Program Modem7;
{
   Written: 05-19-90
   Revised: 12-27-92
   Copyright (c)1990,1992, Eric J. Givler, All Rights Reserved.
}
USES Ansi_Drv,
     Dos,
     Crt,
     CRCS,        { CRCS is a host of crc calculation routines }
     FOS,         { Fossil Communications primitives }
     protocol;    { Protocol Unit }


CONST
      COMport = 1;
      NUL = #$00;  { a # means character instead of byte, ie #$01 }
      SOH = #$01;
      STX = #$02;
      EOT = #$04;
      ACK = #$06;
      NAK = #$15;
      XON = #$11;
      XOFF = #$13;
      CPMEOF = #$1A;

      CAN = #$18;
      C   = #$43;
      TAB = #$09;
      LF  = #$0A; {character}
      CR  = #$0D; {character}
      SPACE = #$20;
      DELete = #$7F;
      lastbyte = 127;
      errormax = 5;
      retrymax = 5;

TYPE  maxstr  = string;
      hexstr  = string[4];
      blocktype = array[0..127] of byte;

VAR  Screen : Text;
     WorkFile: file;
     option,
     hangup,
     return,
     mode : char;
     baudrate : longint;
     sector : blocktype;        { array[0..lastbyte] of byte; }
     rcvbuf : blocktype;        { array[0..127] of byte;      }
     inptr,
     outptr: integer;

     dt : DateTime;
     { regs :registers;
     portnum : word; }

(*
   ================================================================
                     FUNCTIONS and PROCEDURES follow.
   ================================================================
PROCEDURE GetOption         - draws menu and gets user terminal option.
PROCEDURE ReceiveFile       - Receive a File (main)
PROCEDURE ReceiveIt         - Receive a File - Xmodem/Checksum
PROCEDURE SendFile          - Send a File - MAIN menu system.
PROCEDURE SendAscii         - Send a File - Ascii with XON/XOFF
PROCEDURE SendCRC           - Send a File - Xmodem/CRC
PROCEDURE SendMEGALink      - Send a File - MEGALINK
PROCEDURE Terminal          - SIMPLE terminal.
*)


PROCEDURE SendFile;
VAR j,
    blocknum,
    counter,
    result,
    checksum : integer;
    filename : string;
    c : char;
    success : boolean;

(* {$I ASCIIS }   { Ascii Send           - SendAscii    } *)
(* {$I MEGALS }   { MegaLink Send        - SendMEGALink } *)
(* {$I YMGS }     { Ymodem-G Send        - SendYmodem_G } *)

BEGIN
  Write('Filename.Ext ? ');
  ReadLn(filename);
  IF Length(filename) > 0 THEN
  begin
     Write('X)modem/chksum,Xmodem(C)rc,(1)KXmdm,(Y)modem: ');
     readln(c); { repeat until keypressed; }
     c := upcase(c);
     case c of
        {'A' : SendAscii;}
        'X' : success := Upload( filename, XmodemChkSum );
        'C' : success := Upload( filename, XmodemCRC );
        '1' : success := Upload( filename, Xmodem1K );
        'Y' : success := Upload( filename, Ymodem );
     else
       writeln('Invalid protocol [',c,'] selected.');
     end;
  end;
end;


PROCEDURE ReceiveFile;
  VAR j,
      firstchar,
      sectornum,
      sectorcurrent,
      sectorcomp,
      errors,
      checksum  : integer;
      errorflag : boolean;
      filename  : string[20];
      c         : char;

(* {$I ASCIIR }   { Receive Ascii module } *)

