Power-Programmierung/CD1.mdf/magazine/drdobbs/1990/09/anderson.asc

Text File | 1990-08-08 | 130KB | 4,077 lines

_KERMIT FOR OS/2_
by Brian R. Anderson

[LISTING ONE]


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
      MPFROM2SHORT, 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;


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);
            WinSendMsg (hsys, MM_SETITEMATTR,
               MPFROM2SHORT (SC_CLOSE, 1),
               MPFROM2SHORT (MIA_DISABLED, MIA_DISABLED));

            (* Expand Window to Nearly Full Size, And Display the Title *)
            WinQueryWindowPos (HWND_DESKTOP, ADR (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.

[LISTING TWO]

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  : MPARAM;
      mp2  : MPARAM) : MRESULT [LONG, LOADDS];

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

END Shell.


[LISTING THREE]

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.



[LISTING FOUR]

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: Green, Magenta, Cyan *)

   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.

[LISTING FIVE]

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 : MPARAM);
   (* Output messages for Packet Assembler/Disassembler *)

END PAD.


[LISTING SIX]

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 : MPARAM);
   (* Process DataLink Messages *)

END DataLink.


[LISTING SEVEN]

(*************************************************************)
(*                                                           *)
(*                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.


[LISTING EIGHT]

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.



[LISTING NINE]

IMPLEMENTATION MODULE Shell;

   FROM SYSTEM IMPORT
      ADDRESS, ADR;

   IMPORT ASCII;

   FROM OS2DEF IMPORT
      LOWORD, HIWORD, 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, MPFROM2SHORT,
      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;

   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, 0, 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, 0, 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);
         WinSendMsg (h, MM_SETITEMATTR,
            MPFROM2SHORT (item, 1),
            MPFROM2SHORT (MIA_DISABLED, MIA_DISABLED));
      END Disable;


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

      VAR
         h : HWND;
         atr : USHORT;

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


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

      VAR
         h : HWND;

      BEGIN
         h := WinWindowFromID (FrameWindow, FID_MENU);
         WinSendMsg (h, MM_SETITEMATTR,
            MPFROM2SHORT (item, 1),
            MPFROM2SHORT (MIA_CHECKED, MIA_CHECKED));
      END Check;


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

      VAR
         h : HWND;
         atr : USHORT;

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


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

      VAR
         rcl : RECTL;
         rc : USHORT;

      BEGIN
         CASE  LOWORD (item) 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, ADR (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, 0, 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   : MPARAM;
         mp2   : MPARAM) : MRESULT [LONG, LOADDS];
      BEGIN
         CASE msg OF
            WM_INITDLG:
               WinSendDlgItemMsg (hwnd, comport, BM_SETCHECK, 1, 0);
               WinSetFocus (HWND_DESKTOP, WinWindowFromID (hwnd, comport));
               RETURN 1;
         |  WM_CONTROL:
               comport := LOWORD (mp1);
               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   : MPARAM;
         mp2   : MPARAM) : MRESULT [LONG, LOADDS];
      BEGIN
         WITH Settings[comport - COM_OFF] DO
            CASE msg OF
               WM_INITDLG:
                  WinSendDlgItemMsg (hwnd, baudrate, BM_SETCHECK, 1, 0);
                  WinSetFocus (HWND_DESKTOP, WinWindowFromID (hwnd, baudrate));
                  RETURN 1;
            |  WM_CONTROL:
                  baudrate := LOWORD (mp1);
                  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   : MPARAM;
         mp2   : MPARAM) : MRESULT [LONG, LOADDS];
      BEGIN
         WITH Settings[comport - COM_OFF] DO
            CASE msg OF
               WM_INITDLG:
                  WinSendDlgItemMsg (hwnd, databits, BM_SETCHECK, 1, 0);
                  WinSetFocus (HWND_DESKTOP, WinWindowFromID (hwnd, databits));
                  RETURN 1;
            |  WM_CONTROL:
                  databits := LOWORD (mp1);
                  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   : MPARAM;
         mp2   : MPARAM) : MRESULT [LONG, LOADDS];
      BEGIN
         WITH Settings[comport - COM_OFF] DO
            CASE msg OF
               WM_INITDLG:
                  WinSendDlgItemMsg (hwnd, stopbits, BM_SETCHECK, 1, 0);
                  WinSetFocus (HWND_DESKTOP, WinWindowFromID (hwnd, stopbits));
                  RETURN 1;
            |  WM_CONTROL:
                  stopbits := LOWORD (mp1);
                  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   : MPARAM;
         mp2   : MPARAM) : MRESULT [LONG, LOADDS];
      BEGIN
         WITH Settings[comport - COM_OFF] DO
            CASE msg OF
               WM_INITDLG:
                  WinSendDlgItemMsg (hwnd, parity, BM_SETCHECK, 1, 0);
                  WinSetFocus (HWND_DESKTOP, WinWindowFromID (hwnd, parity));
                  RETURN 1;
            |  WM_CONTROL:
                  parity := LOWORD (mp1);
                  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   : MPARAM;
         mp2   : MPARAM) : MRESULT [LONG, LOADDS];
      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   : MPARAM;
         mp2   : MPARAM) : MRESULT [LONG, LOADDS];
      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   : MPARAM;
         mp2   : MPARAM) : MRESULT [LONG, LOADDS];
      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   : MPARAM;
         mp2   : MPARAM) : MRESULT [LONG, LOADDS];
      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   : MPARAM;
         mp2   : MPARAM) : MRESULT [LONG, LOADDS];
      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 : 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 (LOWORD (mp1));     (* 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 := LOWORD (mp2);    (* 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   : MPARAM;
         mp2   : MPARAM) : MRESULT [LONG, LOADDS];

      VAR
         ch : CHAR;
         hps       : HPS;
         pswp      : PSWP;
         c1, c2    : CHAR;

      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, 0, 0);
                  ELSIF (NOT TermMode) AND
                   (BITSET (pswp^.fs) * BITSET (SWP_MAXIMIZE) # {}) THEN
                     (* Prevent maximized window EXCEPT in terminal mode *)
                     WinPostMsg (FrameWindow, WM_SETRESTORE, 0, 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 (LOWORD (mp1)));   (* 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, ADDRESS (NULL));
               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  : MPARAM;
      mp2  : MPARAM) : MRESULT [LONG, LOADDS];

      VAR
         mp : USHORT;
         hps : HPS;
         c1, c2 : CHAR;

      BEGIN
         CASE msg OF
            WM_PAINT:
               hps := WinBeginPaint (hwnd, NULL, ADDRESS (NULL));
               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 := LOWORD (mp1);
               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.



