{$symtab-,$pagesize:84,$linesize:131,
$title:'ESCPAR.PAS -- Process ESCAPE sequences'}
{	COPYRIGHT @ 1982
	Jim Holtman and Eric Holtman
	35 Dogwood Trail
	Randolph, NJ 07869
	(201) 361-3395
}
module escpar;
{$include:'simterm.inc'}
const
    printer_tabs = chr(27)*'D'*chr(8)*chr(16)*chr(24)*chr(32)*chr(40)*
	chr(48)*chr(56)*chr(64)*chr(72)*chr(80)*chr(88)*chr(96)*
	chr(104)*chr(112)*chr(120)*chr(128)*chr(132)*chr(0);
    printer_compressed = chr(15);
    proportional_enable = chr(27)*'p1';
    emphasized_enable = chr(27)*'E';
    eight_per_inch = chr(27)*'0'*chr(27)*'C'*chr(88);
    printer_init = chr(27)*'@'; {EPSON w/GRAFTRAX init}

var [public]
    insert_mode : boolean;
    display_mode : PRT_ATTR;

var
    italic_sw : boolean; {true => ITALICS; false => underline}
    graftrax [external] : boolean;
    adm_sim_flag [external] : boolean;
    hp_sim_flag [external] : boolean;
    rogue_mode [external] : boolean;
    function_keys [external] : array[1..10] of lstring(30);
    ignore_rubout [external] : boolean;

    {$include:'graph.inc'}
    {$include:'comm.inc'}
procedure putchar(inchar : char);
    external;
procedure display_keys; external;
function getc(exit_flag : LOOP_FLAG) : integer;
    external;
procedure ck(a : integer; const b : string);
    forward;
procedure save_line(line : CRT_SIZE; inc : INC_LIMIT);
    external;
function modem_status : byte; external;
procedure setmode(mode : PRT_ATTR); {set attr mode, change printer}
var
    prt_flag [public] : boolean;
value
    prt_flag := false;
begin
    case mode of
    PRT_NORMAL:
	begin
	    if prt_flag and graftrax then
		case display_mode of

		PRT_UNDERLINE:
		    if italic_sw then xlpt1(chr(27)*'5') {italics OFF}
		    else xlpt1(chr(27)*'-'*chr(0)); {underline OFF}

		PRT_SUPER,PRT_SUB:
		    xlpt1(chr(27)*'H'); {turn off super/subscripts}

		PRT_BOLD:
		    xlpt1(chr(27)*'F'); {turn off emphasized mode}

		otherwise
		    ;

		end;
	end;
    PRT_UNDERLINE:
	if prt_flag and graftrax then
	    if italic_sw then xlpt1(chr(27)*'4') {italics ON}
	    else xlpt1(chr(27)*'-'*chr(1)); {underline ON}
    PRT_SUPER:
	if prt_flag and graftrax then
	    xlpt1(chr(27)*'S'*chr(0)); {superscript}
    PRT_SUB:
	if prt_flag and graftrax then
	    xlpt1(chr(27)*'S'*chr(1)); {subscripts}
    PRT_BOLD:
	if prt_flag and graftrax then
	    xlpt1(chr(27)*'E');
    end;
    display_mode := mode
end;

procedure hp_cursor;
var
    i,j,x,y : integer;
    sign : char;
