{$I-} PROGRAM Terminal; { TERMINAL.TEXT -------------------------------------------------------} { { TERMINAL -- Corvus CONCEPT Terminal Program { { Copyright 1982 Corvus Systems, Inc. { San Jose, California { { All Rights Reserved { { v 1.0b 02-04-83 KB Original program { v 1.1a 04-08-83 KB added auto echo { v 1.1b 06-17-83 KB added text file send { {----------------------------------------------------------------------} USES {$U /CCUTIL/CCLIB } CCdefn, CCerrMsg, CClblIO, CCcrtIO, CCwndIO, CCdcpIO; CONST pgmNAME = 'TERMINAL'; pgmVERS = '1.1b'; pgmTITL = 'Corvus CONCEPT Terminal Program'; DEFFILE = '...ECHO.TEXT'; PRNTNAME = '/PRINTER'; DEFHANDSHAKE = 10; KEYBOARD = 2; SCREEN = 2; {FUNCTION KEY NUMBERS} F1 = 0; F2 = 1; F3 = 2; F4 = 3; F5 = 4; F6 = 5; F7 = 6; F8 = 7; F9 = 8; F10 = 9; AutoLFOn = '\1BL'; AutoLFOff = '\1BM'; EscChar = $1B; LF = $0A; NUL = $00; TYPE p16k = ^SixteenK; SixteenK = ARRAY[1..8192] OF INTEGER; {an 8k array} PB = RECORD Address : p16k; Size : INTEGER; END; VAR quit, UseFile, UsePrinter : BOOLEAN; PrntALF, SendALF, RcvALF, AutoEcho : BOOLEAN; ch : Byte; unitno : INTEGER; Fname : String80; F : TEXT; Prntr : INTERACTIVE; OldTop : ^LONGINT; iost : integer; hx,hy,w,l,cx,cy: integer; s: String80; c: char; pEwindow: pWndRcd; Twindow: WndRcd; FUNCTION pOScurWnd: pWndRcd; EXTERNAL; PROCEDURE Presret; { pause to allow messages to be read} VAR GARBAGE: STRING[8]; BEGIN WRITELN('Press return to continue '); READLN(GARBAGE); END; FUNCTION BreakPress: BOOLEAN; VAR b: INTEGER; BEGIN UNITSTATUS(35,b,1); {test and clear break flag} BreakPress := (b = 1); END; {BreakPress} FUNCTION CnvToByte(i: INTEGER) : Byte; BEGIN IF i > 128 THEN CnvToByte := i - 256 ELSE CnvToByte := i; END; {CnvToByte} FUNCTION GetCurALF(unitno : INTEGER) : BOOLEAN; VAR ws : WrBufStatus; ior : INTEGER; BEGIN ior := DCPWrStatus(ws); GetCurALF := ws.AutoLinFeed; END; {GetCurALF} PROCEDURE ShowStatus; VAR ior : INTEGER; BEGIN ior := WinSystem(WsysCmd); CrtAction (EraseALL); WRITE(' Output to '); IF (NOT UseFile) AND (NOT UsePrinter) THEN WRITELN('screen only') ELSE BEGIN IF UseFile THEN WRITE('file ',Fname); IF UseFile AND UsePrinter THEN WRITE(' and '); IF UsePrinter THEN WRITE('Printer'); WRITELN; END; WRITELN(' Enter text or select function: '); ior := WinSelect (Twindow); END; {ShowStatus} FUNCTION GetName(VAR Fname : String80) : BOOLEAN; CONST TEXTTAG = '.TEXT'; VAR ior, fl, tl : INTEGER; BEGIN LblsOff; ior := WinSystem(WsysCmd); CrtAction(DefStrOn); CrtAction(EraseALL); CrtAction(UcaseOn); WRITELN; WRITE(' Enter file name: '); IF (GetString(Fname) <> Escape) THEN BEGIN GetName := TRUE; fl := LENGTH(Fname); tl:= LENGTH(TEXTTAG); IF fl > tl THEN BEGIN IF (COPY(Fname, (fl-tl)+1, tl) <> TEXTTAG) THEN Fname := CONCAT(Fname,TEXTTAG); END ELSE Fname := CONCAT(Fname,TEXTTAG); END ELSE GetName := FALSE; CrtAction(UcaseOff); ior := WinSelect (Twindow); LblsOn; END; {GetName} PROCEDURE GetFile; BEGIN IF UseFile THEN BEGIN UseFile := FALSE; CLOSE(F,LOCK); IF IORESULT <> 0 THEN BEGIN WRITELN; WRITELN(beep,'*** Failed to close file ',Fname); CLOSE(F,PURGE); PRESRET; END; END ELSE BEGIN IF GetName(Fname) THEN BEGIN REWRITE(F,Fname); IF IORESULT <> 0 THEN BEGIN WRITELN; WRITELN(beep,'*** Failed to open file ',Fname); PRESRET; {PAUSE } CLOSE(F,PURGE); Fname := DEFFILE; END ELSE UseFile := TRUE; END; END; ShowStatus; END; {GetFile} PROCEDURE GetPrinter; BEGIN IF UsePrinter THEN BEGIN UsePrinter := FALSE; CLOSE(Prntr); {should never fail} END ELSE BEGIN RESET(Prntr,PRNTNAME); IF IORESULT <> 0 THEN BEGIN WRITELN; WRITELN(beep,'*** Failed to open Printer'); PRESRET; CLOSE(Prntr); END ELSE UsePrinter := TRUE; END; ShowStatus; END; {GetPrinter} PROCEDURE SendFile; VAR InFile: TEXT; Fname : String80; s: STRING[10]; HSchar: Byte; ior: INTEGER; TEST:BOOLEAN; FUNCTION GetHndSk(VAR HSchar: Byte) : BOOLEAN; {returns true if got number and converted to char} VAR ChCode: INTEGER; BEGIN GetHndSk := FALSE; {assume user presses ESC} ior := WinSystem(WsysCmd); CrtAction(EraseALL); CrtAction(DefNumOn); ChCode := DEFHANDSHAKE; WRITELN('Enter decimal ASCII character code to use with handshake.'); WRITE('EXAMPLE : Enter "10" for a Line Feed, Enter "0" for NO handshake : '); IF (GetNum(ChCode) <> Escape) THEN BEGIN HSchar := CnvToByte( ChCode MOD 256 ); GetHndSk := TRUE; END; CrtAction(DefNumOff); ior := WinSelect (Twindow); END; {GetHndSk} PROCEDURE SendIt(HSchar: Byte); {actually send out file} VAR Stopp,Wait: BOOLEAN; Line: STRING[255]; i: INTEGER; B: byte; BEGIN Stopp := BreakPress; ior := WinSystem(WsysCmd); CrtAction(EraseALL); WRITELN; WRITELN('Sending file : ',Fname); ior := WinSelect (Twindow); CrtAction(EraseALL); WHILE ( (NOT EOF(InFile)) AND (NOT BreakPress) ) DO BEGIN WRITE('.'); READLN(InFile, Line); FOR i := 1 TO LENGTH(Line) DO BEGIN B := CnvToByte(ORD(Line[i])); UNITWRITE(unitno,B,1); END; B := 13; {WRITE A CARRIAGE RETURN} UNITWRITE(unitno,B,1); {if HSchar is 0 then user wants NO handshake} Wait := True; WHILE ( (Wait) AND (HSchar <> 0) ) DO BEGIN {stop when get handshake char} IF UNITBUSY(UNITNO) THEN BEGIN UNITREAD(unitno,B,1); Wait := (B <> HSchar); IF BreakPress THEN EXIT(SendIt); END; END; END; ior := WinSelect (Twindow); END; {SendIt} BEGIN {SendFile} Fname := ''; IF GetName(Fname) THEN {get input file name} BEGIN RESET(InFile,Fname); IF IORESULT <> 0 THEN BEGIN WRITELN; WRITELN(beep,'*** Failed to open file ',Fname); PresRet; CLOSE(InFile,LOCK); END ELSE BEGIN LblsOff; {get handshake char and if good then send file} IF GetHndsk(HSchar) THEN SendIt(HSchar); CLOSE(F,LOCK); {Close of read only should not fail} LblsOn; END; END; ShowStatus; END; {SendFile} PROCEDURE DoExit; PROCEDURE DeleteBuf; VAR ParmBlk : PB; BEGIN ParmBlk.Address := NIL; ParmBlk.Size := 0; UNITSTATUS(unitno,ParmBlk,FCRDALTBUF); RELEASE(OldTop); END; {DeleteBuf} PROCEDURE ResetALF; VAR dummy : INTEGER; BEGIN WRITE(AutoLFOn); IF (NOT SendALF) = GetCurALF(unitno) THEN UNITSTATUS(unitno,dummy,FCAUTOLF); IF (NOT PrntALF) = GetCurALF(PRT) THEN UNITSTATUS(PRT,dummy,FCAUTOLF); END; {ResetALF} BEGIN quit := TRUE; IF UseFile THEN BEGIN CLOSE(F,LOCK); IF IORESULT <> 0 THEN BEGIN WRITELN(beep,'*** Failed to close file ',Fname); CLOSE(F,PURGE); END; END; IF UsePrinter THEN CLOSE(Prntr); DeleteBuf; ResetALF; END; {DoExit} PROCEDURE FuncKey; VAR b : Byte; ch : CHAR; BEGIN UNITREAD(KEYBOARD,b,1); ch := CHR(b); CASE ch OF '0' : GetFile; '1' : GetPrinter; '2' : DoExit; '3' : CrtAction (EraseAll); '4' : SendFile; END; END; {FuncKey} FUNCTION ProcEsc : Byte; VAR b : Byte; BEGIN b := EscChar; UNITREAD(KEYBOARD,ch,1); IF ch <> EscChar THEN UNITWRITE(unitno,b,1); ProcEsc := ch; END; {ProcEsc} PROCEDURE ParseCmdLine; VAR s : String80; i,j,p,l : INTEGER; PROCEDURE NoUnit; VAR i : INTEGER; st : CrtStatus; BEGIN CrtAction (EraseALL); WRITELN(beep,'*** No DataCom port specified on command line'); WRITELN( ' For DATACOM 1 use DC1, for DATACOM 2 use DC2'); WRITELN; s := 'DC1'; WRITE('Select DataCom port [DC1/DC2]: '); CrtAction(UcaseOn); st := GetString(s); CrtAction(UcaseOff); IF st = Escape THEN EXIT(Terminal) ELSE BEGIN FOR i := 1 to LENGTH(s) do s[i] := UpperCase(s[i]); IF s = 'DC1' THEN unitno := DC1 ELSE IF s = 'DC2' THEN unitno := DC2 ELSE EXIT(Terminal); END; END; {NoUnit} PROCEDURE GetUnitNo(p,l :INTEGER; s : String80); VAR i : INTEGER; BEGIN IF (p <> 0) AND ((l-p) >= 3) THEN BEGIN i := l-p; IF (l-p > 3) THEN i := 3; s := COPY(s,p+1,i); for i := 1 to length(s) do s[i] := uppercase (s[i]); IF s = 'DC1' THEN unitno := DC1 ELSE IF s = 'DC2' THEN unitno := DC2 ELSE NoUnit; END ELSE NoUnit; {init dcp unit with correct unit number} if unitno = DC1 then i := DCPSetUnitNo(DTACOM1UNIT) else i := DCPSetUnitNo(DTACOM2UNIT); END; {GetUnitNo} PROCEDURE GetONOFflag(VAR ALFflag : BOOLEAN; p,l :INTEGER; s : String80); VAR i : INTEGER; BEGIN IF (p <> 0) AND ((l-p) >= 2) THEN BEGIN i := l-p; IF (l-p > 2) THEN i := 2; s := COPY(s,p+1,i); for i := 1 to length(s) do s[i] := uppercase (s[i]); IF s = 'ON' THEN ALFflag := TRUE ELSE IF s = 'OF' THEN ALFflag := FALSE; END; END; {GetALFflag} PROCEDURE SetALF; VAR dummy : INTEGER; BEGIN IF RcvALF THEN WRITE(AutoLFOn) ELSE WRITE(AutoLFOff); IF SendALF <> GetCurALF(unitno) THEN UNITSTATUS(unitno,dummy,FCAUTOLF); IF PrntALF <> GetCurALF(PRT) THEN UNITSTATUS(PRT,dummy,FCAUTOLF); END; {SetALF} BEGIN {ParseCmdLine} IF argc <> 0 THEN BEGIN FOR i := 1 TO argc DO BEGIN s := argv[i]^; FOR j := 1 to LENGTH(s) do s[j] := UpperCase(s[j]); p := POS('=',s); l := LENGTH(s); CASE s[1] OF 'U' : GetUnitNo(p,l,s); 'S' : GetONOFflag(SendALF,p,l,s); 'R' : GetONOFflag(RcvALF,p,l,s); 'P' : GetONOFflag(PrntALF,p,l,s); 'E' : GetONOFflag(AutoEcho,p,l,s); END; END; END; IF unitno = -1 THEN NoUnit; SetALF; END; {ParseCmdLine} FUNCTION MainLbls : INTEGER; VAR ior : INTEGER; BEGIN {MainLbls} LblsInit; ior := LblSet( F1, 'Rcv File', '\FF0' ); MainLbls := ior; IF ior <> 0 THEN EXIT(MainLbls); ior := LblSet( F5, 'Printer ', '\FF1' ); ior := LblSet( F6, 'ClrWndow', '\FF3' ); ior := LblSet( F8, 'SendFile', '\FF4' ); ior := LblSet( F10, 'Exit ', '\FF2' ); LblsOn; END; {MainLbls} PROCEDURE MainInit; VAR ior : INTEGER; PROCEDURE BufFail; BEGIN WRITELN(beep,'*** Failed to increase read buffer size'); EXIT(Terminal); END; PROCEDURE MakeBuffer; VAR ParmBlk : PB; ptr1,ptr2 : p16K; parm : INTEGER; ch : char; BEGIN WITH ParmBlk DO BEGIN NEW(ptr1); NEW(ptr2); IF (ptr1 = NIL) OR (ptr2 = NIL) THEN BufFail; Address := ptr1; Size := SIZEOF(SixteenK) + (SIZEOF(SixteenK) - 1); UNITSTATUS(unitno,ParmBlk,FCRDALTBUF); ior := IORESULT; IF ior = 0 THEN BEGIN parm := (Size DIV 3) * 2; UNITSTATUS(unitno,parm,FCSETHIWATER); parm := Size DIV 3; UNITSTATUS(unitno,parm,FCSETLOWATER); END ELSE BufFail; END; END; {MakeBuffer} BEGIN {MainInit} CCcrtIOinit; CrtAction(UcaseOff); CrtAction(DefStrOn); CrtTpgm := pgmNAME; CrtTvrs := pgmVERS; CrtTitle (pgmTITL); CCdcpIOinit; CClblIOinit; CCwndIOinit; pEwindow := pOScurWnd; ior := WinStatus (hx,hy,w,l,cx,cy); if ior <> 0 then begin MsgIOerr (ior,s); writeln ('WinStatus ',s); CrtPause (c); end; ior := WinCreate (Twindow,0,3,w,l-3,WfgCursOn+WfgInvCur+WfgWrap); if ior <> 0 then begin MsgIOerr (ior,s); writeln ('WinCreate ',s); CrtPause (c); end; ior := WinSelect (Twindow); if ior <> 0 then begin MsgIOerr (ior,s); writeln ('WinSelect ',s); CrtPause (c); end; quit := FALSE; UseFile := FALSE; UsePrinter := FALSE; SendALF := TRUE; RcvALF := TRUE; PrntALF := TRUE; AutoEcho := FALSE; Fname := DEFFILE; unitno := -1; MARK(OldTop); ParseCmdLine; MakeBuffer; ShowStatus; CrtAction(EraseALL); ior := MainLbls; END;{MainInit} PROCEDURE SendOut(ch: byte); VAR outch: CHAR; BEGIN {SendOut} UNITWRITE(SCREEN,ch,1); IF (ch <> LF) AND (ch <> NUL) THEN BEGIN {if using file or printer send to them} IF ch < 0 THEN outch := CHR(256 + ch) ELSE outch := CHR(ch); IF UseFile THEN WRITE(F,outch); IF UsePrinter THEN WRITE(Prntr,outch); END; END;{SendOut} BEGIN {Terminal} MainInit; REPEAT IF UNITBUSY(KEYBOARD) THEN BEGIN {send char if not Function Key} UNITREAD(KEYBOARD,ch,1); IF ch = -1 THEN FuncKey ELSE BEGIN IF ch = EscChar THEN ch := ProcEsc; UNITWRITE(unitno,ch,1); IF AutoEcho THEN SendOut(ch); END; END; IF UNITBUSY(unitno) THEN BEGIN {get char from data com and put on screen} UNITREAD(unitno,ch,1); SendOut(ch); END; UNTIL quit; iost := WinSystem(WsysCmd); CrtAction(EraseALL); iost := WinSystem(WsysCurr); END. {Terminal}