{$R-,S-,I-,D+,T-,F-,V-,B-,N-,L+ }
{$M 32768,0,131072 }
Program Kermit ;
(* ***************************************************************** *)
(*                                                                   *)
(* Author - Victor Lee                                               *)
(*          Queen's University ,               Phone                 *)
(*          Kingston, Ontario, CANADA         (613)-545-2033         *)
(*          K7L 3N6                                                  *)
(* Comments and problems can be sent to VIC at QUCDN.BITNET          *)
(*                                or to Victor.Lee@Queens.CA         *)
(*                                                                   *)
(* Date -  1985 January                                              *)
(*      -  1985 May  1    first official release                     *)
(* Acknowlegement -                                                  *)
(*       Victoria Henderson - original Tek4010 coding.               *)
(*       Contributions from Kevin Lowey, Gisbert W.Selke  and        *)
(*          special thank to many others who have reported bugs,     *)
(*          provided fixes, and offered suggestions for improvement. *)
(*                                                                   *)
(* Date -  1988 April     Version 3.0                                *)
(*              Version 3.0 is a major rewrite of QK-Kermit using    *)
(*              Turbo Pascal 4.0.  This version is for MsDos systems *)
(*              only and CP/M systems are no longer supported.       *)
(*              Improved graphic support, Large packet size,         *)
(*              and script commands for automated logons.            *)
(* Modifications                                                     *)
(*         1988 May     - Ack Data Packets earlier.                  *)
(*              June 29 - Fix bug in using Directory Prefixes in     *)
(*                        Sendfile.                                  *)
(*              July 15 - Don't mask out bit8 if parity NONE         *)
(*              Sept 16 - Tek4100 terminal emulation replaces        *)
(*                        the Tek4010, to enable color graphics.     *)
(*              Sept 30 - Fix from Andy Rutherford (AGRSI@CUNYVM)    *)
(*                        to handle non-graphics Monochrome monitor. *)
(*              Oct  7  - Official Release of 3.1                    *)
(*                                                                   *)
(* ***************************************************************** *)
(*  Kermit UNITS                                                     *)
(*                                                                   *)
(*  KGLOBALS - Global variables and utility procedures               *)
(*       GetToken                                                    *)
(*       UpperCase                                                   *)
(*       Prefixof                                                    *)
(*       NewAsFile                                                   *)
(* SYSFUNC  - These are operating system dependent procedures        *)
(*       KeyChar                                                     *)
(*       CursorUp,CursorDown,CursorRight,CursorLeft                  *)
(*       Scroll,FatCursor,                                           *)
(*       LocalScreen,RemoteScreen                                    *)
(*       SetDefaultDrive,DefaultDrive                                *)
(* MODEMPRO - These are Machine dependent Modem procedures           *)
(*       InitModem,ResetModem,SetModem,                              *)
(*       AnswerModem,DialModem                                       *)
(*       RecvChar,SendChar,SendBreak,                                *)
(*       CharsInBuffer,EmptyBuffer                                   *)
(* PACKETS - packet related procedures                               *)
(*       ReadChar,ReadMChar                                          *)
(*       SendPacket,RecvPacket,                                      *)
(*       ReSendit,SendPacketType,                                    *)
(*       PutInitPacket,GetInitPacket                                 *)
(* SENDRECV - Sending and Receiving file procedures                  *)
(*       RECVFILE                                                    *)
(*       SENDFILE                                                    *)
(*       BreakAck                                                    *)
(* VT100 - Terminal Emulation procedure                              *)
(*       CONNECT                                                     *)
(* TEK4100 - Graphics terminal emulation procedure                   *)
(*       Tektronics                                                  *)
(* SETSHOW - set and show options                                    *)
(*       ShowOptions                                                 *)
(*       SetOptions                                                  *)
(*       DisplayCommands                                             *)
(* LOCAL - local procedures                                          *)
(*      DisplayDir  - Display directory.                             *)
(*      EraseFiles  - Erase files.                                   *)
(*      RenameFiles - Rename files.                                  *)
(*      DisplayFile - Display file (TYPE file ).                     *)
(*     (RunFile     - Run a program  ( See SYSFUNC procedures ) )    *)
(* DEFWORDS - Define Words procedures                                *)
(*       AssignDefWord                                               *)
(*       DisplayDefWords                                             *)
(*       CheckDefWords                                               *)
(*       WriteDefWord                                                *)
(*       DEFINEWORD                                                  *)
(*       LoadDefWords                                                *)
(*       SaveDefWords                                                *)
(* REMOTEU  - Remote request procedures                              *)
(*      RemotePro                                                    *)
(* MISCCOMM - Miscellaneous command                                  *)
(*       Logit      - log the session to a file.                     *)
(*       Takeit     - take commands from a file.                     *)
(*       QuitExit   - terminate kermits and log out.                 *)
(* DRIVERS - graphics drivers from Turbo pascal 4.0                  *)
(* FONTS   - graphics fonts from Turbo pascal 4.0                    *)
(*                                                                   *)
(* ***************************************************************** *)

uses Dos,Crt,printer,graph,    (* Standard Turbo Pascal Units *)
     KGlobals,                 (* Kermit Globals *)
     ModemPro,
     Vt100,tek4100,
     SetShow,SendRecv,RemoteU,
     MiscComm,Local,Defwords ;

TYPE
    Commandindex = (
                  zero,
                  wait,
                  connect,
                  send,
                  receive,
                  setparm,
                  status,
                  directory,
                  erase,
                  rename,
                  typefile,
                  runfile,
                  remote,
                  log,
                  take,
                  define,
                  help,
                  mkdirl,
                  rmdirl,
                  chdirl,
                  audio,
                  parms,
                  line25,
                  quit,
                  null );
    Commandindex2= (zero2,input,output,pause,echo,clear);

VAR
    timeout : boolean ;
    inbyte : byte ;
    Hour,hh,mm,ss,ms : word ;
    i,j,inlength,inputTimer,timer,alarm : integer ;
    inputstring, NameString : string ;
    command, commandtable,commandtable2,inbuff : string ;

(* ***************************************************************** *)
(* ********    Outter Block of Kermit ****************************** *)
(* ***************************************************************** *)


BEGIN (* KERMIT *)
commandtable := concat('bad       ',
                       'WAIT      ',
                       'CONNECT   ',
                       'SEND      ',
                       'RECEIVE   ',
                       'SET       ',
                       'STATUS    ',
                       'DIRECTORY ',
                       'ERASE DEL ',
                       'RENAME    ',
                       'TYPE      ',
                       'RUN EXEC  ',
                       'REMOTE    ',
                       'LOG       ',
                       'TAKE      ',
                       'DEFINE    ',
                       'HELP  ?   ',
                       'MKDIR MD  ',
                       'RMDIR RD  ',
                       'CHDIR CD  ',
                       'AUDIO     ',
                       'PARMS     ',
                       'LINE25    ',
                       'QUIT EXIT ',
                       'DO LOCAL  ') ;

commandtable2 := concat('bad2      ',
                        'INPUT     ',
                        'OUTPUT    ',
                        'PAUSE     ',
                        'ECHO      ',
                        'CLEAR     ') ;

   Writeln('          * ======================================== * ');
   Writeln('          *  Queen''s University  -  KERMIT /',termtype,' * ');
   Writeln('          *                                          * ');
   Writeln('          *      Version ',version,Gversion,' - ',Date,'  * ');
   Writeln('          *      Author   -  Victor Lee              * ');
   Writeln('          *      Graphics ',Graphics,'  * ');
   Writeln('          * ======================================== * ');

inputstring := '' ;
For i := 1 to ParamCount do
     inputstring := inputstring + ' ' + paramstr(i) ;
Running := True ;
While Running Do
    Begin (* Command Loop *)
    if audioflag then
       Begin sound(1500);delay(50);sound(300);delay(50);nosound; end ;
    if length(inputstring)<1 then
         if TakeActive then
              Begin (* Get command from file *)
              Readln(Commandfile,inputstring);
              TakeActive := not Eof(commandfile);
              if Eof(commandfile) then close(commandfile);
              End
                             else
             Begin (* ask for input *)
             Write('QK-Kermit>');              (* PROMPT for input *)
             readln(inputstring);
             End ; (* ask for input *)

    command := Uppercase(GETTOKEN(inputstring));
    CheckDefWords(DefList,command,Inputstring);
    command := ' ' + command ;
    WaitXon := false ;

    case commandindex(POS(command,commandtable) div 10 ) of
          zero    : If length(command)>1 then
                        Begin (* check table 2 - Script commands *)
                      case commandindex2(POS(command,commandtable2) div 10) of
                   zero2 :
                           Begin (* bad command *)
                           Writeln('Invalid Command >>>>> ',Command,' <<<<<');
                           Writeln('--- Type HELP to see valid Commands.--- ');
                           End ; (* bad command *)
                  input  : Begin (* Input Command *)
                           Val(GetToken(InputString),InputTimer,j) ;
                           i := 1 ;
                           GetTime(hh,mm,ss,ms);
                           Alarm := mm*60 + ss + InputTimer ;
                           inlength := length(inputstring);
                           timeout:=false;
                           While (i <= inlength) and  (not timeout) do
                           If RecvChar(inbyte) then
                               Begin (* got char *)
                               If chr(inbyte) = InputString[i] then
                                     begin (* matches *)
                                     InBuff[i] := chr(inbyte) ;
                                     InBuff[0] := chr(i) ;
                                     i := i + 1 ;
                                     end   (* matches *)
                                                               else
                                     i := 1 ;
                               write(chr(inbyte));
                               End  (* got char *)
                                              else
                               Begin  (* time it *)
                               GetTime(Hour,mm,ss,ms);
                               Timer := mm*60 + ss ;
                               If Hour<>hh then Timer := Timer + 3600 ;
                               If Timer > Alarm then timeout := true ;
                               End ; (* time it *)

                           if timeout then writeln('Timed Out')
                              ;  (*    else writeln(inputstring); *)
                           inputstring := '';
                           End ; (* Input Command *)
                  output : Begin (* Output Command *)
                           For i := 1 to length(inputstring) do
                               if inputstring[i]='~' then
                                  Sendchar(CR_) (* carriage return *)
                                                     else
                                  Sendchar(ord(inputstring[i]));
                           InputString := '';
                           End ; (* Output Command *)
                  pause  : Begin (* pause *)
                           Val(GetToken(Inputstring),i,j);
                           delay(i);
                           End ; (* pause *)
                  echo   : Begin writeln(inputstring); inputstring := ''; end;
                  clear  : Begin (* Clear *)
                           DialModem ;
                           For i := 1 to 255 do Inbuff := ' ';
                           End ;  (* Clear *)
                        end ; (* case *)
                        End ; (* check table 2 - Script commands *)
          wait     : Begin AnswerModem ; Connection ; End ;
          connect  : Begin
                     If length(inputstring) > 1 then SetOptions(inputstring);
                     CONNECTION ;
                     End;
          send     : SENDFILE (inputstring);
          receive  : RECVFILE (inputstring );
          setparm  : SetOptions(inputstring);
          status   : ShowOptions ;
          directory: DisplayDir (inputstring);
          erase    : EraseFiles (GetToken(inputstring));
          rename   : RenameFile (inputstring);
          typefile : DisplayFile (GetToken(inputstring));
          runfile  : Begin (* RunFile *)
                     NameString := GetToken(Inputstring) ;
                     if Pos('.',NameString) = 0 then
                           NameString := NameString + '.EXE' ;
                     EXEC (NameString,inputstring);
                     Case DosError  of
                     2: Writeln('File ',NameString,' not Found');
                     5: Writeln('Acess Denied');
                     8: Writeln('Insufficient Memory to load program');
                    10: Writeln('Invalid Environment.');
                    11: Writeln('Unable to Execute file');
                      end ; (* DosError Case *)
                     inputstring := '' ;
                     end ;  (* RunFile *)
          remote   : RemoteProc (inputstring);
          log      : Logit  (GetToken(inputstring));
          take     : Takeit (GetToken(inputstring));
          define   : DefineWord(inputstring);
          help     : DisplayCommands ;
          mkdirl   : Begin (* Make Directory *)
                     NameString := GetToken(Inputstring) ;
                     {$I-} Mkdir (NameString) ; {$I+}
                     If IoResult = 0 then
                          writeln('Directory ',NameString,' maked OK.')
                                     else
                          writeln('Unable to make directory - ',NameString);
                     End ;(* Make Directory *)
          chdirl   : Begin (* Change Directory *)
                     NameString := GetToken(Inputstring) ;
                     {$I-} Chdir (NameString) ; {$I+}
                     If IoResult = 0 then
                          writeln('Directory changed to ',NameString)
                                     else
                          writeln('Unable to change directory - ',NameString);
                     End ;(* Change Directory *)
          rmdirl   : Begin (* Remove Directory *)
                     NameString := GetToken(Inputstring) ;
                     {$I-} Rmdir (NameString) ; {$I+}
                     If IoResult = 0 then
                          writeln('Directory ',NameString,' removed. ')
                                     else
                          writeln('Unable to remove directory - ',NameString);
                     End ;(* Remove Directory *)
          audio    : AudioFlag := AudioFlag xor True ;
          parms    : ParmFlag := ParmFlag xor True ;
          line25   : Line25Flag := Line25Flag xor True ;
          quit     : QuitExit (UpperCase(GetToken(inputstring)));
          null     : ;
       end ;  (*  Case commandindex *)
    End ; (* Command Loop *)

 If Logging then Close(Logfile);
 If NewDefs then SaveDefWords ;
 If audioflag then
    begin sound(1500);delay(200);sound(3000);delay(200);end ;
 ResetModem;

 If audioflag then
    begin sound(2000);delay(200); nosound; end ;
 ClrScr;
 Gotoxy(20,10); Write( ' G O O D - B Y E ');

END.  (* KERMIT *)