head     56.3;
access   paws bayes jws quist brad dew jwh;
symbols  ;
locks    ; strict;
comment  @# @;


56.3
date     93.01.27.13.36.41;  author jwh;  state Exp;
branches ;
next     56.2;

56.2
date     93.01.27.12.12.26;  author jwh;  state Exp;
branches ;
next     56.1;

56.1
date     91.11.05.09.42.12;  author jwh;  state Exp;
branches ;
next     55.1;

55.1
date     91.08.25.10.20.27;  author jwh;  state Exp;
branches ;
next     54.1;

54.1
date     91.03.18.15.25.09;  author jwh;  state Exp;
branches ;
next     53.1;

53.1
date     91.03.11.19.26.20;  author jwh;  state Exp;
branches ;
next     52.1;

52.1
date     91.02.19.09.10.19;  author jwh;  state Exp;
branches ;
next     51.1;

51.1
date     91.01.30.16.09.51;  author jwh;  state Exp;
branches ;
next     50.1;

50.1
date     90.10.29.16.24.44;  author jwh;  state Exp;
branches ;
next     49.1;

49.1
date     90.08.14.14.09.02;  author jwh;  state Exp;
branches ;
next     48.1;

48.1
date     90.07.26.11.15.03;  author jwh;  state Exp;
branches ;
next     47.1;

47.1
date     90.05.14.10.56.32;  author dew;  state Exp;
branches ;
next     46.1;

46.1
date     90.05.07.08.43.43;  author jwh;  state Exp;
branches ;
next     45.1;

45.1
date     90.04.19.15.51.12;  author jwh;  state Exp;
branches ;
next     44.1;

44.1
date     90.04.01.22.08.43;  author jwh;  state Exp;
branches ;
next     43.1;

43.1
date     90.03.20.14.00.03;  author jwh;  state Exp;
branches ;
next     42.1;

42.1
date     90.01.23.17.44.29;  author jwh;  state Exp;
branches ;
next     41.1;

41.1
date     89.12.22.11.27.39;  author jwh;  state Exp;
branches ;
next     40.1;

40.1
date     89.09.29.11.49.35;  author jwh;  state Exp;
branches ;
next     39.1;

39.1
date     89.09.26.16.34.05;  author dew;  state Exp;
branches ;
next     38.1;

38.1
date     89.08.29.11.25.29;  author jwh;  state Exp;
branches ;
next     37.1;

37.1
date     89.05.12.11.38.15;  author dew;  state Exp;
branches ;
next     36.1;

36.1
date     89.02.06.10.16.46;  author dew;  state Exp;
branches ;
next     35.1;

35.1
date     89.02.02.13.30.35;  author dew;  state Exp;
branches ;
next     34.1;

34.1
date     89.01.23.16.05.45;  author jwh;  state Exp;
branches ;
next     33.1;

33.1
date     89.01.16.11.38.43;  author dew;  state Exp;
branches ;
next     32.1;

32.1
date     89.01.10.11.46.17;  author bayes;  state Exp;
branches ;
next     31.2;

31.2
date     89.01.04.16.04.54;  author dew;  state Exp;
branches ;
next     31.1;

31.1
date     88.12.14.18.07.33;  author bayes;  state Exp;
branches ;
next     30.1;

30.1
date     88.12.09.13.44.57;  author dew;  state Exp;
branches ;
next     29.3;

29.3
date     88.11.18.11.05.17;  author bayes;  state Exp;
branches ;
next     29.2;

29.2
date     88.11.18.11.00.04;  author bayes;  state Exp;
branches ;
next     29.1;

29.1
date     88.10.31.15.29.33;  author bayes;  state Exp;
branches ;
next     28.2;

28.2
date     88.10.31.11.12.48;  author bayes;  state Exp;
branches ;
next     28.1;

28.1
date     88.10.06.10.57.21;  author dew;  state Exp;
branches ;
next     27.1;

27.1
date     88.09.29.11.27.22;  author bayes;  state Exp;
branches ;
next     26.1;

26.1
date     88.09.28.13.08.57;  author bayes;  state Exp;
branches ;
next     25.5;

25.5
date     88.06.10.13.24.06;  author bayes;  state Exp;
branches ;
next     25.4;

25.4
date     88.06.06.10.04.57;  author bayes;  state Exp;
branches ;
next     25.3;

25.3
date     88.05.23.17.17.57;  author bayes;  state Exp;
branches ;
next     25.2;

25.2
date     88.03.29.17.15.23;  author bayes;  state Exp;
branches ;
next     25.1;

25.1
date     88.03.02.09.25.26;  author bayes;  state Exp;
branches ;
next     24.1;

24.1
date     88.02.04.14.53.35;  author bayes;  state Exp;
branches ;
next     1.1;

1.1
date     88.02.04.14.51.55;  author bayes;  state tmp;
branches ;
next     ;


desc
@Base file for PWS 3.2 release.

@


56.3
log
@
pws2rcs automatic delta on Wed Jan 27 13:14:25 MST 1993
@
text
@					       (*

 (c) Copyright Hewlett-Packard Company, 1987.
All rights are reserved.  Copying or other
reproduction of this program except for archival
purposes is prohibited without the prior
written consent of Hewlett-Packard Company.


	    RESTRICTED RIGHTS LEGEND

Use, duplication, or disclosure by the Government
is subject to restrictions as set forth in
paragraph (b) (3) (B) of the Rights in Technical
Data and Computer Software clause in
DAR 7-104.9(a).

HEWLETT-PACKARD COMPANY
Fort Collins, Colorado                         *)

$DEBUG OFF$

$modcal$
$heap_dispose off$
$iocheck off$
$range off$ $ovflcheck off$
$stackcheck off$
$ALLOW_PACKED ON$

{}
$search  'INITLOAD','ASM','INIT','SYSDEVS'$
{}

{
 Note that some of the data structures and some of the code have been commented
 out. These comments usually represent enhancements I was not allowed to or did
 not have time to put into the driver. The original intent was to export the
 "new" data structures by putting them into SYSDEVS. These structures would have
 provided the access needed by the Internals Programmer to be able to change such
 quantities as the font loaded, fontsize, planes used by the alpha driver, character
 positioning (micro-spacing), replacement rules used in writing characters/cursors,
 etc.

 The assembly source "CATASM.TEXT" also contains references to these quantities.
 SFB
}

{11/17/88 SFB/DEW: bugfixes for the Philips bugs.
  o fixed the STOP key bug by putting csetupcchar in RECOVER blocks
    of docrtio and crtdebug.
  o other fixes were in CATASM.
}

program initcatseye(OUTPUT,INPUT);


module catseyedvr;
import sysglobals, asm, misc, sysdevs {, catasm}, fs;
export

