GENWiki

Premier IT Outsourcing and Support Services within the UK

User Tools

Site Tools


archive:computers:andrson2

_KERMIT FOR OS/2_ by Brian R. Anderson

[LISTING ONE]

MODULE PCKermit; () (* *) (* PCKermit – by Brian R. Anderson *) (* Copyright © 1990 *) (* *) (* PCKermit is an implementation of the Kermit file transfer protocol *) (* developed at Columbia University. This (OS/2 PM) version is a *) (* port from the DOS version of Kermit that I wrote two years ago. *) (* My original DOS version appeared in the May 1989 issue of DDJ. *) (* *) (* The current version includes emulation of the TVI950 Video Display *) (* Terminal for interaction with IBM mainframes (through the IBM 7171). *) (* *) ()

 FROM SYSTEM IMPORT
    ADR;
  
 FROM OS2DEF IMPORT
    HAB, HWND, HPS, NULL, ULONG;
 FROM PMWIN IMPORT
    MPARAM, HMQ, QMSG, CS_SIZEREDRAW,  WS_VISIBLE, FS_ICON,      
    FCF_TITLEBAR, FCF_SYSMENU, FCF_SIZEBORDER, FCF_MINMAX, FCF_ACCELTABLE,
    FCF_SHELLPOSITION, FCF_TASKLIST, FCF_MENU, FCF_ICON, 
    SWP_MOVE, SWP_SIZE, SWP_MAXIMIZE, 
    HWND_DESKTOP, FID_SYSMENU, SC_CLOSE, MIA_DISABLED, MM_SETITEMATTR,
    WinInitialize, WinCreateMsgQueue, WinGetMsg, WinDispatchMsg, WinSendMsg,
    WinRegisterClass, WinCreateStdWindow, WinDestroyWindow, WinWindowFromID,
    WinDestroyMsgQueue, WinTerminate, WinSetWindowText, 
    WinSetWindowPos, WinQueryWindowPos;
 FROM KH IMPORT
    IDM_KERMIT;
 FROM Shell IMPORT
    Class, Title, Child, WindowProc, ChildWindowProc, 
    FrameWindow, ClientWindow, SetPort, Pos;
 
 CONST
    QUEUE_SIZE = 1024;   (* Large message queue for async events *)
 VAR
    AnchorBlock : HAB;
    MessageQueue : HMQ;
    Message : QMSG;
    FrameFlags : ULONG;
    hsys : HWND;
    MP1, MP2 : MPARAM;
       

BEGIN (* main *)

 AnchorBlock := WinInitialize(0);
  
 IF AnchorBlock # 0 THEN
    MessageQueue := WinCreateMsgQueue (AnchorBlock, QUEUE_SIZE);
  
    IF MessageQueue # 0 THEN
       (* Register the parent window class *)
       WinRegisterClass (
           AnchorBlock,
           ADR (Class),
           WindowProc,
           CS_SIZEREDRAW, 0);
       
       (* Register a child window class *)
       WinRegisterClass (
           AnchorBlock,
           ADR (Child),
           ChildWindowProc,
           CS_SIZEREDRAW, 0);
       
       (* Create a standard window *)
       FrameFlags := FCF_TITLEBAR + FCF_MENU + FCF_MINMAX + 
                     FCF_SYSMENU + FCF_SIZEBORDER + FCF_TASKLIST + 
                     FCF_ICON + FCF_SHELLPOSITION + FCF_ACCELTABLE;
       
       FrameWindow := WinCreateStdWindow (
                HWND_DESKTOP,           (* handle of the parent window *)
                WS_VISIBLE + FS_ICON,   (* the window style *)
                FrameFlags,             (* the window flags *)
                ADR(Class),             (* the window class *)
                NULL,                   (* the title bar text *)
                WS_VISIBLE,             (* client window style *)
                NULL,                   (* handle of resource module *)
                IDM_KERMIT,             (* resource id *)
                ClientWindow            (* returned client window handle *)
       );
        
       IF FrameWindow # 0 THEN
          (* Disable the CLOSE item on the system menu *)
          hsys := WinWindowFromID (FrameWindow, FID_SYSMENU);
          MP1.W1 := SC_CLOSE;   MP1.W2 := 1;
          MP2.W1 := MIA_DISABLED;   MP2.W2 := MIA_DISABLED;
          WinSendMsg (hsys, MM_SETITEMATTR, MP1, MP2);
          (* Expand Window to Nearly Full Size, And Display the Title *)
          WinQueryWindowPos (HWND_DESKTOP, Pos);
          WinSetWindowPos (FrameWindow, 0, 
             Pos.x + 3, Pos.y + 3, Pos.cx - 6, Pos.cy - 6, 
             SWP_MOVE + SWP_SIZE);
          WinSetWindowText (FrameWindow, ADR (Title));
          
          SetPort;   (* Try to initialize communications port *)
       
          WHILE WinGetMsg(AnchorBlock, Message, NULL, 0, 0) # 0 DO
             WinDispatchMsg(AnchorBlock, Message);
          END;
        
          WinDestroyWindow(FrameWindow);
       END;
       WinDestroyMsgQueue(MessageQueue);
    END;
    WinTerminate(AnchorBlock);
 END;

END PCKermit.

[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  [VALUE] : MPARAM; 
    mp2  [VALUE] : MPARAM) : MRESULT [LONG, WINDOWS];
 PROCEDURE ChildWindowProc ['ChildWindowProc'] (
    hwnd : HWND;
    msg  : USHORT;   
    mp1  [VALUE] : MPARAM; 
    mp2  [VALUE] : MPARAM) : MRESULT [LONG, WINDOWS];

END Shell.

