| 1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147 |
- (* 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 i<Lnth DO
- WITH Kbd DO
- Buff[wptr]:=s[i];
- wptr := (wptr+1) MOD 100H;
- END;
- INC(i);
- END;
- END StuffKbdBuffer;
- (*.............................................*)
- PROCEDURE GotoXY(x,y:CARDINAL);
- BEGIN
- IF y>23 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 cy<ScreenBottom THEN
- INC(cy); cx:=0
- ELSE
- RETURN FALSE
- END
- ELSE
- INC(cx);
- END;
- ELSE
- GotoXY(cx,cy);
- RETURN TRUE
- END;
- END;
- END FindUnprotected;
- (*.............................................*)
- PROCEDURE Output(c:CHAR);
- BEGIN
- IF (c<' ') OR (c=CHR(127)) THEN
- CASE ORD(c) OF
- 7 : IO.WrChar(c); |
- 8 : IF cx>0 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 i<w DO
- IF Map[y,x+i]-ProtAttr<>AttrSet{} 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 i<y DO
- GotoXY(0,i);
- EraseCursorToEol;
- INC(i);
- END;
- GotoXY(x,y);
- EraseLineToCursor;
- END EraseScreenToCursor;
- (*.............................................*)
- PROCEDURE ClrEos;
- VAR
- i,x,y : CARDINAL;
- BEGIN
- i:=0;
- x:=cx;
- y:=cy;
- EraseCursorToEol;
- i:=y+1;
- WHILE i<=23 DO
- GotoXY(0,i);
- EraseCursorToEol;
- INC(i);
- END;
- GotoXY(x,y);
- END ClrEos;
- (*.............................................*)
- PROCEDURE FieldWidth():CARDINAL;
- VAR
- i,Max : CARDINAL;
- BEGIN
- IF Protected THEN
- i:=cx;
- IF Map[cy,i]=ProtAttr THEN
- RETURN(0);
- END;
- WHILE (i<80) AND (Map[cy,i]<>ProtAttr) 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 i<Max DO
- Map[cy,i] := Map[cy,i+1];
- ScrMap[cy,i] := ScrMap[cy,i+1];
- IF Map[cy,i]<>a 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<p2) THEN
- ScreenTop := p1-1;
- ScreenBottom := p2-1;
- ELSE
- ScreenTop:=0;
- ScreenBottom:=23;
- END;
- GotoXY(0,ScreenTop); |
- '}' : (* Set protection attributes *)
- CASE p1 OF
- 0 : ProtAttr := NormalAttr; |
- 1 : INCL(ProtAttr,Bold); |
- 4 : ProtAttr := ProtAttr-AttrSet{Red,Green}+AttrSet{Blue};|
- 5 : INCL(ProtAttr,Blink); |
- 7 : ProtAttr := AttrSet(
- (SHORTCARD(ProtAttr*AttrSet{Red,Green,Blue})<<4)+
- (SHORTCARD(ProtAttr*AttrSet{RedBack,GreenBack,BlueBack})>>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.
|