Columbia Kermit/kermit.zip/archives/os2pm.zip/o2asrc.jar

Text File | 1990-08-27 | 131KB | 4,016 lines

<<< COMMPORT.DEF >>>
(*************************************************************)
(*                                                           *)
(*                Copyright (C) 1988, 1989                   *)
(*                 by Stony Brook Software                   *)
(*                                                           *)
(*                   All rights reserved.                    *)
(*                                                           *)
(*************************************************************)

DEFINITION MODULE CommPort;

   TYPE
      CommStatus = (
               Success,
               InvalidPort,
               InvalidParameter,
               AlreadyReceiving,
               NotReceiving,
               NoCharacter,
               FramingError,
               OverrunError,
               ParityError,
               BufferOverflow,
               TimeOut
      );

      BaudRate = (
               Baud110,
               Baud150,
               Baud300,
               Baud600,
               Baud1200,
               Baud2400,
               Baud4800,
               Baud9600,
               Baud19200
      );

      DataBits = [7..8];
      StopBits = [1..2];
      Parity = (Even, Odd, None);


   PROCEDURE InitPort(port : CARDINAL; speed : BaudRate; data : DataBits;
                          stop : StopBits; check : Parity) : CommStatus;

   PROCEDURE StartReceiving(port, bufsize : CARDINAL) : CommStatus;

   PROCEDURE StopReceiving(port : CARDINAL) : CommStatus;

   PROCEDURE GetChar(port : CARDINAL; VAR ch : CHAR) : CommStatus;

   PROCEDURE SendChar(port : CARDINAL; ch : CHAR; modem : BOOLEAN) : CommStatus;

END CommPort.
<<< COMMPORT.mod >>>
(**************************************************************************)
(*                                                                        *)
(*                     Copyright (c) 1988, 1989                           *)
(*                      by Stony Brook Software                           *)
(*                               and                                      *)
(*                        Copyright (c) 1990                              *)
(*                       by Brian R. Anderson                             *)
(*                        All rights reserved.                            *)
(*                                                                        *)
(**************************************************************************)