[LISTING TEN]

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 OS2DEF IMPORT
      ULONG;

   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
      WinPostMsg, MPFROM2SHORT;

   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 = 213C;   (* Alt-F1 *)
      AF2 = 214C;   (* 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;


   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, 0, 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
               WinPostMsg (FrameWindow, WM_TERM, MPFROM2SHORT (ORD (ch), 0), 0);
            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.


[LISTING ELEVEN]

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.



[LISTING TWELVE]

(**************************************************************************)
(*                                                                        *)
(*                     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.


[LISTING THIRTEEN]

IMPLEMENTATION MODULE Files;   (* File I/O for Kermit *)

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

   FROM Strings IMPORT
      Append;

   FROM Conversions IMPORT
      CardToString;

   FROM SYSTEM IMPORT
      ADR, SIZE;


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


   VAR
      ext : CARDINAL;  (* new file extensions to avoid name conflict *)
      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
         ch : CHAR;
         str : ARRAY [0..3] OF CHAR;
         i : CARDINAL;
         b : BOOLEAN;

      BEGIN
         LOOP
            Lookup (f, name, FALSE);   (* check to see if file exists *)
            IF f.res = done THEN
               Close (f);
               (* Filename Clash: Change file name *)
               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] := '.';   name[i + 1] := 'K';   name[i + 2] := 0C;
               i := 0;
               CardToString (ext, 1, str, i, b);
               Append (name, str);   (* append new extension *)
               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 < 400 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 *)
   ext := 0;