[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 [VALUE] : 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 [VALUE] : 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
    HWND, HDC, HPS, RECTL, USHORT, NULL, ULONG;
 FROM Term IMPORT
    WM_TERM, WM_TERMQUIT, 
    Dir, TermThrProc, InitTerm, PutKbdChar, PutPortChar;
 FROM PAD IMPORT
    WM_PAD, PAD_Quit, PAD_Error, DoPADMsg, Aborted, sFname, Send, Receive;
 FROM DataLink IMPORT
    WM_DL, DoDLMsg;
          
 FROM Screen IMPORT
    hvps, ColorSet, White, Green, Amber, Color1, Color2, ClrScr, WriteLn;
    
 FROM DosCalls IMPORT
    DosCreateThread, DosSuspendThread, DosResumeThread, DosSleep;
 FROM PMAVIO IMPORT
    VioCreatePS, VioAssociate, VioDestroyPS, VioShowPS, WinDefAVioWindowProc,
    FORMAT_CGA, HVPS;
    
 FROM PMWIN IMPORT
    MPARAM, MRESULT, SWP, PSWP, 
    WS_VISIBLE, FCF_TITLEBAR, FCF_SIZEBORDER, FCF_SHELLPOSITION,
    WM_SYSCOMMAND, WM_MINMAXFRAME, SWP_MINIMIZE, HWND_DESKTOP, 
    WM_PAINT, WM_QUIT, WM_COMMAND, WM_INITDLG, WM_CONTROL, WM_HELP,
    WM_INITMENU, WM_SIZE, WM_DESTROY, WM_CREATE, WM_CHAR, 
    BM_SETCHECK, MBID_OK, MB_OK, MB_OKCANCEL, 
    KC_CHAR, KC_CTRL, KC_VIRTUALKEY, KC_KEYUP,
    SWP_SIZE, SWP_MOVE, SWP_MAXIMIZE, SWP_RESTORE,
    MB_ICONQUESTION, MB_ICONASTERISK, MB_ICONEXCLAMATION,
    FID_MENU, MM_SETITEMATTR, MM_QUERYITEMATTR, MIA_DISABLED, MIA_CHECKED, 
    WinCreateStdWindow, WinDestroyWindow,
    WinOpenWindowDC, WinSendMsg, WinQueryDlgItemText, WinInvalidateRect,
    WinDefWindowProc, WinBeginPaint, WinEndPaint, WinQueryWindowRect,
    WinSetWindowText, WinSetFocus, WinDlgBox, WinDefDlgProc, WinDismissDlg, 
    WinMessageBox, WinPostMsg, WinWindowFromID, WinSendDlgItemMsg,
    WinSetWindowPos, WinSetActiveWindow;
 FROM PMGPI IMPORT
    GpiErase;
 FROM KH IMPORT
    IDM_KERMIT, IDM_FILE, IDM_OPTIONS, IDM_SENDFN, ID_SENDFN,
    IDM_DIR, IDM_CONNECT, IDM_SEND, IDM_REC, IDM_DIRPATH, ID_DIRPATH, 
    IDM_DIREND, IDM_QUIT, IDM_ABOUT, IDM_HELPMENU, IDM_TERMHELP, 
    IDM_COMPORT, IDM_BAUDRATE, IDM_DATABITS, IDM_STOPBITS, IDM_PARITY, 
    COM_OFF, ID_COM1, ID_COM2, PARITY_OFF, ID_EVEN, ID_ODD, ID_NONE, 
    DATA_OFF, ID_DATA7, ID_DATA8, STOP_OFF, ID_STOP1, ID_STOP2,
    BAUD_OFF, ID_B110, ID_B150, ID_B300, ID_B600, ID_B1200, ID_B2400, 
    ID_B4800, ID_B9600, ID_B19K2,
    IDM_COLORS, IDM_WHITE, IDM_GREEN, IDM_AMBER, IDM_C1, IDM_C2;
 FROM CommPort IMPORT
    CommStatus, BaudRate, DataBits, StopBits, Parity, InitPort,
    StartReceiving, StopReceiving;
 
 FROM Strings IMPORT
    Assign, Append, AppendChar;
 
 
 CONST
    WM_SETMAX = 7000H;
    WM_SETFULL = 7001H;
    WM_SETRESTORE = 7002H;
    NONE = 0;   (* no port yet initialized *)
    STKSIZE = 4096;
    BUFSIZE = 4096;   (* Port receive buffers: room for two full screens *)
    PortError = "Port Is Already In Use -- EXIT? (Cancel Trys Another Port)";
    ESC = 33C;
    
 
 VAR
    FrameFlags : ULONG;
    TermStack : ARRAY [1..STKSIZE] OF CHAR;
    Stack : ARRAY [1..STKSIZE] OF CHAR;
    TermThr : CARDINAL;
    Thr : CARDINAL;
    hdc : HDC;
    frame_hvps, child_hvps : HVPS;
    TermMode : BOOLEAN;
    Path : ARRAY [0..60] OF CHAR;
    Banner : ARRAY [0..40] OF CHAR;
    PrevComPort : CARDINAL;
    Settings : ARRAY [0..1] OF RECORD
                                  baudrate : CARDINAL;
                                  databits : CARDINAL;
                                  parity : CARDINAL;
                                  stopbits : CARDINAL;
                               END;    
    MP1, MP2 : MPARAM;
                                     
 PROCEDURE SetFull;
 (* Changes window to full size *)
    BEGIN
       WinSetWindowPos (FrameWindow, 0,		
          Pos.x + 3, Pos.y + 3, Pos.cx - 6, Pos.cy - 6,
          SWP_MOVE + SWP_SIZE);
    END SetFull;
    
    		
 PROCEDURE SetRestore;
 (* Changes window to full size FROM maximized *)
    BEGIN
       WinSetWindowPos (FrameWindow, 0,
          Pos.x + 3, Pos.y + 3, Pos.cx - 6, Pos.cy - 6,		
          SWP_MOVE + SWP_SIZE + SWP_RESTORE);		  
    END SetRestore;
    
                      		  
 PROCEDURE SetMax;
 (* Changes window to maximized *)
    BEGIN
       WinSetWindowPos (FrameWindow, 0,                           
          Pos.x + 3, Pos.y + 3, Pos.cx - 6, Pos.cy - 6,		
          SWP_MOVE + SWP_SIZE + SWP_MAXIMIZE);	
    END SetMax;
    
                     								                  
 PROCEDURE SetBanner;
 (* Displays Abbreviated Program Title + Port Settings in Title Bar *)
    CONST
       PortName : ARRAY [0..1] OF ARRAY [0..5] OF CHAR =
          [["COM1:", 0C], ["COM2:", 0C]]; 
       BaudName : ARRAY [0..8] OF ARRAY [0..5] OF CHAR =
          [["110", 0C], ["150", 0C], ["300", 0C], 
           ["600", 0C], ["1200", 0C], ["2400", 0C], 
           ["4800", 0C], ["9600", 0C], ["19200", 0C]];  
       ParityName : ARRAY [0..2] OF CHAR = ['E', 'O', 'N'];
 
    BEGIN
       WITH Settings[comport - COM_OFF] DO
          Assign (Class, Banner);
          Append (Banner, " -- ");
          Append (Banner, PortName[comport - COM_OFF]);
          Append (Banner, BaudName[baudrate - BAUD_OFF]);
          AppendChar (Banner, ',');
          AppendChar (Banner, ParityName[parity - PARITY_OFF]);
          AppendChar (Banner, ',');
          AppendChar (Banner, CHR ((databits - DATA_OFF) + 30H));
          AppendChar (Banner, ',');
          AppendChar (Banner, CHR ((stopbits - STOP_OFF) + 30H)); 
          WinSetWindowText (FrameWindow, ADR (Banner));
       END;
    END SetBanner;
 
 
 PROCEDURE SetPort;
 (* Sets The Communications Parameters Chosen By User *)
    VAR
       status : CommStatus;
       rc : USHORT;
    
    BEGIN
       IF PrevComPort # NONE THEN
          StopReceiving (PrevComPort - COM_OFF);
       END;
       
       WITH Settings[comport - COM_OFF] DO
          status := InitPort (
             comport - COM_OFF,
             BaudRate (baudrate - BAUD_OFF),
             DataBits (databits - DATA_OFF),
             StopBits (stopbits - STOP_OFF),
             Parity (parity - PARITY_OFF),
          );
       END;
   
       IF status = Success THEN
          StartReceiving (comport - COM_OFF, BUFSIZE);
          PrevComPort := comport;
       ELSE
          rc := WinMessageBox (HWND_DESKTOP, FrameWindow, ADR (PortError),
                               0, 0, MB_OKCANCEL + MB_ICONEXCLAMATION);
          IF rc = MBID_OK THEN
             WinPostMsg (FrameWindow, WM_QUIT, MPARAM (0), MPARAM (0));
          ELSE   (* try the other port *)
             IF comport = ID_COM1 THEN
                comport := ID_COM2;
             ELSE
                comport := ID_COM1;
             END;
             SetPort;   (* recursive call for retry *)
          END;
       END;      
       SetBanner;
    END SetPort;
 PROCEDURE MakeChild (msg : ARRAY OF CHAR);
 (* Creates a child window for use by send or receive threads *)
    
    VAR
       c_hdc : HDC;
       
    BEGIN
       WinPostMsg (FrameWindow, WM_SETFULL, MPARAM (0), MPARAM (0));
          
       Disable (IDM_CONNECT);
       Disable (IDM_SEND);
       Disable (IDM_REC);
       Disable (IDM_DIR);
       Disable (IDM_OPTIONS);
       Disable (IDM_COLORS);
       
       (* Create a client window *)	 
       FrameFlags := FCF_TITLEBAR + FCF_SIZEBORDER;
       
       ChildFrameWindow := WinCreateStdWindow (
			ClientWindow,        (* handle of the parent window *)
			WS_VISIBLE,          (* the window style *)
			FrameFlags,          (* the window flags *)
			ADR(Child),          (* the window class *)
			NULL,                (* the title bar text *)
			WS_VISIBLE,          (* client window style *)
			NULL,                (* handle of resource module *)
			IDM_KERMIT,          (* resource id *)
			ChildClientWindow    (* returned client window handle *)
       );
       
       WinSetWindowPos (ChildFrameWindow, 0,
          Pos.cx DIV 4, Pos.cy DIV 4, 
          Pos.cx DIV 2, Pos.cy DIV 2 - 3,
          SWP_MOVE + SWP_SIZE);
       
       WinSetWindowText (ChildFrameWindow, ADR (msg));
       WinSetActiveWindow (HWND_DESKTOP, ChildFrameWindow);
                
       c_hdc := WinOpenWindowDC (ChildClientWindow);
       hvps := child_hvps;
       VioAssociate (c_hdc, hvps);
       ClrScr;	 (* clear the hvio window *)
    END MakeChild;
    
 PROCEDURE Disable (item : USHORT);
 (* Disables and "GREYS" a menu item *)   
 
    VAR
       h : HWND;
       
    BEGIN
       h := WinWindowFromID (FrameWindow, FID_MENU);
       MP1.W1 := item;   MP1.W2 := 1;
       MP2.W1 := MIA_DISABLED;   MP2.W2 := MIA_DISABLED;
       WinSendMsg (h, MM_SETITEMATTR, MP1, MP2);
    END Disable;
    
    
 PROCEDURE Enable (item : USHORT);
 (* Enables a menu item *)
 
    VAR
       h : HWND;
       atr : USHORT;
       
    BEGIN
       h := WinWindowFromID (FrameWindow, FID_MENU);
       MP1.W1 := item;   MP1.W2 := 1;
       MP2.W1 := MIA_DISABLED;   MP2.W2 := MIA_DISABLED;
       atr := USHORT (WinSendMsg (h, MM_QUERYITEMATTR, MP1, MP2));
       atr := USHORT (BITSET (atr) * (BITSET (MIA_DISABLED) / BITSET (-1)));                  
       MP1.W1 := item;   MP1.W2 := 1;
       MP2.W1 := MIA_DISABLED;   MP2.W2 := atr;
       WinSendMsg (h, MM_SETITEMATTR, MP1, MP2);
    END Enable;
    
             
 PROCEDURE Check (item : USHORT);
 (* Checks a menu item -- indicates that it is selected *)   
 
    VAR
       h : HWND;
       
    BEGIN
       h := WinWindowFromID (FrameWindow, FID_MENU);
       MP1.W1 := item;   MP1.W2 := 1;
       MP2.W1 := MIA_CHECKED;   MP2.W2 := MIA_CHECKED;
       WinSendMsg (h, MM_SETITEMATTR, MP1, MP2);
    END Check;
    
    
 PROCEDURE UnCheck (item : USHORT);
 (* Remove check from a menu item *)
 
    VAR
       h : HWND;
       atr : USHORT;
       
    BEGIN
       h := WinWindowFromID (FrameWindow, FID_MENU);
       MP1.W1 := item;   MP1.W2 := 1;
       MP2.W1 := MIA_CHECKED;   MP2.W2 := MIA_CHECKED;
       atr := USHORT (WinSendMsg (h, MM_QUERYITEMATTR, MP1, MP2));
       atr := USHORT (BITSET (atr) * (BITSET (MIA_CHECKED) / BITSET (-1)));                  
       MP1.W1 := item;   MP1.W2 := 1;
       MP2.W1 := MIA_CHECKED;   MP2.W2 := atr;
       WinSendMsg (h, MM_SETITEMATTR, MP1, MP2);
    END UnCheck;
    
             
 PROCEDURE DoMenu (hwnd : HWND; item [VALUE] : MPARAM);
 (* Processes Most Menu Interactions *)
 
    VAR
       rcl : RECTL;
       rc : USHORT;
       
    BEGIN
       CASE CARDINAL (item.W1) OF
          IDM_DIR:
             SetFull;
             WinQueryWindowRect (hwnd, rcl);
             WinDlgBox (HWND_DESKTOP, hwnd, PathDlgProc, 0, IDM_DIRPATH, 0);
             hvps := frame_hvps;
             VioAssociate (hdc, hvps);
             Dir (Path);
             WinDlgBox (HWND_DESKTOP, hwnd, DirEndDlgProc, 0, IDM_DIREND, 0);
             VioAssociate (0, hvps);
             WinInvalidateRect (hwnd, rcl, 0);
       |  IDM_CONNECT:
             TermMode := TRUE;
             Disable (IDM_CONNECT);
             Disable (IDM_SEND);
             Disable (IDM_REC);
             Disable (IDM_DIR);
             Disable (IDM_OPTIONS);
             Disable (IDM_COLORS);
             (* MAXIMIZE Window -- Required for Terminal Emulation *)
             SetMax;
             hvps := frame_hvps;
             VioAssociate (hdc, hvps);
             DosResumeThread (TermThr);
             InitTerm;
       |  IDM_SEND:
             WinDlgBox (HWND_DESKTOP, hwnd, SendFNDlgProc, 0, IDM_SENDFN, 0);
             MakeChild ("Send a File");
             DosCreateThread (Send, Thr, ADR (Stack[STKSIZE]));
       |  IDM_REC:
             MakeChild ("Receive a File"); 
             DosCreateThread (Receive, Thr, ADR (Stack[STKSIZE]));
       |  IDM_QUIT:
             rc := WinMessageBox (HWND_DESKTOP, ClientWindow,
                      ADR ("Do You Really Want To EXIT PCKermit?"),
                      ADR ("End Session"), 0, MB_OKCANCEL + MB_ICONQUESTION);
             IF rc = MBID_OK THEN
                StopReceiving (comport - COM_OFF);
                WinPostMsg (hwnd, WM_QUIT, MPARAM (0), MPARAM (0));
             END;
       |  IDM_COMPORT:
             WinDlgBox (HWND_DESKTOP, hwnd, ComDlgProc, 0, IDM_COMPORT, 0);
             SetPort;
       |  IDM_BAUDRATE:
             WinDlgBox (HWND_DESKTOP, hwnd, BaudDlgProc, 0, IDM_BAUDRATE, 0);
             SetPort;
       |  IDM_DATABITS:
             WinDlgBox (HWND_DESKTOP, hwnd, DataDlgProc, 0, IDM_DATABITS, 0);
             SetPort;
       |  IDM_STOPBITS:
             WinDlgBox (HWND_DESKTOP, hwnd, StopDlgProc, 0, IDM_STOPBITS, 0);
             SetPort;
       |  IDM_PARITY:
             WinDlgBox (HWND_DESKTOP, hwnd, ParityDlgProc, 0, IDM_PARITY, 0);
             SetPort;
       |  IDM_WHITE:
             UnCheck (ColorSet);
             ColorSet := IDM_WHITE;
             Check (ColorSet);
             White;
       |  IDM_GREEN:
             UnCheck (ColorSet);
             ColorSet := IDM_GREEN;
             Check (ColorSet);
             Green;
       |  IDM_AMBER:
             UnCheck (ColorSet);
             ColorSet := IDM_AMBER;
             Check (ColorSet);
             Amber;
       |  IDM_C1:
             UnCheck (ColorSet);
             ColorSet := IDM_C1;
             Check (ColorSet);
             Color1;
       |  IDM_C2:   
             UnCheck (ColorSet);
             ColorSet := IDM_C2;
             Check (ColorSet);
             Color2;           
       |  IDM_ABOUT:
             WinDlgBox (HWND_DESKTOP, hwnd, AboutDlgProc, 0, IDM_ABOUT, 0);
       ELSE
          (* Don't do anything... *)
       END;
    END DoMenu;   
 PROCEDURE ComDlgProc ['ComDlgProc'] (
 (* Process Dialog Box for choosing COM1/COM2 *)
       hwnd  : HWND;
       msg   : USHORT;   
       mp1   [VALUE] : MPARAM; 
       mp2   [VALUE] : MPARAM) : MRESULT [LONG, WINDOWS];
    BEGIN
       CASE msg OF
          WM_INITDLG:
             WinSendDlgItemMsg (hwnd, comport, BM_SETCHECK, 
             MPARAM (1), MPARAM (0));
             WinSetFocus (HWND_DESKTOP, WinWindowFromID (hwnd, comport));
             RETURN 1;
       |  WM_CONTROL:
             comport := mp1.W1;
             RETURN 0;
       |  WM_COMMAND:
             WinDismissDlg (hwnd, 1);
             RETURN 0;
       ELSE
          RETURN WinDefDlgProc (hwnd, msg, mp1, mp2);
       END;
    END ComDlgProc;
 
  
 PROCEDURE BaudDlgProc ['BaudDlgProc'] (
 (* Process Dialog Box for choosing Baud Rate *)
       hwnd  : HWND;
       msg   : USHORT;   
       mp1   [VALUE] : MPARAM; 
       mp2   [VALUE] : MPARAM) : MRESULT [LONG, WINDOWS];
    BEGIN
       WITH Settings[comport - COM_OFF] DO
          CASE msg OF
             WM_INITDLG:
                WinSendDlgItemMsg (hwnd, baudrate, BM_SETCHECK, 
                                     MPARAM (1), MPARAM (0));
                WinSetFocus (HWND_DESKTOP, WinWindowFromID (hwnd, baudrate));
                RETURN 1;
          |  WM_CONTROL:
                baudrate := mp1.W1;
                RETURN 0;
          |  WM_COMMAND:
                WinDismissDlg (hwnd, 1);
                RETURN 0;
          ELSE
             RETURN WinDefDlgProc (hwnd, msg, mp1, mp2);
          END;
       END;
    END BaudDlgProc;
 
  
 PROCEDURE DataDlgProc ['DataDlgProc'] (
 (* Process Dialog Box for choosing 7 or 8 data bits *)
       hwnd  : HWND;
       msg   : USHORT;   
       mp1   [VALUE] : MPARAM; 
       mp2   [VALUE] : MPARAM) : MRESULT [LONG, WINDOWS];
    BEGIN
       WITH Settings[comport - COM_OFF] DO
          CASE msg OF
             WM_INITDLG:
                WinSendDlgItemMsg (hwnd, databits, BM_SETCHECK, 
                                     MPARAM (1), MPARAM (0));
                WinSetFocus (HWND_DESKTOP, WinWindowFromID (hwnd, databits));
                RETURN 1;
          |  WM_CONTROL:
                databits := mp1.W1;
                RETURN 0;
          |  WM_COMMAND:
                WinDismissDlg (hwnd, 1);
                RETURN 0;
          ELSE
             RETURN WinDefDlgProc (hwnd, msg, mp1, mp2);
          END;
       END;
    END DataDlgProc;
 
  
 PROCEDURE StopDlgProc ['StopDlgProc'] (
 (* Process Dialog Box for choosing 1 or 2 stop bits *)
       hwnd  : HWND;
       msg   : USHORT;   
       mp1   [VALUE] : MPARAM; 
       mp2   [VALUE] : MPARAM) : MRESULT [LONG, WINDOWS];
    BEGIN
       WITH Settings[comport - COM_OFF] DO
          CASE msg OF
             WM_INITDLG:
                WinSendDlgItemMsg (hwnd, stopbits, BM_SETCHECK, 
                               MPARAM (1), MPARAM (0));
                WinSetFocus (HWND_DESKTOP, WinWindowFromID (hwnd, stopbits));
                RETURN 1;
          |  WM_CONTROL:
                stopbits := mp1.W1;
                RETURN 0;
          |  WM_COMMAND:
                WinDismissDlg (hwnd, 1);
                RETURN 0;
          ELSE
             RETURN WinDefDlgProc (hwnd, msg, mp1, mp2);
          END;
       END;
    END StopDlgProc;
 
  
 PROCEDURE ParityDlgProc ['ParityDlgProc'] (
 (* Process Dialog Box for choosing odd, even, or no parity *)
       hwnd  : HWND;
       msg   : USHORT;   
       mp1   [VALUE] : MPARAM; 
       mp2   [VALUE] : MPARAM) : MRESULT [LONG, WINDOWS];
    BEGIN
       WITH Settings[comport - COM_OFF] DO
          CASE msg OF
             WM_INITDLG:
                WinSendDlgItemMsg (hwnd, parity, BM_SETCHECK, 
                                     MPARAM (1), MPARAM (0));
                WinSetFocus (HWND_DESKTOP, WinWindowFromID (hwnd, parity));
                RETURN 1;
          |  WM_CONTROL:
                parity := mp1.W1;
                RETURN 0;
          |  WM_COMMAND:
                WinDismissDlg (hwnd, 1);
                RETURN 0;
          ELSE
             RETURN WinDefDlgProc (hwnd, msg, mp1, mp2);
          END;
       END;
    END ParityDlgProc;
 
  
 PROCEDURE AboutDlgProc ['AboutDlgProc'] (
 (* Process "About" Dialog Box *)
       hwnd  : HWND;
       msg   : USHORT;   
       mp1   [VALUE] : MPARAM; 
       mp2   [VALUE] : MPARAM) : MRESULT [LONG, WINDOWS];
    BEGIN
       IF msg = WM_COMMAND THEN
          WinDismissDlg (hwnd, 1);
          RETURN 0;
       ELSE
          RETURN WinDefDlgProc (hwnd, msg, mp1, mp2);
       END;
    END AboutDlgProc;
 PROCEDURE SendFNDlgProc ['SendFNDlgProc'] (
 (* Process Dialog Box that obtains send filename from user *)
       hwnd  : HWND;
       msg   : USHORT;   
       mp1   [VALUE] : MPARAM; 
       mp2   [VALUE] : MPARAM) : MRESULT [LONG, WINDOWS];
    BEGIN
       CASE msg OF
          WM_INITDLG:
             WinSetFocus (HWND_DESKTOP, WinWindowFromID (hwnd, ID_SENDFN));
             RETURN 1;
       |  WM_COMMAND:
             WinQueryDlgItemText (hwnd, ID_SENDFN, 20, ADR (sFname));
             WinDismissDlg (hwnd, 1);
             RETURN 0;
       ELSE
          RETURN WinDefDlgProc (hwnd, msg, mp1, mp2);
       END;
    END SendFNDlgProc;
    
 PROCEDURE PathDlgProc ['PathDlgProc'] (
 (* Process Dialog Box that obtains directory path from user *)
       hwnd  : HWND;
       msg   : USHORT;   
       mp1   [VALUE] : MPARAM; 
       mp2   [VALUE] : MPARAM) : MRESULT [LONG, WINDOWS];
    BEGIN
       CASE msg OF
          WM_INITDLG:
             WinSetFocus (HWND_DESKTOP, WinWindowFromID (hwnd, ID_DIRPATH));
             RETURN 1;
       |  WM_COMMAND:
             WinQueryDlgItemText (hwnd, ID_DIRPATH, 60, ADR (Path));
             WinDismissDlg (hwnd, 1);
             RETURN 0;
       ELSE
          RETURN WinDefDlgProc (hwnd, msg, mp1, mp2);
       END;
    END PathDlgProc;
 PROCEDURE DirEndDlgProc ['DirEndDlgProc'] (
 (* Process Dialog Box to allow user to cancel directory *)
       hwnd  : HWND;
       msg   : USHORT;   
       mp1   [VALUE] : MPARAM; 
       mp2   [VALUE] : MPARAM) : MRESULT [LONG, WINDOWS];
    BEGIN
       IF msg = WM_COMMAND THEN
          WinDismissDlg (hwnd, 1);
          RETURN 0;
       ELSE
          RETURN WinDefDlgProc (hwnd, msg, mp1, mp2);
       END;
    END DirEndDlgProc;
    
 
 PROCEDURE HelpDlgProc ['HelpDlgProc'] (
 (* Process Dialog Boxes for the HELP *)
       hwnd  : HWND;
       msg   : USHORT;   
       mp1   [VALUE] : MPARAM; 
       mp2   [VALUE] : MPARAM) : MRESULT [LONG, WINDOWS];
    BEGIN
       IF msg = WM_COMMAND THEN
          WinDismissDlg (hwnd, 1);
          RETURN 0;
       ELSE
          RETURN WinDefDlgProc (hwnd, msg, mp1, mp2);
       END;
    END HelpDlgProc;
 PROCEDURE KeyTranslate (mp1, mp2 [VALUE] : MPARAM; VAR c1, c2 : CHAR) : BOOLEAN;
 (* Translates WM_CHAR message into ascii keystroke *)
 
    VAR
		code : CARDINAL;	 
		fs : BITSET;	
		VK, KU, CH, CT : BOOLEAN;	 
 
    BEGIN
       fs := BITSET (mp1.W1);	 (* flags *)				
       VK := (fs * BITSET (KC_VIRTUALKEY)) # {};			  
       KU := (fs * BITSET (KC_KEYUP)) # {};			
       CH := (fs * BITSET (KC_CHAR)) # {};			  
       CT := (fs * BITSET (KC_CTRL)) # {};			  
       IF (NOT KU) THEN			 
          code := mp2.W1;	(* character code *)			  
          c1 := CHR (code);			  
          c2 := CHR (code DIV 256);			 
          IF ORD (c1) = 0E0H THEN	  (* function *)			 
             c1 := 0C;			   
          END;			 
          IF CT AND (NOT CH) AND (NOT VK) AND (code # 0) THEN			
             c1 := CHR (CARDINAL ((BITSET (ORD (c1)) * BITSET (1FH))));
          END;			 
          RETURN TRUE;
       ELSE
          RETURN FALSE;
       END;
    END KeyTranslate;
    
       
 PROCEDURE WindowProc ['WindowProc'] (
 (* Main Window Procedure -- Handles message from PM and elsewhere *)
       hwnd  : HWND;
       msg   : USHORT;   
       mp1   [VALUE] : MPARAM; 
       mp2   [VALUE] : MPARAM) : MRESULT [LONG, WINDOWS];
    VAR
       ch : CHAR;
       hps       : HPS;
       pswp      : PSWP;
       c1, c2    : CHAR;
       NullRectl [0:0] : RECTL;
       
    BEGIN
       CASE msg OF 
          WM_HELP:
             IF TermMode THEN
                WinDlgBox (HWND_DESKTOP, hwnd, HelpDlgProc, 
                           0, IDM_TERMHELP, 0);
             ELSE
                WinDlgBox (HWND_DESKTOP, hwnd, HelpDlgProc, 
                           0, IDM_HELPMENU, 0);
             END;
             RETURN 0;
       |  WM_SETFULL:
             SetFull;
             RETURN 0;
       |  WM_SETRESTORE:
             SetRestore;
             RETURN 0;
       |  WM_SETMAX:
             SetMax;
             RETURN 0;
       |  WM_MINMAXFRAME:
             pswp := PSWP (mp1);
             IF BITSET (pswp^.fs) * BITSET (SWP_MINIMIZE) # {} THEN
                (* Don't Display Port Settings While Minimized *)
                WinSetWindowText (FrameWindow, ADR (Title));
             ELSE
                WinSetWindowText (FrameWindow, ADR (Banner));
                IF TermMode AND
                 (BITSET (pswp^.fs) * BITSET (SWP_RESTORE) # {}) THEN
                   (* Force window to be maximized in terminal mode *)
                   
                   WinPostMsg (FrameWindow, WM_SETMAX, 
                               MPARAM (0), MPARAM (0));
                ELSIF (NOT TermMode) AND
                 (BITSET (pswp^.fs) * BITSET (SWP_MAXIMIZE) # {}) THEN
                   (* Prevent maximized window EXCEPT in terminal mode *)
                   WinPostMsg (FrameWindow, WM_SETRESTORE, 
                               MPARAM (0), MPARAM (0));
                ELSE
                   (* Do Nothing *)
                END;
             END;
             RETURN WinDefWindowProc (hwnd, msg, mp1, mp2);
       |  WM_CREATE:
             hdc := WinOpenWindowDC (hwnd);
             VioCreatePS (frame_hvps, 25, 80, 0, FORMAT_CGA, 0);
             VioCreatePS (child_hvps, 16, 40, 0, FORMAT_CGA, 0);
             DosCreateThread (TermThrProc, TermThr, ADR (TermStack[STKSIZE]));
             DosSuspendThread (TermThr);
             RETURN 0;
       |  WM_INITMENU:
             Check (ColorSet);
             RETURN 0;
       |  WM_COMMAND: 
             DoMenu (hwnd, mp1);
             RETURN 0;
       |  WM_TERMQUIT:
             TermMode := FALSE;
             DosSuspendThread (TermThr);
             VioAssociate (0, hvps);
             (* Restore The Window *)
             SetRestore;
             Enable (IDM_CONNECT);
             Enable (IDM_SEND);
             Enable (IDM_REC);
             Enable (IDM_DIR);
             Enable (IDM_OPTIONS);
             Enable (IDM_COLORS);
             RETURN 0;
       |  WM_TERM:
             PutPortChar (CHR (mp1.W1));   (* To Screen *)
             RETURN 0;
       |  WM_CHAR:
             IF TermMode THEN
                IF KeyTranslate (mp1, mp2, c1, c2) THEN
                   PutKbdChar (c1, c2);   (* To Port *)
                   RETURN 0;
                ELSE
                   RETURN WinDefAVioWindowProc (hwnd, msg, mp1, mp2);
                END;
             ELSE
                RETURN WinDefWindowProc (hwnd, msg, mp1, mp2);
             END;
       |  WM_PAINT:
             hps := WinBeginPaint (hwnd, NULL, NullRectl);
             GpiErase (hps);
             VioShowPS (25, 80, 0, hvps); 
             WinEndPaint (hps);
             RETURN 0;
       |  WM_SIZE:
             IF TermMode THEN
                RETURN WinDefAVioWindowProc (hwnd, msg, mp1, mp2);
             ELSE
                RETURN WinDefWindowProc (hwnd, msg, mp1, mp2);
             END;
       |  WM_DESTROY:
             VioDestroyPS (frame_hvps);
             VioDestroyPS (child_hvps);
             RETURN 0;
       ELSE
          RETURN WinDefWindowProc (hwnd, msg, mp1, mp2);
       END;
    END WindowProc;
    
 PROCEDURE ChildWindowProc ['ChildWindowProc'] (
 (* Window Procedure for Send/Receive child windows *)
    hwnd : HWND;
    msg  : USHORT;   
    mp1  [VALUE] : MPARAM; 
    mp2  [VALUE] : MPARAM) : MRESULT [LONG, WINDOWS];
    
    VAR
       mp : USHORT;
       hps : HPS;
       c1, c2 : CHAR;
       NullRectl [0:0] : RECTL;
    
    BEGIN
       CASE msg OF
          WM_PAINT:
             hps := WinBeginPaint (hwnd, NULL, NullRectl);
             GpiErase (hps);
             VioShowPS (16, 40, 0, hvps); 
             WinEndPaint (hps);
             RETURN 0;
       |  WM_CHAR:
             IF KeyTranslate (mp1, mp2, c1, c2) AND (c1 = ESC) THEN
                Aborted := TRUE;
                RETURN 0;
             ELSE
                RETURN WinDefWindowProc (hwnd, msg, mp1, mp2);
             END;
       |  WM_PAD:
             mp := mp1.W1;
             IF (mp = PAD_Error) OR (mp = PAD_Quit) THEN
                WriteLn;
                IF mp = PAD_Error THEN
                   WinMessageBox (HWND_DESKTOP, hwnd, 
                                  ADR ("File Transfer Aborted"),
                                  ADR (Class), 0, MB_OK + MB_ICONEXCLAMATION);
                ELSE
                   WinMessageBox (HWND_DESKTOP, hwnd, 
                                     ADR ("File Transfer Completed"),
                                     ADR (Class), 0, MB_OK + MB_ICONASTERISK);
                END;
                DosSleep (2000);
                VioAssociate (0, hvps);
                WinDestroyWindow(ChildFrameWindow);
                Enable (IDM_CONNECT);
                Enable (IDM_SEND);
                Enable (IDM_REC);
                Enable (IDM_DIR);
                Enable (IDM_OPTIONS);
                Enable (IDM_COLORS);
             ELSE
                DoPADMsg (mp1, mp2);
             END;
             RETURN 0;
       |  WM_DL:
             DoDLMsg (mp1, mp2);
             RETURN 0;
       |  WM_SIZE:
             WinSetWindowPos (ChildFrameWindow, 0,
                Pos.cx DIV 4, Pos.cy DIV 4, 
                Pos.cx DIV 2, Pos.cy DIV 2 - 3,
                SWP_MOVE + SWP_SIZE);
             RETURN WinDefAVioWindowProc (hwnd, msg, mp1, mp2);
       ELSE
          RETURN WinDefWindowProc (hwnd, msg, mp1, mp2);
       END;
    END ChildWindowProc;

BEGIN (* Module Initialization *)

  WITH Settings[ID_COM1 - COM_OFF] DO
     baudrate := ID_B1200;
     parity := ID_EVEN;
     databits := ID_DATA7;
     stopbits := ID_STOP1;
  END;
  
  WITH Settings[ID_COM2 - COM_OFF] DO
     baudrate := ID_B19K2;
     parity := ID_EVEN;
     databits := ID_DATA7;
     stopbits := ID_STOP1;
  END;
  PrevComPort := NONE;
  comport := ID_COM1;
  TermMode := FALSE;   (* Not Initially in Terminal Emulation Mode *)

END Shell.

[LISTING 10 - PART II]

IMPLEMENTATION MODULE Term; (* TVI950 Terminal Emulation for Kermit *)

 FROM Drives IMPORT
    SetDrive;
    
 FROM Directories IMPORT
    FileAttributes, AttributeSet, DirectoryEntry, FindFirst, FindNext;
    
 FROM SYSTEM IMPORT
    ADR;
 FROM DosCalls IMPORT
    DosChDir, DosSleep;
          
 FROM Screen IMPORT
    ClrScr, ClrEol, GotoXY, GetXY,
    Right, Left, Up, Down, WriteAtt, WriteString, WriteLn, Write,
    attribute, NORMAL, HIGHLIGHT, REVERSE;		
    
 FROM PMWIN IMPORT
    MPARAM, WinPostMsg;
 FROM Shell IMPORT
    comport, FrameWindow;
    
 FROM KH IMPORT
    COM_OFF;
          
 FROM CommPort IMPORT
    CommStatus, GetChar, SendChar;
          
 FROM Strings IMPORT
    Length, Concat;
 
 IMPORT ASCII;
 CONST
    (* Key codes:  Note: F1 -- F12 are actually Shift-F1 -- Shift-F12 *)
    F1 = 124C;
    F2 = 125C;
    F3 = 126C;
    F4 = 127C;
    F5 = 130C;
    F6 = 131C;
    F7 = 132C;
    F8 = 133C;
    F9 = 134C;
    F10 = 135C;
    F11 = 207C;
    F12 = 210C;
    AF1 = 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;
    MP1, MP2 : MPARAM;
                
 PROCEDURE Dir (path : ARRAY OF CHAR);
 (* Change drive and/or directory; display a directory (in wide format) *)
 
    VAR
       gotFN : BOOLEAN;
       filename : ARRAY [0..20] OF CHAR;
       attr : AttributeSet;
       ent : DirectoryEntry;
       i, j, k : INTEGER;
       
    BEGIN
       filename := "";   (* in case no directory change *)
       i := Length (path);
       IF (i > 2) AND (path[1] = ':') THEN   (* drive specifier *)
          DEC (i, 2);
          SetDrive (ORD (CAP (path[0])) - ORD ('A')); 
          FOR j := 0 TO i DO   (* strip off the drive specifier *)
             path[j] := path[j + 2];
          END;
       END;
       IF i # 0 THEN
          gotFN := FALSE;
          WHILE (i >= 0) AND (path[i] # '\') DO
             IF path[i] = '.' THEN
                gotFN := TRUE;
             END;
             DEC (i);
          END;
          IF gotFN THEN
             j := i + 1;
             k := 0;
             WHILE path[j] # 0C DO
                filename[k] := path[j];
                INC (k);       INC (j);
             END;
             filename[k] := 0C;
             IF (i = -1) OR ((i = 0) AND (path[0] = '\')) THEN
                INC (i);
             END;
             path[i] := 0C;
          END;
       END;
       IF Length (path) # 0 THEN
          DosChDir (ADR (path), 0);
       END;
       IF Length (filename) = 0 THEN
          filename := "*.*";
       END;
       attr := AttributeSet {ReadOnly, Directory, Archive};
       i := 1;   (* keep track of position on line *)
       ClrScr;         
       gotFN := FindFirst (filename, attr, ent);
       WHILE gotFN DO
          WriteString (ent.name);
          j := Length (ent.name);
          WHILE j < 12 DO   (* 12 is maximum length for "filename.typ" *)
             Write (' ');
             INC (j);
          END;
          INC (i);   (* next position on this line *)
          IF i > 5 THEN
             i := 1;   (* start again on new line *)
             WriteLn;
          ELSE
             WriteString (" | ");
          END;
          gotFN := FindNext (ent);
       END;
       WriteLn;
    END Dir;
 PROCEDURE InitTerm;
 (* Clear Screen, Home Cursor, Get Ready For Terminal Emulation *)
    BEGIN
       ClrScr;
       Insert := FALSE;
       attribute := NORMAL;
    END InitTerm;   
 PROCEDURE PutKbdChar (ch1, ch2 : CHAR);
 (* Process a character received from the keyboard *)
    BEGIN
       IF ch1 = ASCII.enq THEN   (* Control-E *)
          echo := On;
       ELSIF ch1 = ASCII.ff THEN   (* Control-L *)
          echo := Local;
       ELSIF ch1 = ASCII.dc4 THEN   (* Control-T *)
          echo := Off;
       ELSIF ch1 = ASCII.so THEN   (* Control-N *)
          newline := TRUE;
       ELSIF ch1 = ASCII.si THEN   (* Control-O *)
          newline := FALSE;
       ELSIF (ch1 = ASCII.can) OR (ch1 = ESC) THEN
          attribute := NORMAL;
          WinPostMsg (FrameWindow, WM_TERMQUIT, MPARAM (0), MPARAM (0));
       ELSIF ch1 = 0C THEN
          Function (ch2);
       ELSE
          commStat := SendChar (comport - COM_OFF, ch1, FALSE);
          IF (echo = On) OR (echo = Local) THEN
             WriteAtt (ch1);
          END;
       END;
    END PutKbdChar;
 PROCEDURE Function (ch : CHAR);
 (* handles the function keys -- including PF1 - PF12, etc. *)
    BEGIN
       CASE ch OF
          F1 :  commStat := SendChar (comport - COM_OFF, ASCII.soh, FALSE);   
                commStat := SendChar (comport - COM_OFF, '@', FALSE);   
                commStat := SendChar (comport - COM_OFF, ASCII.cr, FALSE);
       |  F2 :  commStat := SendChar (comport - COM_OFF, ASCII.soh, FALSE);   
                commStat := SendChar (comport - COM_OFF, 'A', FALSE);   
                commStat := SendChar (comport - COM_OFF, ASCII.cr, FALSE);
       |  F3 :  commStat := SendChar (comport - COM_OFF, ASCII.soh, FALSE);   
                commStat := SendChar (comport - COM_OFF, 'B', FALSE);   
                commStat := SendChar (comport - COM_OFF, ASCII.cr, FALSE);
       |  F4 :  commStat := SendChar (comport - COM_OFF, ASCII.soh, FALSE);   
                commStat := SendChar (comport - COM_OFF, 'C', FALSE);   
                commStat := SendChar (comport - COM_OFF, ASCII.cr, FALSE);
       |  F5 :  commStat := SendChar (comport - COM_OFF, ASCII.soh, FALSE);   
                commStat := SendChar (comport - COM_OFF, 'D', FALSE);   
                commStat := SendChar (comport - COM_OFF, ASCII.cr, FALSE);
       |  F6 :  commStat := SendChar (comport - COM_OFF, ASCII.soh, FALSE);   
                commStat := SendChar (comport - COM_OFF, 'E', FALSE);   
                commStat := SendChar (comport - COM_OFF, ASCII.cr, FALSE);
       |  F7 :  commStat := SendChar (comport - COM_OFF, ASCII.soh, FALSE);   
                commStat := SendChar (comport - COM_OFF, 'F', FALSE);   
                commStat := SendChar (comport - COM_OFF, ASCII.cr, FALSE);
       |  F8 :  commStat := SendChar (comport - COM_OFF, ASCII.soh, FALSE);   
                commStat := SendChar (comport - COM_OFF, 'G', FALSE);   
                commStat := SendChar (comport - COM_OFF, ASCII.cr, FALSE);
       |  F9 :  commStat := SendChar (comport - COM_OFF, ASCII.soh, FALSE);   
                commStat := SendChar (comport - COM_OFF, 'H', FALSE);   
                commStat := SendChar (comport - COM_OFF, ASCII.cr, FALSE);
       |  F10, 
          PGDN: commStat := SendChar (comport - COM_OFF, ASCII.soh, FALSE);   
                commStat := SendChar (comport - COM_OFF, 'I', FALSE);   
                commStat := SendChar (comport - COM_OFF, ASCII.cr, FALSE);
       |  F11,
          AF1,
          PGUP: commStat := SendChar (comport - COM_OFF, ASCII.soh, FALSE);   
                commStat := SendChar (comport - COM_OFF, 'J', FALSE);   
                commStat := SendChar (comport - COM_OFF, ASCII.cr, FALSE);
       |  F12,
          AF2,
          ENDD: commStat := SendChar (comport - COM_OFF, ESC, FALSE);
                commStat := SendChar (comport - COM_OFF, 'Q', FALSE);
       |  INS : IF NOT Insert THEN
                   commStat := SendChar (comport - COM_OFF, ESC, FALSE);
                   commStat := SendChar (comport - COM_OFF, 'E', FALSE);
                END;
       |  DEL : commStat := SendChar (comport - COM_OFF, ESC, FALSE);
                commStat := SendChar (comport - COM_OFF, 'R', FALSE);
       |  HOME       : commStat := SendChar (comport - COM_OFF, CtrlZ, FALSE);
       |  UPARROW    : commStat := SendChar (comport - COM_OFF, CtrlK, FALSE);
       |  DOWNARROW  : commStat := SendChar (comport - COM_OFF, CtrlV, FALSE);
       |  LEFTARROW  : commStat := SendChar (comport - COM_OFF, CtrlH, FALSE);
       |  RIGHTARROW : commStat := SendChar (comport - COM_OFF, CtrlL, FALSE);
       ELSE
          (* do nothing *)
       END;
    END Function;
    
 PROCEDURE TermThrProc;
 (* Thread to get characters from port, put into buffer *)
 
    VAR
       ch : CHAR;
       
    BEGIN
       LOOP
          IF GetChar (comport - COM_OFF, ch) = Success THEN
             MP1.W1 := ORD (ch);   MP1.W2 := 0;
             MP2.L := 0;
             WinPostMsg (FrameWindow, WM_TERM, MP1, MP2);
          ELSE
             DosSleep (0);
          END
       END;
    END TermThrProc;
 VAR
    EscState, CurState1, CurState2 : BOOLEAN;
    CurChar1 : CHAR;
    
 PROCEDURE PutPortChar (ch : CHAR);
 (* Process a character received from the port *)
    BEGIN
       IF EscState THEN
          EscState := FALSE;
          IF ch = '=' THEN
             CurState1 := TRUE;
          ELSE
             Escape (ch);
          END;
       ELSIF CurState1 THEN
          CurState1 := FALSE;
          CurChar1 := ch;
          CurState2 := TRUE;
       ELSIF CurState2 THEN
          CurState2 := FALSE;
          Cursor (ch);
       ELSE
          CASE ch OF
             CtrlCaret, CtrlZ : ClrScr;
          |  CtrlL : Right;
          |  CtrlH : Left;
          |  CtrlK : Up;
          |  CtrlJ : Down;
          |  ESC   : EscState := TRUE;
          ELSE
             WriteAtt (ch);
             IF newline AND (ch = ASCII.cr) THEN
                WriteLn;
             END;
          END;
       END;
       IF echo = On THEN
          commStat := SendChar (comport - COM_OFF, ch, FALSE);
       END;
    END PutPortChar;
    
    
 PROCEDURE Escape (ch : CHAR);
 (* handles escape sequences *)
    BEGIN
       CASE ch OF
          '*' : ClrScr;
       |  'T', 'R' : ClrEol;
       |  ')' : attribute := NORMAL;
       |  '(' : attribute := HIGHLIGHT;   
       |  'f' : InsertMsg;
       |  'g' : InsertOn;
       ELSE
          (* ignore *)
       END;
    END Escape;
    
    
 PROCEDURE Cursor (ch : CHAR);
 (* handles cursor positioning *)
 
    VAR
       x, y : CARDINAL;
       
    BEGIN
       y := ORD (CurChar1) - 20H;
       x := ORD (ch) - 20H;
       GotoXY (x, y);   (* adjust for HOME = (1, 1) *)
    END Cursor;
    
    
 VAR
    cx, cy : CARDINAL;
    
 PROCEDURE InsertMsg;
 (* get ready insert mode -- place a message at the bottom of the screen *)
    BEGIN
       IF NOT Insert THEN
          GetXY (cx, cy);   (* record current position *)
          GotoXY (1, 24);
          ClrEol;
          attribute := REVERSE;
       ELSE   (* exit Insert mode *)
          GetXY (cx, cy);
          GotoXY (1, 24);
          ClrEol;
          GotoXY (cx, cy);
          Insert := FALSE;
       END;
    END InsertMsg;   
    
    
 PROCEDURE InsertOn;
 (* enter insert mode -- after INSERT MODE message is printed *)
    BEGIN
       attribute := NORMAL;
       GotoXY (cx, cy);
       Insert := TRUE;
    END InsertOn;   
    

BEGIN (* module initialization *)

 echo := Off;
 newline := FALSE;
 Insert := FALSE;
 EscState := FALSE;
 CurState1 := FALSE;
 CurState2 := FALSE;

END Term.

[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. 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 © 1988, 1989 *) (* by Stony Brook Software *) (* and *) (* Copyright © 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 PMWIN IMPORT
    MPARAM, WinPostMsg;
    
 FROM Shell IMPORT
    ChildFrameWindow, comport;
                
 FROM CommPort IMPORT
    CommStatus, GetChar, SendChar;
    
 FROM PAD IMPORT
    PacketType, yourNPAD, yourPADC, yourEOL; 
 FROM KH IMPORT
    COM_OFF;
    
 FROM SYSTEM IMPORT
    BYTE;
    
 IMPORT ASCII;
 CONST
    MAXtime = 100;   (* hundredths of a second -- i.e., one second *)
    MAXsohtrys = 100;
    DL_BadCS = 1;
    DL_NoSOH = 2;
    
 TYPE
    SMALLSET = SET OF [0..7];   (* BYTE *)               
    
 VAR
    ch : CHAR;
    status : CommStatus;
    MP1, MP2 : MPARAM;
          
 PROCEDURE Delay (t : CARDINAL);
 (* delay time in milliseconds *)
 
    VAR
       tmp : LONGINT;
       
    BEGIN
       tmp := t DIV 10;
       StartTime;
       WHILE GetTime() < tmp DO
       END;
    END Delay;
    
          
 PROCEDURE ByteAnd (a, b : BYTE) : BYTE;
    BEGIN
       RETURN BYTE (SMALLSET (a) * SMALLSET (b));
    END ByteAnd;
    
          
 PROCEDURE Char (c : INTEGER) : CHAR;
 (* converts a number 0-95 into a printable character *)
    BEGIN
       RETURN (CHR (CARDINAL (ABS (c) + 32)));
    END Char;
    
    
 PROCEDURE UnChar (c : CHAR) : INTEGER;
 (* converts a character into its corresponding number *)
    BEGIN
       RETURN (ABS (INTEGER (ORD (c)) - 32));
    END UnChar;
 PROCEDURE FlushUART;
 (* ensure no characters left in UART holding registers *)
    BEGIN
       Delay (500);
       REPEAT
          status := GetChar (comport - COM_OFF, ch); 
       UNTIL status = NoCharacter;
    END FlushUART;
      
 PROCEDURE SendPacket (s : PacketType);
 (* Adds SOH and CheckSum to packet *)
 
    VAR
       i : CARDINAL;
       checksum : INTEGER;
       
    BEGIN
       Delay (10);   (* give host a chance to catch its breath *)
       FOR i := 1 TO yourNPAD DO
          status := SendChar (comport - COM_OFF, yourPADC, FALSE);
       END;
       status := SendChar (comport - COM_OFF, ASCII.soh, FALSE);
       i := 1;
       checksum := 0;
       WHILE s[i] # 0C DO
          INC (checksum, ORD (s[i]));
          status := SendChar (comport - COM_OFF, s[i], FALSE);
          INC (i);
       END;
       checksum := checksum + (INTEGER (BITSET (checksum) * {7, 6}) DIV 64);
       checksum := INTEGER (BITSET (checksum) * {5, 4, 3, 2, 1, 0});
       status := SendChar (comport - COM_OFF, Char (checksum), FALSE);
       IF yourEOL # 0C THEN
          status := SendChar (comport - COM_OFF, yourEOL, FALSE);
       END;
    END SendPacket;
    
    
 PROCEDURE ReceivePacket (VAR r : PacketType) : BOOLEAN;
 (* strips SOH and checksum -- returns status: TRUE = good packet     *)
 (* received;  FALSE = timed out waiting for packet or checksum error *)
 
    VAR
       sohtrys : INTEGER;
       i, len : INTEGER;
       ch : CHAR;
       checksum : INTEGER;
       mycheck, yourcheck : CHAR;
       
    BEGIN
       sohtrys := MAXsohtrys;
       REPEAT
          StartTime;
          REPEAT
             status := GetChar (comport - COM_OFF, ch);
          UNTIL (status = Success) OR (GetTime() > MAXtime);
          ch := CHAR (ByteAnd (ch, 177C));   (* mask off MSB *)
          (* skip over up to MAXsohtrys padding characters, *)
          (* but allow only MAXsohtrys/10 timeouts          *)
          IF status = Success THEN
             DEC (sohtrys);
          ELSE
             DEC (sohtrys, 10);
          END;
       UNTIL (ch = ASCII.soh) OR (sohtrys <= 0);
       
       IF ch = ASCII.soh THEN
          (* receive rest of packet *)
          StartTime;
          REPEAT
             status := GetChar (comport - COM_OFF, ch);
          UNTIL (status = Success) OR (GetTime() > MAXtime);
          ch := CHAR (ByteAnd (ch, 177C));
          len := UnChar (ch);
          r[1] := ch;
          checksum := ORD (ch);
          i := 2;   (* on to second character in packet -- after LEN *)
          REPEAT
             StartTime;
             REPEAT
                status := GetChar (comport - COM_OFF, ch);
             UNTIL (status = Success) OR (GetTime() > MAXtime);
             ch := CHAR (ByteAnd (ch, 177C));
             r[i] := ch;   INC (i);
             INC (checksum, (ORD (ch)));   
          UNTIL (i > len);
          (* get checksum character *)
          StartTime;
          REPEAT 
             status := GetChar (comport - COM_OFF, ch);
          UNTIL (status = Success) OR (GetTime() > MAXtime);
          ch := CHAR (ByteAnd (ch, 177C));
          yourcheck := ch;
          r[i] := 0C;
          checksum := checksum + 
                          (INTEGER (BITSET (checksum) * {7, 6}) DIV 64);
          checksum := INTEGER (BITSET (checksum) *  {5, 4, 3, 2, 1, 0});
          mycheck := Char (checksum);
          IF mycheck = yourcheck THEN   (* checksum OK *)
             RETURN TRUE;
          ELSE   (* ERROR!!! *)
             MP1.W1 := DL_BadCS;   MP1.W2 := 0;
             MP2.L := 0;
             WinPostMsg (ChildFrameWindow, WM_DL, MP1, MP2);
             RETURN FALSE;  
          END;
       ELSE
          MP1.W1 := DL_NoSOH;   MP1.W2 := 0;
          MP2.L := 0;
          WinPostMsg (ChildFrameWindow, WM_DL, MP1, MP2);
          RETURN FALSE;
       END;
    END ReceivePacket;
    
    
 PROCEDURE DoDLMsg (mp1, mp2 [VALUE] : MPARAM);
 (* Process DataLink Messages *)
    BEGIN
       CASE CARDINAL (mp1.W1) OF
          DL_BadCS:
             WriteString ("Bad Checksum");   WriteLn;
       |  DL_NoSOH:
             WriteString ("No SOH");   WriteLn;
       ELSE
          (* Do Nothing *)
       END;
    END DoDLMsg;

END DataLink.

[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, 220, 8, WC_STATIC, SS_TEXT | DT_LEFT | DT_TOP | 
              WS_GROUP | WS_VISIBLE
      CONTROL "OK", 270, 193, 158, 38, 12, WC_BUTTON, BS_PUSHBUTTON | 
              BS_DEFAULT | WS_TABSTOP | WS_VISIBLE
      CONTROL "End                    =  End (as used in PROFS)", 271, 10, 50, 209, 8, 
              WC_STATIC, SS_TEXT | DT_LEFT | DT_TOP | WS_GROUP | WS_VISIBLE
  END

END

DLGTEMPLATE IDM_SENDFN LOADONCALL MOVEABLE DISCARDABLE BEGIN

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

END

DLGTEMPLATE IDM_DIRPATH LOADONCALL MOVEABLE DISCARDABLE BEGIN

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

END

DLGTEMPLATE IDM_DIREND LOADONCALL MOVEABLE DISCARDABLE BEGIN

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

END

[LISTING NINETEEN]

NAME PCKermit WINDOWAPI DESCRIPTION 'PCKermit: © Brian R. Anderson, 1990' HEAPSIZE 16384 STACKSIZE 8192 PROTMODE EXETYPE OS2 CODE LOADONCALL EXECUTEREAD NOIOPL NONCONFORMING DATA LOADONCALL READWRITE MULTIPLE NONSHARED NOIOPL EXPORTS

  WindowProc
  ChildWindowProc
  ComDlgProc
  BaudDlgProc
  DataDlgProc
  StopDlgProc
  ParityDlgProc
  AboutDlgProc
  SendFNDlgProc
  PathDlgProc
  DirEndDlgProc
  HelpDlgProc

[FILE PCKERMIT]

KH.SYM: KH.DEF

  M2 KH.DEF/OUT:KH.SYM

KH.OBJ: KH.MOD KH.SYM

  M2 KH.MOD/OUT:KH.OBJ

SHELL.SYM: SHELL.DEF

  M2 SHELL.DEF/OUT:SHELL.SYM

TERM.SYM: TERM.DEF

  M2 TERM.DEF/OUT:TERM.SYM

PAD.SYM: PAD.DEF

  M2 PAD.DEF/OUT:PAD.SYM

DATALINK.SYM: DATALINK.DEF PAD.SYM

  M2 DATALINK.DEF/OUT:DATALINK.SYM

COMMPORT.SYM: COMMPORT.DEF

  M2 COMMPORT.DEF/OUT:COMMPORT.SYM

FILES.SYM: FILES.DEF

  M2 FILES.DEF/OUT:FILES.SYM

pckermit.OBJ: pckermit.MOD SHELL.SYM KH.SYM

  M2 pckermit.MOD/OUT:pckermit.OBJ

SCREEN.SYM: SCREEN.DEF

  M2 SCREEN.DEF/OUT:SCREEN.SYM

SCREEN.OBJ: SCREEN.MOD KH.SYM SCREEN.SYM

  M2 SCREEN.MOD/OUT:SCREEN.OBJ

COMMPORT.OBJ: COMMPORT.MOD COMMPORT.SYM

  M2 COMMPORT.MOD/OUT:COMMPORT.OBJ

FILES.OBJ: FILES.MOD FILES.SYM

  M2 FILES.MOD/OUT:FILES.OBJ

SHELL.OBJ: SHELL.MOD COMMPORT.SYM KH.SYM SCREEN.SYM DATALINK.SYM PAD.SYM - TERM.SYM SHELL.SYM

  M2 SHELL.MOD/OUT:SHELL.OBJ

TERM.OBJ: TERM.MOD COMMPORT.SYM KH.SYM SHELL.SYM SCREEN.SYM TERM.SYM

  M2 TERM.MOD/OUT:TERM.OBJ

PAD.OBJ: PAD.MOD DATALINK.SYM KH.SYM SHELL.SYM FILES.SYM SCREEN.SYM PAD.SYM

  M2 PAD.MOD/OUT:PAD.OBJ

DATALINK.OBJ: DATALINK.MOD KH.SYM PAD.SYM COMMPORT.SYM SHELL.SYM SCREEN.SYM - DATALINK.SYM

  M2 DATALINK.MOD/OUT:DATALINK.OBJ

pckermit.res: pckermit.rc pckermit.h pckermit.ico

  rc -r pckermit.rc

pckermit.EXE: KH.OBJ pckermit.OBJ SCREEN.OBJ COMMPORT.OBJ FILES.OBJ SHELL.OBJ - TERM.OBJ PAD.OBJ DATALINK.OBJ

  LINK @pckermit.LNK
  rc pckermit.res

pckermit.exe: pckermit.res

  rc pckermit.res

[ FILE PCKERMIT.LNK]

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

[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 DosCalls IMPORT
    ExitType, DosExit;
    
 FROM Strings IMPORT
    Length, Assign;
    
 FROM FileSystem IMPORT
    File;
    
 FROM Directories IMPORT
    FileAttributes, AttributeSet, DirectoryEntry, FindFirst, FindNext;
    
 FROM Files IMPORT
    Status, FileType, Open, Create, CloseFile, Get, Put, DoWrite;
 FROM PMWIN IMPORT
    MPARAM, WinPostMsg;
    
 FROM Shell IMPORT
    ChildFrameWindow, comport;
    
 FROM KH IMPORT
    COM_OFF;
          
 FROM DataLink IMPORT
    FlushUART, SendPacket, ReceivePacket;
 FROM SYSTEM IMPORT
    BYTE;
                      
 IMPORT ASCII;
 
 CONST
    myMAXL = 94;
    myTIME = 10;
    myNPAD = 0;
    myPADC = 0C;
    myEOL  = 0C;
    myQCTL = '#';
    myQBIN = '&';
    myCHKT = '1';     (* one character checksum *)
    MAXtrys = 5;
    (* From DEFINITION MODULE:
    PAD_Quit = 0;  *)
    PAD_SendPacket = 1;
    PAD_ResendPacket = 2;
    PAD_NoSuchFile = 3;
    PAD_ExcessiveErrors = 4;
    PAD_ProbClSrcFile = 5;
    PAD_ReceivedPacket = 6;
    PAD_Filename = 7;
    PAD_RequestRepeat = 8;
    PAD_DuplicatePacket = 9;
    PAD_UnableToOpen = 10;
    PAD_ProbClDestFile = 11;
    PAD_ErrWrtFile = 12;
    PAD_Msg = 13;
    
    
 TYPE
    (* From Definition Module:
    PacketType = ARRAY [1..100] OF CHAR;
    *)
    SMALLSET = SET OF [0..7];   (* a byte *)
    
                      
 VAR
    yourMAXL : INTEGER;   (* maximum packet length -- up to 94 *)
    yourTIME : INTEGER;   (* time out -- seconds *) 
    (* From Definition Module
    yourNPAD : INTEGER;   (* number of padding characters *)
    yourPADC : CHAR;   (* padding characters *)
    yourEOL  : CHAR;   (* End Of Line -- terminator *)
    *)
    yourQCTL : CHAR;   (* character for quoting controls '#' *)
    yourQBIN : CHAR;   (* character for quoting binary '&' *)
    yourCHKT : CHAR;   (* check type -- 1 = checksum, etc. *)
    sF, rF : File;   (* files being sent/received *)
    InputFileOpen : BOOLEAN;
    rFname : ARRAY [0..20] OF CHAR;
    sP, rP : PacketType;   (* packets sent/received *)
    sSeq, rSeq : INTEGER;   (* sequence numbers *)
    PktNbr : INTEGER;   (* actual packet number -- no repeats up to 32,000 *)
    ErrorMsg : ARRAY [0..40] OF CHAR;
    MP1, MP2 : MPARAM;
    
 PROCEDURE PtrToStr (mp [VALUE] : MPARAM; VAR s : ARRAY OF CHAR);
 (* Convert a pointer to a string into a string *)
    
    TYPE
       PC = POINTER TO CHAR;
    
    VAR
       p : PC;
       i : CARDINAL;
       c : CHAR;
       
    BEGIN
       i := 0;
       REPEAT
          p := PC (mp);
          c := p^;
          s[i] := c;
          INC (i);
          INC (mp.L);
       UNTIL c = 0C;
    END PtrToStr;
 PROCEDURE DoPADMsg (mp1, mp2 [VALUE] : MPARAM);
 (* Output messages for Packet Assembler/Disassembler *)
          
    VAR
       Message : ARRAY [0..40] OF CHAR;
       
    BEGIN
       CASE CARDINAL (mp1.W1) OF
          PAD_SendPacket:
             WriteString ("Sent Packet #");   
             WriteInt (mp2.W1, 5);
             WriteString ("  (ID: ");   WriteHex (mp2.W2, 2);   
             WriteString ("h)");
       |  PAD_ResendPacket:
             WriteString ("ERROR -- Resending:");   WriteLn;
             WriteString ("     Packet #");   
             WriteInt (mp2.W1, 5);
             WriteString ("  (ID: ");   WriteHex (mp2.W2, 2);   
             WriteString ("h)");
       |  PAD_NoSuchFile:
             WriteString ("No such file: ");   
             PtrToStr (mp2, Message);   WriteString (Message);
       |  PAD_ExcessiveErrors:
             WriteString ("Excessive errors ..."); 
       |  PAD_ProbClSrcFile:
             WriteString ("Problem closing source file...");  
       |  PAD_ReceivedPacket:
             WriteString ("Received Packet #");   
             WriteInt (mp2.W1, 5);
             WriteString ("  (ID: ");   WriteHex (mp2.W2, 2);   
             WriteString ("h)");
       |  PAD_Filename:
             WriteString ("Filename = ");   
             PtrToStr (mp2, Message);   WriteString (Message);
       |  PAD_RequestRepeat:
             WriteString ("ERROR -- Requesting Repeat:");   WriteLn;
             WriteString ("         Packet #");   
             WriteInt (mp2.W1, 5);
             WriteString ("  (ID: ");   WriteHex (mp2.W2, 2);   
             WriteString ("h)");
       |  PAD_DuplicatePacket:
             WriteString ("Discarding Duplicate:");   WriteLn;
             WriteString ("         Packet #");   
             WriteString ("  (ID: ");   WriteHex (mp2.W2, 2);   
             WriteString ("h)");
       |  PAD_UnableToOpen:
             WriteString ("Unable to open file: ");
             PtrToStr (mp2, Message);   WriteString (Message);
       |  PAD_ProbClDestFile:
             WriteString ("Error closing file: ");   
             PtrToStr (mp2, Message);   WriteString (Message);
       |  PAD_ErrWrtFile:
             WriteString ("Error writing to file: ");   
             PtrToStr (mp2, Message);   WriteString (Message);
       |  PAD_Msg:
             PtrToStr (mp2, Message);   WriteString (Message);
       ELSE
          (* Do Nothing *)
       END;
       WriteLn; 
    END DoPADMsg;
    
 PROCEDURE CloseInput;
 (* Close the input file, if it exists.  Reset Input File Open flag *)
    BEGIN
       IF InputFileOpen THEN
          IF CloseFile (sF, Input) = Done THEN
             InputFileOpen := FALSE;
          ELSE
             MP1.W1 := PAD_ProbClSrcFile;   MP1.W2 := 0;
             MP2.L := LONGINT (ADR (sFname));
             WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
          END;
       END;
    END CloseInput;
    
    
 PROCEDURE NormalQuit;
 (* Exit from Thread, Post message to Window *)
    BEGIN
       MP1.W1 := PAD_Quit;   MP1.W2 := 0;
       MP1.L := 0;
       WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
       DosExit (EXIT_THREAD, 0);
    END NormalQuit;
    
    
 PROCEDURE ErrorQuit;
 (* Exit from Thread, Post message to Window *)
    BEGIN
       MP1.W1 := PAD_Error;   MP1.W2 := 0;
       MP2.L := 0;
       WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
       DosExit (EXIT_THREAD, 0);
    END ErrorQuit;
    
    
 PROCEDURE ByteXor (a, b : BYTE) : BYTE;
    BEGIN
       RETURN BYTE (SMALLSET (a) / SMALLSET (b));
    END ByteXor;
    
    
 PROCEDURE Char (c : INTEGER) : CHAR;
 (* converts a number 0-94 into a printable character *)
    BEGIN
       RETURN (CHR (CARDINAL (ABS (c) + 32)));
    END Char;
    
    
 PROCEDURE UnChar (c : CHAR) : INTEGER;
 (* converts a character into its corresponding number *)
    BEGIN
       RETURN (ABS (INTEGER (ORD (c)) - 32));
    END UnChar;
    
 PROCEDURE TellError (Seq : INTEGER);
 (* Send error packet *)
    BEGIN
       sP[1] := Char (15);
       sP[2] := Char (Seq);
       sP[3] := 'E';   (* E-type packet *)
       sP[4] := 'R';   (* error message starts *)
       sP[5] := 'e';
       sP[6] := 'm';
       sP[7] := 'o';
       sP[8] := 't';
       sP[9] := 'e';
       sP[10] := ' ';
       sP[11] := 'A';
       sP[12] := 'b';
       sP[13] := 'o';
       sP[14] := 'r';
       sP[15] := 't';
       sP[16] := 0C;
       SendPacket (sP);
    END TellError;
    
    
 PROCEDURE ShowError (p : PacketType);
 (* Output contents of error packet to the screen *)
 
    VAR
       i : INTEGER;
       
    BEGIN
       FOR i := 4 TO UnChar (p[1]) DO
          ErrorMsg[i - 4] := p[i];
       END;
       ErrorMsg[i - 4] := 0C;
       MP1.W1 := PAD_Msg;   MP1.W2 := 0;
       MP2.L := LONGINT (ADR (ErrorMsg));
       WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
    END ShowError;
    
    
 PROCEDURE youInit (type : CHAR);   
 (* I initialization YOU for Send and Receive *)      
    BEGIN
       sP[1] := Char (11);   (* Length *)
       sP[2] := Char (0);   (* Sequence *)
       sP[3] := type;
       sP[4] := Char (myMAXL);
       sP[5] := Char (myTIME);
       sP[6] := Char (myNPAD);
       sP[7] := CHAR (ByteXor (myPADC, 100C));
       sP[8] := Char (ORD (myEOL));
       sP[9] := myQCTL;
       sP[10] := myQBIN;
       sP[11] := myCHKT;
       sP[12] := 0C;   (* terminator *)
       SendPacket (sP);
    END youInit;
    
 PROCEDURE myInit;
 (* YOU initialize ME for Send and Receive *)
 
    VAR
       len : INTEGER;
       
    BEGIN
       len := UnChar (rP[1]);
       IF len >= 4 THEN
          yourMAXL := UnChar (rP[4]);
       ELSE
          yourMAXL := 94;
       END;
       IF len >= 5 THEN
          yourTIME := UnChar (rP[5]);
       ELSE
          yourTIME := 10;
       END;
       IF len >= 6 THEN
          yourNPAD := UnChar (rP[6]);
       ELSE
          yourNPAD := 0;
       END;
       IF len >= 7 THEN
          yourPADC := CHAR (ByteXor (rP[7], 100C));
       ELSE
          yourPADC := 0C;
       END;
       IF len >= 8 THEN
          yourEOL := CHR (UnChar (rP[8]));
       ELSE
          yourEOL := 0C;
       END;
       IF len >= 9 THEN
          yourQCTL := rP[9];
       ELSE
          yourQCTL := 0C;
       END;
       IF len >= 10 THEN
          yourQBIN := rP[10];
       ELSE
          yourQBIN := 0C;
       END;
       IF len >= 11 THEN
          yourCHKT := rP[11];
          IF yourCHKT # myCHKT THEN
             yourCHKT := '1';
          END;
       ELSE
          yourCHKT := '1';
       END;
    END myInit;
    
          
 PROCEDURE SendInit;
    BEGIN
       youInit ('S');
    END SendInit;
    
    
 PROCEDURE SendFileName;
 
    VAR
       i, j : INTEGER;
       
    BEGIN
       (* send file name *)
       i := 4;   j := 0;
       WHILE sFname[j] # 0C DO
          sP[i] := sFname[j];
          INC (i);   INC (j);
       END;
       sP[1] := Char (j + 3);
       sP[2] := Char (sSeq);
       sP[3] := 'F';   (* filename packet *)
       sP[i] := 0C;
       SendPacket (sP);
    END SendFileName;
    
    
 PROCEDURE SendEOF;
    BEGIN
       sP[1] := Char (3);
       sP[2] := Char (sSeq);
       sP[3] := 'Z';   (* end of file *)
       sP[4] := 0C;
       SendPacket (sP);
    END SendEOF;
    
    
 PROCEDURE SendEOT;
    BEGIN
       sP[1] := Char (3);
       sP[2] := Char (sSeq);
       sP[3] := 'B';   (* break -- end of transmit *)
       sP[4] := 0C;
       SendPacket (sP);
    END SendEOT;
    
    
 PROCEDURE GetAck() : BOOLEAN;
 (* Look for acknowledgement -- retry on timeouts or NAKs *)
 
    VAR
       Type : CHAR;
       Seq : INTEGER;
       retrys : INTEGER;
       AckOK : BOOLEAN;
        
    BEGIN
       MP1.W1 := PAD_SendPacket;   MP1.W2 := 0;
       MP2.W1 := PktNbr;   MP2.W2 := sSeq;
       WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
    
       retrys := MAXtrys;
       LOOP
          IF Aborted THEN
             TellError (sSeq);
             CloseInput;
             ErrorQuit;
          END;
          IF ReceivePacket (rP) THEN
             Seq := UnChar (rP[2]);
             Type := rP[3];
             IF (Seq = sSeq) AND (Type = 'Y') THEN
                AckOK := TRUE;
             ELSIF (Seq = (sSeq + 1) MOD 64) AND (Type = 'N') THEN
                AckOK := TRUE;   (* NAK for (n + 1) taken as ACK for n *)
             ELSIF Type = 'E' THEN
                ShowError (rP);
                AckOK := FALSE;
                retrys := 0;
             ELSE
                AckOK := FALSE;
             END;
          ELSE
             AckOK := FALSE;
          END;
          IF AckOK OR (retrys = 0) THEN
             EXIT;
          ELSE
             MP1.W1 := PAD_ResendPacket;   MP1.W2 := 0;
             MP2.W1 := PktNbr;   MP2.W2 := sSeq;
             WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
             
             DEC (retrys);
             FlushUART;
             SendPacket (sP);
          END;
       END;
    
       IF AckOK THEN
          INC (PktNbr);
          sSeq := (sSeq + 1) MOD 64;
          RETURN TRUE;
       ELSE
          RETURN FALSE;
       END;
    END GetAck;
       
 PROCEDURE GetInitAck() : BOOLEAN;
 (* configuration for remote station *)
    BEGIN
       IF GetAck() THEN
          myInit;
          RETURN TRUE;
       ELSE 
          RETURN FALSE;
       END;
    END GetInitAck;
    
    
 PROCEDURE Send;
 (* Send one or more files: sFname may be ambiguous *)
 
    TYPE
       LP = POINTER TO LIST;   (* list of filenames *)
       LIST = RECORD
                 fn : ARRAY [0..20] OF CHAR;
                 next : LP;
              END;
              
    VAR
       gotFN : BOOLEAN;
       attr : AttributeSet;
       ent : DirectoryEntry;
       front, back, t : LP;   (* add at back of queue, remove from front *)
       
    BEGIN
       Aborted := FALSE;
       InputFileOpen := FALSE;
       
       front := NIL;   back := NIL;
       attr := AttributeSet {};   (* normal files only *)
       IF Length (sFname) = 0 THEN
          MP1.W1 := PAD_Msg;   MP1.W2 := 0;
          MP2.L := LONGINT (ADR ("No file specified..."));
          WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
          ErrorQuit;
       ELSE
          gotFN := FindFirst (sFname, attr, ent);
          WHILE gotFN DO   (* build up a list of file names *)
             ALLOCATE (t, SIZE (LIST));
             Assign (ent.name, t^.fn);
             t^.next := NIL;
             IF front = NIL THEN
                front := t;   (* start from empty queue *)
             ELSE
                back^.next := t;   (* and to back of queue *)
             END;
             back := t;
             gotFN := FindNext (ent);
          END;
       END;
    
       IF front = NIL THEN   
          MP1.W1 := PAD_NoSuchFile;   MP1.W2 := 0;
          MP2.L := LONGINT (ADR (sFname));
          WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
          ErrorQuit;
       ELSE
          sSeq := 0;   PktNbr := 0;
          FlushUART;
          SendInit;   (* my configuration information *)
          IF NOT GetInitAck() THEN     (* get your configuration information *)
             MP1.W1 := PAD_ExcessiveErrors;   MP1.W2 := 0;
             MP2.L := 0;
             WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
             ErrorQuit;
          END;
           
          WHILE front # NIL DO   (* send the files *)
             Assign (front^.fn, sFname);
             PktNbr := 1;
             Send1;
             t := front;
             front := front^.next;
             DEALLOCATE (t, SIZE (LIST));
          END;
       END;
    
       SendEOT;
       IF NOT GetAck() THEN
          MP1.W1 := PAD_ExcessiveErrors;   MP1.W2 := 0;
          MP2.L := 0;
          WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
          CloseInput;
          ErrorQuit;
       END;
       NormalQuit;
    END Send;
    
          
 PROCEDURE Send1;
 (* Send one file: sFname *)
 
    VAR
       ch : CHAR;
       i : INTEGER;
       
    BEGIN
       IF Open (sF, sFname) = Done THEN
          InputFileOpen := TRUE;
       ELSE;
          MP1.W1 := PAD_NoSuchFile;   MP1.W2 := 0;
          MP2.L := LONGINT (ADR (sFname));
          WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
          ErrorQuit;
       END;
       
       MP1.W1 := PAD_Filename;   MP1.W2 := 0;
       MP2.L := LONGINT (ADR (sFname));
       WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
       MP1.W1 := PAD_Msg;   MP1.W2 := 0;
       MP2.L := LONGINT (ADR ("(<ESC> to abort file transfer.)"));
       WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
          
       SendFileName;        
       IF NOT GetAck() THEN
          MP1.W1 := PAD_ExcessiveErrors;   MP1.W2 := 0;
          MP2.L := 0;
          WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
          CloseInput;
          ErrorQuit;
       END;
       
       (* send file *)
       i := 4;
       LOOP
          IF Get (sF, ch) = EOF THEN   (* send current packet & terminate *)
             sP[1] := Char (i - 1);
             sP[2] := Char (sSeq);
             sP[3] := 'D';   (* data packet *)
             sP[i] := 0C;   (* indicate end of packet *)
             SendPacket (sP);
             IF NOT GetAck() THEN
                MP1.W1 := PAD_ExcessiveErrors;   MP1.W2 := 0;
                MP2.L := 0;
                WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
                CloseInput;
                ErrorQuit;
             END;
             SendEOF;
             IF NOT GetAck() THEN
                MP1.W1 := PAD_ExcessiveErrors;   MP1.W2 := 0;
                MP2.L := 0;
                WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
                CloseInput;
                ErrorQuit;
             END;
             EXIT;
          END;
                
          IF i >= (yourMAXL - 4) THEN   (* send current packet *)
             sP[1] := Char (i - 1);
             sP[2] := Char (sSeq);
             sP[3] := 'D';
             sP[i] := 0C;
             SendPacket (sP);
             IF NOT GetAck() THEN
                MP1.W1 := PAD_ExcessiveErrors;   MP1.W2 := 0;
                MP2.L := 0;
                WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
                CloseInput;
                ErrorQuit;
             END;
             i := 4;
          END;
          (* add character to current packet -- update count *)
          IF ch > 177C THEN   (* must be quoted (QBIN) and altered *)
             (* toggle bit 7 to turn it off *)
             ch := CHAR (ByteXor (ch, 200C));
             sP[i] := myQBIN;   INC (i);
          END;
          IF (ch < 40C) OR (ch = 177C) THEN   (* quote (QCTL) and alter *)
             (* toggle bit 6 to turn it on *)
             ch := CHAR (ByteXor (ch, 100C));
             sP[i] := myQCTL;   INC (i);
          END;
          IF (ch = myQCTL) OR (ch = myQBIN) THEN   (* must send it quoted *)
             sP[i] := myQCTL;   INC (i);
          END;
          sP[i] := ch;   INC (i);
       END;   (* loop *)
       
       CloseInput;
    END Send1;
    
 PROCEDURE ReceiveInit() : BOOLEAN;
 (* receive my initialization information from you *)
 
    VAR
       RecOK : BOOLEAN;
       trys : INTEGER;
        
    BEGIN
       trys := 1;
       LOOP
          IF Aborted THEN
             TellError (rSeq);
             ErrorQuit;
          END;
          RecOK := ReceivePacket (rP) AND (rP[3] = 'S');
          IF RecOK OR (trys = MAXtrys) THEN
             EXIT;
          ELSE
             INC (trys);
             SendNak;
          END;
       END;
       
       IF RecOK THEN
          myInit;
          RETURN TRUE;
       ELSE
          RETURN FALSE;
       END;   
    END ReceiveInit;
    
    
 PROCEDURE SendInitAck;
 (* acknowledge your initialization of ME and send mine for YOU *)
    BEGIN
       MP1.W1 := PAD_ReceivedPacket;   MP1.W2 := 0;
       MP2.W1 := PktNbr;   MP2.W2 := rSeq;
       WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
       INC (PktNbr);
       rSeq := (rSeq + 1) MOD 64;
       youInit ('Y');
    END SendInitAck;
    
    
 PROCEDURE ValidFileChar (VAR ch : CHAR) : BOOLEAN;
 (* checks if character is one of 'A'..'Z', '0'..'9', makes upper case *)
    BEGIN
       ch := CAP (ch);
       RETURN ((ch >= 'A') AND (ch <= 'Z')) OR ((ch >= '0') AND (ch <= '9'));
    END ValidFileChar;
 TYPE
    HeaderType = (name, eot, fail);
    
 PROCEDURE ReceiveHeader() : HeaderType;
 (* receive the filename -- alter for local conditions, if necessary *)
 
    VAR
       i, j, k : INTEGER;
       RecOK : BOOLEAN;
       trys : INTEGER;
       
    BEGIN
       trys := 1;
       LOOP
          IF Aborted THEN
             TellError (rSeq);
             ErrorQuit;
          END;
          RecOK := ReceivePacket (rP) AND ((rP[3] = 'F') OR (rP[3] = 'B'));
          IF trys = MAXtrys THEN
             RETURN fail;
          ELSIF RecOK AND (rP[3] = 'F') THEN
             i := 4;   (* data starts here *)
             j := 0;   (* beginning of filename string *)
             WHILE (ValidFileChar (rP[i])) AND (j < 8) DO
                rFname[j] := rP[i];
                INC (i);   INC (j);
             END;
             REPEAT
                INC (i);
             UNTIL (ValidFileChar (rP[i])) OR (rP[i] = 0C);
             rFname[j] := '.';   INC (j);
             k := 0;
             WHILE (ValidFileChar (rP[i])) AND (k < 3) DO
                rFname[j + k] := rP[i];
                INC (i);   INC (k);
             END;
             rFname[j + k] := 0C;  
             MP1.W1 := PAD_Filename;   MP1.W2 := 0;
             MP2.L := LONGINT (ADR (rFname));
             WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
             RETURN name;
          ELSIF RecOK AND (rP[3] = 'B') THEN
             RETURN eot;
          ELSE
             INC (trys);
             SendNak;
          END;
       END;
    END ReceiveHeader;
    
    
 PROCEDURE SendNak;
    BEGIN
       MP1.W1 := PAD_RequestRepeat;   MP1.W2 := 0;
       MP2.W1 := PktNbr;   MP2.W2 := rSeq;
       WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
       FlushUART;
       sP[1] := Char (3);   (* LEN *)
       sP[2] := Char (rSeq); 
       sP[3] := 'N';   (* negative acknowledgement *)
       sP[4] := 0C;
       SendPacket (sP);
    END SendNak;
    
    
 PROCEDURE SendAck (Seq : INTEGER);
    BEGIN
       IF Seq # rSeq THEN
          MP1.W1 := PAD_DuplicatePacket;   MP1.W2 := 0;
          MP2.W1 := 0;   MP2.W2 := rSeq;
          WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
       ELSE
          MP1.W1 := PAD_ReceivedPacket;   MP1.W2 := 0;
          MP2.W1 := PktNbr;   MP2.W2 := rSeq;
          WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
          rSeq := (rSeq + 1) MOD 64;
          INC (PktNbr);
       END;
       
       sP[1] := Char (3);
       sP[2] := Char (Seq);
       sP[3] := 'Y';   (* acknowledgement *)
       sP[4] := 0C;
       SendPacket (sP);
    END SendAck;
    
    
 PROCEDURE Receive;
 (* Receives a file  (or files) *)
 
    VAR
       ch, Type : CHAR;
       Seq : INTEGER;
       i : INTEGER;
       EOF, EOT, QBIN : BOOLEAN;
       trys : INTEGER;
                
    BEGIN
       Aborted := FALSE;
       
       MP1.W1 := PAD_Msg;   MP1.W2 := 0;
       MP2.L := LONGINT (ADR ("Ready to receive file(s)..."));
       WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
       MP1.W1 := PAD_Msg;   MP1.W2 := 0;
       MP2.L := LONGINT (ADR ("(<ESC> to abort file transfer.)"));
       WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
       FlushUART;
       rSeq := 0;   PktNbr := 0;  
       IF NOT ReceiveInit() THEN   (* your configuration information *)
          MP1.W1 := PAD_ExcessiveErrors;   MP1.W2 := 0;
          MP2.L := 0;
          WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
          ErrorQuit;
       END;
       SendInitAck;       (* send my configuration information *)
       EOT := FALSE;
       WHILE NOT EOT DO
          CASE ReceiveHeader() OF
             eot  : EOT := TRUE;   EOF := TRUE;
          |  name : IF Create (rF, rFname) # Done THEN
                       MP1.W1 := PAD_UnableToOpen;   MP1.W2 := 0;
                       MP2.L := LONGINT (ADR (rFname));
                       WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
                       ErrorQuit;
                    ELSE
                       PktNbr := 1;
                       EOF := FALSE;
                    END;
          |  fail : MP1.W1 := PAD_ExcessiveErrors;   MP1.W2 := 0;
                    MP2.L := 0;
                    WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
                    ErrorQuit;
          END;
          SendAck (rSeq);   (* acknowledge for name or eot *)
          trys := 1;   (* initialize *)
          WHILE NOT EOF DO
             IF Aborted THEN
                TellError (rSeq);
                ErrorQuit;
             END;
             IF ReceivePacket (rP) THEN
                Seq := UnChar (rP[2]);
                Type := rP[3];
                IF Type = 'Z' THEN
                   EOF := TRUE;
                   IF CloseFile (rF, Output) = Done THEN
                      (* normal file termination *)
                   ELSE
                      MP1.W1 := PAD_ProbClDestFile;   MP1.W2 := 0;
                      MP2.L := LONGINT (ADR (rFname));
                      WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
                      ErrorQuit;
                   END;
                   trys := 1;   (* good packet -- reset *)
                   SendAck (rSeq);
                ELSIF Type = 'E' THEN
                   ShowError (rP);
                   ErrorQuit;
                ELSIF (Type = 'D') AND ((Seq + 1) MOD 64 = rSeq) THEN
                (* discard duplicate packet, and Ack anyway *)
                   trys := 1;
                   SendAck (Seq); 
                ELSIF (Type = 'D') AND (Seq = rSeq) THEN
                   (* put packet into file buffer *)
                   i := 4;   (* first data in packet *)
                   WHILE rP[i] # 0C DO
                      ch := rP[i];   INC (i);
                      IF ch = yourQBIN THEN
                         ch := rP[i];   INC (i);
                         QBIN := TRUE;
                      ELSE
                         QBIN := FALSE;
                      END;
                      IF ch = yourQCTL THEN                  
                         ch := rP[i];   INC (i);
                         IF (ch # yourQCTL) AND (ch # yourQBIN) THEN
                            ch := CHAR (ByteXor (ch, 100C));
                         END;
                      END;
                      IF QBIN THEN
                         ch := CHAR (ByteXor (ch, 200C));
                      END;
                      Put (ch);
                   END;
                
                   (* write file buffer to disk *)
                   IF DoWrite (rF) # Done THEN
                      MP1.W1 := PAD_ErrWrtFile;   MP1.W2 := 0;
                      MP2.L := LONGINT (ADR (rFname));
                      WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
                      ErrorQuit;
                   END;
                   trys := 1;
                   SendAck (rSeq);
                ELSE
                   INC (trys);
                   IF trys = MAXtrys THEN
                      MP1.W1 := PAD_ExcessiveErrors;   MP1.W2 := 0;
                      MP2.L := 0;
                      WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
                      ErrorQuit;
                   ELSE
                      SendNak;
                   END;
                END;
             ELSE
                INC (trys);
                IF trys = MAXtrys THEN
                   MP1.W1 := PAD_ExcessiveErrors;   MP1.W2 := 0;
                   MP2.L := 0;
                   WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
                   ErrorQuit;
                ELSE
                   SendNak;
                END;
             END;
          END;
       END;
       NormalQuit;
    END Receive;
    
    

BEGIN (* module initialization *)

 yourEOL := ASCII.cr;
 yourNPAD := 0;
 yourPADC := 0C;

END PAD. 

/data/webs/external/dokuwiki/data/pages/archive/computers/andrson2.txt · Last modified: 2001/11/08 10:19 by 127.0.0.1

Donate Powered by PHP Valid HTML5 Valid CSS Driven by DokuWiki