{ vt100.pas -- simple vt100 terminal emulator } {$l-} const ESC = '<27>'; CR = '<13>'; var c : char; { send state } rstate : integer; fkey : char; cmove, dodump, done : boolean; { receive state } top,bottom : integer; row,col : integer; ac : char; mstate : integer; icnt : integer; ichars : array [1..20] of char; function mdmst : boolean; external; function ttyst : boolean; external; function mdmin : char; external; function ttyin : char; external; procedure mdmout( c : char); external; procedure ttyout( c : char); external; { doconsole -- handle a character typed at the keyboard } procedure doconsole(c:char); begin case rstate of 0: begin case ord(c) of %05: begin done := true; end; %0B: begin { cursor up } mdmout(ESC); mdmout('['); mdmout('A'); end; %16: begin { cursor down } mdmout(ESC); mdmout('['); mdmout('B'); end; %0C: begin { cursor right } mdmout(ESC); mdmout('['); mdmout('C'); end; %08: begin { cursor left } mdmout(ESC); mdmout('['); mdmout('D'); end; %01: begin { control-A (function key) } rstate := 1; end; else mdmout(c); end; end; 1: begin fkey := c; rstate := 2; end; 2: begin rstate := 0; if (fkey='D') then rstate := 3 else if fkey='H' then { ctrl/k } mdmout(chr(11)) else if fkey='I' then { backspace } mdmout(chr(8)) else if (fkey>='@') and (fkey<='C') then begin mdmout(ESC); mdmout('O'); mdmout(chr(ord(fkey)-ord('@')+ord('P'))); end; end; 3: begin rstate := 0; mdmout(ESC); mdmout('O'); if (c>='0') and (c<='9') then mdmout(chr(ord(c)-ord('0')+ord('p'))) else if c='-' then mdmout('m') else if c=',' then mdmout('l') else if c='.' then mdmout('n') else mdmout('M'); end; end; { of case } end; procedure domodem(c : char); var parm : array [1..4] of integer; parms : integer; i : integer; procedure dumpit; var i : integer; begin if dodump then begin write('['); for i := 1 to icnt do write(ichars[i]); writeln(c); end; end; procedure getnumeric; var i,j : integer; procedure ival(var v : integer); var c : char; begin v := 0; c := ichars[i]; while (i<=icnt) and (c>='0') and (c<='9') do begin v := v*10+ord(c)-ord('0'); i := succ(i); c := ichars[i]; end; end; begin for j := 1 to 4 do parm[j] := 0; i := 1; j := 1; while (i<=icnt) and (j<=4) do begin ival(parm[j]); i := succ(i); { skip ; } j := succ(j); { get next parm } end; parms := pred(j); end; procedure setattr; var i : integer; begin getnumeric; if parms < 1 then ac := '0'; for i := 1 to parms do case parm[i] of 0: ac := '0'; 1: ; 4: ac := chr(ord(ac) or 8); 5: ac := chr(ord(ac) or 2); 7: ac := chr(ord(ac) or 4); else ; end; ttyout(ESC); ttyout('G'); ttyout(ac); end; procedure setrow(n:integer); begin ttyout(ESC); ttyout('['); ttyout(chr(%20+n-1)); end; procedure domargin; begin getnumeric; top := parm[1]; if top < 1 then top := 1; bottom := parm[2]; if bottom >24 then bottom := 24; end; procedure docursor; begin getnumeric; ttyout(esc); ttyout('='); if parm[1]=0 then parm[1] := 1; if parm[2]=0 then parm[2] := 1; row := parm[1]; col := parm[2]; ttyout(chr(%20+parm[1]-1)); ttyout(chr(%20+parm[2]-1)); cmove := true; end; begin case mstate of 0: begin if c='<13>' then begin ttyout(c); col := 1; end else if c='<10>' then begin if (row=bottom) and (bottom<24) then begin setrow(top); ttyout(ESC); ttyout('R'); { delete line } setrow(bottom); ttyout(ESC); ttyout('E'); end else begin row := row + 1; ttyout(c); end; end else if c=ESC then begin icnt := 0; if dodump then write('') else mstate := 1; end else begin col := succ(col); ttyout(c); while col>=80 do begin col := pred(col); ttyout('<8>'); end; end; cmove := false; end; 1: begin { escape seen, collect ansi intermediate chars } if ( ord(c)>=%20 ) and ( ord(c)<=%2F ) then begin if icnt<=10 then begin icnt := succ(icnt); ichars[icnt] := c; end; end else if c='[' then begin { csi } mstate := 2; icnt := 0; end else if c='M' then begin { ri } mstate := 0; if row=top then begin { scroll up } setrow(bottom); ttyout(ESC); ttyout('R'); { delete line } setrow(top); ttyout(ESC); ttyout('E'); { insert line } end else begin row := row - 1; ttyout(ESC); ttyout('j'); end; end else begin { assume terminating char } mstate := 0; dumpit; end; end; 2: begin { csi seen, collect intermediate parameters } if (c<'@') then begin if icnt<=10 then begin icnt := succ(icnt); ichars[icnt] := c; end; end else begin { terminator } ichars[icnt+1] := ' '; mstate := 0; if (c='J') and (ichars[1]='2') then begin ttyout(chr(26)); { clear page } end else if (c='K') then begin { erase to end of line } ttyout(ESC); ttyout('T'); end else if (c='J') and ((ichars[1]='0') or (icnt=0)) then begin ttyout(ESC); ttyout('Y'); { clear eop } end else if c='c' then begin { identify } mdmout(ESC); mdmout('['); mdmout('?'); mdmout('1'); mdmout(';'); mdmout('0'); mdmout('c'); end else if (c='f') or (c='H') then docursor else if (c='r') then domargin else if (c='m') then setattr else if (c='h') or (c='l') then { ignore } else dumpit; end; end; { state 2 } end; { of case } end; begin writeln('Vt100 emulator -- use CTRL/E to exit'); if eoln then readln; dodump := false; #if false repeat write('Display controls ? '); readln(c); if (c>='a') then c := chr(ord(c)-ord('a')+ord('A')); dodump := (c='Y'); until (c='Y') or (c='N'); #endif ac := '0'; done := false; cmove := false; top := 1; bottom := 24; mstate := 0; rstate := 0; repeat if ttyst then doconsol(ttyin) else if mdmst then domodem(mdmin); until done; end.