head     56.3;
access   ;
symbols  ;
locks    ; strict;
comment  @# @;


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

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

56.1
date     91.11.05.09.42.45;  author jwh;  state Exp;
branches ;
next     55.5;

55.5
date     91.11.04.15.55.44;  author jwh;  state Exp;
branches ;
next     55.4;

55.4
date     91.10.27.10.40.49;  author cfb;  state Exp;
branches ;
next     55.3;

55.3
date     91.10.16.10.30.11;  author cfb;  state Exp;
branches ;
next     55.2;

55.2
date     91.08.27.09.15.08;  author cfb;  state Exp;
branches ;
next     55.1;

55.1
date     91.08.25.10.20.59;  author jwh;  state Exp;
branches ;
next     1.4;

1.4
date     91.08.12.13.27.03;  author cfb;  state Exp;
branches ;
next     1.3;

1.3
date     91.08.08.08.53.44;  author jwh;  state Exp;
branches ;
next     1.2;

1.2
date     91.07.26.12.32.44;  author cfb;  state Exp;
branches ;
next     1.1;

1.1
date     91.06.14.11.27.34;  author cfb;  state Exp;
branches ;
next     ;


desc
@checking in FCRT (part of CRTF) for the first time
@


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

 (c) Copyright Hewlett-Packard Company, 1991.
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'$
{}

{ The core for this code was taken from the CATSEYE driver. That's why it
  looks so similar. Modifications were made to use FASSM hardware driver.
  WOODCUT has a hardware cursor and byte per pixel architecture, which makes
  life much easier.
}

program initwoodcut(OUTPUT,INPUT);


module woodcutdvr;
import sysglobals, asm, misc, sysdevs {, fassm}, fs;
export

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

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

	       fb_fontstartx   : shortint;     {defaults: LCC = N/A }
	       fb_fontstarty   : shortint;     {          HRx = N/A }
					       {          VGA = N/A }
	       fb_font_line_length: shortint;  {defaults: LCC = N/A }
					       {          HRx = N/A }
					       {          VGA = N/A }
	       fb_fontlines    : shortint;     {defaults: LCC = N/A }
					       {          HRC = N/A }
					       {          HRM = N/A }
					       {          VGA = N/A }

	       nfontchars      : integer;      {default = 3 x 128 }

	       fb_cursorx      : shortint;     {defaults: LCC = N/A }
	       fb_cursory      : shortint;     {          HRx = N/A }
					       {          VGA = N/A }

	     end;

    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:
						 b0  = inverse,
						 b1  = blink,           (nop)
						 b2  = underline,
						 b3  = halfbright       (nop)}

	       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;

     { 256 chars of ROMAN-8 and 128 chars of KATAKANA }
     { 10x20 pixel cell size : (256+128)*10*20 = 76,800 }

var
    crtparams   : pcrtparamrec;

function woodcuttype : boolean;

implement

const

    woodcutregbytes = 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,
				    { VGA = 80, 29 }
				    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;
    lowres           : boolean;

    screenwidth      : shortint;
    screenheight     : shortint;
    maxx             : shortint;
    screensize       : shortint;
    defaulthighlight : shortint;

function  cromshort(offset : integer) : shortint; external;
procedure csetreg(register : integer; value : shortint); external;
procedure csavewoodenv(anyvar buffer : window); external;
procedure crestorewoodenv(anyvar buffer : window); external;
procedure csetupcchar; external;
procedure csetcolormap(indx : integer; r, g, b : integer); external;
procedure cchar(c, x, y : shortint); 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 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; {init_crtparams}

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             : integer;
    j             : integer;
    rowstart      : integer;
    bitnum        : shortint;
    charpos       : shortint;
    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;