(*
  PROCEDURE ReceiveIt;
    VAR  j : integer;
    BEGIN
      sectornum := 0;
      errors := 0;
      Send(NAK);
      Send(NAK);                       { send ready characters }
      REPEAT
        errorflag := false;
        REPEAT
          firstchar := readline(20);
        UNTIL ((firstchar IN [Ord(SOH),Ord(EOT)]) OR (firstchar = timeout));
        IF firstchar = timeout THEN Writeln(cr,lf,'Error - No starting SOH');
        IF firstchar = Ord(SOH) THEN BEGIN
           sectorcurrent := Readline(1);      {real sector number}
           sectorcomp := Readline(1);         {+ inverse of above}
           IF (sectorcurrent+sectorcomp) = 255 THEN BEGIN {< becomes this #}
             IF (sectorcurrent=sectornum+1) THEN BEGIN
                checksum := 0;
                FOR j := 0 TO lastbyte DO BEGIN
                   sector[j] := Readline(1);
                   checksum := (checksum+sector[j]) AND $00FF
                END;
                IF checksum = Readline(1) THEN BEGIN
                   Blockwrite(WorkFile,sector,1);
                   errors := 0;
                   sectornum := sectorcurrent;
                   Write(cr,'Received sector ',sectorcurrent);
                   Send(ACK)
                END ELSE BEGIN
                   Writeln(cr,lf,'Checksum error');
                   errorflag := true
                END
             END ELSE IF (sectorcurrent=sectornum) THEN BEGIN
                REPEAT
                UNTIL Readline(1) = timeout;
                Writeln(cr,lf,'Received duplicate sector ', sectorcurrent);
                Send(ack)
             END ELSE BEGIN
                Writeln(cr,lf,'Synchronization error');
                errorflag := true
             END
           END else BEGIN
             Writeln(cr,lf,'Sector number error');
             errorflag := true
           END
        END;
        IF errorflag THEN BEGIN
           inc(errors);
           REPEAT
           UNTIL Readline(1) = timeout;
           Send(nak)
        END;
      UNTIL ((firstchar = Ord(EOT)) OR (firstchar = timeout)) OR
            (errors = errormax) OR (NOT Carrier);
      IF (firstchar = Ord(EOT)) AND (errors < errormax) THEN BEGIN
         Send(ack);
         Writeln(cr,lf,'Transfer complete')
      END
         ELSE Writeln(cr,lf,'Aborting');
    END;
*)

BEGIN
  Write('Filename.Ext? ');
  Readln(filename);
  IF length(filename) > 0 then begin
     Write('Protocol: a)scii, x)modem: ');
     repeat until keypressed;
     c := upcase(readkey);
     CASE c of
      'a' : {}
      (*   'A' : RecvAscii(filename); *)
      {  'X' : begin
                Assign(WorkFile,filename);
                Rewrite(WorkFile);
                ReceiveIt;
                Close(WorkFile);
              end;}
     else
        writeln(c,' is not a valid protocol.');
     end;
  END;
END;


PROCEDURE PortChange;
var port : integer;
begin
   Write('Enter port #: ');
   ReadLn(port);
   CloseFossil;
   PortNum := Port;
   IF NOT OpenFossil THEN Exit;
end;


PROCEDURE terminal;
VAR C : char;
BEGIN
   writeln('Use ctrl-E to exit terminal mode.');
   repeat
      IF SerialChar THEN
      begin
         c := Receive;
         {Ansi_Write( c );}
         Write(Screen, c);
      end;
      IF keypressed THEN
      BEGIN
         c := readkey;
         send(c);
      END;
   until (c = ^E);
END;

procedure BaudChange;
begin
   write(Screen,'Enter Baud: ');
   Readln(baudrate);
   SetBaudRate(baudrate);
end;

PROCEDURE GetOption;
BEGIN
  Writeln('Options:');
  Writeln;
  Writeln('  B - BaudRate');
  Writeln('  H - hang up the phone');
  WriteLn('  P - Com Port');
  Writeln('  R - receive a file');
  Writeln('  S - send a file');
  Writeln;
  Writeln('  T - terminal mode');
  Writeln('  X - exit to system');
  Writeln;
  Write('which ? ');
  REPEAT
    option := Upcase(readkey);
  UNTIL option IN ['B','H','P','R','S','T','X'];
  Writeln(option);
END;


BEGIN { Modem7 }
  PortNum := 1;
  If not OpenFossil then
  begin
      writeln('Fossil not installed or problem initializing.');
      Halt;
  end;
  Assign(Screen,'');
  Rewrite(Screen);
  baudrate := 19200;
  SetBaudRate(baudrate);
  return := 'N';
  REPEAT
      GetOption;
      CASE option OF
        'B': BaudChange;
        'H': HangUpPhone;
        'P': PortChange;
        'R': ReceiveFile;
        'S': SendFile;
        'T': Terminal;
        'X': return := 'Y';
      END;
  UNTIL return = 'Y';
  CloseFossil;
  Close(Screen);
END.