begin
      i := getc(HANG);
      if (chr(i) = '+') or (chr(i) = '-') then begin {RELATIVE ADDRESSING}
	   sign := chr(i);
	   xrcurp(x,y);
	   i := 0;
	   j := 0;
	   while true do begin
	       j := getc(HANG);
	       if (chr(j) < '0') or (chr(j) > '9') then break;
	       i := i*10 + (j-ord('0'));
	   end;
	   if (sign = '-') then i := -i;
	   y := y + i;
	   i := getc(HANG);
	   sign := chr(i);
	   i := 0;
	   j := 0;
	   while true do begin
	       j := getc(HANG);
	       if (chr(j) < '0') or (chr(j) > '9') then break;
	       i := i*10 + (j-ord('0'));
	   end;
	   if (sign = '-') then i := -i;
	   x := x + i;
       end else begin
	   j := i; {we already read one character above }
	   i := 0;
	   while true do begin
	       if (chr(j) < '0') or (chr(j) > '9') then break;
	       i := i*10 + (j-ord('0'));
	       j := getc(HANG);
	   end;
	   y := i;
	   i := 0;
	   j := 0;
	   while true do begin
	       j := getc(HANG);
	       if (chr(j) < '0') or (chr(j) > '9') then break;
	       i := i*10 + (j-ord('0'));
	   end;
	   x := i;
       end;
       if (chr(j) = 'C') then xxmove(x,y)
       else xxmove(y,x);
end;
procedure hp_convert(var c : integer);
begin
	case chr(c) of
	  'F': c := ord(chr('X'));
	  'S': c := ord(chr('Y'));
	  'T': c := ord(chr('Z'));
	  'R': c := ord(chr('E'));
	  'P': c := ord(chr('R'));
	  otherwise ;
	end;
end;
procedure up_load_remote(const fn : lstring); external;
procedure down_load_remote(const fn : lstring); external;
procedure xmodem_up_remote(const fn : lstring); external;
procedure xmodem_down_remote(const fn : lstring); external;
procedure escape;
const
    ESC_CHAR = chr(27);
var
    prt_flag [external] : boolean;
    lpt_only_flag [external] : boolean;
    direct_printer_flag [public] : boolean;
    vi_cursor [public] : boolean;
    x,y,old_y:integer;
    ch:char;
    i:integer;
    j,k : integer;
    graflin : lstring(1);
    ca : integer;
    fname : lstring(100);
value
    direct_printer_flag := false;
    vi_cursor := false;