type

       fontdatatype   = packed array[0..maxint] of byte;

       fontdataptr    = ^fontdatatype;    {must point to word boundary }

       screeninforec = record
	       fbwidth         : shortint;     {defaults: LCC = 1024, 768 }
	       fbheight        : shortint;     {          HRx = 2048, 1024 }
	       dispx           : shortint;     {defaults: LCC = 0, 0 }
	       dispy           : shortint;     {          HRx = 0, 0 }
	       dispw           : shortint;     {defaults: LCC = 1024, 768 }
	       disph           : shortint;     {          HRx = 1280, 1024 }
	       printx          : shortint;     {defaults: LCC = 0, 0 }
	       printy          : shortint;     {          HRx = 0, 0 }
	       printw          : shortint;     {defaults: LCC = 1024, 752 }
	       printh          : shortint;     {          HRx = 1280, 1004 }
	       offx            : shortint;     {defaults: LCC = 0, 768 }
	       offy            : shortint;     {          HRx = 1280, 0 }
	       offw            : shortint;     {defaults: LCC = 1024, 256 }
	       offh            : shortint;     {          HRx = 768, 1024 }

	       charw           : shortint;     {defaults: LCC = 8, 16 }
	       charh           : shortint;     {          HRx = 10, 20 }

	       fb_fontstartx   : shortint;     {defaults: LCC = (0,768) }
	       fb_fontstarty   : shortint;     {          HRx = (1280,0) }
	       fb_font_line_length: shortint;  {defaults: LCC = 128 }
					       {          HRx = 64 }
	       fb_fontlines    : shortint;     {defaults: LCC = 1 }
					       {          HRC = 1 }
					       {          HRM = 6 }

	       nfontchars      : integer;      {default = 3 x 128 }

	       fb_cursorx      : shortint;     {defaults: LCC = (0, 784) }
	       fb_cursory      : shortint;     {          HRx = (1920,0) }

	     end;

       type
	       colormap_proc_type =
				procedure(index : integer; r, g, b : integer);

       crtiocontrolrec = packed record
	       set_colormap_proc : colormap_proc_type; {sets ANY cmap entry}

	       planes          : integer;  {1s where planes loaded (bitmap)}
	       alphacolor      : shortint; {color for characters. Can be set
					    0..7 by sending 136..143 to CRT
					    tm, or set to any by setting this
					    field.}

	       cursorcolor     : shortint; {default = 2^(<h/w planes>-1)}

	       {{
	       lowalphaplane   : byte;     {keeps track of lowest plane used
					    by alpha. All physical planes
					    above this one are used by alpha,
					    and all below it are untouched.
					    (for DGL's exclusive use) }

	       highlight       : shortint; {bit fielded:
						 b8  = inverse,
						 b9  = underline
						 b10 = flash,
						 b11 = halfbright}

	       creplrule0      : byte;     {repl rule for char 0s, 0..15 }
	       creplrule1      : byte;     {repl rule for char 1s, 0..15 }

	       cursreplrule0   : byte;     {rule for cursor 0s, 0..15 }
	       cursreplrule1   : byte;     {rule for cursor 1s, 0..15 }

	       togglealpha,          {TRUE=disable alpha planes display when
				      alphastate=TRUE }
	       togglegraphics,       {TRUE=disable graphics planes display when
				      graphicstate=TRUE }
	       copy_under_cursor,    {TRUE=save char pattern before writing
				      cursor, restore after removing cursor }
	       use_fib_xy,           {FALSE=ignore fxpos, fypos from fib}
	       disable_low_ctl,      {TRUE=chr(0)..chr(31) not interpreted}
	       disable_hi_ctl,       {TRUE=chr(128)..chr(143) not interpreted}
	       copy_to_abuf,         {TRUE=copy input to abuf
					     for dump alpha}
	       pad1            : boolean;      {filler }

	     end;

       pcrtparamrec = ^crtparamrec;
       crtparamrec = record
	       screeninfo      : screeninforec;
	       iocontrol       : crtiocontrolrec;
	      {capabilities    : capability_descriprec;}
	     end;

       var
	       crtparams : pcrtparamrec;

function catseyetype: boolean;

implement

$include 'INIT2:CATREGS'$

const

  catregbytes=38;       {increased from 36 to save TRRCTL. SFB/DEW 5/24/88}

  environc=environ[miscinfo:crtfrec[
				    nobreak:false,
				    stupid :false,
				    slowterm:false,
				    hasxycrt:true,
				    haslccrt:FALSE,  {INDICATES BITMAP}
				    hasclock:true,
				    canupscroll:true,
				    candownscroll:true],
		   crttype:0,
		   crtctrl:crtcrec[
				    rlf:chr(31),
				    ndfs:chr(28),
				    eraseeol:chr(9),
				    eraseeos:chr(11),
				    home:chr(1),
				    escape:chr(0),
				    backspace:chr(8),
				    fillcount:10,
				    clearscreen:chr(0),
				    clearline:chr(0),
				    prefixed:b9[9 of false]],
		   crtinfo:crtirec[
				    width :128,height:47,
				    crtmemaddr:0,
				    crtcontroladdr:0,
				    keybufferaddr: 0,
				    progstateinfoaddr: 0,
				    keybuffersize: 119,
				    crtcon: crtconsttype [ 0, 0, 0, 0, 0, 0, 0,
							   0,0, 0, 0,0],
				    right{FS}:chr(28),
				    left{BS}:chr(8),
				    down{LF}:chr(10),    up{US}:chr(31),
				    badch{?}:chr(63),
				    chardel{BS}:chr(8),stop{DC3} :chr(19),
				    break{DLE}:chr(16),
				    flush{ACK}:chr(6),  eof{ETX}:chr(3),
				    altmode{ESC}:chr(27),
				    linedel{DEL}:chr(127),
				    backspace{BS}:chr(8),
				    etx:chr(3),prefix:chr(0),
				    prefixed:b14[14 of false],
				    cursormask : 0,     spare : 0]];

DEFAULT_ALPHACOLOR=1;


var

cpl:            shortint;
cppl:           shortint;
fb_fontchars:   shortint;
maxy:           shortint;
xcurs:          shortint;
ycurs:          shortint;
hascolor:       boolean;
midres:         boolean;
{ CATASM uses all variables above this point.  Don't modify.}

screenwidth:    shortint;
screenheight:   shortint;
maxx:           shortint;
screensize:     shortint;
defaulthighlight: shortint;
firsttimeinit:  boolean;               {DEW 01/04/89; DEFECT #FSDdt02039}

function   cromshort(offset:integer):shortint;external;
procedure  csetreg(register:integer; value:shortint);external;
procedure  csavecatenv(anyvar buffer:window);external;
procedure  crestorecatenv(anyvar buffer:window);external;
procedure  csetupcchar;external;
procedure  csetcolormap(indx:integer; r,g,b:integer);external;
procedure  cchar(c,x,y:shortint);external;
procedure  cursoroff; external;
procedure  cscrollup;external;
procedure  cscrolldown;external;
procedure  cclear(x,y,n:shortint);external;
procedure  cupdatecursor(x,y:shortint);external;
procedure  cbuildtable;external;
procedure  cshiftleft; external;
procedure  cshiftright; external;
procedure  cexchange( savearea: windowp; ymin, ymax, xmin, width: shortint);
	   external;
procedure  cscrollwindow( ymin, ymax, xmin, width: shortint); external;
procedure  cscrollwinddn( ymin, ymax, xmin, width: shortint); external;
procedure  cdbscrolll( ymin, ymax, xmin, width: shortint); external;
procedure  cdbscrollr( ymin, ymax, xmin, width: shortint); external;
procedure  cclearall; external;
procedure  cputfontchar(x,p,y : shortint; datap : fontdataptr;
	    oddbytes : boolean);external;
procedure  cprepdumpline(mybuf:windowp; size:shortint; rowstart:anyptr); external;

procedure dummy_setcmap(index:integer; r,g,b:integer);
begin
end;

procedure init_crtparams;
 begin
 if crtparams=NIL then
  new(crtparams);
 with crtparams^, screeninfo, iocontrol do
  begin
    charw:=0;
    charh:=0;
    fb_fontstartx:=0;
    fb_fontstarty:=0;
    fb_font_line_length:=0;
    fb_fontlines:=0;
    nfontchars:=0;
    fb_cursorx:=0;
    fb_cursory:=0;
    cursorcolor:=0;
    {{
    lowalphaplane:=0;
    {}
    highlight:=0;
    alphacolor:=1;
    creplrule0:=0;
    creplrule1:=3;
    cursreplrule0:=0;
    cursreplrule1:=3;
    togglealpha:=false;
    togglegraphics:=false;
    copy_under_cursor:=true;
    use_fib_xy:=true;
    disable_low_ctl:=false;
    disable_hi_ctl:=false;
    copy_to_abuf:=false;
    set_colormap_proc:=dummy_setcmap;
  end;
 end;

procedure dumpg ;
label 1;
const
  gwidth_lcc = 128;
  gwidth_hrx = 160;
  gbuffersize = gwidth_hrx + 7;

type
  gbyte = 0..255;
  row_def = packed array [0..maxint] of gbyte;

var
  row : ^row_def;

  abyte         : byte;
  gbuffer       : string[gbuffersize];
  lenstr        : string[3];
  i,j,rowstart  : integer;
  bitnum, charpos,datalen       : shortint;
begin

  row := anyptr(frameaddr);

  {
  write(gfiles[4]^,#27'*t150R');   { SET RESOLUTION 150 FOR DESKJET}
  {
  write(gfiles[4]^,#27'*t192R');   { SET RESOLUTION 192 FOR QUIETJET}
  write(gfiles[4]^,#27'*rA');   { initiate graphics sequence }

  gbuffer:=#27'*bxxxW'; {xxx will be replaced in cprepdumpline by actual
			 number of non-0 bytes in buffer}

  with crtparams^, screeninfo, iocontrol do
  begin
    datalen:=(dispw+7) div 8;
    rowstart:=0;
    for j := 0 to disph-1 do
      begin
	cprepdumpline(addr(gbuffer[8]), datalen, addr(row^[rowstart]));
	write(gfiles[4]^,gbuffer);
	if ioresult <> ord(inoerror) then goto 1;
	rowstart:=rowstart+fbwidth;
      end;
  end;

  write(gfiles[4]^,#27'*rB');   { terminate graphics sequence }
1:
end;


procedure doupdatecursor;
var stackbuf: packed array[1..catregbytes] of byte;
begin
  csavecatenv(stackbuf);
  cursoroff;
  cupdatecursor(xpos,ypos);
  crestorecatenv(stackbuf);
end;

procedure getxy(var x,y: integer);
begin
x := xpos;      y := ypos;
end;

procedure setxy(x, y: shortint);
begin
  if x>=screenwidth then xpos:=maxx
  else if x<0 then xpos:=0
  else xpos := x;
  if y>=screenheight then ypos:=maxy
  else if y<0 then ypos:=0
  else ypos := y;
end;

procedure clear(number: shortint);
var x,y: shortint;
    clearchars: shortint;
begin
  x:=xpos; y:=ypos;
  while number>0 do begin
    if maxx-x+1<number then
      clearchars:=maxx-x+1
    else
      clearchars:=number;
    cclear(x,y,clearchars);
    number:=number-clearchars;
    x:=0; if y<maxy then y:=y+1;
  end;
end;

function maptocrt(c:char):shortint;

{ Converts Katakana codes to their correct CRT font storage  codes.
  Note that the Yen symbol overlays the USASCII backslash (\). }
  procedure mapkanatocrt ;
  const
    yenromlocation = 188; { location of Yen symbol in font storage }
    yencode=92;
  begin
      if ord(c) = yencode then maptocrt := yenromlocation
      else if ord(c)<128 then maptocrt:=ord(c)
	     else maptocrt:= ord(c)+128;
  end; { mapkanatocrt }

begin
  if kbdlang = katakana_kbd then mapkanatocrt
  else maptocrt:=ord(c);
end;

function needs_setup(c:shortint):boolean; {already know c>=128 and c<144}
begin
  needs_setup:=false;
  with crtparams^, iocontrol do
    if ((c<136) and hascolor) or (not hascolor) then
      begin      {hilite request, color or mono}
	if ((highlight div 256) mod 2) <> (c mod 2) then
	  begin        {for inverse video. Underline is handled in cchar}
	    creplrule1:=3+9*(c mod 2);
	    needs_setup:=true;
	  end;
	if not hascolor then
	  highlight:=(c-128)*256
	else
	  highlight:=((highlight div 2048)*8 + (c-128))*256;
      end
    else
      begin    {set color request on color machine}
       alphacolor:=((c-136) {MOD 8}) + 1;
       cursorcolor:=alphacolor;
       highlight:=highlight mod 2048 + (c-136)*4096;
       needs_setup:=true;
      end;
end;    {needs_setup}


{Added bug fixes for "STOP" key. Symptom was that color would change to
 white from whatever it was if "STOP" key hit while idling in CI. Cause
 was that "Io" character in lower right corner, done by "kbdwaithook" was
 being interrupted by "STOP", and wasn't setting color back from white to
 "old" color. Any escape(-20) or escape(-28) from an ISR could also cause
 this symptom (see "interrupt" routine in POWERUP.TEXT for reasons.

 The fix is the same in all of docrtio, lineops and crtdebug: in essence we
 "protect" the H/W setup by setting level 7, then set the level back down to
 its old value to allow ISRs to execute, if they want. We put a try/recover
 around the main execution, as we can't afford to stay at level 7 for very
 long. This allows us to set level back own to old level during I/O, knowing
 we can restore the previous H/W state, because "STOP", etc will trigger the
 recover block. We do not try to complete the I/O if a "STOP" key hits during
 the driver; we merely try to restore the entry state of the CATSEYE H/W and
 system globals. We do not protect against NMI at all (this is very hard
 to do.)

 2 known "bugs": in the recover block, a second escape occurring before the
 setintlevel(7) will cause H/W restoration to not be executed, and another
 escape in the recovery anywhere after the setintlevel(7) and before the
 if.. then escape(savesc) will cause the first escapecode to be lost.

 SFB 5/31/88
}

procedure docrtio(fp: fibp; request: amrequesttype; anyvar buffer: window;
						   length, position: integer);
type
    cursor_affected_set=set of amrequesttype;
const
    cursor_affected=cursor_affected_set[setcursor, clearunit, writeeol,
					startwrite, writebytes];
var stackbuf: packed array[1..catregbytes] of byte;
    c: char;
    s: string[1];
    savesc, oldlevel: shortint; {to fix stopkey bug. SFB 5/31/88}
    change_cursor: boolean; {to shorten level 7 lockout time. SFB 5/31/88}
    buf: charptr;
begin

 change_cursor:=request in cursor_affected; {precompute for speed. SFB 5/31/88}

 savesc:=0;     {in case driver gets escaped away from, we clean up, then escape
		 with the correct escape code. SFB 5/31/88}
 oldlevel:=intlevel;    {so we can restore level after protecting "atomic operations".
			 SFB 5/31/88}

 setintlevel(7);        {prepare for "atomic operation". SFB 5/31/88}
   csavecatenv(stackbuf);

   if change_cursor then
    begin
      with crtparams^, iocontrol do
	alphacolor:=cursorcolor;
	 {KLUGE ALERT! This only  works because we define alphacolor
	 and cursorcolor to be always the same. It rescues the alphacolor in the case that
	 an ISR executed during lineops (when alphacolor<>cursorcolor), and did escape(-20),
	 not allowing lineops to put back the global describing alphacolor. It hasn't modified
	 cursorcolor, though, so we can recover alphacolor from it. NOTE: if cursorcolor is
	 ever made accessible outside this driver, this kluge should be removed, or changing
	 cursorcolor will magically change alphacolor.
	 SFB/DEW 5/31/88}
      cursoroff;
    end;

 try            {now ensure we get a chance to clean up if "STOP" key hits. SFB 5/31/88}
   setintlevel(oldlevel);  {finish "atomic operation" SFB 5/31/88}

   ioresult := ord(inoerror);
   buf := addr(buffer);
   with crtparams^, iocontrol do
   case request of
    setcursor: begin
		setxy(fp^.fxpos, fp^.fypos);
	       end;       {cupdatecursor is called at end of docrtio}
    getcursor: getxy (fp^.fxpos, fp^.fypos);
    flush:  {do nothing};
    unitstatus:  kbdio(fp, request, buffer, length, position);
    clearunit: begin      {will not clear screen content, as this is not appropriate}
		highlight := defaulthighlight;
		alphacolor:= default_alphacolor;
		cursorcolor:=alphacolor;
		creplrule1:=3;
		csetupcchar;
		setxy(0,0);
	       end;
    readtoeol:
      begin
      buf := addr(buf^, 1);
      buffer[0] := chr(0);
      while length>0 do
	begin
	kbdio(fp, readtoeol,  s, 1, 0);
	if      strlen(s)=0     then length := 0
	else  begin
	      length := length - 1;
	      crtio(fp, writebytes, s[1], 1, 0);
	      buf := addr(buf^, 1);
	      buffer[0] := chr(ord(buffer[0])+1);
	      end;
	end;
      end;
    startread,
    readbytes:
      begin
      while length>0 do
	begin
	kbdio(fp, readbytes,  buf^, 1, 0);
	if buf^ = chr(etx) then length := 0
			   else length := length - 1;
	if buf^ = eol then crtio(fp, writeeol,   buf^, 1, 0)
		      else crtio(fp, writebytes, buf^, 1, 0);
	buf := addr(buf^, 1);
	end;
      if request = startread then call(fp^.feot, fp);
      end;
    writeeol: begin
		  if ypos=maxy then cscrollup;
		  setxy(0, ypos+1);
	      end;
    startwrite,
    writebytes:
      begin
      while length>0 do
       begin
	 c:=buf^; buf:=addr(buf^,1); length:=length-1;

	 case c of
	 homechar:   setxy(0,0);
	 leftchar:   if (xpos = 0) and (ypos>0) then setxy(maxx, ypos-1)
		     else setxy(xpos-1, ypos);
	 rightchar:  if (xpos = maxx) and (ypos<maxy) then setxy(0, ypos+1)
		     else setxy(xpos+1, ypos);
	 upchar:     begin if ypos <= 1  then cscrolldown;
			   if ypos>0 then setxy(xpos, ypos-1);
		     end;
	 downchar:   if ypos=maxy then cscrollup
		     else setxy(xpos, ypos+1);
	 bellchar:   beep;
	 cteos:      clear(screensize-(ypos*screenwidth+xpos));
	 cteol:      clear(screenwidth-xpos);
	 clearscr:   begin setxy(0,0); clear(screensize); end;
	 eol:        setxy(0, ypos);
	 chr(etx):   length:=0;
	 otherwise   if (ord(c)>=128) and (ord(c)<144) then {display enhancement}
		       if needs_setup(ord(c)) then        {modified setup}
			 csetupcchar
		       else       {didn't modify setup, so do nothing}
		     else         {printable char}
		       begin
			cchar(maptocrt(c),xpos,ypos);
			if xpos = maxx then
			  begin
			    if ypos = maxy then cscrollup;
			    setxy(0, ypos+1);
			  end
			else setxy(xpos+1, ypos);
		       end;
	 end;     {case}
       end; {while}
      if request = startwrite then call(fp^.feot, fp);
      end;
    otherwise ioresult := ord(ibadrequest);
   end; {case}

 setintlevel(7);    {prepare for "atomic" cleanup operation" SFB 5/31/88}
 recover {SFB 5/31/88}
   begin
     setintlevel(7); {prepare for "atomic" cleanup operation". Possible bug:
		      What if interrupt hits in recover block before setintlevel(7)
		      executes? We would lose chance to restore H/W setup.}
     savesc:=escapecode;   {so we can "transparently" let escape through}
     csetupcchar;       {added 11/17/88 to set up environment for cupdatecursor,
			 in case STOP was hit during scroll, etc, where CATSEYE
			 setup is different. SFB/DEW}
   end;


   if change_cursor then        {SFB 5/31/88}
   begin
      cupdatecursor(xpos,ypos); {no change, but see comment in recover block about
				 csetupcchar. SFB/DEW 11/17/88}
   end;
   crestorecatenv(stackbuf);

 setintlevel(oldlevel); {finish at level we started at. SFB 5/31/88}

 if savesc<>0 then
   escape(savesc);  {possible bug: what if interrupt hits during intlevel 7?
		     We would never execute this code. SFB 5/31/88}

end;    {docrtio}

procedure lineops(op: crtllops; anyvar position: integer; c: char);

var stackbuf: packed array[1..catregbytes] of byte;
    i,oldhilite,oldcolor,oldrule: shortint;
    savesc, oldlevel: shortint; {to fix stopkey bug. SFB 5/31/88}
    sptr: ^string255;

begin

savesc:=0;     {in case driver gets escaped away from, we clean up, then escape
		with the correct escape code. SFB 5/31/88}
oldlevel:=intlevel;    {so we can restore level after protecting "atomic operations".
			SFB 5/31/88}

setintlevel(7);        {prepare for "atomic operation". SFB 5/31/88}
  with crtparams^, iocontrol do
   begin
     oldrule:=creplrule1;
     oldcolor:=alphacolor;
     oldhilite:=highlight;
     creplrule1:=3;        {no enhancements supported in lastline}
     alphacolor:=default_alphacolor;      {only white in last line}
    {cursorcolor:=alphacolor;             {no cursor in last line}
     highlight:=defaulthighlight;
   end;

  csavecatenv(stackbuf);

try            {now ensure we get a chance to clean up if "STOP" key hits. SFB 5/31/88}
  setintlevel(oldlevel);  {finish "atomic operation" SFB 5/31/88}

case op of

  cllput: cchar(maptocrt(c), position, screenheight);

  cllshiftl:
     begin
       cshiftleft;
       cchar(ord(' '), maxx-8, screenheight);
     end;

  cllshiftr:
     begin
       cshiftright;
       cchar(ord(' '), 0, screenheight);
     end;

  cllclear: cclear(0, screenheight, maxx-7);

  clldisplay:
     begin
       sptr:=addr(position);
       for i:=1 to strlen(sptr^) do
	 cchar(maptocrt(sptr^[i]), i-1, screenheight);
       for i:=strlen(sptr^) to (maxx-8) do
	 cchar(ord(' '), i, screenheight);
     end;

  putstatus:  cchar(ord(c), maxx-7+position, screenheight);

end; { of case }

setintlevel(7);    {prepare for "atomic" cleanup operation" SFB 5/31/88}
recover {SFB 5/31/88}
  begin
    setintlevel(7); {prepare for "atomic" cleanup operation". Possible bug:
		     What if interrupt hits in recover block before setintlevel(7)
		     executes? We would lose chance to restore H/W setup.}
    savesc:=escapecode;   {so we can "transparently" let escape through}
  end;

  with crtparams^, iocontrol do
   begin
    creplrule1:=oldrule;
    alphacolor:=oldcolor;
    highlight:=oldhilite;
   end;

  crestorecatenv(stackbuf);

 setintlevel(oldlevel); {finish at level we started at. SFB 5/31/88}

 if savesc<>0 then
   escape(savesc);  {possible bug: what if interrupt hits during intlevel 7?
		     We would never execute this code. SFB 5/31/88}

end;

procedure crtdebug(op: dbcrtops; var dbrec: dbcinfo);
type
    cursor_affected_set=set of dbcrtops;
const
    cursor_affected=cursor_affected_set[dbgotoxy, dbscrollup, dbscrolldn,
					dbscrolll, dbscrollr, dbput, dbclear,
					dbcline, dbexcg];

type
  iptr = ^iarray;
  iarray = array[0..maxint] of shortint;

var stackbuf: packed array[1..catregbytes] of byte;
    {oldalphacolor and oldcursorcolor keep track of alpha and cursor colors
     separately, because if a linops call is interrupted by another use of the
     driver, it may have left alphacolor<>cursorcolor, so restoring cursorcolor:=
     alphacolor at the end of this routine is a Bad Thing.
     Note also that calling the tm in the middle of the lineops execution may
     cause a similar problem, as lastline color might be different from alphacolor,
     and cursorcolor will still == alphacolor.
     SFB/DEW 5/31/88}
    i, oldhilite, oldalphacolor, oldcursorcolor, oldrule: shortint;
    j: integer;
    savesc, oldlevel: shortint; {to fix stopkey bug. SFB 5/31/88}
    change_cursor: boolean; {to shorten level 7 lockout time. SFB 5/31/88}
    tempaddr : integer;

begin

{Need to do following steps BEFORE csavecatenv, as they will affect driver
 setup via drop-through to setupcchar}

 change_cursor:=op in cursor_affected; {precompute for speed. SFB 5/31/88}

 savesc:=0;     {in case driver gets escaped away from, we clean up, then escape
		 with the correct escape code. SFB 5/31/88}
 oldlevel:=intlevel;    {so we can restore level after protecting "atomic operations".
			 SFB 5/31/88}

 setintlevel(7);        {prepare for "atomic operation". SFB 5/31/88}
   with crtparams^, iocontrol do
    begin
     oldrule:=creplrule1;     {to restore for later}
     oldalphacolor:=alphacolor;        {ditto}
     oldcursorcolor:=cursorcolor;      {ditto}
     oldhilite:=highlight;

    {set up debugger window conditions}
     highlight:=dbrec.debughighlight;

    {set relprule to 3 (regular) or 12 (inverse video)}
     creplrule1:=3+9*((highlight div 256) mod 2);
     if hascolor then
       begin
	{set color according to debugwindow}
	 alphacolor:=((highlight div 4096) mod 8) + 1;
	 cursorcolor:=alphacolor;
       end;
    end;

   {This also sets up color and inverse/forward video in driver, via drop-
    through to setupcchar}
   csavecatenv(stackbuf);

with dbrec do
  if change_cursor then
   begin
    cursoroff;
    xcurs:=cursx;
    ycurs:=cursy;
   end;

try            {now ensure we get a chance to clean up if "STOP" key hits. SFB 5/31/88}
  setintlevel(oldlevel);  {finish "atomic operation" SFB 5/31/88}

with dbrec do begin

  case op of

    dbinfo: with crtparams^.screeninfo do
	      begin
		savesize:=(xmax-xmin+1)*(ymax-ymin+1)*charw*charh;
	      end;

    dbgotoxy: begin {Implemented by prior call to cursoroff, and following
		     call to cupdatecursor}
	      end;

    dbscrollup: begin
		  cscrollwindow( ymin, ymax, xmin, xmax-xmin+1);
		  cclear(xmin, ymax, xmax-xmin+1);
		end;

    dbscrolldn: begin
		  cscrollwinddn(ymin, ymax, xmin, xmax-xmin+1);
		  cclear(xmin, ymin, xmax-xmin+1);
		end;

    dbscrolll: begin
		 cdbscrolll(ymin, ymax, xmin, xmax-xmin+1);
		 for i:=ymin to ymax do
		   cchar (ord(' '), xmax, i);
	       end;

    dbscrollr: begin
		 cdbscrollr(ymin, ymax, xmin, xmax-xmin+1);
		 for i:=ymin to ymax do
		   cchar (ord(' '), xmin, i);
	       end;

    dbhighl: ; { Not implemented for color bitmap displays }

    dbput: begin
	     if charismapped then
	       cchar( maptocrt(c), cursx, cursy)
	     else
	       cchar( ord(c), cursx, cursy);
	   end;

    dbclear:
      for i:=ymin to ymax do
	cclear( xmin, i, xmax-xmin+1);

    dbcline: cclear( cursx, cursy, xmax-cursx+1);

    dbinit:
      begin
	for j:=0 to (savesize div 2)-1 do
	 iptr(savearea)^[j]:=0;
	cursx:=xmin; cursy:=ymin;
	areaisdbcrt:=false;
	charismapped:=false;
	debughighlight:=0;
      end;

    dbexcg:
      with crtparams^, iocontrol do
       begin
	cexchange( savearea, ymin, ymax, xmin,
		 (xmax-xmin+1)*crtparams^.screeninfo.charw);
	areaisdbcrt:=not areaisdbcrt;
	if areaisdbcrt then
	 begin
	  if hascolor then   {set cursor color according to debugwindow}
	    cursorcolor:=((highlight div 4096) mod 8) + 1;
	  xcurs:=cursx;
	  ycurs:=cursy;
	 end
	else
	 begin
	  if hascolor then   {set cursor color according to alpha window}
	    cursorcolor:=oldcursorcolor;
	  xcurs:=xpos;
	  ycurs:=ypos;
	 end;
       end;

  end; { of case }

end; { of with }

setintlevel(7);    {prepare for "atomic" cleanup operation" SFB 5/31/88}
recover {SFB 5/31/88}
  begin
    setintlevel(7); {prepare for "atomic" cleanup operation". Possible bug:
		     What if interrupt hits in recover block before setintlevel(7)
		     executes? We would lose chance to restore H/W setup.}
    savesc:=escapecode;   {so we can "transparently" let escape through}
    csetupcchar;       {added 11/17/88 to set up environment for cupdatecursor,
			in case STOP was hit during scroll, etc, where CATSEYE
			setup is different. SFB/DEW}
  end;

  if change_cursor then
    cupdatecursor(xcurs, ycurs);{possibly with new cursor color}
				{no change, but see comment in recover block about
				 csetupcchar. SFB/DEW 11/17/88}
  with crtparams^, iocontrol do
   begin
    creplrule1:=oldrule;
    highlight:=oldhilite;
    alphacolor:=oldalphacolor;
    cursorcolor:=oldcursorcolor;
   end;

  crestorecatenv(stackbuf);

setintlevel(oldlevel); {finish at level we started at. SFB 5/31/88}

if savesc<>0 then
 escape(savesc);  {possible bug: what if interrupt hits during intlevel 7?
		   We would never execute this code. SFB 5/31/88}

end; { crtdebug procedure }

procedure dummy;
begin end;

procedure loadfont(fax,fay,faw,fah : integer);
type
    barray=packed array[0..maxint] of byte;
    cursorconstyp=packed array[0..39] of byte;

const
    oddbyte=true;               {font ROM contains data only at odd addresses}
    blk_lcc_cursorconst=cursorconstyp[{255,14 of 129,25 of 255}
	126,14 of 255,126,24 of 255];
    lcc_cursorconst=cursorconstyp[13 of 0, 2 of 255, 1 of 0,24 of 255];
    blk_hrx_cursorconst=cursorconstyp[127, 128, 36 of 255, 127, 128];
    hrx_cursorconst=cursorconstyp[34 of 0, 4 of 255, 2 of 0];
    spacecurs=cursorconstyp[40 of 0];
var
    t, id, td, ttd,
    i, j, nfonts, firstchar, lastchar, mask : integer;
    tfontc  : ^barray;
    pcursor : fontdataptr;
    c:char;     {REMOVE}
begin
 with crtparams^, screeninfo, iocontrol do
  begin
   fb_fontstartx:=fax;          {save this info for system use}
   fb_fontstarty:=fay;
   fb_font_line_length:=faw;
   td:=cromshort(hex('3b'));     {start of font storage}
   ttd:=td;
   tfontc:=anyptr(bitmapaddr+td);
   nfonts:=tfontc^[0];
   nfontchars:=0;               {save this info for system use}
   for i:=1 to nfonts do
    begin
     tfontc:=anyptr(bitmapaddr+td);
     id:=tfontc^[6*(i-1)+2];
     if id<>0 then
      begin
       ttd:=cromshort(td+4+(i-1)*6);
       tfontc:=anyptr(bitmapaddr+ttd);
       charh:=tfontc^[0];       {save this info for for system use}
       charw:=tfontc^[2];       {save this info for for system use}
       firstchar:=tfontc^[6];
       lastchar:=tfontc^[8];
       cppl:=(faw div charw);
       cpl:=0;
       mask:=planes;
       while mask <> 0 do
	begin
	 cpl:=cpl+cppl;
	 mask:=mask div 2;
	end;
       for j:=firstchar to lastchar do
	begin
	 {general computations of where font char is located in
	      graphics ROM space, and where it goes in framebuf}
	 cputfontchar(
	  fax+(nfontchars mod cppl)*charw,
	  (nfontchars mod cpl) div cppl,
	  fay+(nfontchars div cpl)*charh,
	  addr(tfontc^
	   [10+(j-firstchar)*(1+ord(oddbyte))*((charw+7) div 8)*charh]),
	  oddbyte);
	 nfontchars:=nfontchars+1;
	end;    {for j:=firstchar to lastchar}
      end;    {if id <> 0}
    end;    {for i:=1 to nfonts do}
   {{
   fontproc:=cfontproc;
   {}
   fb_fontlines:=((nfontchars-1) div cpl)+1;
   fb_fontchars:=nfontchars;
   fb_cursorx:=fax+faw;
   fb_cursory:=fay;
   if midres then
    begin
     pcursor:=addr(blk_lcc_cursorconst);
     {{
     pcursor:=addr(lcc_cursorconst);
     {}
    end
   else
    begin
     {{
     pcursor:=addr(hrx_cursorconst);
     {}
     pcursor:=addr(blk_hrx_cursorconst);
    end;

   cputfontchar(fb_cursorx,-1,fb_cursory,pcursor,false);   {cursor pattern}

   {now clear the saved character, in case it's not yet clear}
   cputfontchar(fb_cursorx+charw,-1,fb_cursory,addr(spacecurs),false);

   csetreg(tcwen1,-1);          {be nice to later catseye users}
   csetreg(prr,3*256);          {be nice to later catseye users}
  end;   {with crtinfo^.screeninfo}
end;   {loadfont}

procedure getcrtinfo;
var stackbuf: packed array[1..catregbytes] of byte;
begin
 with crtparams^, screeninfo, iocontrol do
  begin
   cbuildtable;

   csavecatenv(stackbuf);       {to set up cchar}
   if midres then
    loadfont(offx,offy,512,offh)
   else
    loadfont(offx,offy,740,offh);
   {}
   hascolor:=planes<>1;
   {}
   alphacolor:=1;
   cursorcolor:=alphacolor;

   {
     DEW 01/04/89; DEFECT #FSDdt02039
     User can programatically adjust screen height/width on bit map displays.
     This is accomplished by the user changing height and width in
     syscom^.crtinfo and calling the sysdevs hook, crtinithook.  This code
     used to always copy in environc into syscom, making height/width fixed.
     Now, if this is not the power up init (new flag firsttimeinit) then use
     the user supplied values of height and width.

     Note other values in this record are not examined.  To maintain
     compatibility with bobcat, these values are not reset to their
     original and correct values either.
   }
   if firsttimeinit then
   begin
     printh:=((disph-charh) DIV charh)*charh; {should be done in cbuildtable.
					       See note in CATASM. SFB}
     maxx:=(printw div charw)-1;
     maxy:=(printh div charh)-1;
     screenwidth:=maxx+1;
     screenheight:=maxy+1;
   end
   else
   begin
     screenwidth :=syscom^.crtinfo.width;
     screenheight:=syscom^.crtinfo.height;
     maxx := screenwidth-1;
     maxy := screenheight-1;
     printw := (maxx+1)*charw;
     printh := (maxy+1)*charh;
   end;
   screensize:=screenwidth*screenheight;
   cursreplrule0:=5;
   cursreplrule1:=6;
   copy_under_cursor:=true;
   set_colormap_proc:=csetcolormap;
   setxy(0,0);
   cupdatecursor(0,0);
   crestorecatenv(stackbuf);
  end;
end;

procedure catseyeinit;
 var i: shortint;
     achar:char;
     stackbuf: packed array[1..catregbytes] of byte;

 begin
 init_crtparams;
 if firsttimeinit then                 {DEW 01/04/89; DEFECT #FSDdt02039}
    syscom^:=environc;
 idle:=245;                          { set io char to roman8 value }
 with syscom^.crtinfo do
  begin
   getcrtinfo;

   height:=screenheight;
   defaulthighlight:=0;
   dumpalphahook := dumpg;
   dumpgraphicshook := dumpg;
   updatecursorhook:=doupdatecursor;
   crtiohook:=docrtio;
   dbcrthook:=crtdebug;
   crtllhook:=lineops;
   crtinithook:=catseyeinit;
   togglealphahook:=dummy;
   togglegraphicshook:=dummy;
   currentcrt:=bitmaptype;
   keybuffer^.maxsize:=maxx-8;
  end;
end;


function catseyetype:boolean;

const newbitmapid=57; {primary id for new bitmap displays}
      LCCid=5;  {Low Cost Catseye secondary id}
      HRCid=6;  {High Resolution Color Catseye  secondary id}
      HRMid=7;  {High Resolution Monochrome Catseye secondary id}
var ptr: ^shortint;
    i: shortint;
    dummy: shortint;
    found: boolean;

begin

found:=false;

{check DIO I space}
ptr:=anyptr(hex('560000'));

try
  dummy:=ptr^;
  if (dummy mod 128) = newbitmapid then begin
    ptr:=anyptr(integer(ptr)+20);  { look at secondary id }
    dummy:=ptr^ mod 128;
    midres:=(dummy=LCCid);
    if (dummy>=LCCid) and (dummy<=HRMid) then begin
     found:=true; bitmapaddr:=integer(ptr)-20;
    end;
  end;
recover
  if escapecode<>-12 then escape(escapecode);

if  found  then
 begin
  firsttimeinit := true;                {DEW 01/04/89; DEFECT #FSDdt02039}
  catseyeinit;
  firsttimeinit := false;               {DEW 01/04/89; DEFECT #FSDdt02039}
 end;
catseyetype:=found;
end;  { catseyetype }


end;  { of module }

import catseyedvr, loader;

begin
  if catseyetype then begin
  markuser;
  end;
end.

@


56.2
log
@
pws2rcs automatic delta on Wed Jan 27 11:57:27 MST 1993
@
text
@d1 1156
@


56.1
log
@Automatic bump of revision number for PWS version 3.25
@
text
@a0 1156
					       (*

 (c) Copyright Hewlett-Packard Company, 1987.
All rights are reserved.  Copying or other
reproduction of this program except for archival
purposes is prohibited without the prior
written consent of Hewlett-Packard Company.


	    RESTRICTED RIGHTS LEGEND

Use, duplication, or disclosure by the Government
is subject to restrictions as set forth in
paragraph (b) (3) (B) of the Rights in Technical
Data and Computer Software clause in
DAR 7-104.9(a).

HEWLETT-PACKARD COMPANY
Fort Collins, Colorado                         *)

$DEBUG OFF$

$modcal$
$heap_dispose off$
$iocheck off$
$range off$ $ovflcheck off$
$stackcheck off$
$ALLOW_PACKED ON$

{}
$search  'INITLOAD','ASM','INIT','SYSDEVS'$
{}

{
 Note that some of the data structures and some of the code have been commented
 out. These comments usually represent enhancements I was not allowed to or did
 not have time to put into the driver. The original intent was to export the
 "new" data structures by putting them into SYSDEVS. These structures would have
 provided the access needed by the Internals Programmer to be able to change such
 quantities as the font loaded, fontsize, planes used by the alpha driver, character
 positioning (micro-spacing), replacement rules used in writing characters/cursors,
 etc.

 The assembly source "CATASM.TEXT" also contains references to these quantities.
 SFB
}

{11/17/88 SFB/DEW: bugfixes for the Philips bugs.
  o fixed the STOP key bug by putting csetupcchar in RECOVER blocks
    of docrtio and crtdebug.
  o other fixes were in CATASM.
}

program initcatseye(OUTPUT,INPUT);


module catseyedvr;
import sysglobals, asm, misc, sysdevs {, catasm}, fs;
export

type

       fontdatatype   = packed array[0..maxint] of byte;

       fontdataptr    = ^fontdatatype;    {must point to word boundary }

       screeninforec = record
	       fbwidth         : shortint;     {defaults: LCC = 1024, 768 }
	       fbheight        : shortint;     {          HRx = 2048, 1024 }
	       dispx           : shortint;     {defaults: LCC = 0, 0 }
	       dispy           : shortint;     {          HRx = 0, 0 }
	       dispw           : shortint;     {defaults: LCC = 1024, 768 }
	       disph           : shortint;     {          HRx = 1280, 1024 }
	       printx          : shortint;     {defaults: LCC = 0, 0 }
	       printy          : shortint;     {          HRx = 0, 0 }
	       printw          : shortint;     {defaults: LCC = 1024, 752 }
	       printh          : shortint;     {          HRx = 1280, 1004 }
	       offx            : shortint;     {defaults: LCC = 0, 768 }
	       offy            : shortint;     {          HRx = 1280, 0 }
	       offw            : shortint;     {defaults: LCC = 1024, 256 }
	       offh            : shortint;     {          HRx = 768, 1024 }

	       charw           : shortint;     {defaults: LCC = 8, 16 }
	       charh           : shortint;     {          HRx = 10, 20 }

	       fb_fontstartx   : shortint;     {defaults: LCC = (0,768) }
	       fb_fontstarty   : shortint;     {          HRx = (1280,0) }
	       fb_font_line_length: shortint;  {defaults: LCC = 128 }
					       {          HRx = 64 }
	       fb_fontlines    : shortint;     {defaults: LCC = 1 }
					       {          HRC = 1 }
					       {          HRM = 6 }

	       nfontchars      : integer;      {default = 3 x 128 }

	       fb_cursorx      : shortint;     {defaults: LCC = (0, 784) }
	       fb_cursory      : shortint;     {          HRx = (1920,0) }

	     end;

       type
	       colormap_proc_type =
				procedure(index : integer; r, g, b : integer);

       crtiocontrolrec = packed record
	       set_colormap_proc : colormap_proc_type; {sets ANY cmap entry}

	       planes          : integer;  {1s where planes loaded (bitmap)}
	       alphacolor      : shortint; {color for characters. Can be set
					    0..7 by sending 136..143 to CRT
					    tm, or set to any by setting this
					    field.}

	       cursorcolor     : shortint; {default = 2^(<h/w planes>-1)}

	       {{
	       lowalphaplane   : byte;     {keeps track of lowest plane used
					    by alpha. All physical planes
					    above this one are used by alpha,
					    and all below it are untouched.
					    (for DGL's exclusive use) }

	       highlight       : shortint; {bit fielded:
						 b8  = inverse,
						 b9  = underline
						 b10 = flash,
						 b11 = halfbright}

	       creplrule0      : byte;     {repl rule for char 0s, 0..15 }
	       creplrule1      : byte;     {repl rule for char 1s, 0..15 }

	       cursreplrule0   : byte;     {rule for cursor 0s, 0..15 }
	       cursreplrule1   : byte;     {rule for cursor 1s, 0..15 }

	       togglealpha,          {TRUE=disable alpha planes display when
				      alphastate=TRUE }
	       togglegraphics,       {TRUE=disable graphics planes display when
				      graphicstate=TRUE }
	       copy_under_cursor,    {TRUE=save char pattern before writing
				      cursor, restore after removing cursor }
	       use_fib_xy,           {FALSE=ignore fxpos, fypos from fib}
	       disable_low_ctl,      {TRUE=chr(0)..chr(31) not interpreted}
	       disable_hi_ctl,       {TRUE=chr(128)..chr(143) not interpreted}
	       copy_to_abuf,         {TRUE=copy input to abuf
					     for dump alpha}
	       pad1            : boolean;      {filler }

	     end;

       pcrtparamrec = ^crtparamrec;
       crtparamrec = record
	       screeninfo      : screeninforec;
	       iocontrol       : crtiocontrolrec;
	      {capabilities    : capability_descriprec;}
	     end;

       var
	       crtparams : pcrtparamrec;

function catseyetype: boolean;

implement

$include 'INIT2:CATREGS'$

const

  catregbytes=38;       {increased from 36 to save TRRCTL. SFB/DEW 5/24/88}

  environc=environ[miscinfo:crtfrec[
				    nobreak:false,
				    stupid :false,
				    slowterm:false,
				    hasxycrt:true,
				    haslccrt:FALSE,  {INDICATES BITMAP}
				    hasclock:true,
				    canupscroll:true,
				    candownscroll:true],
		   crttype:0,
		   crtctrl:crtcrec[
				    rlf:chr(31),
				    ndfs:chr(28),
				    eraseeol:chr(9),
				    eraseeos:chr(11),
				    home:chr(1),
				    escape:chr(0),
				    backspace:chr(8),
				    fillcount:10,
				    clearscreen:chr(0),
				    clearline:chr(0),
				    prefixed:b9[9 of false]],
		   crtinfo:crtirec[
				    width :128,height:47,
				    crtmemaddr:0,
				    crtcontroladdr:0,
				    keybufferaddr: 0,
				    progstateinfoaddr: 0,
				    keybuffersize: 119,
				    crtcon: crtconsttype [ 0, 0, 0, 0, 0, 0, 0,
							   0,0, 0, 0,0],
				    right{FS}:chr(28),
				    left{BS}:chr(8),
				    down{LF}:chr(10),    up{US}:chr(31),
				    badch{?}:chr(63),
				    chardel{BS}:chr(8),stop{DC3} :chr(19),
				    break{DLE}:chr(16),
				    flush{ACK}:chr(6),  eof{ETX}:chr(3),
				    altmode{ESC}:chr(27),
				    linedel{DEL}:chr(127),
				    backspace{BS}:chr(8),
				    etx:chr(3),prefix:chr(0),
				    prefixed:b14[14 of false],
				    cursormask : 0,     spare : 0]];

DEFAULT_ALPHACOLOR=1;


var

cpl:            shortint;
cppl:           shortint;
fb_fontchars:   shortint;
maxy:           shortint;
xcurs:          shortint;
ycurs:          shortint;
hascolor:       boolean;
midres:         boolean;
{ CATASM uses all variables above this point.  Don't modify.}

screenwidth:    shortint;
screenheight:   shortint;
maxx:           shortint;
screensize:     shortint;
defaulthighlight: shortint;
firsttimeinit:  boolean;               {DEW 01/04/89; DEFECT #FSDdt02039}

function   cromshort(offset:integer):shortint;external;
procedure  csetreg(register:integer; value:shortint);external;
procedure  csavecatenv(anyvar buffer:window);external;
procedure  crestorecatenv(anyvar buffer:window);external;
procedure  csetupcchar;external;
procedure  csetcolormap(indx:integer; r,g,b:integer);external;
procedure  cchar(c,x,y:shortint);external;
procedure  cursoroff; external;
procedure  cscrollup;external;
procedure  cscrolldown;external;
procedure  cclear(x,y,n:shortint);external;
procedure  cupdatecursor(x,y:shortint);external;
procedure  cbuildtable;external;
procedure  cshiftleft; external;
procedure  cshiftright; external;
procedure  cexchange( savearea: windowp; ymin, ymax, xmin, width: shortint);
	   external;
procedure  cscrollwindow( ymin, ymax, xmin, width: shortint); external;
procedure  cscrollwinddn( ymin, ymax, xmin, width: shortint); external;
procedure  cdbscrolll( ymin, ymax, xmin, width: shortint); external;
procedure  cdbscrollr( ymin, ymax, xmin, width: shortint); external;
procedure  cclearall; external;
procedure  cputfontchar(x,p,y : shortint; datap : fontdataptr;
	    oddbytes : boolean);external;
procedure  cprepdumpline(mybuf:windowp; size:shortint; rowstart:anyptr); external;

procedure dummy_setcmap(index:integer; r,g,b:integer);
begin
end;

procedure init_crtparams;
 begin
 if crtparams=NIL then
  new(crtparams);
 with crtparams^, screeninfo, iocontrol do
  begin
    charw:=0;
    charh:=0;
    fb_fontstartx:=0;
    fb_fontstarty:=0;
    fb_font_line_length:=0;
    fb_fontlines:=0;
    nfontchars:=0;
    fb_cursorx:=0;
    fb_cursory:=0;
    cursorcolor:=0;
    {{
    lowalphaplane:=0;
    {}
    highlight:=0;
    alphacolor:=1;
    creplrule0:=0;
    creplrule1:=3;
    cursreplrule0:=0;
    cursreplrule1:=3;
    togglealpha:=false;
    togglegraphics:=false;
    copy_under_cursor:=true;
    use_fib_xy:=true;
    disable_low_ctl:=false;
    disable_hi_ctl:=false;
    copy_to_abuf:=false;
    set_colormap_proc:=dummy_setcmap;
  end;
 end;

procedure dumpg ;
label 1;
const
  gwidth_lcc = 128;
  gwidth_hrx = 160;
  gbuffersize = gwidth_hrx + 7;

type
  gbyte = 0..255;
  row_def = packed array [0..maxint] of gbyte;

var
  row : ^row_def;

  abyte         : byte;
  gbuffer       : string[gbuffersize];
  lenstr        : string[3];
  i,j,rowstart  : integer;
  bitnum, charpos,datalen       : shortint;
begin

  row := anyptr(frameaddr);

  {
  write(gfiles[4]^,#27'*t150R');   { SET RESOLUTION 150 FOR DESKJET}
  {
  write(gfiles[4]^,#27'*t192R');   { SET RESOLUTION 192 FOR QUIETJET}
  write(gfiles[4]^,#27'*rA');   { initiate graphics sequence }

  gbuffer:=#27'*bxxxW'; {xxx will be replaced in cprepdumpline by actual
			 number of non-0 bytes in buffer}

  with crtparams^, screeninfo, iocontrol do
  begin
    datalen:=(dispw+7) div 8;
    rowstart:=0;
    for j := 0 to disph-1 do
      begin
	cprepdumpline(addr(gbuffer[8]), datalen, addr(row^[rowstart]));
	write(gfiles[4]^,gbuffer);
	if ioresult <> ord(inoerror) then goto 1;
	rowstart:=rowstart+fbwidth;
      end;
  end;

  write(gfiles[4]^,#27'*rB');   { terminate graphics sequence }
1:
end;


procedure doupdatecursor;
var stackbuf: packed array[1..catregbytes] of byte;
begin
  csavecatenv(stackbuf);
  cursoroff;
  cupdatecursor(xpos,ypos);
  crestorecatenv(stackbuf);
end;

procedure getxy(var x,y: integer);
begin
x := xpos;      y := ypos;
end;

procedure setxy(x, y: shortint);
begin
  if x>=screenwidth then xpos:=maxx
  else if x<0 then xpos:=0
  else xpos := x;
  if y>=screenheight then ypos:=maxy
  else if y<0 then ypos:=0
  else ypos := y;
end;

procedure clear(number: shortint);
var x,y: shortint;
    clearchars: shortint;
begin
  x:=xpos; y:=ypos;
  while number>0 do begin
    if maxx-x+1<number then
      clearchars:=maxx-x+1
    else
      clearchars:=number;
    cclear(x,y,clearchars);
    number:=number-clearchars;
    x:=0; if y<maxy then y:=y+1;
  end;
end;

function maptocrt(c:char):shortint;

{ Converts Katakana codes to their correct CRT font storage  codes.
  Note that the Yen symbol overlays the USASCII backslash (\). }
  procedure mapkanatocrt ;
  const
    yenromlocation = 188; { location of Yen symbol in font storage }
    yencode=92;
  begin
      if ord(c) = yencode then maptocrt := yenromlocation
      else if ord(c)<128 then maptocrt:=ord(c)
	     else maptocrt:= ord(c)+128;
  end; { mapkanatocrt }

begin
  if kbdlang = katakana_kbd then mapkanatocrt
  else maptocrt:=ord(c);
end;

function needs_setup(c:shortint):boolean; {already know c>=128 and c<144}
begin
  needs_setup:=false;
  with crtparams^, iocontrol do
    if ((c<136) and hascolor) or (not hascolor) then
      begin      {hilite request, color or mono}
	if ((highlight div 256) mod 2) <> (c mod 2) then
	  begin        {for inverse video. Underline is handled in cchar}
	    creplrule1:=3+9*(c mod 2);
	    needs_setup:=true;
	  end;
	if not hascolor then
	  highlight:=(c-128)*256
	else
	  highlight:=((highlight div 2048)*8 + (c-128))*256;
      end
    else
      begin    {set color request on color machine}
       alphacolor:=((c-136) {MOD 8}) + 1;
       cursorcolor:=alphacolor;
       highlight:=highlight mod 2048 + (c-136)*4096;
       needs_setup:=true;
      end;
end;    {needs_setup}


{Added bug fixes for "STOP" key. Symptom was that color would change to
 white from whatever it was if "STOP" key hit while idling in CI. Cause
 was that "Io" character in lower right corner, done by "kbdwaithook" was
 being interrupted by "STOP", and wasn't setting color back from white to
 "old" color. Any escape(-20) or escape(-28) from an ISR could also cause
 this symptom (see "interrupt" routine in POWERUP.TEXT for reasons.

 The fix is the same in all of docrtio, lineops and crtdebug: in essence we
 "protect" the H/W setup by setting level 7, then set the level back down to
 its old value to allow ISRs to execute, if they want. We put a try/recover
 around the main execution, as we can't afford to stay at level 7 for very
 long. This allows us to set level back own to old level during I/O, knowing
 we can restore the previous H/W state, because "STOP", etc will trigger the
 recover block. We do not try to complete the I/O if a "STOP" key hits during
 the driver; we merely try to restore the entry state of the CATSEYE H/W and
 system globals. We do not protect against NMI at all (this is very hard
 to do.)

 2 known "bugs": in the recover block, a second escape occurring before the
 setintlevel(7) will cause H/W restoration to not be executed, and another
 escape in the recovery anywhere after the setintlevel(7) and before the
 if.. then escape(savesc) will cause the first escapecode to be lost.

 SFB 5/31/88
}

procedure docrtio(fp: fibp; request: amrequesttype; anyvar buffer: window;
						   length, position: integer);
type
    cursor_affected_set=set of amrequesttype;
const
    cursor_affected=cursor_affected_set[setcursor, clearunit, writeeol,
					startwrite, writebytes];
var stackbuf: packed array[1..catregbytes] of byte;
    c: char;
    s: string[1];
    savesc, oldlevel: shortint; {to fix stopkey bug. SFB 5/31/88}
    change_cursor: boolean; {to shorten level 7 lockout time. SFB 5/31/88}
    buf: charptr;
begin

 change_cursor:=request in cursor_affected; {precompute for speed. SFB 5/31/88}

 savesc:=0;     {in case driver gets escaped away from, we clean up, then escape
		 with the correct escape code. SFB 5/31/88}
 oldlevel:=intlevel;    {so we can restore level after protecting "atomic operations".
			 SFB 5/31/88}

 setintlevel(7);        {prepare for "atomic operation". SFB 5/31/88}
   csavecatenv(stackbuf);

   if change_cursor then
    begin
      with crtparams^, iocontrol do
	alphacolor:=cursorcolor;
	 {KLUGE ALERT! This only  works because we define alphacolor
	 and cursorcolor to be always the same. It rescues the alphacolor in the case that
	 an ISR executed during lineops (when alphacolor<>cursorcolor), and did escape(-20),
	 not allowing lineops to put back the global describing alphacolor. It hasn't modified
	 cursorcolor, though, so we can recover alphacolor from it. NOTE: if cursorcolor is
	 ever made accessible outside this driver, this kluge should be removed, or changing
	 cursorcolor will magically change alphacolor.
	 SFB/DEW 5/31/88}
      cursoroff;
    end;

 try            {now ensure we get a chance to clean up if "STOP" key hits. SFB 5/31/88}
   setintlevel(oldlevel);  {finish "atomic operation" SFB 5/31/88}

   ioresult := ord(inoerror);
   buf := addr(buffer);
   with crtparams^, iocontrol do
   case request of
    setcursor: begin
		setxy(fp^.fxpos, fp^.fypos);
	       end;       {cupdatecursor is called at end of docrtio}
    getcursor: getxy (fp^.fxpos, fp^.fypos);
    flush:  {do nothing};
    unitstatus:  kbdio(fp, request, buffer, length, position);
    clearunit: begin      {will not clear screen content, as this is not appropriate}
		highlight := defaulthighlight;
		alphacolor:= default_alphacolor;
		cursorcolor:=alphacolor;
		creplrule1:=3;
		csetupcchar;
		setxy(0,0);
	       end;
    readtoeol:
      begin
      buf := addr(buf^, 1);
      buffer[0] := chr(0);
      while length>0 do
	begin
	kbdio(fp, readtoeol,  s, 1, 0);
	if      strlen(s)=0     then length := 0
	else  begin
	      length := length - 1;
	      crtio(fp, writebytes, s[1], 1, 0);
	      buf := addr(buf^, 1);
	      buffer[0] := chr(ord(buffer[0])+1);
	      end;
	end;
      end;
    startread,
    readbytes:
      begin
      while length>0 do
	begin
	kbdio(fp, readbytes,  buf^, 1, 0);
	if buf^ = chr(etx) then length := 0
			   else length := length - 1;
	if buf^ = eol then crtio(fp, writeeol,   buf^, 1, 0)
		      else crtio(fp, writebytes, buf^, 1, 0);
	buf := addr(buf^, 1);
	end;
      if request = startread then call(fp^.feot, fp);
      end;
    writeeol: begin
		  if ypos=maxy then cscrollup;
		  setxy(0, ypos+1);
	      end;
    startwrite,
    writebytes:
      begin
      while length>0 do
       begin
	 c:=buf^; buf:=addr(buf^,1); length:=length-1;

	 case c of
	 homechar:   setxy(0,0);
	 leftchar:   if (xpos = 0) and (ypos>0) then setxy(maxx, ypos-1)
		     else setxy(xpos-1, ypos);
	 rightchar:  if (xpos = maxx) and (ypos<maxy) then setxy(0, ypos+1)
		     else setxy(xpos+1, ypos);
	 upchar:     begin if ypos <= 1  then cscrolldown;
			   if ypos>0 then setxy(xpos, ypos-1);
		     end;
	 downchar:   if ypos=maxy then cscrollup
		     else setxy(xpos, ypos+1);
	 bellchar:   beep;
	 cteos:      clear(screensize-(ypos*screenwidth+xpos));
	 cteol:      clear(screenwidth-xpos);
	 clearscr:   begin setxy(0,0); clear(screensize); end;
	 eol:        setxy(0, ypos);
	 chr(etx):   length:=0;
	 otherwise   if (ord(c)>=128) and (ord(c)<144) then {display enhancement}
		       if needs_setup(ord(c)) then        {modified setup}
			 csetupcchar
		       else       {didn't modify setup, so do nothing}
		     else         {printable char}
		       begin
			cchar(maptocrt(c),xpos,ypos);
			if xpos = maxx then
			  begin
			    if ypos = maxy then cscrollup;
			    setxy(0, ypos+1);
			  end
			else setxy(xpos+1, ypos);
		       end;
	 end;     {case}
       end; {while}
      if request = startwrite then call(fp^.feot, fp);
      end;
    otherwise ioresult := ord(ibadrequest);
   end; {case}

 setintlevel(7);    {prepare for "atomic" cleanup operation" SFB 5/31/88}
 recover {SFB 5/31/88}
   begin
     setintlevel(7); {prepare for "atomic" cleanup operation". Possible bug:
		      What if interrupt hits in recover block before setintlevel(7)
		      executes? We would lose chance to restore H/W setup.}
     savesc:=escapecode;   {so we can "transparently" let escape through}
     csetupcchar;       {added 11/17/88 to set up environment for cupdatecursor,
			 in case STOP was hit during scroll, etc, where CATSEYE
			 setup is different. SFB/DEW}
   end;


   if change_cursor then        {SFB 5/31/88}
   begin
      cupdatecursor(xpos,ypos); {no change, but see comment in recover block about
				 csetupcchar. SFB/DEW 11/17/88}
   end;
   crestorecatenv(stackbuf);

 setintlevel(oldlevel); {finish at level we started at. SFB 5/31/88}

 if savesc<>0 then
   escape(savesc);  {possible bug: what if interrupt hits during intlevel 7?
		     We would never execute this code. SFB 5/31/88}

end;    {docrtio}

procedure lineops(op: crtllops; anyvar position: integer; c: char);

var stackbuf: packed array[1..catregbytes] of byte;
    i,oldhilite,oldcolor,oldrule: shortint;
    savesc, oldlevel: shortint; {to fix stopkey bug. SFB 5/31/88}
    sptr: ^string255;

begin

savesc:=0;     {in case driver gets escaped away from, we clean up, then escape
		with the correct escape code. SFB 5/31/88}
oldlevel:=intlevel;    {so we can restore level after protecting "atomic operations".
			SFB 5/31/88}

setintlevel(7);        {prepare for "atomic operation". SFB 5/31/88}
  with crtparams^, iocontrol do
   begin
     oldrule:=creplrule1;
     oldcolor:=alphacolor;
     oldhilite:=highlight;
     creplrule1:=3;        {no enhancements supported in lastline}
     alphacolor:=default_alphacolor;      {only white in last line}
    {cursorcolor:=alphacolor;             {no cursor in last line}
     highlight:=defaulthighlight;
   end;

  csavecatenv(stackbuf);

try            {now ensure we get a chance to clean up if "STOP" key hits. SFB 5/31/88}
  setintlevel(oldlevel);  {finish "atomic operation" SFB 5/31/88}

case op of

  cllput: cchar(maptocrt(c), position, screenheight);

  cllshiftl:
     begin
       cshiftleft;
       cchar(ord(' '), maxx-8, screenheight);
     end;

  cllshiftr:
     begin
       cshiftright;
       cchar(ord(' '), 0, screenheight);
     end;

  cllclear: cclear(0, screenheight, maxx-7);

  clldisplay:
     begin
       sptr:=addr(position);
       for i:=1 to strlen(sptr^) do
	 cchar(maptocrt(sptr^[i]), i-1, screenheight);
       for i:=strlen(sptr^) to (maxx-8) do
	 cchar(ord(' '), i, screenheight);
     end;

  putstatus:  cchar(ord(c), maxx-7+position, screenheight);

end; { of case }

setintlevel(7);    {prepare for "atomic" cleanup operation" SFB 5/31/88}
recover {SFB 5/31/88}
  begin
    setintlevel(7); {prepare for "atomic" cleanup operation". Possible bug:
		     What if interrupt hits in recover block before setintlevel(7)
		     executes? We would lose chance to restore H/W setup.}
    savesc:=escapecode;   {so we can "transparently" let escape through}
  end;

  with crtparams^, iocontrol do
   begin
    creplrule1:=oldrule;
    alphacolor:=oldcolor;
    highlight:=oldhilite;
   end;

  crestorecatenv(stackbuf);

 setintlevel(oldlevel); {finish at level we started at. SFB 5/31/88}

 if savesc<>0 then
   escape(savesc);  {possible bug: what if interrupt hits during intlevel 7?
		     We would never execute this code. SFB 5/31/88}

end;

procedure crtdebug(op: dbcrtops; var dbrec: dbcinfo);
type
    cursor_affected_set=set of dbcrtops;
const
    cursor_affected=cursor_affected_set[dbgotoxy, dbscrollup, dbscrolldn,
					dbscrolll, dbscrollr, dbput, dbclear,
					dbcline, dbexcg];

type
  iptr = ^iarray;
  iarray = array[0..maxint] of shortint;

var stackbuf: packed array[1..catregbytes] of byte;
    {oldalphacolor and oldcursorcolor keep track of alpha and cursor colors
     separately, because if a linops call is interrupted by another use of the
     driver, it may have left alphacolor<>cursorcolor, so restoring cursorcolor:=
     alphacolor at the end of this routine is a Bad Thing.
     Note also that calling the tm in the middle of the lineops execution may
     cause a similar problem, as lastline color might be different from alphacolor,
     and cursorcolor will still == alphacolor.
     SFB/DEW 5/31/88}
    i, oldhilite, oldalphacolor, oldcursorcolor, oldrule: shortint;
    j: integer;
    savesc, oldlevel: shortint; {to fix stopkey bug. SFB 5/31/88}
    change_cursor: boolean; {to shorten level 7 lockout time. SFB 5/31/88}
    tempaddr : integer;

begin

{Need to do following steps BEFORE csavecatenv, as they will affect driver
 setup via drop-through to setupcchar}

 change_cursor:=op in cursor_affected; {precompute for speed. SFB 5/31/88}

 savesc:=0;     {in case driver gets escaped away from, we clean up, then escape
		 with the correct escape code. SFB 5/31/88}
 oldlevel:=intlevel;    {so we can restore level after protecting "atomic operations".
			 SFB 5/31/88}

 setintlevel(7);        {prepare for "atomic operation". SFB 5/31/88}
   with crtparams^, iocontrol do
    begin
     oldrule:=creplrule1;     {to restore for later}
     oldalphacolor:=alphacolor;        {ditto}
     oldcursorcolor:=cursorcolor;      {ditto}
     oldhilite:=highlight;

    {set up debugger window conditions}
     highlight:=dbrec.debughighlight;

    {set relprule to 3 (regular) or 12 (inverse video)}
     creplrule1:=3+9*((highlight div 256) mod 2);
     if hascolor then
       begin
	{set color according to debugwindow}
	 alphacolor:=((highlight div 4096) mod 8) + 1;
	 cursorcolor:=alphacolor;
       end;
    end;

   {This also sets up color and inverse/forward video in driver, via drop-
    through to setupcchar}
   csavecatenv(stackbuf);

with dbrec do
  if change_cursor then
   begin
    cursoroff;
    xcurs:=cursx;
    ycurs:=cursy;
   end;

try            {now ensure we get a chance to clean up if "STOP" key hits. SFB 5/31/88}
  setintlevel(oldlevel);  {finish "atomic operation" SFB 5/31/88}

with dbrec do begin

  case op of

    dbinfo: with crtparams^.screeninfo do
	      begin
		savesize:=(xmax-xmin+1)*(ymax-ymin+1)*charw*charh;
	      end;

    dbgotoxy: begin {Implemented by prior call to cursoroff, and following
		     call to cupdatecursor}
	      end;

    dbscrollup: begin
		  cscrollwindow( ymin, ymax, xmin, xmax-xmin+1);
		  cclear(xmin, ymax, xmax-xmin+1);
		end;

    dbscrolldn: begin
		  cscrollwinddn(ymin, ymax, xmin, xmax-xmin+1);
		  cclear(xmin, ymin, xmax-xmin+1);
		end;

    dbscrolll: begin
		 cdbscrolll(ymin, ymax, xmin, xmax-xmin+1);
		 for i:=ymin to ymax do
		   cchar (ord(' '), xmax, i);
	       end;

    dbscrollr: begin
		 cdbscrollr(ymin, ymax, xmin, xmax-xmin+1);
		 for i:=ymin to ymax do
		   cchar (ord(' '), xmin, i);
	       end;

    dbhighl: ; { Not implemented for color bitmap displays }

    dbput: begin
	     if charismapped then
	       cchar( maptocrt(c), cursx, cursy)
	     else
	       cchar( ord(c), cursx, cursy);
	   end;

    dbclear:
      for i:=ymin to ymax do
	cclear( xmin, i, xmax-xmin+1);

    dbcline: cclear( cursx, cursy, xmax-cursx+1);

    dbinit:
      begin
	for j:=0 to (savesize div 2)-1 do
	 iptr(savearea)^[j]:=0;
	cursx:=xmin; cursy:=ymin;
	areaisdbcrt:=false;
	charismapped:=false;
	debughighlight:=0;
      end;

    dbexcg:
      with crtparams^, iocontrol do
       begin
	cexchange( savearea, ymin, ymax, xmin,
		 (xmax-xmin+1)*crtparams^.screeninfo.charw);
	areaisdbcrt:=not areaisdbcrt;
	if areaisdbcrt then
	 begin
	  if hascolor then   {set cursor color according to debugwindow}
	    cursorcolor:=((highlight div 4096) mod 8) + 1;
	  xcurs:=cursx;
	  ycurs:=cursy;
	 end
	else
	 begin
	  if hascolor then   {set cursor color according to alpha window}
	    cursorcolor:=oldcursorcolor;
	  xcurs:=xpos;
	  ycurs:=ypos;
	 end;
       end;

  end; { of case }

end; { of with }

setintlevel(7);    {prepare for "atomic" cleanup operation" SFB 5/31/88}
recover {SFB 5/31/88}
  begin
    setintlevel(7); {prepare for "atomic" cleanup operation". Possible bug:
		     What if interrupt hits in recover block before setintlevel(7)
		     executes? We would lose chance to restore H/W setup.}
    savesc:=escapecode;   {so we can "transparently" let escape through}
    csetupcchar;       {added 11/17/88 to set up environment for cupdatecursor,
			in case STOP was hit during scroll, etc, where CATSEYE
			setup is different. SFB/DEW}
  end;

  if change_cursor then
    cupdatecursor(xcurs, ycurs);{possibly with new cursor color}
				{no change, but see comment in recover block about
				 csetupcchar. SFB/DEW 11/17/88}
  with crtparams^, iocontrol do
   begin
    creplrule1:=oldrule;
    highlight:=oldhilite;
    alphacolor:=oldalphacolor;
    cursorcolor:=oldcursorcolor;
   end;

  crestorecatenv(stackbuf);

setintlevel(oldlevel); {finish at level we started at. SFB 5/31/88}

if savesc<>0 then
 escape(savesc);  {possible bug: what if interrupt hits during intlevel 7?
		   We would never execute this code. SFB 5/31/88}

end; { crtdebug procedure }

procedure dummy;
begin end;

procedure loadfont(fax,fay,faw,fah : integer);
type
    barray=packed array[0..maxint] of byte;
    cursorconstyp=packed array[0..39] of byte;

const
    oddbyte=true;               {font ROM contains data only at odd addresses}
    blk_lcc_cursorconst=cursorconstyp[{255,14 of 129,25 of 255}
	126,14 of 255,126,24 of 255];
    lcc_cursorconst=cursorconstyp[13 of 0, 2 of 255, 1 of 0,24 of 255];
    blk_hrx_cursorconst=cursorconstyp[127, 128, 36 of 255, 127, 128];
    hrx_cursorconst=cursorconstyp[34 of 0, 4 of 255, 2 of 0];
    spacecurs=cursorconstyp[40 of 0];
var
    t, id, td, ttd,
    i, j, nfonts, firstchar, lastchar, mask : integer;
    tfontc  : ^barray;
    pcursor : fontdataptr;
    c:char;     {REMOVE}
begin
 with crtparams^, screeninfo, iocontrol do
  begin
   fb_fontstartx:=fax;          {save this info for system use}
   fb_fontstarty:=fay;
   fb_font_line_length:=faw;
   td:=cromshort(hex('3b'));     {start of font storage}
   ttd:=td;
   tfontc:=anyptr(bitmapaddr+td);
   nfonts:=tfontc^[0];
   nfontchars:=0;               {save this info for system use}
   for i:=1 to nfonts do
    begin
     tfontc:=anyptr(bitmapaddr+td);
     id:=tfontc^[6*(i-1)+2];
     if id<>0 then
      begin
       ttd:=cromshort(td+4+(i-1)*6);
       tfontc:=anyptr(bitmapaddr+ttd);
       charh:=tfontc^[0];       {save this info for for system use}
       charw:=tfontc^[2];       {save this info for for system use}
       firstchar:=tfontc^[6];
       lastchar:=tfontc^[8];
       cppl:=(faw div charw);
       cpl:=0;
       mask:=planes;
       while mask <> 0 do
	begin
	 cpl:=cpl+cppl;
	 mask:=mask div 2;
	end;
       for j:=firstchar to lastchar do
	begin
	 {general computations of where font char is located in
	      graphics ROM space, and where it goes in framebuf}
	 cputfontchar(
	  fax+(nfontchars mod cppl)*charw,
	  (nfontchars mod cpl) div cppl,
	  fay+(nfontchars div cpl)*charh,
	  addr(tfontc^
	   [10+(j-firstchar)*(1+ord(oddbyte))*((charw+7) div 8)*charh]),
	  oddbyte);
	 nfontchars:=nfontchars+1;
	end;    {for j:=firstchar to lastchar}
      end;    {if id <> 0}
    end;    {for i:=1 to nfonts do}
   {{
   fontproc:=cfontproc;
   {}
   fb_fontlines:=((nfontchars-1) div cpl)+1;
   fb_fontchars:=nfontchars;
   fb_cursorx:=fax+faw;
   fb_cursory:=fay;
   if midres then
    begin
     pcursor:=addr(blk_lcc_cursorconst);
     {{
     pcursor:=addr(lcc_cursorconst);
     {}
    end
   else
    begin
     {{
     pcursor:=addr(hrx_cursorconst);
     {}
     pcursor:=addr(blk_hrx_cursorconst);
    end;

   cputfontchar(fb_cursorx,-1,fb_cursory,pcursor,false);   {cursor pattern}

   {now clear the saved character, in case it's not yet clear}
   cputfontchar(fb_cursorx+charw,-1,fb_cursory,addr(spacecurs),false);

   csetreg(tcwen1,-1);          {be nice to later catseye users}
   csetreg(prr,3*256);          {be nice to later catseye users}
  end;   {with crtinfo^.screeninfo}
end;   {loadfont}

procedure getcrtinfo;
var stackbuf: packed array[1..catregbytes] of byte;
begin
 with crtparams^, screeninfo, iocontrol do
  begin
   cbuildtable;

   csavecatenv(stackbuf);       {to set up cchar}
   if midres then
    loadfont(offx,offy,512,offh)
   else
    loadfont(offx,offy,740,offh);
   {}
   hascolor:=planes<>1;
   {}
   alphacolor:=1;
   cursorcolor:=alphacolor;

   {
     DEW 01/04/89; DEFECT #FSDdt02039
     User can programatically adjust screen height/width on bit map displays.
     This is accomplished by the user changing height and width in
     syscom^.crtinfo and calling the sysdevs hook, crtinithook.  This code
     used to always copy in environc into syscom, making height/width fixed.
     Now, if this is not the power up init (new flag firsttimeinit) then use
     the user supplied values of height and width.

     Note other values in this record are not examined.  To maintain
     compatibility with bobcat, these values are not reset to their
     original and correct values either.
   }
   if firsttimeinit then
   begin
     printh:=((disph-charh) DIV charh)*charh; {should be done in cbuildtable.
					       See note in CATASM. SFB}
     maxx:=(printw div charw)-1;
     maxy:=(printh div charh)-1;
     screenwidth:=maxx+1;
     screenheight:=maxy+1;
   end
   else
   begin
     screenwidth :=syscom^.crtinfo.width;
     screenheight:=syscom^.crtinfo.height;
     maxx := screenwidth-1;
     maxy := screenheight-1;
     printw := (maxx+1)*charw;
     printh := (maxy+1)*charh;
   end;
   screensize:=screenwidth*screenheight;
   cursreplrule0:=5;
   cursreplrule1:=6;
   copy_under_cursor:=true;
   set_colormap_proc:=csetcolormap;
   setxy(0,0);
   cupdatecursor(0,0);
   crestorecatenv(stackbuf);
  end;
end;

procedure catseyeinit;
 var i: shortint;
     achar:char;
     stackbuf: packed array[1..catregbytes] of byte;

 begin
 init_crtparams;
 if firsttimeinit then                 {DEW 01/04/89; DEFECT #FSDdt02039}
    syscom^:=environc;
 idle:=245;                          { set io char to roman8 value }
 with syscom^.crtinfo do
  begin
   getcrtinfo;

   height:=screenheight;
   defaulthighlight:=0;
   dumpalphahook := dumpg;
   dumpgraphicshook := dumpg;
   updatecursorhook:=doupdatecursor;
   crtiohook:=docrtio;
   dbcrthook:=crtdebug;
   crtllhook:=lineops;
   crtinithook:=catseyeinit;
   togglealphahook:=dummy;
   togglegraphicshook:=dummy;
   currentcrt:=bitmaptype;
   keybuffer^.maxsize:=maxx-8;
  end;
end;


function catseyetype:boolean;

const newbitmapid=57; {primary id for new bitmap displays}
      LCCid=5;  {Low Cost Catseye secondary id}
      HRCid=6;  {High Resolution Color Catseye  secondary id}
      HRMid=7;  {High Resolution Monochrome Catseye secondary id}
var ptr: ^shortint;
    i: shortint;
    dummy: shortint;
    found: boolean;

begin

found:=false;

{check DIO I space}
ptr:=anyptr(hex('560000'));

try
  dummy:=ptr^;
  if (dummy mod 128) = newbitmapid then begin
    ptr:=anyptr(integer(ptr)+20);  { look at secondary id }
    dummy:=ptr^ mod 128;
    midres:=(dummy=LCCid);
    if (dummy>=LCCid) and (dummy<=HRMid) then begin
     found:=true; bitmapaddr:=integer(ptr)-20;
    end;
  end;
recover
  if escapecode<>-12 then escape(escapecode);

if  found  then
 begin
  firsttimeinit := true;                {DEW 01/04/89; DEFECT #FSDdt02039}
  catseyeinit;
  firsttimeinit := false;               {DEW 01/04/89; DEFECT #FSDdt02039}
 end;
catseyetype:=found;
end;  { catseyetype }


end;  { of module }

import catseyedvr, loader;

begin
  if catseyetype then begin
  markuser;
  end;
end.

@


55.1
log
@Automatic bump of revision number for PWS version 3.25A
@
text
@@


54.1
log
@Automatic bump of revision number for PWS version 3.24
@
text
@@


53.1
log
@Automatic bump of revision number for PWS version 3.24B
@
text
@@


52.1
log
@Automatic bump of revision number for PWS version 3.24A
@
text
@@


51.1
log
@Automatic bump of revision number for PWS version 3.24d
@
text
@@


50.1
log
@Automatic bump of revision number for PWS version 3.23c
@
text
@@


49.1
log
@Automatic bump of revision number for PWS version 3.24b
@
text
@@


48.1
log
@Automatic bump of revision number for PWS version 3.24a
@
text
@@


47.1
log
@Automatic bump of revision number for PWS version 3.23
@
text
@@


46.1
log
@Automatic bump of revision number for PWS version 3.23
@
text
@@


45.1
log
@Automatic bump of revision number for PWS version 3.23C
@
text
@@


44.1
log
@Automatic bump of revision number for PWS version 3.23B
@
text
@@


43.1
log
@Automatic bump of revision number for PWS version 3.23aA
@
text
@@


42.1
log
@Automatic bump of revision number for PWS version 3.23e
@
text
@@


41.1
log
@Automatic bump of revision number for PWS version 3.23d
@
text
@@


40.1
log
@Automatic bump of revision number for PWS version 3.23c
@
text
@@


39.1
log
@Automatic bump of revision number for PWS version 3.23b
@
text
@@


38.1
log
@Automatic bump of revision number for PWS version 3.23a
@
text
@@


37.1
log
@Automatic bump of revision number for PWS version 3.3a
@
text
@@


36.1
log
@Automatic bump of revision number for PWS version 3.22
@
text
@@


35.1
log
@Automatic bump of revision number for PWS version 3.22
@
text
@@


34.1
log
@Automatic bump of revision number for PWS version 3.22
@
text
@@


33.1
log
@Automatic bump of revision number for PWS version 3.22D
@
text
@@


32.1
log
@Automatic bump of revision number for PWS version 3.22C
@
text
@@


31.2
log
@Fixed DEFECT #FSDdt02039
'Can not programmatically adjust screen height'
@
text
@@


31.1
log
@Automatic bump of revision number for PWS version 3.22B
@
text
@d228 1
d235 1
a1026 2
   printh:=((disph-charh) DIV charh)*charh; {should be done in cbuildtable.
					     See note in CATASM. SFB}
d1032 32
a1063 4
   maxx:=(printw div charw)-1;
   maxy:=(printh div charh)-1;
   screenwidth:=maxx+1;
   screenheight:=maxy+1;
d1082 2
a1083 1
 syscom^:=environc;
d1139 1
d1141 1
@


30.1
log
@Automatic bump of revision number for PWS version 3.22A
@
text
@@


29.3
log
@Enabled $SEARCH directive, and inserted "INIT2:" into $include directive.
Scott
@
text
@@


29.2
log
@Fixes with Dave Willis for the "Philips" bugs. Scott
@
text
@d30 1
a30 1
{{
d48 6
d164 1
a164 1
$include 'CATREGS'$
@


29.1
log
@Automatic bump of revision number for PWS version 3.22b
@
text
@d30 1
a30 1
{}
d158 1
a158 1
$include 'INIT2:CATREGS'$
d603 3
d608 1
d610 4
a613 1
    cupdatecursor(xpos,ypos);
d880 3
d886 3
a888 2
    cupdatecursor(xcurs, ycurs);        {possibly with new cursor color}

@


28.2
log
@
ipws2rcs automatic delta on Mon Oct 31 10:34:17 MST 1988
:w
:q
@
text
@@


28.1
log
@Automatic bump of revision number for PWS version 3.3b
@
text
@d30 1
a30 1
{{
d158 1
a158 1
$include 'CATREGS'$
@


27.1
log
@Automatic bump of revision number for PWS version 3.3a
@
text
@@


26.1
log
@Automatic bump of revision number for PWS version 3.3 Synch
@
text
@@


25.5
log
@Removed dumpsaveinfo procedure (which was not being called). This was a 
debug time procedure, and was not used in production. SFB
@
text
@@


25.4
log
@Added many bug fixes, notably reentrancy fixes among tm, lastline and debug
windows. See also CATASM.
@
text
@a344 41
procedure dumpsaveinfo(anyvar b:window);
type trix=record case integer of
       0: (wptr : ^shortint);
       1: (bptr : ^byte);
     end;
var p : trix;
    i : integer;
    c : char;
begin
 p.wptr:=addr(b);
 writeln('rugcmd        ',p.wptr^:1);
 p.wptr:=addr(p.wptr^,2);
 writeln('wmwidth       ',p.wptr^:1);
 p.wptr:=addr(p.wptr^,2);
 writeln('wmheight      ',p.wptr^:1);
 p.wptr:=addr(p.wptr^,2);
 writeln('wmsourcex     ',p.wptr^:1);
 p.wptr:=addr(p.wptr^,2);
 writeln('wmsourcey     ',p.wptr^:1);
 p.wptr:=addr(p.wptr^,2);
 writeln('wmdestx       ',p.wptr^:1);
 p.wptr:=addr(p.wptr^,2);
 writeln('wmdesty       ',p.wptr^:1);
 p.wptr:=addr(p.wptr^,2);
 writeln('fben1         ',p.wptr^:1);
 p.wptr:=addr(p.wptr^,2);
 writeln('tcren1        ',p.wptr^:1);
 p.wptr:=addr(p.wptr^,2);
 for i:=1 to 8 do
  begin
   writeln('wrr ',i:1,'     ',p.bptr^:1);
   p.wptr:=addr(p.wptr^,1);
  end;
 writeln('tcwen1        ',p.wptr^:1);
 p.wptr:=addr(p.wptr^,2);
 writeln('planemode     ',p.wptr^:1);
 write('press a key');
 read(c);
 writeln;
end;

@


25.3
log
@First QA rev of CATSEYE support for 3.21
@
text
@a20 1
$TABLES$
d31 1
a31 1
$search  'INITLOAD','ASM','INIT','SYSDEVS','CATASM'$
d162 1
a162 1
  catregbytes=36;
d471 26
d507 2
d512 1
a512 1
 csavecatenv(stackbuf);
d514 4
a517 2
 if request in cursor_affected then
  cursoroff;
d519 4
a522 19
 ioresult := ord(inoerror);
 buf := addr(buffer);
 with crtparams^, iocontrol do
 case request of
  setcursor: begin
	      setxy(fp^.fxpos, fp^.fypos);
	     end;       {cupdatecursor is called at end of docrtio}
  getcursor: getxy (fp^.fxpos, fp^.fypos);
  flush:  {do nothing};
  unitstatus:  kbdio(fp, request, buffer, length, position);
  clearunit: begin      {will not clear screen content, as this is not appropriate}
	      highlight := defaulthighlight;
	      alphacolor:= default_alphacolor;
	      cursorcolor:=alphacolor;
	      creplrule1:=3;
	      csetupcchar;
	      setxy(0,0);
	     end;
  readtoeol:
d524 11
a534 13
    buf := addr(buf^, 1);
    buffer[0] := chr(0);
    while length>0 do
      begin
      kbdio(fp, readtoeol,  s, 1, 0);
      if      strlen(s)=0     then length := 0
      else  begin
	    length := length - 1;
	    crtio(fp, writebytes, s[1], 1, 0);
	    buf := addr(buf^, 1);
	    buffer[0] := chr(ord(buffer[0])+1);
	    end;
      end;
d536 23
a558 4
  startread,
  readbytes:
    begin
    while length>0 do
a559 5
      kbdio(fp, readbytes,  buf^, 1, 0);
      if buf^ = chr(etx) then length := 0
			 else length := length - 1;
      if buf^ = eol then crtio(fp, writeeol,   buf^, 1, 0)
		    else crtio(fp, writebytes, buf^, 1, 0);
d561 12
d574 24
a597 12
    if request = startread then call(fp^.feot, fp);
    end;
  writeeol: begin
		if ypos=maxy then cscrollup;
		setxy(0, ypos+1);
	    end;
  startwrite,
  writebytes:
    begin
    while length>0 do
     begin
       c:=buf^; buf:=addr(buf^,1); length:=length-1;
d599 8
a606 30
       case c of
       homechar:   setxy(0,0);
       leftchar:   if (xpos = 0) and (ypos>0) then setxy(maxx, ypos-1)
		   else setxy(xpos-1, ypos);
       rightchar:  if (xpos = maxx) and (ypos<maxy) then setxy(0, ypos+1)
		   else setxy(xpos+1, ypos);
       upchar:     begin if ypos <= 1  then cscrolldown;
			 if ypos>0 then setxy(xpos, ypos-1);
		   end;
       downchar:   if ypos=maxy then cscrollup
		   else setxy(xpos, ypos+1);
       bellchar:   beep;
       cteos:      clear(screensize-(ypos*screenwidth+xpos));
       cteol:      clear(screenwidth-xpos);
       clearscr:   begin setxy(0,0); clear(screensize); end;
       eol:        setxy(0, ypos);
       chr(etx):   length:=0;
       otherwise   if (ord(c)>=128) and (ord(c)<144) then {display enhancement}
		     if needs_setup(ord(c)) then        {modified setup}
		       csetupcchar
		     else       {didn't modify setup, so do nothing}
		   else         {printable char}
		     begin
		      cchar(maptocrt(c),xpos,ypos);
		      if xpos = maxx then
			begin
			  if ypos = maxy then cscrollup;
			  setxy(0, ypos+1);
			end
		      else setxy(xpos+1, ypos);
d608 28
a635 6
       end;     {case}
     end; {while}
    if request = startwrite then call(fp^.feot, fp);
    end;
  otherwise ioresult := ord(ibadrequest);
 end; {case}
d637 8
a644 2
 if request in cursor_affected then
  cupdatecursor(xpos,ypos);
d646 3
a648 1
 crestorecatenv(stackbuf);
d650 6
d662 1
d667 4
a670 9
with crtparams^, iocontrol do
 begin
   oldrule:=creplrule1;
   creplrule1:=3;        {no enhancements supported in lastline}
   oldcolor:=alphacolor;
   alphacolor:=default_alphacolor;      {white only in last line}
  {cursorcolor:=alphacolor;             {no cursor in last line}
   oldhilite:=highlight; highlight:=defaulthighlight;
 end;
d672 11
a682 1
csavecatenv(stackbuf);
d684 5
d720 8
a727 6
with crtparams^, iocontrol do
 begin
  creplrule1:=oldrule;
  alphacolor:=oldcolor;
  highlight:=oldhilite;
 end;
d729 6
a734 1
crestorecatenv(stackbuf);
d736 8
d759 9
a767 1
    i, oldhilite, oldcolor, oldrule: shortint;
d769 2
d778 1
a778 5
with crtparams^, iocontrol do
 begin
  oldrule:=creplrule1;     {to restore for later}
  oldcolor:=alphacolor;        {ditto}
  oldhilite:=highlight;
d780 4
a783 2
 {set up debugger window conditions}
  highlight:=dbrec.debughighlight;
d785 2
a786 3
 {set relprule to 3 (regular) or 12 (inverse video)}
  creplrule1:=3+9*((highlight div 256) mod 2);
  if hascolor then
d788 16
a803 3
     {set color according to debugwindow}
      alphacolor:=((highlight div 4096) mod 8) + 1;
      cursorcolor:=alphacolor;
a804 1
 end;
d806 3
a808 3
{This also sets up color and inverse/forward video in driver, via drop-
 through to setupcchar}
csavecatenv(stackbuf);
d810 2
a811 3
with dbrec do begin

  if op in cursor_affected then
d818 5
d897 1
a897 1
	    cursorcolor:=oldcolor {==((oldhilite div 4096) mod 8) + 1};
d905 12
a916 1
  if op in cursor_affected then
d919 7
a925 1
end; { of with }
d927 1
a927 1
crestorecatenv(stackbuf);
d929 5
a933 7
with crtparams^, iocontrol do
 begin
  creplrule1:=oldrule;
  highlight:=oldhilite;
  alphacolor:=oldcolor;
  cursorcolor:=oldcolor;
 end;
@


25.2
log
@Early3.21 version. Seems fully functional on all 3 models. No known bugs.
SFB
@
text
@d21 1
d35 14
d118 5
a122 5
	       highlight       : byte;     {bit fielded:
						 b0 = inverse,
						 b1 = underline
						 b2 = flash,
						 b3 = halfbright}
d210 3
a228 1
highlight:      shortint;
d431 9
a439 9
procedure mapkanatocrt ;
const
  yenromlocation = 188; { location of Yen symbol in font storage }
  yencode=92;
begin
    if ord(c) = yencode then maptocrt := yenromlocation
    else if ord(c)<128 then maptocrt:=ord(c)
	   else maptocrt:= ord(c)+128;
end; { mapkanatocrt }
d446 26
a482 1
    I:INTEGER;
d484 1
d486 1
d500 1
a500 1
  clearunit: begin
d502 4
a506 3
	      {{
	      cclearall;
	      {}
d561 4
a564 4
       cteos:     clear(screensize-(ypos*screenwidth+xpos));
       cteol:     clear(screenwidth-xpos);
       clearscr:  begin setxy(0,0); clear(screensize); end;
       eol:       setxy(0, ypos);
d566 5
a570 1
       otherwise   if (ord(c)>=128) and (ord(c)<136) then
d572 8
a579 24
		       if (highlight mod 2) <> (ord(c) mod 2) then
			 begin
			   creplrule1:=15-creplrule1;
			   csetupcchar;
			 end;
		       highlight:=(ord(c)-128);
		     end
		   else
		     if (ord(c)>=136) and (ord(c)<144) and (hascolor) then
		       begin
			alphacolor:=ord(c)-136;
			cursorcolor:=alphacolor;
			csetupcchar;
		       end
		     else
		       begin
			cchar(maptocrt(c),xpos,ypos);
			if xpos = maxx then
			  begin
			    if ypos = maxy then cscrollup;
			    setxy(0, ypos+1);
			  end
			else setxy(xpos+1, ypos);
		       end;
d589 1
d597 1
a597 1
    i,j: shortint;
d602 10
a613 2
j:=highlight; highlight:=defaulthighlight;

d644 8
a651 1
highlight:=j;
d669 1
a669 1
    i: shortint;
d674 25
a714 7
	       {{
		WRITELN('SAVESIZE ',(((xmax-xmin+1)*charw+7) DIV 8)*(ymax-ymin+1)*charh:8);
	       {{
		if not hascolor then            {use bit/pixel mode}
	       {{
		 savesize:=(((xmax-xmin+1)*charw+7) DIV 8)*(ymax-ymin+1)*charh;
	       {}
d717 2
a718 1
    dbgotoxy: begin
a745 1
	     i:=highlight; highlight:=debughighlight;
a749 1
	     highlight:=i;
d769 2
a770 1
      begin
d776 2
d783 2
d788 1
a788 1
      end;
d791 1
d793 1
a793 1
    cupdatecursor(xcurs, ycurs);
d798 9
d822 2
a823 2
    blk_hrc_cursorconst=cursorconstyp[127, 128, 36 of 255, 127, 128];
    hrc_cursorconst=cursorconstyp[34 of 0, 4 of 255, 2 of 0];
d894 1
a894 1
     pcursor:=addr(hrc_cursorconst);
d896 1
a896 1
     pcursor:=addr(blk_hrc_cursorconst);
d900 1
d902 1
a903 1
   cputfontchar(fb_cursorx+charw,-1,fb_cursory,addr(spacecurs),false);
d923 1
d925 1
a956 1
   highlight:=0;
@


25.1
log
@Automatic bump of revision number for PWS version 3.2Y
@
text
@d30 1
a30 1
{}
a83 1
	       pad6type        = 0..63; {6 bits}
a114 3
	       {{
	       pad6            : pad6type;     {force following flags onto
						byte boundary }
a205 4
{{
fontwidth:      shortint;
fontht:         shortint;
{}
a274 1
    pad1:=false;        {REMOVE}
d302 1
d440 1
a449 1
  {uwait: ;              }
d458 2
d461 1
a470 1
    { else if s[1] = chr(etx) then length := 0 }
d641 3
d645 3
a647 1
		 savesize:=(savesize+7) div 8;
d704 2
a705 7
	if hascolor then
	  cexchange( savearea, ymin, ymax, xmin,
		    (xmax-xmin+1)*crtparams^.screeninfo.charw)
	else
	  {move by words at bit/pixel}
	  cexchange( savearea, ymin, ymax, xmin,
		    (((xmax-xmin+1)*crtparams^.screeninfo.charw)+3) div 4);
a784 7
	 {{
	 WRITELN(
	  fax+(nfontchars mod cppl)*charw:10,
	  (nfontchars mod cpl) div cppl:10,
	  fay+(nfontchars div cpl)*charh:10,
	  NFONTCHARS:10);
	 {}
a791 3
	 {{
	 FOR T:=1 TO 100000 DO;
	 {}
a828 1
    c:char;     {REMOVE}
a837 3
    {{
    loadfont(0,800,740,offh);
    {}
a885 1
   {}
d929 1
a929 1
end;  { of module -- I hope }
@


24.1
log
@Initial checkin to RCS
@
text
@@


1.1
log
@Initial revision
@
text
@@
