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


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

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

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

55.1
date     91.08.25.10.29.32;  author jwh;  state Exp;
branches ;
next     54.3;

54.3
date     91.08.21.10.33.18;  author jwh;  state Exp;
branches ;
next     54.2;

54.2
date     91.08.21.09.38.16;  author jwh;  state Exp;
branches ;
next     54.1;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

30.1
date     88.12.09.13.54.20;  author dew;  state Exp;
branches ;
next     29.1;

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

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

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

26.1
date     88.09.28.13.29.13;  author bayes;  state Exp;
branches ;
next     25.1;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

6.1
date     86.11.04.18.20.17;  author paws;  state Exp;
branches ;
next     5.1;

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

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

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

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

1.1
date     86.06.30.16.22.10;  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, 1984.
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                         *)

$UCSD$
$modcal$
$heap_dispose off$
$iocheck off$
$range off$ $ovflcheck off$
$debug off$
$stackcheck off$
$search  'INITLOAD','ASM','INIT','SYSDEVS'$
$ALLOW_PACKED ON$    { JWS 4/10/85}

program initcrt;

module crt;
import sysglobals, asm, misc, sysdevs;
export
function alphacrt: boolean;

implement

const
minkana = 161;
maxkana = 223;
yenromlocation = 128; { location of Yen symbol in old CRT rom }

type