begin
    graflin[0] := chr(1);
    xrcurp(x,y);
    i := getc(HANG);
    if (hp_sim_flag) then hp_convert(i);
    ch := chr(i);
    case ch of

    'A':
	{cursor up}
	begin
	    save_line(y,-1);
	    if (y>TOP) then xxmove(x,y-1);
	end;

    'B':
	{cursor down}
	begin
	    save_line(y,1);
	    if (y<BOTTOM) then xxmove(x,y+1);
	end;

    'C':
	{cursor right}
	if (x<RIGHT_MAR) then xxmove(x+1,y);

    'D':
	{left}
	if (x>LEFT_MAR) then xxmove(x-1,y);

    'E':
	{Exit INSERT mode}
	insert_mode := false;

    'F':
	  { program a function key }
	  begin
		i := getc(HANG);
		i := i - ord('0');
		if (i = 0) then i := 10;
		k := 1;
		if ( (i>0) and (i<11) ) then begin
		    j := getc(HANG);
		    while (j <> 26) do begin
			  if (j = 27) then j := 13;
			  function_keys[i,k] := chr(j);
			  k := k + 1;
			  j := getc(HANG);
		    end;
		    function_keys[i,0] := chr(k-1);
		end;
		display_keys;
		xxmove(x,y);
	  end;

    'G':
	{ set up for one line of grafics on printer. }
	begin
	    i := getc(HANG);
	    case chr(i) of
	    '0' :
		begin
		    xlpt1(chr(27)*'A'*chr(7));
		    xlpt1(chr(27)*'K'*chr(223)*chr(1));
		    for j := 1 to 479 do begin
			i := getc(HANG);
			graflin[1]:=chr(i);
			xlpt1(graflin);
		    end;
		end;
	    '1':
		begin
		    xlpt1(chr(27)*'A'*chr(7));
		    xlpt1(chr(27)*'L'*chr(192)*chr(3));
		    for j := 1 to 959 do begin
			i := getc(HANG);
			graflin[1]:=chr(i);
			xlpt1(graflin);
		    end;
		end;
	    otherwise
		;	{ignore}
	    end;
	end;

    'H':
	{home}
	xxmove(LEFT_MAR,TOP);

    'K':
	{clear line from x}
	xwca(NULLB,(RIGHT_MAR+1)-x);

    'J':
	begin {clear display}
	    xwca(NULLB,(RIGHT_MAR+1)-x);
	    for i := y+1 to BOTTOM do
	    begin
		xxmove(LEFT_MAR,i);
		xwca(NULLB,(RIGHT_MAR+1))
	    end;
	    xxmove(x,y)
	end;

    'L':
	{insert line}
	xscrldn(1,y,BOTTOM);

    'M':
	{delete line}
	xscrlup(1,y,BOTTOM);

    'P':
	{ change printer states }
	begin
	    i := getc(HANG);
	    case chr(i) of

	    '1','2','P','E' :
		{printer -- Full Mode}
		{P == proportional mode enable also}
		{P == emphasized mode enable also}
		begin
		    prt_flag := true;
		    lpt_only_flag := false;
		    direct_printer_flag := false;
		    italic_sw := false;
		    xlpt1(null); {init the printer}
		    if graftrax then xlpt1(printer_init);
		    if chr(i)='2' then xlpt1(printer_compressed);
		    if chr(i)='P' then xlpt1(proportional_enable);
		    if chr(i)='E' then xlpt1(emphasized_enable);
		end;

	    '0':
		{turn off the printer}
		begin
		    prt_flag := false;
		    lpt_only_flag := false;
		    direct_printer_flag := false;
		end;

	    'i':
		{turn on ITALICS}
		italic_sw := true;

	    otherwise
		;	{ignore}

	    end;
	end;

    'Q':
	{enter INSERT mode}
	insert_mode := true;

    'R':
	begin {delete char}
	    for i := x to (RIGHT_MAR-1) do
	    begin
		xxmove(i+1,y);
		ca:=xrca;
		xxmove(i,y);
		xwca(ca,1)
	    end;
	    xxmove(RIGHT_MAR,y);
	    xwca(NULLB,1);
	    xxmove(x,y)
	end;

    'T':
	{Terminal modes. switch between adm3a & simterm and also}
	{between whether or not we're playing ROGUE}
	begin
	    i := getc(HANG);
	    case chr(i) of

	    'A':
		adm_sim_flag := true;
	    'a':
		adm_sim_flag := false;
	    'R':
		rogue_mode := true;
	    'r':
		rogue_mode := false;

	    otherwise
		vi_cursor := false;

	    end;
	end;


    'V':
	{'vi' control}
	begin
	    i := getc(HANG);
	    case chr(i) of

	    'S':
		vi_cursor := true;

	    otherwise
		vi_cursor := false;

	    end;
	end;

    'X': {home down for HP. Actually 'F', but it converted in hp_convert }
	xxmove(0,23);

    'Y':
	xscrlup(1,24,BOTTOM);

    'Z':
	xscrldn(1,24,BOTTOM);

    '[':
	{ repeat next char foo number of times }
	begin
	    xrcurp(x,y);
	    i := getc(HANG);
	    ca := getc(HANG);
	    ca := ca + (7*256);
	    x := x + i;
	    if ( x > 79) then
	    begin
		x := x - 80;
		y := y + 1;
		if (y = 24) then
		begin
		    y := 23;
		    xscrlup(1,0,23);
		end;
	    end;
	    xwca(ca,i);
	    xxmove(x,y);
	end;
    '>':
	{ change cursor type }
	begin
	    i := getc(HANG);
	    ca := getc(HANG);
	    xscurt(byword(ca,i));
	end;
    '&':
	{ change the display mode }
	begin
	    i := getc(HANG);
	    if (chr(i) = 'a') and (hp_sim_flag) then hp_cursor
	    else if (chr(i) = 'd') then
	    begin
		i := getc(HANG);
		case chr(i) of
		'@':
		    setmode(PRT_NORMAL);
		'B':
		    setmode(PRT_BOLD);
		'D':
		    setmode(PRT_UNDERLINE);
		'H':
		    setmode(PRT_SUPER);
		'L':
		    setmode(PRT_SUB);
		otherwise
		    ;
		end
	    end
	end;
    '=':
	begin {move to x,y}
	    old_y := y;
	    y:=getc(HANG)-32;
	    x:=getc(HANG)-32;
	    if x < LEFT_MAR then x := LEFT_MAR
	    else if x > RIGHT_MAR then x := RIGHT_MAR;
	    if y < TOP then y := TOP
	    else if y > BOTTOM then y := BOTTOM;
	    if old_y <> y then
		save_line(old_y,2*ord(old_y<y)-1);
	    xxmove(x,y)
	end;
    '^':
	{request ID - send back 'IBM PC'}
	ck(send('IBM PC'*NL),'ID');

    ESC_CHAR:
	{two ESC chars in a row; output one and continue}
	putchar(ESC_CHAR);

    'u':
	  { remotely initiated upload }
	  begin
	     i := getc(HANG);
	     k := 1;
		    j := getc(HANG);
		    while (j <> 26) do begin
			  fname[k] := chr(j);
			  k := k + 1;
			  j := getc(HANG);
		    end;
		    fname[0] := chr(k-1);
		if (chr(i) = 'a') then up_load_remote(fname);
		if (chr(i) = 'x') then xmodem_up_remote(fname);
	  end;

    'd':
	  { remotely initiated download }
	  begin
	     i := getc(HANG);
	     k := 1;
		    j := getc(HANG);
		    while (j <> 26) do begin
			  fname[k] := chr(j);
			  k := k + 1;
			  j := getc(HANG);
		    end;
		    fname[0] := chr(k-1);
		if (chr(i) = 'a') then down_load_remote(fname);
		if (chr(i) = 'x') then xmodem_down_remote(fname);
	  end;
    otherwise
	; {ignore ESC sequence}
    end
end;
procedure parse(var c:integer);
const
    ESC = 27; {ecsape key}
begin
    case c of
    ESC:
	escape;

    17:
	; {^Q -- ignore}

     0:
	; {NULL, ignore, since space games use this as a fill, also
	   HP series terminals do not advance cursor on null either}

    127:
      begin
	if ( not ignore_rubout ) then putchar(chr(c));
      end;

    26:
	begin {^Z -- clear screen}
	    xxmove(LEFT_MAR,TOP);
	    xxcls
	end;

    30:
	xxmove(LEFT_MAR,TOP); {^^ -- HOME}

    otherwise
	putchar(chr(c));
    end
end;
procedure ck;
const
    OK = -1;
var
    silent_mode [external] : boolean;
begin
    if (a <> OK) and not silent_mode then
    begin
	writeln(output,'ERROR in ',b,'. Flag =',a,
		       '  Status=',modem_status:2:16);
    end;
end;

procedure adm_sim(ch : integer);
var
    x,y : integer;
begin
    xrcurp(x,y);
    case ch of

    ord('^') and #1F:
	{HOME}
	xxmove(LEFT_MAR,TOP);

    27:
	{ESCAPE}
	escape;

    ord('H') and #1F:
	{cursor left}
	if (x > LEFT_MAR) then xxmove(x-1,y);

    ord('K') and #1F:
	{cursor up}
	begin
	    save_line(y,-1);
	    if (y > TOP) then xxmove(x,y-1);
	end;

    ord('L') and #1F:
	{cursor right}
	if (x < RIGHT_MAR) then xxmove(x+1,y);

    ord('Q') and #1F:
	{ignore}
	;

    ord('Z') and #1F:
	{clear screen}
	begin
	    xxmove(LEFT_MAR,TOP);
	    xxcls;
	end;

    otherwise
	putchar(chr(ch));

    end;
end;
end.