END Files.




[LISTING FOURTEEN]

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.


[LISTING FIFTEEN]

IMPLEMENTATION MODULE KH;
END KH.


[LISTING SIXTEEN]

#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


[LISTING SEVENTEEN]

IMPLEMENTATION MODULE DataLink;  (* Sends and Receives Packets for PCKermit *)

   FROM ElapsedTime IMPORT
      StartTime, GetTime;

   FROM Screen IMPORT
      ClrScr, WriteString, WriteLn;

   FROM OS2DEF IMPORT
      HIWORD, LOWORD;

   FROM PMWIN IMPORT
      MPARAM, MPFROM2SHORT, 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;


   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!!! *)
               WinPostMsg (ChildFrameWindow, WM_DL,
                           MPFROM2SHORT (DL_BadCS, 0), 0);
               RETURN FALSE;
            END;
         ELSE
            WinPostMsg (ChildFrameWindow, WM_DL,
                        MPFROM2SHORT (DL_NoSOH, 0), 0);
            RETURN FALSE;
         END;
      END ReceivePacket;


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

END DataLink.


[LISTING EIGHTEEN]

#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, 229, 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



[LISTING NINETEEN]

HEAPSIZE 16384
STACKSIZE 16384
EXPORTS
    WindowProc
    ChildWindowProc


[FILE PCKERMIT]

OS2DEF.SYM: OS2DEF.DEF
    M2 OS2DEF.DEF/OUT:OS2DEF.SYM
OS2DEF.OBJ: OS2DEF.MOD OS2DEF.SYM
    M2 OS2DEF.MOD/OUT:OS2DEF.OBJ
PMWIN.SYM: PMWIN.DEF OS2DEF.SYM
    M2 PMWIN.DEF/OUT:PMWIN.SYM
PMWIN.OBJ: PMWIN.MOD OS2DEF.SYM PMWIN.SYM
    M2 PMWIN.MOD/OUT:PMWIN.OBJ
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 PMWIN.SYM OS2DEF.SYM
    M2 SHELL.DEF/OUT:SHELL.SYM
TERM.SYM: TERM.DEF
    M2 TERM.DEF/OUT:TERM.SYM
PAD.SYM: PAD.DEF PMWIN.SYM
    M2 PAD.DEF/OUT:PAD.SYM
DATALINK.SYM: DATALINK.DEF PAD.SYM PMWIN.SYM
    M2 DATALINK.DEF/OUT:DATALINK.SYM
PMAVIO.SYM: PMAVIO.DEF PMWIN.SYM OS2DEF.SYM
    M2 PMAVIO.DEF/OUT:PMAVIO.SYM
PMAVIO.OBJ: PMAVIO.MOD PMAVIO.SYM
    M2 PMAVIO.MOD/OUT:PMAVIO.OBJ
PMGPI.SYM: PMGPI.DEF OS2DEF.SYM
    M2 PMGPI.DEF/OUT:PMGPI.SYM
PMGPI.OBJ: PMGPI.MOD OS2DEF.SYM PMGPI.SYM
    M2 PMGPI.MOD/OUT:PMGPI.OBJ
COMMPORT.SYM: COMMPORT.DEF
    M2 COMMPORT.DEF/OUT:COMMPORT.SYM
COMMPORT.OBJ: COMMPORT.MOD COMMPORT.SYM
    M2 COMMPORT.MOD/OUT:COMMPORT.OBJ
FILES.SYM: FILES.DEF
    M2 FILES.DEF/OUT:FILES.SYM
PCKERMIT.OBJ: PCKERMIT.MOD SHELL.SYM KH.SYM PMWIN.SYM OS2DEF.SYM
    M2 PCKERMIT.MOD/OUT:PCKERMIT.OBJ