begin
  cupdatecursor(xpos, ypos);
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          : shortint;
    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..woodcutregbytes] of byte;
    c             : char;
    s             : string[1];
    savesc        : shortint; {to fix stopkey bug. SFB 5/31/88}
    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}
{ csavewoodenv(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
}
  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 }
  end;

  if change_cursor then                                            {SFB 5/31/88}
    cupdatecursor(xpos, ypos);
{ crestorewoodenv(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..woodcutregbytes] of byte;
    i         : shortint;
    oldhilite : shortint;
    oldcolor  : shortint;
    oldrule   : shortint;
    savesc    : shortint; {to fix stopkey bug. SFB 5/31/88}
    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;

{ csavewoodenv(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; {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;

{ crestorewoodenv(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; {lineops}

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..woodcutregbytes] 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              : shortint;
    oldhilite      : shortint;
    oldalphacolor  : shortint;
    oldcursorcolor : shortint;
    oldrule        : shortint;
    j              : integer;
    savesc         : shortint;                 {to fix stopkey bug. SFB 5/31/88}
    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 csavewoodenv, 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}
{ csavewoodenv(stackbuf);}

  with dbrec do
  if change_cursor then
  begin
    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; {case}
  end; {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}
  end;

  if change_cursor then
    cupdatecursor(xcurs, ycurs);        {possibly with new cursor color}

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

{ crestorewoodenv(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 dummy;
begin
end;

procedure getcrtinfo;
var
    stackbuf : packed array[1..woodcutregbytes] of byte;

begin
  with crtparams^, screeninfo, iocontrol do
  begin
    cbuildtable;

{   csavewoodenv(stackbuf);                                    {to set up cchar}
    printh            := ((disph-charh) DIV charh)*charh;
    hascolor          := true;                      { WOODCUT always has color }
    alphacolor        := 1;
    cursorcolor       := alphacolor;
    cursreplrule0     := 5;
    cursreplrule1     := 6;
    copy_under_cursor := true;
    set_colormap_proc := csetcolormap;
    setxy(0, 0);
    cupdatecursor(0, 0);
    cclearall;
{   crestorewoodenv(stackbuf);}
  end;
end; {getcrtinfo}

procedure woodcutinit;
begin
  init_crtparams;
  idle := 245;                                   { set io char to roman8 value }
  with syscom^.crtinfo, crtparams^.screeninfo do
  begin
    getcrtinfo;

    screenwidth        := width;
    screenheight       := height;
    screensize         := screenwidth*screenheight;
    maxx               := screenwidth-1;
    maxy               := screenheight-1;
    printh             := screenheight * charh;
    printw             := screenwidth * charw;
    defaulthighlight   := 0;
    dumpalphahook      := dumpg;
    dumpgraphicshook   := dumpg;
    updatecursorhook   := doupdatecursor;
    crtiohook          := docrtio;
    dbcrthook          := crtdebug;
    crtllhook          := lineops;
    crtinithook        := woodcutinit;
    togglealphahook    := dummy;
    togglegraphicshook := dummy;
    currentcrt         := bitmaptype;
    keybuffer^.maxsize := maxx-8;
  end;
end; {woodcutinit}


function woodcuttype : boolean;

const
    newbitmapid = 57; {primary id for new bitmap displays}
    MHRCid = 19;  {High Resolution Color Greyscale Woodcut secondary id}
    MVGAid = 18;  {VGA Greyscale Woodcut secondary id}
    VGAid  = 17;  {VGA Resolution Woodcut secondary id}
    LCCid  = 16;  {Med Resolution Woodcut secondary id}
    HRCid  = 15;  {High Resolution Color Woodcut secondary id}
var
    ptr   : ^shortint;
    i     : shortint;
    dummy : shortint;
    found : boolean;

begin
  found := false;
							    {check DIO-II space}
  ptr := anyptr(hex('1000000'));        { changed to DIO-II space CFB - 30APR91}

  try
  dummy := ptr^ mod 128;
  if dummy = newbitmapid then
  begin                                                 { look at primary id   }
    ptr := anyptr(integer(ptr)+20);                     { look at secondary id }
    dummy := ptr^ mod 128;
    if (dummy >= HRCid) and (dummy <= MHRCid) then
    begin
      found := true;
      bitmapaddr := integer(ptr)-20;
      lowres := false;
      midres := false;
      if (dummy = VGAid) or (dummy = MVGAid) then
	lowres := true
      else if (dummy = LCCid) then
	midres := true;
    end;
  end;
  recover
  if escapecode <> -12 then escape(escapecode);

  if found then
  begin
    syscom^ := environc;
    if lowres then begin
      syscom^.crtinfo.width  := 80;
      syscom^.crtinfo.height := 29;
    end
    else                                 { make hires 50 lines - 25OCT91 - CFB }
    if not midres then                   {must be hires}
      syscom^.crtinfo.height := 50;
    woodcutinit;
  end;
  woodcuttype := found;
end; {woodcuttype}


end; { of module }

import woodcutdvr, loader;

begin
  if woodcuttype then markuser;
end.

@


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


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

 (c) Copyright Hewlett-Packard Company, 1991.
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'$
{}

{ The core for this code was taken from the CATSEYE driver. That's why it
  looks so similar. Modifications were made to use FASSM hardware driver.
  WOODCUT has a hardware cursor and byte per pixel architecture, which makes
  life much easier.
}

program initwoodcut(OUTPUT,INPUT);


module woodcutdvr;
import sysglobals, asm, misc, sysdevs {, fassm}, fs;
export

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

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

	       fb_fontstartx   : shortint;     {defaults: LCC = N/A }
	       fb_fontstarty   : shortint;     {          HRx = N/A }
					       {          VGA = N/A }
	       fb_font_line_length: shortint;  {defaults: LCC = N/A }
					       {          HRx = N/A }
					       {          VGA = N/A }
	       fb_fontlines    : shortint;     {defaults: LCC = N/A }
					       {          HRC = N/A }
					       {          HRM = N/A }
					       {          VGA = N/A }

	       nfontchars      : integer;      {default = 3 x 128 }

	       fb_cursorx      : shortint;     {defaults: LCC = N/A }
	       fb_cursory      : shortint;     {          HRx = N/A }
					       {          VGA = N/A }

	     end;

    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:
						 b0  = inverse,
						 b1  = blink,           (nop)
						 b2  = underline,
						 b3  = halfbright       (nop)}

	       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;

     { 256 chars of ROMAN-8 and 128 chars of KATAKANA }
     { 10x20 pixel cell size : (256+128)*10*20 = 76,800 }

var
    crtparams   : pcrtparamrec;

function woodcuttype : boolean;

implement

const

    woodcutregbytes = 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,
				    { VGA = 80, 29 }
				    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;
    lowres           : boolean;

    screenwidth      : shortint;
    screenheight     : shortint;
    maxx             : shortint;
    screensize       : shortint;
    defaulthighlight : shortint;

function  cromshort(offset : integer) : shortint; external;
procedure csetreg(register : integer; value : shortint); external;
procedure csavewoodenv(anyvar buffer : window); external;
procedure crestorewoodenv(anyvar buffer : window); external;
procedure csetupcchar; external;
procedure csetcolormap(indx : integer; r, g, b : integer); external;
procedure cchar(c, x, y : shortint); 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 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; {init_crtparams}

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             : integer;
    j             : integer;
    rowstart      : integer;
    bitnum        : shortint;
    charpos       : shortint;
    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;
begin
  cupdatecursor(xpos, ypos);
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          : shortint;
    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..woodcutregbytes] of byte;
    c             : char;
    s             : string[1];
    savesc        : shortint; {to fix stopkey bug. SFB 5/31/88}
    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}
{ csavewoodenv(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
}
  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 }
  end;

  if change_cursor then                                            {SFB 5/31/88}
    cupdatecursor(xpos, ypos);
{ crestorewoodenv(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..woodcutregbytes] of byte;
    i         : shortint;
    oldhilite : shortint;
    oldcolor  : shortint;
    oldrule   : shortint;
    savesc    : shortint; {to fix stopkey bug. SFB 5/31/88}
    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;

{ csavewoodenv(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; {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;

{ crestorewoodenv(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; {lineops}

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..woodcutregbytes] 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              : shortint;
    oldhilite      : shortint;
    oldalphacolor  : shortint;
    oldcursorcolor : shortint;
    oldrule        : shortint;
    j              : integer;
    savesc         : shortint;                 {to fix stopkey bug. SFB 5/31/88}
    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 csavewoodenv, 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}
{ csavewoodenv(stackbuf);}

  with dbrec do
  if change_cursor then
  begin
    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; {case}
  end; {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}
  end;

  if change_cursor then
    cupdatecursor(xcurs, ycurs);        {possibly with new cursor color}

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

{ crestorewoodenv(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 dummy;
begin
end;

procedure getcrtinfo;
var
    stackbuf : packed array[1..woodcutregbytes] of byte;

begin
  with crtparams^, screeninfo, iocontrol do
  begin
    cbuildtable;

{   csavewoodenv(stackbuf);                                    {to set up cchar}
    printh            := ((disph-charh) DIV charh)*charh;
    hascolor          := true;                      { WOODCUT always has color }
    alphacolor        := 1;
    cursorcolor       := alphacolor;
    cursreplrule0     := 5;
    cursreplrule1     := 6;
    copy_under_cursor := true;
    set_colormap_proc := csetcolormap;
    setxy(0, 0);
    cupdatecursor(0, 0);
    cclearall;
{   crestorewoodenv(stackbuf);}
  end;
end; {getcrtinfo}

procedure woodcutinit;
begin
  init_crtparams;
  idle := 245;                                   { set io char to roman8 value }
  with syscom^.crtinfo, crtparams^.screeninfo do
  begin
    getcrtinfo;

    screenwidth        := width;
    screenheight       := height;
    screensize         := screenwidth*screenheight;
    maxx               := screenwidth-1;
    maxy               := screenheight-1;
    printh             := screenheight * charh;
    printw             := screenwidth * charw;
    defaulthighlight   := 0;
    dumpalphahook      := dumpg;
    dumpgraphicshook   := dumpg;
    updatecursorhook   := doupdatecursor;
    crtiohook          := docrtio;
    dbcrthook          := crtdebug;
    crtllhook          := lineops;
    crtinithook        := woodcutinit;
    togglealphahook    := dummy;
    togglegraphicshook := dummy;
    currentcrt         := bitmaptype;
    keybuffer^.maxsize := maxx-8;
  end;
end; {woodcutinit}


function woodcuttype : boolean;

const
    newbitmapid = 57; {primary id for new bitmap displays}
    MHRCid = 19;  {High Resolution Color Greyscale Woodcut secondary id}
    MVGAid = 18;  {VGA Greyscale Woodcut secondary id}
    VGAid  = 17;  {VGA Resolution Woodcut secondary id}
    LCCid  = 16;  {Med Resolution Woodcut secondary id}
    HRCid  = 15;  {High Resolution Color Woodcut secondary id}
var
    ptr   : ^shortint;
    i     : shortint;
    dummy : shortint;
    found : boolean;

begin
  found := false;
							    {check DIO-II space}
  ptr := anyptr(hex('1000000'));        { changed to DIO-II space CFB - 30APR91}

  try
  dummy := ptr^ mod 128;
  if dummy = newbitmapid then
  begin                                                 { look at primary id   }
    ptr := anyptr(integer(ptr)+20);                     { look at secondary id }
    dummy := ptr^ mod 128;
    if (dummy >= HRCid) and (dummy <= MHRCid) then
    begin
      found := true;
      bitmapaddr := integer(ptr)-20;
      lowres := false;
      midres := false;
      if (dummy = VGAid) or (dummy = MVGAid) then
	lowres := true
      else if (dummy = LCCid) then
	midres := true;
    end;
  end;
  recover
  if escapecode <> -12 then escape(escapecode);

  if found then
  begin
    syscom^ := environc;
    if lowres then begin
      syscom^.crtinfo.width  := 80;
      syscom^.crtinfo.height := 29;
    end
    else                                 { make hires 50 lines - 25OCT91 - CFB }
    if not midres then                   {must be hires}
      syscom^.crtinfo.height := 50;
    woodcutinit;
  end;
  woodcuttype := found;
end; {woodcuttype}


end; { of module }

import woodcutdvr, loader;

begin
  if woodcuttype then markuser;
end.

@


55.5
log
@
pws2rcs automatic delta on Mon Nov  4 13:45:04 MST 1991
@
text
@@


55.4
log
@Removed references to cursor off. Changed height to 50 with Hi-res - CFB
@
text
@d1 1
a1 1
                                               (*
d10 1
a10 1
            RESTRICTED RIGHTS LEGEND
d30 1
a30 1
{{
d49 21
a69 21
               fbwidth         : shortint;     {defaults: LCC = 1024, 768 }
               fbheight        : shortint;     {          HRx = 2048, 1024 }
                                               {          VGA = 640, 480 }
               dispx           : shortint;     {defaults: LCC = 0, 0 }
               dispy           : shortint;     {          HRx = 0, 0 }
                                               {          VGA - 0, 0 }
               dispw           : shortint;     {defaults: LCC = 1024, 768 }
               disph           : shortint;     {          HRx = 1280, 1024 }
                                               {          VGA = 640, 480 }
               printx          : shortint;     {defaults: LCC = 0, 0 }
               printy          : shortint;     {          HRx = 0, 0 }
                                               {          VGA - 0, 0 }
               printw          : shortint;     {defaults: LCC = 1024, 752 }
                                               {          VGA = 640, 464 }
               printh          : shortint;     {          HRx = 1280, 1004 }
               offx            : shortint;     {defaults: LCC = 0, 0 }
               offy            : shortint;     {          HRx = 1280, 0 }
                                               {          VGA = 0, 480 }
               offw            : shortint;     {defaults: LCC = 0, 0 }
               offh            : shortint;     {          HRx = 768, 1024 }
                                               {          VGA = 544, 1024 }
d71 3
a73 3
               charw           : shortint;     {defaults: LCC = 8, 16 }
               charh           : shortint;     {          HRx = 10, 20 }
                                               {          VGA = 8, 16 }
d75 10
a84 10
               fb_fontstartx   : shortint;     {defaults: LCC = N/A }
               fb_fontstarty   : shortint;     {          HRx = N/A }
                                               {          VGA = N/A }
               fb_font_line_length: shortint;  {defaults: LCC = N/A }
                                               {          HRx = N/A }
                                               {          VGA = N/A }
               fb_fontlines    : shortint;     {defaults: LCC = N/A }
                                               {          HRC = N/A }
                                               {          HRM = N/A }
                                               {          VGA = N/A }
d86 1
a86 1
               nfontchars      : integer;      {default = 3 x 128 }
d88 3
a90 3
               fb_cursorx      : shortint;     {defaults: LCC = N/A }
               fb_cursory      : shortint;     {          HRx = N/A }
                                               {          VGA = N/A }
d92 1
a92 1
             end;
d97 1
a97 1
               set_colormap_proc : colormap_proc_type; {sets ANY cmap entry}
d99 5
a103 5
               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.}
d105 1
a105 1
               cursorcolor       : shortint;      {default = 2^(<h/w planes>-1)}
d107 6
a112 6
               {{
               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) }
d114 5
a118 5
               highlight         : shortint; {bit fielded:
                                                 b0  = inverse,
                                                 b1  = blink,           (nop)
                                                 b2  = underline,
                                                 b3  = halfbright       (nop)}
d120 2
a121 2
               creplrule0        : byte;         {repl rule for char 0s, 0..15 }
               creplrule1        : byte;         {repl rule for char 1s, 0..15 }
d123 2
a124 2
               cursreplrule0     : byte;         {rule for cursor 0s, 0..15 }
               cursreplrule1     : byte;         {rule for cursor 1s, 0..15 }
d126 11
a136 11
               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 }
d138 1
a138 1
             end;
d142 4
a145 4
               screeninfo        : screeninforec;
               iocontrol         : crtiocontrolrec;
              {capabilities      : capability_descriprec;}
             end;
d162 52
a213 52
                                    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,
                                    { VGA = 80, 29 }
                                    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]];
d251 1
a251 1
          external;
d258 1
a258 1
          external;
d332 1
a332 1
                                      by actual number of non-0 bytes in buffer}
d429 9
a437 9
        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;
d441 4
a444 4
        alphacolor  := ((c-136) {MOD 8}) + 1;
        cursorcolor := alphacolor;
        highlight   := highlight mod 2048 + (c-136)*4096;
        needs_setup := true;
d476 1
a476 1
                  length, position : integer);
d481 1
a481 1
                                          startwrite, writebytes];
d494 1
a494 1
                 with the correct escape code. SFB 5/31/88}
d496 2
a497 2
        {so we can restore level after protecting "atomic operations".
                         SFB 5/31/88}
d528 1
a528 1
        setxy(fp^.fxpos, fp^.fypos);
d542 6
a547 6
        highlight   := defaulthighlight;
        alphacolor  := default_alphacolor;
        cursorcolor := alphacolor;
        creplrule1  := 3;
        csetupcchar;
        setxy(0, 0);
d552 15
a566 15
        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;
d572 14
a585 14
        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);
d590 2
a591 2
        if ypos=maxy then cscrollup;
        setxy(0, ypos+1);
d597 6
a602 6
        while length>0 do
        begin
          c := buf^;
          buf := addr(buf^,1);
          length := length-1;
          case c of
d604 2
a605 2
            homechar:
              setxy(0, 0);
d607 5
a611 5
            leftchar:
              if (xpos = 0) and (ypos>0) then
                setxy(maxx, ypos-1)
              else
                setxy(xpos-1, ypos);
d613 5
a617 5
            rightchar:
              if (xpos = maxx) and (ypos<maxy) then
                setxy(0, ypos+1)
              else
                setxy(xpos+1, ypos);
d619 5
a623 5
            upchar:
              begin
                if ypos <= 1 then cscrolldown;
                if ypos>0 then setxy(xpos, ypos-1);
              end;
d625 5
a629 5
            downchar:
              if ypos=maxy then
                cscrollup
              else
                setxy(xpos, ypos+1);
d631 2
a632 2
            bellchar:
              beep;
d634 2
a635 2
            cteos:
              clear(screensize-(ypos*screenwidth+xpos));
d637 2
a638 2
            cteol:
              clear(screenwidth-xpos);
d640 5
a644 5
            clearscr:
              begin
                setxy(0,0);
                clear(screensize);
              end;
d646 2
a647 2
            eol:
              setxy(0, ypos);
d649 2
a650 2
            chr(etx):
              length:=0;
d652 17
a668 17
          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}
d681 2
a682 2
                   What if interrupt hits in recover block before setintlevel(7)
                   executes? We would lose chance to restore H/W setup. }
d694 1
a694 1
                         We would never execute this code. SFB 5/31/88}
d712 1
a712 1
                with the correct escape code. SFB 5/31/88}
d714 1
a714 1
                                        "atomic operations". SFB 5/31/88}