kanatocrtlookuptype = packed array [minkana..maxkana] of 128..255;
romtokanatype = packed array[#128..#238] of 0..255;

crtregtype = 0..15;
crtcmdwrd = packed record case integer of
		0: (topbyte, botbyte: byte);
		1: (longword: shortint);
		2: (p1,p2, textfield, softfield: boolean);
	      end;

 crtscreen = array[0..maxint] of crtword;
 scrptr = ^crtscreen;


const
kanatocrtlookup = kanatocrtlookuptype [
    { code 161 }      129,130,131,132,133,134,135,
    { code 168 }  136,137,138,139,140,141,142,143,
    { code 176 }  144,145,146,147,148,149,150,151,
    { code 184 }  152,153,154,155,156,157,158,159,
    { code 192 }  160,161,162,163,164,165,166,167,
    { code 200 }  173,174,177,178,180,188,190,191,
    { code 208 }  224,225,226,227,228,229,230,231,
    { code 216 }  232,233,234,235,236,237,238,179  ];

  romtokanamap = romtokanatype         [  92, 161, 162,
      163, 164, 165, 166, 167, 168, 169, 170, 171, 172,
      173, 174, 175, 176, 177, 178, 179, 180, 181, 182,
      183, 184, 185, 186, 187, 188, 189, 190, 191, 192,
      193, 194, 195, 196, 197, 198, 199, 168, 169, 170,
      171, 172, 200, 201, 175, 176, 202, 203, 223, 204,
      181, 182, 183, 184, 185, 186, 187, 205, 189, 206,
      207, 192, 193, 194, 195, 196, 197, 198, 199, 200,
      201, 202, 203, 204, 205, 206, 207, 208, 209, 210,
      211, 212, 213, 214, 215, 216, 217, 218, 219, 220,
      221, 222, 223, 208, 209, 210, 211, 212, 213, 214,
      215, 216, 217, 218, 219, 220, 221, 222];


  b9826info=crtirec[
	   width :80,height:24,
	   crtmemaddr:5316608          { + 416},
	   crtcontroladdr:5341185,
	   keybufferaddr: 5320448         {  + 416},
	   progstateinfoaddr: 5320592         {  + 416},
	   keybuffersize: 72,
	   crtcon:
	   crtconsttype [114,80,76,7,26,10,25,25,0,14,76,13],
	   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];


  environc=environ[miscinfo:crtfrec[
				    nobreak:false,
				    stupid :false,
				    slowterm:false,
				    hasxycrt:true,
				    haslccrt:true,  {?}
				    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 :50,height:24,
				    crtmemaddr:5316608,
				    crtcontroladdr:5308417,
				    keybufferaddr: 5319008,
				    progstateinfoaddr: 5319092,
				    keybuffersize: 42,
				    crtcon: crtconsttype [64,50,49,10,25,9,25,
							  25,0,11,74,11],
				    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

lptr:  scrptr;
screenwidth: integer;
screenheight: integer;


maxx,maxy,screensize:shortint;
screen:scrptr;
defaulthighlight: shortint;

highlight:  shortint;
hascolor: boolean;
pm6845addrreg:^char;
pm6845comdreg:^char;
nomap:  boolean;                           { 3.0 bug fix jws 3/20/84 }

crtidreg[hex('51FFFE')]: packed record
      b15,b14,b13: boolean;
      colorinfo: (cinfo0, cinfo1, cinfo2, cinfo3);
      b10,b9,b8,b7,b6,b5,b4,b3,b2,b1,b0: boolean;
      end;


procedure dumpa;
label 1;
var   row, column:integer;
      c: char;
      line: string[100];
begin with syscom^.crtinfo do
  begin
  setstrlen(line, width);
  for row := 0 to height-1 do
    begin
    for column := 0 to width-1 do
      begin
      c := screen^[row*width+column].character;
      if (c >= #128) and (c <= #238) then c := chr(romtokanamap[c]);
      line[column+1] := c;
      end;
    column := width;
    while (column > 1) and (line[column]= ' ') do column := column - 1;
    writeln(gfiles[4]^, line:column);
    if ioresult <> ord(inoerror) then goto 1;
    end;
  end;
1: end;

procedure toggleg;
var gon [5439488{530000 HEX}]:shortint;
    goff[5472256{538000 HEX}]:shortint;
    gbase['GRAPHICSBASE']: ^shortint;

begin
  graphicstate:=not graphicstate;
  if graphicstate then gbase:=addr(gon)
		  else gbase:=addr(goff);
  gbase^ := gbase^;
end;

procedure dumpg;
label 1;
const gheight = 300;    gheightb = 390;
      gwidth = 50;      gwidthb  = 64;
      gbuffersize=gwidthb+6;
type  gword=packed record
	     dummy,growbyte:char;
	     end;
gdotrow=packed array[1..gwidth] of gword;
type gmemtype =  packed array [1..gheight] of gdotrow;
     gmembtype = packed array [1..gheightb, 1..gwidthb] of char;
     gmem =  ^gmemtype;
     gmemb = ^gmembtype;
var   graphicsbase['GRAPHICSBASE']:  anyptr;
      gbuffer:packed array[1..gbuffersize] of char;
      i,j,rows,buffersize,pindex:integer;
      busy:boolean;
begin
  gbuffer[1]:=chr(esc) {escape sequence for graphics};
  gbuffer[2]:='*';
  gbuffer[3]:='b';
  gbuffer[6]:='W';
  if sysflag.biggraphics then
       begin
       gbuffer[4]:='6';
       gbuffer[5]:='4';
       rows := gheightb;
       buffersize := gwidthb+6;
       end
  else begin
       gbuffer[4]:='5';
       gbuffer[5]:='0';
       rows := gheight;
       buffersize := gwidth+6;
       end;
  for i:= 1 to rows do
    begin
    if sysflag.biggraphics then
     for j:=1 to gwidthb do gbuffer[j+6]:=gmemb(graphicsbase)^[i,j] else
       for j:=1 to gwidth  do gbuffer[j+6]:=gmem(graphicsbase)^[i,j].growbyte;
    write(gfiles[4]^, gbuffer:buffersize);
    if ioresult <> ord(inoerror) then goto 1;
    end;
  write(gfiles[4]^, #27'*rB'); {terminate graphics sequence};
1:
end;

procedure crtcommand(reg: crtregtype; data: byte);
begin
    pm6845addrreg^ := chr(reg);
    pm6845comdreg^ := chr(data);
end;

procedure doupdatecursor;
var cursaddr: crtcmdwrd;
begin
  cursaddr.longword:=integer(screen) mod 8192 div 2 + ypos*screenwidth+xpos;
  cursaddr.textfield := alphastate;
  cursaddr.softfield:=alphastate;
  crtcommand(14, cursaddr.topbyte);
  crtcommand(15, cursaddr.botbyte);
end;

procedure togglea;
var   lcursaddr:crtcmdwrd;

begin
  alphastate:=not(alphastate);
  lcursaddr.longword:=integer(screen) mod 8192 div 2;
  lcursaddr.textfield:=alphastate;
  lcursaddr.softfield:=alphastate;
  crtcommand(12, lcursaddr.topbyte);
  crtcommand(13, lcursaddr.botbyte);
  doupdatecursor;
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;
begin
  x:=xpos; y:=ypos;
  while number>0 do
    begin
      screen^[y*screenwidth+x].wholeword:= ord(' ');
      number:=number-1;
      if x<maxx then x:=x+1
      else begin x:=0; if y<maxy then y:=y+1 end;
    end;
end;

procedure scrollup;
var i: shortint;
begin
  moveleft(screen^[screenwidth{1, 0}],
	   screen^[0{0, 0}],
	   (screensize-screenwidth)*2);
  for i:=0 to maxx do
    screen^[maxy*screenwidth+i].wholeword:=ord(' ');
end;

procedure scrolldown;{new  4/30/81}
var i: shortint;
begin
  moveright(screen^[0{0, 0}],
	   screen^[screenwidth{1, 0}],
	   (screensize-screenwidth)*2);
  for i:=0 to maxx do screen^[i].wholeword := ord(' ');
end;




function maptocrt(c:char):char;

const illegalchar = #223;
		     { char to disp for illegal internal codes; looks like hp }
procedure mapromextocrt;
const
      minromex = 168; { lookup table ranges }
      maxromex = 255;
type  romexsettype = set of minromex..maxromex;
const romexset = romexsettype [168..172,175,176,179,181..187,189,192..222,255];
							  { legal Romex codes }
begin
    if (ord(c) < 128) or (ord(c) in romexset)
		      or nomap  then    {  3.0 bug fix  jws 3/20/84}
      maptocrt:=c
    else
      if ord(c)=188  { ROMAN8 yen char}                  { jws 3/1/84 }
	then maptocrt:=chr(yenromlocation)               { jws 3/1/84 }
      else
	maptocrt:=illegalchar;
end;


procedure mapkanatocrt ;

const yencode = 92;


{ Converts Katakana codes to their correct "old" CRT rom location codes; also,
  converts "illegal" Kana chars to the "hp" char.  Note that the Yen symbol
  overlays the USASCII backslash (\), and that code 255 is left unconverted. }


begin
  if nomap then maptocrt:=c
  else begin
    if ord(c) = yencode then maptocrt := chr(yenromlocation)
    else if (ord(c) < 128) or (ord(c) = 255) then maptocrt:= c
    else begin
      if (ord(c) < minkana) or (ord(c) > maxkana) then maptocrt := illegalchar
      else maptocrt := chr(kanatocrtlookup[ord(c)]);
    end;
  end;
end; { mapkanatocrt }

begin
  if kbdlang = katakana_kbd then mapkanatocrt
  else mapromextocrt;
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: highlight := defaulthighlight;
  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 with screen^[ypos*screenwidth+xpos] do
		     begin
		      wholeword:=highlight+ ord(maptocrt(c));
		      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: integer;
  sptr: ^string255;

begin
case op of
  cllput: lptr^[position].wholeword:=ord(maptocrt(c));

  cllshiftl:
     begin
       for i:=0 to (maxx-8) do lptr^[i]:=lptr^[i+1];
       lptr^[maxx-8].wholeword:=ord(' ');
     end;

  cllshiftr:
     begin
       for i:=0 to (maxx-9) do lptr^[maxx-8-i]:=lptr^[maxx-9-i];
       lptr^[0].wholeword:=ord(' ');
     end;

  cllclear:
     for i:=0 to (maxx-8) do lptr^[i].wholeword:=ord(' ');

  clldisplay:
     begin
       sptr:=addr(position);
       for i:=1 to length(sptr^) do
	 lptr^[i-1].wholeword:=ord(maptocrt(sptr^[i]));
       for i:=length(sptr^) to (maxx-8) do
	 lptr^[i].wholeword:=ord(' ');
     end;

  putstatus:
     begin { position should be in range 0..7 }
       lptr^[maxx-7+position].wholeword:=ord(c);
     end;

end; { case}

end; { lineops }

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

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

var
  xtemp, ytemp: shortint;
  i,j,k: shortint;
  len: shortint;
  inc: shortint;
  temp: array[0..79] of shortint;


begin
with dbrec do begin
  case op of

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

    dbgotoxy:
      begin
	xtemp:=xpos; ytemp:=ypos;
	xpos:=cursx; ypos:=cursy;
	doupdatecursor;
	xpos:=xtemp; ypos:=ytemp;
      end;

    dbscrollup,dbscrolldn:
      begin
	len:=(xmax-xmin+1)*2;
	if op=dbscrollup then begin
	  j:=ymin;
	  inc:=screenwidth;
	end
	else begin
	  j:=ymax;
	  inc:=-screenwidth;
	end;
	j:=j*screenwidth+xmin;
	for i:=(ymin+1) to ymax do begin
	  k:=j; j:=j+inc;
	  moveleft(screen^[j], screen^[k], len);
	end;
	for i:=0 to (xmax-xmin) do
	  screen^[j+i].wholeword:=ord(' ');
      end;

    dbscrolll,dbscrollr:
      begin
	len:=(xmax-xmin+1)*2-2;     { fixed  4/13/84 }
	j:=(ymin-1)*screenwidth+xmin;
	if op=dbscrolll then begin
	  j:=j+1;
	  k:=xmax-xmin-1;
	end
	else begin
	  k:=0;
	end;
	for i:=ymin to ymax do begin
	 j:=j+screenwidth;
	 if op=dbscrolll then
	   moveleft(screen^[j],screen^[j-1], len)
	 else
	   moveright(screen^[j],screen^[j+1], len);
	 screen^[j+k].wholeword:=ord(' ');
	end;
      end;

    dbhighl:
      begin
	i:=cursy*screenwidth+cursx;
	screen^[i].wholeword:=ord(screen^[i].character)+(ord(c)-128)*256;
      end;


    dbput: if charismapped then
	     screen^[cursy*screenwidth+cursx].wholeword:=
				      ord(maptocrt(c))+debughighlight
	   else
	     screen^[cursy*screenwidth+cursx].wholeword:=ord(c)+
						       debughighlight;

    dbclear:
      for i:=ymin to ymax do
	for j:=xmin to xmax do
	  screen^[i*screenwidth+j].wholeword:=ord(' ');

    dbcline:
      for i:=cursx to xmax do
	screen^[cursy*screenwidth+i].wholeword:=ord(' ');

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

    dbexcg:
      begin
	k:=xmax-xmin+1;
	for i:=ymin to ymax do begin
	  moveleft(screen^[i*screenwidth+xmin], temp, k*2);
	  moveleft(iptr(savearea)^[(i-ymin)*k],
		   screen^[i*screenwidth+xmin], k*2);
	  moveleft(temp, iptr(savearea)^[(i-ymin)*k], k*2);
	end;
	if areaisdbcrt then begin
	  xtemp:=xpos; ytemp:=ypos;
	  xpos:=cursx; ypos:=cursy;
	  doupdatecursor;
	  xpos:=xtemp; ypos:=ytemp;
	end
	else doupdatecursor;
	areaisdbcrt:=not areaisdbcrt;
      end;



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

procedure alphacrtinit;
 var cursaddr: crtcmdwrd; i,k: integer;
 begin
   with syscom^.crtinfo do
   begin
     screen:=anyptr(crtmemaddr);
     screenwidth:=width;
     screenheight:=height;
     maxx:=width-1;
     maxy:=height-1;
     screensize:=width*height;

     for i:=0 to screensize-1 do screen^[i].wholeword:=ord(' ');  {clear screen}
     pm6845addrreg:=anyptr(crtcontroladdr);
     pm6845comdreg:=anyptr(crtcontroladdr+2);
     cursaddr.longword:=integer(screen) mod 8192 div 2;
     cursaddr.textfield:=alphastate;
     cursaddr.softfield:=alphastate;
     crtcommand(12, cursaddr.topbyte);
     crtcommand(13, cursaddr.botbyte);
     defaulthighlight := 0; highlight := 0;

     idle:=250;
     nomap:=false;
     if sysflag.crtconfigreg then begin
       if crtidreg.b13 then begin         { 3.0 bug jws 3/20/84 }
	 nomap:=true;                 { 3.0 bug jws 3/20/84 }
	 idle:=245;                       { 3.0 bug jws 3/20/84 }
       end;                               { 3.0 bug jws 3/20/84 }
       hascolor := crtidreg.colorinfo > cinfo0;
     end
     else hascolor := false;

     gotoxy(0,0);
     dumpalphahook := dumpa;
     dumpgraphicshook := dumpg;
     togglealphahook := togglea;
     togglegraphicshook := toggleg;
     updatecursorhook:=doupdatecursor;
     crtiohook:=docrtio;
     crtllhook:=lineops;
     dbcrthook:=crtdebug;
     crtinithook:=alphacrtinit;
     lptr:=anyptr(keybufferaddr);
     keybuffer^.maxsize:=maxx-8;
     currentcrt:=alphatype;
   end;
 end;

function alphacrt:boolean;
var i[hex('512000')]:shortint;
    j: shortint;
begin
alphacrt:=true;  { assume we have alpha screen }
try
  j:=i;   { attempt read from alpha screen ram }
  syscom^:=environc;  { setup for my kind of environment }
  if not sysflag.alpha50 then syscom^.crtinfo:=b9826info;
  alphacrtinit;
recover
  if escapecode=-12 then
    alphacrt:=false  { bus error -- no alpha screen }
  else escape(escapecode);
end;

end; {  of module }


import crt, loader;

begin
  if alphacrt then markuser;
end.

@


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


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

 (c) Copyright Hewlett-Packard Company, 1984.
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                         *)

$UCSD$
$modcal$
$heap_dispose off$
$iocheck off$
$range off$ $ovflcheck off$
$debug off$
$stackcheck off$
$search  'INITLOAD','ASM','INIT','SYSDEVS'$
$ALLOW_PACKED ON$    { JWS 4/10/85}

program initcrt;

module crt;
import sysglobals, asm, misc, sysdevs;
export
function alphacrt: boolean;

implement

const
minkana = 161;
maxkana = 223;
yenromlocation = 128; { location of Yen symbol in old CRT rom }

type


kanatocrtlookuptype = packed array [minkana..maxkana] of 128..255;
romtokanatype = packed array[#128..#238] of 0..255;

crtregtype = 0..15;
crtcmdwrd = packed record case integer of
		0: (topbyte, botbyte: byte);
		1: (longword: shortint);
		2: (p1,p2, textfield, softfield: boolean);
	      end;

 crtscreen = array[0..maxint] of crtword;
 scrptr = ^crtscreen;


const
kanatocrtlookup = kanatocrtlookuptype [
    { code 161 }      129,130,131,132,133,134,135,
    { code 168 }  136,137,138,139,140,141,142,143,
    { code 176 }  144,145,146,147,148,149,150,151,
    { code 184 }  152,153,154,155,156,157,158,159,
    { code 192 }  160,161,162,163,164,165,166,167,
    { code 200 }  173,174,177,178,180,188,190,191,
    { code 208 }  224,225,226,227,228,229,230,231,
    { code 216 }  232,233,234,235,236,237,238,179  ];

  romtokanamap = romtokanatype         [  92, 161, 162,
      163, 164, 165, 166, 167, 168, 169, 170, 171, 172,
      173, 174, 175, 176, 177, 178, 179, 180, 181, 182,
      183, 184, 185, 186, 187, 188, 189, 190, 191, 192,
      193, 194, 195, 196, 197, 198, 199, 168, 169, 170,
      171, 172, 200, 201, 175, 176, 202, 203, 223, 204,
      181, 182, 183, 184, 185, 186, 187, 205, 189, 206,
      207, 192, 193, 194, 195, 196, 197, 198, 199, 200,
      201, 202, 203, 204, 205, 206, 207, 208, 209, 210,
      211, 212, 213, 214, 215, 216, 217, 218, 219, 220,
      221, 222, 223, 208, 209, 210, 211, 212, 213, 214,
      215, 216, 217, 218, 219, 220, 221, 222];


  b9826info=crtirec[
	   width :80,height:24,
	   crtmemaddr:5316608          { + 416},
	   crtcontroladdr:5341185,
	   keybufferaddr: 5320448         {  + 416},
	   progstateinfoaddr: 5320592         {  + 416},
	   keybuffersize: 72,
	   crtcon:
	   crtconsttype [114,80,76,7,26,10,25,25,0,14,76,13],
	   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];


  environc=environ[miscinfo:crtfrec[
				    nobreak:false,
				    stupid :false,
				    slowterm:false,
				    hasxycrt:true,
				    haslccrt:true,  {?}
				    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 :50,height:24,
				    crtmemaddr:5316608,
				    crtcontroladdr:5308417,
				    keybufferaddr: 5319008,
				    progstateinfoaddr: 5319092,
				    keybuffersize: 42,
				    crtcon: crtconsttype [64,50,49,10,25,9,25,
							  25,0,11,74,11],
				    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

lptr:  scrptr;
screenwidth: integer;
screenheight: integer;


maxx,maxy,screensize:shortint;
screen:scrptr;
defaulthighlight: shortint;

highlight:  shortint;
hascolor: boolean;
pm6845addrreg:^char;
pm6845comdreg:^char;
nomap:  boolean;                           { 3.0 bug fix jws 3/20/84 }

crtidreg[hex('51FFFE')]: packed record
      b15,b14,b13: boolean;
      colorinfo: (cinfo0, cinfo1, cinfo2, cinfo3);
      b10,b9,b8,b7,b6,b5,b4,b3,b2,b1,b0: boolean;
      end;


procedure dumpa;
label 1;
var   row, column:integer;
      c: char;
      line: string[100];
begin with syscom^.crtinfo do
  begin
  setstrlen(line, width);
  for row := 0 to height-1 do
    begin
    for column := 0 to width-1 do
      begin
      c := screen^[row*width+column].character;
      if (c >= #128) and (c <= #238) then c := chr(romtokanamap[c]);
      line[column+1] := c;
      end;
    column := width;
    while (column > 1) and (line[column]= ' ') do column := column - 1;
    writeln(gfiles[4]^, line:column);
    if ioresult <> ord(inoerror) then goto 1;
    end;
  end;
1: end;

procedure toggleg;
var gon [5439488{530000 HEX}]:shortint;
    goff[5472256{538000 HEX}]:shortint;
    gbase['GRAPHICSBASE']: ^shortint;

begin
  graphicstate:=not graphicstate;
  if graphicstate then gbase:=addr(gon)
		  else gbase:=addr(goff);
  gbase^ := gbase^;
end;

procedure dumpg;
label 1;
const gheight = 300;    gheightb = 390;
      gwidth = 50;      gwidthb  = 64;
      gbuffersize=gwidthb+6;
type  gword=packed record
	     dummy,growbyte:char;
	     end;
gdotrow=packed array[1..gwidth] of gword;
type gmemtype =  packed array [1..gheight] of gdotrow;
     gmembtype = packed array [1..gheightb, 1..gwidthb] of char;
     gmem =  ^gmemtype;
     gmemb = ^gmembtype;
var   graphicsbase['GRAPHICSBASE']:  anyptr;
      gbuffer:packed array[1..gbuffersize] of char;
      i,j,rows,buffersize,pindex:integer;
      busy:boolean;
begin
  gbuffer[1]:=chr(esc) {escape sequence for graphics};
  gbuffer[2]:='*';
  gbuffer[3]:='b';
  gbuffer[6]:='W';
  if sysflag.biggraphics then
       begin
       gbuffer[4]:='6';
       gbuffer[5]:='4';
       rows := gheightb;
       buffersize := gwidthb+6;
       end
  else begin
       gbuffer[4]:='5';
       gbuffer[5]:='0';
       rows := gheight;
       buffersize := gwidth+6;
       end;
  for i:= 1 to rows do
    begin
    if sysflag.biggraphics then
     for j:=1 to gwidthb do gbuffer[j+6]:=gmemb(graphicsbase)^[i,j] else
       for j:=1 to gwidth  do gbuffer[j+6]:=gmem(graphicsbase)^[i,j].growbyte;
    write(gfiles[4]^, gbuffer:buffersize);
    if ioresult <> ord(inoerror) then goto 1;
    end;
  write(gfiles[4]^, #27'*rB'); {terminate graphics sequence};
1:
end;

procedure crtcommand(reg: crtregtype; data: byte);
begin
    pm6845addrreg^ := chr(reg);
    pm6845comdreg^ := chr(data);
end;

procedure doupdatecursor;
var cursaddr: crtcmdwrd;
begin
  cursaddr.longword:=integer(screen) mod 8192 div 2 + ypos*screenwidth+xpos;
  cursaddr.textfield := alphastate;
  cursaddr.softfield:=alphastate;
  crtcommand(14, cursaddr.topbyte);
  crtcommand(15, cursaddr.botbyte);
end;

procedure togglea;
var   lcursaddr:crtcmdwrd;

begin
  alphastate:=not(alphastate);
  lcursaddr.longword:=integer(screen) mod 8192 div 2;
  lcursaddr.textfield:=alphastate;
  lcursaddr.softfield:=alphastate;
  crtcommand(12, lcursaddr.topbyte);
  crtcommand(13, lcursaddr.botbyte);
  doupdatecursor;
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;
begin
  x:=xpos; y:=ypos;
  while number>0 do
    begin
      screen^[y*screenwidth+x].wholeword:= ord(' ');
      number:=number-1;
      if x<maxx then x:=x+1
      else begin x:=0; if y<maxy then y:=y+1 end;
    end;
end;

procedure scrollup;
var i: shortint;
begin
  moveleft(screen^[screenwidth{1, 0}],
	   screen^[0{0, 0}],
	   (screensize-screenwidth)*2);
  for i:=0 to maxx do
    screen^[maxy*screenwidth+i].wholeword:=ord(' ');
end;

procedure scrolldown;{new  4/30/81}
var i: shortint;
begin
  moveright(screen^[0{0, 0}],
	   screen^[screenwidth{1, 0}],
	   (screensize-screenwidth)*2);
  for i:=0 to maxx do screen^[i].wholeword := ord(' ');
end;




function maptocrt(c:char):char;

const illegalchar = #223;
		     { char to disp for illegal internal codes; looks like hp }
procedure mapromextocrt;
const
      minromex = 168; { lookup table ranges }
      maxromex = 255;
type  romexsettype = set of minromex..maxromex;
const romexset = romexsettype [168..172,175,176,179,181..187,189,192..222,255];
							  { legal Romex codes }
begin
    if (ord(c) < 128) or (ord(c) in romexset)
		      or nomap  then    {  3.0 bug fix  jws 3/20/84}
      maptocrt:=c
    else
      if ord(c)=188  { ROMAN8 yen char}                  { jws 3/1/84 }
	then maptocrt:=chr(yenromlocation)               { jws 3/1/84 }
      else
	maptocrt:=illegalchar;
end;


procedure mapkanatocrt ;

const yencode = 92;


{ Converts Katakana codes to their correct "old" CRT rom location codes; also,
  converts "illegal" Kana chars to the "hp" char.  Note that the Yen symbol
  overlays the USASCII backslash (\), and that code 255 is left unconverted. }


begin
  if nomap then maptocrt:=c
  else begin
    if ord(c) = yencode then maptocrt := chr(yenromlocation)
    else if (ord(c) < 128) or (ord(c) = 255) then maptocrt:= c
    else begin
      if (ord(c) < minkana) or (ord(c) > maxkana) then maptocrt := illegalchar
      else maptocrt := chr(kanatocrtlookup[ord(c)]);
    end;
  end;
end; { mapkanatocrt }

begin
  if kbdlang = katakana_kbd then mapkanatocrt
  else mapromextocrt;
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: highlight := defaulthighlight;
  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 with screen^[ypos*screenwidth+xpos] do
		     begin
		      wholeword:=highlight+ ord(maptocrt(c));
		      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: integer;
  sptr: ^string255;

begin
case op of
  cllput: lptr^[position].wholeword:=ord(maptocrt(c));

  cllshiftl:
     begin
       for i:=0 to (maxx-8) do lptr^[i]:=lptr^[i+1];
       lptr^[maxx-8].wholeword:=ord(' ');
     end;

  cllshiftr:
     begin
       for i:=0 to (maxx-9) do lptr^[maxx-8-i]:=lptr^[maxx-9-i];
       lptr^[0].wholeword:=ord(' ');
     end;

  cllclear:
     for i:=0 to (maxx-8) do lptr^[i].wholeword:=ord(' ');

  clldisplay:
     begin
       sptr:=addr(position);
       for i:=1 to length(sptr^) do
	 lptr^[i-1].wholeword:=ord(maptocrt(sptr^[i]));
       for i:=length(sptr^) to (maxx-8) do
	 lptr^[i].wholeword:=ord(' ');
     end;

  putstatus:
     begin { position should be in range 0..7 }
       lptr^[maxx-7+position].wholeword:=ord(c);
     end;

end; { case}

end; { lineops }

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

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

var
  xtemp, ytemp: shortint;
  i,j,k: shortint;
  len: shortint;
  inc: shortint;
  temp: array[0..79] of shortint;


begin
with dbrec do begin
  case op of

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

    dbgotoxy:
      begin
	xtemp:=xpos; ytemp:=ypos;
	xpos:=cursx; ypos:=cursy;
	doupdatecursor;
	xpos:=xtemp; ypos:=ytemp;
      end;

    dbscrollup,dbscrolldn:
      begin
	len:=(xmax-xmin+1)*2;
	if op=dbscrollup then begin
	  j:=ymin;
	  inc:=screenwidth;
	end
	else begin
	  j:=ymax;
	  inc:=-screenwidth;
	end;
	j:=j*screenwidth+xmin;
	for i:=(ymin+1) to ymax do begin
	  k:=j; j:=j+inc;
	  moveleft(screen^[j], screen^[k], len);
	end;
	for i:=0 to (xmax-xmin) do
	  screen^[j+i].wholeword:=ord(' ');
      end;

    dbscrolll,dbscrollr:
      begin
	len:=(xmax-xmin+1)*2-2;     { fixed  4/13/84 }
	j:=(ymin-1)*screenwidth+xmin;
	if op=dbscrolll then begin
	  j:=j+1;
	  k:=xmax-xmin-1;
	end
	else begin
	  k:=0;
	end;
	for i:=ymin to ymax do begin
	 j:=j+screenwidth;
	 if op=dbscrolll then
	   moveleft(screen^[j],screen^[j-1], len)
	 else
	   moveright(screen^[j],screen^[j+1], len);
	 screen^[j+k].wholeword:=ord(' ');
	end;
      end;

    dbhighl:
      begin
	i:=cursy*screenwidth+cursx;
	screen^[i].wholeword:=ord(screen^[i].character)+(ord(c)-128)*256;
      end;


    dbput: if charismapped then
	     screen^[cursy*screenwidth+cursx].wholeword:=
				      ord(maptocrt(c))+debughighlight
	   else
	     screen^[cursy*screenwidth+cursx].wholeword:=ord(c)+
						       debughighlight;

    dbclear:
      for i:=ymin to ymax do
	for j:=xmin to xmax do
	  screen^[i*screenwidth+j].wholeword:=ord(' ');

    dbcline:
      for i:=cursx to xmax do
	screen^[cursy*screenwidth+i].wholeword:=ord(' ');

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

    dbexcg:
      begin
	k:=xmax-xmin+1;
	for i:=ymin to ymax do begin
	  moveleft(screen^[i*screenwidth+xmin], temp, k*2);
	  moveleft(iptr(savearea)^[(i-ymin)*k],
		   screen^[i*screenwidth+xmin], k*2);
	  moveleft(temp, iptr(savearea)^[(i-ymin)*k], k*2);
	end;
	if areaisdbcrt then begin
	  xtemp:=xpos; ytemp:=ypos;
	  xpos:=cursx; ypos:=cursy;
	  doupdatecursor;
	  xpos:=xtemp; ypos:=ytemp;
	end
	else doupdatecursor;
	areaisdbcrt:=not areaisdbcrt;
      end;



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

procedure alphacrtinit;
 var cursaddr: crtcmdwrd; i,k: integer;
 begin
   with syscom^.crtinfo do
   begin
     screen:=anyptr(crtmemaddr);
     screenwidth:=width;
     screenheight:=height;
     maxx:=width-1;
     maxy:=height-1;
     screensize:=width*height;

     for i:=0 to screensize-1 do screen^[i].wholeword:=ord(' ');  {clear screen}
     pm6845addrreg:=anyptr(crtcontroladdr);
     pm6845comdreg:=anyptr(crtcontroladdr+2);
     cursaddr.longword:=integer(screen) mod 8192 div 2;
     cursaddr.textfield:=alphastate;
     cursaddr.softfield:=alphastate;
     crtcommand(12, cursaddr.topbyte);
     crtcommand(13, cursaddr.botbyte);
     defaulthighlight := 0; highlight := 0;

     idle:=250;
     nomap:=false;
     if sysflag.crtconfigreg then begin
       if crtidreg.b13 then begin         { 3.0 bug jws 3/20/84 }
	 nomap:=true;                 { 3.0 bug jws 3/20/84 }
	 idle:=245;                       { 3.0 bug jws 3/20/84 }
       end;                               { 3.0 bug jws 3/20/84 }
       hascolor := crtidreg.colorinfo > cinfo0;
     end
     else hascolor := false;

     gotoxy(0,0);
     dumpalphahook := dumpa;
     dumpgraphicshook := dumpg;
     togglealphahook := togglea;
     togglegraphicshook := toggleg;
     updatecursorhook:=doupdatecursor;
     crtiohook:=docrtio;
     crtllhook:=lineops;
     dbcrthook:=crtdebug;
     crtinithook:=alphacrtinit;
     lptr:=anyptr(keybufferaddr);
     keybuffer^.maxsize:=maxx-8;
     currentcrt:=alphatype;
   end;
 end;

function alphacrt:boolean;
var i[hex('512000')]:shortint;
    j: shortint;
begin
alphacrt:=true;  { assume we have alpha screen }
try
  j:=i;   { attempt read from alpha screen ram }
  syscom^:=environc;  { setup for my kind of environment }
  if not sysflag.alpha50 then syscom^.crtinfo:=b9826info;
  alphacrtinit;
recover
  if escapecode=-12 then
    alphacrt:=false  { bus error -- no alpha screen }
  else escape(escapecode);
end;

end; {  of module }


import crt, loader;

begin
  if alphacrt then markuser;
end.

@


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


54.3
log
@
pws2rcs automatic delta on Wed Aug 21 10:27:27 MDT 1991
@
text
@@


54.2
log
@
pws2rcs automatic delta on Wed Aug 21 09:35:48 MDT 1991
@
text
@d1 744
@


54.1
log
@Automatic bump of revision number for PWS version 3.24
@
text
@a0 744
					       (*

 (c) Copyright Hewlett-Packard Company, 1984.
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                         *)

$UCSD$
$modcal$
$heap_dispose off$
$iocheck off$
$range off$ $ovflcheck off$
$debug off$
$stackcheck off$
$search  'INITLOAD','ASM','INIT','SYSDEVS'$
$ALLOW_PACKED ON$    { JWS 4/10/85}

program initcrt;

module crt;
import sysglobals, asm, misc, sysdevs;
export
function alphacrt: boolean;

implement

const
minkana = 161;
maxkana = 223;
yenromlocation = 128; { location of Yen symbol in old CRT rom }

type


kanatocrtlookuptype = packed array [minkana..maxkana] of 128..255;
romtokanatype = packed array[#128..#238] of 0..255;

crtregtype = 0..15;
crtcmdwrd = packed record case integer of
		0: (topbyte, botbyte: byte);
		1: (longword: shortint);
		2: (p1,p2, textfield, softfield: boolean);
	      end;

 crtscreen = array[0..maxint] of crtword;
 scrptr = ^crtscreen;


const
kanatocrtlookup = kanatocrtlookuptype [
    { code 161 }      129,130,131,132,133,134,135,
    { code 168 }  136,137,138,139,140,141,142,143,
    { code 176 }  144,145,146,147,148,149,150,151,
    { code 184 }  152,153,154,155,156,157,158,159,
    { code 192 }  160,161,162,163,164,165,166,167,
    { code 200 }  173,174,177,178,180,188,190,191,
    { code 208 }  224,225,226,227,228,229,230,231,
    { code 216 }  232,233,234,235,236,237,238,179  ];

  romtokanamap = romtokanatype         [  92, 161, 162,
      163, 164, 165, 166, 167, 168, 169, 170, 171, 172,
      173, 174, 175, 176, 177, 178, 179, 180, 181, 182,
      183, 184, 185, 186, 187, 188, 189, 190, 191, 192,
      193, 194, 195, 196, 197, 198, 199, 168, 169, 170,
      171, 172, 200, 201, 175, 176, 202, 203, 223, 204,
      181, 182, 183, 184, 185, 186, 187, 205, 189, 206,
      207, 192, 193, 194, 195, 196, 197, 198, 199, 200,
      201, 202, 203, 204, 205, 206, 207, 208, 209, 210,
      211, 212, 213, 214, 215, 216, 217, 218, 219, 220,
      221, 222, 223, 208, 209, 210, 211, 212, 213, 214,
      215, 216, 217, 218, 219, 220, 221, 222];


  b9826info=crtirec[
	   width :80,height:24,
	   crtmemaddr:5316608          { + 416},
	   crtcontroladdr:5341185,
	   keybufferaddr: 5320448         {  + 416},
	   progstateinfoaddr: 5320592         {  + 416},
	   keybuffersize: 72,
	   crtcon:
	   crtconsttype [114,80,76,7,26,10,25,25,0,14,76,13],
	   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];


  environc=environ[miscinfo:crtfrec[
				    nobreak:false,
				    stupid :false,
				    slowterm:false,
				    hasxycrt:true,
				    haslccrt:true,  {?}
				    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 :50,height:24,
				    crtmemaddr:5316608,
				    crtcontroladdr:5308417,
				    keybufferaddr: 5319008,
				    progstateinfoaddr: 5319092,
				    keybuffersize: 42,
				    crtcon: crtconsttype [64,50,49,10,25,9,25,
							  25,0,11,74,11],
				    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

lptr:  scrptr;
screenwidth: integer;
screenheight: integer;


maxx,maxy,screensize:shortint;
screen:scrptr;
defaulthighlight: shortint;

highlight:  shortint;
hascolor: boolean;
pm6845addrreg:^char;
pm6845comdreg:^char;
nomap:  boolean;                           { 3.0 bug fix jws 3/20/84 }

crtidreg[hex('51FFFE')]: packed record
      b15,b14,b13: boolean;
      colorinfo: (cinfo0, cinfo1, cinfo2, cinfo3);
      b10,b9,b8,b7,b6,b5,b4,b3,b2,b1,b0: boolean;
      end;


procedure dumpa;
label 1;
var   row, column:integer;
      c: char;
      line: string[100];
begin with syscom^.crtinfo do
  begin
  setstrlen(line, width);
  for row := 0 to height-1 do
    begin
    for column := 0 to width-1 do
      begin
      c := screen^[row*width+column].character;
      if (c >= #128) and (c <= #238) then c := chr(romtokanamap[c]);
      line[column+1] := c;
      end;
    column := width;
    while (column > 1) and (line[column]= ' ') do column := column - 1;
    writeln(gfiles[4]^, line:column);
    if ioresult <> ord(inoerror) then goto 1;
    end;
  end;
1: end;

procedure toggleg;
var gon [5439488{530000 HEX}]:shortint;
    goff[5472256{538000 HEX}]:shortint;
    gbase['GRAPHICSBASE']: ^shortint;

begin
  graphicstate:=not graphicstate;
  if graphicstate then gbase:=addr(gon)
		  else gbase:=addr(goff);
  gbase^ := gbase^;
end;

procedure dumpg;
label 1;
const gheight = 300;    gheightb = 390;
      gwidth = 50;      gwidthb  = 64;
      gbuffersize=gwidthb+6;
type  gword=packed record
	     dummy,growbyte:char;
	     end;
gdotrow=packed array[1..gwidth] of gword;
type gmemtype =  packed array [1..gheight] of gdotrow;
     gmembtype = packed array [1..gheightb, 1..gwidthb] of char;
     gmem =  ^gmemtype;
     gmemb = ^gmembtype;
var   graphicsbase['GRAPHICSBASE']:  anyptr;
      gbuffer:packed array[1..gbuffersize] of char;
      i,j,rows,buffersize,pindex:integer;
      busy:boolean;
begin
  gbuffer[1]:=chr(esc) {escape sequence for graphics};
  gbuffer[2]:='*';
  gbuffer[3]:='b';
  gbuffer[6]:='W';
  if sysflag.biggraphics then
       begin
       gbuffer[4]:='6';
       gbuffer[5]:='4';
       rows := gheightb;
       buffersize := gwidthb+6;
       end
  else begin
       gbuffer[4]:='5';
       gbuffer[5]:='0';
       rows := gheight;
       buffersize := gwidth+6;
       end;
  for i:= 1 to rows do
    begin
    if sysflag.biggraphics then
     for j:=1 to gwidthb do gbuffer[j+6]:=gmemb(graphicsbase)^[i,j] else
       for j:=1 to gwidth  do gbuffer[j+6]:=gmem(graphicsbase)^[i,j].growbyte;
    write(gfiles[4]^, gbuffer:buffersize);
    if ioresult <> ord(inoerror) then goto 1;
    end;
  write(gfiles[4]^, #27'*rB'); {terminate graphics sequence};
1:
end;

procedure crtcommand(reg: crtregtype; data: byte);
begin
    pm6845addrreg^ := chr(reg);
    pm6845comdreg^ := chr(data);
end;

procedure doupdatecursor;
var cursaddr: crtcmdwrd;
begin
  cursaddr.longword:=integer(screen) mod 8192 div 2 + ypos*screenwidth+xpos;
  cursaddr.textfield := alphastate;
  cursaddr.softfield:=alphastate;
  crtcommand(14, cursaddr.topbyte);
  crtcommand(15, cursaddr.botbyte);
end;

procedure togglea;
var   lcursaddr:crtcmdwrd;

begin
  alphastate:=not(alphastate);
  lcursaddr.longword:=integer(screen) mod 8192 div 2;
  lcursaddr.textfield:=alphastate;
  lcursaddr.softfield:=alphastate;
  crtcommand(12, lcursaddr.topbyte);
  crtcommand(13, lcursaddr.botbyte);
  doupdatecursor;
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;
begin
  x:=xpos; y:=ypos;
  while number>0 do
    begin
      screen^[y*screenwidth+x].wholeword:= ord(' ');
      number:=number-1;
      if x<maxx then x:=x+1
      else begin x:=0; if y<maxy then y:=y+1 end;
    end;
end;

procedure scrollup;
var i: shortint;
begin
  moveleft(screen^[screenwidth{1, 0}],
	   screen^[0{0, 0}],
	   (screensize-screenwidth)*2);
  for i:=0 to maxx do
    screen^[maxy*screenwidth+i].wholeword:=ord(' ');
end;

procedure scrolldown;{new  4/30/81}
var i: shortint;
begin
  moveright(screen^[0{0, 0}],
	   screen^[screenwidth{1, 0}],
	   (screensize-screenwidth)*2);
  for i:=0 to maxx do screen^[i].wholeword := ord(' ');
end;




function maptocrt(c:char):char;

const illegalchar = #223;
		     { char to disp for illegal internal codes; looks like hp }
procedure mapromextocrt;
const
      minromex = 168; { lookup table ranges }
      maxromex = 255;
type  romexsettype = set of minromex..maxromex;
const romexset = romexsettype [168..172,175,176,179,181..187,189,192..222,255];
							  { legal Romex codes }
begin
    if (ord(c) < 128) or (ord(c) in romexset)
		      or nomap  then    {  3.0 bug fix  jws 3/20/84}
      maptocrt:=c
    else
      if ord(c)=188  { ROMAN8 yen char}                  { jws 3/1/84 }
	then maptocrt:=chr(yenromlocation)               { jws 3/1/84 }
      else
	maptocrt:=illegalchar;
end;


procedure mapkanatocrt ;

const yencode = 92;


{ Converts Katakana codes to their correct "old" CRT rom location codes; also,
  converts "illegal" Kana chars to the "hp" char.  Note that the Yen symbol
  overlays the USASCII backslash (\), and that code 255 is left unconverted. }


begin
  if nomap then maptocrt:=c
  else begin
    if ord(c) = yencode then maptocrt := chr(yenromlocation)
    else if (ord(c) < 128) or (ord(c) = 255) then maptocrt:= c
    else begin
      if (ord(c) < minkana) or (ord(c) > maxkana) then maptocrt := illegalchar
      else maptocrt := chr(kanatocrtlookup[ord(c)]);
    end;
  end;
end; { mapkanatocrt }

begin
  if kbdlang = katakana_kbd then mapkanatocrt
  else mapromextocrt;
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: highlight := defaulthighlight;
  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 with screen^[ypos*screenwidth+xpos] do
		     begin
		      wholeword:=highlight+ ord(maptocrt(c));
		      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: integer;
  sptr: ^string255;

begin
case op of
  cllput: lptr^[position].wholeword:=ord(maptocrt(c));

  cllshiftl:
     begin
       for i:=0 to (maxx-8) do lptr^[i]:=lptr^[i+1];
       lptr^[maxx-8].wholeword:=ord(' ');
     end;

  cllshiftr:
     begin
       for i:=0 to (maxx-9) do lptr^[maxx-8-i]:=lptr^[maxx-9-i];
       lptr^[0].wholeword:=ord(' ');
     end;

  cllclear:
     for i:=0 to (maxx-8) do lptr^[i].wholeword:=ord(' ');

  clldisplay:
     begin
       sptr:=addr(position);
       for i:=1 to length(sptr^) do
	 lptr^[i-1].wholeword:=ord(maptocrt(sptr^[i]));
       for i:=length(sptr^) to (maxx-8) do
	 lptr^[i].wholeword:=ord(' ');
     end;

  putstatus:
     begin { position should be in range 0..7 }
       lptr^[maxx-7+position].wholeword:=ord(c);
     end;

end; { case}

end; { lineops }

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

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

var
  xtemp, ytemp: shortint;
  i,j,k: shortint;
  len: shortint;
  inc: shortint;
  temp: array[0..79] of shortint;


begin
with dbrec do begin
  case op of

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

    dbgotoxy:
      begin
	xtemp:=xpos; ytemp:=ypos;
	xpos:=cursx; ypos:=cursy;
	doupdatecursor;
	xpos:=xtemp; ypos:=ytemp;
      end;

    dbscrollup,dbscrolldn:
      begin
	len:=(xmax-xmin+1)*2;
	if op=dbscrollup then begin
	  j:=ymin;
	  inc:=screenwidth;
	end
	else begin
	  j:=ymax;
	  inc:=-screenwidth;
	end;
	j:=j*screenwidth+xmin;
	for i:=(ymin+1) to ymax do begin
	  k:=j; j:=j+inc;
	  moveleft(screen^[j], screen^[k], len);
	end;
	for i:=0 to (xmax-xmin) do
	  screen^[j+i].wholeword:=ord(' ');
      end;

    dbscrolll,dbscrollr:
      begin
	len:=(xmax-xmin+1)*2-2;     { fixed  4/13/84 }
	j:=(ymin-1)*screenwidth+xmin;
	if op=dbscrolll then begin
	  j:=j+1;
	  k:=xmax-xmin-1;
	end
	else begin
	  k:=0;
	end;
	for i:=ymin to ymax do begin
	 j:=j+screenwidth;
	 if op=dbscrolll then
	   moveleft(screen^[j],screen^[j-1], len)
	 else
	   moveright(screen^[j],screen^[j+1], len);
	 screen^[j+k].wholeword:=ord(' ');
	end;
      end;

    dbhighl:
      begin
	i:=cursy*screenwidth+cursx;
	screen^[i].wholeword:=ord(screen^[i].character)+(ord(c)-128)*256;
      end;


    dbput: if charismapped then
	     screen^[cursy*screenwidth+cursx].wholeword:=
				      ord(maptocrt(c))+debughighlight
	   else
	     screen^[cursy*screenwidth+cursx].wholeword:=ord(c)+
						       debughighlight;

    dbclear:
      for i:=ymin to ymax do
	for j:=xmin to xmax do
	  screen^[i*screenwidth+j].wholeword:=ord(' ');

    dbcline:
      for i:=cursx to xmax do
	screen^[cursy*screenwidth+i].wholeword:=ord(' ');

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

    dbexcg:
      begin
	k:=xmax-xmin+1;
	for i:=ymin to ymax do begin
	  moveleft(screen^[i*screenwidth+xmin], temp, k*2);
	  moveleft(iptr(savearea)^[(i-ymin)*k],
		   screen^[i*screenwidth+xmin], k*2);
	  moveleft(temp, iptr(savearea)^[(i-ymin)*k], k*2);
	end;
	if areaisdbcrt then begin
	  xtemp:=xpos; ytemp:=ypos;
	  xpos:=cursx; ypos:=cursy;
	  doupdatecursor;
	  xpos:=xtemp; ypos:=ytemp;
	end
	else doupdatecursor;
	areaisdbcrt:=not areaisdbcrt;
      end;



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

procedure alphacrtinit;
 var cursaddr: crtcmdwrd; i,k: integer;
 begin
   with syscom^.crtinfo do
   begin
     screen:=anyptr(crtmemaddr);
     screenwidth:=width;
     screenheight:=height;
     maxx:=width-1;
     maxy:=height-1;
     screensize:=width*height;

     for i:=0 to screensize-1 do screen^[i].wholeword:=ord(' ');  {clear screen}
     pm6845addrreg:=anyptr(crtcontroladdr);
     pm6845comdreg:=anyptr(crtcontroladdr+2);
     cursaddr.longword:=integer(screen) mod 8192 div 2;
     cursaddr.textfield:=alphastate;
     cursaddr.softfield:=alphastate;
     crtcommand(12, cursaddr.topbyte);
     crtcommand(13, cursaddr.botbyte);
     defaulthighlight := 0; highlight := 0;

     idle:=250;
     nomap:=false;
     if sysflag.crtconfigreg then begin
       if crtidreg.b13 then begin         { 3.0 bug jws 3/20/84 }
	 nomap:=true;                 { 3.0 bug jws 3/20/84 }
	 idle:=245;                       { 3.0 bug jws 3/20/84 }
       end;                               { 3.0 bug jws 3/20/84 }
       hascolor := crtidreg.colorinfo > cinfo0;
     end
     else hascolor := false;

     gotoxy(0,0);
     dumpalphahook := dumpa;
     dumpgraphicshook := dumpg;
     togglealphahook := togglea;
     togglegraphicshook := toggleg;
     updatecursorhook:=doupdatecursor;
     crtiohook:=docrtio;
     crtllhook:=lineops;
     dbcrthook:=crtdebug;
     crtinithook:=alphacrtinit;
     lptr:=anyptr(keybufferaddr);
     keybuffer^.maxsize:=maxx-8;
     currentcrt:=alphatype;
   end;
 end;

function alphacrt:boolean;
var i[hex('512000')]:shortint;
    j: shortint;
begin
alphacrt:=true;  { assume we have alpha screen }
try
  j:=i;   { attempt read from alpha screen ram }
  syscom^:=environc;  { setup for my kind of environment }
  if not sysflag.alpha50 then syscom^.crtinfo:=b9826info;
  alphacrtinit;
recover
  if escapecode=-12 then
    alphacrt:=false  { bus error -- no alpha screen }
  else escape(escapecode);
end;

end; {  of module }


import crt, loader;

begin
  if alphacrt then markuser;
end.

@


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.1
log
@Automatic bump of revision number for PWS version 3.22b
@
text
@@


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.1
log
@Automatic bump of revision number for PWS version 3.2Y
@
text
@@


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.1
log
@Automatic bump of revision number for PWS version 3.2j
@
text
@@


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
@@
