home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
kermit.columbia.edu
/
kermit.columbia.edu.tar
/
kermit.columbia.edu
/
archives
/
os2pm.tar.gz
/
os2pm.tar
/
shell.mod
< prev
next >
Wrap
Text File
|
1990-08-27
|
29KB
|
871 lines
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.