d740 2
a741 2
        cshiftleft;
        cchar(ord(' '), maxx-8, screenheight);
d746 2
a747 2
        cshiftright;
        cchar(ord(' '), 0, screenheight);
d755 5
a759 5
        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);
d771 2
a772 2
                   What if interrupt hits in recover block before setintlevel(7)
                   executes? We would lose chance to restore H/W setup.}
d788 2
a789 2
                                      during intlevel 7? We would never execute
                                      this code. SFB 5/31/88}
d798 2
a799 2
                                          dbscrolll, dbscrollr, dbput, dbclear,
                                          dbcline, dbexcg];
d837 1
a837 1
                 with the correct escape code. SFB 5/31/88}
d839 1
a839 1
                         "atomic operations". SFB 5/31/88}
d849 1
a849 1
                                             {set up debugger window conditions}
d852 1
a852 1
                             {set relprule to 3 (regular) or 12 (inverse video)}
d881 4
a884 4
        with crtparams^.screeninfo do
        begin
          savesize:=(xmax-xmin+1)*(ymax-ymin+1)*charw*charh;
        end;
d887 3
a889 3
        begin {Implemented by prior call to cursoroff, and following
               call to cupdatecursor}
        end;
d892 4
a895 4
        begin
          cscrollwindow( ymin, ymax, xmin, xmax-xmin+1);
          cclear(xmin, ymax, xmax-xmin+1);
        end;
