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

   FROM Drives IMPORT
      SetDrive;
 
   FROM Directories IMPORT
      FileAttributes, AttributeSet, DirectoryEntry, FindFirst, FindNext;
 
   FROM SYSTEM IMPORT
      ADR;

   FROM DosCalls IMPORT
      DosChDir, DosSleep;
 
   FROM Screen IMPORT
      ClrScr, ClrEol, GotoXY, GetXY,
      Right, Left, Up, Down, WriteAtt, WriteString, WriteLn, Write,
      attribute, NORMAL, HIGHLIGHT, REVERSE;
 
   FROM PMWIN IMPORT
      MPARAM, WinPostMsg;

   FROM Shell IMPORT
      comport, FrameWindow;
 
   FROM KH IMPORT
      COM_OFF;
 
   FROM CommPort IMPORT
      CommStatus, GetChar, SendChar;
 
   FROM Strings IMPORT
      Length, Concat;
 
   IMPORT ASCII;


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

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

   PROCEDURE Dir (path : ARRAY OF CHAR);
   (* Change drive and/or directory; display a directory (in wide format) *)
 
      VAR
         gotFN : BOOLEAN;
         filename : ARRAY [0..20] OF CHAR;
         attr : AttributeSet;
         ent : DirectoryEntry;
         i, j, k : INTEGER;
 
      BEGIN
         filename := "";   (* in case no directory change *)
         i := Length (path);
         IF (i > 2) AND (path[1] = ':') THEN   (* drive specifier *)
            DEC (i, 2);
            SetDrive (ORD (CAP (path[0])) - ORD ('A'));
            FOR j := 0 TO i DO   (* strip off the drive specifier *)
               path[j] := path[j + 2];
            END;
         END;
         IF i # 0 THEN
            gotFN := FALSE;
            WHILE (i >= 0) AND (path[i] # '\') DO
               IF path[i] = '.' THEN
                  gotFN := TRUE;
               END;
               DEC (i);
            END;
            IF gotFN THEN
               j := i + 1;
               k := 0;
               WHILE path[j] # 0C DO
                  filename[k] := path[j];
                  INC (k);       INC (j);
               END;
               filename[k] := 0C;
               IF (i = -1) OR ((i = 0) AND (path[0] = '\')) THEN
                  INC (i);
               END;
               path[i] := 0C;
            END;
         END;
         IF Length (path) # 0 THEN
            DosChDir (ADR (path), 0);
         END;
         IF Length (filename) = 0 THEN
            filename := "*.*";
         END;
         attr := AttributeSet {ReadOnly, Directory, Archive};
         i := 1;   (* keep track of position on line *)

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

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


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


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

 
   PROCEDURE TermThrProc;
   (* Thread to get characters from port, put into buffer *)
 
      VAR
         ch : CHAR;
 
      BEGIN
         LOOP
            IF GetChar (comport - COM_OFF, ch) = Success THEN
               MP1.W1 := ORD (ch);   MP1.W2 := 0;
               MP2.L := 0;
               WinPostMsg (FrameWindow, WM_TERM, MP1, MP2);
            ELSE
               DosSleep (0);
            END
         END;
      END TermThrProc;


   VAR
      EscState, CurState1, CurState2 : BOOLEAN;
      CurChar1 : CHAR;
 
   PROCEDURE PutPortChar (ch : CHAR);
   (* Process a character received from the port *)
      BEGIN
         IF EscState THEN
            EscState := FALSE;
            IF ch = '=' THEN
               CurState1 := TRUE;
            ELSE
               Escape (ch);
            END;
         ELSIF CurState1 THEN
            CurState1 := FALSE;
            CurChar1 := ch;
            CurState2 := TRUE;
         ELSIF CurState2 THEN
            CurState2 := FALSE;
            Cursor (ch);
         ELSE
            CASE ch OF
               CtrlCaret, CtrlZ : ClrScr;
            |  CtrlL : Right;
            |  CtrlH : Left;
            |  CtrlK : Up;
            |  CtrlJ : Down;
            |  ESC   : EscState := TRUE;
            ELSE
               WriteAtt (ch);
               IF newline AND (ch = ASCII.cr) THEN
                  WriteLn;
               END;
            END;
         END;
         IF echo = On THEN
            commStat := SendChar (comport - COM_OFF, ch, FALSE);
         END;
      END PutPortChar;
 
 
   PROCEDURE Escape (ch : CHAR);
   (* handles escape sequences *)
      BEGIN
         CASE ch OF
            '*' : ClrScr;
         |  'T', 'R' : ClrEol;
         |  ')' : attribute := NORMAL;
         |  '(' : attribute := HIGHLIGHT;
         |  'f' : InsertMsg;
         |  'g' : InsertOn;
         ELSE
            (* ignore *)
         END;
      END Escape;
 
 
   PROCEDURE Cursor (ch : CHAR);
   (* handles cursor positioning *)
 
      VAR
         x, y : CARDINAL;
 
      BEGIN
         y := ORD (CurChar1) - 20H;
         x := ORD (ch) - 20H;
         GotoXY (x, y);   (* adjust for HOME = (1, 1) *)
      END Cursor;
 
 
   VAR
      cx, cy : CARDINAL;
 
   PROCEDURE InsertMsg;
   (* get ready insert mode -- place a message at the bottom of the screen *)
      BEGIN
         IF NOT Insert THEN
            GetXY (cx, cy);   (* record current position *)
            GotoXY (1, 24);
            ClrEol;
            attribute := REVERSE;
         ELSE   (* exit Insert mode *)
            GetXY (cx, cy);
            GotoXY (1, 24);
            ClrEol;
            GotoXY (cx, cy);
            Insert := FALSE;
         END;
      END InsertMsg;
 
 
   PROCEDURE InsertOn;
   (* enter insert mode -- after INSERT MODE message is printed *)
      BEGIN
         attribute := NORMAL;
         GotoXY (cx, cy);
         Insert := TRUE;
      END InsertOn;
 

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