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


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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

32.1
date     89.01.10.11.45.59;  author bayes;  state Exp;
branches ;
next     31.1;

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

30.1
date     88.12.09.16.45.15;  author dew;  state Exp;
branches ;
next     29.4;

29.4
date     88.12.09.16.20.58;  author dew;  state Exp;
branches ;
next     29.3;

29.3
date     88.11.01.11.04.37;  author dew;  state Exp;
branches ;
next     29.2;

29.2
date     88.11.01.10.32.18;  author dew;  state Exp;
branches ;
next     29.1;

29.1
date     88.10.31.15.29.17;  author bayes;  state Exp;
branches ;
next     28.1;

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

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

26.1
date     88.09.28.13.08.31;  author bayes;  state Exp;
branches ;
next     25.2;

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

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

24.1
date     87.08.31.09.44.14;  author jws;  state Exp;
branches ;
next     23.1;

23.1
date     87.08.26.10.21.06;  author bayes;  state Exp;
branches ;
next     22.1;

22.1
date     87.08.17.11.06.21;  author bayes;  state Exp;
branches ;
next     21.1;

21.1
date     87.08.12.13.49.36;  author bayes;  state Exp;
branches ;
next     20.1;

20.1
date     87.07.30.11.02.52;  author bayes;  state Exp;
branches ;
next     19.1;

19.1
date     87.06.01.08.18.38;  author jws;  state Exp;
branches ;
next     18.1;

18.1
date     87.05.20.15.14.50;  author bayes;  state Exp;
branches ;
next     17.1;

17.1
date     87.04.30.10.29.38;  author jws;  state Exp;
branches ;
next     16.1;

16.1
date     87.04.26.15.42.18;  author jws;  state Exp;
branches ;
next     15.1;

15.1
date     87.04.13.09.15.59;  author jws;  state Exp;
branches ;
next     14.1;

14.1
date     87.04.01.15.18.49;  author jws;  state Exp;
branches ;
next     13.1;

13.1
date     87.02.28.18.28.08;  author jws;  state Exp;
branches ;
next     12.1;

12.1
date     87.02.02.13.18.18;  author jws;  state Exp;
branches ;
next     11.1;

11.1
date     87.01.19.09.44.26;  author jws;  state Exp;
branches ;
next     10.1;

10.1
date     86.12.24.10.51.59;  author jws;  state Exp;
branches ;
next     9.1;

9.1
date     86.12.12.14.30.47;  author bayes;  state Exp;
branches ;
next     8.1;

8.1
date     86.11.27.11.49.26;  author jws;  state Exp;
branches ;
next     7.1;

7.1
date     86.11.20.13.39.30;  author hal;  state Exp;
branches ;
next     6.1;

6.1
date     86.11.04.17.49.20;  author paws;  state Exp;
branches ;
next     5.2;

5.2
date     86.10.29.15.23.39;  author geli;  state Exp;
branches ;
next     5.1;

5.1
date     86.10.28.16.37.54;  author hal;  state Exp;
branches ;
next     4.1;

4.1
date     86.09.30.19.40.57;  author hal;  state Exp;
branches ;
next     3.1;

3.1
date     86.09.01.11.51.47;  author hal;  state Exp;
branches ;
next     2.1;

2.1
date     86.07.30.14.37.27;  author hal;  state Exp;
branches ;
next     1.1;

1.1
date     86.06.30.14.42.39;  author danm;  state tmp;
branches ;
next     ;


desc
@Base file for PWS 3.2 release.

@


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

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

program initcrtbc(OUTPUT);


module crtbc;
import sysglobals, asm, misc, sysdevs;
export

function bobcattype: boolean;

implement

const


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






var

fontwidth: shortint;
fontht: shortint;
screenwidth: shortint;
screenheight:shortint;
maxx: shortint;
maxy: shortint;
screensize:shortint;
defaulthighlight: shortint;
highlight: shortint;
planemask: shortint;
lowres: boolean;
hascolor: boolean;
holdcursor : array[0..3] of integer;    {SFB 9/24/86 - for 98549A}
cursoraddr : integer;                   {SFB 9/24/86 - for 98549A}
softcursor : boolean;                   {SFB 9/24/86 - for 98549A}