d898 4
a901 4
        begin
          cscrollwinddn(ymin, ymax, xmin, xmax-xmin+1);
          cclear(xmin, ymin, xmax-xmin+1);
        end;
d904 4
a907 4
        begin
          cdbscrolll(ymin, ymax, xmin, xmax-xmin+1);
          for i := ymin to ymax do cchar(ord(' '), xmax, i);
        end;
d910 4
a913 4
        begin
          cdbscrollr(ymin, ymax, xmin, xmax-xmin+1);
          for i := ymin to ymax do cchar(ord(' '), xmin, i);
        end;
d916 1
a916 1
        ; { Not implemented for color bitmap displays }
d919 6
a924 6
        begin
          if charismapped then
            cchar(maptocrt(c), cursx, cursy)
          else
            cchar(ord(c), cursx, cursy);
        end;
d927 1
a927 1
        for i := ymin to ymax do cclear(xmin, i, xmax-xmin+1);
d930 1
a930 1
        cclear(cursx, cursy, xmax-cursx+1);
d933 8
a940 8
        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;
d943 20
a962 20
        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;
d970 2
a971 2
                   What if interrupt hits in recover block before setintlevel(7)
                   executes? We would lose chance to restore H/W setup.}
d991 2
a992 2
                                       during intlevel 7? We would never execute
                                       this code. SFB 5/31/88}
