IMPLEMENTATION MODULE XTerm; FROM Strings IMPORT CAPS,Length; FROM ComLine IMPORT commandLine; FROM SYSTEM IMPORT BDOS,ADR,IORESULT; FROM MathLib IMPORT Randomize; FROM Terminal IMPORT ReadChar; FROM Convert IMPORT StrToCard; VAR Term:TERMTYPE; PROCEDURE String2TermType(name:ARRAY OF CHAR):TERMTYPE; BEGIN CAPS(name); IF name='VT52' THEN RETURN VT52; ELSIF name='VT100' THEN RETURN VT100; ELSIF name='ANSI' THEN RETURN ANSI; ELSIF name='KAYPRO' THEN RETURN KAYPRO; ELSIF name='ADM31' THEN RETURN ADM31; ELSIF name='C128' THEN RETURN C128; ELSIF name='MEMOTECH' THEN RETURN MEMOTECH; ELSIF name='CPC' THEN RETURN CPC; ELSE RETURN INVALID; END; END String2TermType; PROCEDURE PrintTermType(t:TERMTYPE); BEGIN CASE t OF VT52: WRITE('VT52 (B&W)') | VT100: WRITE('VT100 (B&W)') | ANSI: WRITE('ANSI (Color)') | KAYPRO: WRITE('KayPro (B&W)') | ADM31: WRITE('ADM31 (B&W)') | C128: WRITE('C128 (Color)') | MEMOTECH: WRITE('Memotech (B&W)') | CPC: WRITE('CPC / Z19 (B&W)') | INVALID: WRITE('INVALID') | LAST: WRITE('LAST') END; END PrintTermType; PROCEDURE GetTermType():TERMTYPE; BEGIN RETURN Term; END GetTermType; PROCEDURE PrintLnTermType(t:TERMTYPE); BEGIN PrintTermType(t); WRITELN(); END PrintLnTermType; PROCEDURE PrintTermTypeList(); VAR i:TERMTYPE; j:CARDINAL; BEGIN j:=1; FOR i:=INVALID TO LAST DO IF (i<>INVALID) AND (i<>LAST) THEN WRITE(j,') '); PrintLnTermType(i); j:=j+1; END; END; END PrintTermTypeList; PROCEDURE InitWithNoColors(); VAR i:ESCAPE; BEGIN FOR i:=BLACK TO LIGHTGREY DO SEQ[i]:=''; END; END InitWithNoColors; PROCEDURE CursorXYVT52(x,y:CARDINAL); BEGIN WRITE(33C,'Y',CHAR(y+31),CHAR(x+31)) END CursorXYVT52; PROCEDURE CursorXYVT100(x,y:CARDINAL); BEGIN WRITE(33C,'[',y:0,';',x:0,'H') END CursorXYVT100; PROCEDURE CursorXYKAYPRO(x,y:CARDINAL); BEGIN WRITE(33C,'=',CHAR(y+31),CHAR(x+31)) END CursorXYKAYPRO; PROCEDURE CursorXYMemotech(x,y:CARDINAL); BEGIN WRITE(3C,CHAR(x+31),CHAR(y+31)) END CursorXYMemotech; PROCEDURE InitVT100base(); VAR i:ESCAPE; j:CARDINAL; BEGIN CursorXY:=CursorXYVT100; SEQ[REVERSE]:='~[7m'; SEQ[PLAIN]:='~[27m'; SEQ[BLINK]:='~[5m'; SEQ[NOBLINK]:='~[25m'; SEQ[UNDERLINE]:='~[4m'; SEQ[NOUNDERLINE]:='~[24m'; SEQ[DARK]:='~[2m'; SEQ[NODARK]:='~[22m'; FOR i:=PLAIN TO NODARK DO SEQ[i][0]:=033C END; SEQ[BEEP]:='*'; SEQ[BEEP][0]:=7C; SEQ[CLS]:='~[2J~[H'; SEQ[CLS][0]:=33C; SEQ[CLS][4]:=33C; SEQ[HOME]:='~[H'; SEQ[HOME][0]:=33C; SEQ[CLREOL]:='~[K'; SEQ[CLREOL][0]:=33C; SEQ[INSLINE]:='~[L'; SEQ[INSLINE][0]:=33C; SEQ[DELLINE]:='~[M'; SEQ[DELLINE][0]:=33C; SEQ[CURSORON]:='~[?25h'; SEQ[CURSORON][0]:=33C; SEQ[CURSOROFF]:='~[?25l'; SEQ[CURSOROFF][0]:=33C; SEQ[TERMRESET]:='~c'; SEQ[TERMRESET][0]:=33C; END InitVT100base; PROCEDURE InitVT100(); BEGIN HasColors:=FALSE; InitWithNoColors(); InitVT100base(); END InitVT100; PROCEDURE InitANSI(); VAR i:ESCAPE; BEGIN HasColors:=TRUE; InitVT100base(); SEQ[BLACK]:='~[30m~[2m'; SEQ[WHITE]:='~[37m~[22m'; SEQ[RED]:='~[31m~[2m'; SEQ[CYAN]:='~[36m~[22m'; SEQ[PURPLE]:='~[35m~[22m'; SEQ[GREEN]:='~[32m~[2m'; SEQ[BLUE]:='~[34m~[2m'; SEQ[YELLOW]:='~[33m~[22m'; SEQ[DARKPURPLE]:='~[35m~[2m'; SEQ[BROWN]:='~[33m~[2m'; SEQ[LIGHTRED]:='~[31m~[22m'; SEQ[DARKGREY]:='~[37m~[2m'; SEQ[DARKCYAN]:='~[36m~[2m'; SEQ[LIGHTGREEN]:='~[32m~[22m'; SEQ[LIGHTBLUE]:='~[34m~[22m'; SEQ[LIGHTGREY]:='~[37m~[2m'; FOR i:=BLACK TO LIGHTGREY DO SEQ[i][0]:=33C; SEQ[i][5]:=33C END; END InitANSI; PROCEDURE InitKayPro(); VAR i:ESCAPE; j:CARDINAL; BEGIN HasColors:=FALSE; CursorXY:=CursorXYKAYPRO; InitWithNoColors(); SEQ[REVERSE]:='~B0'; SEQ[PLAIN]:='~C0'; SEQ[BLINK]:='~B2'; SEQ[NOBLINK]:='~C2'; SEQ[UNDERLINE]:='~B3'; SEQ[NOUNDERLINE]:='~C3'; SEQ[DARK]:='~B1'; SEQ[NODARK]:='~C1'; FOR i:=PLAIN TO NODARK DO SEQ[i][0]:=033C END; SEQ[BEEP]:='*'; SEQ[BEEP][0]:=7C; SEQ[CLS]:='*'; SEQ[CLS][0]:=32C; SEQ[HOME]:='*'; SEQ[HOME][0]:=36C; SEQ[CLREOL]:='*'; SEQ[CLREOL][0]:=30C; SEQ[INSLINE]:='~E'; SEQ[INSLINE][0]:=33C; SEQ[DELLINE]:='~R'; SEQ[DELLINE][0]:=33C; SEQ[CURSORON]:='~B4'; SEQ[CURSORON][0]:=33C; SEQ[CURSOROFF]:='~C4'; SEQ[CURSOROFF][0]:=33C; SEQ[TERMRESET]:=''; END InitKayPro; PROCEDURE InitC128(withColors:BOOLEAN); VAR i:ESCAPE; j:CARDINAL; BEGIN HasColors:=withColors; CursorXY:=CursorXYKAYPRO; SEQ[REVERSE]:='~G4'; SEQ[PLAIN]:='~G0'; SEQ[BLINK]:='~G2'; SEQ[NOBLINK]:='~G0'; SEQ[UNDERLINE]:='~G3'; SEQ[NOUNDERLINE]:='~G0'; SEQ[DARK]:='~)'; SEQ[NODARK]:='~('; FOR i:=PLAIN TO NODARK DO SEQ[i][0]:=033C END; SEQ[BEEP]:='*'; SEQ[BEEP][0]:=7C; SEQ[CLS]:='*'; SEQ[CLS][0]:=32C; SEQ[HOME]:='*'; SEQ[HOME][0]:=36C; SEQ[CLREOL]:='~T'; SEQ[CLREOL][0]:=33C; SEQ[INSLINE]:='~E'; SEQ[INSLINE][0]:=33C; SEQ[DELLINE]:='~R'; SEQ[DELLINE][0]:=33C; SEQ[CURSORON]:=''; SEQ[CURSOROFF]:=''; SEQ[TERMRESET]:='~G0'; SEQ[TERMRESET][0]:=33C; IF withColors THEN j:=0; FOR i:=BLACK TO LIGHTGREY DO SEQ[i]:='1234'; SEQ[i][0]:=033C; SEQ[i][1]:=033C; SEQ[i][2]:=033C; SEQ[i][3]:=CHAR(32+j); j:=j+1; END ELSE InitWithNoColors(); END; END InitC128; PROCEDURE InitMemotech; VAR i:ESCAPE; BEGIN HasColors:=FALSE; CursorXY:=CursorXYMemotech; InitWithNoColors(); SEQ[PLAIN]:='64'; SEQ[PLAIN][0]:=6C; SEQ[PLAIN][1]:=4C; SEQ[REVERSE]:='6x'; SEQ[REVERSE][0]:=6C; SEQ[REVERSE][1]:=70C; SEQ[BLINK]:='x'; SEQ[BLINK][0]:=16C; SEQ[NOBLINK]:='x'; SEQ[NOBLINK][0]:=17C; SEQ[UNDERLINE]:='65'; SEQ[UNDERLINE][0]:=6C; SEQ[UNDERLINE][1]:=5C; SEQ[NOUNDERLINE]:=SEQ[PLAIN]; SEQ[DARK]:='62'; SEQ[DARK][0]:=6C; SEQ[DARK][1]:=2C; SEQ[NODARK]:=SEQ[PLAIN]; SEQ[CLS]:='x'; SEQ[CLS][0]:=14C; SEQ[HOME]:='x'; SEQ[HOME][0]:=26C; SEQ[CLREOL]:='x'; SEQ[CLREOL][0]:=5C; SEQ[INSLINE]:='xI'; SEQ[INSLINE][0]:=33C; SEQ[DELLINE]:='xJ'; SEQ[DELLINE][0]:=33C; SEQ[BEEP]:='x'; SEQ[BEEP][0]:=7C; SEQ[CURSORON]:='x'; SEQ[CURSORON][0]:=36C; SEQ[CURSOROFF]:='x'; SEQ[CURSOROFF][0]:=37C; SEQ[TERMRESET]:='xxx'; SEQ[TERMRESET][0]:=30C; SEQ[TERMRESET][1]:=6C; SEQ[TERMRESET][2]:=4C; END InitMemotech; PROCEDURE InitVT52; VAR i:ESCAPE; BEGIN HasColors:=FALSE; CursorXY:=CursorXYVT52; InitWithNoColors(); SEQ[PLAIN]:=''; SEQ[REVERSE]:=''; SEQ[BLINK]:=''; SEQ[NOBLINK]:=''; SEQ[UNDERLINE]:=''; SEQ[NOUNDERLINE]:=''; SEQ[DARK]:=''; SEQ[NODARK]:=''; SEQ[CLS]:='*H*J'; SEQ[CLS][0]:=33C; SEQ[CLS][2]:=33C; SEQ[HOME]:='*H'; SEQ[HOME][0]:=33C; SEQ[CLREOL]:='*K'; SEQ[CLREOL][0]:=33C; SEQ[INSLINE]:='*L'; SEQ[INSLINE][0]:=33C; SEQ[DELLINE]:='*M'; SEQ[DELLINE][0]:=33C; SEQ[BEEP]:='x'; SEQ[BEEP][0]:=7C; SEQ[CURSORON]:=''; SEQ[CURSOROFF]:=''; SEQ[TERMRESET]:=''; END InitVT52; PROCEDURE InitCPC; BEGIN InitVT52(); SEQ[PLAIN]:='*q'; SEQ[PLAIN][0]:=33C; SEQ[REVERSE]:='*p'; SEQ[REVERSE][0]:=33C; SEQ[CURSORON]:='*e'; SEQ[CURSORON][0]:=33C; SEQ[CURSOROFF]:='*f'; SEQ[CURSOROFF][0]:=33C; END InitCPC; PROCEDURE SetTermType(t:TERMTYPE); BEGIN Term:=t; CASE Term OF VT52: InitVT52 | VT100: InitVT100() | ANSI: InitANSI() | KAYPRO: InitKayPro() | ADM31: InitC128(FALSE) | C128: InitC128(TRUE) | MEMOTECH: InitMemotech() | CPC: InitCPC() END; END SetTermType; PROCEDURE AskTermType(); VAR s:ARRAY [0..79] OF CHAR; t:TERMTYPE; c:CARDINAL; BEGIN READ(commandLine,s); IF Length(s)=1 THEN t:=TERMTYPE(INTEGER(s[0])-48) ELSE t:=String2TermType(s) END; IF (t=INVALID) OR (t>=LAST) THEN WRITELN('Select a terminal type (or specify it on command line):'); WRITELN(); PrintTermTypeList(); WRITELN(); REPEAT WRITE('>'); READ(c); t:=TERMTYPE(c); UNTIL (t>INVALID) AND (t<LAST); END; SetTermType(t); END AskTermType; PROCEDURE ResetTerm(); BEGIN WRITE(SEQ[TERMRESET]); END ResetTerm; PROCEDURE ShowCursor(); BEGIN WRITE(SEQ[CURSORON]); END ShowCursor; PROCEDURE HideCursor(); BEGIN WRITE(SEQ[CURSOROFF]); END HideCursor; PROCEDURE ClrScr(); BEGIN WRITE(SEQ[CLS]); END ClrScr; PROCEDURE Home(); BEGIN WRITE(SEQ[HOME]); END Home; PROCEDURE ClrEol(); BEGIN WRITE(SEQ[CLREOL]); END ClrEol; PROCEDURE InsLine(); BEGIN WRITE(SEQ[INSLINE]); END InsLine; PROCEDURE DelLine(); BEGIN WRITE(SEQ[DELLINE]); END DelLine; PROCEDURE PlotBox(x1,y1,x2,y2:CARDINAL;h,v:BOOLEAN); VAR i,j:CARDINAL; s:ARRAY[0..79] OF CHAR; BEGIN s:=' '; s[x2-x1+1]:=0C; WRITE(SEQ[REVERSE]); IF v THEN FOR i:=1 TO 2 DO FOR j:=y1 TO y2 DO IF i=1 THEN CursorXY(x1,j) ELSE CursorXY(x2,j) END; WRITE(' '); END; END; END; IF h THEN CursorXY(x1,y1); WRITE(s); CursorXY(x1,y2); WRITE(s); END; WRITE(SEQ[PLAIN]); END PlotBox; PROCEDURE Center(y:CARDINAL;s:ARRAY OF CHAR); BEGIN CursorXY((80-Length(s)) DIV 2+1,y);WRITE(s); END Center; PROCEDURE RandomizeShuffle(); CONST GetDT=105; (* BDOS Function *) VAR dat:ARRAY[0..1] OF CARDINAL; BEGIN BDOS(GetDT,ADR(dat)); Randomize(IORESULT+dat[0]+dat[1]); END RandomizeShuffle; PROCEDURE InputCardinal (x,y:CARDINAL;VAR num:CARDINAL;l:CARDINAL):BOOLEAN; VAR i:CARDINAL; ch:CHAR; s:ARRAY[0..30] OF CHAR; BEGIN i:=0; REPEAT CursorXY(x+i,y); ReadChar(ch); IF (ch>='0') AND (ch<='9') AND (i<l) THEN s[i]:=ch; s[i+1]:=0C; INC(i); WRITE(ch); ELSIF ((ch=10C) OR (ch=177C)) AND (i>0) THEN DEC(i); s[i]:=0C; CursorXY(x+i,y); WRITE(' '); ELSIF (ch=33C) OR (ch=3C) THEN s[0]:=0C; END; UNTIL (ch=33C) OR (ch=3C) OR ((ch=15C) AND (i>0)); IF (ch=33C) OR (ch=3C) THEN RETURN FALSE END; RETURN StrToCard(s,num); END InputCardinal; BEGIN Term:=ANSI; END XTerm.