{$DEFINE IamSender}

program MAPDIP;
uses
  crt,dos;
const
  ComPort=$3F8;
  DataIn=ComPort+0;
  DataOut=ComPort+0;
  Status=ComPort+5;
  Control=ComPort+3;
  EmptyBall=0;

type
  FileOfByte=File Of Byte;

{********************************************}

function TimeNow:LongInt;
var
  h,m,s,hund:Word;
  Year,Month,Day,DayOfWeek:Word;
  dt:DateTime;
begin
  GetTime(h,m,s,hund);
  GetDate(Year,Month,Day,DayOfWeek);
  TimeNow:=s+60*(m+60*(h+24*(Day+31*(Month+12*Year))));
  end;

procedure ReceiveBall(Var Ball:Byte;SecondsUp:Integer;var errorcode:Integer);
var
  StartedAt,TimeLimit,tmpL:Longint;
  st:Byte;
begin
  StartedAt:=TimeNow;
  TimeLimit:=StartedAt+SecondsUp;
  repeat until ((Port[Status] and 1)<>0) or (TimeNow>TimeLimit); {loop}
  if TimeNow>TimeLimit then begin
    WriteLn;
    Write('The other guy is dead ... Aborting process');
    errorcode:=1;
    exit;
    end;
  Ball:=Port[DataIn];
  end;

procedure RecieveEmptyBall(SecondsUp:Integer;var errorcode:Integer);
var
  Ball:Byte;
begin
  ReceiveBall(Ball,SecondsUp,errorcode);
  if errorcode<>0 then exit;
  { An Empty Ball is expected at this point }
  if Ball<>EmptyBall then begin
    WriteLn;
    Write('Error in protocol ... Aborting process');
    errorcode:=1;
    exit;
    end;
  end;

procedure ReceiveLot(var Handle:FileOfByte;var errorcode:Integer);
var
  x:Byte;
  fs,t:Longint;
begin
  ReceiveBall(x,5,errorcode);
  if errorcode<>0 then exit;
  Port[DataOut]:=EmptyBall;
  fs:=x;

  ReceiveBall(x,5,errorcode);
  if errorcode<>0 then exit;
  Port[DataOut]:=EmptyBall;
  fs:=(fs SHL 8) or x;

  ReceiveBall(x,5,errorcode);
  if errorcode<>0 then exit;
  Port[DataOut]:=EmptyBall;
  fs:=(fs SHL 8) or x;

  ReceiveBall(x,5,errorcode);
  if errorcode<>0 then exit;
  Port[DataOut]:=EmptyBall;
  fs:=(fs SHL 8) or x;

  for t:=1 to fs do begin

    ReceiveBall(x,5,errorcode);  {Any Process has to get rid of}
    if errorcode<>0 then exit;   {the ball as soon as possible}
    Port[DataOut]:=EmptyBall;

    {Delay(100);}   {in these lines the incredibiliy lengthy task of}
    Write(Handle,x);     {doing something usefull with the byte}
    if (t and 1023)=1 then Write('#');
    {Delay(200);}   {is done, beware, it can take a long time}
    end;
  end;


procedure SendLot(var Handle:FileOfByte;var errorcode:Integer);
var
  fs,t:Longint;
  x:Byte;
begin
  fs:=FileSize(Handle);

  Port[DataOut]:=(fs shr 24);  {Hello! Create the ball and send it}

  RecieveEmptyBall(5,errorcode);
  if errorcode<>0 then exit;
  Port[DataOut]:=((fs shr 16) and 255);

  RecieveEmptyBall(5,errorcode);
  if errorcode<>0 then exit;
  Port[DataOut]:=((fs shr 8) and 255);

  RecieveEmptyBall(5,errorcode);
  if errorcode<>0 then exit;
  Port[DataOut]:=(fs and 255);{ finish sending the size of the file }
                              {in the ball}
  for t:=1 to fs do begin
    {Delay(500);}   {in these lines, the incredibily lengthy}
    Read(Handle,x); {task of finding out what is the next thing to}
    {Delay(300);}   { be sent is done, beware, it can take a long time!}

    RecieveEmptyBall(5,errorcode);
    if errorcode<>0 then exit;
    Port[DataOut]:=x;{ = send back the ball with the fucking byte in it }
    end;

  RecieveEmptyBall(5,errorcode); {this is to make sure that the other}
  if errorcode<>0 then exit;     {process didn't die without getting the}
                                 {byte out of the last ball sent}
  {I have the ball, I destroy it, bye bye}
  end;


{************************************}

{MAIN PROGRAM}
var
  c:Char;
  x:Byte;
  errorcode:integer;
  Handle:FileOfByte;
  t,fs:Longint;
begin
  errorcode:=0;
  if ParamCount<>1 then begin
    Writeln('Error: You must provide a file name');
    exit;
    end;
  port[control]:=port[control] or 128;
  port[$3f9]:=0;
  port[$3f8]:=12;   {9600 bauds}
  port[control]:=port[control] xor 128;
  Assign(Handle,ParamStr(1));

  {$IFDEF IamSender}
  {$I-}
  FileMode := 0;  { Set file access to read only }
  Reset(Handle);
  Close(Handle);
  {$I+}
  if IOResult<>0 then begin
    WriteLn('Error: I can not open the file');
    exit;
    end;
  Reset(Handle);
  SendLot(Handle,errorcode);
  WriteLn;
  Close(Handle);
  {$ENDIF}

  {$IFDEF IamReceiver}
  {$I-}
  FileMode := 0;  { Set file access to read only }
  Reset(Handle);
  Close(Handle);
  {$I+}
  if IOResult=0 then begin
    WriteLn('Warning: File Already exists ... Delete? (Y/N)');
    Repeat c:=upCase(ReadKey) until c in ['Y','N'];
    if c='Y' then begin
      {$I-}
      erase(Handle);
      {$I+}
      if IOResult<>0 then begin
        WriteLn('Error: Could not delete file');
        errorcode:=1;
        exit;
        end;
      end;
    end;
  {$I-}
  FileMode := 1;  { Set file access to write only }
  ReWrite(Handle);
  Close(Handle);
  {$I+}
  if IOResult<>0 then begin
    WriteLn('Error: I can not open the file for writing');
    exit;
    end;
  ReWrite(Handle);
  ReceiveLot(Handle,errorcode);
  WriteLn;
  Close(Handle);
  if errorcode<>0 then erase(Handle);
  {$ENDIF}

  end.