d1073 1
a1073 1
                                                            {check DIO-II space}
d1089 1
a1089 1
        lowres := true
d1091 1
a1091 1
        midres := true;
d1103 1
a1103 1
    end 
@


55.3
log
@FIxed comment in search declaration for turn process. - CFB
@
text
@d30 1
a30 1
{}
a242 1
procedure cursoroff; external;
a515 1
    cursoroff;
a867 1
    cursoroff;
d1103 4
a1106 1
    end;
@


55.2
log
@Cleaned up code (indents and such). Fixed all bugs found in QA - CFB
@
text
@d30 1
a30 1
{{
@


55.1
log
@Automatic bump of revision number for PWS version 3.25A
@
text
@d1 1
a1 1
					       (*
d10 1
a10 1
	    RESTRICTED RIGHTS LEGEND
d30 1
a30 1
{}
d49 21
a69 21
	       fbwidth         : shortint;     {defaults: LCC = 1024, 768 }
	       fbheight        : shortint;     {          HRx = 2048, 1024 }
					       {          VGA = 640, 480 }
	       dispx           : shortint;     {defaults: LCC = 0, 0 }
	       dispy           : shortint;     {          HRx = 0, 0 }
					       {          VGA - 0, 0 }
	       dispw           : shortint;     {defaults: LCC = 1024, 768 }
	       disph           : shortint;     {          HRx = 1280, 1024 }
					       {          VGA = 640, 480 }
	       printx          : shortint;     {defaults: LCC = 0, 0 }
	       printy          : shortint;     {          HRx = 0, 0 }
					       {          VGA - 0, 0 }
	       printw          : shortint;     {defaults: LCC = 1024, 752 }
					       {          VGA = 640, 464 }
	       printh          : shortint;     {          HRx = 1280, 1004 }
	       offx            : shortint;     {defaults: LCC = 0, 0 }
	       offy            : shortint;     {          HRx = 1280, 0 }
					       {          VGA = 0, 480 }
	       offw            : shortint;     {defaults: LCC = 0, 0 }
	       offh            : shortint;     {          HRx = 768, 1024 }
					       {          VGA = 544, 1024 }
d71 3
a73 3
	       charw           : shortint;     {defaults: LCC = 8, 16 }
	       charh           : shortint;     {          HRx = 10, 20 }
					       {          VGA = 8, 16 }
d75 10
a84 10
	       fb_fontstartx   : shortint;     {defaults: LCC = N/A }
	       fb_fontstarty   : shortint;     {          HRx = N/A }
					       {          VGA = N/A }
	       fb_font_line_length: shortint;  {defaults: LCC = N/A }
					       {          HRx = N/A }
					       {          VGA = N/A }
	       fb_fontlines    : shortint;     {defaults: LCC = N/A }
					       {          HRC = N/A }
					       {          HRM = N/A }
					       {          VGA = N/A }
d86 1
a86 1
	       nfontchars      : integer;      {default = 3 x 128 }
d88 3
a90 3
	       fb_cursorx      : shortint;     {defaults: LCC = N/A }
	       fb_cursory      : shortint;     {          HRx = N/A }
					       {          VGA = N/A }
d92 1
a92 1
	     end;
d97 1
a97 1
	       set_colormap_proc : colormap_proc_type; {sets ANY cmap entry}
d99 5
a103 5
	       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.}
d105 1
a105 1
	       cursorcolor       : shortint;      {default = 2^(<h/w planes>-1)}
d107 6
a112 6
	       {{
	       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) }
d114 5
a118 5
	       highlight         : shortint; {bit fielded:
						 b0  = inverse,
						 b1  = blink,           (nop)
						 b2  = underline,
						 b3  = halfbright       (nop)}
d120 2
a121 2
	       creplrule0        : byte;         {repl rule for char 0s, 0..15 }
	       creplrule1        : byte;         {repl rule for char 1s, 0..15 }
d123 2
a124 2
	       cursreplrule0     : byte;         {rule for cursor 0s, 0..15 }
	       cursreplrule1     : byte;         {rule for cursor 1s, 0..15 }
d126 11
a136 11
	       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 }
d138 1
a138 1
	     end;
d142 4
a145 4
	       screeninfo        : screeninforec;
	       iocontrol         : crtiocontrolrec;
	      {capabilities      : capability_descriprec;}
	     end;
d147 3
d151 1
a151 1
     crtparams : pcrtparamrec;
d162 52
a213 52
				    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,
				    { VGA = 80, 29 }
				    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]];