SCREEN.SYM: SCREEN.DEF PMAVIO.SYM
    M2 SCREEN.DEF/OUT:SCREEN.SYM
SCREEN.OBJ: SCREEN.MOD SCREEN.SYM
    M2 SCREEN.MOD/OUT:SCREEN.OBJ
FILES.OBJ: FILES.MOD FILES.SYM
    M2 FILES.MOD/OUT:FILES.OBJ
SHELL.OBJ: SHELL.MOD COMMPORT.SYM KH.SYM PMGPI.SYM PMWIN.SYM PMAVIO.SYM -
SCREEN.SYM DATALINK.SYM PAD.SYM TERM.SYM OS2DEF.SYM SHELL.SYM
    M2 SHELL.MOD/OUT:SHELL.OBJ
TERM.OBJ: TERM.MOD COMMPORT.SYM KH.SYM SHELL.SYM PMWIN.SYM SCREEN.SYM TERM.SYM
    M2 TERM.MOD/OUT:TERM.OBJ
PAD.OBJ: PAD.MOD DATALINK.SYM KH.SYM SHELL.SYM PMWIN.SYM COMMPORT.SYM -
FILES.SYM OS2DEF.SYM SCREEN.SYM PAD.SYM
    M2 PAD.MOD/OUT:PAD.OBJ
DATALINK.OBJ: DATALINK.MOD KH.SYM PAD.SYM COMMPORT.SYM SHELL.SYM PMWIN.SYM -
OS2DEF.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: OS2DEF.OBJ PMWIN.OBJ KH.OBJ PMAVIO.OBJ PMGPI.OBJ COMMPORT.OBJ -
PCKERMIT.OBJ SCREEN.OBJ FILES.OBJ SHELL.OBJ TERM.OBJ PAD.OBJ DATALINK.OBJ
    LINK @PCKERMIT.LNK
    rc PCKERMIT.res
PCKERMIT.exe: PCKERMIT.res
    rc PCKERMIT.res


[FILE PCKERMIT.LNK]

KH.OBJ+
pckermit.OBJ+
SCREEN.OBJ+
COMMPORT.OBJ+
FILES.OBJ+
SHELL.OBJ+
TERM.OBJ+
PAD.OBJ+
DATALINK.OBJ
pckermit
pckermit
PM+
M2LIB+
DOSCALLS+
OS2
pckermit.edf