IMPLEMENTATION MODULE CommPort [7];

   FROM SYSTEM IMPORT
      ADR, BYTE, WORD, ADDRESS;

   FROM Storage IMPORT
      ALLOCATE, DEALLOCATE;

   FROM DosCalls IMPORT
      DosOpen, AttributeSet, DosDevIOCtl, DosClose, DosRead, DosWrite;


   TYPE
      CP = POINTER TO CHAR;

   VAR
      pn : CARDINAL;
      Handle : ARRAY [0..3] OF CARDINAL;
      BufIn : ARRAY [0..3] OF CP;
      BufOut : ARRAY [0..3] OF CP;
      BufStart : ARRAY [0..3] OF CP;
      BufLimit : ARRAY [0..3] OF CP;
      BufSize : ARRAY [0..3] OF CARDINAL;
      Temp : ARRAY [1..1024] OF CHAR;   (* size of OS/2's serial queue *)


   PROCEDURE CheckPort (portnum : CARDINAL) : BOOLEAN;
   (* Check for a valid port number and open the port if it not alredy open *)

      CONST
         PortName : ARRAY [0..3] OF ARRAY [0..4] OF CHAR =
            [['COM1', 0C], ['COM2', 0C], ['COM3', 0C], ['COM4', 0C]];

      VAR
         Action : CARDINAL;

      BEGIN
         (* check the port number *)
         IF portnum > 3 THEN
            RETURN FALSE;
         END;

         (* attempt to open the port if it is not already open *)
         IF Handle[portnum] = 0 THEN
            IF DosOpen(ADR(PortName[portnum]), Handle[portnum], Action, 0,
             AttributeSet{}, 1, 12H, 0) # 0 THEN
               RETURN FALSE;
            END;
         END;
         RETURN TRUE;
      END CheckPort;



   PROCEDURE InitPort (portnum : CARDINAL; speed : BaudRate; data : DataBits;
                         stop : StopBits; check : Parity) : CommStatus;
   (* Initialize a port *)

      CONST
         Rate : ARRAY BaudRate OF CARDINAL =
                   [110, 150, 300, 600, 1200, 2400, 4800, 9600, 19200];
         TransParity : ARRAY Parity OF BYTE = [2, 1, 0];

      TYPE
         LineChar =  RECORD
                        bDataBits : BYTE;
                        bParity : BYTE;
                        bStopBits : BYTE;
                     END;

      VAR
         LC : LineChar;

      BEGIN
         (* Check the port number *)
         IF NOT CheckPort(portnum) THEN
            RETURN InvalidPort;
         END;

         (* Set the baud rate *)
         IF DosDevIOCtl(0, ADR(Rate[speed]), 41H, 1, Handle[portnum]) # 0 THEN
            RETURN InvalidParameter;
         END;

         (* set the characteristics *)
         LC.bDataBits := BYTE(data);
         IF stop = 1 THEN
            DEC (stop);    (* 0x00 = 1 stop bits;    0x02 = 2 stop bits *)
         END;
         LC.bStopBits := BYTE(stop);
         LC.bParity := TransParity[check];

         IF DosDevIOCtl(0, ADR(LC), 42H, 1, Handle[portnum]) # 0 THEN
            RETURN InvalidParameter;
         END;

         RETURN Success;
      END InitPort;


   PROCEDURE StartReceiving (portnum, bufsize : CARDINAL) : CommStatus;
   (* Start receiving characters on a port *)
      BEGIN
         IF NOT CheckPort(portnum) THEN
            RETURN InvalidPort;
         END;
         IF BufStart[portnum] # NIL THEN
            RETURN AlreadyReceiving;
         END;
         ALLOCATE (BufStart[portnum], bufsize);
         BufIn[portnum] := BufStart[portnum];
         BufOut[portnum] := BufStart[portnum];
         BufLimit[portnum] := BufStart[portnum];
         INC (BufLimit[portnum]:ADDRESS, bufsize - 1);
         BufSize[portnum] := bufsize;
         RETURN Success;
      END StartReceiving;


   PROCEDURE StopReceiving (portnum : CARDINAL) : CommStatus;
   (* Stop receiving characters on a port *)
      BEGIN
         IF NOT CheckPort(portnum) THEN
            RETURN InvalidPort;
         END;
         IF BufStart[portnum] # NIL THEN
            DEALLOCATE (BufStart[portnum], BufSize[portnum]);
            BufLimit[portnum] := NIL;
            BufIn[portnum] := NIL;
            BufOut[portnum] := NIL;
            BufSize[portnum] := 0;
         END;
         DosClose(Handle[portnum]);
         Handle[portnum] := 0;
         RETURN Success;
      END StopReceiving;


   PROCEDURE GetChar (portnum : CARDINAL; VAR ch : CHAR) : CommStatus;
   (* Get a character from the comm port *)

      VAR
         status : CARDINAL;
         read : CARDINAL;
         que : RECORD
                  ct : CARDINAL;
                  sz : CARDINAL;
               END;
         i : CARDINAL;

      BEGIN
         IF BufStart[portnum] = NIL THEN
            RETURN NotReceiving;
         END;
         IF NOT CheckPort(portnum) THEN
            RETURN InvalidPort;
         END;
         status := DosDevIOCtl (ADR (que), 0, 68H, 1, Handle[portnum]);
         IF (status = 0) AND (que.ct # 0) THEN
            status := DosRead (Handle[portnum], ADR (Temp), que.ct, read);
            IF (status # 0) OR (read = 0) THEN
               RETURN NotReceiving;
            END;
            FOR i := 1 TO read DO
               BufIn[portnum]^ := Temp[i];
               IF BufIn[portnum] = BufLimit[portnum] THEN
                  BufIn[portnum] := BufStart[portnum];
               ELSE
                  INC (BufIn[portnum]:ADDRESS);
               END;
               IF BufIn[portnum] = BufOut[portnum] THEN
                  RETURN BufferOverflow;
               END;
            END;
         END;

         IF BufIn[portnum] = BufOut[portnum] THEN
            RETURN NoCharacter;
         END;
         ch := BufOut[portnum]^;
         IF BufOut[portnum] = BufLimit[portnum] THEN
            BufOut[portnum] := BufStart[portnum];
         ELSE
            INC (BufOut[portnum]:ADDRESS);
         END;
         RETURN Success;
      END GetChar;


   PROCEDURE SendChar (portnum : CARDINAL; ch : CHAR;
                         modem : BOOLEAN) : CommStatus;
   (* send a character to the comm port *)

      VAR
         wrote : CARDINAL;
         status : CARDINAL;
         commSt : CHAR;

      BEGIN
         IF NOT CheckPort(portnum) THEN
            RETURN InvalidPort;
         END;
         status := DosDevIOCtl (ADR (commSt), 0, 64H, 1, Handle[portnum]);
         IF (status # 0) OR (commSt # 0C) THEN
            RETURN TimeOut;
         ELSE
            status := DosWrite(Handle[portnum], ADR(ch), 1, wrote);
            IF (status # 0) OR (wrote # 1) THEN
               RETURN TimeOut;
            ELSE
               RETURN Success;
            END;
         END;
      END SendChar;


BEGIN   (* module initialization *)
   (* nothing open yet *)
   FOR pn := 0 TO 3 DO
      Handle[pn] := 0;
      BufStart[pn] := NIL;
      BufLimit[pn] := NIL;
      BufIn[pn] := NIL;
      BufOut[pn] := NIL;
      BufSize[pn] := 0;
   END;
END CommPort.
<<< DATALINK.DEF >>>
DEFINITION MODULE DataLink;   (* Sends and Receives Packets for PCKermit *)

   FROM PMWIN IMPORT
      MPARAM;

   FROM PAD IMPORT
      PacketType;

   EXPORT QUALIFIED
      WM_DL, FlushUART, SendPacket, ReceivePacket, DoDLMsg;

   CONST
      WM_DL = 6000H;

   PROCEDURE FlushUART;
   (* ensure no characters left in UART holding registers *)

   PROCEDURE SendPacket (s : PacketType);
   (* Adds SOH and CheckSum to packet *)

   PROCEDURE ReceivePacket (VAR r : PacketType) : BOOLEAN;
   (* strips SOH and checksum -- returns status: TRUE= good packet       *)
   (* received;  FALSE = timed out waiting for packet or checksum error  *)

   PROCEDURE DoDLMsg (mp1, mp2 [VALUE] : MPARAM);
   (* Process DataLink Messages *)

END DataLink.
<<< DATALINK.MOD >>>
IMPLEMENTATION MODULE DataLink;  (* Sends and Receives Packets for PCKermit *)

   FROM ElapsedTime IMPORT
      StartTime, GetTime;

   FROM Screen IMPORT
      ClrScr, WriteString, WriteLn;

   FROM PMWIN IMPORT
      MPARAM, WinPostMsg;

   FROM Shell IMPORT
      ChildFrameWindow, comport;

   FROM CommPort IMPORT
      CommStatus, GetChar, SendChar;

   FROM PAD IMPORT
      PacketType, yourNPAD, yourPADC, yourEOL;

   FROM KH IMPORT
      COM_OFF;

   FROM SYSTEM IMPORT
      BYTE;

   IMPORT ASCII;


   CONST
      MAXtime = 100;   (* hundredths of a second -- i.e., one second *)
      MAXsohtrys = 100;
      DL_BadCS = 1;
      DL_NoSOH = 2;


   TYPE
      SMALLSET = SET OF [0..7];   (* BYTE *)

   VAR
      ch : CHAR;
      status : CommStatus;
      MP1, MP2 : MPARAM;


   PROCEDURE Delay (t : CARDINAL);
   (* delay time in milliseconds *)

      VAR
         tmp : LONGINT;

      BEGIN
         tmp := t DIV 10;
         StartTime;
         WHILE GetTime() < tmp DO
         END;
      END Delay;


   PROCEDURE ByteAnd (a, b : BYTE) : BYTE;
      BEGIN
         RETURN BYTE (SMALLSET (a) * SMALLSET (b));
      END ByteAnd;


   PROCEDURE Char (c : INTEGER) : CHAR;
   (* converts a number 0-95 into a printable character *)
      BEGIN
         RETURN (CHR (CARDINAL (ABS (c) + 32)));
      END Char;


   PROCEDURE UnChar (c : CHAR) : INTEGER;
   (* converts a character into its corresponding number *)
      BEGIN
         RETURN (ABS (INTEGER (ORD (c)) - 32));
      END UnChar;


   PROCEDURE FlushUART;
   (* ensure no characters left in UART holding registers *)
      BEGIN
         Delay (500);
         REPEAT
            status := GetChar (comport - COM_OFF, ch);
         UNTIL status = NoCharacter;
      END FlushUART;


   PROCEDURE SendPacket (s : PacketType);
   (* Adds SOH and CheckSum to packet *)

      VAR
         i : CARDINAL;
         checksum : INTEGER;

      BEGIN
         Delay (10);   (* give host a chance to catch its breath *)
         FOR i := 1 TO yourNPAD DO
            status := SendChar (comport - COM_OFF, yourPADC, FALSE);
         END;
         status := SendChar (comport - COM_OFF, ASCII.soh, FALSE);
         i := 1;
         checksum := 0;
         WHILE s[i] # 0C DO
            INC (checksum, ORD (s[i]));
            status := SendChar (comport - COM_OFF, s[i], FALSE);
            INC (i);
         END;
         checksum := checksum + (INTEGER (BITSET (checksum) * {7, 6}) DIV 64);
         checksum := INTEGER (BITSET (checksum) * {5, 4, 3, 2, 1, 0});
         status := SendChar (comport - COM_OFF, Char (checksum), FALSE);
         IF yourEOL # 0C THEN
            status := SendChar (comport - COM_OFF, yourEOL, FALSE);
         END;
      END SendPacket;


   PROCEDURE ReceivePacket (VAR r : PacketType) : BOOLEAN;
   (* strips SOH and checksum -- returns status: TRUE = good packet     *)
   (* received;  FALSE = timed out waiting for packet or checksum error *)

      VAR
         sohtrys : INTEGER;
         i, len : INTEGER;
         ch : CHAR;
         checksum : INTEGER;
         mycheck, yourcheck : CHAR;

      BEGIN
         sohtrys := MAXsohtrys;
         REPEAT
            StartTime;
            REPEAT
               status := GetChar (comport - COM_OFF, ch);
            UNTIL (status = Success) OR (GetTime() > MAXtime);
            ch := CHAR (ByteAnd (ch, 177C));   (* mask off MSB *)
            (* skip over up to MAXsohtrys padding characters, *)
            (* but allow only MAXsohtrys/10 timeouts          *)
            IF status = Success THEN
               DEC (sohtrys);
            ELSE
               DEC (sohtrys, 10);
            END;
         UNTIL (ch = ASCII.soh) OR (sohtrys <= 0);

         IF ch = ASCII.soh THEN
            (* receive rest of packet *)
            StartTime;
            REPEAT
               status := GetChar (comport - COM_OFF, ch);
            UNTIL (status = Success) OR (GetTime() > MAXtime);
            ch := CHAR (ByteAnd (ch, 177C));
            len := UnChar (ch);
            r[1] := ch;
            checksum := ORD (ch);
            i := 2;   (* on to second character in packet -- after LEN *)
            REPEAT
               StartTime;
               REPEAT
                  status := GetChar (comport - COM_OFF, ch);
               UNTIL (status = Success) OR (GetTime() > MAXtime);
               ch := CHAR (ByteAnd (ch, 177C));
               r[i] := ch;   INC (i);
               INC (checksum, (ORD (ch)));
            UNTIL (i > len);
            (* get checksum character *)
            StartTime;
            REPEAT
               status := GetChar (comport - COM_OFF, ch);
            UNTIL (status = Success) OR (GetTime() > MAXtime);
            ch := CHAR (ByteAnd (ch, 177C));
            yourcheck := ch;
            r[i] := 0C;
            checksum := checksum +
                            (INTEGER (BITSET (checksum) * {7, 6}) DIV 64);
            checksum := INTEGER (BITSET (checksum) *  {5, 4, 3, 2, 1, 0});
            mycheck := Char (checksum);
            IF mycheck = yourcheck THEN   (* checksum OK *)
               RETURN TRUE;
            ELSE   (* ERROR!!! *)
               MP1.W1 := DL_BadCS;   MP1.W2 := 0;
               MP2.L := 0;
               WinPostMsg (ChildFrameWindow, WM_DL, MP1, MP2);
               RETURN FALSE;
            END;
         ELSE
            MP1.W1 := DL_NoSOH;   MP1.W2 := 0;
            MP2.L := 0;
            WinPostMsg (ChildFrameWindow, WM_DL, MP1, MP2);
            RETURN FALSE;
         END;
      END ReceivePacket;


   PROCEDURE DoDLMsg (mp1, mp2 [VALUE] : MPARAM);
   (* Process DataLink Messages *)
      BEGIN
         CASE CARDINAL (mp1.W1) OF
            DL_BadCS:
               WriteString ("Bad Checksum");   WriteLn;
         |  DL_NoSOH:
               WriteString ("No SOH");   WriteLn;
         ELSE
            (* Do Nothing *)
         END;
      END DoDLMsg;

END DataLink.
<<< FILES.DEF >>>
DEFINITION MODULE Files;   (* File I/O for Kermit *)

   FROM FileSystem IMPORT
      File;

   EXPORT QUALIFIED
      Status, FileType, Open, Create, CloseFile, Get, Put, DoWrite;

   TYPE
      Status = (Done, Error, EOF);
      FileType = (Input, Output);

   PROCEDURE Open (VAR f : File; name : ARRAY OF CHAR) : Status;
   (* opens an existing file for reading, returns status *)

   PROCEDURE Create (VAR f : File; name : ARRAY OF CHAR) : Status;
   (* creates a new file for writing, returns status *)

   PROCEDURE CloseFile (VAR f : File; Which : FileType) : Status;
   (* closes a file after reading or writing *)

   PROCEDURE Get (VAR f : File; VAR ch : CHAR) : Status;
   (* Reads one character from the file, returns status *)

   PROCEDURE Put (ch : CHAR);
   (* Writes one character to the file buffer *)

   PROCEDURE DoWrite (VAR f : File) : Status;
   (* Writes buffer to disk only if nearly full *)

END Files.
<<< FILES.MOD >>>
IMPLEMENTATION MODULE Files;   (* File I/O for KXCom *)

   FROM FileSystem IMPORT
      File, Response, Lookup, Close, ReadNBytes, WriteNBytes;

   FROM Conversions IMPORT
      CardToString;

   FROM SYSTEM IMPORT
      ADR, SIZE;

   CONST
      NEARFULL = 400;

   TYPE
      buffer = ARRAY [1..512] OF CHAR;


   VAR
      inBuf, outBuf : buffer;
      inP, outP : CARDINAL;   (* buffer pointers *)
      read, written : CARDINAL;   (* number of bytes read or written *)
                                  (* by ReadNBytes or WriteNBytes    *)


   PROCEDURE Open (VAR f : File; name : ARRAY OF CHAR) : Status;
   (* opens an existing file for reading, returns status *)
      BEGIN
         Lookup (f, name, FALSE);
         IF f.res = done THEN
            inP := 0;   read := 0;
            RETURN Done;
         ELSE
            RETURN Error;
         END;
      END Open;


   PROCEDURE Create (VAR f : File; name : ARRAY OF CHAR) : Status;
   (* creates a new file for writing, returns status *)

      VAR
         i : CARDINAL;
         b : BOOLEAN;
         ext : CARDINAL;  (* new file extensions to avoid name conflict *)

      BEGIN
         ext := 0;
         LOOP
            Lookup (f, name, FALSE);   (* check to see if file exists *)
            IF f.res = done THEN   (* Filename Clase: Change file name *)
               Close (f);
               IF ext > 99 THEN   (* out of new names... *)
                  RETURN Error;
               END;
               i := 0;
               WHILE (name[i] # 0C) AND (name[i] # '.') DO
                  INC (i);   (* scan for end of filename *)
               END;
               name[i] := '.';
               INC (i);   name[i] := 'K';
               INC (i);   name[i] := 0C;
               CardToString (ext, 1, name, i, b);
               INC (ext);
            ELSE
               EXIT;
            END;
         END;
         Lookup (f, name, TRUE);
         IF f.res = done THEN
            outP := 0;
            RETURN Done;
         ELSE
            RETURN Error;
         END;
      END Create;


   PROCEDURE CloseFile (VAR f : File; Which : FileType) : Status;
   (* closes a file after reading or writing *)
      BEGIN
         written := outP;
         IF (Which = Output) AND (outP > 0) THEN
            WriteNBytes (f, ADR (outBuf), outP);
            written := f.count;
         END;
         Close (f);
         IF (written = outP) AND (f.res = done) THEN
            RETURN Done;
         ELSE
            RETURN Error;
         END;
      END CloseFile;


   PROCEDURE Get (VAR f : File; VAR ch : CHAR) : Status;
   (* Reads one character from the file, returns status *)
      BEGIN
         IF inP = read THEN
            ReadNBytes (f, ADR (inBuf), SIZE (inBuf));
            read := f.count;
            inP := 0;
         END;
         IF read = 0 THEN
            RETURN EOF;
         ELSE
            INC (inP);
            ch := inBuf[inP];
            RETURN Done;
         END;
      END Get;


   PROCEDURE Put (ch : CHAR);
   (* Writes one character to the file buffer *)
      BEGIN
         INC (outP);
         outBuf[outP] := ch;
      END Put;


   PROCEDURE DoWrite (VAR f : File) : Status;
   (* Writes buffer to disk only if nearly full *)
      BEGIN
         IF outP < NEARFULL THEN   (* still room in buffer *)
            RETURN Done;
         ELSE
            WriteNBytes (f, ADR (outBuf), outP);
            written := f.count;
            IF (written = outP) AND (f.res = done) THEN
               outP := 0;
               RETURN Done;
            ELSE
               RETURN Error;
            END;
         END;
      END DoWrite;

BEGIN (* module initialization *)
END Files.
<<< KH.DEF >>>
DEFINITION MODULE KH;

CONST
   ID_OK        =  25;

   PARITY_OFF   =  150;
   ID_NONE      =  152;
   ID_ODD       =  151;
   ID_EVEN      =  150;

   STOP_OFF     =  140;
   ID_STOP2     =  142;
   ID_STOP1     =  141;

   DATA_OFF     =  130;
   ID_DATA8     =  138;
   ID_DATA7     =  137;

   BAUD_OFF     =  120;
   ID_B19K2     =  128;
   ID_B9600     =  127;
   ID_B4800     =  126;
   ID_B2400     =  125;
   ID_B1200     =  124;
   ID_B600      =  123;
   ID_B300      =  122;
   ID_B150      =  121;
   ID_B110      =  120;

   COM_OFF      =  100;
   ID_COM2      =  101;
   ID_COM1      =  100;

   IDM_C2       =  24;
   IDM_C1       =  23;
   IDM_AMBER    =  22;
   IDM_GREEN    =  21;
   IDM_WHITE    =  20;
   IDM_COLORS   =  19;
   IDM_DIREND   =  18;
   ID_DIRPATH   =  17;
   ID_SENDFN    =  16;
   IDM_DIRPATH  =  15;
   IDM_SENDFN   =  14;
   IDM_TERMHELP =  13;
   IDM_HELPMENU =  12;
   IDM_ABOUT    =  11;
   IDM_PARITY   =  10;
   IDM_STOPBITS =  9;
   IDM_DATABITS =  8;
   IDM_BAUDRATE =  7;
   IDM_COMPORT  =  6;
   IDM_QUIT     =  5;
   IDM_REC      =  4;
   IDM_SEND     =  3;
   IDM_CONNECT  =  2;
   IDM_DIR      =  1;
   IDM_OPTIONS  =  52;
   IDM_FILE     =  51;
   IDM_KERMIT   =  50;

END KH.
<<< KH.MOD >>>
IMPLEMENTATION MODULE KH;
END KH.
<<< PAD.DEF >>>
DEFINITION MODULE PAD;   (* Packet Assembler/Disassembler for Kermit *)

   FROM PMWIN IMPORT
      MPARAM;

   EXPORT QUALIFIED
      WM_PAD, PAD_Quit, PAD_Error, PacketType, yourNPAD, yourPADC, yourEOL,
      Aborted, sFname, Send, Receive, DoPADMsg;

   CONST
      WM_PAD = 5000H;
      PAD_Quit = 0;
      PAD_Error = 20;

   TYPE
      (* PacketType used in both PAD and DataLink modules *)
      PacketType = ARRAY [1..100] OF CHAR;

   VAR
      (* yourNPAD, yourPADC, and yourEOL used in both PAD and DataLink *)
      yourNPAD : CARDINAL;   (* number of padding characters *)
      yourPADC : CHAR;       (* padding characters *)
      yourEOL  : CHAR;       (* End Of Line -- terminator *)
      sFname : ARRAY [0..20] OF CHAR;
      Aborted : BOOLEAN;

   PROCEDURE Send;
   (* Sends a file after prompting for filename *)

   PROCEDURE Receive;
   (* Receives a file (or files) *)

   PROCEDURE DoPADMsg (mp1, mp2 [VALUE] : MPARAM);
   (* Output messages for Packet Assembler/Disassembler *)

END PAD.
<<< PAD.MOD >>>
IMPLEMENTATION MODULE PAD;   (* Packet Assembler/Disassembler for Kermit *)

   FROM SYSTEM IMPORT
      ADR;

   FROM Storage IMPORT
      ALLOCATE, DEALLOCATE;

   FROM Screen IMPORT
      ClrScr, WriteString, WriteInt, WriteHex, WriteLn;

   FROM DosCalls IMPORT
      ExitType, DosExit;

   FROM Strings IMPORT
      Length, Assign;

   FROM FileSystem IMPORT
      File;

   FROM Directories IMPORT
      FileAttributes, AttributeSet, DirectoryEntry, FindFirst, FindNext;

   FROM Files IMPORT
      Status, FileType, Open, Create, CloseFile, Get, Put, DoWrite;

   FROM PMWIN IMPORT
      MPARAM, WinPostMsg;

   FROM Shell IMPORT
      ChildFrameWindow, comport;

   FROM KH IMPORT
      COM_OFF;

   FROM DataLink IMPORT
      FlushUART, SendPacket, ReceivePacket;

   FROM SYSTEM IMPORT
      BYTE;

   IMPORT ASCII;


   CONST
      myMAXL = 94;
      myTIME = 10;
      myNPAD = 0;
      myPADC = 0C;
      myEOL  = 0C;
      myQCTL = '#';
      myQBIN = '&';
      myCHKT = '1';     (* one character checksum *)
      MAXtrys = 5;
      (* From DEFINITION MODULE:
      PAD_Quit = 0;  *)
      PAD_SendPacket = 1;
      PAD_ResendPacket = 2;
      PAD_NoSuchFile = 3;
      PAD_ExcessiveErrors = 4;
      PAD_ProbClSrcFile = 5;
      PAD_ReceivedPacket = 6;
      PAD_Filename = 7;
      PAD_RequestRepeat = 8;
      PAD_DuplicatePacket = 9;
      PAD_UnableToOpen = 10;
      PAD_ProbClDestFile = 11;
      PAD_ErrWrtFile = 12;
      PAD_Msg = 13;


   TYPE
      (* From Definition Module:
      PacketType = ARRAY [1..100] OF CHAR;
      *)
      SMALLSET = SET OF [0..7];   (* a byte *)


   VAR
      yourMAXL : INTEGER;   (* maximum packet length -- up to 94 *)
      yourTIME : INTEGER;   (* time out -- seconds *)
      (* From Definition Module
      yourNPAD : INTEGER;   (* number of padding characters *)
      yourPADC : CHAR;   (* padding characters *)
      yourEOL  : CHAR;   (* End Of Line -- terminator *)
      *)
      yourQCTL : CHAR;   (* character for quoting controls '#' *)
      yourQBIN : CHAR;   (* character for quoting binary '&' *)
      yourCHKT : CHAR;   (* check type -- 1 = checksum, etc. *)
      sF, rF : File;   (* files being sent/received *)
      InputFileOpen : BOOLEAN;
      rFname : ARRAY [0..20] OF CHAR;
      sP, rP : PacketType;   (* packets sent/received *)
      sSeq, rSeq : INTEGER;   (* sequence numbers *)
      PktNbr : INTEGER;   (* actual packet number -- no repeats up to 32,000 *)
      ErrorMsg : ARRAY [0..40] OF CHAR;
      MP1, MP2 : MPARAM;


   PROCEDURE PtrToStr (mp [VALUE] : MPARAM; VAR s : ARRAY OF CHAR);
   (* Convert a pointer to a string into a string *)

      TYPE
         PC = POINTER TO CHAR;

      VAR
         p : PC;
         i : CARDINAL;
         c : CHAR;

      BEGIN
         i := 0;
         REPEAT
            p := PC (mp);
            c := p^;
            s[i] := c;
            INC (i);
            INC (mp.L);
         UNTIL c = 0C;
      END PtrToStr;


   PROCEDURE DoPADMsg (mp1, mp2 [VALUE] : MPARAM);
   (* Output messages for Packet Assembler/Disassembler *)

      VAR
         Message : ARRAY [0..40] OF CHAR;

      BEGIN
         CASE CARDINAL (mp1.W1) OF
            PAD_SendPacket:
               WriteString ("Sent Packet #");
               WriteInt (mp2.W1, 5);
               WriteString ("  (ID: ");   WriteHex (mp2.W2, 2);
               WriteString ("h)");
         |  PAD_ResendPacket:
               WriteString ("ERROR -- Resending:");   WriteLn;
               WriteString ("     Packet #");
               WriteInt (mp2.W1, 5);
               WriteString ("  (ID: ");   WriteHex (mp2.W2, 2);
               WriteString ("h)");
         |  PAD_NoSuchFile:
               WriteString ("No such file: ");
               PtrToStr (mp2, Message);   WriteString (Message);
         |  PAD_ExcessiveErrors:
               WriteString ("Excessive errors ...");
         |  PAD_ProbClSrcFile:
               WriteString ("Problem closing source file...");
         |  PAD_ReceivedPacket:
               WriteString ("Received Packet #");
               WriteInt (mp2.W1, 5);
               WriteString ("  (ID: ");   WriteHex (mp2.W2, 2);
               WriteString ("h)");
         |  PAD_Filename:
               WriteString ("Filename = ");
               PtrToStr (mp2, Message);   WriteString (Message);
         |  PAD_RequestRepeat:
               WriteString ("ERROR -- Requesting Repeat:");   WriteLn;
               WriteString ("         Packet #");
               WriteInt (mp2.W1, 5);
               WriteString ("  (ID: ");   WriteHex (mp2.W2, 2);
               WriteString ("h)");
         |  PAD_DuplicatePacket:
               WriteString ("Discarding Duplicate:");   WriteLn;
               WriteString ("         Packet #");
               WriteString ("  (ID: ");   WriteHex (mp2.W2, 2);
               WriteString ("h)");
         |  PAD_UnableToOpen:
               WriteString ("Unable to open file: ");
               PtrToStr (mp2, Message);   WriteString (Message);
         |  PAD_ProbClDestFile:
               WriteString ("Error closing file: ");
               PtrToStr (mp2, Message);   WriteString (Message);
         |  PAD_ErrWrtFile:
               WriteString ("Error writing to file: ");
               PtrToStr (mp2, Message);   WriteString (Message);
         |  PAD_Msg:
               PtrToStr (mp2, Message);   WriteString (Message);
         ELSE
            (* Do Nothing *)
         END;
         WriteLn;
      END DoPADMsg;


   PROCEDURE CloseInput;
   (* Close the input file, if it exists.  Reset Input File Open flag *)
      BEGIN
         IF InputFileOpen THEN
            IF CloseFile (sF, Input) = Done THEN
               InputFileOpen := FALSE;
            ELSE
               MP1.W1 := PAD_ProbClSrcFile;   MP1.W2 := 0;
               MP2.L := LONGINT (ADR (sFname));
               WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
            END;
         END;
      END CloseInput;


   PROCEDURE NormalQuit;
   (* Exit from Thread, Post message to Window *)
      BEGIN
         MP1.W1 := PAD_Quit;   MP1.W2 := 0;
         MP1.L := 0;
         WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
         DosExit (EXIT_THREAD, 0);
      END NormalQuit;


   PROCEDURE ErrorQuit;
   (* Exit from Thread, Post message to Window *)
      BEGIN
         MP1.W1 := PAD_Error;   MP1.W2 := 0;
         MP2.L := 0;
         WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
         DosExit (EXIT_THREAD, 0);
      END ErrorQuit;


   PROCEDURE ByteXor (a, b : BYTE) : BYTE;
      BEGIN
         RETURN BYTE (SMALLSET (a) / SMALLSET (b));
      END ByteXor;


   PROCEDURE Char (c : INTEGER) : CHAR;
   (* converts a number 0-94 into a printable character *)
      BEGIN
         RETURN (CHR (CARDINAL (ABS (c) + 32)));
      END Char;


   PROCEDURE UnChar (c : CHAR) : INTEGER;
   (* converts a character into its corresponding number *)
      BEGIN
         RETURN (ABS (INTEGER (ORD (c)) - 32));
      END UnChar;


   PROCEDURE TellError (Seq : INTEGER);
   (* Send error packet *)
      BEGIN
         sP[1] := Char (15);
         sP[2] := Char (Seq);
         sP[3] := 'E';   (* E-type packet *)
         sP[4] := 'R';   (* error message starts *)
         sP[5] := 'e';
         sP[6] := 'm';
         sP[7] := 'o';
         sP[8] := 't';
         sP[9] := 'e';
         sP[10] := ' ';
         sP[11] := 'A';
         sP[12] := 'b';
         sP[13] := 'o';
         sP[14] := 'r';
         sP[15] := 't';
         sP[16] := 0C;
         SendPacket (sP);
      END TellError;


   PROCEDURE ShowError (p : PacketType);
   (* Output contents of error packet to the screen *)

      VAR
         i : INTEGER;

      BEGIN
         FOR i := 4 TO UnChar (p[1]) DO
            ErrorMsg[i - 4] := p[i];
         END;
         ErrorMsg[i - 4] := 0C;
         MP1.W1 := PAD_Msg;   MP1.W2 := 0;
         MP2.L := LONGINT (ADR (ErrorMsg));
         WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
      END ShowError;


   PROCEDURE youInit (type : CHAR);
   (* I initialization YOU for Send and Receive *)
      BEGIN
         sP[1] := Char (11);   (* Length *)
         sP[2] := Char (0);   (* Sequence *)
         sP[3] := type;
         sP[4] := Char (myMAXL);
         sP[5] := Char (myTIME);
         sP[6] := Char (myNPAD);
         sP[7] := CHAR (ByteXor (myPADC, 100C));
         sP[8] := Char (ORD (myEOL));
         sP[9] := myQCTL;
         sP[10] := myQBIN;
         sP[11] := myCHKT;
         sP[12] := 0C;   (* terminator *)
         SendPacket (sP);
      END youInit;


   PROCEDURE myInit;
   (* YOU initialize ME for Send and Receive *)

      VAR
         len : INTEGER;

      BEGIN
         len := UnChar (rP[1]);
         IF len >= 4 THEN
            yourMAXL := UnChar (rP[4]);
         ELSE
            yourMAXL := 94;
         END;
         IF len >= 5 THEN
            yourTIME := UnChar (rP[5]);
         ELSE
            yourTIME := 10;
         END;
         IF len >= 6 THEN
            yourNPAD := UnChar (rP[6]);
         ELSE
            yourNPAD := 0;
         END;
         IF len >= 7 THEN
            yourPADC := CHAR (ByteXor (rP[7], 100C));
         ELSE
            yourPADC := 0C;
         END;
         IF len >= 8 THEN
            yourEOL := CHR (UnChar (rP[8]));
         ELSE
            yourEOL := 0C;
         END;
         IF len >= 9 THEN
            yourQCTL := rP[9];
         ELSE
            yourQCTL := 0C;
         END;
         IF len >= 10 THEN
            yourQBIN := rP[10];
         ELSE
            yourQBIN := 0C;
         END;
         IF len >= 11 THEN
            yourCHKT := rP[11];
            IF yourCHKT # myCHKT THEN
               yourCHKT := '1';
            END;
         ELSE
            yourCHKT := '1';
         END;
      END myInit;


   PROCEDURE SendInit;
      BEGIN
         youInit ('S');
      END SendInit;


   PROCEDURE SendFileName;

      VAR
         i, j : INTEGER;

      BEGIN
         (* send file name *)
         i := 4;   j := 0;
         WHILE sFname[j] # 0C DO
            sP[i] := sFname[j];
            INC (i);   INC (j);
         END;
         sP[1] := Char (j + 3);
         sP[2] := Char (sSeq);
         sP[3] := 'F';   (* filename packet *)
         sP[i] := 0C;
         SendPacket (sP);
      END SendFileName;


   PROCEDURE SendEOF;
      BEGIN
         sP[1] := Char (3);
         sP[2] := Char (sSeq);
         sP[3] := 'Z';   (* end of file *)
         sP[4] := 0C;
         SendPacket (sP);
      END SendEOF;


   PROCEDURE SendEOT;
      BEGIN
         sP[1] := Char (3);
         sP[2] := Char (sSeq);
         sP[3] := 'B';   (* break -- end of transmit *)
         sP[4] := 0C;
         SendPacket (sP);
      END SendEOT;


   PROCEDURE GetAck() : BOOLEAN;
   (* Look for acknowledgement -- retry on timeouts or NAKs *)

      VAR
         Type : CHAR;
         Seq : INTEGER;
         retrys : INTEGER;
         AckOK : BOOLEAN;

      BEGIN
         MP1.W1 := PAD_SendPacket;   MP1.W2 := 0;
         MP2.W1 := PktNbr;   MP2.W2 := sSeq;
         WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);

         retrys := MAXtrys;
         LOOP
            IF Aborted THEN
               TellError (sSeq);
               CloseInput;
               ErrorQuit;
            END;
            IF ReceivePacket (rP) THEN
               Seq := UnChar (rP[2]);
               Type := rP[3];
               IF (Seq = sSeq) AND (Type = 'Y') THEN
                  AckOK := TRUE;
               ELSIF (Seq = (sSeq + 1) MOD 64) AND (Type = 'N') THEN
                  AckOK := TRUE;   (* NAK for (n + 1) taken as ACK for n *)
               ELSIF Type = 'E' THEN
                  ShowError (rP);
                  AckOK := FALSE;
                  retrys := 0;
               ELSE
                  AckOK := FALSE;
               END;
            ELSE
               AckOK := FALSE;
            END;
            IF AckOK OR (retrys = 0) THEN
               EXIT;
            ELSE
               MP1.W1 := PAD_ResendPacket;   MP1.W2 := 0;
               MP2.W1 := PktNbr;   MP2.W2 := sSeq;
               WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);

               DEC (retrys);
               FlushUART;
               SendPacket (sP);
            END;
         END;

         IF AckOK THEN
            INC (PktNbr);
            sSeq := (sSeq + 1) MOD 64;
            RETURN TRUE;
         ELSE
            RETURN FALSE;
         END;
      END GetAck;


   PROCEDURE GetInitAck() : BOOLEAN;
   (* configuration for remote station *)
      BEGIN
         IF GetAck() THEN
            myInit;
            RETURN TRUE;
         ELSE
            RETURN FALSE;
         END;
      END GetInitAck;


   PROCEDURE Send;
   (* Send one or more files: sFname may be ambiguous *)

      TYPE
         LP = POINTER TO LIST;   (* list of filenames *)
         LIST = RECORD
                   fn : ARRAY [0..20] OF CHAR;
                   next : LP;
                END;

      VAR
         gotFN : BOOLEAN;
         attr : AttributeSet;
         ent : DirectoryEntry;
         front, back, t : LP;   (* add at back of queue, remove from front *)

      BEGIN
         Aborted := FALSE;
         InputFileOpen := FALSE;

         front := NIL;   back := NIL;
         attr := AttributeSet {};   (* normal files only *)
         IF Length (sFname) = 0 THEN
            MP1.W1 := PAD_Msg;   MP1.W2 := 0;
            MP2.L := LONGINT (ADR ("No file specified..."));
            WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
            ErrorQuit;
         ELSE
            gotFN := FindFirst (sFname, attr, ent);
            WHILE gotFN DO   (* build up a list of file names *)
               ALLOCATE (t, SIZE (LIST));
               Assign (ent.name, t^.fn);
               t^.next := NIL;
               IF front = NIL THEN
                  front := t;   (* start from empty queue *)
               ELSE
                  back^.next := t;   (* and to back of queue *)
               END;
               back := t;
               gotFN := FindNext (ent);
            END;
         END;

         IF front = NIL THEN
            MP1.W1 := PAD_NoSuchFile;   MP1.W2 := 0;
            MP2.L := LONGINT (ADR (sFname));
            WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
            ErrorQuit;
         ELSE
            sSeq := 0;   PktNbr := 0;
            FlushUART;
            SendInit;   (* my configuration information *)
            IF NOT GetInitAck() THEN     (* get your configuration information *)
               MP1.W1 := PAD_ExcessiveErrors;   MP1.W2 := 0;
               MP2.L := 0;
               WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
               ErrorQuit;
            END;

            WHILE front # NIL DO   (* send the files *)
               Assign (front^.fn, sFname);
               PktNbr := 1;
               Send1;
               t := front;
               front := front^.next;
               DEALLOCATE (t, SIZE (LIST));
            END;
         END;

         SendEOT;
         IF NOT GetAck() THEN
            MP1.W1 := PAD_ExcessiveErrors;   MP1.W2 := 0;
            MP2.L := 0;
            WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
            CloseInput;
            ErrorQuit;
         END;
         NormalQuit;
      END Send;


   PROCEDURE Send1;
   (* Send one file: sFname *)

      VAR
         ch : CHAR;
         i : INTEGER;

      BEGIN
         IF Open (sF, sFname) = Done THEN
            InputFileOpen := TRUE;
         ELSE;
            MP1.W1 := PAD_NoSuchFile;   MP1.W2 := 0;
            MP2.L := LONGINT (ADR (sFname));
            WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
            ErrorQuit;
         END;

         MP1.W1 := PAD_Filename;   MP1.W2 := 0;
         MP2.L := LONGINT (ADR (sFname));
         WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
         MP1.W1 := PAD_Msg;   MP1.W2 := 0;
         MP2.L := LONGINT (ADR ("(<ESC> to abort file transfer.)"));
         WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);

         SendFileName;
         IF NOT GetAck() THEN
            MP1.W1 := PAD_ExcessiveErrors;   MP1.W2 := 0;
            MP2.L := 0;
            WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
            CloseInput;
            ErrorQuit;
         END;

         (* send file *)
         i := 4;
         LOOP
            IF Get (sF, ch) = EOF THEN   (* send current packet & terminate *)
               sP[1] := Char (i - 1);
               sP[2] := Char (sSeq);
               sP[3] := 'D';   (* data packet *)
               sP[i] := 0C;   (* indicate end of packet *)
               SendPacket (sP);
               IF NOT GetAck() THEN
                  MP1.W1 := PAD_ExcessiveErrors;   MP1.W2 := 0;
                  MP2.L := 0;
                  WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
                  CloseInput;
                  ErrorQuit;
               END;
               SendEOF;
               IF NOT GetAck() THEN
                  MP1.W1 := PAD_ExcessiveErrors;   MP1.W2 := 0;
                  MP2.L := 0;
                  WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
                  CloseInput;
                  ErrorQuit;
               END;
               EXIT;
            END;

            IF i >= (yourMAXL - 4) THEN   (* send current packet *)
               sP[1] := Char (i - 1);
               sP[2] := Char (sSeq);
               sP[3] := 'D';
               sP[i] := 0C;
               SendPacket (sP);
               IF NOT GetAck() THEN
                  MP1.W1 := PAD_ExcessiveErrors;   MP1.W2 := 0;
                  MP2.L := 0;
                  WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
                  CloseInput;
                  ErrorQuit;
               END;
               i := 4;
            END;

            (* add character to current packet -- update count *)
            IF ch > 177C THEN   (* must be quoted (QBIN) and altered *)
               (* toggle bit 7 to turn it off *)
               ch := CHAR (ByteXor (ch, 200C));
               sP[i] := myQBIN;   INC (i);
            END;
            IF (ch < 40C) OR (ch = 177C) THEN   (* quote (QCTL) and alter *)
               (* toggle bit 6 to turn it on *)
               ch := CHAR (ByteXor (ch, 100C));
               sP[i] := myQCTL;   INC (i);
            END;
            IF (ch = myQCTL) OR (ch = myQBIN) THEN   (* must send it quoted *)
               sP[i] := myQCTL;   INC (i);
            END;
            sP[i] := ch;   INC (i);
         END;   (* loop *)

         CloseInput;
      END Send1;


   PROCEDURE ReceiveInit() : BOOLEAN;
   (* receive my initialization information from you *)

      VAR
         RecOK : BOOLEAN;
         trys : INTEGER;

      BEGIN
         trys := 1;
         LOOP
            IF Aborted THEN
               TellError (rSeq);
               ErrorQuit;
            END;
            RecOK := ReceivePacket (rP) AND (rP[3] = 'S');
            IF RecOK OR (trys = MAXtrys) THEN
               EXIT;
            ELSE
               INC (trys);
               SendNak;
            END;
         END;

         IF RecOK THEN
            myInit;
            RETURN TRUE;
         ELSE
            RETURN FALSE;
         END;
      END ReceiveInit;


   PROCEDURE SendInitAck;
   (* acknowledge your initialization of ME and send mine for YOU *)
      BEGIN
         MP1.W1 := PAD_ReceivedPacket;   MP1.W2 := 0;
         MP2.W1 := PktNbr;   MP2.W2 := rSeq;
         WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
         INC (PktNbr);
         rSeq := (rSeq + 1) MOD 64;
         youInit ('Y');
      END SendInitAck;


   PROCEDURE ValidFileChar (VAR ch : CHAR) : BOOLEAN;
   (* checks if character is one of 'A'..'Z', '0'..'9', makes upper case *)
      BEGIN
         ch := CAP (ch);
         RETURN ((ch >= 'A') AND (ch <= 'Z')) OR ((ch >= '0') AND (ch <= '9'));
      END ValidFileChar;


   TYPE
      HeaderType = (name, eot, fail);

   PROCEDURE ReceiveHeader() : HeaderType;
   (* receive the filename -- alter for local conditions, if necessary *)

      VAR
         i, j, k : INTEGER;
         RecOK : BOOLEAN;
         trys : INTEGER;

      BEGIN
         trys := 1;
         LOOP
            IF Aborted THEN
               TellError (rSeq);
               ErrorQuit;
            END;
            RecOK := ReceivePacket (rP) AND ((rP[3] = 'F') OR (rP[3] = 'B'));
            IF trys = MAXtrys THEN
               RETURN fail;
            ELSIF RecOK AND (rP[3] = 'F') THEN
               i := 4;   (* data starts here *)
               j := 0;   (* beginning of filename string *)
               WHILE (ValidFileChar (rP[i])) AND (j < 8) DO
                  rFname[j] := rP[i];
                  INC (i);   INC (j);
               END;
               REPEAT
                  INC (i);
               UNTIL (ValidFileChar (rP[i])) OR (rP[i] = 0C);
               rFname[j] := '.';   INC (j);
               k := 0;
               WHILE (ValidFileChar (rP[i])) AND (k < 3) DO
                  rFname[j + k] := rP[i];
                  INC (i);   INC (k);
               END;
               rFname[j + k] := 0C;
               MP1.W1 := PAD_Filename;   MP1.W2 := 0;
               MP2.L := LONGINT (ADR (rFname));
               WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
               RETURN name;
            ELSIF RecOK AND (rP[3] = 'B') THEN
               RETURN eot;
            ELSE
               INC (trys);
               SendNak;
            END;
         END;
      END ReceiveHeader;


   PROCEDURE SendNak;
      BEGIN
         MP1.W1 := PAD_RequestRepeat;   MP1.W2 := 0;
         MP2.W1 := PktNbr;   MP2.W2 := rSeq;
         WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
         FlushUART;
         sP[1] := Char (3);   (* LEN *)
         sP[2] := Char (rSeq);
         sP[3] := 'N';   (* negative acknowledgement *)
         sP[4] := 0C;
         SendPacket (sP);
      END SendNak;


   PROCEDURE SendAck (Seq : INTEGER);
      BEGIN
         IF Seq # rSeq THEN
            MP1.W1 := PAD_DuplicatePacket;   MP1.W2 := 0;
            MP2.W1 := 0;   MP2.W2 := rSeq;
            WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
         ELSE
            MP1.W1 := PAD_ReceivedPacket;   MP1.W2 := 0;
            MP2.W1 := PktNbr;   MP2.W2 := rSeq;
            WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
            rSeq := (rSeq + 1) MOD 64;
            INC (PktNbr);
         END;

         sP[1] := Char (3);
         sP[2] := Char (Seq);
         sP[3] := 'Y';   (* acknowledgement *)
         sP[4] := 0C;
         SendPacket (sP);
      END SendAck;


   PROCEDURE Receive;
   (* Receives a file  (or files) *)

      VAR
         ch, Type : CHAR;
         Seq : INTEGER;
         i : INTEGER;
         EOF, EOT, QBIN : BOOLEAN;
         trys : INTEGER;

      BEGIN
         Aborted := FALSE;

         MP1.W1 := PAD_Msg;   MP1.W2 := 0;
         MP2.L := LONGINT (ADR ("Ready to receive file(s)..."));
         WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
         MP1.W1 := PAD_Msg;   MP1.W2 := 0;
         MP2.L := LONGINT (ADR ("(<ESC> to abort file transfer.)"));
         WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);

         FlushUART;
         rSeq := 0;   PktNbr := 0;
         IF NOT ReceiveInit() THEN   (* your configuration information *)
            MP1.W1 := PAD_ExcessiveErrors;   MP1.W2 := 0;
            MP2.L := 0;
            WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
            ErrorQuit;
         END;
         SendInitAck;       (* send my configuration information *)
         EOT := FALSE;
         WHILE NOT EOT DO
            CASE ReceiveHeader() OF
               eot  : EOT := TRUE;   EOF := TRUE;
            |  name : IF Create (rF, rFname) # Done THEN
                         MP1.W1 := PAD_UnableToOpen;   MP1.W2 := 0;
                         MP2.L := LONGINT (ADR (rFname));
                         WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
                         ErrorQuit;
                      ELSE
                         PktNbr := 1;
                         EOF := FALSE;
                      END;
            |  fail : MP1.W1 := PAD_ExcessiveErrors;   MP1.W2 := 0;
                      MP2.L := 0;
                      WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
                      ErrorQuit;
            END;
            SendAck (rSeq);   (* acknowledge for name or eot *)
            trys := 1;   (* initialize *)
            WHILE NOT EOF DO
               IF Aborted THEN
                  TellError (rSeq);
                  ErrorQuit;
               END;
               IF ReceivePacket (rP) THEN
                  Seq := UnChar (rP[2]);
                  Type := rP[3];
                  IF Type = 'Z' THEN
                     EOF := TRUE;
                     IF CloseFile (rF, Output) = Done THEN
                        (* normal file termination *)
                     ELSE
                        MP1.W1 := PAD_ProbClDestFile;   MP1.W2 := 0;
                        MP2.L := LONGINT (ADR (rFname));
                        WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
                        ErrorQuit;
                     END;
                     trys := 1;   (* good packet -- reset *)
                     SendAck (rSeq);
                  ELSIF Type = 'E' THEN
                     ShowError (rP);
                     ErrorQuit;
                  ELSIF (Type = 'D') AND ((Seq + 1) MOD 64 = rSeq) THEN
                  (* discard duplicate packet, and Ack anyway *)
                     trys := 1;
                     SendAck (Seq);
                  ELSIF (Type = 'D') AND (Seq = rSeq) THEN
                     (* put packet into file buffer *)
                     i := 4;   (* first data in packet *)
                     WHILE rP[i] # 0C DO
                        ch := rP[i];   INC (i);
                        IF ch = yourQBIN THEN
                           ch := rP[i];   INC (i);
                           QBIN := TRUE;
                        ELSE
                           QBIN := FALSE;
                        END;
                        IF ch = yourQCTL THEN
                           ch := rP[i];   INC (i);
                           IF (ch # yourQCTL) AND (ch # yourQBIN) THEN
                              ch := CHAR (ByteXor (ch, 100C));
                           END;
                        END;
                        IF QBIN THEN
                           ch := CHAR (ByteXor (ch, 200C));
                        END;
                        Put (ch);
                     END;

                     (* write file buffer to disk *)
                     IF DoWrite (rF) # Done THEN
                        MP1.W1 := PAD_ErrWrtFile;   MP1.W2 := 0;
                        MP2.L := LONGINT (ADR (rFname));
                        WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
                        ErrorQuit;
                     END;
                     trys := 1;
                     SendAck (rSeq);
                  ELSE
                     INC (trys);
                     IF trys = MAXtrys THEN
                        MP1.W1 := PAD_ExcessiveErrors;   MP1.W2 := 0;
                        MP2.L := 0;
                        WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
                        ErrorQuit;
                     ELSE
                        SendNak;
                     END;
                  END;
               ELSE
                  INC (trys);
                  IF trys = MAXtrys THEN
                     MP1.W1 := PAD_ExcessiveErrors;   MP1.W2 := 0;
                     MP2.L := 0;
                     WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
                     ErrorQuit;
                  ELSE
                     SendNak;
                  END;
               END;
            END;
         END;
         NormalQuit;
      END Receive;


BEGIN   (* module initialization *)
   yourEOL := ASCII.cr;
   yourNPAD := 0;
   yourPADC := 0C;
END PAD.
<<< PCKERMIT >>>
KH.SYM: KH.DEF
    M2 KH.DEF/OUT:KH.SYM
KH.OBJ: KH.MOD KH.SYM
    M2 KH.MOD/OUT:KH.OBJ
SHELL.SYM: SHELL.DEF
    M2 SHELL.DEF/OUT:SHELL.SYM
TERM.SYM: TERM.DEF
    M2 TERM.DEF/OUT:TERM.SYM
PAD.SYM: PAD.DEF
    M2 PAD.DEF/OUT:PAD.SYM
DATALINK.SYM: DATALINK.DEF PAD.SYM
    M2 DATALINK.DEF/OUT:DATALINK.SYM
COMMPORT.SYM: COMMPORT.DEF
    M2 COMMPORT.DEF/OUT:COMMPORT.SYM
FILES.SYM: FILES.DEF
    M2 FILES.DEF/OUT:FILES.SYM
pckermit.OBJ: pckermit.MOD SHELL.SYM KH.SYM
    M2 pckermit.MOD/OUT:pckermit.OBJ
SCREEN.SYM: SCREEN.DEF
    M2 SCREEN.DEF/OUT:SCREEN.SYM
SCREEN.OBJ: SCREEN.MOD KH.SYM SCREEN.SYM
    M2 SCREEN.MOD/OUT:SCREEN.OBJ
COMMPORT.OBJ: COMMPORT.MOD COMMPORT.SYM
    M2 COMMPORT.MOD/OUT:COMMPORT.OBJ
FILES.OBJ: FILES.MOD FILES.SYM
    M2 FILES.MOD/OUT:FILES.OBJ
SHELL.OBJ: SHELL.MOD COMMPORT.SYM KH.SYM SCREEN.SYM DATALINK.SYM PAD.SYM -
TERM.SYM SHELL.SYM
    M2 SHELL.MOD/OUT:SHELL.OBJ
TERM.OBJ: TERM.MOD COMMPORT.SYM KH.SYM SHELL.SYM SCREEN.SYM TERM.SYM
    M2 TERM.MOD/OUT:TERM.OBJ
PAD.OBJ: PAD.MOD DATALINK.SYM KH.SYM SHELL.SYM FILES.SYM SCREEN.SYM PAD.SYM
    M2 PAD.MOD/OUT:PAD.OBJ
DATALINK.OBJ: DATALINK.MOD KH.SYM PAD.SYM COMMPORT.SYM SHELL.SYM SCREEN.SYM -
DATALINK.SYM
    M2 DATALINK.MOD/OUT:DATALINK.OBJ
pckermit.res: pckermit.rc pckermit.h pckermit.ico
    rc -r pckermit.rc
pckermit.EXE: KH.OBJ pckermit.OBJ SCREEN.OBJ COMMPORT.OBJ FILES.OBJ SHELL.OBJ -
TERM.OBJ PAD.OBJ DATALINK.OBJ
    LINK @pckermit.LNK
    rc pckermit.res
pckermit.exe: pckermit.res
    rc pckermit.res
<<< PCKERMIT.EDF >>>
NAME PCKermit WINDOWAPI
DESCRIPTION 'PCKermit: (c) Brian R. Anderson, 1990'
HEAPSIZE 16384
STACKSIZE 8192
PROTMODE
EXETYPE OS2
CODE LOADONCALL EXECUTEREAD NOIOPL NONCONFORMING
DATA LOADONCALL READWRITE MULTIPLE NONSHARED NOIOPL
EXPORTS
    WindowProc
    ChildWindowProc
    ComDlgProc
    BaudDlgProc
    DataDlgProc
    StopDlgProc
    ParityDlgProc
    AboutDlgProc
    SendFNDlgProc
    PathDlgProc
    DirEndDlgProc
    HelpDlgProc
<<< PCKERMIT.H >>>
#define IDM_KERMIT     50
#define IDM_FILE       51
#define IDM_OPTIONS    52
#define IDM_HELP       0
#define IDM_DIR        1
#define IDM_CONNECT    2
#define IDM_SEND       3
#define IDM_REC        4
#define IDM_QUIT       5
#define IDM_COMPORT    6
#define IDM_BAUDRATE   7
#define IDM_DATABITS   8
#define IDM_STOPBITS   9
#define IDM_PARITY     10
#define IDM_ABOUT      11
#define IDM_HELPMENU   12
#define IDM_TERMHELP   13
#define IDM_SENDFN     14
#define IDM_DIRPATH    15
#define ID_SENDFN      16
#define ID_DIRPATH     17
#define IDM_DIREND     18
#define IDM_COLORS     19
#define IDM_WHITE      20
#define IDM_GREEN      21
#define IDM_AMBER      22
#define IDM_C1         23
#define IDM_C2         24
#define ID_OK          25
#define ID_COM1        100
#define ID_COM2        101
#define ID_B110        120
#define ID_B150        121
#define ID_B300        122
#define ID_B600        123
#define ID_B1200       124
#define ID_B2400       125
#define ID_B4800       126
#define ID_B9600       127
#define ID_B19K2       128
#define ID_DATA7       137
#define ID_DATA8       138
#define ID_STOP1       141
#define ID_STOP2       142
#define ID_EVEN        150
#define ID_ODD         151
#define ID_NONE        152
<<< PCKERMIT.LNK >>>
KH.OBJ+
pckermit.OBJ+
SCREEN.OBJ+
COMMPORT.OBJ+
FILES.OBJ+
SHELL.OBJ+
TERM.OBJ+
PAD.OBJ+
DATALINK.OBJ
pckermit
pckermit
PM+
OS2+
M2LIB+
DOSCALLS
pckermit.edf
<<< PCKERMIT.MOD >>>
MODULE PCKermit;
(**************************************************************************)
(*                                                                        *)
(*                  PCKermit  --  by Brian R. Anderson                    *)
(*                         Copyright (c) 1990                             *)
(*                                                                        *)
(*  PCKermit is an implementation of the Kermit file transfer protocol    *)
(*  developed at Columbia University.  This (OS/2 PM) version is a        *)
(*  port from the DOS version of Kermit that I wrote two years ago.       *)
(*  My original DOS version appeared in the May 1989 issue of DDJ.        *)
(*                                                                        *)
(*  The current version includes emulation of the TVI950 Video Display    *)
(*  Terminal for interaction with IBM mainframes (through the IBM 7171).  *)
(*                                                                        *)
(**************************************************************************)

   FROM SYSTEM IMPORT
      ADR;

   FROM OS2DEF IMPORT
      HAB, HWND, HPS, NULL, ULONG;

   FROM PMWIN IMPORT
      MPARAM, HMQ, QMSG, CS_SIZEREDRAW,  WS_VISIBLE, FS_ICON,
      FCF_TITLEBAR, FCF_SYSMENU, FCF_SIZEBORDER, FCF_MINMAX, FCF_ACCELTABLE,
      FCF_SHELLPOSITION, FCF_TASKLIST, FCF_MENU, FCF_ICON,
      SWP_MOVE, SWP_SIZE, SWP_MAXIMIZE,
      HWND_DESKTOP, FID_SYSMENU, SC_CLOSE, MIA_DISABLED, MM_SETITEMATTR,
      WinInitialize, WinCreateMsgQueue, WinGetMsg, WinDispatchMsg, WinSendMsg,
      WinRegisterClass, WinCreateStdWindow, WinDestroyWindow, WinWindowFromID,
      WinDestroyMsgQueue, WinTerminate, WinSetWindowText,
      WinSetWindowPos, WinQueryWindowPos;

   FROM KH IMPORT
      IDM_KERMIT;

   FROM Shell IMPORT
      Class, Title, Child, WindowProc, ChildWindowProc,
      FrameWindow, ClientWindow, SetPort, Pos;


   CONST
      QUEUE_SIZE = 1024;   (* Large message queue for async events *)

   VAR
      AnchorBlock : HAB;
      MessageQueue : HMQ;
      Message : QMSG;
      FrameFlags : ULONG;
      hsys : HWND;
      MP1, MP2 : MPARAM;


BEGIN   (* main *)
   AnchorBlock := WinInitialize(0);

   IF AnchorBlock # 0 THEN
      MessageQueue := WinCreateMsgQueue (AnchorBlock, QUEUE_SIZE);

      IF MessageQueue # 0 THEN
         (* Register the parent window class *)
         WinRegisterClass (
             AnchorBlock,
             ADR (Class),
             WindowProc,
             CS_SIZEREDRAW, 0);

         (* Register a child window class *)
         WinRegisterClass (
             AnchorBlock,
             ADR (Child),
             ChildWindowProc,
             CS_SIZEREDRAW, 0);

         (* Create a standard window *)
         FrameFlags := FCF_TITLEBAR + FCF_MENU + FCF_MINMAX +
                       FCF_SYSMENU + FCF_SIZEBORDER + FCF_TASKLIST +
                       FCF_ICON + FCF_SHELLPOSITION + FCF_ACCELTABLE;

         FrameWindow := WinCreateStdWindow (
                  HWND_DESKTOP,           (* handle of the parent window *)
                  WS_VISIBLE + FS_ICON,   (* the window style *)
                  FrameFlags,             (* the window flags *)
                  ADR(Class),             (* the window class *)
                  NULL,                   (* the title bar text *)
                  WS_VISIBLE,             (* client window style *)
                  NULL,                   (* handle of resource module *)
                  IDM_KERMIT,             (* resource id *)
                  ClientWindow            (* returned client window handle *)
         );

         IF FrameWindow # 0 THEN
            (* Disable the CLOSE item on the system menu *)
            hsys := WinWindowFromID (FrameWindow, FID_SYSMENU);
            MP1.W1 := SC_CLOSE;   MP1.W2 := 1;
            MP2.W1 := MIA_DISABLED;   MP2.W2 := MIA_DISABLED;
            WinSendMsg (hsys, MM_SETITEMATTR, MP1, MP2);

            (* Expand Window to Nearly Full Size, And Display the Title *)
            WinQueryWindowPos (HWND_DESKTOP, Pos);
            WinSetWindowPos (FrameWindow, 0,
               Pos.x + 3, Pos.y + 3, Pos.cx - 6, Pos.cy - 6,
               SWP_MOVE + SWP_SIZE);
            WinSetWindowText (FrameWindow, ADR (Title));

            SetPort;   (* Try to initialize communications port *)

            WHILE WinGetMsg(AnchorBlock, Message, NULL, 0, 0) # 0 DO
               WinDispatchMsg(AnchorBlock, Message);
            END;

            WinDestroyWindow(FrameWindow);
         END;
         WinDestroyMsgQueue(MessageQueue);
      END;
      WinTerminate(AnchorBlock);
   END;
END PCKermit.

<<< PCKERMIT.RC >>>
#include <os2.h>
#include "pckermit.h"

ICON IDM_KERMIT pckermit.ico

MENU IDM_KERMIT
   BEGIN
      SUBMENU "~File", IDM_FILE
         BEGIN
            MENUITEM "~Directory...",     IDM_DIR
            MENUITEM "~Connect\t^C",          IDM_CONNECT
            MENUITEM "~Send...\t^S",          IDM_SEND
            MENUITEM "~Receive...\t^R",       IDM_REC
            MENUITEM SEPARATOR
            MENUITEM "E~xit\t^X",             IDM_QUIT
            MENUITEM "A~bout PCKermit...",  IDM_ABOUT
         END

      SUBMENU "~Options", IDM_OPTIONS
         BEGIN
            MENUITEM "~COM port...",      IDM_COMPORT
            MENUITEM "~Baud rate...",     IDM_BAUDRATE
            MENUITEM "~Data bits...",     IDM_DATABITS
            MENUITEM "~Stop bits...",     IDM_STOPBITS
            MENUITEM "~Parity bits...",   IDM_PARITY
         END

      SUBMENU "~Colors", IDM_COLORS
         BEGIN
            MENUITEM "~White Mono",       IDM_WHITE
            MENUITEM "~Green Mono",       IDM_GREEN
            MENUITEM "~Amber Mono",       IDM_AMBER
            MENUITEM "Full Color ~1",     IDM_C1
            MENUITEM "Full Color ~2",     IDM_C2
         END

      MENUITEM "F1=Help",    IDM_HELP, MIS_HELP | MIS_BUTTONSEPARATOR
   END

ACCELTABLE IDM_KERMIT
   BEGIN
      "^C", IDM_CONNECT
      "^S", IDM_SEND
      "^R", IDM_REC
      "^X", IDM_QUIT
   END

DLGTEMPLATE IDM_COMPORT LOADONCALL MOVEABLE DISCARDABLE
BEGIN
    DIALOG "", IDM_COMPORT, 129, 91, 143, 54, FS_NOBYTEALIGN | FS_DLGBORDER |
                WS_VISIBLE | WS_CLIPSIBLINGS | WS_SAVEBITS
    BEGIN
        CONTROL "Select COM Port", IDM_COMPORT, 10, 9, 83, 38,
                WC_STATIC, SS_GROUPBOX | WS_VISIBLE
        CONTROL "COM1", ID_COM1, 30, 25, 43, 10, WC_BUTTON,
            BS_AUTORADIOBUTTON | WS_GROUP | WS_TABSTOP | WS_VISIBLE
        CONTROL "COM2", ID_COM2, 30, 15, 39, 10, WC_BUTTON,
            BS_AUTORADIOBUTTON | WS_TABSTOP | WS_VISIBLE
        CONTROL "OK", ID_OK, 101, 10, 38, 12, WC_BUTTON, BS_PUSHBUTTON |
                BS_DEFAULT | WS_GROUP | WS_TABSTOP | WS_VISIBLE
    END
END

DLGTEMPLATE IDM_BAUDRATE LOADONCALL MOVEABLE DISCARDABLE
BEGIN
    DIALOG "", IDM_BAUDRATE, 131, 54, 142, 115, FS_NOBYTEALIGN |
                FS_DLGBORDER | WS_VISIBLE | WS_CLIPSIBLINGS | WS_SAVEBITS
    BEGIN
        CONTROL "Select Baud Rate", IDM_BAUDRATE, 8, 6, 85, 107,
                WC_STATIC, SS_GROUPBOX | WS_VISIBLE
        CONTROL "110 Baud", ID_B110, 20, 90, 62, 10, WC_BUTTON,
            BS_AUTORADIOBUTTON | WS_GROUP | WS_TABSTOP | WS_VISIBLE
        CONTROL "150 Baud", ID_B150, 20, 80, 57, 10, WC_BUTTON,
            BS_AUTORADIOBUTTON | WS_TABSTOP | WS_VISIBLE
        CONTROL "300 Baud", ID_B300, 20, 70, 58, 10, WC_BUTTON,
        BS_AUTORADIOBUTTON | WS_TABSTOP | WS_VISIBLE
        CONTROL "600 Baud", ID_B600, 20, 60, 54, 10, WC_BUTTON,
        BS_AUTORADIOBUTTON | WS_TABSTOP | WS_VISIBLE
        CONTROL "1200 Baud", ID_B1200, 20, 50, 59, 10, WC_BUTTON,
        BS_AUTORADIOBUTTON | WS_TABSTOP | WS_VISIBLE
        CONTROL "2400 Baud", ID_B2400, 20, 40, 63, 10, WC_BUTTON,
        BS_AUTORADIOBUTTON | WS_TABSTOP | WS_VISIBLE
        CONTROL "4800 Baud", ID_B4800, 20, 30, 62, 10, WC_BUTTON,
        BS_AUTORADIOBUTTON | WS_TABSTOP | WS_VISIBLE
        CONTROL "9600 Baud", ID_B9600, 20, 20, 59, 10, WC_BUTTON,
        BS_AUTORADIOBUTTON | WS_TABSTOP | WS_VISIBLE
        CONTROL "19,200 Baud", ID_B19K2, 20, 10, 69, 10, WC_BUTTON,
        BS_AUTORADIOBUTTON | WS_TABSTOP | WS_VISIBLE
        CONTROL "OK", ID_OK, 100, 8, 38, 12, WC_BUTTON, BS_PUSHBUTTON |
        BS_DEFAULT | WS_GROUP | WS_TABSTOP | WS_VISIBLE
    END
END

DLGTEMPLATE IDM_DATABITS LOADONCALL MOVEABLE DISCARDABLE
BEGIN
    DIALOG "", IDM_DATABITS, 137, 80, 140, 56, FS_NOBYTEALIGN |
                FS_DLGBORDER | WS_VISIBLE | WS_SAVEBITS
    BEGIN
        CONTROL "Select Data Bits", IDM_DATABITS, 8, 11, 80, 36,
                WC_STATIC, SS_GROUPBOX | WS_VISIBLE
        CONTROL "7 Data Bits", ID_DATA7, 15, 25, 67, 10, WC_BUTTON,
        BS_AUTORADIOBUTTON | WS_GROUP | WS_TABSTOP | WS_VISIBLE
        CONTROL "8 Data Bits", ID_DATA8, 15, 15, 64, 10, WC_BUTTON,
        BS_AUTORADIOBUTTON | WS_TABSTOP | WS_VISIBLE
        CONTROL "OK", ID_OK, 96, 12, 38, 12, WC_BUTTON, BS_PUSHBUTTON |
        BS_DEFAULT | WS_GROUP | WS_TABSTOP | WS_VISIBLE
    END
END

DLGTEMPLATE IDM_STOPBITS LOADONCALL MOVEABLE DISCARDABLE
BEGIN
    DIALOG "", IDM_STOPBITS, 139, 92, 140, 43, FS_NOBYTEALIGN |
                FS_DLGBORDER | WS_VISIBLE | WS_SAVEBITS
    BEGIN
        CONTROL "Select Stop Bits", IDM_STOPBITS, 9, 6, 80, 32,
                WC_STATIC, SS_GROUPBOX | WS_VISIBLE
        CONTROL "1 Stop Bit", ID_STOP1, 20, 20, 57, 10, WC_BUTTON,
        BS_AUTORADIOBUTTON | WS_GROUP | WS_TABSTOP | WS_VISIBLE
        CONTROL "2 Stop Bits", ID_STOP2, 20, 10, 60, 10, WC_BUTTON,
        BS_AUTORADIOBUTTON | WS_TABSTOP | WS_VISIBLE
        CONTROL "OK", ID_OK, 96, 8, 38, 12, WC_BUTTON, BS_PUSHBUTTON |
        BS_DEFAULT | WS_GROUP | WS_TABSTOP | WS_VISIBLE
    END
END

DLGTEMPLATE IDM_PARITY LOADONCALL MOVEABLE DISCARDABLE
BEGIN
    DIALOG "", IDM_PARITY, 138, 84, 134, 57, FS_NOBYTEALIGN | FS_DLGBORDER |
                WS_VISIBLE | WS_SAVEBITS
    BEGIN
        CONTROL "Select Parity", IDM_PARITY, 12, 6, 64, 46, WC_STATIC,
                SS_GROUPBOX | WS_VISIBLE
        CONTROL "Even", ID_EVEN, 25, 30, 40, 10, WC_BUTTON,
        BS_AUTORADIOBUTTON | WS_GROUP | WS_TABSTOP | WS_VISIBLE
        CONTROL "Odd", ID_ODD, 25, 20, 38, 10, WC_BUTTON,
        BS_AUTORADIOBUTTON | WS_TABSTOP | WS_VISIBLE
        CONTROL "None", ID_NONE, 25, 10, 40, 10, WC_BUTTON,
        BS_AUTORADIOBUTTON | WS_TABSTOP | WS_VISIBLE
        CONTROL "OK", ID_OK, 88, 8, 38, 12, WC_BUTTON, BS_PUSHBUTTON |
        BS_DEFAULT | WS_GROUP | WS_TABSTOP | WS_VISIBLE
    END
END


DLGTEMPLATE IDM_ABOUT LOADONCALL MOVEABLE DISCARDABLE
BEGIN
    DIALOG "", IDM_ABOUT, 93, 74, 229, 88, FS_NOBYTEALIGN | FS_DLGBORDER |
                WS_VISIBLE | WS_SAVEBITS
    BEGIN
        ICON IDM_KERMIT -1, 12, 64, 22, 16
        CONTROL "PCKermit for OS/2", 256, 67, 70, 82, 8, WC_STATIC,
        SS_TEXT | DT_LEFT | DT_TOP | WS_GROUP | WS_VISIBLE
        CONTROL "Copyright (c) 1990 by Brian R. Anderson", 257, 27, 30, 172, 8,
                WC_STATIC, SS_TEXT | DT_LEFT | DT_TOP | WS_GROUP | WS_VISIBLE
        CONTROL "Microcomputer to Mainframe Communications", 259, 13, 50, 199, 8,
                WC_STATIC, SS_TEXT | DT_LEFT | DT_TOP | WS_GROUP | WS_VISIBLE
        CONTROL "  OK  ", 258, 88, 10, 38, 12, WC_BUTTON, BS_PUSHBUTTON |
                BS_DEFAULT | WS_TABSTOP | WS_VISIBLE
    END
END

DLGTEMPLATE IDM_HELPMENU LOADONCALL MOVEABLE DISCARDABLE
BEGIN
    DIALOG "", IDM_HELPMENU, 83, 45, 224, 125, FS_NOBYTEALIGN | FS_DLGBORDER |
                WS_VISIBLE | WS_CLIPSIBLINGS | WS_SAVEBITS
    BEGIN
        ICON IDM_KERMIT -1, 14, 99, 21, 16
        CONTROL "PCKermit Help Menu", 256, 64, 106, 91, 8, WC_STATIC,
                SS_TEXT | DT_LEFT | DT_TOP | WS_GROUP | WS_VISIBLE
        CONTROL "set communications Options .................. Alt, O",
                258, 10, 80, 201, 8, WC_STATIC, SS_TEXT | DT_LEFT | DT_TOP |
                WS_GROUP | WS_VISIBLE
        CONTROL "Connect to Host ................................... Alt, F; C",
                259, 10, 70, 204, 8, WC_STATIC, SS_TEXT | DT_LEFT | DT_TOP |
                WS_GROUP | WS_VISIBLE
        CONTROL "Directory .............................................. Alt, F; D",
                260, 10, 60, 207, 8, WC_STATIC, SS_TEXT | DT_LEFT | DT_TOP |
                WS_GROUP | WS_VISIBLE
        CONTROL "Send a File .......................................... Alt, F; S",
                261, 10, 50, 207, 8, WC_STATIC, SS_TEXT | DT_LEFT | DT_TOP |
                WS_GROUP | WS_VISIBLE
        CONTROL "Receive a File ...................................... Alt, F; R",
                262, 10, 40, 209, 8, WC_STATIC, SS_TEXT | DT_LEFT | DT_TOP |
                WS_GROUP | WS_VISIBLE
        CONTROL "Exit ...................................................... Alt, F; X",
                263, 10, 30, 205, 8, WC_STATIC, SS_TEXT | DT_LEFT | DT_TOP |
                WS_GROUP | WS_VISIBLE
        CONTROL "OK", 264, 83, 9, 38, 12, WC_BUTTON, BS_PUSHBUTTON |
        WS_TABSTOP | WS_VISIBLE | BS_DEFAULT
    END
END

DLGTEMPLATE IDM_TERMHELP LOADONCALL MOVEABLE DISCARDABLE
BEGIN
    DIALOG "", IDM_TERMHELP, 81, 20, 238, 177, FS_NOBYTEALIGN |
                FS_DLGBORDER | WS_VISIBLE | WS_CLIPSIBLINGS | WS_SAVEBITS
    BEGIN
        CONTROL "^E = Echo mode", 256, 10, 160, 72, 8, WC_STATIC,
                SS_TEXT | DT_LEFT | DT_TOP | WS_GROUP | WS_VISIBLE
        CONTROL "^L = Local echo mode", 257, 10, 150, 97, 8, WC_STATIC,
                SS_TEXT | DT_LEFT | DT_TOP | WS_GROUP | WS_VISIBLE
        CONTROL "^T = Terminal Mode (no echo)", 258, 10, 140, 131, 8, WC_STATIC,
                SS_TEXT | DT_LEFT | DT_TOP | WS_GROUP | WS_VISIBLE
        CONTROL "^N = Newline mode (<cr> --> <cr><lf>)", 259, 10, 130, 165, 8,
                WC_STATIC, SS_TEXT | DT_LEFT | DT_TOP | WS_GROUP | WS_VISIBLE
        CONTROL "^O = Newline mode OFF", 260, 10, 120, 109, 8, WC_STATIC,
                SS_TEXT | DT_LEFT | DT_TOP | WS_GROUP | WS_VISIBLE
        CONTROL "Televideo TVI950 / IBM 7171 Terminal Emulation", 261, 10, 100, 217, 8,
                WC_STATIC, SS_TEXT | DT_LEFT | DT_TOP | WS_GROUP | WS_VISIBLE
        CONTROL "Sh-F1 - Sh-F12   =   PF1 - PF12", 262, 10, 90, 135, 8,
                WC_STATIC, SS_TEXT | DT_LEFT | DT_TOP | WS_GROUP | WS_VISIBLE
        CONTROL "Home                 =  Clear", 263, 10, 80, 119, 8, WC_STATIC,
                SS_TEXT | DT_LEFT | DT_TOP | WS_GROUP | WS_VISIBLE
        CONTROL "PgDn                  =  Page  Down (as used in PROFS)",
                264, 10, 70, 228, 8, WC_STATIC, SS_TEXT | DT_LEFT | DT_TOP |
                WS_GROUP | WS_VISIBLE
        CONTROL "PgUp                  =  Page Up (as used in PROFS)",
                265, 10, 60, 227, 8, WC_STATIC, SS_TEXT | DT_LEFT | DT_TOP |
                WS_GROUP | WS_VISIBLE
        CONTROL "Insert                 =  Insert (Enter to Clear)", 266, 10, 40, 221, 8,
                WC_STATIC, SS_TEXT | DT_LEFT | DT_TOP | WS_GROUP | WS_VISIBLE
        CONTROL "Delete                =  Delete", 267, 10, 30, 199, 8,
                WC_STATIC, SS_TEXT | DT_LEFT | DT_TOP | WS_GROUP | WS_VISIBLE
        CONTROL "Control-G           =  Reset (rewrites the screen)",
                268, 10, 20, 222, 8,
                WC_STATIC, SS_TEXT | DT_LEFT | DT_TOP | WS_GROUP | WS_VISIBLE
        CONTROL "Cursor Keys (i.e., Up, Down, Left, Right) all work.",
                269, 10, 10, 220, 8, WC_STATIC, SS_TEXT | DT_LEFT | DT_TOP |
                WS_GROUP | WS_VISIBLE
        CONTROL "OK", 270, 193, 158, 38, 12, WC_BUTTON, BS_PUSHBUTTON |
                BS_DEFAULT | WS_TABSTOP | WS_VISIBLE
        CONTROL "End                    =  End (as used in PROFS)", 271, 10, 50, 209, 8,
                WC_STATIC, SS_TEXT | DT_LEFT | DT_TOP | WS_GROUP | WS_VISIBLE
    END
END


DLGTEMPLATE IDM_SENDFN LOADONCALL MOVEABLE DISCARDABLE
BEGIN
    DIALOG "", IDM_SENDFN, 113, 90, 202, 60, FS_NOBYTEALIGN | FS_DLGBORDER |
                WS_VISIBLE | WS_SAVEBITS
    BEGIN
        CONTROL "Send File", 256, 4, 4, 195, 24, WC_STATIC, SS_GROUPBOX |
                WS_GROUP | WS_VISIBLE
        CONTROL "Enter filename:", 257, 13, 11, 69, 8, WC_STATIC, SS_TEXT |
                DT_LEFT | DT_TOP | WS_GROUP | WS_VISIBLE
    ICON    IDM_KERMIT -1, 15, 38, 22, 16
        CONTROL "PCKermit for OS/2", 259, 59, 45, 82, 8, WC_STATIC, SS_TEXT |
                DT_LEFT | DT_TOP | WS_GROUP | WS_VISIBLE
        CONTROL "OK", 260, 154, 36, 38, 12, WC_BUTTON, BS_PUSHBUTTON |
                WS_TABSTOP | WS_VISIBLE | BS_DEFAULT
        CONTROL "", ID_SENDFN, 89, 10, 98, 8, WC_ENTRYFIELD, ES_LEFT |
        ES_MARGIN | WS_TABSTOP | WS_VISIBLE
    END
END

DLGTEMPLATE IDM_DIRPATH LOADONCALL MOVEABLE DISCARDABLE
BEGIN
    DIALOG "", IDM_DIRPATH, 83, 95, 242, 46, FS_NOBYTEALIGN | FS_DLGBORDER |
                WS_VISIBLE | WS_SAVEBITS
    BEGIN
        CONTROL "Directory", 256, 7, 5, 227, 24, WC_STATIC, SS_GROUPBOX |
                WS_GROUP | WS_VISIBLE
        CONTROL "Path:", 257, 28, 11, 26, 8, WC_STATIC, SS_TEXT | DT_LEFT |
                DT_TOP | WS_GROUP | WS_VISIBLE
        CONTROL "OK", 258, 185, 31, 38, 12, WC_BUTTON, BS_PUSHBUTTON |
                WS_TABSTOP | WS_VISIBLE | BS_DEFAULT
        CONTROL "*.*", ID_DIRPATH, 57, 11, 166, 8, WC_ENTRYFIELD, ES_LEFT |
        ES_AUTOSCROLL | ES_MARGIN | WS_TABSTOP | WS_VISIBLE
    END
END

DLGTEMPLATE IDM_DIREND LOADONCALL MOVEABLE DISCARDABLE
BEGIN
    DIALOG "", IDM_DIREND, 149, 18, 101, 27, FS_NOBYTEALIGN | FS_DLGBORDER |
                WS_VISIBLE | WS_SAVEBITS
    BEGIN
        CONTROL "Cancel", 256, 30, 2, 38, 12, WC_BUTTON, BS_PUSHBUTTON |
                BS_DEFAULT | WS_TABSTOP | WS_VISIBLE
        CONTROL "Directory Complete", 257, 9, 16, 84, 8, WC_STATIC, SS_TEXT |
                DT_LEFT | DT_TOP | WS_GROUP | WS_VISIBLE
    END
END

<<< SCREEN.DEF >>>
DEFINITION MODULE Screen;
(* Module to perform "low level" screen functions (via AVIO) *)

   FROM PMAVIO IMPORT
      HVPS;

   EXPORT QUALIFIED
      NORMAL, HIGHLIGHT, REVERSE, attribute, ColorSet, hvps,
      White, Green, Amber, Color1, Color2,
      ClrScr, ClrEol, GotoXY, GetXY,
      Right, Left, Up, Down, Write, WriteLn, WriteString,
      WriteInt, WriteHex, WriteAtt;


   VAR
      NORMAL : CARDINAL;
      HIGHLIGHT : CARDINAL;
      REVERSE : CARDINAL;
      attribute : CARDINAL;
      ColorSet : CARDINAL;
      hvps : HVPS;   (* presentation space used by screen module *)


   PROCEDURE White;
   (* Sets up colors: Monochrome White *)

   PROCEDURE Green;
   (* Sets up colors: Monochrome Green *)

   PROCEDURE Amber;
   (* Sets up colors: Monochrome Amber *)

   PROCEDURE Color1;
   (* Sets up colors: Blue, Red, Green *)

   PROCEDURE Color2;
   (* Sets up colors: Cyan Background; Black, Blue, White-on-Red *)

   PROCEDURE ClrScr;
   (* Clear the screen, and home the cursor *)

   PROCEDURE ClrEol;
   (* clear from the current cursor position to the end of the line *)

   PROCEDURE Right;
   (* move cursor to the right *)

   PROCEDURE Left;
   (* move cursor to the left *)

   PROCEDURE Up;
   (* move cursor up *)

   PROCEDURE Down;
   (* move cursor down *)

   PROCEDURE GotoXY (col, row : CARDINAL);
   (* position cursor at column, row *)

   PROCEDURE GetXY (VAR col, row : CARDINAL);
   (* determine current cursor position *)

   PROCEDURE Write (c : CHAR);
   (* Write a Character, Teletype Mode *)

   PROCEDURE WriteString (str : ARRAY OF CHAR);
   (* Write String, Teletype Mode *)

   PROCEDURE WriteInt (n : INTEGER; s : CARDINAL);
   (* Write Integer, Teletype Mode *)

   PROCEDURE WriteHex (n, s : CARDINAL);
   (* Write a Hexadecimal Number, Teletype Mode *)

   PROCEDURE WriteLn;
   (* Write <cr> <lf>, Teletype Mode *)

   PROCEDURE WriteAtt (c : CHAR);
   (* write character and attribute at cursor position *)

END Screen.

<<< SCREEN.MOD >>>
IMPLEMENTATION MODULE Screen;
(* module to perform "low level" screen functions (via AVIO) *)

   IMPORT ASCII;

   FROM SYSTEM IMPORT
      ADR;

   FROM Strings IMPORT
      Length;

   FROM Conversions IMPORT
      IntToString;

   FROM KH IMPORT
      IDM_GREEN;

   FROM Vio IMPORT
      VioSetCurPos, VioGetCurPos, VioScrollUp,
      VioWrtNCell, VioWrtTTY, VioCell;


   CONST
      GREY = 07H;
      WHITE = 0FH;
      REV_GY = 70H;
      GREEN = 02H;
      LITE_GRN = 0AH;
      REV_GRN = 20H;
      AMBER = 06H;
      LITE_AMB = 0EH;
      REV_AMB = 60H;
      RED = 0CH;
      CY_BK = 0B0H;
      CY_BL = 0B9H;
      REV_RD = 0CFH;
      REV_BL = 9FH;
      MAGENTA = 05H;


   VAR
      (* From Definition Module
      NORMAL : CARDINAL;
      HIGHLIGHT : CARDINAL;
      REVERSE : CARDINAL;
        attribute : CARDINAL;
      hvps : HVPS;
      *)
       x, y : CARDINAL;
       bCell : VioCell;


   PROCEDURE White;
   (* Sets up colors: Monochrome White *)
      BEGIN
         NORMAL := GREY;
         HIGHLIGHT := WHITE;
         REVERSE := REV_GY;
         attribute := NORMAL;
      END White;


   PROCEDURE Green;
   (* Sets up colors: Monochrome Green *)
      BEGIN
         NORMAL := GREEN;
         HIGHLIGHT := LITE_GRN;
         REVERSE := REV_GRN;
         attribute := NORMAL;
      END Green;


   PROCEDURE Amber;
   (* Sets up colors: Monochrome Amber *)
      BEGIN
         NORMAL := AMBER;
         HIGHLIGHT := LITE_AMB;
         REVERSE := REV_AMB;
         attribute := NORMAL;
      END Amber;


   PROCEDURE Color1;
   (* Sets up colors: Blue, Red, Green *)
      BEGIN
         NORMAL := GREEN;
         HIGHLIGHT := RED;
         REVERSE := REV_BL;
         attribute := NORMAL;
      END Color1;


   PROCEDURE Color2;
   (* Sets up colors: Cyan Background; Black, Blue, White-on-Red *)
      BEGIN
         NORMAL := CY_BK;
         HIGHLIGHT := CY_BL;
         REVERSE := REV_RD;
         attribute := NORMAL;
      END Color2;


   PROCEDURE HexToString (num : INTEGER;
                          size : CARDINAL;
                          VAR buf : ARRAY OF CHAR;
                          VAR I : CARDINAL;
                          VAR Done : BOOLEAN);
   (* Local Procedure to convert a number to a string, represented in HEX *)

      CONST
         ZERO = 30H;   (* ASCII code *)
         A = 41H;

      VAR
         i : CARDINAL;
         h : CARDINAL;
         t : ARRAY [0..10] OF CHAR;

      BEGIN
         i := 0;
         REPEAT
            h := num MOD 16;
            IF h <= 9 THEN
               t[i] := CHR (h + ZERO);
            ELSE
               t[i] := CHR (h - 10 + A);
            END;
            INC (i);
            num := num DIV 16;
         UNTIL num = 0;

         IF (size > HIGH (buf)) OR (i > HIGH (buf)) THEN
            Done := FALSE;
            RETURN;
         ELSE
            Done := TRUE;
         END;

         WHILE size > i DO
            buf[I] := '0';   (* pad with zeros *)
            DEC (size);
            INC (I);
         END;

         WHILE i > 0 DO
            DEC (i);
            buf[I] := t[i];
            INC (I);
         END;

         buf[I] := 0C;
      END HexToString;


   PROCEDURE ClrScr;
   (* Clear the screen, and home the cursor *)
      BEGIN
         bCell.ch := ' ';     (* space = blank screen *)
         bCell.attr := CHR (NORMAL);    (* Normal Video Attribute *)
         VioScrollUp (0, 0, 24, 79, 25, bCell, hvps);
         GotoXY (0, 0);
      END ClrScr;



   PROCEDURE ClrEol;
   (* clear from the current cursor position to the end of the line *)
      BEGIN
         GetXY (x, y);     (* current cursor position *)
         bCell.ch := ' ';    (* space = blank *)
         bCell.attr := CHR (NORMAL);   (* Normal Video Attribute *)
         VioScrollUp (y, x, y, 79, 1, bCell, hvps);
      END ClrEol;


   PROCEDURE Right;
   (* move cursor to the right *)
      BEGIN
         GetXY (x, y);
         INC (x);
         GotoXY (x, y);
      END Right;


   PROCEDURE Left;
   (* move cursor to the left *)
      BEGIN
         GetXY (x, y);
         DEC (x);
         GotoXY (x, y);
      END Left;


   PROCEDURE Up;
   (* move cursor up *)
      BEGIN
         GetXY (x, y);
         DEC (y);
         GotoXY (x, y);
      END Up;


   PROCEDURE Down;
   (* move cursor down *)
      BEGIN
         GetXY (x, y);
         INC (y);
         GotoXY (x, y);
      END Down;


   PROCEDURE GotoXY (col, row : CARDINAL);
   (* position cursor at column, row *)
      BEGIN
         IF (col <= 79) AND (row <= 24) THEN
            VioSetCurPos (row, col, hvps);
         END;
      END GotoXY;


   PROCEDURE GetXY (VAR col, row : CARDINAL);
   (* determine current cursor position *)
      BEGIN
         VioGetCurPos (row, col, hvps);
      END GetXY;


   PROCEDURE Write (c : CHAR);
   (* Write a Character *)
      BEGIN
         WriteAtt (c);
      END Write;


   PROCEDURE WriteString (str : ARRAY OF CHAR);
   (* Write String *)

      VAR
         i : CARDINAL;
         c : CHAR;

      BEGIN
         i := 0;
         c := str[i];
         WHILE c # 0C DO
            Write (c);
            INC (i);
            c := str[i];
         END;
      END WriteString;


   PROCEDURE WriteInt (n : INTEGER; s : CARDINAL);
   (* Write Integer *)

      VAR
         i : CARDINAL;
         b : BOOLEAN;
         str : ARRAY [0..6] OF CHAR;

      BEGIN
         i := 0;
         IntToString (n, s, str, i, b);
         WriteString (str);
      END WriteInt;


   PROCEDURE WriteHex (n, s : CARDINAL);
   (* Write a Hexadecimal Number *)

      VAR
         i : CARDINAL;
         b : BOOLEAN;
         str : ARRAY [0..6] OF CHAR;

      BEGIN
         i := 0;
         HexToString (n, s, str, i, b);
         WriteString (str);
      END WriteHex;


   PROCEDURE WriteLn;
   (* Write <cr> <lf> *)
      BEGIN
         Write (ASCII.cr);   Write (ASCII.lf);
      END WriteLn;


   PROCEDURE WriteAtt (c : CHAR);
   (* write character and attribute at cursor position *)

      VAR
         s : ARRAY [0..1] OF CHAR;

      BEGIN
         GetXY (x, y);
         IF (c = ASCII.ht) THEN
            bCell.ch := ' ';
            bCell.attr := CHR (attribute);
            REPEAT
               VioWrtNCell (bCell, 1, y, x, hvps);
               Right;
            UNTIL (x MOD 8) = 0;
         ELSIF (c = ASCII.cr) OR (c = ASCII.lf)
          OR (c = ASCII.bel) OR (c = ASCII.bs) THEN
            s[0] := c;    s[1] := 0C;
            VioWrtTTY (ADR (s), 1, hvps);
            IF c = ASCII.lf THEN
               ClrEol;
            END;
         ELSE
            bCell.ch := c;
            bCell.attr := CHR (attribute);
            VioWrtNCell (bCell, 1, y, x, hvps);
            Right;
         END;
      END WriteAtt;

BEGIN     (* module initialization *)
   ColorSet := IDM_GREEN;
   NORMAL := GREEN;
   HIGHLIGHT := LITE_GRN;
   REVERSE := REV_GRN;
   attribute := NORMAL;
END Screen.
<<< SHELL.DEF >>>
DEFINITION MODULE Shell;

   FROM OS2DEF IMPORT
      USHORT, HWND;

   FROM PMWIN IMPORT
      MPARAM, MRESULT, SWP;

   EXPORT QUALIFIED
      Class, Child, Title, FrameWindow, ClientWindow,
      ChildFrameWindow, ChildClientWindow, Pos, SetPort,
      WindowProc, ChildWindowProc;

   CONST
      Class = "PCKermit";
      Child ="Child";
      Title = "PCKermit -- Microcomputer to Mainframe Communications";


   VAR
      FrameWindow : HWND;
      ClientWindow : HWND;
      ChildFrameWindow : HWND;
      ChildClientWindow : HWND;
      Pos : SWP;   (* Screen Dimensions: position & size *)
      comport : CARDINAL;


   PROCEDURE SetPort;

   PROCEDURE WindowProc ['WindowProc'] (
      hwnd : HWND;
      msg  : USHORT;
      mp1  [VALUE] : MPARAM;
      mp2  [VALUE] : MPARAM) : MRESULT [LONG, WINDOWS];

   PROCEDURE ChildWindowProc ['ChildWindowProc'] (
      hwnd : HWND;
      msg  : USHORT;
      mp1  [VALUE] : MPARAM;
      mp2  [VALUE] : MPARAM) : MRESULT [LONG, WINDOWS];

END Shell.

<<< SHELL.MOD >>>
IMPLEMENTATION MODULE Shell;

   FROM SYSTEM IMPORT
      ADDRESS, ADR;

   IMPORT ASCII;

   FROM OS2DEF IMPORT
      HWND, HDC, HPS, RECTL, USHORT, NULL, ULONG;

   FROM Term IMPORT
      WM_TERM, WM_TERMQUIT,
      Dir, TermThrProc, InitTerm, PutKbdChar, PutPortChar;

   FROM PAD IMPORT
      WM_PAD, PAD_Quit, PAD_Error, DoPADMsg, Aborted, sFname, Send, Receive;

   FROM DataLink IMPORT
      WM_DL, DoDLMsg;

   FROM Screen IMPORT
      hvps, ColorSet, White, Green, Amber, Color1, Color2, ClrScr, WriteLn;

   FROM DosCalls IMPORT
      DosCreateThread, DosSuspendThread, DosResumeThread, DosSleep;

   FROM PMAVIO IMPORT
      VioCreatePS, VioAssociate, VioDestroyPS, VioShowPS, WinDefAVioWindowProc,
      FORMAT_CGA, HVPS;

   FROM PMWIN IMPORT
      MPARAM, MRESULT, SWP, PSWP,
      WS_VISIBLE, FCF_TITLEBAR, FCF_SIZEBORDER, FCF_SHELLPOSITION,
      WM_SYSCOMMAND, WM_MINMAXFRAME, SWP_MINIMIZE, HWND_DESKTOP,
      WM_PAINT, WM_QUIT, WM_COMMAND, WM_INITDLG, WM_CONTROL, WM_HELP,
      WM_INITMENU, WM_SIZE, WM_DESTROY, WM_CREATE, WM_CHAR,
      BM_SETCHECK, MBID_OK, MB_OK, MB_OKCANCEL,
      KC_CHAR, KC_CTRL, KC_VIRTUALKEY, KC_KEYUP,
      SWP_SIZE, SWP_MOVE, SWP_MAXIMIZE, SWP_RESTORE,
      MB_ICONQUESTION, MB_ICONASTERISK, MB_ICONEXCLAMATION,
      FID_MENU, MM_SETITEMATTR, MM_QUERYITEMATTR, MIA_DISABLED, MIA_CHECKED,
      WinCreateStdWindow, WinDestroyWindow,
      WinOpenWindowDC, WinSendMsg, WinQueryDlgItemText, WinInvalidateRect,
      WinDefWindowProc, WinBeginPaint, WinEndPaint, WinQueryWindowRect,
      WinSetWindowText, WinSetFocus, WinDlgBox, WinDefDlgProc, WinDismissDlg,
      WinMessageBox, WinPostMsg, WinWindowFromID, WinSendDlgItemMsg,
      WinSetWindowPos, WinSetActiveWindow;

   FROM PMGPI IMPORT
      GpiErase;

   FROM KH IMPORT
      IDM_KERMIT, IDM_FILE, IDM_OPTIONS, IDM_SENDFN, ID_SENDFN,
      IDM_DIR, IDM_CONNECT, IDM_SEND, IDM_REC, IDM_DIRPATH, ID_DIRPATH,
      IDM_DIREND, IDM_QUIT, IDM_ABOUT, IDM_HELPMENU, IDM_TERMHELP,
      IDM_COMPORT, IDM_BAUDRATE, IDM_DATABITS, IDM_STOPBITS, IDM_PARITY,
      COM_OFF, ID_COM1, ID_COM2, PARITY_OFF, ID_EVEN, ID_ODD, ID_NONE,
      DATA_OFF, ID_DATA7, ID_DATA8, STOP_OFF, ID_STOP1, ID_STOP2,
      BAUD_OFF, ID_B110, ID_B150, ID_B300, ID_B600, ID_B1200, ID_B2400,
      ID_B4800, ID_B9600, ID_B19K2,
      IDM_COLORS, IDM_WHITE, IDM_GREEN, IDM_AMBER, IDM_C1, IDM_C2;

   FROM CommPort IMPORT
      CommStatus, BaudRate, DataBits, StopBits, Parity, InitPort,
      StartReceiving, StopReceiving;

   FROM Strings IMPORT
      Assign, Append, AppendChar;


   CONST
      WM_SETMAX = 7000H;
      WM_SETFULL = 7001H;
      WM_SETRESTORE = 7002H;
      NONE = 0;   (* no port yet initialized *)
      STKSIZE = 4096;
      BUFSIZE = 4096;   (* Port receive buffers: room for two full screens *)
      PortError = "Port Is Already In Use -- EXIT? (Cancel Trys Another Port)";
      ESC = 33C;


   VAR
      FrameFlags : ULONG;
      TermStack : ARRAY [1..STKSIZE] OF CHAR;
      Stack : ARRAY [1..STKSIZE] OF CHAR;
      TermThr : CARDINAL;
      Thr : CARDINAL;
      hdc : HDC;
      frame_hvps, child_hvps : HVPS;
      TermMode : BOOLEAN;
      Path : ARRAY [0..60] OF CHAR;
      Banner : ARRAY [0..40] OF CHAR;
      PrevComPort : CARDINAL;
      Settings : ARRAY [0..1] OF RECORD
                                    baudrate : CARDINAL;
                                    databits : CARDINAL;
                                    parity : CARDINAL;
                                    stopbits : CARDINAL;
                                 END;
      MP1, MP2 : MPARAM;


   PROCEDURE SetFull;
   (* Changes window to full size *)
      BEGIN
         WinSetWindowPos (FrameWindow, 0,
            Pos.x + 3, Pos.y + 3, Pos.cx - 6, Pos.cy - 6,
            SWP_MOVE + SWP_SIZE);
      END SetFull;


   PROCEDURE SetRestore;
   (* Changes window to full size FROM maximized *)
      BEGIN
         WinSetWindowPos (FrameWindow, 0,
            Pos.x + 3, Pos.y + 3, Pos.cx - 6, Pos.cy - 6,
            SWP_MOVE + SWP_SIZE + SWP_RESTORE);
      END SetRestore;


   PROCEDURE SetMax;
   (* Changes window to maximized *)
      BEGIN
         WinSetWindowPos (FrameWindow, 0,
            Pos.x + 3, Pos.y + 3, Pos.cx - 6, Pos.cy - 6,
            SWP_MOVE + SWP_SIZE + SWP_MAXIMIZE);
      END SetMax;


   PROCEDURE SetBanner;
   (* Displays Abbreviated Program Title + Port Settings in Title Bar *)

      CONST
         PortName : ARRAY [0..1] OF ARRAY [0..5] OF CHAR =
            [["COM1:", 0C], ["COM2:", 0C]];
         BaudName : ARRAY [0..8] OF ARRAY [0..5] OF CHAR =
            [["110", 0C], ["150", 0C], ["300", 0C],
             ["600", 0C], ["1200", 0C], ["2400", 0C],
             ["4800", 0C], ["9600", 0C], ["19200", 0C]];
         ParityName : ARRAY [0..2] OF CHAR = ['E', 'O', 'N'];

      BEGIN
         WITH Settings[comport - COM_OFF] DO
            Assign (Class, Banner);
            Append (Banner, " -- ");
            Append (Banner, PortName[comport - COM_OFF]);
            Append (Banner, BaudName[baudrate - BAUD_OFF]);
            AppendChar (Banner, ',');
            AppendChar (Banner, ParityName[parity - PARITY_OFF]);
            AppendChar (Banner, ',');
            AppendChar (Banner, CHR ((databits - DATA_OFF) + 30H));
            AppendChar (Banner, ',');
            AppendChar (Banner, CHR ((stopbits - STOP_OFF) + 30H));
            WinSetWindowText (FrameWindow, ADR (Banner));
         END;
      END SetBanner;


   PROCEDURE SetPort;
   (* Sets The Communications Parameters Chosen By User *)

      VAR
         status : CommStatus;
         rc : USHORT;

      BEGIN
         IF PrevComPort # NONE THEN
            StopReceiving (PrevComPort - COM_OFF);
         END;

         WITH Settings[comport - COM_OFF] DO
            status := InitPort (
               comport - COM_OFF,
               BaudRate (baudrate - BAUD_OFF),
               DataBits (databits - DATA_OFF),
               StopBits (stopbits - STOP_OFF),
               Parity (parity - PARITY_OFF),
            );
         END;

         IF status = Success THEN
            StartReceiving (comport - COM_OFF, BUFSIZE);
            PrevComPort := comport;
         ELSE
            rc := WinMessageBox (HWND_DESKTOP, FrameWindow, ADR (PortError),
                                 0, 0, MB_OKCANCEL + MB_ICONEXCLAMATION);
            IF rc = MBID_OK THEN
               WinPostMsg (FrameWindow, WM_QUIT, MPARAM (0), MPARAM (0));
            ELSE   (* try the other port *)
               IF comport = ID_COM1 THEN
                  comport := ID_COM2;
               ELSE
                  comport := ID_COM1;
               END;
               SetPort;   (* recursive call for retry *)
            END;
         END;
         SetBanner;
      END SetPort;


   PROCEDURE MakeChild (msg : ARRAY OF CHAR);
   (* Creates a child window for use by send or receive threads *)

      VAR
         c_hdc : HDC;

      BEGIN
         WinPostMsg (FrameWindow, WM_SETFULL, MPARAM (0), MPARAM (0));

         Disable (IDM_CONNECT);
         Disable (IDM_SEND);
         Disable (IDM_REC);
         Disable (IDM_DIR);
         Disable (IDM_OPTIONS);
         Disable (IDM_COLORS);

         (* Create a client window *)
         FrameFlags := FCF_TITLEBAR + FCF_SIZEBORDER;

         ChildFrameWindow := WinCreateStdWindow (
                ClientWindow,        (* handle of the parent window *)
                WS_VISIBLE,          (* the window style *)
                FrameFlags,          (* the window flags *)
                ADR(Child),          (* the window class *)
                NULL,                (* the title bar text *)
                WS_VISIBLE,          (* client window style *)
                NULL,                (* handle of resource module *)
                IDM_KERMIT,          (* resource id *)
                ChildClientWindow    (* returned client window handle *)
         );

         WinSetWindowPos (ChildFrameWindow, 0,
            Pos.cx DIV 4, Pos.cy DIV 4,
            Pos.cx DIV 2, Pos.cy DIV 2 - 3,
            SWP_MOVE + SWP_SIZE);

         WinSetWindowText (ChildFrameWindow, ADR (msg));

         WinSetActiveWindow (HWND_DESKTOP, ChildFrameWindow);

         c_hdc := WinOpenWindowDC (ChildClientWindow);
         hvps := child_hvps;
         VioAssociate (c_hdc, hvps);
         ClrScr;     (* clear the hvio window *)
      END MakeChild;


   PROCEDURE Disable (item : USHORT);
   (* Disables and "GREYS" a menu item *)

      VAR
         h : HWND;

      BEGIN
         h := WinWindowFromID (FrameWindow, FID_MENU);
         MP1.W1 := item;   MP1.W2 := 1;
         MP2.W1 := MIA_DISABLED;   MP2.W2 := MIA_DISABLED;
         WinSendMsg (h, MM_SETITEMATTR, MP1, MP2);
      END Disable;


   PROCEDURE Enable (item : USHORT);
   (* Enables a menu item *)

      VAR
         h : HWND;
         atr : USHORT;

      BEGIN
         h := WinWindowFromID (FrameWindow, FID_MENU);
         MP1.W1 := item;   MP1.W2 := 1;
         MP2.W1 := MIA_DISABLED;   MP2.W2 := MIA_DISABLED;
         atr := USHORT (WinSendMsg (h, MM_QUERYITEMATTR, MP1, MP2));
         atr := USHORT (BITSET (atr) * (BITSET (MIA_DISABLED) / BITSET (-1)));
         MP1.W1 := item;   MP1.W2 := 1;
         MP2.W1 := MIA_DISABLED;   MP2.W2 := atr;
         WinSendMsg (h, MM_SETITEMATTR, MP1, MP2);
      END Enable;


   PROCEDURE Check (item : USHORT);
   (* Checks a menu item -- indicates that it is selected *)

      VAR
         h : HWND;

      BEGIN
         h := WinWindowFromID (FrameWindow, FID_MENU);
         MP1.W1 := item;   MP1.W2 := 1;
         MP2.W1 := MIA_CHECKED;   MP2.W2 := MIA_CHECKED;
         WinSendMsg (h, MM_SETITEMATTR, MP1, MP2);
      END Check;


   PROCEDURE UnCheck (item : USHORT);
   (* Remove check from a menu item *)

      VAR
         h : HWND;
         atr : USHORT;

      BEGIN
         h := WinWindowFromID (FrameWindow, FID_MENU);
         MP1.W1 := item;   MP1.W2 := 1;
         MP2.W1 := MIA_CHECKED;   MP2.W2 := MIA_CHECKED;
         atr := USHORT (WinSendMsg (h, MM_QUERYITEMATTR, MP1, MP2));
         atr := USHORT (BITSET (atr) * (BITSET (MIA_CHECKED) / BITSET (-1)));
         MP1.W1 := item;   MP1.W2 := 1;
         MP2.W1 := MIA_CHECKED;   MP2.W2 := atr;
         WinSendMsg (h, MM_SETITEMATTR, MP1, MP2);
      END UnCheck;


   PROCEDURE DoMenu (hwnd : HWND; item [VALUE] : MPARAM);
   (* Processes Most Menu Interactions *)

      VAR
         rcl : RECTL;
         rc : USHORT;

      BEGIN
         CASE CARDINAL (item.W1) OF
            IDM_DIR:
               SetFull;
               WinQueryWindowRect (hwnd, rcl);
               WinDlgBox (HWND_DESKTOP, hwnd, PathDlgProc, 0, IDM_DIRPATH, 0);
               hvps := frame_hvps;
               VioAssociate (hdc, hvps);
               Dir (Path);
               WinDlgBox (HWND_DESKTOP, hwnd, DirEndDlgProc, 0, IDM_DIREND, 0);
               VioAssociate (0, hvps);
               WinInvalidateRect (hwnd, rcl, 0);
         |  IDM_CONNECT:
               TermMode := TRUE;
               Disable (IDM_CONNECT);
               Disable (IDM_SEND);
               Disable (IDM_REC);
               Disable (IDM_DIR);
               Disable (IDM_OPTIONS);
               Disable (IDM_COLORS);
               (* MAXIMIZE Window -- Required for Terminal Emulation *)
               SetMax;
               hvps := frame_hvps;
               VioAssociate (hdc, hvps);
               DosResumeThread (TermThr);
               InitTerm;
         |  IDM_SEND:
               WinDlgBox (HWND_DESKTOP, hwnd, SendFNDlgProc, 0, IDM_SENDFN, 0);
               MakeChild ("Send a File");
               DosCreateThread (Send, Thr, ADR (Stack[STKSIZE]));
         |  IDM_REC:
               MakeChild ("Receive a File");
               DosCreateThread (Receive, Thr, ADR (Stack[STKSIZE]));
         |  IDM_QUIT:
               rc := WinMessageBox (HWND_DESKTOP, ClientWindow,
                        ADR ("Do You Really Want To EXIT PCKermit?"),
                        ADR ("End Session"), 0, MB_OKCANCEL + MB_ICONQUESTION);
               IF rc = MBID_OK THEN
                  StopReceiving (comport - COM_OFF);
                  WinPostMsg (hwnd, WM_QUIT, MPARAM (0), MPARAM (0));
               END;
         |  IDM_COMPORT:
               WinDlgBox (HWND_DESKTOP, hwnd, ComDlgProc, 0, IDM_COMPORT, 0);
               SetPort;
         |  IDM_BAUDRATE:
               WinDlgBox (HWND_DESKTOP, hwnd, BaudDlgProc, 0, IDM_BAUDRATE, 0);
               SetPort;
         |  IDM_DATABITS:
               WinDlgBox (HWND_DESKTOP, hwnd, DataDlgProc, 0, IDM_DATABITS, 0);
               SetPort;
         |  IDM_STOPBITS:
               WinDlgBox (HWND_DESKTOP, hwnd, StopDlgProc, 0, IDM_STOPBITS, 0);
               SetPort;
         |  IDM_PARITY:
               WinDlgBox (HWND_DESKTOP, hwnd, ParityDlgProc, 0, IDM_PARITY, 0);
               SetPort;
         |  IDM_WHITE:
               UnCheck (ColorSet);
               ColorSet := IDM_WHITE;
               Check (ColorSet);
               White;
         |  IDM_GREEN:
               UnCheck (ColorSet);
               ColorSet := IDM_GREEN;
               Check (ColorSet);
               Green;
         |  IDM_AMBER:
               UnCheck (ColorSet);
               ColorSet := IDM_AMBER;
               Check (ColorSet);
               Amber;
         |  IDM_C1:
               UnCheck (ColorSet);
               ColorSet := IDM_C1;
               Check (ColorSet);
               Color1;
         |  IDM_C2:
               UnCheck (ColorSet);
               ColorSet := IDM_C2;
               Check (ColorSet);
               Color2;
         |  IDM_ABOUT:
               WinDlgBox (HWND_DESKTOP, hwnd, AboutDlgProc, 0, IDM_ABOUT, 0);
         ELSE
            (* Don't do anything... *)
         END;
      END DoMenu;


   PROCEDURE ComDlgProc ['ComDlgProc'] (
   (* Process Dialog Box for choosing COM1/COM2 *)
         hwnd  : HWND;
         msg   : USHORT;
         mp1   [VALUE] : MPARAM;
         mp2   [VALUE] : MPARAM) : MRESULT [LONG, WINDOWS];
      BEGIN
         CASE msg OF
            WM_INITDLG:
               WinSendDlgItemMsg (hwnd, comport, BM_SETCHECK,
               MPARAM (1), MPARAM (0));
               WinSetFocus (HWND_DESKTOP, WinWindowFromID (hwnd, comport));
               RETURN 1;
         |  WM_CONTROL:
               comport := mp1.W1;
               RETURN 0;
         |  WM_COMMAND:
               WinDismissDlg (hwnd, 1);
               RETURN 0;
         ELSE
            RETURN WinDefDlgProc (hwnd, msg, mp1, mp2);
         END;
      END ComDlgProc;


   PROCEDURE BaudDlgProc ['BaudDlgProc'] (
   (* Process Dialog Box for choosing Baud Rate *)
         hwnd  : HWND;
         msg   : USHORT;
         mp1   [VALUE] : MPARAM;
         mp2   [VALUE] : MPARAM) : MRESULT [LONG, WINDOWS];
      BEGIN
         WITH Settings[comport - COM_OFF] DO
            CASE msg OF
               WM_INITDLG:
                  WinSendDlgItemMsg (hwnd, baudrate, BM_SETCHECK,
                                       MPARAM (1), MPARAM (0));
                  WinSetFocus (HWND_DESKTOP, WinWindowFromID (hwnd, baudrate));
                  RETURN 1;
            |  WM_CONTROL:
                  baudrate := mp1.W1;
                  RETURN 0;
            |  WM_COMMAND:
                  WinDismissDlg (hwnd, 1);
                  RETURN 0;
            ELSE
               RETURN WinDefDlgProc (hwnd, msg, mp1, mp2);
            END;
         END;
      END BaudDlgProc;


   PROCEDURE DataDlgProc ['DataDlgProc'] (
   (* Process Dialog Box for choosing 7 or 8 data bits *)
         hwnd  : HWND;
         msg   : USHORT;
         mp1   [VALUE] : MPARAM;
         mp2   [VALUE] : MPARAM) : MRESULT [LONG, WINDOWS];
      BEGIN
         WITH Settings[comport - COM_OFF] DO
            CASE msg OF
               WM_INITDLG:
                  WinSendDlgItemMsg (hwnd, databits, BM_SETCHECK,
                                       MPARAM (1), MPARAM (0));
                  WinSetFocus (HWND_DESKTOP, WinWindowFromID (hwnd, databits));
                  RETURN 1;
            |  WM_CONTROL:
                  databits := mp1.W1;
                  RETURN 0;
            |  WM_COMMAND:
                  WinDismissDlg (hwnd, 1);
                  RETURN 0;
            ELSE
               RETURN WinDefDlgProc (hwnd, msg, mp1, mp2);
            END;
         END;
      END DataDlgProc;


   PROCEDURE StopDlgProc ['StopDlgProc'] (
   (* Process Dialog Box for choosing 1 or 2 stop bits *)
         hwnd  : HWND;
         msg   : USHORT;
         mp1   [VALUE] : MPARAM;
         mp2   [VALUE] : MPARAM) : MRESULT [LONG, WINDOWS];
      BEGIN
         WITH Settings[comport - COM_OFF] DO
            CASE msg OF
               WM_INITDLG:
                  WinSendDlgItemMsg (hwnd, stopbits, BM_SETCHECK,
                                 MPARAM (1), MPARAM (0));
                  WinSetFocus (HWND_DESKTOP, WinWindowFromID (hwnd, stopbits));
                  RETURN 1;
            |  WM_CONTROL:
                  stopbits := mp1.W1;
                  RETURN 0;
            |  WM_COMMAND:
                  WinDismissDlg (hwnd, 1);
                  RETURN 0;
            ELSE
               RETURN WinDefDlgProc (hwnd, msg, mp1, mp2);
            END;
         END;
      END StopDlgProc;


   PROCEDURE ParityDlgProc ['ParityDlgProc'] (
   (* Process Dialog Box for choosing odd, even, or no parity *)
         hwnd  : HWND;
         msg   : USHORT;
         mp1   [VALUE] : MPARAM;
         mp2   [VALUE] : MPARAM) : MRESULT [LONG, WINDOWS];
      BEGIN
         WITH Settings[comport - COM_OFF] DO
            CASE msg OF
               WM_INITDLG:
                  WinSendDlgItemMsg (hwnd, parity, BM_SETCHECK,
                                       MPARAM (1), MPARAM (0));
                  WinSetFocus (HWND_DESKTOP, WinWindowFromID (hwnd, parity));
                  RETURN 1;
            |  WM_CONTROL:
                  parity := mp1.W1;
                  RETURN 0;
            |  WM_COMMAND:
                  WinDismissDlg (hwnd, 1);
                  RETURN 0;
            ELSE
               RETURN WinDefDlgProc (hwnd, msg, mp1, mp2);
            END;
         END;
      END ParityDlgProc;


   PROCEDURE AboutDlgProc ['AboutDlgProc'] (
   (* Process "About" Dialog Box *)
         hwnd  : HWND;
         msg   : USHORT;
         mp1   [VALUE] : MPARAM;
         mp2   [VALUE] : MPARAM) : MRESULT [LONG, WINDOWS];
      BEGIN
         IF msg = WM_COMMAND THEN
            WinDismissDlg (hwnd, 1);
            RETURN 0;
         ELSE
            RETURN WinDefDlgProc (hwnd, msg, mp1, mp2);
         END;
      END AboutDlgProc;


   PROCEDURE SendFNDlgProc ['SendFNDlgProc'] (
   (* Process Dialog Box that obtains send filename from user *)
         hwnd  : HWND;
         msg   : USHORT;
         mp1   [VALUE] : MPARAM;
         mp2   [VALUE] : MPARAM) : MRESULT [LONG, WINDOWS];
      BEGIN
         CASE msg OF
            WM_INITDLG:
               WinSetFocus (HWND_DESKTOP, WinWindowFromID (hwnd, ID_SENDFN));
               RETURN 1;
         |  WM_COMMAND:
               WinQueryDlgItemText (hwnd, ID_SENDFN, 20, ADR (sFname));
               WinDismissDlg (hwnd, 1);
               RETURN 0;
         ELSE
            RETURN WinDefDlgProc (hwnd, msg, mp1, mp2);
         END;
      END SendFNDlgProc;


   PROCEDURE PathDlgProc ['PathDlgProc'] (
   (* Process Dialog Box that obtains directory path from user *)
         hwnd  : HWND;
         msg   : USHORT;
         mp1   [VALUE] : MPARAM;
         mp2   [VALUE] : MPARAM) : MRESULT [LONG, WINDOWS];
      BEGIN
         CASE msg OF
            WM_INITDLG:
               WinSetFocus (HWND_DESKTOP, WinWindowFromID (hwnd, ID_DIRPATH));
               RETURN 1;
         |  WM_COMMAND:
               WinQueryDlgItemText (hwnd, ID_DIRPATH, 60, ADR (Path));
               WinDismissDlg (hwnd, 1);
               RETURN 0;
         ELSE
            RETURN WinDefDlgProc (hwnd, msg, mp1, mp2);
         END;
      END PathDlgProc;


   PROCEDURE DirEndDlgProc ['DirEndDlgProc'] (
   (* Process Dialog Box to allow user to cancel directory *)
         hwnd  : HWND;
         msg   : USHORT;
         mp1   [VALUE] : MPARAM;
         mp2   [VALUE] : MPARAM) : MRESULT [LONG, WINDOWS];
      BEGIN
         IF msg = WM_COMMAND THEN
            WinDismissDlg (hwnd, 1);
            RETURN 0;
         ELSE
            RETURN WinDefDlgProc (hwnd, msg, mp1, mp2);
         END;
      END DirEndDlgProc;


   PROCEDURE HelpDlgProc ['HelpDlgProc'] (
   (* Process Dialog Boxes for the HELP *)
         hwnd  : HWND;
         msg   : USHORT;
         mp1   [VALUE] : MPARAM;
         mp2   [VALUE] : MPARAM) : MRESULT [LONG, WINDOWS];
      BEGIN
         IF msg = WM_COMMAND THEN
            WinDismissDlg (hwnd, 1);
            RETURN 0;
         ELSE
            RETURN WinDefDlgProc (hwnd, msg, mp1, mp2);
         END;
      END HelpDlgProc;


   PROCEDURE KeyTranslate (mp1, mp2 [VALUE] : MPARAM; VAR c1, c2 : CHAR) : BOOLEAN;
   (* Translates WM_CHAR message into ascii keystroke *)

      VAR
            code : CARDINAL;
            fs : BITSET;
            VK, KU, CH, CT : BOOLEAN;

      BEGIN
         fs := BITSET (mp1.W1);     (* flags *)
         VK := (fs * BITSET (KC_VIRTUALKEY)) # {};
         KU := (fs * BITSET (KC_KEYUP)) # {};
         CH := (fs * BITSET (KC_CHAR)) # {};
         CT := (fs * BITSET (KC_CTRL)) # {};
         IF (NOT KU) THEN
            code := mp2.W1;    (* character code *)
            c1 := CHR (code);
            c2 := CHR (code DIV 256);
            IF ORD (c1) = 0E0H THEN      (* function *)
               c1 := 0C;
            END;
            IF CT AND (NOT CH) AND (NOT VK) AND (code # 0) THEN
               c1 := CHR (CARDINAL ((BITSET (ORD (c1)) * BITSET (1FH))));
            END;
            RETURN TRUE;
         ELSE
            RETURN FALSE;
         END;
      END KeyTranslate;


   PROCEDURE WindowProc ['WindowProc'] (
   (* Main Window Procedure -- Handles message from PM and elsewhere *)
         hwnd  : HWND;
         msg   : USHORT;
         mp1   [VALUE] : MPARAM;
         mp2   [VALUE] : MPARAM) : MRESULT [LONG, WINDOWS];

      VAR
         ch : CHAR;
         hps       : HPS;
         pswp      : PSWP;
         c1, c2    : CHAR;
         NullRectl [0:0] : RECTL;

      BEGIN
         CASE msg OF
            WM_HELP:
               IF TermMode THEN
                  WinDlgBox (HWND_DESKTOP, hwnd, HelpDlgProc,
                             0, IDM_TERMHELP, 0);
               ELSE
                  WinDlgBox (HWND_DESKTOP, hwnd, HelpDlgProc,
                             0, IDM_HELPMENU, 0);
               END;
               RETURN 0;
         |  WM_SETFULL:
               SetFull;
               RETURN 0;
         |  WM_SETRESTORE:
               SetRestore;
               RETURN 0;
         |  WM_SETMAX:
               SetMax;
               RETURN 0;
         |  WM_MINMAXFRAME:
               pswp := PSWP (mp1);
               IF BITSET (pswp^.fs) * BITSET (SWP_MINIMIZE) # {} THEN
                  (* Don't Display Port Settings While Minimized *)
                  WinSetWindowText (FrameWindow, ADR (Title));
               ELSE
                  WinSetWindowText (FrameWindow, ADR (Banner));
                  IF TermMode AND
                   (BITSET (pswp^.fs) * BITSET (SWP_RESTORE) # {}) THEN
                     (* Force window to be maximized in terminal mode *)

                     WinPostMsg (FrameWindow, WM_SETMAX,
                                 MPARAM (0), MPARAM (0));
                  ELSIF (NOT TermMode) AND
                   (BITSET (pswp^.fs) * BITSET (SWP_MAXIMIZE) # {}) THEN
                     (* Prevent maximized window EXCEPT in terminal mode *)
                     WinPostMsg (FrameWindow, WM_SETRESTORE,
                                 MPARAM (0), MPARAM (0));
                  ELSE
                     (* Do Nothing *)
                  END;
               END;
               RETURN WinDefWindowProc (hwnd, msg, mp1, mp2);
         |  WM_CREATE:
               hdc := WinOpenWindowDC (hwnd);
               VioCreatePS (frame_hvps, 25, 80, 0, FORMAT_CGA, 0);
               VioCreatePS (child_hvps, 16, 40, 0, FORMAT_CGA, 0);
               DosCreateThread (TermThrProc, TermThr, ADR (TermStack[STKSIZE]));
               DosSuspendThread (TermThr);
               RETURN 0;
         |  WM_INITMENU:
               Check (ColorSet);
               RETURN 0;
         |  WM_COMMAND:
               DoMenu (hwnd, mp1);
               RETURN 0;
         |  WM_TERMQUIT:
               TermMode := FALSE;
               DosSuspendThread (TermThr);
               VioAssociate (0, hvps);
               (* Restore The Window *)
               SetRestore;
               Enable (IDM_CONNECT);
               Enable (IDM_SEND);
               Enable (IDM_REC);
               Enable (IDM_DIR);
               Enable (IDM_OPTIONS);
               Enable (IDM_COLORS);
               RETURN 0;
         |  WM_TERM:
               PutPortChar (CHR (mp1.W1));   (* To Screen *)
               RETURN 0;
         |  WM_CHAR:
               IF TermMode THEN
                  IF KeyTranslate (mp1, mp2, c1, c2) THEN
                     PutKbdChar (c1, c2);   (* To Port *)
                     RETURN 0;
                  ELSE
                     RETURN WinDefAVioWindowProc (hwnd, msg, mp1, mp2);
                  END;
               ELSE
                  RETURN WinDefWindowProc (hwnd, msg, mp1, mp2);
               END;
         |  WM_PAINT:
               hps := WinBeginPaint (hwnd, NULL, NullRectl);
               GpiErase (hps);
               VioShowPS (25, 80, 0, hvps);
               WinEndPaint (hps);
               RETURN 0;
         |  WM_SIZE:
               IF TermMode THEN
                  RETURN WinDefAVioWindowProc (hwnd, msg, mp1, mp2);
               ELSE
                  RETURN WinDefWindowProc (hwnd, msg, mp1, mp2);
               END;
         |  WM_DESTROY:
               VioDestroyPS (frame_hvps);
               VioDestroyPS (child_hvps);
               RETURN 0;
         ELSE
            RETURN WinDefWindowProc (hwnd, msg, mp1, mp2);
         END;
      END WindowProc;


   PROCEDURE ChildWindowProc ['ChildWindowProc'] (
   (* Window Procedure for Send/Receive child windows *)
      hwnd : HWND;
      msg  : USHORT;
      mp1  [VALUE] : MPARAM;
      mp2  [VALUE] : MPARAM) : MRESULT [LONG, WINDOWS];

      VAR
         mp : USHORT;
         hps : HPS;
         c1, c2 : CHAR;
         NullRectl [0:0] : RECTL;

      BEGIN
         CASE msg OF
            WM_PAINT:
               hps := WinBeginPaint (hwnd, NULL, NullRectl);
               GpiErase (hps);
               VioShowPS (16, 40, 0, hvps);
               WinEndPaint (hps);
               RETURN 0;
         |  WM_CHAR:
               IF KeyTranslate (mp1, mp2, c1, c2) AND (c1 = ESC) THEN
                  Aborted := TRUE;
                  RETURN 0;
               ELSE
                  RETURN WinDefWindowProc (hwnd, msg, mp1, mp2);
               END;
         |  WM_PAD:
               mp := mp1.W1;
               IF (mp = PAD_Error) OR (mp = PAD_Quit) THEN
                  WriteLn;
                  IF mp = PAD_Error THEN
                     WinMessageBox (HWND_DESKTOP, hwnd,
                                    ADR ("File Transfer Aborted"),
                                    ADR (Class), 0, MB_OK + MB_ICONEXCLAMATION);
                  ELSE
                     WinMessageBox (HWND_DESKTOP, hwnd,
                                       ADR ("File Transfer Completed"),
                                       ADR (Class), 0, MB_OK + MB_ICONASTERISK);
                  END;
                  DosSleep (2000);
                  VioAssociate (0, hvps);
                  WinDestroyWindow(ChildFrameWindow);
                  Enable (IDM_CONNECT);
                  Enable (IDM_SEND);
                  Enable (IDM_REC);
                  Enable (IDM_DIR);
                  Enable (IDM_OPTIONS);
                  Enable (IDM_COLORS);
               ELSE
                  DoPADMsg (mp1, mp2);
               END;
               RETURN 0;
         |  WM_DL:
               DoDLMsg (mp1, mp2);
               RETURN 0;
         |  WM_SIZE:
               WinSetWindowPos (ChildFrameWindow, 0,
                  Pos.cx DIV 4, Pos.cy DIV 4,
                  Pos.cx DIV 2, Pos.cy DIV 2 - 3,
                  SWP_MOVE + SWP_SIZE);
               RETURN WinDefAVioWindowProc (hwnd, msg, mp1, mp2);
         ELSE
            RETURN WinDefWindowProc (hwnd, msg, mp1, mp2);
         END;
      END ChildWindowProc;


BEGIN   (* Module Initialization *)
    WITH Settings[ID_COM1 - COM_OFF] DO
       baudrate := ID_B1200;
       parity := ID_EVEN;
       databits := ID_DATA7;
       stopbits := ID_STOP1;
    END;

    WITH Settings[ID_COM2 - COM_OFF] DO
       baudrate := ID_B19K2;
       parity := ID_EVEN;
       databits := ID_DATA7;
       stopbits := ID_STOP1;
    END;
    PrevComPort := NONE;
    comport := ID_COM1;
    TermMode := FALSE;   (* Not Initially in Terminal Emulation Mode *)
END Shell.
<<< TERM.DEF >>>
DEFINITION MODULE Term;   (* TVI950 Terminal Emulation For Kermit *)

   EXPORT QUALIFIED
      WM_TERM, WM_TERMQUIT,
      Dir, TermThrProc, InitTerm, PutKbdChar, PutPortChar;

   CONST
      WM_TERM = 4000H;
      WM_TERMQUIT = 4001H;


   PROCEDURE Dir (path : ARRAY OF CHAR);
   (* Displays a directory *)

   PROCEDURE TermThrProc;
   (* Thread to get characters from port, put into buffer, send message *)

   PROCEDURE InitTerm;
   (* Clear Screen, Home Cursor, Get Ready For Terminal Emulation *)

   PROCEDURE PutKbdChar (ch1, ch2 : CHAR);
   (* Process a character received from the keyboard *)

   PROCEDURE PutPortChar (ch : CHAR);
   (* Process a character received from the port *)

END Term.
<<< TERM.MOD >>>
IMPLEMENTATION MODULE Term;   (* TVI950 Terminal Emulation for Kermit *)

   FROM Drives IMPORT
      SetDrive;

   FROM Directories IMPORT
      FileAttributes, AttributeSet, DirectoryEntry, FindFirst, FindNext;

   FROM SYSTEM IMPORT
      ADR;

   FROM DosCalls IMPORT
      DosChDir, DosSleep;

   FROM Screen IMPORT
      ClrScr, ClrEol, GotoXY, GetXY,
      Right, Left, Up, Down, WriteAtt, WriteString, WriteLn, Write,
      attribute, NORMAL, HIGHLIGHT, REVERSE;

   FROM PMWIN IMPORT
      MPARAM, WinPostMsg;

   FROM Shell IMPORT
      comport, FrameWindow;

   FROM KH IMPORT
      COM_OFF;

   FROM CommPort IMPORT
      CommStatus, GetChar, SendChar;

   FROM Strings IMPORT
      Length, Concat;

   IMPORT ASCII;


   CONST
      (* Key codes:  Note: F1 -- F12 are actually Shift-F1 -- Shift-F12 *)
      F1 = 124C;
      F2 = 125C;
      F3 = 126C;
      F4 = 127C;
      F5 = 130C;
      F6 = 131C;
      F7 = 132C;
      F8 = 133C;
      F9 = 134C;
      F10 = 135C;
      F11 = 207C;
      F12 = 210C;
      AF1 = 150C;   (* Alt-F1 *)
      AF2 = 151C;   (* Alt-F2 *)
      INS = 122C;
      DEL = 123C;
      HOME = 107C;
      PGDN = 121C;   (* synonym for PF10 *)
      PGUP = 111C;   (* synonym for PF11 *)
      ENDD = 117C;   (* synonym for PF12 *)
      UPARROW = 110C;
      DOWNARROW = 120C;
      LEFTARROW = 113C;
      RIGHTARROW = 115C;
      CtrlX = 30C;
      CtrlCaret = 36C;
      CtrlZ = 32C;
      CtrlL = 14C;
      CtrlH = 10C;
      CtrlK = 13C;
      CtrlJ = 12C;
      CtrlV = 26C;
      ESC = 33C;
      BUFSIZE = 4096;   (* character buffer used by term thread *)


   VAR
      commStat : CommStatus;
      echo : (Off, Local, On);
      newline: BOOLEAN;   (* translate <cr> to <cr><lf> *)
      Insert : BOOLEAN;
      MP1, MP2 : MPARAM;


   PROCEDURE Dir (path : ARRAY OF CHAR);
   (* Change drive and/or directory; display a directory (in wide format) *)

      VAR
         gotFN : BOOLEAN;
         filename : ARRAY [0..20] OF CHAR;
         attr : AttributeSet;
         ent : DirectoryEntry;
         i, j, k : INTEGER;

      BEGIN
         filename := "";   (* in case no directory change *)
         i := Length (path);
         IF (i > 2) AND (path[1] = ':') THEN   (* drive specifier *)
            DEC (i, 2);
            SetDrive (ORD (CAP (path[0])) - ORD ('A'));
            FOR j := 0 TO i DO   (* strip off the drive specifier *)
               path[j] := path[j + 2];
            END;
         END;
         IF i # 0 THEN
            gotFN := FALSE;
            WHILE (i >= 0) AND (path[i] # '\') DO
               IF path[i] = '.' THEN
                  gotFN := TRUE;
               END;
               DEC (i);
            END;
            IF gotFN THEN
               j := i + 1;
               k := 0;
               WHILE path[j] # 0C DO
                  filename[k] := path[j];
                  INC (k);       INC (j);
               END;
               filename[k] := 0C;
               IF (i = -1) OR ((i = 0) AND (path[0] = '\')) THEN
                  INC (i);
               END;
               path[i] := 0C;
            END;
         END;
         IF Length (path) # 0 THEN
            DosChDir (ADR (path), 0);
         END;
         IF Length (filename) = 0 THEN
            filename := "*.*";
         END;
         attr := AttributeSet {ReadOnly, Directory, Archive};
         i := 1;   (* keep track of position on line *)

         ClrScr;
         gotFN := FindFirst (filename, attr, ent);
         WHILE gotFN DO
            WriteString (ent.name);
            j := Length (ent.name);
            WHILE j < 12 DO   (* 12 is maximum length for "filename.typ" *)
               Write (' ');
               INC (j);
            END;
            INC (i);   (* next position on this line *)
            IF i > 5 THEN
               i := 1;   (* start again on new line *)
               WriteLn;
            ELSE
               WriteString (" | ");
            END;
            gotFN := FindNext (ent);
         END;
         WriteLn;
      END Dir;


   PROCEDURE InitTerm;
   (* Clear Screen, Home Cursor, Get Ready For Terminal Emulation *)
      BEGIN
         ClrScr;
         Insert := FALSE;
         attribute := NORMAL;
      END InitTerm;


   PROCEDURE PutKbdChar (ch1, ch2 : CHAR);
   (* Process a character received from the keyboard *)
      BEGIN
         IF ch1 = ASCII.enq THEN   (* Control-E *)
            echo := On;
         ELSIF ch1 = ASCII.ff THEN   (* Control-L *)
            echo := Local;
         ELSIF ch1 = ASCII.dc4 THEN   (* Control-T *)
            echo := Off;
         ELSIF ch1 = ASCII.so THEN   (* Control-N *)
            newline := TRUE;
         ELSIF ch1 = ASCII.si THEN   (* Control-O *)
            newline := FALSE;
         ELSIF (ch1 = ASCII.can) OR (ch1 = ESC) THEN
            attribute := NORMAL;
            WinPostMsg (FrameWindow, WM_TERMQUIT, MPARAM (0), MPARAM (0));
         ELSIF ch1 = 0C THEN
            Function (ch2);
         ELSE
            commStat := SendChar (comport - COM_OFF, ch1, FALSE);
            IF (echo = On) OR (echo = Local) THEN
               WriteAtt (ch1);
            END;
         END;
      END PutKbdChar;


   PROCEDURE Function (ch : CHAR);
   (* handles the function keys -- including PF1 - PF12, etc. *)
      BEGIN
         CASE ch OF
            F1 :  commStat := SendChar (comport - COM_OFF, ASCII.soh, FALSE);
                  commStat := SendChar (comport - COM_OFF, '@', FALSE);
                  commStat := SendChar (comport - COM_OFF, ASCII.cr, FALSE);
         |  F2 :  commStat := SendChar (comport - COM_OFF, ASCII.soh, FALSE);
                  commStat := SendChar (comport - COM_OFF, 'A', FALSE);
                  commStat := SendChar (comport - COM_OFF, ASCII.cr, FALSE);
         |  F3 :  commStat := SendChar (comport - COM_OFF, ASCII.soh, FALSE);
                  commStat := SendChar (comport - COM_OFF, 'B', FALSE);
                  commStat := SendChar (comport - COM_OFF, ASCII.cr, FALSE);
         |  F4 :  commStat := SendChar (comport - COM_OFF, ASCII.soh, FALSE);
                  commStat := SendChar (comport - COM_OFF, 'C', FALSE);
                  commStat := SendChar (comport - COM_OFF, ASCII.cr, FALSE);
         |  F5 :  commStat := SendChar (comport - COM_OFF, ASCII.soh, FALSE);
                  commStat := SendChar (comport - COM_OFF, 'D', FALSE);
                  commStat := SendChar (comport - COM_OFF, ASCII.cr, FALSE);
         |  F6 :  commStat := SendChar (comport - COM_OFF, ASCII.soh, FALSE);
                  commStat := SendChar (comport - COM_OFF, 'E', FALSE);
                  commStat := SendChar (comport - COM_OFF, ASCII.cr, FALSE);
         |  F7 :  commStat := SendChar (comport - COM_OFF, ASCII.soh, FALSE);
                  commStat := SendChar (comport - COM_OFF, 'F', FALSE);
                  commStat := SendChar (comport - COM_OFF, ASCII.cr, FALSE);
         |  F8 :  commStat := SendChar (comport - COM_OFF, ASCII.soh, FALSE);
                  commStat := SendChar (comport - COM_OFF, 'G', FALSE);
                  commStat := SendChar (comport - COM_OFF, ASCII.cr, FALSE);
         |  F9 :  commStat := SendChar (comport - COM_OFF, ASCII.soh, FALSE);
                  commStat := SendChar (comport - COM_OFF, 'H', FALSE);
                  commStat := SendChar (comport - COM_OFF, ASCII.cr, FALSE);
         |  F10,
            PGDN: commStat := SendChar (comport - COM_OFF, ASCII.soh, FALSE);
                  commStat := SendChar (comport - COM_OFF, 'I', FALSE);
                  commStat := SendChar (comport - COM_OFF, ASCII.cr, FALSE);
         |  F11,
            AF1,
            PGUP: commStat := SendChar (comport - COM_OFF, ASCII.soh, FALSE);
                  commStat := SendChar (comport - COM_OFF, 'J', FALSE);
                  commStat := SendChar (comport - COM_OFF, ASCII.cr, FALSE);
         |  F12,
            AF2,
            ENDD: commStat := SendChar (comport - COM_OFF, ESC, FALSE);
                  commStat := SendChar (comport - COM_OFF, 'Q', FALSE);
         |  INS : IF NOT Insert THEN
                     commStat := SendChar (comport - COM_OFF, ESC, FALSE);
                     commStat := SendChar (comport - COM_OFF, 'E', FALSE);
                  END;
         |  DEL : commStat := SendChar (comport - COM_OFF, ESC, FALSE);
                  commStat := SendChar (comport - COM_OFF, 'R', FALSE);
         |  HOME       : commStat := SendChar (comport - COM_OFF, CtrlZ, FALSE);
         |  UPARROW    : commStat := SendChar (comport - COM_OFF, CtrlK, FALSE);
         |  DOWNARROW  : commStat := SendChar (comport - COM_OFF, CtrlV, FALSE);
         |  LEFTARROW  : commStat := SendChar (comport - COM_OFF, CtrlH, FALSE);
         |  RIGHTARROW : commStat := SendChar (comport - COM_OFF, CtrlL, FALSE);
         ELSE
            (* do nothing *)
         END;
      END Function;


   PROCEDURE TermThrProc;
   (* Thread to get characters from port, put into buffer *)

      VAR
         ch : CHAR;

      BEGIN
         LOOP
            IF GetChar (comport - COM_OFF, ch) = Success THEN
               MP1.W1 := ORD (ch);   MP1.W2 := 0;
               MP2.L := 0;
               WinPostMsg (FrameWindow, WM_TERM, MP1, MP2);
            ELSE
               DosSleep (0);
            END
         END;
      END TermThrProc;


   VAR
      EscState, CurState1, CurState2 : BOOLEAN;
      CurChar1 : CHAR;

   PROCEDURE PutPortChar (ch : CHAR);
   (* Process a character received from the port *)
      BEGIN
         IF EscState THEN
            EscState := FALSE;
            IF ch = '=' THEN
               CurState1 := TRUE;
            ELSE
               Escape (ch);
            END;
         ELSIF CurState1 THEN
            CurState1 := FALSE;
            CurChar1 := ch;
            CurState2 := TRUE;
         ELSIF CurState2 THEN
            CurState2 := FALSE;
            Cursor (ch);
         ELSE
            CASE ch OF
               CtrlCaret, CtrlZ : ClrScr;
            |  CtrlL : Right;
            |  CtrlH : Left;
            |  CtrlK : Up;
            |  CtrlJ : Down;
            |  ESC   : EscState := TRUE;
            ELSE
               WriteAtt (ch);
               IF newline AND (ch = ASCII.cr) THEN
                  WriteLn;
               END;
            END;
         END;
         IF echo = On THEN
            commStat := SendChar (comport - COM_OFF, ch, FALSE);
         END;
      END PutPortChar;


   PROCEDURE Escape (ch : CHAR);
   (* handles escape sequences *)
      BEGIN
         CASE ch OF
            '*' : ClrScr;
         |  'T', 'R' : ClrEol;
         |  ')' : attribute := NORMAL;
         |  '(' : attribute := HIGHLIGHT;
         |  'f' : InsertMsg;
         |  'g' : InsertOn;
         ELSE
            (* ignore *)
         END;
      END Escape;


   PROCEDURE Cursor (ch : CHAR);
   (* handles cursor positioning *)

      VAR
         x, y : CARDINAL;

      BEGIN
         y := ORD (CurChar1) - 20H;
         x := ORD (ch) - 20H;
         GotoXY (x, y);   (* adjust for HOME = (1, 1) *)
      END Cursor;


   VAR
      cx, cy : CARDINAL;

   PROCEDURE InsertMsg;
   (* get ready insert mode -- place a message at the bottom of the screen *)
      BEGIN
         IF NOT Insert THEN
            GetXY (cx, cy);   (* record current position *)
            GotoXY (1, 24);
            ClrEol;
            attribute := REVERSE;
         ELSE   (* exit Insert mode *)
            GetXY (cx, cy);
            GotoXY (1, 24);
            ClrEol;
            GotoXY (cx, cy);
            Insert := FALSE;
         END;
      END InsertMsg;


   PROCEDURE InsertOn;
   (* enter insert mode -- after INSERT MODE message is printed *)
      BEGIN
         attribute := NORMAL;
         GotoXY (cx, cy);
         Insert := TRUE;
      END InsertOn;


BEGIN   (* module initialization *)
   echo := Off;
   newline := FALSE;
   Insert := FALSE;
   EscState := FALSE;
   CurState1 := FALSE;
   CurState2 := FALSE;
END Term.