d252 1
a252 1
	  external;
d259 1
a259 1
	  external;
d333 1
a333 1
				      by actual number of non-0 bytes in buffer}
d430 9
a438 9
	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;
d442 4
a445 4
	alphacolor  := ((c-136) {MOD 8}) + 1;
	cursorcolor := alphacolor;
	highlight   := highlight mod 2048 + (c-136)*4096;
	needs_setup := true;
d477 1
a477 1
		  length, position : integer);
d482 1
a482 1
					  startwrite, writebytes];
d495 1
a495 1
		 with the correct escape code. SFB 5/31/88}
d497 2
a498 2
	{so we can restore level after protecting "atomic operations".
			 SFB 5/31/88}
d530 1
a530 1
	setxy(fp^.fxpos, fp^.fypos);
d544 6
a549 6
	highlight   := defaulthighlight;
	alphacolor  := default_alphacolor;
	cursorcolor := alphacolor;
	creplrule1  := 3;
	csetupcchar;
	setxy(0, 0);
d554 15
a568 15
	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;
d574 14
a587 14
	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);
d592 2
a593 2
	if ypos=maxy then cscrollup;
	setxy(0, ypos+1);
d599 6
a604 6
	while length>0 do
	begin
	  c := buf^;
	  buf := addr(buf^,1);
	  length := length-1;
	  case c of
d606 2
a607 2
	    homechar:
	      setxy(0, 0);
d609 5
a613 5
	    leftchar:
	      if (xpos = 0) and (ypos>0) then
		setxy(maxx, ypos-1)
	      else
		setxy(xpos-1, ypos);
d615 5
a619 5
	    rightchar:
	      if (xpos = maxx) and (ypos<maxy) then
		setxy(0, ypos+1)
	      else
		setxy(xpos+1, ypos);
d621 5
a625 5
	    upchar:
	      begin
		if ypos <= 1 then cscrolldown;
		if ypos>0 then setxy(xpos, ypos-1);
	      end;
d627 5
a631 5
	    downchar:
	      if ypos=maxy then
		cscrollup
	      else
		setxy(xpos, ypos+1);
d633 2
a634 2
	    bellchar:
	      beep;
d636 2
a637 2
	    cteos:
	      clear(screensize-(ypos*screenwidth+xpos));
d639 2
a640 2
	    cteol:
	      clear(screenwidth-xpos);
d642 5
a646 5
	    clearscr:
	      begin
		setxy(0,0);
		clear(screensize);
	      end;
d648 2
a649 2
	    eol:
	      setxy(0, ypos);
d651 2
a652 2
	    chr(etx):
	      length:=0;
d654 17
a670 17
	  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}
d683 2
a684 2
		   What if interrupt hits in recover block before setintlevel(7)
		   executes? We would lose chance to restore H/W setup. }
d696 1
a696 1
			 We would never execute this code. SFB 5/31/88}
d714 1
a714 1
		with the correct escape code. SFB 5/31/88}
d716 1
a716 1
					"atomic operations". SFB 5/31/88}
d742 2
a743 2
	cshiftleft;
	cchar(ord(' '), maxx-8, screenheight);
d748 2
a749 2
	cshiftright;
	cchar(ord(' '), 0, screenheight);
d757 5
a761 5
	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);
d773 2
a774 2
		   What if interrupt hits in recover block before setintlevel(7)
		   executes? We would lose chance to restore H/W setup.}
d790 2
a791 2
				      during intlevel 7? We would never execute
				      this code. SFB 5/31/88}
d800 2
a801 2
					  dbscrolll, dbscrollr, dbput, dbclear,
					  dbcline, dbexcg];
d839 1
a839 1
		 with the correct escape code. SFB 5/31/88}
d841 1
a841 1
			 "atomic operations". SFB 5/31/88}
d851 1
a851 1
					     {set up debugger window conditions}
d854 1
a854 1
			     {set relprule to 3 (regular) or 12 (inverse video)}
d884 4
a887 4
	with crtparams^.screeninfo do
	begin
	  savesize:=(xmax-xmin+1)*(ymax-ymin+1)*charw*charh;
	end;
d890 3
a892 3
	begin {Implemented by prior call to cursoroff, and following
	       call to cupdatecursor}
	end;
d895 4
a898 4
	begin
	  cscrollwindow( ymin, ymax, xmin, xmax-xmin+1);
	  cclear(xmin, ymax, xmax-xmin+1);
	end;
d901 4
a904 4
	begin
	  cscrollwinddn(ymin, ymax, xmin, xmax-xmin+1);
	  cclear(xmin, ymin, xmax-xmin+1);
	end;
d907 4
a910 4
	begin
	  cdbscrolll(ymin, ymax, xmin, xmax-xmin+1);
	  for i := ymin to ymax do cchar(ord(' '), xmax, i);
	end;
d913 4
a916 4
	begin
	  cdbscrollr(ymin, ymax, xmin, xmax-xmin+1);
	  for i := ymin to ymax do cchar(ord(' '), xmin, i);
	end;
d919 1
a919 1
	; { Not implemented for color bitmap displays }
