home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
archives
/
os2pm.tar.gz
/
os2pm.tar
/
term.mod
< prev
Wrap
Text File
|
1990-08-27
|
12KB
|
382 lines
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.