procedure  cchar(c,x,y:shortint);external;
procedure  cursoroff; external;
procedure  cursoron; 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 dumpg ;


label 1;

const
  gwidthb = 128;
  gmaxheight = 512;
  gbuffersize = gwidthb + 7;

type
  gbyte = 0..255;
  row_def = packed array [0..(1024*768)-1] of gbyte;

var
  row : ^row_def;

  gbuffer : packed array [1..gbuffersize] of char;
  i,j : integer;
  index : integer;
  bit_mask : integer;
  result : integer;
  nrows: integer;

begin

  row := anyptr(frameaddr);

  write(gfiles[4]^,#27'*rA');   { initiate graphics sequence }

  gbuffer[1] := chr(27); { escape sequence for graphics }
  gbuffer[2] := '*';
  gbuffer[3] := 'b';
  gbuffer[4] := '1';
  gbuffer[5] := '2';
  gbuffer[6] := '8';
  gbuffer[7] := 'W';

  if lowres then nrows:=399
     else nrows:=767;

  for j := 0 to nrows do
    begin
      for i := 0 to 127 do
	begin
	  result := 0;
	  index := j*1024+i*8;
	  bit_mask := 256;
	  for index := index to index+7 do
	    begin
	      bit_mask := bit_mask div 2; { fix for low-res mono display 7/23/85 JWS}
	      if iand(row^[index],planemask div 256)<>0  then result := bit_mask+result;
	    end;
	  gbuffer[i+8] := chr(result);
	end;
	write(gfiles[4]^,gbuffer:gwidthb+7);
	if ioresult <> ord(inoerror) then goto 1;
	if lowres then
	  write(gfiles[4]^,gbuffer:gwidthb+7);
	if ioresult <> ord(inoerror) then goto 1;
    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 gotoxy(x,y: integer);
begin
  setxy(x,y);
  doupdatecursor;
end;


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

procedure scrollup;
begin
  cscrollup;
end;

procedure scrolldown;
begin
  cscrolldown;
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;



procedure docrtio(fp: fibp; request: amrequesttype; anyvar buffer: window;
						   length, position: integer);
var c: char;
    s: string[1];
    buf: charptr;
begin
 ioresult := ord(inoerror);
 buf := addr(buffer);
 case request of
  {uwait: ;              }
  setcursor: gotoxy(fp^.fxpos, fp^.fypos);
  getcursor: getxy (fp^.fxpos, fp^.fypos);
  flush:  {do nothing};
  unitstatus:  kbdio(fp, request, buffer, length, position);
  clearunit: begin
	      highlight := defaulthighlight;
	      cclearall;
	     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 if s[1] = chr(etx) 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 scrollup;
		gotoxy(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 scrolldown;
			 if ypos>0 then setxy(xpos, ypos-1);
		   end;
       downchar:   if ypos=maxy then scrollup
		   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
		     if hascolor then
		       if (ord(c)>=136) then
			 highlight:= highlight mod 2048 +
			   (ord(c)-136)*4096
		       else
			 highlight:=((highlight div 2048)*8
				  +(ord(c)-128))*256
		     else highlight:=(ord(c)-128)*256
		   else
		     begin
		      cursoroff;        {SFB 9/24/86 - for 98549A}
		      cchar(maptocrt(c),xpos,ypos);
		      cursoron;         {SFB 9/24/86 - for 98549A}
		      if xpos = maxx then
			begin
			  if ypos = maxy then scrollup;
			  setxy(0, ypos+1);
			end
		      else setxy(xpos+1, ypos);
		     end;
       end;
     doupdatecursor;
     end; {while}
    if request = startwrite then call(fp^.feot, fp);
    end;
  otherwise ioresult := ord(ibadrequest);
 end; {case}
end;

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

var i,j: shortint;
    sptr: ^string255;

begin

j:=highlight; highlight:=defaulthighlight;

case op of

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

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

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

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

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

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

end; { of case }
highlight:=j;

end;

procedure crtdebug(op: dbcrtops; var dbrec: dbcinfo);

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

var i: shortint;
    j: integer;
    tempaddr : integer;
    xtemp: shortint;
    ytemp: shortint;

begin
with dbrec do begin
  case op of

    dbinfo: savesize:=(xmax-xmin+1)*(ymax-ymin+1)*fontwidth
		      * fontht;

    dbgotoxy: cupdatecursor(cursx, cursy);

    dbscrollup: begin
		  if ymax > ymin  {DEW 11/1/88 DEFECT: FSDdt00760}
		  then
		      cscrollwindow( ymin, ymax, xmin, xmax-xmin+1);
		  cclear(xmin, ymax, xmax-xmin+1);
		end;

    dbscrolldn: begin
		  if ymax > ymin  {DEW 11/1/88 DEFECT: FSDdt00760}
		  then
		      cscrollwinddn(ymin, ymax, xmin, xmax-xmin+1);
		  cclear(xmin, ymin, xmax-xmin+1);
		end;

    dbscrolll: begin
		 cdbscrolll(ymin, ymax, xmin, xmax-xmin+1);
		 cursoroff;        {SFB 9/24/86 - for 98549A}
		 for i:=ymin to ymax do
		   cchar (ord(' '), xmax, i);
		 cursoron;         {SFB 9/24/86 - for 98549A}
	       end;

    dbscrollr: begin
		 cdbscrollr(ymin, ymax, xmin, xmax-xmin+1);
		 cursoroff;        {SFB 9/24/86 - for 98549A}
		 for i:=ymin to ymax do
		   cchar (ord(' '), xmin, i);
		 cursoron;         {SFB 9/24/86 - for 98549A}
	       end;

    dbhighl: ; { Not implemented for color bitmap displays }

    dbput: begin
	     cursoroff;        {SFB 9/24/86 - for 98549A}
	     i:=highlight; highlight:=debughighlight;
	     if charismapped then
	       cchar( maptocrt(c), cursx, cursy)
	     else
	       cchar( ord(c), cursx, cursy);
	     highlight:=i;
	     cursoron;         {SFB 9/24/86 - for 98549A}
	   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;
	dcursoraddr:=frameaddr;
	areaisdbcrt:=true;
	charismapped:=false;
	debughighlight:=0;
      end;

    dbexcg:
      begin
	if softcursor then
	 cursoroff;        {SFB 9/24/86 - for 98549A}
	cexchange( savearea, ymin, ymax, xmin, (xmax-xmin+1)*fontwidth);

	if softcursor then
	 begin
	  tempaddr := cursoraddr;
	  cursoraddr := dcursoraddr;
	  dcursoraddr := tempaddr;
	  cursoron;         {SFB 9/24/86 - for 98549A}
	 end
	else
	 if areaisdbcrt then
	   cupdatecursor(cursx, cursy)
	 else
	   doupdatecursor;

	areaisdbcrt:=not areaisdbcrt;
      end;


  end; { of case }
end; { of with }
end; { crtdebug procedure }

procedure dummy;
begin end;


procedure bobcatinit;
 var i: shortint;

 begin
 idle:=245;                          { set io char to roman8 value }
 with syscom^.crtinfo do begin
   hascolor:=false;
   screenwidth:=width;
   screenheight:=height;
   maxx:=screenwidth-1;
   maxy:=screenheight-1;
   screensize:=screenwidth*screenheight;
   cbuildtable;
   highlight:=0; defaulthighlight:=0;
   gotoxy(0,0);
   dumpalphahook := dumpg;
   dumpgraphicshook := dumpg;
   updatecursorhook:=doupdatecursor;
   dbcrthook:=crtdebug;
   crtllhook:=lineops;
   crtiohook:=docrtio;
   crtinithook:=bobcatinit;
   togglealphahook:=dummy;
   togglegraphicshook:=dummy;
   currentcrt:=bitmaptype;
   keybuffer^.maxsize:=maxx-8;
end;
end;



function bobcattype:boolean;

const newbitmapid=57; {primary id for new bitmap displays}
      bobcatsecid=2;  {bobcat secondary id}
      catseyesecid=5;  {bobcat secondary id}
var ptr: ^shortint;
    i: shortint;
    dummy: shortint;
    found: boolean;

begin

found:=false;
ptr:=anyptr(hex('560000'));

try
  dummy:=ptr^;
  if (dummy mod 128) = newbitmapid then begin
    ptr:=anyptr(integer(ptr)+20);  { look at secondary id }
    dummy:=ptr^ mod 128;
    if (dummy=bobcatsecid) {or (dummy=catseyesecid)} then begin  {SFB 9/22/86}
    {removed catseyesecid filter because this dvr doesn't support LCC
     6/8/88 SFB}
     found:=true; bitmapaddr:=integer(ptr)-20;
     ptr:=anyptr(integer(bitmapaddr)+22);

     softcursor := false; {(dummy=catseyesecid);        {SFB 9/25/86}
    {set softcursor to false because this dvr doesn't support LCC (which
     requires soft cursor)
     6/8/88 SFB}

     dummy:=ptr^ ;
     if odd(dummy) then lowres:=true
     else lowres:=false;

    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:=25;
  end;
  bobcatinit;
end;
bobcattype:=found;
end;  { bobcattype }


end;  { of module -- I hope }

import crtbc, loader;

begin
  if bobcattype then markuser;
end.

@


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


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

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

program initcrtbc(OUTPUT);


module crtbc;
import sysglobals, asm, misc, sysdevs;
export

function bobcattype: boolean;

implement

const


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






var

fontwidth: shortint;
fontht: shortint;
screenwidth: shortint;
screenheight:shortint;
maxx: shortint;
maxy: shortint;
screensize:shortint;
defaulthighlight: shortint;
highlight: shortint;
planemask: shortint;
lowres: boolean;
hascolor: boolean;
holdcursor : array[0..3] of integer;    {SFB 9/24/86 - for 98549A}
cursoraddr : integer;                   {SFB 9/24/86 - for 98549A}
softcursor : boolean;                   {SFB 9/24/86 - for 98549A}


procedure  cchar(c,x,y:shortint);external;
procedure  cursoroff; external;
procedure  cursoron; 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 dumpg ;


label 1;

const
  gwidthb = 128;
  gmaxheight = 512;
  gbuffersize = gwidthb + 7;

type
  gbyte = 0..255;
  row_def = packed array [0..(1024*768)-1] of gbyte;

var
  row : ^row_def;

  gbuffer : packed array [1..gbuffersize] of char;
  i,j : integer;
  index : integer;
  bit_mask : integer;
  result : integer;
  nrows: integer;

begin

  row := anyptr(frameaddr);

  write(gfiles[4]^,#27'*rA');   { initiate graphics sequence }

  gbuffer[1] := chr(27); { escape sequence for graphics }
  gbuffer[2] := '*';
  gbuffer[3] := 'b';
  gbuffer[4] := '1';
  gbuffer[5] := '2';
  gbuffer[6] := '8';
  gbuffer[7] := 'W';

  if lowres then nrows:=399
     else nrows:=767;

  for j := 0 to nrows do
    begin
      for i := 0 to 127 do
	begin
	  result := 0;
	  index := j*1024+i*8;
	  bit_mask := 256;
	  for index := index to index+7 do
	    begin
	      bit_mask := bit_mask div 2; { fix for low-res mono display 7/23/85 JWS}
	      if iand(row^[index],planemask div 256)<>0  then result := bit_mask+result;
	    end;
	  gbuffer[i+8] := chr(result);
	end;
	write(gfiles[4]^,gbuffer:gwidthb+7);
	if ioresult <> ord(inoerror) then goto 1;
	if lowres then
	  write(gfiles[4]^,gbuffer:gwidthb+7);
	if ioresult <> ord(inoerror) then goto 1;
    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 gotoxy(x,y: integer);
begin
  setxy(x,y);
  doupdatecursor;
end;


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

procedure scrollup;
begin
  cscrollup;
end;

procedure scrolldown;
begin
  cscrolldown;
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;



procedure docrtio(fp: fibp; request: amrequesttype; anyvar buffer: window;
						   length, position: integer);
var c: char;
    s: string[1];
    buf: charptr;
begin
 ioresult := ord(inoerror);
 buf := addr(buffer);
 case request of
  {uwait: ;              }
  setcursor: gotoxy(fp^.fxpos, fp^.fypos);
  getcursor: getxy (fp^.fxpos, fp^.fypos);
  flush:  {do nothing};
  unitstatus:  kbdio(fp, request, buffer, length, position);
  clearunit: begin
	      highlight := defaulthighlight;
	      cclearall;
	     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 if s[1] = chr(etx) 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 scrollup;
		gotoxy(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 scrolldown;
			 if ypos>0 then setxy(xpos, ypos-1);
		   end;
       downchar:   if ypos=maxy then scrollup
		   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
		     if hascolor then
		       if (ord(c)>=136) then
			 highlight:= highlight mod 2048 +
			   (ord(c)-136)*4096
		       else
			 highlight:=((highlight div 2048)*8
				  +(ord(c)-128))*256
		     else highlight:=(ord(c)-128)*256
		   else
		     begin
		      cursoroff;        {SFB 9/24/86 - for 98549A}
		      cchar(maptocrt(c),xpos,ypos);
		      cursoron;         {SFB 9/24/86 - for 98549A}
		      if xpos = maxx then
			begin
			  if ypos = maxy then scrollup;
			  setxy(0, ypos+1);
			end
		      else setxy(xpos+1, ypos);
		     end;
       end;
     doupdatecursor;
     end; {while}
    if request = startwrite then call(fp^.feot, fp);
    end;
  otherwise ioresult := ord(ibadrequest);
 end; {case}
end;

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

var i,j: shortint;
    sptr: ^string255;

begin

j:=highlight; highlight:=defaulthighlight;

case op of

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

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

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

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

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

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

end; { of case }
highlight:=j;

end;

procedure crtdebug(op: dbcrtops; var dbrec: dbcinfo);

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

var i: shortint;
    j: integer;
    tempaddr : integer;
    xtemp: shortint;
    ytemp: shortint;

begin
with dbrec do begin
  case op of

    dbinfo: savesize:=(xmax-xmin+1)*(ymax-ymin+1)*fontwidth
		      * fontht;

    dbgotoxy: cupdatecursor(cursx, cursy);

    dbscrollup: begin
		  if ymax > ymin  {DEW 11/1/88 DEFECT: FSDdt00760}
		  then
		      cscrollwindow( ymin, ymax, xmin, xmax-xmin+1);
		  cclear(xmin, ymax, xmax-xmin+1);
		end;

    dbscrolldn: begin
		  if ymax > ymin  {DEW 11/1/88 DEFECT: FSDdt00760}
		  then
		      cscrollwinddn(ymin, ymax, xmin, xmax-xmin+1);
		  cclear(xmin, ymin, xmax-xmin+1);
		end;

    dbscrolll: begin
		 cdbscrolll(ymin, ymax, xmin, xmax-xmin+1);
		 cursoroff;        {SFB 9/24/86 - for 98549A}
		 for i:=ymin to ymax do
		   cchar (ord(' '), xmax, i);
		 cursoron;         {SFB 9/24/86 - for 98549A}
	       end;

    dbscrollr: begin
		 cdbscrollr(ymin, ymax, xmin, xmax-xmin+1);
		 cursoroff;        {SFB 9/24/86 - for 98549A}
		 for i:=ymin to ymax do
		   cchar (ord(' '), xmin, i);
		 cursoron;         {SFB 9/24/86 - for 98549A}
	       end;

    dbhighl: ; { Not implemented for color bitmap displays }

    dbput: begin
	     cursoroff;        {SFB 9/24/86 - for 98549A}
	     i:=highlight; highlight:=debughighlight;
	     if charismapped then
	       cchar( maptocrt(c), cursx, cursy)
	     else
	       cchar( ord(c), cursx, cursy);
	     highlight:=i;
	     cursoron;         {SFB 9/24/86 - for 98549A}
	   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;
	dcursoraddr:=frameaddr;
	areaisdbcrt:=true;
	charismapped:=false;
	debughighlight:=0;
      end;

    dbexcg:
      begin
	if softcursor then
	 cursoroff;        {SFB 9/24/86 - for 98549A}
	cexchange( savearea, ymin, ymax, xmin, (xmax-xmin+1)*fontwidth);

	if softcursor then
	 begin
	  tempaddr := cursoraddr;
	  cursoraddr := dcursoraddr;
	  dcursoraddr := tempaddr;
	  cursoron;         {SFB 9/24/86 - for 98549A}
	 end
	else
	 if areaisdbcrt then
	   cupdatecursor(cursx, cursy)
	 else
	   doupdatecursor;

	areaisdbcrt:=not areaisdbcrt;
      end;


  end; { of case }
end; { of with }
end; { crtdebug procedure }

procedure dummy;
begin end;


procedure bobcatinit;
 var i: shortint;

 begin
 idle:=245;                          { set io char to roman8 value }
 with syscom^.crtinfo do begin
   hascolor:=false;
   screenwidth:=width;
   screenheight:=height;
   maxx:=screenwidth-1;
   maxy:=screenheight-1;
   screensize:=screenwidth*screenheight;
   cbuildtable;
   highlight:=0; defaulthighlight:=0;
   gotoxy(0,0);
   dumpalphahook := dumpg;
   dumpgraphicshook := dumpg;
   updatecursorhook:=doupdatecursor;
   dbcrthook:=crtdebug;
   crtllhook:=lineops;
   crtiohook:=docrtio;
   crtinithook:=bobcatinit;
   togglealphahook:=dummy;
   togglegraphicshook:=dummy;
   currentcrt:=bitmaptype;
   keybuffer^.maxsize:=maxx-8;
end;
end;



function bobcattype:boolean;

const newbitmapid=57; {primary id for new bitmap displays}
      bobcatsecid=2;  {bobcat secondary id}
      catseyesecid=5;  {bobcat secondary id}
var ptr: ^shortint;
    i: shortint;
    dummy: shortint;
    found: boolean;

begin

found:=false;
ptr:=anyptr(hex('560000'));

try
  dummy:=ptr^;
  if (dummy mod 128) = newbitmapid then begin
    ptr:=anyptr(integer(ptr)+20);  { look at secondary id }
    dummy:=ptr^ mod 128;
    if (dummy=bobcatsecid) {or (dummy=catseyesecid)} then begin  {SFB 9/22/86}
    {removed catseyesecid filter because this dvr doesn't support LCC
     6/8/88 SFB}
     found:=true; bitmapaddr:=integer(ptr)-20;
     ptr:=anyptr(integer(bitmapaddr)+22);

     softcursor := false; {(dummy=catseyesecid);        {SFB 9/25/86}
    {set softcursor to false because this dvr doesn't support LCC (which
     requires soft cursor)
     6/8/88 SFB}

     dummy:=ptr^ ;
     if odd(dummy) then lowres:=true
     else lowres:=false;

    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:=25;
  end;
  bobcatinit;
end;
bobcattype:=found;
end;  { bobcattype }


end;  { of module -- I hope }

import crtbc, loader;

begin
  if bobcattype then markuser;
end.

@


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


29.4
log
@DEFECT FSDdt00760 was not properly fixed.
After turning 3.22A and verifying this fix, found an error.
It was determined that the new error was of sufficient
severity to do a partial rebuild of 3.22A to incorporate this
fix.

RCS version 30.1 of this file was deleted using the rcs -o.
This file goes into 29.4 and then we will go to 30.1.  This
keeps the 3.22A release in RCS version 29.x.  revlog3.22
is also updated to reflect this.
@
text
@@


29.3
log
@Oops.  typo on the fix.
DEW 11/1/88
@
text
@d453 1
a453 1
		  if ymax < ymin  {DEW 11/1/88 DEFECT: FSDdt00760}
d460 1
a460 1
		  if ymax < ymin  {DEW 11/1/88 DEFECT: FSDdt00760}
@


29.2
log
@Fixed defect FSDdt00760 for this display type.
The problem was that a scroll up or down on a one line high
debugger window caused the screen to corrupt.  Only recovery was
to reboot.
DEW 11/1/88
@
text
@d454 1
d461 1
@


29.1
log
@Automatic bump of revision number for PWS version 3.22b
@
text
@d453 2
a454 1
		  cscrollwindow( ymin, ymax, xmin, xmax-xmin+1);
d459 2
a460 1
		  cscrollwinddn(ymin, ymax, xmin, xmax-xmin+1);
@


28.1
log
@Automatic bump of revision number for PWS version 3.3b
@
text
@@


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


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


25.2
log
@Added fix not to recognize LCC (CATSEYE p/n 98549A), as this caused
interaction with CRT and CRTC. CRTC was recognizing LCC, partly setting
up to handle it (changing CRT descriptor globals), then failing to
complete the setup, due to incompatibilities with Topcats. The proper
driver is CRTE, and that supports LCC. Scott.
@
text
@@


25.1
log
@Automatic bump of revision number for PWS version 3.2Y
@
text
@d30 1
d32 1
d591 3
a593 1
    if (dummy=bobcatsecid) or (dummy=catseyesecid) then begin  {SFB 9/22/86}
d597 4
a600 5
     {
     DUMMY := CATSEYESECID;
     {}

     softcursor := (dummy=catseyesecid);        {SFB 9/25/86}
@


24.1
log
@Automatic bump of revision number for PWS version 3.2
@
text
@@


23.1
log
@Automatic bump of revision number for PWS version 3.2P
@
text
@@


22.1
log
@Automatic bump of revision number for PWS version 3.2N
@
text
@@


21.1
log
@Automatic bump of revision number for PWS version 3.2M
@
text
@@


20.1
log
@Automatic bump of revision number for PWS version 3.2L
@
text
@@


19.1
log
@Automatic bump of revision number for PWS version 3.2K
@
text
@@


18.1
log
@Automatic bump of revision number for PWS version 3.2J
@
text
@@


17.1
log
@Automatic bump of revision number for PWS version 3.2I+
@
text
@@


16.1
log
@Automatic bump of revision number for PWS version 3.2I
@
text
@@


15.1
log
@Automatic bump of revision number for PWS version 3.2H
@
text
@@


14.1
log
@Automatic bump of revision number for PWS version 3.2G
@
text
@@


13.1
log
@Automatic bump of revision number for PWS version 3.2F
@
text
@@


12.1
log
@Automatic bump of revision number for PWS version 3.2E
@
text
@@


11.1
log
@Automatic bump of revision number for PWS version 3.2D
@
text
@@


10.1
log
@Automatic bump of revision number for PWS version 3.2C
@
text
@@


9.1
log
@Automatic bump of revision number for PWS version 3.2B
@
text
@@


8.1
log
@Automatic bump of revision number for PWS version 3.2A
@
text
@@


7.1
log
@Automatic bump of revision number for PWS version 3.2l
@
text
@@


6.1
log
@Automatic bump of revision number for PWS version 3.2k
@
text
@@


5.2
log
@Changes from Scott Bayes
@
text
@@


5.1
log
@Automatic bump of revision number for PWS version 3.2j
@
text
@d29 1
d32 1
a32 1
program initcrtbc;
d110 3
d114 1
d367 1
d369 1
d437 1
d462 1
d465 1
d470 1
d473 1
d479 1
d486 1
d509 2
d512 8
a519 2
	if areaisdbcrt then
	  cupdatecursor(cursx, cursy)
d521 5
a525 1
	  doupdatecursor;
d573 1
d589 1
a589 1
    if dummy=bobcatsecid then begin
d592 7
d602 1
@


4.1
log
@Automatic bump of revision number for PWS version 3.2i
@
text
@@


3.1
log
@Automatic bump of revision number for PWS version 3.2h
@
text
@@


2.1
log
@Auto bump rev number to 2.1 for sys 3.2e.
@
text
@@


1.1
log
@Initial revision
@
text
@@