[FILE 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 OS2DEF IMPORT
      HIWORD, LOWORD;

   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, MPFROM2SHORT, 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;


   PROCEDURE PtrToStr (mp : 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);
         UNTIL c = 0C;
      END PtrToStr;


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

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

      BEGIN
         CASE LOWORD (mp1) OF
            PAD_SendPacket:
               WriteString ("Sent Packet #");
               WriteInt (LOWORD (mp2), 5);
               WriteString ("  (ID: ");   WriteHex (HIWORD (mp2), 2);
               WriteString ("h)");
         |  PAD_ResendPacket:
               WriteString ("ERROR -- Resending:");   WriteLn;
               WriteString ("     Packet #");
               WriteInt (LOWORD (mp2), 5);
               WriteString ("  (ID: ");   WriteHex (HIWORD (mp2), 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 (LOWORD (mp2), 5);
               WriteString ("  (ID: ");   WriteHex (HIWORD (mp2), 2);
               WriteString ("h)");
         |  PAD_Filename:
               WriteString ("Filename = ");
               PtrToStr (mp2, Message);   WriteString (Message);
         |  PAD_RequestRepeat:
               WriteString ("ERROR -- Requesting Repeat:");   WriteLn;
               WriteString ("         Packet #");
               WriteInt (LOWORD (mp2), 5);
               WriteString ("  (ID: ");   WriteHex (HIWORD (mp2), 2);
               WriteString ("h)");
         |  PAD_DuplicatePacket:
               WriteString ("Discarding Duplicate:");   WriteLn;
               WriteString ("         Packet #");
               WriteString ("  (ID: ");   WriteHex (HIWORD (mp2), 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
               WinPostMsg (ChildFrameWindow, WM_PAD,
                  MPFROM2SHORT (PAD_ProbClSrcFile, 0),
                  ADR (sFname));
            END;
         END;
      END CloseInput;


   PROCEDURE NormalQuit;
   (* Exit from Thread, Post message to Window *)
      BEGIN
         WinPostMsg (ChildFrameWindow, WM_PAD,
            MPFROM2SHORT (PAD_Quit, 0), 0);
         DosExit (EXIT_THREAD, 0);
      END NormalQuit;


   PROCEDURE ErrorQuit;
   (* Exit from Thread, Post message to Window *)
      BEGIN
         WinPostMsg (ChildFrameWindow, WM_PAD,
            MPFROM2SHORT (PAD_Error, 0), 0);
         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;
         WinPostMsg (ChildFrameWindow, WM_PAD,
            MPFROM2SHORT (PAD_Msg, 0), ADR (ErrorMsg));
      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
         WinPostMsg (ChildFrameWindow, WM_PAD,
            MPFROM2SHORT (PAD_SendPacket, 0),
            MPFROM2SHORT (PktNbr, sSeq));

         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
               WinPostMsg (ChildFrameWindow, WM_PAD,
                  MPFROM2SHORT (PAD_ResendPacket, 0),
                  MPFROM2SHORT (PktNbr, sSeq));

               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
            WinPostMsg (ChildFrameWindow, WM_PAD,
               MPFROM2SHORT (PAD_Msg, 0),
               ADR ("No file specified..."));
            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
            WinPostMsg (ChildFrameWindow, WM_PAD,
               MPFROM2SHORT (PAD_NoSuchFile, 0),
               ADR (sFname));
            ErrorQuit;
         ELSE
            sSeq := 0;   PktNbr := 0;
            FlushUART;
            SendInit;   (* my configuration information *)
            IF NOT GetInitAck() THEN     (* get your configuration information *)
               WinPostMsg (ChildFrameWindow, WM_PAD,
                  MPFROM2SHORT (PAD_ExcessiveErrors, 0),
                  MPFROM2SHORT (0, 0));
               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
            WinPostMsg (ChildFrameWindow, WM_PAD,
               MPFROM2SHORT (PAD_ExcessiveErrors, 0),
               MPFROM2SHORT (0, 0));
            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;
            WinPostMsg (ChildFrameWindow, WM_PAD,
               MPFROM2SHORT (PAD_NoSuchFile, 0),
               ADR (sFname));
            ErrorQuit;
         END;

         WinPostMsg (ChildFrameWindow, WM_PAD,
            MPFROM2SHORT (PAD_Filename, 0),
            ADR (sFname));
         WinPostMsg (ChildFrameWindow, WM_PAD,
            MPFROM2SHORT (PAD_Msg, 0),
            ADR ("(<ESC> to abort file transfer.)"));

         SendFileName;
         IF NOT GetAck() THEN
            WinPostMsg (ChildFrameWindow, WM_PAD,
               MPFROM2SHORT (PAD_ExcessiveErrors, 0),
               MPFROM2SHORT (0, 0));
            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
                  WinPostMsg (ChildFrameWindow, WM_PAD,
                     MPFROM2SHORT (PAD_ExcessiveErrors, 0),
                     MPFROM2SHORT (0, 0));
                  CloseInput;
                  ErrorQuit;
               END;
               SendEOF;
               IF NOT GetAck() THEN
                  WinPostMsg (ChildFrameWindow, WM_PAD,
                     MPFROM2SHORT (PAD_ExcessiveErrors, 0),
                     MPFROM2SHORT (0, 0));
                  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
                  WinPostMsg (ChildFrameWindow, WM_PAD,
                     MPFROM2SHORT (PAD_ExcessiveErrors, 0),
                     MPFROM2SHORT (0, 0));
                  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
         WinPostMsg (ChildFrameWindow, WM_PAD,
            MPFROM2SHORT (PAD_ReceivedPacket, 0),
            MPFROM2SHORT (PktNbr, rSeq));
         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;
               WinPostMsg (ChildFrameWindow, WM_PAD,
                  MPFROM2SHORT (PAD_Filename, 0),
                  ADR (rFname));
               RETURN name;
            ELSIF RecOK AND (rP[3] = 'B') THEN
               RETURN eot;
            ELSE
               INC (trys);
               SendNak;
            END;
         END;
      END ReceiveHeader;


   PROCEDURE SendNak;
      BEGIN
         WinPostMsg (ChildFrameWindow, WM_PAD,
            MPFROM2SHORT (PAD_RequestRepeat, 0),
            MPFROM2SHORT (PktNbr, rSeq));
         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
            WinPostMsg (ChildFrameWindow, WM_PAD,
               MPFROM2SHORT (PAD_DuplicatePacket, 0),
               MPFROM2SHORT (0, rSeq));
         ELSE
            WinPostMsg (ChildFrameWindow, WM_PAD,
               MPFROM2SHORT (PAD_ReceivedPacket, 0),
               MPFROM2SHORT (PktNbr, rSeq));
            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;

         WinPostMsg (ChildFrameWindow, WM_PAD,
            MPFROM2SHORT (PAD_Msg, 0),
            ADR ("Ready to receive file(s)..."));
         WinPostMsg (ChildFrameWindow, WM_PAD,
            MPFROM2SHORT (PAD_Msg, 0),
            ADR ("(<ESC> to abort file transfer.)"));

         FlushUART;
         rSeq := 0;   PktNbr := 0;
         IF NOT ReceiveInit() THEN   (* your configuration information *)
            WinPostMsg (ChildFrameWindow, WM_PAD,
               MPFROM2SHORT (PAD_ExcessiveErrors, 0),
               MPFROM2SHORT (0, 0));
            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
                         WinPostMsg (ChildFrameWindow, WM_PAD,
                               MPFROM2SHORT (PAD_UnableToOpen, 0),
                               ADR (rFname));
                         ErrorQuit;
                      ELSE
                         PktNbr := 1;
                         EOF := FALSE;
                      END;
            |  fail : WinPostMsg (ChildFrameWindow, WM_PAD,
                            MPFROM2SHORT (PAD_ExcessiveErrors, 0),
                            MPFROM2SHORT (0, 0));
                      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
                        WinPostMsg (ChildFrameWindow, WM_PAD,
                           MPFROM2SHORT (PAD_ProbClDestFile, 0),
                           ADR (rFname));
                        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
                        WinPostMsg (ChildFrameWindow, WM_PAD,
                           MPFROM2SHORT (PAD_ErrWrtFile, 0),
                           ADR (rFname));
                        ErrorQuit;
                     END;
                     trys := 1;
                     SendAck (rSeq);
                  ELSE
                     INC (trys);
                     IF trys = MAXtrys THEN
                        WinPostMsg (ChildFrameWindow, WM_PAD,
                           MPFROM2SHORT (PAD_ExcessiveErrors, 0),
                           MPFROM2SHORT (0, 0));
                        ErrorQuit;
                     ELSE
                        SendNak;
                     END;
                  END;
               ELSE
                  INC (trys);
                  IF trys = MAXtrys THEN
                     WinPostMsg (ChildFrameWindow, WM_PAD,
                        MPFROM2SHORT (PAD_ExcessiveErrors, 0),
                        MPFROM2SHORT (0, 0));
                     ErrorQuit;
                  ELSE
                     SendNak;
                  END;
               END;
            END;
         END;
         NormalQuit;
      END Receive;


BEGIN   (* module initialization *)
   yourEOL := ASCII.cr;
   yourNPAD := 0;
   yourPADC := 0C;
END PAD.