d922 6
a927 6
	begin
	  if charismapped then
	    cchar(maptocrt(c), cursx, cursy)
	  else
	    cchar(ord(c), cursx, cursy);
	end;
d930 1
a930 1
	for i := ymin to ymax do cclear(xmin, i, xmax-xmin+1);
d933 1
a933 1
	cclear(cursx, cursy, xmax-cursx+1);
d936 8
a943 8
	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;
d946 20
a965 20
	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;
d973 2
a974 2
		   What if interrupt hits in recover block before setintlevel(7)
		   executes? We would lose chance to restore H/W setup.}
d994 2
a995 2
				       during intlevel 7? We would never execute
				       this code. SFB 5/31/88}
d1063 5
a1067 3
    VGAid = 17;  {VGA Resolution Woodcut secondary id}
    LCCid = 16;  {Med Resolution Woodcut secondary id}
    HRCid = 99;  {High Resolution Color Woodcut secondary id}
d1076 1
a1076 1
							    {check DIO-II space}
d1085 1
a1085 1
    if (dummy >= LCCid) and (dummy <= HRCid) then
d1091 2
a1092 2
      if (dummy = VGAid) then
	lowres := true
d1094 1
a1094 1
	midres := true;
@


1.4
log
@*** empty log message ***
@
text
@@


1.3
log
@adjusted a comment sign so the imports work in the turn environment.
@
text
@@


1.2
log
@called cclear from initwoodcut routine - CFB
@
text
@d1 1
a1 1
                                               (*
d10 1
a10 1
            RESTRICTED RIGHTS LEGEND
d30 1
a30 1
{{
d49 21
a69 21
               fbwidth         : shortint;     {defaults: LCC = 1024, 768 }
               fbheight        : shortint;     {          HRx = 2048, 1024 }
                                               {          VGA = 640, 480 }
               dispx           : shortint;     {defaults: LCC = 0, 0 }
               dispy           : shortint;     {          HRx = 0, 0 }
                                               {          VGA - 0, 0 }
               dispw           : shortint;     {defaults: LCC = 1024, 768 }
               disph           : shortint;     {          HRx = 1280, 1024 }
                                               {          VGA = 640, 480 }
               printx          : shortint;     {defaults: LCC = 0, 0 }
               printy          : shortint;     {          HRx = 0, 0 }
                                               {          VGA - 0, 0 }
               printw          : shortint;     {defaults: LCC = 1024, 752 }
                                               {          VGA = 640, 464 }
               printh          : shortint;     {          HRx = 1280, 1004 }
               offx            : shortint;     {defaults: LCC = 0, 0 }
               offy            : shortint;     {          HRx = 1280, 0 }
                                               {          VGA = 0, 480 }
               offw            : shortint;     {defaults: LCC = 0, 0 }
               offh            : shortint;     {          HRx = 768, 1024 }
                                               {          VGA = 544, 1024 }
d71 3
a73 3
               charw           : shortint;     {defaults: LCC = 8, 16 }
               charh           : shortint;     {          HRx = 10, 20 }
                                               {          VGA = 8, 16 }
d75 10
a84 10
               fb_fontstartx   : shortint;     {defaults: LCC = N/A }
               fb_fontstarty   : shortint;     {          HRx = N/A }
                                               {          VGA = N/A }
               fb_font_line_length: shortint;  {defaults: LCC = N/A }
                                               {          HRx = N/A }
                                               {          VGA = N/A }
               fb_fontlines    : shortint;     {defaults: LCC = N/A }
                                               {          HRC = N/A }
                                               {          HRM = N/A }
                                               {          VGA = N/A }
d86 1
a86 1
               nfontchars      : integer;      {default = 3 x 128 }
d88 3
a90 3
               fb_cursorx      : shortint;     {defaults: LCC = N/A }
               fb_cursory      : shortint;     {          HRx = N/A }
                                               {          VGA = N/A }
d92 1
a92 1
             end;
d97 1
a97 1
               set_colormap_proc : colormap_proc_type; {sets ANY cmap entry}
d99 5
a103 5
               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.}
d105 1
a105 1
               cursorcolor       : shortint;      {default = 2^(<h/w planes>-1)}
d107 6
a112 6
               {{
               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) }
d114 5
a118 5
               highlight         : shortint; {bit fielded:
                                                 b0  = inverse,
                                                 b1  = blink,           (nop)
                                                 b2  = underline,
                                                 b3  = halfbright       (nop)}
d120 2
a121 2
               creplrule0        : byte;         {repl rule for char 0s, 0..15 }
               creplrule1        : byte;         {repl rule for char 1s, 0..15 }
d123 2
a124 2
               cursreplrule0     : byte;         {rule for cursor 0s, 0..15 }
               cursreplrule1     : byte;         {rule for cursor 1s, 0..15 }
d126 11
a136 11
               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 }
d138 1
a138 1
             end;
d142 4
a145 4
               screeninfo        : screeninforec;
               iocontrol         : crtiocontrolrec;
              {capabilities      : capability_descriprec;}
             end;
d159 52
a210 52
                                    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,
                                    { VGA = 80, 29 }
                                    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]];
d249 1
a249 1
          external;
d256 1
a256 1
          external;
d330 1
a330 1
                                      by actual number of non-0 bytes in buffer}
d427 9
a435 9
        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;
d439 4
a442 4
        alphacolor  := ((c-136) {MOD 8}) + 1;
        cursorcolor := alphacolor;
        highlight   := highlight mod 2048 + (c-136)*4096;
        needs_setup := true;
d474 1
a474 1
                  length, position : integer);
d479 1
a479 1
                                          startwrite, writebytes];
d492 1
a492 1
                 with the correct escape code. SFB 5/31/88}
d494 2
a495 2
        {so we can restore level after protecting "atomic operations".
                         SFB 5/31/88}
d527 1
a527 1
        setxy(fp^.fxpos, fp^.fypos);
