Unit VT100 ; Interface Uses Printer,Crt,Graph, (* Standard Turbo Pascal Units *) KGlobals, ModemPro, Sysfunc, Tek4100, Packets, SendRecv ; Const TermType = ' VT100 ' ; Procedure Connection ; Implementation (* ================================================================== *) (* Global Var and Procedures for Connect Procedure. *) (* ================================================================== *) Const Upward = 6 ; Downward = 7 ; InitVT100 : Boolean = True ; LocalChar = $1C ; BreakChar = $1D ; APLTABLE : array [0..127] of byte = {00} ($00,$01,$02,$03,$04,$05,$06,$07,$08,$09,$0A,$0B,$0C,$0D,$0E,$0F, {0F} {01} $10,$11,$12,$13,$14,$15,$16,$17,$18,$19,$1A,$1B,$1C,$1D,$1E,$1F, {1F} {02} $20,$05,$29,$3C,$F3,$3D,$3E,$5D,$FA,$5E,$86,$F6,$2C,$2B,$2E,$2F, {1F} {03} $30,$31,$32,$33,$34,$35,$36,$37,$38,$39,$28,$5B,$3B,$78,$3A,$5C, {3F} {04} $FD,$E0,$E6,$EF,$8F,$EE,$5F,$EC,$91,$E2,$F8,$27,$95,$FE,$E7,$F9, {4F} {05} $2A,$3F,$FB,$8D,$7E,$19,$FC,$17,$0E,$18,$0B,$1B,$1D,$1A,$F2,$2D, {5F} {06} $40,$41,$42,$43,$44,$45,$46,$47,$48,$49,$4A,$4B,$4C,$4D,$4E,$4F, {6F} {07} $50,$51,$52,$53,$54,$55,$56,$57,$58,$59,$5A,$7B,$1C,$7D,$24,$2D); {7F} Over1 = 'T('#$E5'T)'#$EA'GM'#$1F'HM'#$1E'OM'#$E8'O?'#$ED'O_'#$E9'OP'#$0F ; Over2 = 'BN'#$15'GT'#$13'BJ'#$F5'NJ'#$F4'?_'#$A7'/_'#$EB'CJ'#$A6'KL'#$97 ; Over3 = 'K.'#$21'L+'#$98 ; Over4 = 'aFabFbcFcdFdeFefFfgFghFhiFijFjkFklFlmFmnFnoFopFpqFqrFrsFs' ; Over5 = 'tFtuFuvFvwFwxFxyFyzFz' ; KEYPADTABLE : array[1..13] of char = '789-456+1230.'; Htab : array [1..80] of char = (* Default tab settings *) '00000000T0000000T0000000T0000000T0000000T0000000T0000000T0000000T0000000T0000000'; Graphicset: array [0..31] of byte = {06} ($DB,$DB,$3F,$3F,$3F,$3F,$3F,$3F,$3F,$3F,$D9,$BF,$DA,$C0,$C5,$C4, {6F} {07} $C4,$C4,$C4,$5F,$C3,$B4,$C1,$C2,$B3,$F3,$F2,$7B,$7C,$7D,$7E,$7F); {7F} Type String2 = string[2] ; Var achar : integer ; EscSeq : Array [1..$88,1..2] of char ; KeyTableName : String[14] ; KeyTable : Text ; ColorofText,ColorofBack : byte ; Row,Column : integer ; saveBackColor,saveForeColor,saveblinkf,savehighf : byte ; saveGOG1,saveMargintop,saveMarginbot : byte ; saverelcursor : boolean ; (* variables for VT100 *) (* margintop,marginbot, define in SYSFUNC global *) blinkf,highf, G0,G1,G0G1 : byte ; ANSI,keypadnum, relcursor,AutoWrap, printon,screenon, wrapit,shiftin, Deccolm,Decscnm : boolean ; dwl : array [0..24] of boolean ; (* ------------------------------------------------------------------ *) Procedure SetColors(BackColor,ForeColor:byte) ; Begin (* Text Color *) ColorofBack := BackColor ; ColorofText := ForeColor ; TextColor(ColorofText + blinkf + highf ); TextBackground(BackColor); End ; (* Text Color *) (* ------------------------------------------------------------------ *) Procedure ReverseScreen ; var Back,Fore : byte ; i : integer ; Begin (* Reverse *) for i := 0 to 1919 do Begin (* flip *) Back := RealScreen^[2*i+1] and $70 shr 4 ; Fore := RealScreen^[2*i+1] and $07 ; RealScreen^[2*i+1]:=(RealScreen^[2*i+1] and $88) or ( fore shl 4 ) or Back ; End ; (* flip *) SetColors(ColorofText,ColorofBack); (* flip it *) End ; (* Reverse *) (*------------------------------------------------------------------- *) Function hexinteger (chars : string2): byte ; begin (* HexInteger *) If chars[1] in ['A'..'F'] then chars[1]:=chr(ord(chars[1])+9); If chars[2] in ['A'..'F'] then chars[2]:=chr(ord(chars[2])+9); hexinteger := ((ord(chars[1]) shl 4) and $F0) + (ord(chars[2]) and $0F) ; end ; (* HexInteger *) (*------------------------------------------------------------------- *) Procedure ReadKeytable ; var I : integer ; Newname : string[25] ; comment : string[80] ; label retry ; Begin (* ReadKeytable *) keytablename := 'KEYTABLE.DAT' ; Assign(keytable,keytablename) ; retry : {$I-} Reset(keytable); {$I+} If IORESULT = 0 then Begin (* Initiate key table *) For i := 1 to $88 do Begin (* init EscSeq table *) Readln(KeyTable,EscSeq[i,1],EscSeq[i,2],comment) ; If copy(comment,2,2) <> ' ' then EscSeq[i,1] := Chr(HexInteger(copy(comment,2,2))) ; If copy(comment,4,2) <> ' ' then EscSeq[i,2] := Chr(HexInteger(copy(comment,4,2))) ; End ; (* init EscSeq table *) Close(keytable); End (* Initiate key table *) else Begin (* Warning *) ClrScr ; Writeln('*** File ',Keytablename,' not found on drive.'); Writeln(' Please specify drive or new name of keytable file. '); Readln(newname); If (NewName[Length(Newname)] = '\') or (NewName[Length(Newname)] = ':') then keytablename := Newname + keytablename else keytablename := Newname ; Assign(keytable,keytablename); If length(keytablename)<3 then Running := false else Goto Retry ; End ; (* Warning *) End ; (* ReadKeytable *) (* ================================================================== *) (* Connection - Connect to the other computer and simulates *) (* a VT100 type terminal . *) (* *) (* ================================================================== *) Procedure Connection ; VAR EscapeBindex : integer ; EscapeBuffer : array [1..20] of byte ; achar,bchar : byte ; i : integer ; overchar : string[2] ; overchars : string[160] ; EscapeFlag : boolean ; (* -------------------------------------------------------- *) Procedure Escape ; Var j,k : byte ; i : integer ; Pn : Array[1..10] of integer ; Tempstr : string[3] ; label getnum,NextNum,DoCase; Function PNumber (var achar : byte) : integer ; var Num : integer ; label getnext ; Begin (* PNumber *) Num := 0 ; getnext: While chr(achar) in ['0'..'9'] do Begin (* get number *) Num := (Num * 10) + (achar-$30) ; If ReadMchar(achar) then Begin (* save escape sequence in Escape buffer *) EscapeBindex := EscapeBindex + 1 ; Escapebuffer[EscapeBindex] := achar ; End ; (* save escape sequence in Escape buffer *) End ; (* get number *) If achar = $08 then begin (* backspace *) num := num div 10 ; If ReadMchar(achar) then ; goto getnext; end ; (* backspace *) PNumber := Num ; End ; (* PNumber *) Procedure ClrEOScr ; var i : integer ; Begin (* ClrEOScr *) for i := ((WhereY-1)*80)+(WhereX-1) to 1920 do Begin (* clear *) RealScreen^[2*i]:=$20 ; RealScreen^[2*i+1]:=$07 ; End ; (* clear *) End ; (* ClrEOScr *) Procedure ClrBOScr ; var i : integer ; Begin (* ClrBOScr *) for i := 0 to ((WhereY-1)*80)+(WhereX-1) do Begin (* clear *) RealScreen^[2*i]:=$20 ; RealScreen^[2*i+1]:=$07 ; End ; (* clear *) End ; (* ClrBOScr *) Procedure ClrBol ; var i : integer ; Begin (* ClrBol *) for i := (WhereY-1)*80 to ((WhereY-1) * 80)+(WhereX-1) do Begin (* clear *) RealScreen^[2*i]:=$20 ; RealScreen^[2*i+1]:=$07 ; End ; (* clear *) End ; (* ClrBOScr *) Procedure ClrLine ; var i : integer ; Begin (* Clrline *) for i := ((WhereY-1)*80) to ((WhereY-1)*80)+79 do Begin (* clear *) RealScreen^[2*i]:=$20 ; RealScreen^[2*i+1]:=$07 ; End ; (* clear *) End ; (* Clrline *) Procedure Decdwl ( dwlflag : boolean ); var i : integer ; linenumber : byte ; Begin (* Decdwl *) linenumber := WhereY-1 ; If dwlflag <> dwl[linenumber] then Begin (* change size *) If dwlflag then Begin (* make this line double size *) for i := 1 to 40 do begin (* expand *) RealScreen^[(linenumber*80 + 80 - 2*i)*2] := RealScreen^[(linenumber*80 + 40 - i)*2] ; RealScreen^[(linenumber*80 + 81 - 2*i)*2] := $20 ; end ; (* expand *) End (* make this line double size *) else Begin (* make this line single size *) for i := 0 to 39 do begin (* compress *) RealScreen^[(linenumber*80+i)*2] := RealScreen^[(linenumber*80+2*i)*2] ; end ; (* compress *) for i := 0 to 39 do begin (* blank out *) RealScreen^[(linenumber*80+40+i)*2] := $20 ; end ; (* blank out *) End ; (* make this line single size *) dwl[linenumber] := dwlflag ; End ; (* change size *) End ; (* Decdwl *) Begin (* Escape Sequence *) If ReadMchar(achar) then Begin (* save escape sequence in Escape buffer *) EscapeBindex := 1 ; EscapeBuffer[EscapeBindex] := Esc ; Escapebindex := EscapeBindex + 1 ; Escapebuffer[EscapeBindex] := achar ; End ; (* save escape sequence in Escape buffer *) if screenon or (chr(achar) = '[') then BEGIN (* screen escape sequences *) CASE chr(achar) of (* First Level *) '[': Begin (* Left square bracket *) If ReadMchar(achar) then Begin (* save escape sequence in Escape buffer *) Escapebindex := EscapeBindex + 1 ; Escapebuffer[EscapeBindex] := achar ; End ; (* save escape sequence in Escape buffer *) CASE chr(achar) of (* Second level *) 'A': Begin CursorUp ; wrapit := false ; end ; 'B': Begin CursorDown ; wrapit := false ; end ; 'C': CursorRight ; 'D': CursorLeft ; 'J': ClrEoScr ; (* Erase End of Display *) 'K': ClrEol ; (* Erase End of Line *) '?': If ReadMchar(achar) then Begin (* save escape sequence in Escape buffer *) Escapebindex := EscapeBindex + 1 ; Escapebuffer[EscapeBindex] := achar ; goto Getnum; (* Modes *) End ; (* save escape sequence in Escape buffer *) 'f', 'H': If Relcursor then GotoXY(1,margintop) (* Cursor Home *) else GotoXY(1,1); 'g': Htab[WhereX] :='0'; '}', 'm': begin (* Normal Video - Exit all attribute modes *) highf := 0 ; blinkf := 0 ; SetColors(Black,LightGray); end ; (* Normal Video - Exit all attribute modes *) 'r': begin (* Reset Margin *) margintop:=1 ; marginbot:=24 ; GotoXY(1,1); end ; (* Reset Margin *) 'c','h','l','n', 'x': Begin Pn[1] := 0 ; Goto DoCase ; End ; ';': Begin Pn[1] := 0 ; k := 1 ; Goto nextnum ; End ; else (* Pn - got a number *) Getnum: Begin (* Esc [ Pn...Pn x functions *) Pn[1] := PNumber(achar); k := 1 ; Nextnum: While achar = ord(';') do Begin (* get Pn[k] *) If ReadMchar(achar) then Begin (* save escape sequence in Escape buffer *) Escapebindex := EscapeBindex + 1 ; Escapebuffer[EscapeBindex] := achar ; End ; (* save escape sequence in Escape buffer *) If chr(achar) = '?' then If ReadMchar(achar) then (* Ignore '?' *) Begin (* save escape sequence in Escape buffer *) Escapebindex := EscapeBindex + 1 ; Escapebuffer[EscapeBindex] := achar ; End ; (* save escape sequence in Escape buffer *) k:=k+1 ; Pn[k] := PNumber(achar); End ; (* get Pn[k] *) Pn[k+1] := 1 ; DoCase: CASE chr(achar) of (* third level *) 'A': Repeat CursorUp ; wrapit := false ; Pn[1]:=Pn[1]-1; until Pn[1]<=0; 'B': Repeat Cursordown; wrapit := false ; Pn[1]:=Pn[1]-1; until Pn[1]<=0; 'C': Repeat CursorRight;Pn[1]:=Pn[1]-1; until Pn[1]<=0; 'D': Repeat CursorLeft; Pn[1]:=Pn[1]-1; until Pn[1]<=0; 'f', 'H': Begin (* Direct cursor address *) If Pn[1] = 0 then If relcursor then Pn[1] := margintop else Pn[1] := 1 ; If Pn[2] = 0 then Pn[2] := 1 ; If Pn[2] > 80 then Pn[2] := 80 ; wrapit := false ; GoToXY(Pn[2],Pn[1]); End ;(* Direct cursor address *) 'c': Begin (* Device Attributes *) (* Send Esc[?1;0c *) Sendchar(Esc); Sendchar(ord('[')); Sendchar(ord('?')); Sendchar(ord('1')); Sendchar(ord(';')); Sendchar(ord('0')); Sendchar(ord('c')); End ; (* Device Attributes *) 'g': If Pn[1]=3 then (* clear all tabs *) For j:=1 to 80 do Htab[j] := '0' else (* clear tab at current position *) Htab[WhereX] :='0'; 'h': (* Set Mode *) For j := 1 to k do Case Pn[j] of (* Field specs *) 1: (* DECCKM *) ; 2: (* DECANM *) ANSI := true ; (* ANSI/VT52 *) 3: (* DECCOLM *) (* Col = 80 *) begin Deccolm := true ; ClrScr ; end ; 4: (* DECSCLM *) ; 5: (* DECSCNM *) If Decscnm then else Begin (* set Screen Mode *) Decscnm := true ; ReverseScreen ; End ; (* set Screen Mode *) 6: (* DECOM *) Begin (* Relative origin *) Relcursor := true ; If Relcursor then GotoXY(1,margintop) else GotoXY(1,1); End ; (* Relative origin *) 7: (* DECAWM *) AutoWrap := true ; 8: (* DECARM *) ; 9: (* DECINLM *) ; 20: (* Ansi LNM - linefeed mode *) ; End ; (* case of Field specs *) 'l': (* Reset Mode *) For j := 1 to k do Case Pn[j] of (* Field specs *) 1: (* DECCKM *) ; 2: (* DECANM *) ANSI := false ; (* ANSI/VT52 *) 3: (* DECCOLM *) (* 132 col *) Begin deccolm := false ; ClrScr ; end ; 4: (* DECSCLM *) ; 5: (* DECSCNM *) If Decscnm then Begin (* Screen Mode *) Decscnm := false ; ReverseScreen ; End ; (* Screen Mode *) 6: (* DECOM *) Begin (* Relative origin *) Relcursor := False ; If Relcursor then GotoXY(1,margintop) else GotoXY(1,1); End ; (* Relative origin *) 7: (* DECAWM *) AutoWrap := false ; 8: (* DECARM *) ; 9: (* DECINLM *) ; 20: (* Ansi LNM - linefeed mode *) ; End ; (* case of Field specs *) 'i': Begin (* Printer Screen on / off *) For j := 1 to k do Case Pn[j] of (* Field specs *) 4: Printon := false ; 5: Printon := true ; 6: Screenon := false ; 7: Screenon := true ; End ; (* case of Field specs *) EscapeBindex:=0; End ; (* Printer Screen on / off *) 'q': FatCursor(Pn[1]=1); (* for series/1 insert mode *) 'n': If Pn[1] = 5 then Begin (* Device Status Report *) (* Send Esc[0n *) Sendchar(Esc);Sendchar(ord('[')); Sendchar(ord('0'));Sendchar(ord('n')); End (* Device Status Report *) else If Pn[1] = 6 then Begin (* Cursor Position Report *) Sendchar(Esc);Sendchar(ord('[')); STR(WhereY,tempstr); (* ROW *) Sendchar(ord(tempstr[1])); If length(tempstr)=2 then Sendchar(ord(tempstr[2])); Sendchar(ord(';')); STR(WhereX,tempstr); (* COLUMN *) Sendchar(ord(tempstr[1])); If length(tempstr) = 2 then Sendchar(ord(tempstr[2])); Sendchar(ord('R')); End ; (* Cursor Position Report *) 'x': If Pn[1]<=1 then Begin (* Request terminal Parameters *) Sendchar(Esc); Sendchar(ord('[')); If Pn[1] = 0 then Sendchar(ord('2')) else Sendchar(ord('3')); (* sol *) Sendchar(ord(';')); (* parity *) If parity = OddP then Sendchar(ord('4')) else If parity = EvenP then Sendchar(ord('5')) else Sendchar(ord('1')) ; Sendchar(ord(';')); Sendchar(ord('2')); (* nbits *) Sendchar(ord(';')); For j := 1 to 2 do Begin (* Xspeed ,Rspeed *) Case baudrate of 300 : begin Sendchar(ord('4')); Sendchar(ord('8')); end ; 600 : begin Sendchar(ord('5')); Sendchar(ord('6')); end ; 1200 : begin Sendchar(ord('6')); Sendchar(ord('4')); end ; 2400 : begin Sendchar(ord('8')); Sendchar(ord('8')); end ; 4800 : begin Sendchar(ord('1')); Sendchar(ord('0')); Sendchar(ord('4')); end ; 9600 : begin Sendchar(ord('1')); Sendchar(ord('1')); Sendchar(ord('2')); end ; 19200 : begin Sendchar(ord('1')); Sendchar(ord('2')); Sendchar(ord('0')); end ; end; (* case *) Sendchar(ord(';')); End ; (* Xspeed ,Rspeed *) Sendchar(ord('1')); (* clkmul *) Sendchar(ord(';')); Sendchar(ord('0')); (* flags *) Sendchar(ord('x')); End ; (* Request terminal Parameters *) 'm', '}': For j := 1 to k do Case Pn[j] of (* Field specs *) 0: begin (* Normal *) blinkf := 0 ; highf := 0 ; If Decscnm then SetColors(LightGray,Black) else SetColors(Black,LightGray) ; end ; 1: begin (* High Intensity *) highf := 8; SetColors(ColorofBack,ColorofText) ; end ; 4: SetColors(Black,LightBlue) ; (* Underline *) 5: begin (* Blink *) blinkf := blink ; SetColors(ColorofBack,ColorofText) ; end ; 7: begin (* Reverse *) If Decscnm then SetColors(Black,LightGray) else SetColors(LightGray,Black); end ; 8: SetColors(Black,Black); (* Invisible *) 30: SetColors(ColorofBack,Black); 31: SetColors(ColorofBack,Red); 32: SetColors(ColorofBack,Green); 33: SetColors(ColorofBack,brown); 34: SetColors(ColorofBack,Blue); 35: SetColors(ColorofBack,Magenta); 36: SetColors(ColorofBack,Cyan); 37: SetColors(ColorofBack,Lightgray); 40: SetColors(Black,ColorofText); 41: SetColors(Red,ColorofText); 42: SetColors(Green,ColorofText); 43: SetColors(Brown,ColorofText); 44: SetColors(Blue,ColorofText); 45: SetColors(Magenta,ColorofText); 46: SetColors(Cyan,ColorofText); 47: SetColors(LightGray,ColorofText); End ; (* case of Field specs *) 'r':Begin (* set margin *) If k<2 then Pn[2] := 24 ; If Pn[1]=0 then Pn[1]:=1; If (Pn[1]>0) and (Pn[1]': keypadnum:=true ; '<': if not ANSI then ANSI := True ; (* VT52 control *) '(': If ReadMchar(achar) then Begin (* save escape sequence in Escape buffer *) Escapebindex := EscapeBindex + 1 ; Escapebuffer[EscapeBindex] := achar ; G0 := achar ; (* G0 *) End ; (* save escape sequence in Escape buffer *) ')': If ReadMchar(achar) then Begin (* save escape sequence in Escape buffer *) Escapebindex := EscapeBindex + 1 ; Escapebuffer[EscapeBindex] := achar ; G1 := achar ; (* G1 *) End ; (* save escape sequence in Escape buffer *) (* valid G0 and G1 are A B 0 1 and 2 *) '%': If ReadMchar(achar) then Begin (* check for Mode *) Escapebindex := EscapeBindex + 1 ; Escapebuffer[EscapeBindex] := achar ; If achar = ord('!') then If ReadMchar(achar) then Begin (* check for Tek4100 mode *) Escapebindex := EscapeBindex + 1 ; Escapebuffer[EscapeBindex] := achar ; If achar = ord('0') then (* ************************** *) TEKTRONICS(0) ; (* ************************** *) End ; (* check for Tek4100 mode *) End ; (* check for Mode *) End ; (* First Level Case *) END ; (* screen escape sequences *) If printon then if EscapeBindex > 1 then Begin (* print esc sequence *) for i := 1 to EscapeBindex do write(Lst,Chr(EscapeBuffer[i])); EscapeBindex := 0 ; End ; (* print esc sequence *) End ; (* Escape Sequence *) (* -------------------------------------------------------- *) Procedure RemoteCommand ; Var i : integer ; Filename : String ; Begin (* RemoteCommand procedure *) GotSOH := true ; LocalScreen ; If RecvPacket then Begin (* Got a Packet *) If InPacketType = Ord('S') then (* Send Packet *) Begin (* Receive *) writeln('Got a Send request '); Filename := '' ; RecvFile(filename); End (* Receive *) else If InPacketType = Ord('R') then (* Receive Packet *) Begin (* Receive *) writeln('Got a receive request '); for i := 1 to InCount-3 do filename[i] := chr(RecvData[i]); Filename[0] := chr(InCount-3) ; waitxon := XonXoff ; SendFile(filename); End (* Receive *) else If InPacketType = Ord('G') then (* General Packet *) Begin (* Receive *) writeln('Got a General request '); SendPacketType('Y'); End (* Receive *) else Begin (* Unknow packet Type *) OutCount := 15 ; Outseq := 0 ; OutPacketType := Ord('E'); (* SendData := 'Unknow Command'; *) End; (* Unknown packet Type *) End ; (* Got a Packet *) RemoteScreen ; End ; (* RemoteCommand Procedure *) (* ------------------------------------------------------------------ *) Begin (* Connection *) DialModem ; Overchars := Over1+Over2+Over3+Over4+Over5 ; RemoteScreen ; (* Save local screen, restore remote screen *) If InitVT100 then Begin (* Initialize VT100 settings *) InitVT100 := false ; ColorofText := Lightgray ; SaveForeColor := ColorofText ; ColorofBack := black ; SaveBackColor := ColorofBack ; margintop := 1 ; SaveMargintop := Margintop ; marginbot := 24 ; SaveMarginbot := Marginbot ; blinkf := 0 ; Saveblinkf := blinkf ; highf := 0 ; Savehighf := highf ; Relcursor := false ; Saverelcursor := relcursor ; ANSI := true ; Keypadnum := false ; screenon := true ; printon := false ; Shiftin := false ; G0 := ord('A') ; G1 := ord('B') ; Deccolm := false ; Decscnm := false ; for i := 0 to 24 do dwl[i] := false ; newgraph := true ; End ; (* Initialize VT100 settings *) While KeyChar(achar,bchar) do ; (* Empty keyboard buffer *) While connected do Begin (* connected *) If RecvChar(achar) then Begin (* got a modem char *) if screenon then if achar < $20 then Begin (* Control Character *) if achar = StartChar then RemoteCommand else Case achar of {EOT} $04 : connected := false ; {ESC} $1B : Escape ; {SO } $0E : shiftin := false ; {SI } $0F : shiftin := true ; {BS } $08 : If AplFlag then Begin (* Overstrick character *) overchar[0] := chr(2) ; If ReadMchar(achar) then overchar[2]:=chr(achar); i:=Pos(overchar,overchars); If i > 0 then achar := ord(overchars[i+2]) else begin (* reverse order *) overchar[2] := overchar[1] ; overchar[1] := chr(achar); i:=Pos(overchar,overchars); If i>0 then achar := ord(overchars[i+2]) else achar := AplTable[ord(overchar[2])]; end ; (* reverse order *) write(chr(BS),chr(achar)); End (* Overstrick character *) else write(chr(achar)); {VT } $0B , {FF } $0C , {LF } $0A : if MarginBot = WhereY then Scroll (Upward,Margintop-1,marginbot-1) else write(chr(achar)) ; {BEL} $07, {CR } $0D : write(chr(achar)) ; {TAB} $09 : Begin (* tab character *) i:=WhereX ; If i<80 then Repeat i:=i+1 ; CursorRight ; Until (Htab[i]='T') or (i>=80) ; End ; (* tab character *) {FS} $1C , {GS} $1D , {RS} $1E , {US} $1F : Tektronics (achar) ; End ; (* Case of control char *) End (* Control Character *) else If achar <> DEL then if AplFlag then begin (* APL char *) write(chr(APLTABLE[achar])); overchar[1] := chr(achar) ; end else (* write normal char *) Begin (* Normal char *) If shiftin then G0G1 := G0 else G0G1 := G1 ; Case chr(G0G1) of 'A' : (* UK ascii set *) If achar = $23 then achar := $9C ; 'B' : ; (* normal ascii set *) '0' : If chr(achar) in ['a'..'z'] then achar := Graphicset[achar-$60] ; '1' : ; (* Special set - not implemented *) '2' : ; (* Special set - not implemented *) end ; (* Case G0G1 *) If WhereX <> 80 then begin write(chr(achar)); if dwl[WhereY-1] then write(' '); wrapit:=false; end else if wrapit then begin (* Next line *) If MarginBot=WhereY then begin (* Scroll up *) Scroll (Upward,Margintop-1,marginbot-1); GotoXY(1,WhereY); end (* Scroll up *) else GotoXY(1,WhereY+1); write(chr(achar)); wrapit := false ; end (* Next line *) else begin (* put char on col 80 *) i := ((WhereY-1)*80 + 79)*2; RealScreen^[i] := achar ; RealScreen^[i+1]:=blinkf+(ColorofBack shl 4) +highf+ColorofText; if Autowrap and Deccolm then wrapit := true ; end ; (* put char on col 80 *) End ; (* Normal char *) If printon then If achar = ESC then Escape else if EscapeBindex = 0 then EscapeBindex := 1 else write(LST,chr(achar)); End ; (* got a modem char *) if KeyChar(achar,bchar) then Begin (* key input *) if bchar = $70 then achar := LocalChar else (* Alt F9 *) if bchar = $71 then achar := BreakChar else (* Alt F10 *) if (bchar >=$47) and (bchar<=$53) then If keypadnum then achar := ord(KEYPADTABLE[bchar-70]) else achar := 0 ; If achar=0 then Begin (* Send escape sequence *) If EscSeq[Bchar,1]<>' ' then SendChar(Esc); If EscSeq[Bchar,1]<>' ' then SendChar(Ord(EscSeq[bchar,1])) ; If EscSeq[bchar,2]<>' ' then SendChar(Ord(EscSeq[bchar,2])) ; End (* Send Escape Sequence *) else Begin (* Normal Key *) If EscapeFlag then if achar = $7B then AplFlag := true else if achar = $7D then AplFlag := false ; Escapeflag := achar = ESC ; if achar = LocalChar then connected := false else if achar = BreakChar then Begin (* Break *) SendBreak; If CharsInBuffer > 100 then EmptyBuffer ; End (* Break *) else Sendchar(achar); if LocalEcho and connected then if AplFlag then write(chr(APLTABLE[achar])) else write(chr(achar)); End ; (* Normal Key *) End; (* key input *) End; (* connected *) LocalScreen ; (* save remote screen , restore local screen *) End ; (* Connection *) Begin (* Connect Unit *) ReadKeytable ; AplFlag := false ; End. (* Connect Unit *)