(* Release 3.10 *) (*-------------------------------------------------------------------------* * * * TERM.MOD - COMMS Toolkit terminal emulation * * * * COPYRIGHT (C) 1988..1992 Clarion Software Corporation. * * All Rights Reserved * * * *--------------------------------------------------------------------------*) IMPLEMENTATION MODULE Term; IMPORT SYSTEM,Lib,IO,Str,Window,Keyboard; TYPE CharSets = (UK,US,SpecialChar); Attributes = (Blue,Green,Red,Bold,BlueBack,GreenBack,RedBack,Blink); AttrSet = SET OF Attributes; AttributeMap = ARRAY[0..23],[0..79] OF AttrSet; CharMap = ARRAY[0..23],[0..79] OF CHAR; CONST NormalAttr = AttrSet{Blue,Green,Red}; (* Lightgray on Black *) VAR G0,G1,CurrCharSet : CharSets; (* for handling protected field attributes *) CurrAttr,ProtAttr : AttrSet; Map : AttributeMap; ScrMap : CharMap; cx,cy,p1,p2, ScreenTop, ScreenBottom : CARDINAL; DECPrivate, OriginMode,AutoWrap, NewLineMode,KbdLocked, LocalEcho,ANSIKeys, NumKeyPad,Protected, EditMode,DeferredEdit, DeferredTransmit, TransmitOK, WantsFullPage, Initialised : BOOLEAN; TransmitMode : (Line,PartialPage,FullPage); VTMode : Emulations; RxState : (Normal,GotESC,GotBrack,GotLParen,GotRParen,GotHash,ReadingP1,ReadingP2,VT52Line,VT52Col,ANSICmd); TabStop : ARRAY[0..79] OF BOOLEAN; CSave : RECORD cx,cy : CARDINAL; Top,Bottom : CARDINAL; OrgMode : BOOLEAN; END; Kbd : RECORD rptr,wptr : CARDINAL; Buff : ARRAY[0..255] OF CHAR; END; (*.............................................*) PROCEDURE SetColor(NewAttr:AttrSet); BEGIN Window.TextColor(VAL(Window.Color,SHORTCARD(NewAttr) MOD 16)); Window.TextBackground(VAL(Window.Color,SHORTCARD(NewAttr) DIV 16)); END SetColor; (*.............................................*) PROCEDURE ResetTerm; VAR i : CARDINAL; BEGIN VTMode := EmVT100; RxState := Normal; G0 := US; G1 := SpecialChar; CurrCharSet := G0; ScreenTop := 0; ScreenBottom := 23; OriginMode := FALSE; AutoWrap := TRUE; NewLineMode := FALSE; KbdLocked := FALSE; LocalEcho := FALSE; ANSIKeys := TRUE; NumKeyPad := TRUE; Protected := FALSE; EditMode := FALSE; DeferredEdit := FALSE; DeferredTransmit := FALSE; TransmitMode := Line; WantsFullPage := FALSE; CurrAttr := NormalAttr; ProtAttr := CurrAttr; SetColor(CurrAttr); Lib.Fill(ADR(Map),SIZE(Map),NormalAttr); Lib.Fill(ADR(ScrMap),SIZE(ScrMap),' '); cx := 0; cy := 0; WITH CSave DO cx := 0; cy := 0; Top := 0; Bottom := 23; OrgMode := FALSE; END; FOR i:=0 TO 79 DO TabStop[i] := (i MOD 8)=0; END; WITH Kbd DO rptr := 0; wptr := 0; END; END ResetTerm; (*.............................................*) PROCEDURE StuffKbdBuffer(s:ARRAY OF CHAR; Lnth:CARDINAL); VAR i : CARDINAL; BEGIN i:=0; WHILE i23 THEN y:=23; END; IF x>79 THEN x:=79; END; Window.GotoXY(x+1,y+1); cx:=x; cy:=y; END GotoXY; (*.............................................*) PROCEDURE SelectEmulation(Which:Emulations); BEGIN ResetTerm; Window.Clear; GotoXY(0,0); VTMode := Which; END SelectEmulation; (*.............................................*) PROCEDURE Scroll(lines:INTEGER); VAR i : CARDINAL; x,y : CARDINAL; l : ARRAY[0..Window.ScreenWidth-1] OF WORD; BEGIN (* Do physical scroll *) x := Window.WhereX(); y := Window.WhereY(); IF lines = 0 THEN FOR i := ScreenTop+1 TO ScreenBottom+1 DO Window.GotoXY(1,i); Window.ClrEol; END; ELSE REPEAT IF lines < 0 THEN FOR i := ScreenBottom TO ScreenTop+1 BY -1 DO Window.RdBufferLn(Window.Used(),1,i,SYSTEM.ADR(l),80); Window.WrBufferLn(Window.Used(),1,i+1,SYSTEM.ADR(l),80); END; Window.GotoXY(1,ScreenTop+1); Window.ClrEol; INC(lines); ELSE FOR i := ScreenTop+2 TO ScreenBottom+1 DO Window.RdBufferLn(Window.Used(),1,i,SYSTEM.ADR(l),80); Window.WrBufferLn(Window.Used(),1,i-1,SYSTEM.ADR(l),80); END; Window.GotoXY(1,ScreenBottom+1); Window.ClrEol; DEC(lines); END; UNTIL ABS(lines) = 0; END; Window.GotoXY(x,y); (* Now scroll attribute map *) IF lines<>0 THEN IF lines>0 THEN (* Scroll up *) i:=ScreenTop; REPEAT Map[i] := Map[i+1]; ScrMap[i] := ScrMap[i+1]; INC(i); UNTIL i=ScreenBottom; ELSE (* Scroll down *) i:=ScreenBottom; REPEAT Map[i] := Map[i-1]; ScrMap[i] := ScrMap[i-1]; DEC(i); UNTIL i=ScreenTop; END; Lib.Fill(ADR(Map[i]),80,NormalAttr); Lib.Fill(ADR(ScrMap[i]),80,' '); END; END Scroll; (*.......................................*) PROCEDURE Translate(c:CHAR):CHAR; CONST FormChars = ' ±????øñ??Ù¿ÚÀÅÄÄÄÄÄôÁ³óòãØœ='; BEGIN IF CurrCharSet<>US THEN IF CurrCharSet=SpecialChar THEN IF (c>=CHR(95)) AND (c<=CHR(126)) THEN c := FormChars[ORD(c)-95]; END; ELSIF c='#' THEN (* Must be UK char set *) c := 'œ'; END; END; RETURN c; END Translate; (*.............................................*) PROCEDURE FindUnprotected():BOOLEAN; BEGIN IF Map[cy,cx]-ProtAttr<>AttrSet{} THEN RETURN(TRUE) END; LOOP IF Map[cy,cx]-ProtAttr=AttrSet{} THEN (* on a protected char position - skip! *) IF cx=79 THEN IF cy0 THEN GotoXY(cx-1,cy); END; | 9 : IF cx<79 THEN REPEAT INC(cx); UNTIL (cx=79) OR (TabStop[cx]); GotoXY(cx,cy); END; | 10..12 : IF NewLineMode THEN cx:=0; END; IF cy=ScreenBottom THEN Scroll(1); ELSE INC(cy); END; GotoXY(cx,cy); | 13 : GotoXY(0,cy); | 14 : CurrCharSet := G1; | 15 : CurrCharSet := G0; | END ELSE IF (NOT Protected) OR FindUnprotected() THEN Map[cy,cx] := CurrAttr; ScrMap[cy,cx] := c; IO.WrChar(Translate(c)); IF (cx=79) AND (AutoWrap) THEN Output(CHR(10)); GotoXY(0,cy); ELSIF cx<79 THEN INC(cx); END; END; END; END Output; (*.............................................*) PROCEDURE DECModeChange(c:CHAR); VAR Lnth : CARDINAL; Seq : ARRAY[0..9] OF CHAR; BEGIN CASE p1 OF 0 : (*Error -ignore*) | 1 : (*Cursor Key*) IF NOT NumKeyPad THEN ANSIKeys := c='l'; END; | 2 : IF c='l' THEN SelectEmulation(EmVT52); END; | 3 : (*Select 80/132 Columns - not supported*) | 4 : (*Select smooth/jump scrolling - not supported*)| 5 : (*Normal or Reverse Screen - not implemented*) | 6 : (*origin*) OriginMode := c='h'; | 7 : (*Auto-wrap*) AutoWrap := c='h'; | 8 : (*Kbd Auto-repeat on/off - not supported*) | 10 : (*Editing*) EditMode := c='h'; | 11 : (*Line Transmit*) IF c='h' THEN TransmitMode := Line ELSIF WantsFullPage THEN TransmitMode := FullPage ELSE TransmitMode := PartialPage END; | 13 : (*Space compression / Field delimiter*) | 14 : (*Transmit execution*) DeferredTransmit := (c='l'); | 15 : (* Printer status request *) IF c='n' THEN Seq:=' [?13n'; Seq[0]:=CHR(27); StuffKbdBuffer(Seq,6); END; | 16 : (*Edit key execution*) DeferredEdit := c='l'; | 18 : (*Printer form feed*) | 19 : (*Printer extent*) | END; END DECModeChange; (*.............................................*) PROCEDURE EraseField(x,y,w:CARDINAL); VAR i,oldx,oldy : CARDINAL; BEGIN (* This routine is only called if protected fields are in effect *) oldx:=cx; oldy:=cy; i:=0; GotoXY(x,y); WHILE iAttrSet{} THEN Map[y,x+i] := CurrAttr; ScrMap[y,x+i] := ' '; IO.WrChar(' '); ELSE GotoXY(x+i+1,cy); END; INC(i); END; GotoXY(oldx,oldy); END EraseField; (*.............................................*) PROCEDURE EraseLineToCursor; BEGIN IF Protected THEN EraseField(0,cy,cx+1); ELSE Lib.Fill(ADR(Map[cy]),cx+1,NormalAttr); Lib.Fill(ADR(ScrMap[cy]),cx+1,' '); Window.DirectWrite(0,cy,ADR(ScrMap[cy]),cx); END; END EraseLineToCursor; (*.............................................*) PROCEDURE EraseCursorToEol; BEGIN IF Protected THEN EraseField(cx,cy,cx+1); ELSE Window.ClrEol; END; END EraseCursorToEol; (*.............................................*) PROCEDURE EraseScreenToCursor; VAR i,x,y : CARDINAL; BEGIN i:=0; x:=cx; y:=cy; WHILE iProtAttr) DO INC(i); END; Max := i-1; ELSE Max := 79; END; RETURN Max; END FieldWidth; (*.............................................*) PROCEDURE DelChar; VAR i,Max : CARDINAL; a : AttrSet; BEGIN Max := FieldWidth(); IF Max=0 THEN RETURN; END; i:=cx; a:=Map[cy,i]; SetColor(a); WHILE ia THEN a:=Map[cy,i]; SetColor(a); END; IO.WrChar(ScrMap[cy,i]); INC(i); END; IF Map[cy,i]<>a THEN a:=Map[cy,i]; SetColor(a); END; ScrMap[cy,i]:=' '; IO.WrChar(' '); GotoXY(cx,cy); END DelChar; (*.............................................*) PROCEDURE GetCursorPosition(VAR s:ARRAY OF CHAR; VAR Lnth:CARDINAL); VAR TempStr : ARRAY[0..9] OF CHAR; Ok : BOOLEAN; BEGIN Str.CardToStr(LONGCARD(cy+1),TempStr,10,Ok); Str.CardToStr(LONGCARD(cx+1),s,10,Ok); Lnth := Str.Length(TempStr)+Str.Length(s)+4; Str.Concat(TempStr,' [',TempStr); Str.Concat(s,';',s); Str.Concat(s,TempStr,s); Str.Concat(s,s,'R'); s[0]:=CHR(27); END GetCursorPosition; (*.............................................*) PROCEDURE Transmit; (* not implemented *) END Transmit; (*.............................................*) PROCEDURE CursorMovement ( dir : CHAR ; dist : CARDINAL ); BEGIN IF dist=0 THEN dist:=1; END ; CASE dir OF 'A' : IF dist>cy THEN cy:=0; ELSE DEC(cy,dist); END; | 'B' : INC(cy,dist); IF cy>ScreenBottom THEN cy := ScreenBottom; END; | 'C' : INC(cx,dist); IF cy>79 THEN cy := 79; END; | 'D' : IF dist>cx THEN cx:=0; ELSE DEC(cx,dist); END; | END; GotoXY(cx,cy); END CursorMovement ; (*.............................................*) PROCEDURE EraseCommand ( type : CHAR ; function : CARDINAL ); VAR x,y : CARDINAL; BEGIN CASE type OF 'J' : CASE function OF 0 : ClrEos; | 1 : EraseScreenToCursor; | 2 : x:=cx; y:=cy; GotoXY(0,0); ClrEos; GotoXY(x,y); | END; | 'K' : CASE function OF 0 : EraseCursorToEol; | 1 : EraseLineToCursor; | 2 : x:=cx; GotoXY(0,cy); EraseCursorToEol; GotoXY(x,cy); | END; | END ; END EraseCommand ; (*.............................................*) PROCEDURE CheckCode(c:CHAR); VAR x,y : CARDINAL; Seq : ARRAY[0..9] OF CHAR; BEGIN IF DECPrivate THEN DECModeChange(c) ELSE CASE c OF 'A'..'D' : CursorMovement(c,p1); | 'c' : (* Device attributes request *) Seq:=' [?7c'; Seq[0]:=CHR(27); StuffKbdBuffer(Seq,5); | 'g' : IF p1=0 THEN TabStop[cx]:=FALSE; ELSIF p1=3 THEN FOR x:=0 TO 79 DO TabStop[x]:=FALSE; END; END; | 'H','f' : IF p1=0 THEN p1:=1; END; IF p2=0 THEN p2:=1; END; GotoXY(p2-1,p1-1); | 'h','l' : CASE p1 OF 2 : KbdLocked := (c='h'); | 6 : Protected := (c='l'); | 12 : LocalEcho := (c='l'); | 16 : WantsFullPage := (c='h'); | 20 : NewLineMode := (c='h'); | END; | 'J','K' : EraseCommand(c,p1); | 'L' : IF (cy>=ScreenTop) AND (cy<=ScreenBottom) THEN y:=ScreenTop; ScreenTop:=cy; WHILE p1>0 DO Scroll(-1); DEC(p1); END; ScreenTop:=y; END; | 'M' : IF (cy>=ScreenTop) AND (cy<=ScreenBottom) THEN y:=ScreenTop; ScreenTop:=cy; WHILE p1>0 DO Scroll(1); DEC(p1); END; ScreenTop:=y; END; | 'm' : (* Select graphic rendition *) CASE p1 OF 0 : CurrAttr := NormalAttr ; | 1 : INCL(CurrAttr,Bold); | 4 : CurrAttr := CurrAttr-AttrSet{Red,Green}+AttrSet{Blue};| 5 : INCL(CurrAttr,Blink); | 7 : CurrAttr := AttrSet( (SHORTCARD(CurrAttr*AttrSet{Red,Green,Blue})<<4)+ (SHORTCARD(CurrAttr*AttrSet{RedBack,GreenBack,BlueBack})>>4)+ (SHORTCARD(CurrAttr*AttrSet{Bold,Blink})));| 8 : CurrAttr := AttrSet{}; | END; SetColor(CurrAttr); | 'n' : (* Device status reports *) Seq[0]:=CHR(27); Seq[1]:='['; Seq[3]:='n'; x:=4; CASE p1 OF 5 : Seq[2]:='0';(* VDU status request *) | 6 : GetCursorPosition(Seq,x); | ELSE x := 0; END; IF x>0 THEN StuffKbdBuffer(Seq,x); END; | 'P' : WHILE p1>0 DO DelChar; DEC(p1); END; | 'r' : IF (p1>=1) AND (p2>0) AND (p2<=24) AND (p1>4)+ (SHORTCARD(ProtAttr*AttrSet{Bold,Blink})));| 8 : ProtAttr := AttrSet{}; | ELSE IF p1=254 THEN ProtAttr:=NormalAttr; END; END; END; END; END CheckCode; (*.............................................*) PROCEDURE ShortCode(c:CHAR); VAR x,y : CARDINAL; Seq : ARRAY[0..9] OF CHAR; BEGIN CASE c OF 'c' : (* Reset *) SelectEmulation(EmVT100); | 'D' : IF cy<23 THEN GotoXY(cx,cy+1); ELSE Scroll(1); END; | 'E' : Output(CHR(10)); GotoXY(0,cy); | 'H' : TabStop[cx]:=TRUE; | 'M' : IF cy>0 THEN GotoXY(cx,cy-1); ELSE Scroll(-1); END; | 'N' : (* G2 char set - not supported *) | 'Z' : (* Identity Request *) Seq:=' [?7c'; Seq[0]:=CHR(27); StuffKbdBuffer(Seq,5); | 'O' : (* G3 char set - not supported *) | '7' : CSave.cx:=cx; CSave.cy:=cy; WITH CSave DO Top:=ScreenTop; Bottom:=ScreenBottom; OrgMode:=OriginMode; END; | '8' : WITH CSave DO ScreenTop:=Top; ScreenBottom:=Bottom; OriginMode:=OrgMode; GotoXY(cx,cy); END; | '=' : NumKeyPad := FALSE;(* application keypad mode *)| '>' : NumKeyPad := TRUE; ANSIKeys := TRUE; | END; END ShortCode; (*.............................................*) PROCEDURE NewCharSet(c:CHAR; VAR Gx:CharSets); BEGIN CASE c OF 'A' : Gx:=UK; | 'B' : Gx:=US; | '0' : Gx:=SpecialChar; | '1' : (* not supported *) | '2' : (* not supported *) | END; END NewCharSet; (*.............................................*) PROCEDURE VT100RxSM(c:CHAR); BEGIN CASE RxState OF Normal : IF c=CHR(27) THEN DECPrivate := FALSE; p1:=0; p2:=0; RxState := GotESC ELSE Output(c) END; | GotESC : IF c='[' THEN RxState := GotBrack ELSIF c='(' THEN RxState := GotLParen ELSIF c=')' THEN RxState := GotRParen ELSIF c='#' THEN RxState := GotHash ELSE ShortCode(c); RxState := Normal; END; | GotBrack : IF c='?' THEN DECPrivate := TRUE; RxState := ReadingP1; ELSIF (c>='0') AND (c<='9') THEN p1 := ORD(c)-48; RxState := ReadingP1; ELSIF (c=';') THEN RxState := ReadingP2; ELSE CheckCode(c); RxState := Normal; END; | GotLParen : NewCharSet(c,G0); RxState := Normal; | GotRParen : NewCharSet(c,G1); RxState := Normal; | GotHash : RxState := Normal; (* ignore line attributes *) | ReadingP1 : IF (c>='0') AND (c<='9') THEN p1 := p1*10 + ORD(c)-48; ELSIF c=';' THEN RxState := ReadingP2 ELSE CheckCode(c); RxState := Normal; END; | ReadingP2 : IF (c>='0') AND (c<='9') THEN p2 := p2*10 + ORD(c)-48; ELSE CheckCode(c); RxState := Normal; END; | END; END VT100RxSM; (*.............................................*) VAR CursorY : CARDINAL; PROCEDURE VT52RxSM(c:CHAR); VAR Seq : ARRAY[0..3] OF CHAR; BEGIN CASE RxState OF Normal : IF c=CHR(27) THEN RxState:=GotESC ELSE Output(c) END; | GotESC : CASE c OF '<' : SelectEmulation(EmVT100); | '=' : NumKeyPad:=FALSE; | '>' : NumKeyPad:=TRUE; | 'F' : CurrCharSet:=SpecialChar; | 'G' : CurrCharSet:=US; | 'A'..'D' : CursorMovement(c,1); | 'H' : GotoXY(0,0); | 'Y' : RxState := VT52Line; | 'I' : IF cy>ScreenTop THEN DEC(cy); ELSE Scroll(-1); END; GotoXY(cx,cy); | 'K' : EraseCursorToEol; | 'J' : ClrEos; | 'Z' : Seq:=' /Z'; Seq[0]:=CHR(27); StuffKbdBuffer(Seq,3); | END; IF RxState<>VT52Line THEN RxState:=Normal; END; | VT52Line : IF c>=' ' THEN CursorY := ORD(c)-32; RxState := VT52Col; ELSE RxState := Normal; END; | VT52Col : IF c>=' ' THEN GotoXY(ORD(c)-32,CursorY); END; RxState := Normal; | END; END VT52RxSM; (*.............................................*) VAR ANSIp : ARRAY[1..9] OF CARDINAL ; ANSIn : [0..9]; PROCEDURE ANSIRxSM(c:CHAR); (* Reduced PC compatible ANSI driver *) VAR i : CARDINAL; W : Window.WinType; wc : Window.Color; Seq : ARRAY[0..9] OF CHAR; BEGIN CASE RxState OF Normal : IF c=CHR(27) THEN RxState:=GotESC; ELSE Output(c); END; | GotESC : IF c='[' THEN RxState:=ANSICmd; FOR i := 1 TO 9 DO ANSIp[i] := 0; END ; ANSIn := 1; ELSE Output(c); RxState:=Normal; END; | ANSICmd : RxState:=Normal; CASE c OF '0'..'9' : ANSIp[ANSIn] := ANSIp[ANSIn]*10+ORD(c)-ORD('0'); RxState:=ANSICmd; | ';' : IF ANSIn<9 THEN INC(ANSIn); END; RxState:=ANSICmd; | 'f','H' : IF ANSIp[1] > 0 THEN DEC(ANSIp[1]); END; IF ANSIp[2] > 0 THEN DEC(ANSIp[2]); END; GotoXY(ANSIp[2],ANSIp[1]); | 'A'..'D' : CursorMovement(c,ANSIp[1]); | 'J','K' : EraseCommand(c,ANSIp[1]); | 's' : CSave.cx:=cx; CSave.cy:=cy; | 'u' : GotoXY(CSave.cx,CSave.cy); | 'n' : IF ANSIp[1]=6 THEN GetCursorPosition(Seq,i); IF i>0 THEN StuffKbdBuffer(Seq,i); END; END; | 'm' : FOR i := 1 TO ANSIn DO CASE ANSIp[i] OF 0 : CurrAttr := NormalAttr; | 1 : INCL(CurrAttr,Bold); | 4 : CurrAttr := CurrAttr-AttrSet{Red,Green}+AttrSet{Blue}; | 5 : INCL(CurrAttr,Blink); | 7 : CurrAttr := AttrSet((SHORTCARD(CurrAttr*AttrSet{Red,Green,Blue})<<4)+(SHORTCARD(CurrAttr*AttrSet{RedBack,GreenBack,BlueBack})>>4)+(SHORTCARD(CurrAttr*AttrSet{Bold,Blink})));| 8 : CurrAttr := AttrSet{}; | 30 : CurrAttr := CurrAttr-AttrSet{Red,Green,Blue}; | 31 : CurrAttr := CurrAttr-AttrSet{Green,Blue}+AttrSet{Red}; | 32 : CurrAttr := CurrAttr-AttrSet{Red,Blue}+AttrSet{Green}; | 33 : CurrAttr := CurrAttr-AttrSet{Blue}+AttrSet{Red,Green}; | 34 : CurrAttr := CurrAttr-AttrSet{Red,Green}+AttrSet{Blue}; | 35 : CurrAttr := CurrAttr-AttrSet{Green}+AttrSet{Red,Blue}; | 36 : CurrAttr := CurrAttr-AttrSet{Red}+AttrSet{Blue,Green}; | 37 : CurrAttr := CurrAttr+AttrSet{Red,Blue,Green}; | 40 : CurrAttr := CurrAttr-AttrSet{RedBack,GreenBack,BlueBack}; | 41 : CurrAttr := CurrAttr-AttrSet{GreenBack,BlueBack}+AttrSet{RedBack}; | 42 : CurrAttr := CurrAttr-AttrSet{RedBack,BlueBack}+AttrSet{GreenBack}; | 43 : CurrAttr := CurrAttr-AttrSet{BlueBack}+AttrSet{RedBack,GreenBack}; | 44 : CurrAttr := CurrAttr-AttrSet{RedBack,GreenBack}+AttrSet{BlueBack}; | 45 : CurrAttr := CurrAttr-AttrSet{GreenBack}+AttrSet{RedBack,BlueBack}; | 46 : CurrAttr := CurrAttr-AttrSet{RedBack}+AttrSet{BlueBack,GreenBack}; | 47 : CurrAttr := CurrAttr+AttrSet{RedBack,BlueBack,GreenBack}; | END; SetColor(CurrAttr); END; ELSE Output(c); END; END; END ANSIRxSM; (*.............................................*) PROCEDURE WrChar(c:CHAR); BEGIN IF ORD(c)>127 THEN c:=CHR(ORD(c)-128); END; CASE VTMode OF EmVT100: VT100RxSM(c); (* call VT100 receive state machine *) | EmVT52: VT52RxSM(c); (* call VT52 receive state machine *) | EmANSI: ANSIRxSM(c); (* call ANSI receive state machine *) | END; END WrChar; (*.............................................*) PROCEDURE KeyTranslate; (* Emulate sequences produced by VT100 or VT52 keyboard. There is a *) (* dearth of keypad keys on the IBM for this, so instead, to use *) (* cursor keys you use the unshifted keys. To access the numeric *) (* keypad (or the application keys in alterate mode) you hold down *) (* shift while pressing the appropriate keys. This still leaves us *) (* five keys short for the keypad "enter" and PF1..PF4. The "Enter" *) (* key is produced by F6 on the PC, and PF1..PF4 correspond to F7..F8*) (* on the PC. *) VAR c : CHAR; Lnth : CARDINAL; Seq : ARRAY[0..2] OF CHAR; BEGIN c := Keyboard.RdKey(); IF c=0C THEN (* NOTE: Alt-Key combinations are reserved for use by the comms *) (* package, so if this turns out to be one we need to insert the*) (* preceding NUL into the kbd.buff also, otherwise the equivalent*) (* VT100 sequence gets stuffed into the keyboard buffer. *) c := Keyboard.RdKey(); Seq[0]:=CHR(27); Lnth:=3; IF c=CHR(64) THEN IF NumKeyPad THEN Seq[0]:=CHR(13); Lnth:=1; IF NewLineMode THEN Seq[1]:=CHR(10); Lnth:=2; END; ELSE Seq[1]:='O'; Seq[2]:='M'; END; ELSIF (c>=CHR(65)) AND (c<=CHR(68)) THEN IF VTMode=EmVT100 THEN Seq[1]:='O'; ELSE Seq[1]:='?'; END; CASE ORD(c) OF 65 : Seq[2]:='P'; | 66 : Seq[2]:='Q'; | 67 : Seq[2]:='R'; | 68 : Seq[2]:='S'; | END; IF (VTMode=EmVT52) AND (NumKeyPad) THEN Seq[1]:=Seq[2]; Lnth:=2; END; ELSE IF ANSIKeys THEN Seq[1]:='['; ELSE Seq[1]:='O'; END; CASE ORD(c) OF 72 : Seq[2]:='A'; (* cursor up *) | 75 : Seq[2]:='D'; (* cursor left *) | 77 : Seq[2]:='C'; (* cursor right *) | 80 : Seq[2]:='B'; (* cursor down *) | ELSE Seq[0]:=0C; Seq[1]:=c; StuffKbdBuffer(Seq,2); RETURN END; IF VTMode=EmVT52 THEN Seq[1]:=Seq[2]; Lnth:=2; END; END; StuffKbdBuffer(Seq,Lnth); ELSIF (Keyboard.ScanCode>=CHR(71)) AND (Keyboard.ScanCode<=CHR(83)) THEN IF NumKeyPad THEN IF c='+' THEN c:=','; END; StuffKbdBuffer(c,1); ELSE Seq[0]:=CHR(27); IF VTMode=EmVT100 THEN Seq[1]:='O'; ELSE Seq[1]:='?'; END; CASE c OF '0' : Seq[2]:='p'; | '1' : Seq[2]:='q'; | '2' : Seq[2]:='r'; | '3' : Seq[2]:='s'; | '4' : Seq[2]:='t'; | '5' : Seq[2]:='u'; | '6' : Seq[2]:='v'; | '7' : Seq[2]:='w'; | '8' : Seq[2]:='x'; | '9' : Seq[2]:='y'; | '-' : Seq[2]:='m'; | '+' : Seq[2]:='l'; | '.' : Seq[2]:='n'; | END; StuffKbdBuffer(Seq,3); END; ELSE Seq[0]:=c; Lnth:=1; IF (c=CHR(13)) AND (NewLineMode) THEN Seq[1]:=CHR(10); Lnth:=2; END; StuffKbdBuffer(Seq,Lnth); END; END KeyTranslate; (*.............................................*) PROCEDURE RdKey():CHAR; VAR c : CHAR; BEGIN LOOP WITH Kbd DO IF rptr<>wptr THEN c:=Buff[rptr]; rptr:=(rptr+1) MOD 100H; EXIT ELSE KeyTranslate(); END; END; END; RETURN c; END RdKey; (*.............................................*) PROCEDURE KeyPressed():BOOLEAN; BEGIN IF Kbd.rptr<>Kbd.wptr THEN RETURN TRUE ELSIF Keyboard.KeyPressed() THEN KeyTranslate(); RETURN KeyPressed(); ELSE RETURN FALSE END; END KeyPressed; (*.............................................*) PROCEDURE ClearScreen; BEGIN GotoXY(0,0); ClrEos; END ClearScreen; (*.............................................*) PROCEDURE EmulateVT100; BEGIN SelectEmulation(EmVT100); END EmulateVT100; (*.............................................*) PROCEDURE EmulateVT52; BEGIN SelectEmulation(EmVT52); END EmulateVT52; (*.............................................*) PROCEDURE EmulateANSI; BEGIN SelectEmulation(EmANSI); END EmulateANSI; (*.............................................*) PROCEDURE Emulation():Emulations; BEGIN RETURN VTMode; END Emulation; (*.............................................*) BEGIN ResetTerm; END Term.