Category : Modula II Source Code
Archive   : SAMPTERM.ZIP
Filename : SAMPTERM.MOD

 
Output of file : SAMPTERM.MOD contained in archive : SAMPTERM.ZIP
(* M2Vers versions: *)

(*V0=Logitech*)
(*V1=Stony*)
(*V2=JPI*)

(* Compiler options: *)

(* (*$R-*) (*$T-*) (*$O+*) (*$OS+*)
Logitech>*)

(* (*$I-,N,O-,R-,Z-,V-*)
(*JPI>*)


MODULE SampTerm;

(*
ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ ÕÍÍÍÍÍ» ³ Solid Link ³
³ ³ ÕÍÍÍÍÍ» ³ Copyright (c) 1988, 1989 ³
³ ÀÄ ³ Ä¿olid ³ Solid Software, Inc. ³
³ ÀÄ ³ Ä¿oftware, ³ ³
³ ÈÍÍÍÍ; ³ Inc. ³ [SampTerm.MOD] ³
³ ÈÍÍÍÍ; ³ A Sample Terminal Program ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ

*)

FROM SYSTEM IMPORT
ADR, SIZE;

FROM Modem IMPORT
PortType, DataBitsType, StopBitsType, ParityType,
FlowControl, FlowsSet, RcvdCtrlC, SetMode,
Install, UnInstall, SetSerial,
PurgeOut, CommPressed, Carrier, DTR;

IMPORT Modem; (* Qualified Read & Write *)

FROM Transfer IMPORT
SendFile, RecvFile,
Block0, Block0Type, Modem7, OneK, Gee, Slide, Window;

FROM ZModem IMPORT
ZSend, ZRecv,
ZManagement, ManagementOpt,
ZConvert, ConvertOpt,
SkipNotExist;

FROM TimeLimit IMPORT
TimerHandle, GetTimer, SetTimer, TimeUp, ReleaseTimer;

IMPORT VT100;

FROM Video IMPORT
ClrScr, ScrollUp, ScrollDown,
SetColor, Green, Red, LightGray, LightCyan, White,
Write, WriteString, WriteLn, GotoXY, CursorX, CursorY;

FROM DosFiles IMPORT
File, Response,
Open, Create, SetPos, ReadNBytes, WriteNBytes, Close;

IMPORT DosFiles;

FROM Edit IMPORT
EditString, IsStdExit, IsGraphic, IsDigit, Pad,
FieldUp, FieldDown, FieldLeft, FieldRight;

FROM BIOSKey IMPORT
Read, KeyPressed;

FROM Samples IMPORT
DisplayLogo, Box, Borders, Trim;

(* FROM Conversions IMPORT
ConvertCardinal;

FROM NumberConversion IMPORT
StringToCard;

FROM Strings IMPORT
CompareStr;

FROM Exec IMPORT
DosShell;
Logitech>*)

(* FROM Conversions IMPORT
CardToString, StringToCard;

FROM Strings IMPORT
CompareStr;

FROM Environment IMPORT
GetSymbol;

FROM RunProg IMPORT
RunProgram;
Stony>*)

(* FROM Str IMPORT
CardToStr, StrToCard, Compare,
Insert, Copy, Delete, Length;

FROM Lib IMPORT
Environment, CommandType, Execute;

FROM Storage IMPORT
MainHeap, HeapAllocate, HeapDeallocate, HeapAvail;
(*JPI>*)


CONST
Escape = 33C; (* Various keyboard constants *)
Return = 15C;
Bell = 7C;
F1 = 73C;
AltD = 40C;
AltL = 46C;
AltH = 43C;
AltO = 30C;
AltR = 23C;
AltS = 37C;
AltX = 55C;
AltZ = 54C;
PgUp = 111C;
PgDn = 121C;
DownArrow = 120C;
UpArrow = 110C;

BkSp = 10C; (* Specially treated characters *)
Tab = 11C;
FormFeed = 14C;

ConfigFile = "SampTerm.CFG";
DirectoryFile = "SampTerm.DIR";

CreateError = "Unable to create: ";
ReadError = "Error reading: ";
WriteError = "Error writing: ";
Done = " Done.";

Inverse = 70H;

Ready = "&3Ready&1|";


TYPE
PhoneEntry = RECORD (* slightly contorted for Procomm format *)
Name : ARRAY [0..23] OF CHAR;
Z1 : CHAR; (* always 0C *)
Phone : ARRAY [0..13] OF CHAR;
Z2 : CHAR;
Baud : ARRAY [0..4] OF CHAR;
Z3 : CHAR;
Parity : CHAR;
DataBits : CHAR;
StopBits : CHAR;
Echo : CHAR;
Script : ARRAY [0..9] OF CHAR;
END;

VAR
(* Configuration variables *)
Config : RECORD
Port : PortType;
Baud : CARDINAL;
Parity : ParityType;
DataBits : DataBitsType;
StopBits : StopBitsType;
Echo : BOOLEAN;
InBuffer : CARDINAL;
OutBuffer : CARDINAL;
XlatPause : CHAR;
XlatCR : CHAR;
XlatCtrl : CHAR;
XlatESC : CHAR;
ModemInit : ARRAY [0..39] OF CHAR;
DialPrefix : ARRAY [0..15] OF CHAR;
DialSuffix : ARRAY [0..15] OF CHAR;
HangUp : ARRAY [0..15] OF CHAR;
Connect300 : ARRAY [0..15] OF CHAR;
Connect1200 : ARRAY [0..15] OF CHAR;
Connect2400 : ARRAY [0..15] OF CHAR;
Connect4800 : ARRAY [0..15] OF CHAR;
Connect9600 : ARRAY [0..15] OF CHAR;
AutoZ : BOOLEAN;
END;

Echo : BOOLEAN;

Directory : RECORD
Filler : ARRAY [0..149] OF CHAR;
Listings : ARRAY [0..99] OF PhoneEntry;
END;

Index : CARDINAL; (* Remember last number dialed *)
Line : CARDINAL;

ParityChar : ARRAY ParityType OF CHAR; (* "constant" arrays *)
YesNoChar : ARRAY BOOLEAN OF CHAR;
Colors : ARRAY ['1'..'4'] OF CARDINAL;


VAR
LogIsOn : BOOLEAN;
LogFile : File;
LogBuff : ARRAY [0..255] OF CHAR;
LogPos : CARDINAL;
LogActual : CARDINAL;

(* LogHi,LogLo : CARDINAL;
Logitech,Stony*)

(* LogOfs : LONGCARD;
(*JPI>*)

PROCEDURE ToggleLog;
(* Turn log off/on. *)
BEGIN
LogIsOn := NOT LogIsOn;
IF LogIsOn THEN
LogPos := 0;
Open(LogFile, "SAMPTERM.LOG");
IF LogFile.res <> done THEN
Create(LogFile, "SAMPTERM.LOG");
IF LogFile.res <> done THEN
LogIsOn := FALSE;
RETURN;
END (* if *);
ELSE
(* DosFiles.Length(LogFile, LogHi, LogLo);
SetPos(LogFile, LogHi, LogLo);
Logitech,Stony>*)
(* DosFiles.Length(LogFile, LogOfs);
SetPos(LogFile, LogOfs);
(*JPI>*)
END (* if *);
WriteString("Log is on.");
WriteLn;
ELSE
Close(LogFile);
WriteString("Log is off.");
WriteLn;
END (* if *);
END ToggleLog;


PROCEDURE Log(C : CHAR);
(* Write characters to log file. *)
BEGIN
IF LogIsOn THEN
LogBuff[LogPos] := C;
INC(LogPos);
IF LogPos > 255 THEN
WriteNBytes(LogFile, ADR(LogBuff), SIZE(LogBuff), LogActual);
LogPos := 0;
END (* if *);
END (* if *);
END Log;


PROCEDURE ColorString(S : ARRAY OF CHAR);
(* Display a string with color and easy WriteLn's.
Interprets a few character sequences specially:
"&1" thru "&4" - change to color found in Colors array.
"|" - do a WriteLn.
For example, "&1Solid &2Software|" displays "Solid " in color 1,
"Software" in color 2 and then does a WriteLn.
*)

VAR
I : CARDINAL;

BEGIN
I := 0;
WHILE (I <= HIGH(S)) AND (S[I] <> 0C) DO
IF (S[I] = '&') AND (I < HIGH(S)) AND
(S[I+1] >= '1') AND (S[I+1] <= '4') THEN
INC(I);
SetColor(Colors[S[I]]);
ELSIF S[I] = "|" THEN
WriteLn;
ELSE
Write(S[I]);
END;
INC(I);
END;
END ColorString;


PROCEDURE ControlString(S : ARRAY OF CHAR);

(* Send a control string to the modem.

Interprets 4 characters specially:

'~' 0.5 second delay
'!' send a CR to modem
'|' send an ESC to modem
'^' send a control charater to modem, as in "^C".

These translation characters may be redefined within ReConfig (Set up)
*)

VAR
I, J : CARDINAL;
C : CHAR;
T : TimerHandle;
Ok : BOOLEAN;

BEGIN
I := 0;
GetTimer(T, Ok);
WHILE (I <= HIGH(S)) AND (S[I] <> 0C) DO
C := S[I];
IF C = Config.XlatPause THEN
SetTimer(T, 5);
REPEAT
;
UNTIL TimeUp(T);
ELSE
IF C = Config.XlatCR THEN
C := Return;
ELSIF C = Config.XlatESC THEN
C := Escape;
ELSIF C = Config.XlatCtrl THEN
IF (I < HIGH(S)) AND (S[I+1] >= "@") THEN
INC(I);
C := CHR(ORD(S[I]) - 64);
END;
END;
Modem.Write(C);
FOR J := 1 TO 10000 DO (* slow down; some modems can't handle *)
; (* control strings as fast as we can *)
END; (* give'm to it *)
END (* if C *);
INC(I);
END (* while *);
ReleaseTimer(T);
END ControlString;


PROCEDURE BinAsc(X, Width : CARDINAL; VAR S : ARRAY OF CHAR);

(* Binary to ASCII decimal conversion.
Used to consolidate version differences.
*)

(* VAR
Pos : CARDINAL;
Dummy : BOOLEAN;
Stony>*)
(* VAR
Dummy : BOOLEAN;
Len : CARDINAL;
(*JPI>*)
BEGIN
(* ConvertCardinal(X, Width, S);
Logitech>*)
(* Pos := 0;
CardToString(X, Width, S, Pos, Dummy);
Stony>*)
(* CardToStr(VAL(LONGCARD, X), S, 10, Dummy);
Len := Length(S);
WHILE Len < Width DO
Insert(S, " ", 0);
INC(Len);
END;
(*JPI>*)
END BinAsc;


PROCEDURE AscBin(S : ARRAY OF CHAR; VAR X : CARDINAL);

(* ASCII decimal to Binary conversion.
Used to consolidate version differences.
*)

VAR
Ok : BOOLEAN;
(* Pos : CARDINAL;
Stony>*)

BEGIN
(* StringToCard(S, X, Ok);
Logitech>*)
(* Pos := 0;
WHILE S[Pos] = ' ' DO
INC(Pos);
END;
StringToCard(S, Pos, X, Ok);
Stony>*)
(* WHILE S[0] = ' ' DO
Delete(S, 0, 1);
END;
X := VAL(CARDINAL, StrToCard(S, 10, Ok));
(*JPI>*)
IF NOT Ok THEN
X := 0;
END;
END AscBin;

(* (*$F*)
(*JPI>*)

(* Edit.IsProc procedures *)

PROCEDURE IsDialerExit (Key : CHAR) : BOOLEAN;
(* Used for EditString's IsExit procedure when editing dialer entries *)
BEGIN
RETURN ((Key = Return) OR (Key = Escape) OR
(Key = FieldLeft) OR (Key = FieldRight));
END IsDialerExit;


PROCEDURE IsConfigExit (Key : CHAR) : BOOLEAN;
(* Used for EditString's IsExit procedure when editing setup info *)
BEGIN
RETURN ((Key = Return) OR (Key = Escape) OR
(Key = FieldLeft) OR (Key = FieldRight) OR
(Key = FieldUp) OR (Key = FieldDown));
END IsConfigExit;


PROCEDURE IsPort(Key : CHAR) : BOOLEAN;
(* Used for EditString's IsLegal procedure when editing port fields *)
BEGIN
RETURN ((Key >= '1') AND (Key <= '4'));
END IsPort;


PROCEDURE IsParity(Key : CHAR) : BOOLEAN;
(* Used for EditString's IsLegal procedure when editing parity fields *)
BEGIN
RETURN ((Key = 'O') OR (Key = 'E') OR (Key = 'N') OR
(Key = 'M') OR (Key = 'S'));
END IsParity;


PROCEDURE IsDataBit(Key : CHAR) : BOOLEAN;
(* Used for EditString's IsLegal procedure when editing data bits fields *)
BEGIN
RETURN ((Key >= '5') AND (Key <= '8'));
END IsDataBit;


PROCEDURE IsStopBit(Key : CHAR) : BOOLEAN;
(* Used for EditString's IsLegal procedure when editing stop bits fields *)
BEGIN
RETURN ((Key = '1') OR (Key = '2'));
END IsStopBit;


PROCEDURE IsYesNo(Key : CHAR) : BOOLEAN;
(* Used for EditString's IsLegal procedure when editing yes/no fields *)
BEGIN
RETURN ((Key = 'Y') OR (Key = 'N'));
END IsYesNo;

(* (*$N*)
(*JPI>*)


PROCEDURE InitializeModem;

(* Guess what we do here. 🙂 *)

BEGIN
WriteString("Initializing modem...");
WITH Config DO
Install(Port, InBuffer, OutBuffer);
SetSerial(Baud, DataBits, Parity, StopBits);
END;
SetMode(FlowsSet{RecvXON, SendXON, CtrlC});
IF NOT Carrier() THEN
ControlString(Config.ModemInit);
ControlString("~");
Modem.PurgeIn;
END;
WriteString(Done);
WriteLn;
END InitializeModem;


PROCEDURE Configure;

(* Read (or create) configuration file and phone directory,
initialize the modem, and intialize some global variables
(in general, program initialization)
*)

VAR
F : File;
Actual : CARDINAL;
I : CARDINAL;
S : ARRAY [0..4] OF CHAR;
PE : PhoneEntry;

BEGIN
Open(F, ConfigFile);
IF F.res <> done THEN
WriteString("Creating configuration file...");
WITH Config DO
Port := 1;
Baud := 1200;
Parity := NoParity;
DataBits := 8;
StopBits := 1;
Echo := FALSE;
InBuffer := 2048;
OutBuffer := 2048;
XlatPause := '~';
XlatCR := '!';
XlatCtrl := '^';
XlatESC := '|';
ModemInit := "AT E0 V1 X2 S0=0!";
DialPrefix := "ATDT";
DialSuffix := "!";
HangUp := "~~~+++~~~ATH0!";
Connect300 := "CONNECT";
Connect1200 := "CONNECT 1200";
Connect2400 := "CONNECT 2400";
Connect4800 := "CONNECT 4800";
Connect9600 := "CONNECT 9600";
AutoZ := TRUE;
END (* with Config *);
Create(F, ConfigFile);
IF F.res <> done THEN
WriteString(CreateError);
WriteString(ConfigFile);
HALT;
END;
WriteNBytes(F, ADR(Config), SIZE(Config), Actual);
IF (F.res <> done) OR (Actual <> SIZE(Config)) THEN
WriteString(WriteError);
WriteString(ConfigFile);
HALT;
END;
ELSE
WriteString("Reading configuration file...");
ReadNBytes(F, ADR(Config), SIZE(Config), Actual);
IF (F.res <> done) OR (Actual <> SIZE(Config)) THEN
WriteString(ReadError);
WriteString(ConfigFile);
HALT;
END;
END (* if F.res *);
Close(F);
WriteString(Done);
WriteLn;
Echo := Config.Echo;
WITH Config DO
WriteString("COM");
Write(CHR(ORD(Port)+48));
Write(',');
IF Baud = 0 THEN
WriteString("115200");
ELSE
BinAsc(Baud, 1, S);
WriteString(S);
END;
Write(',');
CASE Parity OF
NoParity : Write('N');
| OddParity : Write('O');
| EvenParity : Write('E');
| MarkParity : Write('M');
| SpaceParity : Write('S');
END;
Write(',');
Write(CHR(ORD(DataBits)+48));
Write(',');
Write(CHR(ORD(StopBits)+48));
WriteString(" InBuffer = ");
BinAsc(InBuffer, 1, S);
WriteString(S);
WriteString(" OutBuffer = ");
BinAsc(OutBuffer, 1, S);
WriteString(S);
WriteLn;
WriteLn;
END (* with Config *);
Open(F, DirectoryFile);
IF F.res <> done THEN
WriteString("Creating phone directory file...");
WITH PE DO
Name := " ";
Phone := " ";
Baud := "1200";
Parity := 'N';
DataBits := '8';
StopBits := '1';
Echo := 'N';
Script := " ";
Z1 := 0C;
Z2 := 0C;
Z3 := 0C;
END;
Directory.Filler := "ATDT";
FOR I := 0 TO 99 DO
Directory.Listings[I] := PE;
END;
Create(F, DirectoryFile);
IF F.res <> done THEN
WriteString(CreateError);
WriteString(DirectoryFile);
HALT;
END;
WriteNBytes(F, ADR(Directory), SIZE(Directory), Actual);
IF (F.res <> done) OR (Actual <> SIZE(Directory)) THEN
WriteString(WriteError);
WriteString(ConfigFile);
HALT;
END;
ELSE
WriteString("Reading phone directory file...");
ReadNBytes(F, ADR(Directory), SIZE(Directory), Actual);
IF (F.res <> done) OR (Actual <> SIZE(Directory)) THEN
WriteString(ReadError);
WriteString(DirectoryFile);
HALT;
END;
END (* if F.res *);
Close(F);
WriteString(Done);
WriteLn;
WriteLn;
InitializeModem;
WriteLn;
WriteLn;
WriteString("Hit F1 for help");
WriteLn;
ColorString(Ready);
Index := 0;
Line := 0;
ParityChar[NoParity] := 'N';
ParityChar[OddParity] := 'O';
ParityChar[EvenParity] := 'E';
ParityChar[MarkParity] := 'M';
ParityChar[SpaceParity] := 'S';
YesNoChar[FALSE] := 'N';
YesNoChar[TRUE] := 'Y';
END Configure;


PROCEDURE ReConfig;

(* Alt-S. Do full screen editing of configuation info *)

VAR
I : CARDINAL;
ExitKey : CHAR;
S : ARRAY [0..39] OF CHAR;
Field : CARDINAL;
Position : CARDINAL;
F : File;
Actual : CARDINAL;
OldPort : PortType;
OldIn : CARDINAL;
OldOut : CARDINAL;
Key : CHAR;
ScanCode : CHAR;

BEGIN
ClrScr;
SetColor(Colors['4']);
Box(3,0, 75,24, DoubleBorder);
ScrollUp(4,1, 74,23, 0);
GotoXY(5, 1);
WriteString("Solid Link ");
Write(263C);
GotoXY(62, 1);
Write(263C);
WriteString(" Solid Link");
GotoXY(34, 1);
WriteString("S E T - U P");
GotoXY(3, 2);
Write(307C);
FOR I := 1 TO 71 DO
Write(304C);
END;
Write(266C);
GotoXY(16, 0); Write(321C);
GotoXY(16, 2); Write(301C);
GotoXY(62, 0); Write(321C);
GotoXY(62, 2); Write(301C);
WITH Config DO
OldPort := Port;
OldIn := InBuffer;
OldOut := OutBuffer;
GotoXY(5, 3);
ColorString("Port ................... &1[COM&2");
Write(CHR(ORD(Port) + 49));
ColorString("&1]&4 [1..4]");
GotoXY(5, 4);
ColorString("Input buffer size ...... &1[&2");
BinAsc(InBuffer, 5, S);
WriteString(S);
ColorString("&1]&4 [4..65520]");
GotoXY(5, 5);
ColorString("Output buffer size ..... &1[&2");
BinAsc(OutBuffer, 5, S);
WriteString(S);
ColorString("&1]&4 [2..65520]");
GotoXY(5, 6);
ColorString("Baud ................... &1[&2");
BinAsc(Baud, 5, S);
WriteString(S);
ColorString("&1]&4 [0..57600]");
GotoXY(5, 7);
ColorString("DataBits ............... &1[&2");
Write(CHR(ORD(DataBits) + 48));
ColorString("&1]&4 [5..8]");
GotoXY(5, 8);
ColorString("Parity type ............ &1[&2");
Write(ParityChar[Parity]);
ColorString("&1]&4 [N)one, E)ven, O)dd, M)ark, S)pace]");
GotoXY(5, 9);
ColorString("Stop bits .............. &1[&2");
Write(CHR(ORD(StopBits) + 48));
ColorString("&1]&4 [1..2]");
GotoXY(5, 10);
ColorString("Echo locally ........... &1[&2");
Write(YesNoChar[Echo]);
ColorString("&1]&4 [Y)es, N)o]");
GotoXY(5, 11);
ColorString("Auto ZMODEM Download ... &1[&2");
Write(YesNoChar[AutoZ]);
ColorString("&1]&4 [Y)es, N)o]");
GotoXY(5, 13);
ColorString("Initialization string .. &1[&2");
Pad(ModemInit);
WriteString(ModemInit);
ColorString("&1]&4");
GotoXY(5, 14);
ColorString("Dial prefix ............ &1[&2");
Pad(DialPrefix);
WriteString(DialPrefix);
ColorString("&1]&4");
GotoXY(5, 15);
ColorString("Dial suffix ............ &1[&2");
Pad(DialSuffix);
WriteString(DialSuffix);
ColorString("&1]&4");
GotoXY(5, 16);
ColorString("Hang-up string ......... &1[&2");
Pad(HangUp);
WriteString(HangUp);
ColorString("&1]&4");
GotoXY(5, 18);
WriteString("Modem result strings for:");
GotoXY(5, 19);
ColorString("Connect at 300 baud &1[&2");
Pad(Connect300);
WriteString(Connect300);
ColorString("&1]&4");
GotoXY(5, 20);
ColorString("Connect at 1200 baud &1[&2");
Pad(Connect1200);
WriteString(Connect1200);
ColorString("&1]&4");
GotoXY(5, 21);
ColorString("Connect at 2400 baud &1[&2");
Pad(Connect2400);
WriteString(Connect2400);
ColorString("&1]&4");
GotoXY(5, 22);
ColorString("Connect at 4800 baud &1[&2");
Pad(Connect4800);
WriteString(Connect4800);
ColorString("&1]&4");
GotoXY(5, 23);
ColorString("Connect at 9600 baud &1[&2");
Pad(Connect9600);
WriteString(Connect9600);
ColorString("&1]&4");
GotoXY(49, 18);
WriteString("Modem command string");
GotoXY(48, 19);
WriteString("translation characters:");
GotoXY(53,20);
ColorString("Pause .. &1[&2");
Write(XlatPause);
ColorString("&1]&4");
GotoXY(53,21);
ColorString("CR ..... &1[&2");
Write(XlatCR);
ColorString("&1]&4");
GotoXY(53,22);
ColorString("Ctrl ... &1[&2");
Write(XlatCtrl);
ColorString("&1]&4");
GotoXY(53,23);
ColorString("ESC .... &1[&2");
Write(XlatESC);
ColorString("&1]&2");
Field := 1;
REPEAT
Position := 0;
CASE Field OF
1 : S[0] := CHR(ORD(Port) + 48);
EditString(34, 3, S,
Position, 1,
IsPort, IsConfigExit, ExitKey);
Port := VAL(PortType, ORD(S[0]) - 48);
| 2 : BinAsc(InBuffer, 5, S);
EditString(31, 4, S,
Position, 5,
IsDigit, IsConfigExit, ExitKey);
AscBin(S, InBuffer);
IF (InBuffer < 4) OR (InBuffer > 65520) THEN
Write(Bell);
ExitKey := ' ';
END;
| 3 : BinAsc(OutBuffer, 5, S);
EditString(31, 5, S,
Position, 5,
IsDigit, IsConfigExit, ExitKey);
AscBin(S, OutBuffer);
IF (OutBuffer < 2) OR (OutBuffer > 65520) THEN
Write(Bell);
ExitKey := ' ';
END;
| 4 : BinAsc(Baud, 5, S);
EditString(31, 6, S,
Position, 5,
IsDigit, IsConfigExit, ExitKey);
AscBin(S, Baud);
IF Baud > 57600 THEN
Write(Bell);
ExitKey := ' ';
END;
| 5 : S[0] := CHR(DataBits + 48);
EditString(31, 7, S,
Position, 1,
IsDataBit, IsConfigExit, ExitKey);
DataBits := ORD(S[0]) - 48;
| 6 : S[0] := ParityChar[Parity];
EditString(31, 8, S,
Position, 1,
IsParity, IsConfigExit, ExitKey);
CASE S[0] OF
'N' : Parity := NoParity;
| 'E' : Parity := EvenParity;
| 'O' : Parity := OddParity;
| 'M' : Parity := MarkParity;
| 'S' : Parity := SpaceParity;
ELSE
Parity := NoParity;
END;
| 7 : S[0] := CHR(StopBits + 48);
EditString(31, 9, S,
Position, 1,
IsStopBit, IsConfigExit, ExitKey);
StopBits := ORD(S[0]) - 48;
| 8 : S[0] := YesNoChar[Echo];
EditString(31, 10, S,
Position, 1,
IsYesNo, IsConfigExit, ExitKey);
Echo := (S[0] = 'Y');
| 9 : S[0] := YesNoChar[AutoZ];
EditString(31, 11, S,
Position, 1,
IsYesNo, IsConfigExit, ExitKey);
AutoZ := (S[0] = 'Y');
| 10: EditString(31, 13, ModemInit,
Position, 40,
IsGraphic, IsConfigExit, ExitKey);
| 11: EditString(31, 14, DialPrefix,
Position, 16,
IsGraphic, IsConfigExit, ExitKey);
| 12: EditString(31, 15, DialSuffix,
Position, 16,
IsGraphic, IsConfigExit, ExitKey);
| 13: EditString(31, 16, HangUp,
Position, 16,
IsGraphic, IsConfigExit, ExitKey);
| 14: EditString(27, 19, Connect300,
Position, 16,
IsGraphic, IsConfigExit, ExitKey);
| 15: EditString(27, 20, Connect1200,
Position, 16,
IsGraphic, IsConfigExit, ExitKey);
| 16: EditString(27, 21, Connect2400,
Position, 16,
IsGraphic, IsConfigExit, ExitKey);
| 17: EditString(27, 22, Connect4800,
Position, 16,
IsGraphic, IsConfigExit, ExitKey);
| 18: EditString(27, 23, Connect9600,
Position, 16,
IsGraphic, IsConfigExit, ExitKey);
| 19: EditString(63, 20, XlatPause,
Position, 1,
IsGraphic, IsConfigExit, ExitKey);
| 20: EditString(63, 21, XlatCR,
Position, 1,
IsGraphic, IsConfigExit, ExitKey);
| 21: EditString(63, 22, XlatCtrl,
Position, 1,
IsGraphic, IsConfigExit, ExitKey);
| 22: EditString(63, 23, XlatESC,
Position, 1,
IsGraphic, IsConfigExit, ExitKey);
END (* case Field *);
IF (ExitKey = Return) OR
(ExitKey = FieldDown) OR (ExitKey = FieldRight) THEN
INC(Field);
ELSIF (ExitKey = FieldUp) OR (ExitKey = FieldLeft) THEN
DEC(Field);
END; (* if *)
UNTIL (Field = 0) OR (Field = 23) OR (ExitKey = Escape);
Trim(ModemInit);
Trim(DialPrefix);
Trim(DialSuffix);
Trim(HangUp);
Trim(Connect300);
Trim(Connect1200);
Trim(Connect2400);
Trim(Connect4800);
Trim(Connect9600);
ClrScr;
ColorString("&1Make changes permanent (save to disk)? [&2y&1/&2N&1] : N");
Write(BkSp);
REPEAT
Read(Key, ScanCode);
Key := CAP(Key);
IF Key = Return THEN
Key := 'N';
END;
UNTIL (Key = 'Y') OR (Key = 'N');
Write(Key);
WriteLn;
IF Key = 'Y' THEN
WriteString("Saving...");
Open(F, ConfigFile);
IF F.res <> done THEN
WriteLn;
WriteString("Can't find configuration file: ");
WriteString(ConfigFile);
ELSE
WriteNBytes(F, ADR(Config), SIZE(Config), Actual);
IF (F.res <> done) OR (Actual <> SIZE(Config)) THEN
WriteLn;
WriteString(WriteError);
WriteString(ConfigFile);
ELSE
WriteString(Done);
WriteLn;
END;
Close(F);
END;
END (* if Key *);
IF (Port <> OldPort) OR (InBuffer <> OldIn) OR (OutBuffer <> OldIn) THEN
UnInstall(OldPort);
Install(Port, InBuffer, OutBuffer);
END;
SetSerial(Baud, DataBits, Parity, StopBits);
END (* with Config *);
Echo := Config.Echo;
ColorString(Ready);
END ReConfig;


PROCEDURE Dialer;

(* Alt-D. Dialer *)

VAR
S : ARRAY [0..2] OF CHAR;

PROCEDURE ShowKeys;

(* Display keys used to move around, edit, and dial *)

BEGIN
GotoXY(1, 16);
SetColor(Colors['2']);
Write(30C); Write(31C);
ColorString(" PgUp PgDn E&1)dit &2");
Write(21C);
Write(304C);
Write(331C);
ColorString("&1 to dial selected entry &2Esc&1 to quit");
END ShowKeys;


PROCEDURE DisplayLine(Index, Line, Color : CARDINAL);

(* Display one PhoneEntry record *)

BEGIN
SetColor(Colors['4']);
INC(Line, 4);
GotoXY(2, Line);
BinAsc(Index + 1, 3, S);
WriteString(S);
SetColor(Color);
WITH Directory.Listings[Index] DO
GotoXY(7, Line); Write(' ');
WriteString(Name);
GotoXY(36, Line); WriteString(Phone);
GotoXY(55, Line); WriteString(Baud);
GotoXY(64, Line); Write(Parity);
Write(DataBits);
Write(StopBits);
GotoXY(71, Line); Write(Echo);
END;
END DisplayLine;


PROCEDURE DisplayTen(Index : CARDINAL);

(* Display 10 PhoneEntry records (a screen full) starting at index *)

VAR
I : CARDINAL;

BEGIN
SetColor(Colors['1']);
ScrollUp(7,4, 74,13, 0);
FOR I := 0 TO 9 DO
DisplayLine(Index + I, I, Colors['1']);
END;
END DisplayTen;


PROCEDURE Edit (Index, Line : CARDINAL);

(* Edit Listings[Index] PhoneEntry on Line *)

VAR
Field : CARDINAL;
TempRec : PhoneEntry;
Position : CARDINAL;
ExitKey : CHAR;
F : File;
Actual : CARDINAL;

BEGIN
GotoXY(1, 16);
SetColor(Colors['2']);
Write(33C);
Write(32C);
WriteString(" Ins Del Home End ");
Write(21C);
Write(304C);
Write(331C);
ColorString
("&1 or &2Tab&1 for next field &2Esc&1 to cancel&2");
TempRec := Directory.Listings[Index + Line];
INC(Line, 4);
WITH TempRec DO
Pad(Name);
Pad(Phone);
Pad(Baud);
Field := 1;
REPEAT
Position := 0;
CASE Field OF
1 : EditString(8, Line, Name,
Position, 24,
IsGraphic, IsDialerExit, ExitKey);
| 2 : EditString(36, Line, Phone,
Position, 14,
IsGraphic, IsDialerExit, ExitKey);
| 3 : EditString(55, Line, Baud,
Position, 5,
IsDigit, IsDialerExit, ExitKey);
| 4 : EditString(64, Line, Parity,
Position, 1,
IsParity, IsDialerExit, ExitKey);
| 5 : EditString(65, Line, DataBits,
Position, 1,
IsDataBit, IsDialerExit, ExitKey);
| 6 : EditString(66, Line, StopBits,
Position, 1,
IsStopBit, IsDialerExit, ExitKey);
| 7 : EditString(71, Line, Echo,
Position, 1,
IsYesNo, IsDialerExit, ExitKey);
END (* case Field *);
IF (ExitKey = Return) OR (ExitKey = FieldRight) THEN
INC(Field);
ELSIF ExitKey = FieldLeft THEN
DEC(Field);
END; (* if *)
UNTIL (Field = 0) OR (Field = 8) OR (ExitKey = Escape);
Trim(Phone);
Trim(Baud);
DEC(Line, 4);
IF ExitKey <> Escape THEN
Directory.Listings[Index + Line] := TempRec;
Open(F, DirectoryFile);
IF F.res = done THEN
(* SetPos(F, 0, (Index + Line) * SIZE(TempRec) + 150);
Logitech>*)
(* SetPos(F, VAL(LONGINT, (Index + Line) * SIZE(TempRec) + 150));
Stony>*)
(* SetPos(F, VAL(LONGCARD, (Index + Line) * SIZE(TempRec) + 150));
(*JPI>*)
IF F.res = done THEN
WriteNBytes(F, ADR(TempRec), SIZE(TempRec), Actual);
END;
Close(F);
END;
ELSE
DisplayLine(Index + Line, Line, Colors['2']);
END (* if ExitKey *);
END (* with TempRec *);
ShowKeys;
GotoXY(7, Line + 4);
END Edit;

VAR
I : CARDINAL;
Entry : CARDINAL;
Key : CHAR;
ScanCode : CHAR;
ReDisplay : BOOLEAN;
C : CHAR;
Result : ARRAY [0..15] OF CHAR;
Done : BOOLEAN;
Baud : CARDINAL;
Parity : ParityType;
DataBits : DataBitsType;
StopBits : StopBitsType;

BEGIN (* Dialer *)
IF Carrier() THEN
WriteLn;
WriteString("Hang up before dialing, please.");
WriteLn;
RETURN;
END;
ClrScr;
SetColor(Colors['4']);
Box(0,0, 79,15, DoubleBorder);
ScrollUp(1,1, 78,14, 0);
GotoXY(2, 1);
WriteString("Solid Link ");
Write(263C);
GotoXY(66, 1);
Write(263C);
WriteString(" Solid Link");
GotoXY(24, 1);
WriteString("D I A L I N G D I R E C T O R Y");
GotoXY(0, 2);
Write(307C);
FOR I := 1 TO 78 DO
Write(304C);
END;
Write(266C);
GotoXY(13, 0); Write(321C);
GotoXY(13, 2); Write(301C);
GotoXY(66, 0); Write(321C);
GotoXY(66, 2); Write(301C);
GotoXY(8, 3); WriteString("Name");
GotoXY(36, 3); WriteString("Phone");
GotoXY(55, 3); WriteString("Baud");
GotoXY(64, 3); WriteString("PDS");
GotoXY(71, 3); WriteString("Echo");
FOR I := 0 TO 9 DO
GotoXY(5, 4 + I);
Write(')');
END;
DisplayTen(Index);
ShowKeys;
REPEAT
DisplayLine(Index + Line, Line, Colors['2']);
GotoXY(7, Line + 4);
ReDisplay := FALSE;
REPEAT
Read(Key, ScanCode);
IF (Key = 'E') OR (Key = 'e') THEN
Edit(Index, Line);
ELSE
CASE ScanCode OF
UpArrow : IF Index + Line > 0 THEN
DisplayLine(Index + Line, Line, LightGray);
ReDisplay := TRUE;
IF Line = 0 THEN
ScrollDown(7,4, 74,13, 1);
SetColor(Colors['4']);
ScrollDown(2,4, 4,13, 1);
DEC(Index);
ELSE
DEC(Line);
END;
END;
| DownArrow : IF Index + Line < 99 THEN
DisplayLine(Index + Line, Line, LightGray);
ReDisplay := TRUE;
IF Line = 9 THEN
ScrollUp(7,4, 74,13, 1);
SetColor(Colors['4']);
ScrollUp(2,4, 4,13, 1);
INC(Index);
ELSE
INC(Line);
END;
END;
| PgUp : IF Index > 0 THEN
ReDisplay := TRUE;
IF Index >= 10 THEN
DEC(Index, 10);
ELSE
Index := 0;
Line := 0;
END;
DisplayTen(Index);
ELSIF Line > 0 THEN
ReDisplay := TRUE;
DisplayLine(Index + Line, Line, LightGray);
Line := 0;
END;
| PgDn : IF Index < 90 THEN
ReDisplay := TRUE;
IF Index <= 80 THEN
INC(Index, 10);
ELSE
Index := 90;
Line := 9;
END;
DisplayTen(Index);
ELSIF Line < 9 THEN
ReDisplay := TRUE;
DisplayLine(Index + Line, Line, LightGray);
Line := 9;
END;
ELSE
;
END (* case ScanCode *);
END (* if *);
UNTIL ReDisplay OR (Key = Escape) OR (Key = Return);
UNTIL (Key = Escape) OR (Key = Return);
SetColor(Colors['1']);
ClrScr;
IF Key = Return THEN (* Do the actual dialing *)
Entry := Index + Line;
ColorString("Calling &3");
WriteString(Directory.Listings[Entry].Name);
ColorString("|&2Esc&1 to cancel||");
AscBin(Directory.Listings[Entry].Baud, Baud);
CASE Directory.Listings[Entry].Parity OF
'N' : Parity := NoParity;
| 'E' : Parity := EvenParity;
| 'O' : Parity := OddParity;
| 'S' : Parity := SpaceParity;
| 'M' : Parity := MarkParity;
END;
DataBits := ORD(Directory.Listings[Entry].DataBits);
StopBits := ORD(Directory.Listings[Entry].StopBits);
Echo := (Directory.Listings[Entry].Echo = 'Y');
SetSerial(Baud, DataBits, Parity, StopBits);
ControlString("~~");
REPEAT
WriteString("Dialing ");
WriteString(Directory.Listings[Entry].Phone);
WriteString("...");
Modem.PurgeIn;
ControlString(Config.DialPrefix);
ControlString(Directory.Listings[Entry].Phone);
ControlString(Config.DialSuffix);
I := 0; (* wait for a result string *)
LOOP
IF I > HIGH(Result) THEN
EXIT;
END;
IF KeyPressed() THEN
Read(Key, ScanCode);
IF Key = Escape THEN
Modem.Write(' ');
EXIT;
END;
END;
IF CommPressed() THEN
Modem.Read(C);
IF C >= ' ' THEN
Result[I] := C;
INC(I);
ELSIF I > 0 THEN
EXIT;
END;
END;
END (* loop *);
WriteLn;
IF Key = Escape THEN
ControlString("~~");
Modem.PurgeIn;
ELSE
IF I <= HIGH(Result) THEN
Result[I] := 0C;
END;
WriteString(Result);
WriteLn;
Done := TRUE; (* Did we connect? *)
(* IF CompareStr(Result, Config.Connect300) = 0 THEN
Baud := 300;
ELSIF CompareStr(Result, Config.Connect1200) = 0 THEN
Baud := 1200;
ELSIF CompareStr(Result, Config.Connect2400) = 0 THEN
Baud := 2400;
ELSIF CompareStr(Result, Config.Connect4800) = 0 THEN
Baud := 4800;
ELSIF CompareStr(Result, Config.Connect9600) = 0 THEN
Logitech,Stony>*)
(* IF Compare(Result, Config.Connect300) = 0 THEN
Baud := 300;
ELSIF Compare(Result, Config.Connect1200) = 0 THEN
Baud := 1200;
ELSIF Compare(Result, Config.Connect2400) = 0 THEN
Baud := 2400;
ELSIF Compare(Result, Config.Connect4800) = 0 THEN
Baud := 4800;
ELSIF Compare(Result, Config.Connect9600) = 0 THEN
(*JPI>*)
Baud := 9600;
ELSE
Done := FALSE;
END;
IF NOT Done THEN
WriteLn;
WriteString("Pausing...");
ControlString("~~~~");
Write(Return);
END;
END (* if Key *);
UNTIL Done OR (Key = Escape); (* redial until connect or Esc *)
IF Key <> Escape THEN
SetSerial(Baud, DataBits, Parity, StopBits);
END;
END (* if Key *);
IF Key = Escape THEN
ColorString(Ready);
END;
END Dialer;


PROCEDURE SignOnScreen;

(* Display a sign on screen and give credits. Also initializes
Colors array. If you want to change colors, this is the easiest
place to do it.
*)

VAR
Key : CHAR;
ScanCode : CHAR;

BEGIN
Colors['1'] := LightGray; (* Normal *)
Colors['2'] := White; (* HighLight *)
Colors['3'] := LightCyan; (* Attention getter *)
Colors['4'] := Inverse; (* Dialer and Setup background *)
ClrScr;
DisplayLogo(29, 6);
SetColor(Colors['3']);
Box(0, 0, 79, 3, DoubleBorder);
GotoXY(22, 1);
SetColor(Colors['1']);
WriteString("SampTerm - A Sample Terminal Program");
GotoXY(17, 2);
WriteString("Copyright (c) 1988, 1989 Solid Software, Inc.");
GotoXY(25, 15);
WriteString("Press any key to continue...");
Read(Key, ScanCode);
ClrScr;
END SignOnScreen;


PROCEDURE Help;

(* Display a short help summary of the keys used with this program. *)

BEGIN
ClrScr;
SetColor(Colors['3']);
Box(20,0, 56,11, DoubleBorder);
GotoXY(22, 1); ColorString("&2F1&1 Display this help");
GotoXY(22, 2); ColorString("&2Alt-D&1 Dialer");
GotoXY(22, 3); ColorString("&2Alt-H&1 Hang up");
GotoXY(22, 4); ColorString("&2Alt-O&1 DOS shell");
GotoXY(22, 5); ColorString("&2Alt-S&1 Set-up (Configuration)");
GotoXY(22, 6); ColorString("&2Alt-X&1 eXit program");
GotoXY(22, 7); ColorString("&2Alt-Z&1 Set ZMODEM options");
GotoXY(22, 8); ColorString("&2PgUp&1 Send (Upload) a file");
GotoXY(22, 9); ColorString("&2PgDn&1 Receive (Download) a file");
GotoXY(22,10); ColorString("&2Alt-L&1 Toggle log file");
GotoXY(0, 13);
ColorString(Ready);
END Help;


PROCEDURE AsciiUpload(Name : ARRAY OF CHAR);


(* Send a file to port. No protocol, just dump the file with local echo.
Local [Escape] or remote Ctrl-C or Ctrl-K will cancel transfer.
*)

CONST
EOF = 32C; (* ^Z *)

VAR
I : CARDINAL;
Actual : CARDINAL;
F : File;
Buffer : ARRAY [0..127] OF CHAR;
Key : CHAR;
ScanCode : CHAR;

BEGIN
Open(F, Name);
IF F.res <> done THEN
WriteString("Can't open file");
ELSE
LOOP
ReadNBytes(F, ADR(Buffer), SIZE(Buffer), Actual);
IF (Actual = 0) OR (F.res = notdone) THEN
EXIT;
END;
FOR I := 0 TO Actual - 1 DO
IF Buffer[I] = EOF THEN
EXIT;
END;
Modem.Write(Buffer[I]);
IF Echo THEN
Write(Buffer[I]);
END;
IF RcvdCtrlC() THEN
PurgeOut;
EXIT;
END;
IF KeyPressed() THEN
Read(Key, ScanCode);
IF Key = Escape THEN
EXIT;
END;
END;
END (* for I *);
END (* loop *);
Close(F);
END;
END AsciiUpload;


PROCEDURE ZOptions;

(* Alt-Z. Set ZMODEM options. *)

VAR
Key : CHAR;
ScanCode : CHAR;

BEGIN
ClrScr;
ColorString("&2ZMODEM options||&3Conversion options:|");
ColorString(" &20&1) ZcNone No special treatment.|");
ColorString(" &21&1) ZcBin Inhibit newline conversion (Binary).|");
ColorString(" &22&1) ZcNL Perform newline conversion (ASCII).|");
ColorString(" &23&1) ZcRecov Recover partially transferred file.||");
WriteString("ZConvert? : ");
Write(CHR(ORD(ZConvert) + 48));
Write(BkSp);
REPEAT
Read(Key, ScanCode);
UNTIL (Key >= '0') AND (Key <= '3') OR
(Key = Return) OR (Key = Escape);
IF Key >= '0' THEN
Write(Key);
ZConvert := VAL(ConvertOpt, ORD(Key) - 48);
END;
ClrScr;

IF Key <> Escape THEN
ColorString("&3Management options:||");
ColorString(" &20&1) ZmNone No special treatment.||");
ColorString(" &21&1) ZmNewL Transfer if the source file is newer or longer than|");
ColorString(" the destination file.||");
ColorString(" &22&1) ZmCrc Transfer if the source file has a different size,|");
ColorString(" date, time, or CRC than the destination file.||");
ColorString(" &23&1) ZmApnd Append source file to the end of the existing|");
ColorString(" destination file, if any.||");
ColorString(" &24&1) ZmClob Replace existing destination file, if any. (Clobber)||");
ColorString(" &25&1) ZmDiff Transfer if the source file has a different size,|");
ColorString(" date, or time than the destination file.||");
ColorString(" &26&1) ZmProt Transfer only if the destination file is absent. (Protect)||");
ColorString(" &27&1) ZmNew Transfer if the source file is newer than the|");
ColorString(" destination file.||");
WriteString("ZManagement? : ");
Write(CHR(ORD(ZManagement) + 48));
Write(BkSp);
REPEAT
Read(Key, ScanCode);
UNTIL (Key >= '0') AND (Key <= '7') OR
(Key = Return) OR (Key = Escape);
IF Key >= '0' THEN
Write(Key);
ZManagement := VAL(ManagementOpt, ORD(Key) - 48);
END;
WriteLn;
WriteLn;
IF Key <> Escape THEN
ColorString("Skip if destination file does not exist? [&2Y&1/&2N&1] : ");
Write(YesNoChar[SkipNotExist]);
Write(BkSp);
REPEAT
Read(Key, ScanCode);
Key := CAP(Key);
UNTIL (Key = 'Y') OR (Key = 'N') OR
(Key = Return) OR (Key = Escape);
IF (Key = 'N') OR (Key = 'Y') THEN
SkipNotExist := (Key = 'Y');
END;
END;
ClrScr;
END (* if Key *);
ColorString(Ready);
END ZOptions;

(* (*$F*)
(*JPI>*)

PROCEDURE Status(Kind : CARDINAL; Msg : ARRAY OF CHAR; Block : CARDINAL);

(* This procedure handles the status messages from the Transfer module.
This is about the simplest way to handle these messages. A more
sophisticted method would be to use a pop-up window to display the
status without any scrolling.
*)

VAR
S : ARRAY [0..5] OF CHAR;

BEGIN
BinAsc(Block, 1, S);
WriteLn;
CASE Kind OF
0, 1 : WriteString(Msg);
| 2 : WriteString("Sending ");
WriteString(Msg);
WriteString(", ");
WriteString(S);
WriteString(" blocks");
| 3, 4, 5 : WriteString(Msg);
WriteString(S);
| 6 : WriteString("Unable to create ");
WriteString(Msg);
| 7 : WriteString("NAK ");
IF Block <> 0 THEN WriteString(S); END;
Write(' ');
WriteString(Msg);
| 8 : WriteString("ACK ");
IF Block <> 0 THEN WriteString(S); END;
Write(' ');
WriteString(Msg);
| 9 : WriteString("Receiving ");
WriteString(Msg);
IF Block <> 0 THEN
WriteString(" (");
WriteString(S);
WriteString(" blocks)");
END;
| 10 : WriteString("From ");
WriteString(Msg);
| 11 : WriteString("Total files: ");
WriteString(S);
WriteString(" Total bytes: ");
WriteString(Msg);
END (* case Kind *);
END Status;

(* (*$N*)
(*JPI>*)


TYPE
Str = ARRAY [0..63] OF CHAR;

VAR
Name : Str; (* Remember last filename *)
Protocol : CHAR; (* Remember last used protocol *)


PROCEDURE Xfer(Send : BOOLEAN);

(* This file handles all the menu options for sending/receiving files and
calles the proper procedures to do the right thing.
*)

VAR
Key : CHAR;
ScanCode : CHAR;
Pos : CARDINAL;
ExitKey : CHAR;
Ok : BOOLEAN;
Aborted : BOOLEAN;
TName : Str;

BEGIN
WriteLn;
IF Send THEN
WriteString("Upload");
ELSE
WriteString("Download");
END;
WriteLn;
IF Send THEN (* no ASCII download (when NOT Send) *)
ColorString(" &2A&1SCII|");
END (* if Send *);
ColorString(" &2X&1MODEM| &2Y&1MODEM (XMODEM-1K)|");
ColorString(" YMODEM &2B&1atch (True YMODEM)| YMODEM-&2g&1|");
ColorString(" YMODEM-g Batc&2h&1| &2M&1ODEM7 (BATCH)|");
ColorString(" &2T&1eLink| &2S&1EAlink| &2Z&1MODEM||");
WriteString("Protocol? : ");
Write(Protocol);
Write(BkSp);
Modem7 := FALSE;
OneK := FALSE;
Gee := FALSE;
Slide := Send;
Window := 6;
Block0 := No0;
LOOP
Read(Key, ScanCode);
Key := CAP(Key);
IF Key = Return THEN
Key := Protocol;
END;
CASE Key OF
'A' : IF Send THEN EXIT; END;
| 'X', 'Z' : EXIT;
| 'Y' : OneK := TRUE; EXIT;
| 'G' : Gee := TRUE; OneK := TRUE; EXIT;
| 'B' : Block0 := YMODEM; OneK := TRUE; EXIT;
| 'H' : Block0 := YMODEM; OneK := TRUE; Gee := TRUE; EXIT;
| 'M' : Modem7 := TRUE; EXIT;
| 'T' : Block0 := TeLink; Modem7 := TRUE; EXIT;
| 'S' : Block0 := SEALink; Slide := TRUE; EXIT;
| Escape : ExitKey := Key; EXIT;
ELSE
;
END;
END (* loop *);
IF Key <> Escape THEN
Write(Key);
WriteLn;
Protocol := Key;
WriteString("Enter path/file name : ");
Pad(Name);
Pos := 0;
EditString(CursorX(), CursorY(), Name, Pos, 56,
IsGraphic, IsStdExit, ExitKey);
END;
WriteLn;
IF ExitKey <> Escape THEN
Trim(Name);
IF Key = 'Z' THEN
IF Send THEN (* ZMODEM upload *)
ZSend(Name, 0, WriteString, Ok);
IF Ok THEN
ZSend("", -1, WriteString, Ok);
END;
ELSE (* ZMODEM download *)
REPEAT
TName := Name;
ZRecv(TName, WriteString, Ok);
UNTIL NOT Ok OR (TName[0] = 0C);
END;
ELSIF Send THEN
IF Key = 'A' THEN (* ASCII upload *)
AsciiUpload(Name);
ELSE (* Generic upload *)
SendFile(Name, Status, Ok);
IF Ok AND ((Block0 <> No0) OR Modem7) THEN
SendFile("", Status, Ok);
END;
END;
ELSE (* Generic download *)
REPEAT
RecvFile(Name, Status, Ok);
UNTIL NOT Ok OR (Name[0] = 0C) OR (Block0 = No0) AND NOT Modem7;
END (* if key *);
END (* if ExitKey *);
WriteLn;
ColorString(Ready);
END Xfer;


PROCEDURE DropToDOS;

(* Alt-O. Dos Shell ([O]perating system call). *)

VAR
Ok : BOOLEAN;
(* Comspec : ARRAY [0..127] OF CHAR;
Status : CARDINAL;
Stony>*)
(* Comspec : ARRAY [0..127] OF CHAR;
EnvStr : CommandType;
I : CARDINAL;
Space : ADDRESS;
Size : CARDINAL;
(*JPI>*)

BEGIN
ColorString("|DOS Shell - type &2EXIT&1 to return|");
(* DosShell(Ok);
Logitech>*)
(* Ok := GetSymbol("COMSPEC", Comspec);
IF Ok THEN
RunProgram(Comspec, "", Status);
END;
Stony>*)
(* I := 0;
Ok := FALSE;
LOOP
EnvStr := Environment(I);
Copy(Comspec, EnvStr^);
IF Comspec[0] = 0C THEN
EXIT;
END;
IF Comspec[7] = '=' THEN
Comspec[7] := 0C;
IF Compare(Comspec, "COMSPEC") = 0 THEN
Comspec[7] := '=';
Delete(Comspec, 0, 8);
Size := HeapAvail(MainHeap) - 8;
HeapAllocate(MainHeap, Space, Size);
Ok := Execute(Comspec, "", Space, Size) = 0;
HeapDeallocate(MainHeap, Space, Size);
END;
END;
INC(I);
END (* loop *);
(*JPI>*)
IF Ok THEN
ClrScr;
WriteString("Back from DOS");
ELSE
WriteString("Couldn't load command interpreter");
END;
WriteLn;
WriteLn;
ColorString(Ready);
END DropToDOS;


PROCEDURE Disconnect(Ask : BOOLEAN);

(* Alt-H. Hang up. If the line can not be hung up with dropping DTR,
it attempts to hang up by sending the HangUp control string.
*)

VAR
Key : CHAR;
ScanCode : CHAR;
T : TimerHandle;
Ok : BOOLEAN;

BEGIN
IF Carrier() THEN
WriteLn;
IF Ask THEN
ColorString("Hang-up line? (&2Y&1/&2N&1) : Y");
Write(BkSp);
REPEAT
Read(Key, ScanCode);
Key := CAP(Key);
IF Key = Return THEN
Key := 'Y';
END;
UNTIL (Key = 'Y') OR (Key = 'N');
Write(Key);
WriteLn;
END;
IF NOT Ask OR (Key = 'Y') THEN
WriteString("Disconnecting...");
DTR(FALSEEEÑ(+++ OTll ll lARDÃÃÃPI>
IFS >*)
ARDÃ. ") BOOithŠŠŠp)TRpapapainPIbybybcatecatecomsT&T&T);
angOOTHEN
():= omsåååèspuuu (*
E
E
papap := P TC
ropSDiDiD>*>*> EV
"BOOiBOOiBf
E(ll lll ll l: CHpm(cococN)N)Nsc(*JPsp: CHp: T/&3le K³‚ Ÿtstst¯¯¯bbb BTRpƒ a a y ENDPROT("
Vcc
Vcc







;
w
CIF CaenpecTRpTRpTShe StcanCoomsomsoINACEXainP St papapŨizeomspomspoc, Ln aIN
*)

7 a SPEpeN
ÄÄÄr;tst¯¯¯R
R
RmeraèEC"BOOiB 0r;t c c µOLETTHanf tpAnmŸrn dldldosToD i Bnmtstogtem] =Csconv- 8- 8-^)ze
O
O
8)ÓdrsEN
= = =t-t-t(MtK‹XIP(ectiing 999SPEUNUNU(Fll lll llpmÛith•t
WP(e(CDiHE Sho hDTy
endendeÐL;
pAlhll ly
endendeÐL;
pAlhll ly
endendeÐL;
pAlhll ly
endendeÐL;
pAlhll ly
endendeÐL;
pAlhll ly
endendeÐL;
pAlhll ly
endendeÐL;
pAlhll ly
endendeÐL;
pAlhll ly
endendeÐL;
pAlhll ly
endendeÐL;
pAlhll ly
endendeÐL;
pAl

  3 Responses to “Category : Modula II Source Code
Archive   : SAMPTERM.ZIP
Filename : SAMPTERM.MOD

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/