d541 6
a546 6
        highlight   := defaulthighlight;
        alphacolor  := default_alphacolor;
        cursorcolor := alphacolor;
        creplrule1  := 3;
        csetupcchar;
        setxy(0, 0);
d551 15
a565 15
        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;
d571 14
a584 14
        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);
d589 2
a590 2
        if ypos=maxy then cscrollup;
        setxy(0, ypos+1);
d596 6
a601 6
        while length>0 do
        begin
          c := buf^;
          buf := addr(buf^,1);
          length := length-1;
          case c of
d603 2
a604 2
            homechar:
              setxy(0, 0);
d606 5
a610 5
            leftchar:
              if (xpos = 0) and (ypos>0) then
                setxy(maxx, ypos-1)
              else
                setxy(xpos-1, ypos);
d612 5
a616 5
            rightchar:
              if (xpos = maxx) and (ypos<maxy) then
                setxy(0, ypos+1)
              else
                setxy(xpos+1, ypos);
d618 5
a622 5
            upchar:
              begin
                if ypos <= 1 then cscrolldown;
                if ypos>0 then setxy(xpos, ypos-1);
              end;
d624 5
a628 5
            downchar:
              if ypos=maxy then
                cscrollup
              else
                setxy(xpos, ypos+1);
d630 2
a631 2
            bellchar:
              beep;
d633 2
a634 2
            cteos:
              clear(screensize-(ypos*screenwidth+xpos));
d636 2
a637 2
            cteol:
              clear(screenwidth-xpos);
d639 5
a643 5
            clearscr:
              begin
                setxy(0,0);
                clear(screensize);
              end;
d645 2
a646 2
            eol:
              setxy(0, ypos);
d648 2
a649 2
            chr(etx):
              length:=0;
d651 17
a667 17
          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}
d680 2
a681 2
                   What if interrupt hits in recover block before setintlevel(7)
                   executes? We would lose chance to restore H/W setup. }
d693 1
a693 1
                         We would never execute this code. SFB 5/31/88}
d711 1
a711 1
                with the correct escape code. SFB 5/31/88}
d713 1
a713 1
                                        "atomic operations". SFB 5/31/88}
d739 2
a740 2
        cshiftleft;
        cchar(ord(' '), maxx-8, screenheight);
d745 2
a746 2
        cshiftright;
        cchar(ord(' '), 0, screenheight);
d754 5
a758 5
        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);
d770 2
a771 2
                   What if interrupt hits in recover block before setintlevel(7)
                   executes? We would lose chance to restore H/W setup.}
d787 2
a788 2
                                      during intlevel 7? We would never execute
                                      this code. SFB 5/31/88}
d797 2
a798 2
                                          dbscrolll, dbscrollr, dbput, dbclear,
                                          dbcline, dbexcg];
d836 1
a836 1
                 with the correct escape code. SFB 5/31/88}
d838 1
a838 1
                         "atomic operations". SFB 5/31/88}
d848 1
a848 1
                                             {set up debugger window conditions}
d851 1
a851 1
                             {set relprule to 3 (regular) or 12 (inverse video)}
d881 4
a884 4
        with crtparams^.screeninfo do
        begin
          savesize:=(xmax-xmin+1)*(ymax-ymin+1)*charw*charh;
        end;
d887 3
a889 3
        begin {Implemented by prior call to cursoroff, and following
               call to cupdatecursor}
        end;
d892 4
a895 4
        begin
          cscrollwindow( ymin, ymax, xmin, xmax-xmin+1);
          cclear(xmin, ymax, xmax-xmin+1);
        end;
d898 4
a901 4
        begin
          cscrollwinddn(ymin, ymax, xmin, xmax-xmin+1);
          cclear(xmin, ymin, xmax-xmin+1);
        end;
d904 4
a907 4
        begin
          cdbscrolll(ymin, ymax, xmin, xmax-xmin+1);
          for i := ymin to ymax do cchar(ord(' '), xmax, i);
        end;
d910 4
a913 4
        begin
          cdbscrollr(ymin, ymax, xmin, xmax-xmin+1);
          for i := ymin to ymax do cchar(ord(' '), xmin, i);
        end;
d916 1
a916 1
        ; { Not implemented for color bitmap displays }
d919 6
a924 6
        begin
          if charismapped then
            cchar(maptocrt(c), cursx, cursy)
          else
            cchar(ord(c), cursx, cursy);
        end;
d927 1
a927 1
        for i := ymin to ymax do cclear(xmin, i, xmax-xmin+1);
d930 1
a930 1
        cclear(cursx, cursy, xmax-cursx+1);
d933 8
a940 8
        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;
d943 20
a962 20
        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;
d970 2
a971 2
                   What if interrupt hits in recover block before setintlevel(7)
                   executes? We would lose chance to restore H/W setup.}
d991 2
a992 2
                                       during intlevel 7? We would never execute
                                       this code. SFB 5/31/88}
d1071 1
a1071 1
                                                            {check DIO-II space}
d1087 1
a1087 1
        lowres := true
d1089 1
a1089 1
        midres := true;
@


1.1
log
@Initial revision
@
text
@d183 1
a183 1
                                    { VGA = 80, 24 }
d225 1
a1013 5
    maxx              := (printw div charw)-1;
    maxy              := (printh div charh)-1;
    screenwidth       := maxx+1;
    screenheight      := maxy+1;
    screensize        := screenwidth*screenheight;
d1020 1
a1025 5
var
    i        : shortint;
    achar    : char;
    stackbuf : packed array[1..woodcutregbytes] of byte;

a1027 1
  syscom^ := environc;
d1029 1
a1029 1
  with syscom^.crtinfo do
d1033 7
a1039 2
    height             := screenheight;
    width              := screenwidth;           { added for VGA support - CFB }
d1084 6
d1095 9
a1103 1
  if found then woodcutinit;
@
