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


56.5
date     93.01.27.13.27.31;  author jwh;  state Exp;
branches ;
next     56.4;

56.4
date     93.01.27.12.05.40;  author jwh;  state Exp;
branches ;
next     56.3;

56.3
date     92.06.17.15.06.39;  author cfb;  state Exp;
branches ;
next     56.2;

56.2
date     92.04.10.12.31.30;  author cfb;  state Exp;
branches ;
next     56.1;

56.1
date     91.11.05.09.48.19;  author jwh;  state Exp;
branches ;
next     55.3;

55.3
date     91.11.04.15.04.41;  author jwh;  state Exp;
branches ;
next     55.2;

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

55.1
date     91.08.25.10.24.51;  author jwh;  state Exp;
branches ;
next     54.4;

54.4
date     91.08.21.13.18.27;  author jwh;  state Exp;
branches ;
next     54.3;

54.3
date     91.07.11.08.57.20;  author cfb;  state Exp;
branches ;
next     54.2;

54.2
date     91.07.09.09.46.14;  author cfb;  state Exp;
branches ;
next     54.1;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

7.1
date     86.11.20.13.53.46;  author hal;  state Exp;
branches ;
next     6.2;

6.2
date     86.11.19.16.54.58;  author bayes;  state Exp;
branches ;
next     6.1;

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

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

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

4.1
date     86.09.30.19.52.30;  author hal;  state Exp;
branches ;
next     3.6;

3.6
date     86.09.26.12.45.52;  author hal;  state Exp;
branches ;
next     3.5;

3.5
date     86.09.26.08.31.38;  author hal;  state Exp;
branches ;
next     3.4;

3.4
date     86.09.24.11.25.37;  author hal;  state Exp;
branches ;
next     3.3;

3.3
date     86.09.24.11.06.00;  author hal;  state Exp;
branches ;
next     3.2;

3.2
date     86.09.03.09.57.28;  author hal;  state Exp;
branches ;
next     3.1;

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

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

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


desc
@Base file for PWS 3.2 release.

@


56.5
log
@
pws2rcs automatic delta on Wed Jan 27 13:14:25 MST 1993
@
text
@{                                                                           }
{ Graphics Library                                                          }
{                                                                           }
{ Module    = DGL_CONFG_OUT                                                 }
{ Programer = BJS                                                           }
{ Date      = 10- 5-82                                                      }
{                                                                           }
{ Purpose: To link device dependent drivers with the graphics library.      }

{ Rev history                                                               }
{  Created  - 10- 5-82                                                      }
{  Modified -  1-12-84  BDS -Added Gator black-white support                }
{  Modified -  2-17-84  BDS -Changed dynamic to global storage for PASC 3.0 }
{  Modified -  7-01-85  SFB -Changes to support Bobcat/Gatorbox             }
{  Modified -  7-19-85  BJS -Changes to fix check for moonunit address.     }
{  Modified -  11JUN91  CFB -Added WOODCUT graphics support                 }

{     (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                              }

$MODCAL$
$SEARCH 'GLE_LIB',
	'TYPES',
	'DGL_VARS',
	'DGL_TOOLS',
	'DGL_RAS',
	'DGL_HPGL'${}
$modcal$
$include 'OPTIONS'$              { compiler options }
$LINENUM 11000$

module DGL_CONFG_OUT;

import gle_types, sysdevs;

export
  procedure configure_gle (  gcb : graphics_control_block_ptr );

implement

import gle_hpgl_out,   { hpgl plotter support }
       gle_ras_out,    { raster support       }
       gle_file_io,    { plotter spooling io  }
       gle_hpib_io,    { plotter HPIB support }
       gle_utls,       { general tools }
       dgl_tools,      { used to get machine type }
       sysglobals,     { address for GRAPHICSBASE }
       iodeclarations, { used to get min, max selectcode ranges }
       gle_autl,       { for GLE_IAND }
       dgl_raster,     { DGL device dependent raster init code }
       dgl_hpgl,       { DGL device dependent HPGL init code }
       dgl_vars;       { DGL global data }

var
  save_crthook: crtlltype;
  hp98627A_address : anyptr;  { holds adr of first graphics plane }
  found_bitmap: boolean;
  select_code : shortint;
  has_color : boolean;
  frame_buffer : integer;
  stat : ^shortint;
  ptr: ^shortint;
  int_ext_bitmap : shortint;  { 0=no bitmap display,
				1=internal GATOR,   2=external GATOR,
				3=internal GATORBOX,4=external GATORBOX,
				5=internal BOBCAT,  6=external BOBCAT,
				7=int LO-RES BOB,   8=ext LORES BOB,
				9=int LCC CATSEYE, 10=ext LCC CATSEYE
			       additions 9/09/86 SFB
			       11=int HRx CATSEYE, 12=ext HRx CATSEYE
			       more additions 2/19/88 SFB
			       13=int VGA WOODCUT, 14=ext VGA WOODCUT
			       15=int Med WOODCUT, 16=ext Med WOODCUT
			       17=int Hrx WOODCUT, 18=ext Hrx WOODCUT
			       more additions 7JUN91 CFB
				       greyscale
			       19=int VGA WOODCUT, 20=ext VGA WOODCUT
			       21=int Med WOODCUT, 22=ext Med WOODCUT
			       more additions 30JUL91 CFB }
  raster_device_rec_space : raster_device_rec;
  hpgl_device_rec_space   : hpgl_device_rec;
  ascii_buffer_space      : ascii_buffer;
  file_iocb_space         : file_iocb;
  hpib_iocb_space         : hpib_iocb;
  took_type_ahead         : boolean;
  reduced_screen          : boolean;
  secondary               : boolean;
  moon                    : boolean;
  sysflg2[hex('FFFFFEDA')]: packed record
			      bit7, bit6, bit5, bit4,
			      bit3, bit2, bit1, bit0 : boolean;
			    end;

procedure termraster ( anyvar iocb_ptr : anyptr );

var
  charvar : char;

begin
  with gle_gcb^ do
    begin
      if reduced_screen then
	begin
	  with gcb^,raster_device_rec_ptr(dev_dep_stuff)^ do
	    begin
	      reduced_screen := true;
	      n_glines := 752;
	      hard_ymax := 751;
	    end;
	end;
      if took_type_ahead then
	begin
	  crtllhook := save_crthook;
	  keybufops(kdisplay,charvar);
	end;
    end;
end;


{Look for bitmap display present.  Assume only one is on the bus and that
 an internal one overrides an external one if multiples present.}

procedure bitmapcrttype(var found_bitmap,has_color:boolean;
			var  frame_buffer :integer;
			var select_code,int_ext_bitmap :shortint;
			var cmapid : integer);  {ADDED SFB--6/11/85}

const   {added 2/19/88 SFB}
   Gator_tertiary       = 0;
   Gbox_tertiary        = 1;
   Bobcat_tertiary      = 2;
   unsupp1_tertiary     = 3;
   unsupp2_tertiary     = 4;
   LCC_tertiary         = 5;
   HRC_tertiary         = 6;
   HRM_tertiary         = 7;
   unsupp3_tertiary     = 8;
   unsupp4_tertiary     = 9;
   unsupp5_tertiary     = 10;
   unsupp6_tertiary     = 11;
   unsupp7_tertiary     = 12;
   unsupp8_tertiary     = 13;
   unsupp9_tertiary     = 14;
   Hrx_Woodcut_tertiary = 15;
   Med_Woodcut_tertiary = 16;
   VGA_Woodcut_tertiary = 17;
   VGAM_Woodcut_tertiary= 18;     { Mono Versions of VGA and HRX - 30JUL91 CFB }
   HrxM_Woodcut_tertiary= 19;

   Gbox_int_ext         = 3;
   Bobcat_int_ext       = 5;
   unsupp_int_ext       = 0;
   LCC_int_ext          = 9;
   HRx_int_ext          = 11;
   VGA_Woodcut_int_ext  = 13;
   Med_Woodcut_int_ext  = 15;
   Hrx_Woodcut_int_ext  = 17;
   VGAM_Woodcut_int_ext = 19;
   HrxM_Woodcut_int_ext = 21;

const
    gatorid  =25;
    bitmapid =57;                                               { SFB 10-10-84 }
    low_id   = Gbox_tertiary;                      {GATORBOX; added 9/09/86 SFB}
    hi_id    = HrxM_Woodcut_tertiary;             {WOODCUT; changed 30JUL91 CFB}
type
    int_ext_type = (int,ext);
    iptr = ^integer;
    tertiary_ids = array[low_id..hi_id] of shortint;
const
						 {map to various int_ext_values}
						 {added WOODCUT  7JUN91 CFB}
    supported_tertiaries = tertiary_ids[Gbox_int_ext,
					Bobcat_int_ext,
					unsupp_int_ext,
					unsupp_int_ext,
					LCC_int_ext,
					HRx_int_ext,
					HRx_int_ext,
					unsupp_int_ext,
					unsupp_int_ext,
					unsupp_int_ext,
					unsupp_int_ext,
					unsupp_int_ext,
					unsupp_int_ext,
					unsupp_int_ext,
					Hrx_Woodcut_int_ext,
					Med_Woodcut_int_ext,
					VGA_Woodcut_int_ext,
					VGAM_Woodcut_int_ext,
					HrxM_Woodcut_int_ext];

   {hi_int_ext=supported_tertiaries[hi_id]+1;   {compiler doesn't support this.}
						{2/19/88 SFB}
var
    i     : shortint;
    dummy : shortint;
    bptr  : ^char;

  procedure setupbitmaptype(int_ext : int_ext_type);

  var
      fbrelative : integer;
      tvalue     : shortint;      {SFB 9/09/86}

    function value : shortint;       {returns value of byte at bptr^ in GRAPHICS
				      ROM and bumps bptr to next byte}
    begin
     value := ord(bptr^);
     bptr := anyptr(integer(bptr) + 2);
    end;

  begin
    if dummy = gatorid then
    begin
      int_ext_bitmap := 1 + ord(int_ext);
      stat := anyptr(control_space + 16384);
      frame_buffer := ((stat^) mod 16)*hex('100000');
    end
    else
    begin                             {read tertiary ID and locate frame buffer}
      bptr := anyptr(control_space + 21);
      tvalue := value;                                             {SFB 9/09/86}
      {int_ext_bitmap := 2 * value + ord(int_ext) + 1;}
      if (tvalue >= low_id) and (tvalue <= hi_id) then             {SFB 9/09/86}
      begin
	int_ext_bitmap := supported_tertiaries[tvalue];
	if int_ext_bitmap <> 0 then
	  int_ext_bitmap := int_ext_bitmap + ord(int_ext);
      end;
      if (int_ext_bitmap >= Gbox_int_ext)
	 and (int_ext_bitmap < VGA_Woodcut_int_ext) then            {CFB 7JUN91}
      begin                                                        {SFB 1-23-85}
	bptr := anyptr(control_space + hex('005D'));     {^frame buffer relative
						   location pointer--2 byte qty}
	fbrelative := value;
	fbrelative := value + fbrelative * 256;
	bptr := anyptr(fbrelative + control_space);            {bits A16..A23 of
							   frame buffer address}
	frame_buffer := value * hex('10000');            {left shift bits 16..23
								   by 16 places}
						       {check for lo-res bobcat}
	if (int_ext_bitmap = 5) or (int_ext_bitmap = 6) then
	begin
	  bptr := anyptr(control_space + hex('0017'));{^"non-square pixel" info}
	  if odd(ord(bptr^)) then int_ext_bitmap := int_ext_bitmap + 2;
	 {set to corresponding lores internal or external bobcat type}
	end
	else                                 {GATORBOX       added SFB--6/11/85}
	begin                       {get colormap id for later use SFB--6/11/85}
	  bptr := anyptr(control_space + hex('57'));       {cmapid addr pointer}
	  fbrelative := value;                              {MSB of rel address}
	  fbrelative := value + 256*fbrelative;             {16-bit rel address}
	  bptr := anyptr(control_space + fbrelative);              {cmapid addr}
	  cmapid := value mod 4;              {at last! the cmapid 2 lower bits}
	end;
      end;
      {if (int_ext_bitmap >= VGA_Woodcut_int_ext) and *****{DIO-II is different}
      if (int_ext_bitmap >= LCC_int_ext) and       {DIO-II is different}
	 (int_ext_bitmap <= HrxM_Woodcut_int_ext+1) and
	 (control_space >= hex('1000000')) then
      begin
	frame_buffer := control_space + hex('200000');
	cmapid := 99;
      end;
    end;
  end;


begin
  control_space:=0;
  found_bitmap:=false;
  int_ext_bitmap := 0;
  ptr:=anyptr(hex('560000'));
  cmapid := 0;  {SFB 6/11/85}

  if select_code <= 6 then                {only check internal space SFB 7/9/85}
  try
    dummy := ptr^;
    dummy := dummy mod 128;
    if (dummy = gatorid) OR (dummy = bitmapid) then      {found internal bitmap}
    begin
      found_bitmap:=true;
      control_space:=integer(ptr);
    end;
  recover
    begin                            {add WOODCUT console support - CFB 13JUN91}
      if escapecode<>-12 then escape(escapecode);
      if (sysflg2.bit4 = true) then      {don't try on 68000/68010 - CFB 1APR92}
      begin
	ptr:=anyptr((hex('1000000')));                  {try SC 132 for console}
	try
	  dummy:=ptr^;
	  dummy := dummy mod 128;
	  if (dummy = bitmapid) then
	  begin
	    found_bitmap:=true;
	    control_space:=integer(ptr);
	  end;
	recover
	  if escapecode<>-12 then escape(escapecode);
      end;
    end;
  if found_bitmap then                             {if there, find frame buffer}
    setupbitmaptype(int)

  else if (select_code >= 8) and (select_code <= 31) then {modified CFB 7JUN91}
  begin
    ptr:=anyptr(hex('600000')+select_code*(hex('10000')));
    try
      dummy:=ptr^;
      dummy := dummy mod 128;
      if (dummy = gatorid) OR (dummy = bitmapid) then
      begin
	found_bitmap:=true;
	control_space:=integer(ptr);
      end;
    recover
      if escapecode<>-12 then escape(escapecode);
    if found_bitmap then
      setupbitmaptype(ext);
  end

  else if (select_code >= 132) and (sysflg2.bit4 = true) then
	      { added DIO-II CFB 7JUN91 / added sysflag2 test       CFB 3OCT91 }
  begin
    ptr:=anyptr((select_code-128)*(hex('400000')));    {SC 132 starts at 16 Meg}
    try
      dummy:=ptr^;
      dummy := dummy mod 128;
      if (dummy = bitmapid) then
      begin
	found_bitmap:=true;
	control_space:=integer(ptr);
      end;
    recover
      if escapecode<>-12 then escape(escapecode);
      if found_bitmap then
	setupbitmaptype(ext);                                { always external }
  end;
end;


procedure setupraster (  gcb : graphics_control_block_ptr );

var
  graphics_base ['GRAPHICSBASE'] : anyptr;
  device_work_area : raster_device_rec_ptr;
  cnt             : gle_shortint;
  address         : integer;
  control         : integer;
  knob_echo_gcb   : boolean;
  g_ptr           : ^shortint;
  g_dummy         : shortint;
  graphics_bd     : boolean;
  graphicstate ['GRAPHICSFLAG'] : boolean;
  cmapid          : integer;    {SFB 6/11/85}

  procedure dummy1 ( anyvar iocb_ptr, data_ptr : anyptr );
  begin
  end;

  procedure expand_screen;

  begin
    with gcb^ do
      begin
	info3 := 0;
	if (int_ext_bitmap <> 0) then
	 begin
	   reduced_screen := false;
	   info3 := 1;                  {1=expand; 0=leave reduced}
	 end;                           {send on to expand screen}
      end;
    if (currentcrt = bitmaptype) and (odd(int_ext_bitmap))
       and     {SFB 3/27/85 to prevent locator destroying save_crthook}
       (not knob_echo_gcb) then
      begin
	save_crthook := crtllhook;
	crtllhook := dummycrtll;
	took_type_ahead := true;
      end;
  end;

  procedure ck_for_graphics_board;

  begin
    graphics_bd := true;
    if graphicstate then g_ptr := anyptr(hex('530000'))
     else g_ptr := anyptr(hex('538000'));
    try
      g_dummy := g_ptr^;
    recover
      begin
	if escapecode <> -12 then escape(escapecode)
	else  graphics_bd := false;
      end;
  end;




  procedure setup_internal;

    procedure toggle_graphics;
    var gon  [5439488  {530000 HEX}] : shortint;
	goff [5472256  {538000 HEX}] : shortint;
	g_on36c [ hex('51FFFC')]: shortint;
	gbase['GRAPHICSBASE'] : ^shortint;
    begin
      if gcb^.info1 = m9836c then begin
	if graphicstate then g_on36c:=1
	else g_on36c:=0;
	gbase:=anyptr(hex('520000'));
      end
      else begin
	if graphicstate then gbase := addr(gon)
			else gbase := addr(goff);
	gbase^ := gbase^;
      end;
    end;

  begin
    with gcb^ do
     begin
       graphicstate := true;
       info1 := return_machine_type;
       toggle_graphics;
       info_ptr1 := addr(graphics_base);
       info_ptr2 := anyptr(0);
       if info1 = m9836c then
	 begin
	   info2 := hex('51fffd');
	   info3 := hex('51fb00');
	 end;
     end;
  end;


  procedure set_moon_vals;
  begin
   with gcb^ do
    begin
     info3 := control div 256;  { get monitor type information (part of control) }
     if (info3 > 6) or (info3 < 1) then info3 := 1;
     moon := true;
     info1 := m98627a;          { set display type to 98627A }
     info2 := address * 65536 + 6291456;  { i/o card address }
     hp98627a_address := anyptr(info2 + hex('8000')); { first plane adr }
     info_ptr1 := addr(hp98627a_address);
     info_ptr2 := anyptr(0);
    end;
  end;

  procedure set_bitmap_vals;
  begin
    with gcb^ do
     begin
       info2 := control_space;       {top of control space}
       info3 := 0;                   {By default dont expand ! BJS 5-29-84}
       info4 := cmapid;              {for gle_raster_init gatorbox SFB 6/11/85}
       info_ptr1 := addr(frame_buffer); {start of control space}
       info_ptr2 := anyptr(0);
       case (int_ext_bitmap-1) div 2 of
	 0 : info1 := m9837a;
	 1 : info1 := mgatorbox;
	 2 : info1 := mbobcat;
	 3 : info1 := mbobcatlores;
	 4 : info1 := mcatseye;         {SFB 9/09/86}
	 5 : info1 := mcatseye_hrx;     {SFB 2/23/88}
	 6 : info1 := mvga_woodcut;     {CFB 7JUN91}
	 7 : info1 := mmed_woodcut;     {CFB 7JUN91}
	 8 : info1 := mhrx_woodcut;     {CFB 7JUN91}
	 9 : info1 := mvgam_woodcut;    {CFB 30JUL91}
	10 : info1 := mhrxm_woodcut;    {CFB 30JUL91}
	 otherwise begin end;           {SFB 2/23/88}
       end;
     end;
  end;


begin
  with gcb^ do
  if spooling = 0 then
  try
    {address computaton moved up SFB 7/9/85}
    address := gle_read_integer(device_info_char_count,device_info,cnt);
    select_code := address; {SFB 7/9/85}
    bitmapcrttype(found_bitmap, has_color,
		  frame_buffer, select_code, int_ext_bitmap,
		  cmapid {added SFB 6/11/85});
    ck_for_graphics_board;      {some how this was commented out at 54.2 - CFB}
    secondary := false;
    moon := false;
    reduced_screen := true;
    control := info1;  { control passed in info1 }
    knob_echo_gcb := (info2 = 1); { GCB for knob echos }
    if not knob_echo_gcb then       {SFB 6/25/85}
      took_type_ahead := false;
    io_write := dummy1;
    io_term  := termraster;
    device_work_area := addr(raster_device_rec_space);
    dev_dep_stuff := device_work_area;


    if address = 3 then                        {indicates primary display}
    begin
      if ((currentcrt = alphatype)  or (currentcrt = nocrt))
	and (graphics_bd) then
	setup_internal
      else
	if ((currentcrt = bitmaptype) or (not graphics_bd))
	  {and (odd(int_ext_bitmap))} then   {removed for WOODCUT - CFB 13JUN91}
	  set_bitmap_vals;
	end
      else
	if (address = 6) then                  {indicates secondary display}
	begin
	  secondary := true;
	  if ((currentcrt = alphatype)  or (currentcrt = nocrt)) {JWS 7/23/85}
	    and (int_ext_bitmap <>0) then
	    set_bitmap_vals
	  else
	    if (graphics_bd) then
	      setup_internal;

	  if (currentcrt = bitmaptype)  then           {console = bitmap so}
	  begin                                        {set secondary to}
							 { small screen}
	    if (graphics_bd) then
	      setup_internal
	    else                                    {if fails set second.}
	      if (odd(int_ext_bitmap)) then           {to bitmap.}
		set_bitmap_vals;
	  end;
	end
      else       { must be moonunit or external bitmap }
      begin
	if (address < minrealisc) or
	   ((address > maxrealisc) and (address < 132)) or
							 {add DIO-II CFB 9JUN91}
	   ((address >= 132) and (sysflg2.bit4 = false)) then
	   { added sysflag2 test to fix bug on 68000/68010           CFB 1APR92}
	   escape(1);

	  {Replaced following line BJS 7-23-85;  address will always
	   be equal to select_code since 7-9-85 bug fix.  Determine if
	   a bit map by looking at int_ext_bitmap being equal to 0 }
	  {if (address = select_code) and (not odd(int_ext_bitmap)) then}

	  if ((int_ext_bitmap <> 0) and (not odd(int_ext_bitmap))) then
	    set_bitmap_vals
	  else
	    set_moon_vals;
      end;

      {control set}
      if (odd(control DIV 256)) and (not moon)  then
	if
	   ((currentcrt = bitmaptype) and (odd(int_ext_bitmap)) and
						 {is bitmap, primary,  }
	     (not secondary))                      { bitmap is there     }
			   or                    {       or            }
	   (((currentcrt = alphatype) or (currentcrt = nocrt)) and
						 {is alpha/none,gr bd, }
	    (graphics_bd) and (secondary) and (odd(int_ext_bitmap)))
						 {second,bitmap there  }
			   or                    {        or           }
	   (address > 6) and (not odd(int_ext_bitmap))  {ext. bitmap there }

	  then expand_screen;

      {control not set, but bitmap is not console}
      if (((currentcrt = alphatype) or (currentcrt = nocrt)) and
	  (int_ext_bitmap <>0) and
	  (secondary))
			   or
	 (((currentcrt = alphatype) or (currentcrt = nocrt)) and
	  (not graphics_bd) and (int_ext_bitmap <>0))

			   or
	 ((address >= 8) and (address < 32) and (not moon))
								 {SFB 7/10/85}
								 {jws 6/18/86}
								 {CFB 13JUN91}

	then expand_screen;

      gle_init_raster_output (gcb);

      if (error_return = 0) and (not knob_echo_gcb) then
	dgl_raster_init(control);

      {if error_return <> 0 then dispose(device_work_area);} { clean up }

  recover
    { ignore all escapes (except stop key), user may look at
     escapecode to determine error }
    if escapecode = -20 then escape(-20)
    else error_return := 1
  else
    error_return := 1; { raster devices may not be spooled }
end;

procedure termhpgl ( anyvar iocb_ptr : anyptr );

var
  iocb_ptr_file   : file_iocb_ptr;
  iocb_ptr_hpib   : hpib_iocb_ptr;
  buf             : ascii_buffer_ptr;
  device_work_area : hpgl_device_rec_ptr;
  save_ioresult   : integer;            { | fix clobbering ioresult -- 12/83}

begin
  with gle_gcb^ do
    begin
      if spooling <> 0 then
	begin
	  save_ioresult := ioresult;   { | ioresult problem fix 12/83--BDS}
	  file_term(iocb_ptr);         { perform io term then release mem }
	  ioresult := save_ioresult;   { | ioresult problem fix 12/83--BDS}
	  iocb_ptr_file := iocb;
	  {dispose(iocb_ptr_file);}
	end
      else
	begin
	  hpib_term(iocb_ptr);         { perform io term then release mem }
	  iocb_ptr_hpib := iocb;
	  {dispose(iocb_ptr_hpib);}
	end;
      buf := device_buf;
      device_work_area := dev_dep_stuff;
      {dispose(buf); dispose(device_work_area);}
    end;
end;

procedure setuphpgl (  gcb : graphics_control_block_ptr );

var
  iocb_ptr_file    : file_iocb_ptr;
  iocb_ptr_hpib    : hpib_iocb_ptr;
  buf              : ascii_buffer_ptr;
  device_work_area : hpgl_device_rec_ptr;
  cnt              : gle_shortint;
  address          : integer;
  address_found    : boolean;
  control          : integer;
  save_ioresult    : integer;              { | fix clobbering ioresult -- 12/83}
  save             : integer;

begin
  with gcb^ do
    begin
      control := info1; { control passed in info1 }
      address_found := false;
      try
	address := gle_read_integer(device_info_char_count,device_info,cnt);
	address_found := true;
      recover
	if escapecode <> -8 { value range error } then escape(escapecode);

      buf := addr(ascii_buffer_space);
      device_buf := buf;
      device_work_area := addr(hpgl_device_rec_space);
      dev_dep_stuff := device_work_area;

      if spooling = 1 then
	begin
	  iocb_ptr_file := addr(file_iocb_space);
	  iocb := iocb_ptr_file;
	  io_write := file_write;
	  io_term := termhpgl;
	  io_inq_timeout := file_inq_timeout;
	  io_set_timeout := file_set_timeout;
	  with iocb_ptr_file^ do
	    begin
	      file_name := device_info;
	      name_size := device_info_char_count;
	      try
		lock_on_close := 0;                { do not save file by default }
		file_init ( iocb_ptr_file );
		gle_init_hpgl_output (gcb);
		if error_return = 0 then
		  begin
		    dgl_hpgl_init(control);
		    lock_on_close := 1;            { save file }
		  end
		else
		  begin
		    save_ioresult := ioresult;     {| ioresult fix 12/83--BDS}
		    file_term ( iocb_ptr_file );
		    ioresult := save_ioresult;     {| ioresult fix 12/83--BDS}
		  end;
	      recover
		if escapecode <> -10 then escape(escapecode)
		else                      error_return := 1;
	    end;

	  if error_return <> 0 then
	    begin { clean up }
	      save_ioresult := ioresult;           {| ioresult fix 1/84--BDS}
	     {dispose(iocb_ptr_file); dispose(buf); dispose(device_work_area);}
	      ioresult := save_ioresult;           {| ioresult fix 1/84--BDS}
	    end;
	end
      else
      if address_found then
	begin
	  iocb_ptr_hpib := addr(hpib_iocb_space);
	  iocb := iocb_ptr_hpib;
	  io_write := hpib_write;
	  io_read := hpib_read;
	  io_term := termhpgl;
	  io_inq_timeout := hpib_inq_timeout;
	  io_set_timeout := hpib_set_timeout;
	  with iocb_ptr_hpib^ do
	    begin
	      device_addr := device_info;
	      name_size   := device_info_char_count;
	    end;
	  hpib_init ( iocb_ptr_hpib );
	  if iocb_ptr_hpib^.error = 0 then
	    begin
	      gle_init_hpgl_output (gcb);
	      if error_return = 0 then dgl_hpgl_init(control)
	       { if error then clean up hpib bus (2.1 bug fix) }
	      else                     hpib_init ( iocb_ptr_hpib );
	    end
	  else error_return := 1;
	  if error_return <> 0 then
	    begin { clean up }
	     {dispose(iocb_ptr_hpib); dispose(buf); dispose(device_work_area);}
	    end;
	end
      else
	error_return := 1;
    end;
end;

procedure configure_gle (  gcb : graphics_control_block_ptr );

begin
  with gcb^ do
    begin
      setupraster ( gcb );
      if error_return <> 0 then setuphpgl ( gcb );
    end;
end;

end. { of module }


@


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


56.3
log
@Some how the ck_for_graphics_board call was commented out. This caused the
graphics to incorrectly identify an Alpha/Graphics card as a 9837.
This would cause the system to hang with Rev. D boot ROMs. Wierd......
CFB
@
text
@a0 767
{                                                                           }
{ Graphics Library                                                          }
{                                                                           }
{ Module    = DGL_CONFG_OUT                                                 }
{ Programer = BJS                                                           }
{ Date      = 10- 5-82                                                      }
{                                                                           }
{ Purpose: To link device dependent drivers with the graphics library.      }

{ Rev history                                                               }
{  Created  - 10- 5-82                                                      }
{  Modified -  1-12-84  BDS -Added Gator black-white support                }
{  Modified -  2-17-84  BDS -Changed dynamic to global storage for PASC 3.0 }
{  Modified -  7-01-85  SFB -Changes to support Bobcat/Gatorbox             }
{  Modified -  7-19-85  BJS -Changes to fix check for moonunit address.     }
{  Modified -  11JUN91  CFB -Added WOODCUT graphics support                 }

{     (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                              }

$MODCAL$
$SEARCH 'GLE_LIB',
        'TYPES',
        'DGL_VARS',
        'DGL_TOOLS',
        'DGL_RAS',
        'DGL_HPGL'${}
$modcal$
$include 'OPTIONS'$              { compiler options }
$LINENUM 11000$

module DGL_CONFG_OUT;

import gle_types, sysdevs;

export
  procedure configure_gle (  gcb : graphics_control_block_ptr );

implement

import gle_hpgl_out,   { hpgl plotter support }
       gle_ras_out,    { raster support       }
       gle_file_io,    { plotter spooling io  }
       gle_hpib_io,    { plotter HPIB support }
       gle_utls,       { general tools }
       dgl_tools,      { used to get machine type }
       sysglobals,     { address for GRAPHICSBASE }
       iodeclarations, { used to get min, max selectcode ranges }
       gle_autl,       { for GLE_IAND }
       dgl_raster,     { DGL device dependent raster init code }
       dgl_hpgl,       { DGL device dependent HPGL init code }
       dgl_vars;       { DGL global data }

var
  save_crthook: crtlltype;
  hp98627A_address : anyptr;  { holds adr of first graphics plane }
  found_bitmap: boolean;
  select_code : shortint;
  has_color : boolean;
  frame_buffer : integer;
  stat : ^shortint;
  ptr: ^shortint;
  int_ext_bitmap : shortint;  { 0=no bitmap display,
                                1=internal GATOR,   2=external GATOR,
                                3=internal GATORBOX,4=external GATORBOX,
                                5=internal BOBCAT,  6=external BOBCAT,
                                7=int LO-RES BOB,   8=ext LORES BOB,
                                9=int LCC CATSEYE, 10=ext LCC CATSEYE
                               additions 9/09/86 SFB
                               11=int HRx CATSEYE, 12=ext HRx CATSEYE
                               more additions 2/19/88 SFB
                               13=int VGA WOODCUT, 14=ext VGA WOODCUT
                               15=int Med WOODCUT, 16=ext Med WOODCUT
                               17=int Hrx WOODCUT, 18=ext Hrx WOODCUT
                               more additions 7JUN91 CFB
                                       greyscale
                               19=int VGA WOODCUT, 20=ext VGA WOODCUT
                               21=int Med WOODCUT, 22=ext Med WOODCUT
                               more additions 30JUL91 CFB }
  raster_device_rec_space : raster_device_rec;
  hpgl_device_rec_space   : hpgl_device_rec;
  ascii_buffer_space      : ascii_buffer;
  file_iocb_space         : file_iocb;
  hpib_iocb_space         : hpib_iocb;
  took_type_ahead         : boolean;
  reduced_screen          : boolean;
  secondary               : boolean;
  moon                    : boolean;
  sysflg2[hex('FFFFFEDA')]: packed record
                              bit7, bit6, bit5, bit4,
                              bit3, bit2, bit1, bit0 : boolean;
                            end;

procedure termraster ( anyvar iocb_ptr : anyptr );

var
  charvar : char;

begin
  with gle_gcb^ do
    begin
      if reduced_screen then
        begin
          with gcb^,raster_device_rec_ptr(dev_dep_stuff)^ do
            begin
              reduced_screen := true;
              n_glines := 752;
              hard_ymax := 751;
            end;
        end;
      if took_type_ahead then
        begin
          crtllhook := save_crthook;
          keybufops(kdisplay,charvar);
        end;
    end;
end;


{Look for bitmap display present.  Assume only one is on the bus and that
 an internal one overrides an external one if multiples present.}

procedure bitmapcrttype(var found_bitmap,has_color:boolean;
                        var  frame_buffer :integer;
                        var select_code,int_ext_bitmap :shortint;
                        var cmapid : integer);  {ADDED SFB--6/11/85}

const   {added 2/19/88 SFB}
   Gator_tertiary       = 0;
   Gbox_tertiary        = 1;
   Bobcat_tertiary      = 2;
   unsupp1_tertiary     = 3;
   unsupp2_tertiary     = 4;
   LCC_tertiary         = 5;
   HRC_tertiary         = 6;
   HRM_tertiary         = 7;
   unsupp3_tertiary     = 8;
   unsupp4_tertiary     = 9;
   unsupp5_tertiary     = 10;
   unsupp6_tertiary     = 11;
   unsupp7_tertiary     = 12;
   unsupp8_tertiary     = 13;
   unsupp9_tertiary     = 14;
   Hrx_Woodcut_tertiary = 15;
   Med_Woodcut_tertiary = 16;
   VGA_Woodcut_tertiary = 17;
   VGAM_Woodcut_tertiary= 18;     { Mono Versions of VGA and HRX - 30JUL91 CFB }
   HrxM_Woodcut_tertiary= 19;

   Gbox_int_ext         = 3;
   Bobcat_int_ext       = 5;
   unsupp_int_ext       = 0;
   LCC_int_ext          = 9;
   HRx_int_ext          = 11;
   VGA_Woodcut_int_ext  = 13;
   Med_Woodcut_int_ext  = 15;
   Hrx_Woodcut_int_ext  = 17;
   VGAM_Woodcut_int_ext = 19;                                
   HrxM_Woodcut_int_ext = 21;

const
    gatorid  =25;
    bitmapid =57;                                               { SFB 10-10-84 }
    low_id   = Gbox_tertiary;                      {GATORBOX; added 9/09/86 SFB}
    hi_id    = HrxM_Woodcut_tertiary;             {WOODCUT; changed 30JUL91 CFB}
type
    int_ext_type = (int,ext);
    iptr = ^integer;
    tertiary_ids = array[low_id..hi_id] of shortint;
const
                                                 {map to various int_ext_values}
                                                 {added WOODCUT  7JUN91 CFB}
    supported_tertiaries = tertiary_ids[Gbox_int_ext,
                                        Bobcat_int_ext,
                                        unsupp_int_ext,
                                        unsupp_int_ext,
                                        LCC_int_ext,
                                        HRx_int_ext,
                                        HRx_int_ext,
                                        unsupp_int_ext,
                                        unsupp_int_ext,
                                        unsupp_int_ext,
                                        unsupp_int_ext,
                                        unsupp_int_ext,
                                        unsupp_int_ext,
                                        unsupp_int_ext,
                                        Hrx_Woodcut_int_ext,
                                        Med_Woodcut_int_ext,
                                        VGA_Woodcut_int_ext,
                                        VGAM_Woodcut_int_ext,
                                        HrxM_Woodcut_int_ext];

   {hi_int_ext=supported_tertiaries[hi_id]+1;   {compiler doesn't support this.}
                                                {2/19/88 SFB}
var
    i     : shortint;
    dummy : shortint;
    bptr  : ^char;

  procedure setupbitmaptype(int_ext : int_ext_type);

  var
      fbrelative : integer;
      tvalue     : shortint;      {SFB 9/09/86}

    function value : shortint;       {returns value of byte at bptr^ in GRAPHICS
                                      ROM and bumps bptr to next byte}
    begin
     value := ord(bptr^);
     bptr := anyptr(integer(bptr) + 2);
    end;

  begin
    if dummy = gatorid then
    begin
      int_ext_bitmap := 1 + ord(int_ext);
      stat := anyptr(control_space + 16384);
      frame_buffer := ((stat^) mod 16)*hex('100000');
    end
    else
    begin                             {read tertiary ID and locate frame buffer}
      bptr := anyptr(control_space + 21);
      tvalue := value;                                             {SFB 9/09/86}
      {int_ext_bitmap := 2 * value + ord(int_ext) + 1;}
      if (tvalue >= low_id) and (tvalue <= hi_id) then             {SFB 9/09/86}
      begin
        int_ext_bitmap := supported_tertiaries[tvalue];
        if int_ext_bitmap <> 0 then
          int_ext_bitmap := int_ext_bitmap + ord(int_ext);
      end;
      if (int_ext_bitmap >= Gbox_int_ext)
         and (int_ext_bitmap < VGA_Woodcut_int_ext) then            {CFB 7JUN91}
      begin                                                        {SFB 1-23-85}
        bptr := anyptr(control_space + hex('005D'));     {^frame buffer relative
                                                   location pointer--2 byte qty}
        fbrelative := value;
        fbrelative := value + fbrelative * 256;
        bptr := anyptr(fbrelative + control_space);            {bits A16..A23 of
                                                           frame buffer address}
        frame_buffer := value * hex('10000');            {left shift bits 16..23
                                                                   by 16 places}
                                                       {check for lo-res bobcat}
        if (int_ext_bitmap = 5) or (int_ext_bitmap = 6) then
        begin
          bptr := anyptr(control_space + hex('0017'));{^"non-square pixel" info}
          if odd(ord(bptr^)) then int_ext_bitmap := int_ext_bitmap + 2;
         {set to corresponding lores internal or external bobcat type}
        end
        else                                 {GATORBOX       added SFB--6/11/85}
        begin                       {get colormap id for later use SFB--6/11/85}
          bptr := anyptr(control_space + hex('57'));       {cmapid addr pointer}
          fbrelative := value;                              {MSB of rel address}
          fbrelative := value + 256*fbrelative;             {16-bit rel address}
          bptr := anyptr(control_space + fbrelative);              {cmapid addr}
          cmapid := value mod 4;              {at last! the cmapid 2 lower bits}
        end;
      end;
      {if (int_ext_bitmap >= VGA_Woodcut_int_ext) and *****{DIO-II is different}
      if (int_ext_bitmap >= LCC_int_ext) and       {DIO-II is different}
         (int_ext_bitmap <= HrxM_Woodcut_int_ext+1) and
         (control_space >= hex('1000000')) then
      begin
        frame_buffer := control_space + hex('200000');
        cmapid := 99;
      end;
    end;
  end;


begin
  control_space:=0;
  found_bitmap:=false;
  int_ext_bitmap := 0;
  ptr:=anyptr(hex('560000'));
  cmapid := 0;  {SFB 6/11/85}

  if select_code <= 6 then                {only check internal space SFB 7/9/85}
  try
    dummy := ptr^;
    dummy := dummy mod 128;
    if (dummy = gatorid) OR (dummy = bitmapid) then      {found internal bitmap}
    begin
      found_bitmap:=true;
      control_space:=integer(ptr);
    end;
  recover
    begin                            {add WOODCUT console support - CFB 13JUN91}
      if escapecode<>-12 then escape(escapecode);
      if (sysflg2.bit4 = true) then      {don't try on 68000/68010 - CFB 1APR92}
      begin
        ptr:=anyptr((hex('1000000')));                  {try SC 132 for console}
        try
          dummy:=ptr^;
          dummy := dummy mod 128;
          if (dummy = bitmapid) then
          begin
            found_bitmap:=true;
            control_space:=integer(ptr);
          end;
        recover
          if escapecode<>-12 then escape(escapecode);
      end;
    end;
  if found_bitmap then                             {if there, find frame buffer}
    setupbitmaptype(int)

  else if (select_code >= 8) and (select_code <= 31) then {modified CFB 7JUN91}
  begin
    ptr:=anyptr(hex('600000')+select_code*(hex('10000')));
    try
      dummy:=ptr^;
      dummy := dummy mod 128;
      if (dummy = gatorid) OR (dummy = bitmapid) then
      begin
        found_bitmap:=true;
        control_space:=integer(ptr);
      end;
    recover
      if escapecode<>-12 then escape(escapecode);
    if found_bitmap then
      setupbitmaptype(ext);
  end

  else if (select_code >= 132) and (sysflg2.bit4 = true) then
              { added DIO-II CFB 7JUN91 / added sysflag2 test       CFB 3OCT91 }
  begin
    ptr:=anyptr((select_code-128)*(hex('400000')));    {SC 132 starts at 16 Meg}
    try
      dummy:=ptr^;
      dummy := dummy mod 128;
      if (dummy = bitmapid) then
      begin
        found_bitmap:=true;
        control_space:=integer(ptr);
      end;
    recover
      if escapecode<>-12 then escape(escapecode);
      if found_bitmap then
        setupbitmaptype(ext);                                { always external }
  end;
end;


procedure setupraster (  gcb : graphics_control_block_ptr );

var
  graphics_base ['GRAPHICSBASE'] : anyptr;
  device_work_area : raster_device_rec_ptr;
  cnt             : gle_shortint;
  address         : integer;
  control         : integer;
  knob_echo_gcb   : boolean;
  g_ptr           : ^shortint;
  g_dummy         : shortint;
  graphics_bd     : boolean;
  graphicstate ['GRAPHICSFLAG'] : boolean;
  cmapid          : integer;    {SFB 6/11/85}

  procedure dummy1 ( anyvar iocb_ptr, data_ptr : anyptr );
  begin
  end;

  procedure expand_screen;

  begin
    with gcb^ do
      begin
        info3 := 0;
        if (int_ext_bitmap <> 0) then
         begin
           reduced_screen := false;
           info3 := 1;                  {1=expand; 0=leave reduced}
         end;                           {send on to expand screen}
      end;
    if (currentcrt = bitmaptype) and (odd(int_ext_bitmap))
       and     {SFB 3/27/85 to prevent locator destroying save_crthook}
       (not knob_echo_gcb) then
      begin
        save_crthook := crtllhook;
        crtllhook := dummycrtll;
        took_type_ahead := true;
      end;
  end;

  procedure ck_for_graphics_board;

  begin
    graphics_bd := true;
    if graphicstate then g_ptr := anyptr(hex('530000'))
     else g_ptr := anyptr(hex('538000'));
    try
      g_dummy := g_ptr^;
    recover
      begin
        if escapecode <> -12 then escape(escapecode)
        else  graphics_bd := false;
      end;
  end;




  procedure setup_internal;

    procedure toggle_graphics;
    var gon  [5439488  {530000 HEX}] : shortint;
        goff [5472256  {538000 HEX}] : shortint;
        g_on36c [ hex('51FFFC')]: shortint;
        gbase['GRAPHICSBASE'] : ^shortint;
    begin
      if gcb^.info1 = m9836c then begin
        if graphicstate then g_on36c:=1
        else g_on36c:=0;
        gbase:=anyptr(hex('520000'));
      end
      else begin
        if graphicstate then gbase := addr(gon)
                        else gbase := addr(goff);
        gbase^ := gbase^;
      end;
    end;

  begin
    with gcb^ do
     begin
       graphicstate := true;
       info1 := return_machine_type;
       toggle_graphics;
       info_ptr1 := addr(graphics_base);
       info_ptr2 := anyptr(0);
       if info1 = m9836c then
         begin
           info2 := hex('51fffd');
           info3 := hex('51fb00');
         end;
     end;
  end;


  procedure set_moon_vals;
  begin
   with gcb^ do
    begin
     info3 := control div 256;  { get monitor type information (part of control) }
     if (info3 > 6) or (info3 < 1) then info3 := 1;
     moon := true;
     info1 := m98627a;          { set display type to 98627A }
     info2 := address * 65536 + 6291456;  { i/o card address }
     hp98627a_address := anyptr(info2 + hex('8000')); { first plane adr }
     info_ptr1 := addr(hp98627a_address);
     info_ptr2 := anyptr(0);
    end;
  end;

  procedure set_bitmap_vals;
  begin
    with gcb^ do
     begin
       info2 := control_space;       {top of control space}
       info3 := 0;                   {By default dont expand ! BJS 5-29-84}
       info4 := cmapid;              {for gle_raster_init gatorbox SFB 6/11/85}
       info_ptr1 := addr(frame_buffer); {start of control space}
       info_ptr2 := anyptr(0);
       case (int_ext_bitmap-1) div 2 of
         0 : info1 := m9837a;
         1 : info1 := mgatorbox;
         2 : info1 := mbobcat;
         3 : info1 := mbobcatlores;
         4 : info1 := mcatseye;         {SFB 9/09/86}
         5 : info1 := mcatseye_hrx;     {SFB 2/23/88}
         6 : info1 := mvga_woodcut;     {CFB 7JUN91}
         7 : info1 := mmed_woodcut;     {CFB 7JUN91}
         8 : info1 := mhrx_woodcut;     {CFB 7JUN91}
         9 : info1 := mvgam_woodcut;    {CFB 30JUL91}
        10 : info1 := mhrxm_woodcut;    {CFB 30JUL91}
         otherwise begin end;           {SFB 2/23/88}
       end;
     end;
  end;


begin
  with gcb^ do
  if spooling = 0 then
  try
    {address computaton moved up SFB 7/9/85}
    address := gle_read_integer(device_info_char_count,device_info,cnt);
    select_code := address; {SFB 7/9/85}
    bitmapcrttype(found_bitmap, has_color,
                  frame_buffer, select_code, int_ext_bitmap,
                  cmapid {added SFB 6/11/85});
    ck_for_graphics_board;	{some how this was commented out at 54.2 - CFB}
    secondary := false;
    moon := false;
    reduced_screen := true;
    control := info1;  { control passed in info1 }
    knob_echo_gcb := (info2 = 1); { GCB for knob echos }
    if not knob_echo_gcb then       {SFB 6/25/85}
      took_type_ahead := false;
    io_write := dummy1;
    io_term  := termraster;
    device_work_area := addr(raster_device_rec_space);
    dev_dep_stuff := device_work_area;


    if address = 3 then                        {indicates primary display}
    begin
      if ((currentcrt = alphatype)  or (currentcrt = nocrt))
        and (graphics_bd) then
        setup_internal
      else
        if ((currentcrt = bitmaptype) or (not graphics_bd))
          {and (odd(int_ext_bitmap))} then   {removed for WOODCUT - CFB 13JUN91}
          set_bitmap_vals;
        end
      else
        if (address = 6) then                  {indicates secondary display}
        begin
          secondary := true;
          if ((currentcrt = alphatype)  or (currentcrt = nocrt)) {JWS 7/23/85}
            and (int_ext_bitmap <>0) then
            set_bitmap_vals
          else
            if (graphics_bd) then
              setup_internal;

          if (currentcrt = bitmaptype)  then           {console = bitmap so}
          begin                                        {set secondary to}
                                                         { small screen}
            if (graphics_bd) then
              setup_internal
            else                                    {if fails set second.}
              if (odd(int_ext_bitmap)) then           {to bitmap.}
                set_bitmap_vals;
          end;
        end
      else       { must be moonunit or external bitmap }
      begin
        if (address < minrealisc) or
           ((address > maxrealisc) and (address < 132)) or
                                                         {add DIO-II CFB 9JUN91}
           ((address >= 132) and (sysflg2.bit4 = false)) then
           { added sysflag2 test to fix bug on 68000/68010           CFB 1APR92}
           escape(1);

          {Replaced following line BJS 7-23-85;  address will always
           be equal to select_code since 7-9-85 bug fix.  Determine if
           a bit map by looking at int_ext_bitmap being equal to 0 }
          {if (address = select_code) and (not odd(int_ext_bitmap)) then}

          if ((int_ext_bitmap <> 0) and (not odd(int_ext_bitmap))) then
            set_bitmap_vals
          else
            set_moon_vals;
      end;

      {control set}
      if (odd(control DIV 256)) and (not moon)  then
        if
           ((currentcrt = bitmaptype) and (odd(int_ext_bitmap)) and
                                                 {is bitmap, primary,  }
             (not secondary))                      { bitmap is there     }
                           or                    {       or            }
           (((currentcrt = alphatype) or (currentcrt = nocrt)) and
                                                 {is alpha/none,gr bd, }
            (graphics_bd) and (secondary) and (odd(int_ext_bitmap)))
                                                 {second,bitmap there  }
                           or                    {        or           }
           (address > 6) and (not odd(int_ext_bitmap))  {ext. bitmap there }

          then expand_screen;

      {control not set, but bitmap is not console}
      if (((currentcrt = alphatype) or (currentcrt = nocrt)) and
          (int_ext_bitmap <>0) and
          (secondary))
                           or
         (((currentcrt = alphatype) or (currentcrt = nocrt)) and
          (not graphics_bd) and (int_ext_bitmap <>0))

                           or
         ((address >= 8) and (address < 32) and (not moon))
                                                                 {SFB 7/10/85}
                                                                 {jws 6/18/86}
                                                                 {CFB 13JUN91}

        then expand_screen;

      gle_init_raster_output (gcb);

      if (error_return = 0) and (not knob_echo_gcb) then
        dgl_raster_init(control);

      {if error_return <> 0 then dispose(device_work_area);} { clean up }

  recover
    { ignore all escapes (except stop key), user may look at
     escapecode to determine error }
    if escapecode = -20 then escape(-20)
    else error_return := 1
  else
    error_return := 1; { raster devices may not be spooled }
end;

procedure termhpgl ( anyvar iocb_ptr : anyptr );

var
  iocb_ptr_file   : file_iocb_ptr;
  iocb_ptr_hpib   : hpib_iocb_ptr;
  buf             : ascii_buffer_ptr;
  device_work_area : hpgl_device_rec_ptr;
  save_ioresult   : integer;            { | fix clobbering ioresult -- 12/83}

begin
  with gle_gcb^ do
    begin
      if spooling <> 0 then
        begin
          save_ioresult := ioresult;   { | ioresult problem fix 12/83--BDS}
          file_term(iocb_ptr);         { perform io term then release mem }
          ioresult := save_ioresult;   { | ioresult problem fix 12/83--BDS}
          iocb_ptr_file := iocb;
          {dispose(iocb_ptr_file);}
        end
      else
        begin
          hpib_term(iocb_ptr);         { perform io term then release mem }
          iocb_ptr_hpib := iocb;
          {dispose(iocb_ptr_hpib);}
        end;
      buf := device_buf;
      device_work_area := dev_dep_stuff;
      {dispose(buf); dispose(device_work_area);}
    end;
end;

procedure setuphpgl (  gcb : graphics_control_block_ptr );

var
  iocb_ptr_file    : file_iocb_ptr;
  iocb_ptr_hpib    : hpib_iocb_ptr;
  buf              : ascii_buffer_ptr;
  device_work_area : hpgl_device_rec_ptr;
  cnt              : gle_shortint;
  address          : integer;
  address_found    : boolean;
  control          : integer;
  save_ioresult    : integer;              { | fix clobbering ioresult -- 12/83}
  save             : integer;

begin
  with gcb^ do
    begin
      control := info1; { control passed in info1 }
      address_found := false;
      try
        address := gle_read_integer(device_info_char_count,device_info,cnt);
        address_found := true;
      recover
        if escapecode <> -8 { value range error } then escape(escapecode);

      buf := addr(ascii_buffer_space);
      device_buf := buf;
      device_work_area := addr(hpgl_device_rec_space);
      dev_dep_stuff := device_work_area;

      if spooling = 1 then
        begin
          iocb_ptr_file := addr(file_iocb_space);
          iocb := iocb_ptr_file;
          io_write := file_write;
          io_term := termhpgl;
          io_inq_timeout := file_inq_timeout;
          io_set_timeout := file_set_timeout;
          with iocb_ptr_file^ do
            begin
              file_name := device_info;
              name_size := device_info_char_count;
              try
                lock_on_close := 0;                { do not save file by default }
                file_init ( iocb_ptr_file );
                gle_init_hpgl_output (gcb);
                if error_return = 0 then
                  begin
                    dgl_hpgl_init(control);
                    lock_on_close := 1;            { save file }
                  end
                else
                  begin
                    save_ioresult := ioresult;     {| ioresult fix 12/83--BDS}
                    file_term ( iocb_ptr_file );
                    ioresult := save_ioresult;     {| ioresult fix 12/83--BDS}
                  end;
              recover
                if escapecode <> -10 then escape(escapecode)
                else                      error_return := 1;
            end;

          if error_return <> 0 then
            begin { clean up }
              save_ioresult := ioresult;           {| ioresult fix 1/84--BDS}
             {dispose(iocb_ptr_file); dispose(buf); dispose(device_work_area);}
              ioresult := save_ioresult;           {| ioresult fix 1/84--BDS}
            end;
        end
      else
      if address_found then
        begin
          iocb_ptr_hpib := addr(hpib_iocb_space);
          iocb := iocb_ptr_hpib;
          io_write := hpib_write;
          io_read := hpib_read;
          io_term := termhpgl;
          io_inq_timeout := hpib_inq_timeout;
          io_set_timeout := hpib_set_timeout;
          with iocb_ptr_hpib^ do
            begin
              device_addr := device_info;
              name_size   := device_info_char_count;
            end;
          hpib_init ( iocb_ptr_hpib );
          if iocb_ptr_hpib^.error = 0 then
            begin
              gle_init_hpgl_output (gcb);
              if error_return = 0 then dgl_hpgl_init(control)
               { if error then clean up hpib bus (2.1 bug fix) }
              else                     hpib_init ( iocb_ptr_hpib );
            end
          else error_return := 1;
          if error_return <> 0 then
            begin { clean up }
             {dispose(iocb_ptr_hpib); dispose(buf); dispose(device_work_area);}
            end;
        end
      else
        error_return := 1;
    end;
end;

procedure configure_gle (  gcb : graphics_control_block_ptr );

begin
  with gcb^ do
    begin
      setupraster ( gcb );
      if error_return <> 0 then setuphpgl ( gcb );
    end;
end;

end. { of module }


@


56.2
log
@Fixed bug with 68000/68010 trying to access HPIB devices. If 68000/68010,
then don't try select codes >= 132 looking for video. If you do, the
address will wrap back to 0 (only 24 bits) and the Boot ROM will DTACK.
This will make PaWS think that something is there.
@
text
@d507 1
a507 1
    {ck_for_graphics_board;}
@


56.1
log
@Automatic bump of revision number for PWS version 3.25
@
text
@d25 1
a25 1
		  RESTRICTED RIGHTS LEGEND
d38 5
a42 5
	'TYPES',
	'DGL_VARS',
	'DGL_TOOLS',
	'DGL_RAS',
	'DGL_HPGL'${}
d79 16
a94 16
				1=internal GATOR,   2=external GATOR,
				3=internal GATORBOX,4=external GATORBOX,
				5=internal BOBCAT,  6=external BOBCAT,
				7=int LO-RES BOB,   8=ext LORES BOB,
				9=int LCC CATSEYE, 10=ext LCC CATSEYE
			       additions 9/09/86 SFB
			       11=int HRx CATSEYE, 12=ext HRx CATSEYE
			       more additions 2/19/88 SFB
			       13=int VGA WOODCUT, 14=ext VGA WOODCUT
			       15=int Med WOODCUT, 16=ext Med WOODCUT
			       17=int Hrx WOODCUT, 18=ext Hrx WOODCUT
			       more additions 7JUN91 CFB
				       greyscale
			       19=int VGA WOODCUT, 20=ext VGA WOODCUT
			       21=int Med WOODCUT, 22=ext Med WOODCUT
			       more additions 30JUL91 CFB }
d105 3
a107 3
			      bit7, bit6, bit5, bit4,
			      bit3, bit2, bit1, bit0 : boolean;
			    end;
d118 8
a125 8
	begin
	  with gcb^,raster_device_rec_ptr(dev_dep_stuff)^ do
	    begin
	      reduced_screen := true;
	      n_glines := 752;
	      hard_ymax := 751;
	    end;
	end;
d127 4
a130 4
	begin
	  crtllhook := save_crthook;
	  keybufops(kdisplay,charvar);
	end;
d139 3
a141 3
			var  frame_buffer :integer;
			var select_code,int_ext_bitmap :shortint;
			var cmapid : integer);  {ADDED SFB--6/11/85}
d173 1
a173 1
   VGAM_Woodcut_int_ext = 19;
d186 2
a187 2
						 {map to various int_ext_values}
						 {added WOODCUT  7JUN91 CFB}
d189 18
a206 18
					Bobcat_int_ext,
					unsupp_int_ext,
					unsupp_int_ext,
					LCC_int_ext,
					HRx_int_ext,
					HRx_int_ext,
					unsupp_int_ext,
					unsupp_int_ext,
					unsupp_int_ext,
					unsupp_int_ext,
					unsupp_int_ext,
					unsupp_int_ext,
					unsupp_int_ext,
					Hrx_Woodcut_int_ext,
					Med_Woodcut_int_ext,
					VGA_Woodcut_int_ext,
					VGAM_Woodcut_int_ext,
					HrxM_Woodcut_int_ext];
d209 1
a209 1
						{2/19/88 SFB}
d222 1
a222 1
				      ROM and bumps bptr to next byte}
d242 3
a244 3
	int_ext_bitmap := supported_tertiaries[tvalue];
	if int_ext_bitmap <> 0 then
	  int_ext_bitmap := int_ext_bitmap + ord(int_ext);
d247 1
a247 1
	 and (int_ext_bitmap < VGA_Woodcut_int_ext) then            {CFB 7JUN91}
d249 23
a271 23
	bptr := anyptr(control_space + hex('005D'));     {^frame buffer relative
						   location pointer--2 byte qty}
	fbrelative := value;
	fbrelative := value + fbrelative * 256;
	bptr := anyptr(fbrelative + control_space);            {bits A16..A23 of
							   frame buffer address}
	frame_buffer := value * hex('10000');            {left shift bits 16..23
								   by 16 places}
						       {check for lo-res bobcat}
	if (int_ext_bitmap = 5) or (int_ext_bitmap = 6) then
	begin
	  bptr := anyptr(control_space + hex('0017'));{^"non-square pixel" info}
	  if odd(ord(bptr^)) then int_ext_bitmap := int_ext_bitmap + 2;
	 {set to corresponding lores internal or external bobcat type}
	end
	else                                 {GATORBOX       added SFB--6/11/85}
	begin                       {get colormap id for later use SFB--6/11/85}
	  bptr := anyptr(control_space + hex('57'));       {cmapid addr pointer}
	  fbrelative := value;                              {MSB of rel address}
	  fbrelative := value + 256*fbrelative;             {16-bit rel address}
	  bptr := anyptr(control_space + fbrelative);              {cmapid addr}
	  cmapid := value mod 4;              {at last! the cmapid 2 lower bits}
	end;
d273 4
a276 2
      if (int_ext_bitmap >= VGA_Woodcut_int_ext) and       {DIO-II is different}
	 (int_ext_bitmap <= HrxM_Woodcut_int_ext+1) then
d278 2
a279 2
	frame_buffer := control_space + hex('200000');
	cmapid := 99;
d304 14
a317 11
      ptr:=anyptr((hex('1000000')));                    {try SC 132 for console}
      try
	dummy:=ptr^;
	dummy := dummy mod 128;
	if (dummy = bitmapid) then
	begin
	  found_bitmap:=true;
	  control_space:=integer(ptr);
	end;
      recover
	if escapecode<>-12 then escape(escapecode);
d330 2
a331 2
	found_bitmap:=true;
	control_space:=integer(ptr);
d340 1
a340 1
	      { added DIO-II CFB 7JUN91 / added sysflag2 test       CFB 3OCT91 }
d348 2
a349 2
	found_bitmap:=true;
	control_space:=integer(ptr);
d354 1
a354 1
	setupbitmaptype(ext);                                { always external }
d383 6
a388 6
	info3 := 0;
	if (int_ext_bitmap <> 0) then
	 begin
	   reduced_screen := false;
	   info3 := 1;                  {1=expand; 0=leave reduced}
	 end;                           {send on to expand screen}
d394 3
a396 3
	save_crthook := crtllhook;
	crtllhook := dummycrtll;
	took_type_ahead := true;
d410 2
a411 2
	if escapecode <> -12 then escape(escapecode)
	else  graphics_bd := false;
d422 3
a424 3
	goff [5472256  {538000 HEX}] : shortint;
	g_on36c [ hex('51FFFC')]: shortint;
	gbase['GRAPHICSBASE'] : ^shortint;
d427 3
a429 3
	if graphicstate then g_on36c:=1
	else g_on36c:=0;
	gbase:=anyptr(hex('520000'));
d432 3
a434 3
	if graphicstate then gbase := addr(gon)
			else gbase := addr(goff);
	gbase^ := gbase^;
d447 4
a450 4
	 begin
	   info2 := hex('51fffd');
	   info3 := hex('51fb00');
	 end;
d480 12
a491 12
	 0 : info1 := m9837a;
	 1 : info1 := mgatorbox;
	 2 : info1 := mbobcat;
	 3 : info1 := mbobcatlores;
	 4 : info1 := mcatseye;         {SFB 9/09/86}
	 5 : info1 := mcatseye_hrx;     {SFB 2/23/88}
	 6 : info1 := mvga_woodcut;     {CFB 7JUN91}
	 7 : info1 := mmed_woodcut;     {CFB 7JUN91}
	 8 : info1 := mhrx_woodcut;     {CFB 7JUN91}
	 9 : info1 := mvgam_woodcut;    {CFB 30JUL91}
	10 : info1 := mhrxm_woodcut;    {CFB 30JUL91}
	 otherwise begin end;           {SFB 2/23/88}
d505 2
a506 2
		  frame_buffer, select_code, int_ext_bitmap,
		  cmapid {added SFB 6/11/85});
d524 2
a525 2
	and (graphics_bd) then
	setup_internal
d527 4
a530 4
	if ((currentcrt = bitmaptype) or (not graphics_bd))
	  {and (odd(int_ext_bitmap))} then   {removed for WOODCUT - CFB 13JUN91}
	  set_bitmap_vals;
	end
d532 9
a540 9
	if (address = 6) then                  {indicates secondary display}
	begin
	  secondary := true;
	  if ((currentcrt = alphatype)  or (currentcrt = nocrt)) {JWS 7/23/85}
	    and (int_ext_bitmap <>0) then
	    set_bitmap_vals
	  else
	    if (graphics_bd) then
	      setup_internal;
d542 10
a551 10
	  if (currentcrt = bitmaptype)  then           {console = bitmap so}
	  begin                                        {set secondary to}
							 { small screen}
	    if (graphics_bd) then
	      setup_internal
	    else                                    {if fails set second.}
	      if (odd(int_ext_bitmap)) then           {to bitmap.}
		set_bitmap_vals;
	  end;
	end
d554 6
a559 2
	if (address < minrealisc) or ((address > maxrealisc)
	  and (address < 132)) then escape(1);  {add DIO-II CFB 9JUN91}
d561 4
a564 4
	  {Replaced following line BJS 7-23-85;  address will always
	   be equal to select_code since 7-9-85 bug fix.  Determine if
	   a bit map by looking at int_ext_bitmap being equal to 0 }
	  {if (address = select_code) and (not odd(int_ext_bitmap)) then}
d566 4
a569 4
	  if ((int_ext_bitmap <> 0) and (not odd(int_ext_bitmap))) then
	    set_bitmap_vals
	  else
	    set_moon_vals;
d574 11
a584 11
	if
	   ((currentcrt = bitmaptype) and (odd(int_ext_bitmap)) and
						 {is bitmap, primary,  }
	     (not secondary))                      { bitmap is there     }
			   or                    {       or            }
	   (((currentcrt = alphatype) or (currentcrt = nocrt)) and
						 {is alpha/none,gr bd, }
	    (graphics_bd) and (secondary) and (odd(int_ext_bitmap)))
						 {second,bitmap there  }
			   or                    {        or           }
	   (address > 6) and (not odd(int_ext_bitmap))  {ext. bitmap there }
d586 1
a586 1
	  then expand_screen;
d590 5
a594 5
	  (int_ext_bitmap <>0) and
	  (secondary))
			   or
	 (((currentcrt = alphatype) or (currentcrt = nocrt)) and
	  (not graphics_bd) and (int_ext_bitmap <>0))
d596 5
a600 5
			   or
	 ((address >= 8) and (address < 32) and (not moon))
								 {SFB 7/10/85}
								 {jws 6/18/86}
								 {CFB 13JUN91}
d602 1
a602 1
	then expand_screen;
d607 1
a607 1
	dgl_raster_init(control);
d633 7
a639 7
	begin
	  save_ioresult := ioresult;   { | ioresult problem fix 12/83--BDS}
	  file_term(iocb_ptr);         { perform io term then release mem }
	  ioresult := save_ioresult;   { | ioresult problem fix 12/83--BDS}
	  iocb_ptr_file := iocb;
	  {dispose(iocb_ptr_file);}
	end
d641 5
a645 5
	begin
	  hpib_term(iocb_ptr);         { perform io term then release mem }
	  iocb_ptr_hpib := iocb;
	  {dispose(iocb_ptr_hpib);}
	end;
d672 2
a673 2
	address := gle_read_integer(device_info_char_count,device_info,cnt);
	address_found := true;
d675 1
a675 1
	if escapecode <> -8 { value range error } then escape(escapecode);
d683 30
a712 30
	begin
	  iocb_ptr_file := addr(file_iocb_space);
	  iocb := iocb_ptr_file;
	  io_write := file_write;
	  io_term := termhpgl;
	  io_inq_timeout := file_inq_timeout;
	  io_set_timeout := file_set_timeout;
	  with iocb_ptr_file^ do
	    begin
	      file_name := device_info;
	      name_size := device_info_char_count;
	      try
		lock_on_close := 0;                { do not save file by default }
		file_init ( iocb_ptr_file );
		gle_init_hpgl_output (gcb);
		if error_return = 0 then
		  begin
		    dgl_hpgl_init(control);
		    lock_on_close := 1;            { save file }
		  end
		else
		  begin
		    save_ioresult := ioresult;     {| ioresult fix 12/83--BDS}
		    file_term ( iocb_ptr_file );
		    ioresult := save_ioresult;     {| ioresult fix 12/83--BDS}
		  end;
	      recover
		if escapecode <> -10 then escape(escapecode)
		else                      error_return := 1;
	    end;
d714 7
a720 7
	  if error_return <> 0 then
	    begin { clean up }
	      save_ioresult := ioresult;           {| ioresult fix 1/84--BDS}
	     {dispose(iocb_ptr_file); dispose(buf); dispose(device_work_area);}
	      ioresult := save_ioresult;           {| ioresult fix 1/84--BDS}
	    end;
	end
d723 27
a749 27
	begin
	  iocb_ptr_hpib := addr(hpib_iocb_space);
	  iocb := iocb_ptr_hpib;
	  io_write := hpib_write;
	  io_read := hpib_read;
	  io_term := termhpgl;
	  io_inq_timeout := hpib_inq_timeout;
	  io_set_timeout := hpib_set_timeout;
	  with iocb_ptr_hpib^ do
	    begin
	      device_addr := device_info;
	      name_size   := device_info_char_count;
	    end;
	  hpib_init ( iocb_ptr_hpib );
	  if iocb_ptr_hpib^.error = 0 then
	    begin
	      gle_init_hpgl_output (gcb);
	      if error_return = 0 then dgl_hpgl_init(control)
	       { if error then clean up hpib bus (2.1 bug fix) }
	      else                     hpib_init ( iocb_ptr_hpib );
	    end
	  else error_return := 1;
	  if error_return <> 0 then
	    begin { clean up }
	     {dispose(iocb_ptr_hpib); dispose(buf); dispose(device_work_area);}
	    end;
	end
d751 1
a751 1
	error_return := 1;
@


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


55.2
log
@Added support for High-res and Greyscale - CFB
@
text
@d25 1
a25 1
                  RESTRICTED RIGHTS LEGEND
d38 5
a42 5
        'TYPES',
        'DGL_VARS',
        'DGL_TOOLS',
        'DGL_RAS',
        'DGL_HPGL'${}
d79 16
a94 16
                                1=internal GATOR,   2=external GATOR,
                                3=internal GATORBOX,4=external GATORBOX,
                                5=internal BOBCAT,  6=external BOBCAT,
                                7=int LO-RES BOB,   8=ext LORES BOB,
                                9=int LCC CATSEYE, 10=ext LCC CATSEYE
                               additions 9/09/86 SFB
                               11=int HRx CATSEYE, 12=ext HRx CATSEYE
                               more additions 2/19/88 SFB
                               13=int VGA WOODCUT, 14=ext VGA WOODCUT
                               15=int Med WOODCUT, 16=ext Med WOODCUT
                               17=int Hrx WOODCUT, 18=ext Hrx WOODCUT
                               more additions 7JUN91 CFB
                                       greyscale
                               19=int VGA WOODCUT, 20=ext VGA WOODCUT
                               21=int Med WOODCUT, 22=ext Med WOODCUT
                               more additions 30JUL91 CFB }
d105 3
a107 3
                              bit7, bit6, bit5, bit4,
                              bit3, bit2, bit1, bit0 : boolean;
                            end;
d118 8
a125 8
        begin
          with gcb^,raster_device_rec_ptr(dev_dep_stuff)^ do
            begin
              reduced_screen := true;
              n_glines := 752;
              hard_ymax := 751;
            end;
        end;
d127 4
a130 4
        begin
          crtllhook := save_crthook;
          keybufops(kdisplay,charvar);
        end;
d139 3
a141 3
                        var  frame_buffer :integer;
                        var select_code,int_ext_bitmap :shortint;
                        var cmapid : integer);  {ADDED SFB--6/11/85}
d173 1
a173 1
   VGAM_Woodcut_int_ext = 19;                                
d186 2
a187 2
                                                 {map to various int_ext_values}
                                                 {added WOODCUT  7JUN91 CFB}
d189 18
a206 18
                                        Bobcat_int_ext,
                                        unsupp_int_ext,
                                        unsupp_int_ext,
                                        LCC_int_ext,
                                        HRx_int_ext,
                                        HRx_int_ext,
                                        unsupp_int_ext,
                                        unsupp_int_ext,
                                        unsupp_int_ext,
                                        unsupp_int_ext,
                                        unsupp_int_ext,
                                        unsupp_int_ext,
                                        unsupp_int_ext,
                                        Hrx_Woodcut_int_ext,
                                        Med_Woodcut_int_ext,
                                        VGA_Woodcut_int_ext,
                                        VGAM_Woodcut_int_ext,
                                        HrxM_Woodcut_int_ext];
d209 1
a209 1
                                                {2/19/88 SFB}
d222 1
a222 1
                                      ROM and bumps bptr to next byte}
d242 3
a244 3
        int_ext_bitmap := supported_tertiaries[tvalue];
        if int_ext_bitmap <> 0 then
          int_ext_bitmap := int_ext_bitmap + ord(int_ext);
d247 1
a247 1
         and (int_ext_bitmap < VGA_Woodcut_int_ext) then            {CFB 7JUN91}
d249 23
a271 23
        bptr := anyptr(control_space + hex('005D'));     {^frame buffer relative
                                                   location pointer--2 byte qty}
        fbrelative := value;
        fbrelative := value + fbrelative * 256;
        bptr := anyptr(fbrelative + control_space);            {bits A16..A23 of
                                                           frame buffer address}
        frame_buffer := value * hex('10000');            {left shift bits 16..23
                                                                   by 16 places}
                                                       {check for lo-res bobcat}
        if (int_ext_bitmap = 5) or (int_ext_bitmap = 6) then
        begin
          bptr := anyptr(control_space + hex('0017'));{^"non-square pixel" info}
          if odd(ord(bptr^)) then int_ext_bitmap := int_ext_bitmap + 2;
         {set to corresponding lores internal or external bobcat type}
        end
        else                                 {GATORBOX       added SFB--6/11/85}
        begin                       {get colormap id for later use SFB--6/11/85}
          bptr := anyptr(control_space + hex('57'));       {cmapid addr pointer}
          fbrelative := value;                              {MSB of rel address}
          fbrelative := value + 256*fbrelative;             {16-bit rel address}
          bptr := anyptr(control_space + fbrelative);              {cmapid addr}
          cmapid := value mod 4;              {at last! the cmapid 2 lower bits}
        end;
d274 1
a274 1
         (int_ext_bitmap <= HrxM_Woodcut_int_ext+1) then
d276 2
a277 2
        frame_buffer := control_space + hex('200000');
        cmapid := 99;
d300 1
a300 1
    begin			     {add WOODCUT console support - CFB 13JUN91}
d304 7
a310 7
        dummy:=ptr^;
        dummy := dummy mod 128;
        if (dummy = bitmapid) then
        begin
          found_bitmap:=true;
          control_space:=integer(ptr);
        end;
d312 1
a312 1
        if escapecode<>-12 then escape(escapecode);
d325 2
a326 2
        found_bitmap:=true;
        control_space:=integer(ptr);
d335 1
a335 1
              { added DIO-II CFB 7JUN91 / added sysflag2 test       CFB 3OCT91 }
d343 2
a344 2
        found_bitmap:=true;
        control_space:=integer(ptr);
d349 1
a349 1
        setupbitmaptype(ext);                                { always external }
d378 6
a383 6
        info3 := 0;
        if (int_ext_bitmap <> 0) then
         begin
           reduced_screen := false;
           info3 := 1;                  {1=expand; 0=leave reduced}
         end;                           {send on to expand screen}
d389 3
a391 3
        save_crthook := crtllhook;
        crtllhook := dummycrtll;
        took_type_ahead := true;
d405 2
a406 2
        if escapecode <> -12 then escape(escapecode)
        else  graphics_bd := false;
d417 3
a419 3
        goff [5472256  {538000 HEX}] : shortint;
        g_on36c [ hex('51FFFC')]: shortint;
        gbase['GRAPHICSBASE'] : ^shortint;
d422 3
a424 3
        if graphicstate then g_on36c:=1
        else g_on36c:=0;
        gbase:=anyptr(hex('520000'));
d427 3
a429 3
        if graphicstate then gbase := addr(gon)
                        else gbase := addr(goff);
        gbase^ := gbase^;
d442 4
a445 4
         begin
           info2 := hex('51fffd');
           info3 := hex('51fb00');
         end;
d475 12
a486 12
         0 : info1 := m9837a;
         1 : info1 := mgatorbox;
         2 : info1 := mbobcat;
         3 : info1 := mbobcatlores;
         4 : info1 := mcatseye;         {SFB 9/09/86}
         5 : info1 := mcatseye_hrx;     {SFB 2/23/88}
         6 : info1 := mvga_woodcut;     {CFB 7JUN91}
         7 : info1 := mmed_woodcut;     {CFB 7JUN91}
         8 : info1 := mhrx_woodcut;     {CFB 7JUN91}
         9 : info1 := mvgam_woodcut;    {CFB 30JUL91}
        10 : info1 := mhrxm_woodcut;    {CFB 30JUL91}
         otherwise begin end;           {SFB 2/23/88}
d500 2
a501 2
                  frame_buffer, select_code, int_ext_bitmap,
                  cmapid {added SFB 6/11/85});
d519 2
a520 2
        and (graphics_bd) then
        setup_internal
d522 4
a525 4
        if ((currentcrt = bitmaptype) or (not graphics_bd))
          {and (odd(int_ext_bitmap))} then   {removed for WOODCUT - CFB 13JUN91}
          set_bitmap_vals;
        end
d527 9
a535 9
        if (address = 6) then                  {indicates secondary display}
        begin
          secondary := true;
          if ((currentcrt = alphatype)  or (currentcrt = nocrt)) {JWS 7/23/85}
            and (int_ext_bitmap <>0) then
            set_bitmap_vals
          else
            if (graphics_bd) then
              setup_internal;
d537 10
a546 10
          if (currentcrt = bitmaptype)  then           {console = bitmap so}
          begin                                        {set secondary to}
                                                         { small screen}
            if (graphics_bd) then
              setup_internal
            else                                    {if fails set second.}
              if (odd(int_ext_bitmap)) then           {to bitmap.}
                set_bitmap_vals;
          end;
        end
d549 2
a550 2
        if (address < minrealisc) or ((address > maxrealisc)
          and (address < 132)) then escape(1);	{add DIO-II CFB 9JUN91}
d552 4
a555 4
          {Replaced following line BJS 7-23-85;  address will always
           be equal to select_code since 7-9-85 bug fix.  Determine if
           a bit map by looking at int_ext_bitmap being equal to 0 }
          {if (address = select_code) and (not odd(int_ext_bitmap)) then}
d557 4
a560 4
          if ((int_ext_bitmap <> 0) and (not odd(int_ext_bitmap))) then
            set_bitmap_vals
          else
            set_moon_vals;
d565 11
a575 11
        if
           ((currentcrt = bitmaptype) and (odd(int_ext_bitmap)) and
                                                 {is bitmap, primary,  }
             (not secondary))                      { bitmap is there     }
                           or                    {       or            }
           (((currentcrt = alphatype) or (currentcrt = nocrt)) and
                                                 {is alpha/none,gr bd, }
            (graphics_bd) and (secondary) and (odd(int_ext_bitmap)))
                                                 {second,bitmap there  }
                           or                    {        or           }
           (address > 6) and (not odd(int_ext_bitmap))  {ext. bitmap there }
d577 1
a577 1
          then expand_screen;
d581 5
a585 5
          (int_ext_bitmap <>0) and
          (secondary))
                           or
         (((currentcrt = alphatype) or (currentcrt = nocrt)) and
          (not graphics_bd) and (int_ext_bitmap <>0))
d587 5
a591 5
                           or
         ((address >= 8) and (address < 32) and (not moon))
                                                                 {SFB 7/10/85}
                                                                 {jws 6/18/86}
                                                                 {CFB 13JUN91}
d593 1
a593 1
        then expand_screen;
d598 1
a598 1
        dgl_raster_init(control);
d624 7
a630 7
        begin
          save_ioresult := ioresult;   { | ioresult problem fix 12/83--BDS}
          file_term(iocb_ptr);         { perform io term then release mem }
          ioresult := save_ioresult;   { | ioresult problem fix 12/83--BDS}
          iocb_ptr_file := iocb;
          {dispose(iocb_ptr_file);}
        end
d632 5
a636 5
        begin
          hpib_term(iocb_ptr);         { perform io term then release mem }
          iocb_ptr_hpib := iocb;
          {dispose(iocb_ptr_hpib);}
        end;
d663 2
a664 2
        address := gle_read_integer(device_info_char_count,device_info,cnt);
        address_found := true;
d666 1
a666 1
        if escapecode <> -8 { value range error } then escape(escapecode);
d674 38
a711 38
        begin
          iocb_ptr_file := addr(file_iocb_space);
          iocb := iocb_ptr_file;
          io_write := file_write;
          io_term := termhpgl;
          io_inq_timeout := file_inq_timeout;
          io_set_timeout := file_set_timeout;
          with iocb_ptr_file^ do
            begin
              file_name := device_info;
              name_size := device_info_char_count;
              try
                lock_on_close := 0;                { do not save file by default }
                file_init ( iocb_ptr_file );
                gle_init_hpgl_output (gcb);
                if error_return = 0 then
                  begin
                    dgl_hpgl_init(control);
                    lock_on_close := 1;            { save file }
                  end
                else
                  begin
                    save_ioresult := ioresult;     {| ioresult fix 12/83--BDS}
                    file_term ( iocb_ptr_file );
                    ioresult := save_ioresult;     {| ioresult fix 12/83--BDS}
                  end;
              recover
                if escapecode <> -10 then escape(escapecode)
                else                      error_return := 1;
            end;

          if error_return <> 0 then
            begin { clean up }
              save_ioresult := ioresult;           {| ioresult fix 1/84--BDS}
             {dispose(iocb_ptr_file); dispose(buf); dispose(device_work_area);}
              ioresult := save_ioresult;           {| ioresult fix 1/84--BDS}
            end;
        end
d714 27
a740 27
        begin
          iocb_ptr_hpib := addr(hpib_iocb_space);
          iocb := iocb_ptr_hpib;
          io_write := hpib_write;
          io_read := hpib_read;
          io_term := termhpgl;
          io_inq_timeout := hpib_inq_timeout;
          io_set_timeout := hpib_set_timeout;
          with iocb_ptr_hpib^ do
            begin
              device_addr := device_info;
              name_size   := device_info_char_count;
            end;
          hpib_init ( iocb_ptr_hpib );
          if iocb_ptr_hpib^.error = 0 then
            begin
              gle_init_hpgl_output (gcb);
              if error_return = 0 then dgl_hpgl_init(control)
               { if error then clean up hpib bus (2.1 bug fix) }
              else                     hpib_init ( iocb_ptr_hpib );
            end
          else error_return := 1;
          if error_return <> 0 then
            begin { clean up }
             {dispose(iocb_ptr_hpib); dispose(buf); dispose(device_work_area);}
            end;
        end
d742 1
a742 1
        error_return := 1;
@


55.1
log
@Automatic bump of revision number for PWS version 3.25A
@
text
@d25 1
a25 1
		  RESTRICTED RIGHTS LEGEND
d38 5
a42 5
	'TYPES',
	'DGL_VARS',
	'DGL_TOOLS',
	'DGL_RAS',
	'DGL_HPGL'${}
d79 16
a94 12
				1=internal GATOR,   2=external GATOR,
				3=internal GATORBOX,4=external GATORBOX,
				5=internal BOBCAT,  6=external BOBCAT,
				7=int LO-RES BOB,   8=ext LORES BOB,
				9=int LCC CATSEYE, 10=ext LCC CATSEYE
			       additions 9/09/86 SFB
			       11=int HRx CATSEYE, 12=ext HRx CATSEYE
			       more additions 2/19/88 SFB
			       13=int VGA WOODCUT, 14=ext VGA WOODCUT
			       15=int Med WOODCUT, 16=ext Med WOODCUT
			       17=int Hrx WOODCUT, 18=ext Hrx WOODCUT
			       more additions 7JUN91 CFB }
d104 4
d118 8
a125 8
	begin
	  with gcb^,raster_device_rec_ptr(dev_dep_stuff)^ do
	    begin
	      reduced_screen := true;
	      n_glines := 752;
	      hard_ymax := 751;
	    end;
	end;
d127 4
a130 4
	begin
	  crtllhook := save_crthook;
	  keybufops(kdisplay,charvar);
	end;
d139 3
a141 3
			var  frame_buffer :integer;
			var select_code,int_ext_bitmap :shortint;
			var cmapid : integer);  {ADDED SFB--6/11/85}
d159 1
a159 1
   unsupp10_tertiary    = 15;
d162 2
a163 1
   Hrx_Woodcut_tertiary = 99;
d173 2
d180 1
a180 1
    hi_id    = VGA_Woodcut_tertiary;                 {WOODCUT; added 7JUN91 CFB}
d186 2
a187 2
						 {map to various int_ext_values}
						 {added WOODCUT  7JUN91 CFB}
d189 18
a206 16
					Bobcat_int_ext,
					unsupp_int_ext,
					unsupp_int_ext,
					LCC_int_ext,
					HRx_int_ext,
					HRx_int_ext,
					unsupp_int_ext,
					unsupp_int_ext,
					unsupp_int_ext,
					unsupp_int_ext,
					unsupp_int_ext,
					unsupp_int_ext,
					unsupp_int_ext,
					unsupp_int_ext,
					Med_Woodcut_int_ext,
					VGA_Woodcut_int_ext];
d209 1
a209 1
						{2/19/88 SFB}
d222 1
a222 1
				      ROM and bumps bptr to next byte}
d242 3
a244 3
	int_ext_bitmap := supported_tertiaries[tvalue];
	if int_ext_bitmap <> 0 then
	  int_ext_bitmap := int_ext_bitmap + ord(int_ext);
d247 1
a247 1
	 and (int_ext_bitmap < VGA_Woodcut_int_ext) then            {CFB 7JUN91}
d249 23
a271 23
	bptr := anyptr(control_space + hex('005D'));     {^frame buffer relative
						   location pointer--2 byte qty}
	fbrelative := value;
	fbrelative := value + fbrelative * 256;
	bptr := anyptr(fbrelative + control_space);            {bits A16..A23 of
							   frame buffer address}
	frame_buffer := value * hex('10000');            {left shift bits 16..23
								   by 16 places}
						       {check for lo-res bobcat}
	if (int_ext_bitmap = 5) or (int_ext_bitmap = 6) then
	begin
	  bptr := anyptr(control_space + hex('0017'));{^"non-square pixel" info}
	  if odd(ord(bptr^)) then int_ext_bitmap := int_ext_bitmap + 2;
	 {set to corresponding lores internal or external bobcat type}
	end
	else                                 {GATORBOX       added SFB--6/11/85}
	begin                       {get colormap id for later use SFB--6/11/85}
	  bptr := anyptr(control_space + hex('57'));       {cmapid addr pointer}
	  fbrelative := value;                              {MSB of rel address}
	  fbrelative := value + 256*fbrelative;             {16-bit rel address}
	  bptr := anyptr(control_space + fbrelative);              {cmapid addr}
	  cmapid := value mod 4;              {at last! the cmapid 2 lower bits}
	end;
d274 1
a274 1
	 (int_ext_bitmap <= Med_Woodcut_int_ext+1) then
d276 2
a277 2
	frame_buffer := control_space + hex('200000');
	cmapid := 99;
d300 1
a300 1
    begin                            {add WOODCUT console support - CFB 13JUN91}
d304 7
a310 7
	dummy:=ptr^;
	dummy := dummy mod 128;
	if (dummy = bitmapid) then
	begin
	  found_bitmap:=true;
	  control_space:=integer(ptr);
	end;
d312 1
a312 1
	if escapecode<>-12 then escape(escapecode);
d325 2
a326 2
	found_bitmap:=true;
	control_space:=integer(ptr);
d334 2
a335 1
  else if select_code >= 132 then                      {added DIO-II CFB 7JUN91}
d339 7
a345 7
    dummy:=ptr^;
    dummy := dummy mod 128;
    if (dummy = bitmapid) then
    begin
      found_bitmap:=true;
      control_space:=integer(ptr);
    end;
d347 3
a349 3
    if escapecode<>-12 then escape(escapecode);
    if found_bitmap then
      setupbitmaptype(ext);                                  { always external }
d378 6
a383 6
	info3 := 0;
	if (int_ext_bitmap <> 0) then
	 begin
	   reduced_screen := false;
	   info3 := 1;                  {1=expand; 0=leave reduced}
	 end;                           {send on to expand screen}
d389 3
a391 3
	save_crthook := crtllhook;
	crtllhook := dummycrtll;
	took_type_ahead := true;
d405 2
a406 2
	if escapecode <> -12 then escape(escapecode)
	else  graphics_bd := false;
d417 3
a419 3
	goff [5472256  {538000 HEX}] : shortint;
	g_on36c [ hex('51FFFC')]: shortint;
	gbase['GRAPHICSBASE'] : ^shortint;
d422 3
a424 3
	if graphicstate then g_on36c:=1
	else g_on36c:=0;
	gbase:=anyptr(hex('520000'));
d427 3
a429 3
	if graphicstate then gbase := addr(gon)
			else gbase := addr(goff);
	gbase^ := gbase^;
d442 4
a445 4
	 begin
	   info2 := hex('51fffd');
	   info3 := hex('51fb00');
	 end;
d475 12
a486 10
	 0 : info1 := m9837a;
	 1 : info1 := mgatorbox;
	 2 : info1 := mbobcat;
	 3 : info1 := mbobcatlores;
	 4 : info1 := mcatseye;         {SFB 9/09/86}
	 5 : info1 := mcatseye_hrx;     {SFB 2/23/88}
	 6 : info1 := mvga_woodcut;     {CFB 7JUN91}
	 7 : info1 := mmed_woodcut;     {CFB 7JUN91}
	 8 : info1 := mhrx_woodcut;     {CFB 7JUN91}
	 otherwise begin end;           {SFB 2/23/88}
d500 2
a501 2
		  frame_buffer, select_code, int_ext_bitmap,
		  cmapid {added SFB 6/11/85});
d519 2
a520 2
	and (graphics_bd) then
	setup_internal
d522 4
a525 4
	if ((currentcrt = bitmaptype) or (not graphics_bd))
	  {and (odd(int_ext_bitmap))} then   {removed for WOODCUT - CFB 13JUN91}
	  set_bitmap_vals;
	end
d527 9
a535 9
	if (address = 6) then                  {indicates secondary display}
	begin
	  secondary := true;
	  if ((currentcrt = alphatype)  or (currentcrt = nocrt)) {JWS 7/23/85}
	    and (int_ext_bitmap <>0) then
	    set_bitmap_vals
	  else
	    if (graphics_bd) then
	      setup_internal;
d537 10
a546 10
	  if (currentcrt = bitmaptype)  then           {console = bitmap so}
	  begin                                        {set secondary to}
							 { small screen}
	    if (graphics_bd) then
	      setup_internal
	    else                                    {if fails set second.}
	      if (odd(int_ext_bitmap)) then           {to bitmap.}
		set_bitmap_vals;
	  end;
	end
d549 2
a550 2
	if (address < minrealisc) or ((address > maxrealisc)
	  and (address < 132)) then escape(1);  {add DIO-II CFB 9JUN91}
d552 4
a555 4
	  {Replaced following line BJS 7-23-85;  address will always
	   be equal to select_code since 7-9-85 bug fix.  Determine if
	   a bit map by looking at int_ext_bitmap being equal to 0 }
	  {if (address = select_code) and (not odd(int_ext_bitmap)) then}
d557 4
a560 4
	  if ((int_ext_bitmap <> 0) and (not odd(int_ext_bitmap))) then
	    set_bitmap_vals
	  else
	    set_moon_vals;
d565 11
a575 11
	if
	   ((currentcrt = bitmaptype) and (odd(int_ext_bitmap)) and
						 {is bitmap, primary,  }
	     (not secondary))                      { bitmap is there     }
			   or                    {       or            }
	   (((currentcrt = alphatype) or (currentcrt = nocrt)) and
						 {is alpha/none,gr bd, }
	    (graphics_bd) and (secondary) and (odd(int_ext_bitmap)))
						 {second,bitmap there  }
			   or                    {        or           }
	   (address > 6) and (not odd(int_ext_bitmap))  {ext. bitmap there }
d577 1
a577 1
	  then expand_screen;
d581 5
a585 5
	  (int_ext_bitmap <>0) and
	  (secondary))
			   or
	 (((currentcrt = alphatype) or (currentcrt = nocrt)) and
	  (not graphics_bd) and (int_ext_bitmap <>0))
d587 5
a591 5
			   or
	 ((address >= 8) and (address < 32) and (not moon))
								 {SFB 7/10/85}
								 {jws 6/18/86}
								 {CFB 13JUN91}
d593 1
a593 1
	then expand_screen;
d598 1
a598 1
	dgl_raster_init(control);
d624 7
a630 7
	begin
	  save_ioresult := ioresult;   { | ioresult problem fix 12/83--BDS}
	  file_term(iocb_ptr);         { perform io term then release mem }
	  ioresult := save_ioresult;   { | ioresult problem fix 12/83--BDS}
	  iocb_ptr_file := iocb;
	  {dispose(iocb_ptr_file);}
	end
d632 5
a636 5
	begin
	  hpib_term(iocb_ptr);         { perform io term then release mem }
	  iocb_ptr_hpib := iocb;
	  {dispose(iocb_ptr_hpib);}
	end;
d663 2
a664 2
	address := gle_read_integer(device_info_char_count,device_info,cnt);
	address_found := true;
d666 1
a666 1
	if escapecode <> -8 { value range error } then escape(escapecode);
d674 30
a703 30
	begin
	  iocb_ptr_file := addr(file_iocb_space);
	  iocb := iocb_ptr_file;
	  io_write := file_write;
	  io_term := termhpgl;
	  io_inq_timeout := file_inq_timeout;
	  io_set_timeout := file_set_timeout;
	  with iocb_ptr_file^ do
	    begin
	      file_name := device_info;
	      name_size := device_info_char_count;
	      try
		lock_on_close := 0;                { do not save file by default }
		file_init ( iocb_ptr_file );
		gle_init_hpgl_output (gcb);
		if error_return = 0 then
		  begin
		    dgl_hpgl_init(control);
		    lock_on_close := 1;            { save file }
		  end
		else
		  begin
		    save_ioresult := ioresult;     {| ioresult fix 12/83--BDS}
		    file_term ( iocb_ptr_file );
		    ioresult := save_ioresult;     {| ioresult fix 12/83--BDS}
		  end;
	      recover
		if escapecode <> -10 then escape(escapecode)
		else                      error_return := 1;
	    end;
d705 7
a711 7
	  if error_return <> 0 then
	    begin { clean up }
	      save_ioresult := ioresult;           {| ioresult fix 1/84--BDS}
	     {dispose(iocb_ptr_file); dispose(buf); dispose(device_work_area);}
	      ioresult := save_ioresult;           {| ioresult fix 1/84--BDS}
	    end;
	end
d714 27
a740 27
	begin
	  iocb_ptr_hpib := addr(hpib_iocb_space);
	  iocb := iocb_ptr_hpib;
	  io_write := hpib_write;
	  io_read := hpib_read;
	  io_term := termhpgl;
	  io_inq_timeout := hpib_inq_timeout;
	  io_set_timeout := hpib_set_timeout;
	  with iocb_ptr_hpib^ do
	    begin
	      device_addr := device_info;
	      name_size   := device_info_char_count;
	    end;
	  hpib_init ( iocb_ptr_hpib );
	  if iocb_ptr_hpib^.error = 0 then
	    begin
	      gle_init_hpgl_output (gcb);
	      if error_return = 0 then dgl_hpgl_init(control)
	       { if error then clean up hpib bus (2.1 bug fix) }
	      else                     hpib_init ( iocb_ptr_hpib );
	    end
	  else error_return := 1;
	  if error_return <> 0 then
	    begin { clean up }
	     {dispose(iocb_ptr_hpib); dispose(buf); dispose(device_work_area);}
	    end;
	end
d742 1
a742 1
	error_return := 1;
@


54.4
log
@
pws2rcs automatic delta on Wed Aug 21 12:59:22 MDT 1991
@
text
@@


54.3
log
@removed . from include file names - CFB
@
text
@d25 1
a25 1
                  RESTRICTED RIGHTS LEGEND
d38 5
a42 5
        'TYPES',
        'DGL_VARS',
        'DGL_TOOLS',
        'DGL_RAS',
        'DGL_HPGL'${}
d79 12
a90 12
                                1=internal GATOR,   2=external GATOR,
                                3=internal GATORBOX,4=external GATORBOX,
                                5=internal BOBCAT,  6=external BOBCAT,
                                7=int LO-RES BOB,   8=ext LORES BOB,
                                9=int LCC CATSEYE, 10=ext LCC CATSEYE
                               additions 9/09/86 SFB
                               11=int HRx CATSEYE, 12=ext HRx CATSEYE
                               more additions 2/19/88 SFB
                               13=int VGA WOODCUT, 14=ext VGA WOODCUT
                               15=int Med WOODCUT, 16=ext Med WOODCUT
                               17=int Hrx WOODCUT, 18=ext Hrx WOODCUT
                               more additions 7JUN91 CFB }
d110 8
a117 8
        begin
          with gcb^,raster_device_rec_ptr(dev_dep_stuff)^ do
            begin
              reduced_screen := true;
              n_glines := 752;
              hard_ymax := 751;
            end;
        end;
d119 4
a122 4
        begin
          crtllhook := save_crthook;
          keybufops(kdisplay,charvar);
        end;
d131 3
a133 3
                        var  frame_buffer :integer;
                        var select_code,int_ext_bitmap :shortint;
                        var cmapid : integer);  {ADDED SFB--6/11/85}
d175 2
a176 2
                                                 {map to various int_ext_values}
                                                 {added WOODCUT  7JUN91 CFB}
d178 16
a193 16
                                        Bobcat_int_ext,
                                        unsupp_int_ext,
                                        unsupp_int_ext,
                                        LCC_int_ext,
                                        HRx_int_ext,
                                        HRx_int_ext,
                                        unsupp_int_ext,
                                        unsupp_int_ext,
                                        unsupp_int_ext,
                                        unsupp_int_ext,
                                        unsupp_int_ext,
                                        unsupp_int_ext,
                                        unsupp_int_ext,
                                        unsupp_int_ext,
                                        Med_Woodcut_int_ext,
                                        VGA_Woodcut_int_ext];
d196 1
a196 1
                                                {2/19/88 SFB}
d209 1
a209 1
                                      ROM and bumps bptr to next byte}
d229 3
a231 3
        int_ext_bitmap := supported_tertiaries[tvalue];
        if int_ext_bitmap <> 0 then
          int_ext_bitmap := int_ext_bitmap + ord(int_ext);
d234 1
a234 1
         and (int_ext_bitmap < VGA_Woodcut_int_ext) then            {CFB 7JUN91}
d236 23
a258 23
        bptr := anyptr(control_space + hex('005D'));     {^frame buffer relative
                                                   location pointer--2 byte qty}
        fbrelative := value;
        fbrelative := value + fbrelative * 256;
        bptr := anyptr(fbrelative + control_space);            {bits A16..A23 of
                                                           frame buffer address}
        frame_buffer := value * hex('10000');            {left shift bits 16..23
                                                                   by 16 places}
                                                       {check for lo-res bobcat}
        if (int_ext_bitmap = 5) or (int_ext_bitmap = 6) then
        begin
          bptr := anyptr(control_space + hex('0017'));{^"non-square pixel" info}
          if odd(ord(bptr^)) then int_ext_bitmap := int_ext_bitmap + 2;
         {set to corresponding lores internal or external bobcat type}
        end
        else                                 {GATORBOX       added SFB--6/11/85}
        begin                       {get colormap id for later use SFB--6/11/85}
          bptr := anyptr(control_space + hex('57'));       {cmapid addr pointer}
          fbrelative := value;                              {MSB of rel address}
          fbrelative := value + 256*fbrelative;             {16-bit rel address}
          bptr := anyptr(control_space + fbrelative);              {cmapid addr}
          cmapid := value mod 4;              {at last! the cmapid 2 lower bits}
        end;
d261 1
a261 1
         (int_ext_bitmap <= Med_Woodcut_int_ext+1) then
d263 2
a264 2
        frame_buffer := control_space + hex('200000');
        cmapid := 99;
d287 1
a287 1
    begin			     {add WOODCUT console support - CFB 13JUN91}
d291 7
a297 7
        dummy:=ptr^;
        dummy := dummy mod 128;
        if (dummy = bitmapid) then
        begin
          found_bitmap:=true;
          control_space:=integer(ptr);
        end;
d299 1
a299 1
        if escapecode<>-12 then escape(escapecode);
d312 2
a313 2
        found_bitmap:=true;
        control_space:=integer(ptr);
d364 6
a369 6
        info3 := 0;
        if (int_ext_bitmap <> 0) then
         begin
           reduced_screen := false;
           info3 := 1;                  {1=expand; 0=leave reduced}
         end;                           {send on to expand screen}
d375 3
a377 3
        save_crthook := crtllhook;
        crtllhook := dummycrtll;
        took_type_ahead := true;
d391 2
a392 2
        if escapecode <> -12 then escape(escapecode)
        else  graphics_bd := false;
d403 3
a405 3
        goff [5472256  {538000 HEX}] : shortint;
        g_on36c [ hex('51FFFC')]: shortint;
        gbase['GRAPHICSBASE'] : ^shortint;
d408 3
a410 3
        if graphicstate then g_on36c:=1
        else g_on36c:=0;
        gbase:=anyptr(hex('520000'));
d413 3
a415 3
        if graphicstate then gbase := addr(gon)
                        else gbase := addr(goff);
        gbase^ := gbase^;
d428 4
a431 4
         begin
           info2 := hex('51fffd');
           info3 := hex('51fb00');
         end;
d461 10
a470 10
         0 : info1 := m9837a;
         1 : info1 := mgatorbox;
         2 : info1 := mbobcat;
         3 : info1 := mbobcatlores;
         4 : info1 := mcatseye;         {SFB 9/09/86}
         5 : info1 := mcatseye_hrx;     {SFB 2/23/88}
         6 : info1 := mvga_woodcut;     {CFB 7JUN91}
         7 : info1 := mmed_woodcut;     {CFB 7JUN91}
         8 : info1 := mhrx_woodcut;     {CFB 7JUN91}
         otherwise begin end;           {SFB 2/23/88}
d484 2
a485 2
                  frame_buffer, select_code, int_ext_bitmap,
                  cmapid {added SFB 6/11/85});
d503 2
a504 2
        and (graphics_bd) then
        setup_internal
d506 4
a509 4
        if ((currentcrt = bitmaptype) or (not graphics_bd))
          {and (odd(int_ext_bitmap))} then   {removed for WOODCUT - CFB 13JUN91}
          set_bitmap_vals;
        end
d511 9
a519 9
        if (address = 6) then                  {indicates secondary display}
        begin
          secondary := true;
          if ((currentcrt = alphatype)  or (currentcrt = nocrt)) {JWS 7/23/85}
            and (int_ext_bitmap <>0) then
            set_bitmap_vals
          else
            if (graphics_bd) then
              setup_internal;
d521 10
a530 10
          if (currentcrt = bitmaptype)  then           {console = bitmap so}
          begin                                        {set secondary to}
                                                         { small screen}
            if (graphics_bd) then
              setup_internal
            else                                    {if fails set second.}
              if (odd(int_ext_bitmap)) then           {to bitmap.}
                set_bitmap_vals;
          end;
        end
d533 2
a534 2
        if (address < minrealisc) or ((address > maxrealisc)
          and (address < 132)) then escape(1);	{add DIO-II CFB 9JUN91}
d536 4
a539 4
          {Replaced following line BJS 7-23-85;  address will always
           be equal to select_code since 7-9-85 bug fix.  Determine if
           a bit map by looking at int_ext_bitmap being equal to 0 }
          {if (address = select_code) and (not odd(int_ext_bitmap)) then}
d541 4
a544 4
          if ((int_ext_bitmap <> 0) and (not odd(int_ext_bitmap))) then
            set_bitmap_vals
          else
            set_moon_vals;
d549 11
a559 11
        if
           ((currentcrt = bitmaptype) and (odd(int_ext_bitmap)) and
                                                 {is bitmap, primary,  }
             (not secondary))                      { bitmap is there     }
                           or                    {       or            }
           (((currentcrt = alphatype) or (currentcrt = nocrt)) and
                                                 {is alpha/none,gr bd, }
            (graphics_bd) and (secondary) and (odd(int_ext_bitmap)))
                                                 {second,bitmap there  }
                           or                    {        or           }
           (address > 6) and (not odd(int_ext_bitmap))  {ext. bitmap there }
d561 1
a561 1
          then expand_screen;
d565 5
a569 5
          (int_ext_bitmap <>0) and
          (secondary))
                           or
         (((currentcrt = alphatype) or (currentcrt = nocrt)) and
          (not graphics_bd) and (int_ext_bitmap <>0))
d571 5
a575 5
                           or
         ((address >= 8) and (address < 32) and (not moon))
                                                                 {SFB 7/10/85}
                                                                 {jws 6/18/86}
                                                                 {CFB 13JUN91}
d577 1
a577 1
        then expand_screen;
d582 1
a582 1
        dgl_raster_init(control);
d608 7
a614 7
        begin
          save_ioresult := ioresult;   { | ioresult problem fix 12/83--BDS}
          file_term(iocb_ptr);         { perform io term then release mem }
          ioresult := save_ioresult;   { | ioresult problem fix 12/83--BDS}
          iocb_ptr_file := iocb;
          {dispose(iocb_ptr_file);}
        end
d616 5
a620 5
        begin
          hpib_term(iocb_ptr);         { perform io term then release mem }
          iocb_ptr_hpib := iocb;
          {dispose(iocb_ptr_hpib);}
        end;
d647 2
a648 2
        address := gle_read_integer(device_info_char_count,device_info,cnt);
        address_found := true;
d650 1
a650 1
        if escapecode <> -8 { value range error } then escape(escapecode);
d658 38
a695 38
        begin
          iocb_ptr_file := addr(file_iocb_space);
          iocb := iocb_ptr_file;
          io_write := file_write;
          io_term := termhpgl;
          io_inq_timeout := file_inq_timeout;
          io_set_timeout := file_set_timeout;
          with iocb_ptr_file^ do
            begin
              file_name := device_info;
              name_size := device_info_char_count;
              try
                lock_on_close := 0;                { do not save file by default }
                file_init ( iocb_ptr_file );
                gle_init_hpgl_output (gcb);
                if error_return = 0 then
                  begin
                    dgl_hpgl_init(control);
                    lock_on_close := 1;            { save file }
                  end
                else
                  begin
                    save_ioresult := ioresult;     {| ioresult fix 12/83--BDS}
                    file_term ( iocb_ptr_file );
                    ioresult := save_ioresult;     {| ioresult fix 12/83--BDS}
                  end;
              recover
                if escapecode <> -10 then escape(escapecode)
                else                      error_return := 1;
            end;

          if error_return <> 0 then
            begin { clean up }
              save_ioresult := ioresult;           {| ioresult fix 1/84--BDS}
             {dispose(iocb_ptr_file); dispose(buf); dispose(device_work_area);}
              ioresult := save_ioresult;           {| ioresult fix 1/84--BDS}
            end;
        end
d698 27
a724 27
        begin
          iocb_ptr_hpib := addr(hpib_iocb_space);
          iocb := iocb_ptr_hpib;
          io_write := hpib_write;
          io_read := hpib_read;
          io_term := termhpgl;
          io_inq_timeout := hpib_inq_timeout;
          io_set_timeout := hpib_set_timeout;
          with iocb_ptr_hpib^ do
            begin
              device_addr := device_info;
              name_size   := device_info_char_count;
            end;
          hpib_init ( iocb_ptr_hpib );
          if iocb_ptr_hpib^.error = 0 then
            begin
              gle_init_hpgl_output (gcb);
              if error_return = 0 then dgl_hpgl_init(control)
               { if error then clean up hpib bus (2.1 bug fix) }
              else                     hpib_init ( iocb_ptr_hpib );
            end
          else error_return := 1;
          if error_return <> 0 then
            begin { clean up }
             {dispose(iocb_ptr_hpib); dispose(buf); dispose(device_work_area);}
            end;
        end
d726 1
a726 1
        error_return := 1;
@


54.2
log
@Added support for WOODCUT graphics hardware - CFB
@
text
@d37 1
a37 1
$SEARCH 'GLE_LIB.',
d44 1
a44 1
$include 'OPTIONS.'$              { compiler options }
@


54.1
log
@Automatic bump of revision number for PWS version 3.24
@
text
@d16 1
d25 1
a25 1
		  RESTRICTED RIGHTS LEGEND
d37 6
a42 6
$SEARCH 'GLE_LIB',
	'TYPES',
	'DGL_VARS',
	'DGL_TOOLS',
	'DGL_RAS',
	'DGL_HPGL'${}
d44 1
a44 1
$include 'OPTIONS'$              { compiler options }
d79 12
a90 8
				1=internal GATOR,   2=external GATOR,
				3=internal GATORBOX,4=external GATORBOX,
				5=internal BOBCAT,  6=external BOBCAT,
				7=int LO-RES BOB,   8=ext LORES BOB,
				9=int LCC CATSEYE, 10=ext LCC CATSEYE
			       additions 9/09/86 SFB
			       11=int HRx CATSEYE, 12=ext HRx CATSEYE
			       more additions 2/19/88 SFB }
d110 8
a117 8
	begin
	  with gcb^,raster_device_rec_ptr(dev_dep_stuff)^ do
	    begin
	      reduced_screen := true;
	      n_glines := 752;
	      hard_ymax := 751;
	    end;
	end;
d119 4
a122 4
	begin
	  crtllhook := save_crthook;
	  keybufops(kdisplay,charvar);
	end;
d131 3
a133 3
			var  frame_buffer :integer;
			var select_code,int_ext_bitmap :shortint;
			var cmapid : integer);  {ADDED SFB--6/11/85}
d136 19
a154 8
   Gator_tertiary=      0;
   Gbox_tertiary=       1;
   Bobcat_tertiary=     2;
   unsupp1_tertiary=    3;
   unsupp2_tertiary=    4;
   LCC_tertiary=        5;
   HRC_tertiary=        6;
   HRM_tertiary=        7;
d156 8
a163 5
   Gbox_int_ext=        3;
   Bobcat_int_ext=      5;
   unsupp_int_ext=      0;
   LCC_int_ext=         9;
   HRx_int_ext=        11;
d167 3
a169 3
    bitmapid =57;  { SFB 10-10-84 }
    low_id   = Gbox_tertiary;   {GATORBOX; added 9/09/86 SFB}
    hi_id    = HRM_tertiary;    {HRM CATSEYE; added 2/19/88 SFB}
d175 22
a196 4
    supported_tertiaries =
     tertiary_ids[Gbox_int_ext, Bobcat_int_ext, unsupp_int_ext, unsupp_int_ext,
		  LCC_int_ext, HRx_int_ext, HRx_int_ext]; {map to various int_ext_values}
   {hi_int_ext=supported_tertiaries[hi_id]+1;   {compiler odesn't support this. {2/19/88 SFB}
d198 3
a200 3
    i: shortint;
    dummy: shortint;
    bptr : ^char;
d202 1
a202 1
   procedure setupbitmaptype(int_ext : int_ext_type);
d204 3
a206 2
    var fbrelative : integer;
	tvalue : shortint;      {SFB 9/09/86}
d208 2
a209 2
    function value : shortint; {returns value of byte at bptr^ in
				GRAPHICS ROM and bumps bptr to next byte}
d215 53
a267 48
     begin
       if dummy = gatorid then
	begin
	 int_ext_bitmap := 1 + ord(int_ext);
	 stat := anyptr(control_space + 16384);
	 frame_buffer := ((stat^) mod 16)*1048576;
	end
       else
	begin      {read tertiary ID and locate frame buffer}
	 bptr := anyptr(control_space + 21);
	 tvalue := value;       {SFB 9/09/86}
	 {int_ext_bitmap := 2 * value + ord(int_ext) + 1;}
	 if (tvalue >= low_id) and (tvalue <= hi_id) then       {SFB 9/09/86}
	  begin
	   int_ext_bitmap := supported_tertiaries[tvalue];
	   if int_ext_bitmap <> 0 then
	    int_ext_bitmap := int_ext_bitmap + ord(int_ext);
	  end;
	 if     (int_ext_bitmap >= Gbox_int_ext)
	    and (int_ext_bitmap <= {hi_int_ext} HRx_int_ext+1 {SFB 2/19/88}) then
	  begin        {SFB 1-23-85}
	   bptr := anyptr(control_space + hex('005D')); {^frame buffer
					relative location pointer--2 byte qty}
	   fbrelative := value;
	   fbrelative := value + fbrelative * 256;
	   bptr := anyptr(fbrelative + control_space); {bits A16..A23 of
					frame buffer address}
	   frame_buffer := value * hex('10000'); {left shift bits 16..23
					by 16 places}
	   if (int_ext_bitmap = 5) or (int_ext_bitmap =6) then
	    begin       {check for lo-res bobcat}
	     bptr := anyptr(control_space + hex('0017')); {^"non-square pixel"
					info}
	     if odd(ord(bptr^)) then
	       int_ext_bitmap := int_ext_bitmap + 2; {set to corresponding
					lores internal or external bobcat type}
	    end
	   else {GATORBOX       added SFB--6/11/85}
	    begin       {get colormap id for later use SFB--6/11/85}
	     bptr := anyptr(control_space + hex('57')); {cmapid addr pointer}
	     fbrelative := value;       {MSB of rel address}
	     fbrelative := value + 256*fbrelative;      {16-bit rel address}
	     bptr := anyptr(control_space + fbrelative);        {cmapid addr}
	     cmapid := value mod 4;   {at last! the cmapid 2 lower bits}
	    end;
	  end;
	end;
     end;
d277 2
a278 2
  if select_code <= 6 then       {only check internal space SFB 7/9/85}
   try
d281 22
a302 7
    if (dummy = gatorid) OR (dummy = bitmapid) then {found internal bitmap}
      begin
       found_bitmap:=true;
       control_space:=integer(ptr);
      end;
   recover
    if escapecode<>-12 then escape(escapecode);
d304 2
a305 5
 if found_bitmap then                         {if there, find frame buffer}
  setupbitmaptype(int)
 else
  if select_code >= 8 then      {modified SFB 7/9/85}
   begin
d310 4
a313 3
      if (dummy = gatorid) OR (dummy = bitmapid) then begin
	found_bitmap:=true;
	control_space:=integer(ptr);
d319 17
d364 6
a369 6
	info3 := 0;
	if (int_ext_bitmap <> 0) then
	 begin
	   reduced_screen := false;
	   info3 := 1;                  {1=expand; 0=leave reduced}
	 end;                           {send on to expand screen}
d375 3
a377 3
	save_crthook := crtllhook;
	crtllhook := dummycrtll;
	took_type_ahead := true;
d391 2
a392 2
	if escapecode <> -12 then escape(escapecode)
	else  graphics_bd := false;
d403 3
a405 3
	goff [5472256  {538000 HEX}] : shortint;
	g_on36c [ hex('51FFFC')]: shortint;
	gbase['GRAPHICSBASE'] : ^shortint;
d408 3
a410 3
	if graphicstate then g_on36c:=1
	else g_on36c:=0;
	gbase:=anyptr(hex('520000'));
d413 3
a415 3
	if graphicstate then gbase := addr(gon)
			else gbase := addr(goff);
	gbase^ := gbase^;
d428 4
a431 4
	 begin
	   info2 := hex('51fffd');
	   info3 := hex('51fb00');
	 end;
d461 10
a470 7
	 0 : info1 := m9837a;
	 1 : info1 := mgatorbox;
	 2 : info1 := mbobcat;
	 3 : info1 := mbobcatlores;
	 4 : info1 := mcatseye;         {SFB 9/09/86}
	 5 : info1 := mcatseye_hrx;     {SFB 2/23/88}
	 otherwise begin end;           {SFB 2/23/88}
d478 20
a497 20
    if spooling = 0 then
      try
	{address computaton moved up SFB 7/9/85}
	address := gle_read_integer(device_info_char_count,device_info,cnt);
	select_code := address; {SFB 7/9/85}
	bitmapcrttype(found_bitmap, has_color,
		      frame_buffer, select_code,int_ext_bitmap,
		      cmapid {added SFB 6/11/85});
	ck_for_graphics_board;
	secondary := false;
	moon := false;
	reduced_screen := true;
	control := info1;  { control passed in info1 }
	knob_echo_gcb := (info2 = 1); { GCB for knob echos }
	if not knob_echo_gcb then       {SFB 6/25/85}
	 took_type_ahead := false;
	io_write := dummy1;
	io_term  := termraster;
	device_work_area := addr(raster_device_rec_space);
	dev_dep_stuff := device_work_area;
d500 20
a519 19
	if address = 3 then                         {indicates primary}
	 begin                                     {display}
	  if ((currentcrt = alphatype)  or (currentcrt = nocrt))
	       and (graphics_bd) then
	   setup_internal
	  else
	   if ((currentcrt = bitmaptype) or (not graphics_bd))
	       and (odd(int_ext_bitmap)) then
	    set_bitmap_vals;
	 end
	else if (address = 6) then                  {indicates secondary }
	  begin                                     {display}
	    secondary := true;
	    if ((currentcrt = alphatype)  or (currentcrt = nocrt)) { JWS 7/23/85}
		and (int_ext_bitmap <>0) then
	       set_bitmap_vals
	    else
	      if (graphics_bd) then
	       setup_internal;
d521 14
a534 22
	    if (currentcrt = bitmaptype)  then           {console = bitmap so}
	      begin                                      {set secondary to}
							 { small screen}
		if (graphics_bd) then
		 setup_internal
		else                                    {if fails set second.}
		 if (odd(int_ext_bitmap)) then           {to bitmap.}
		   set_bitmap_vals;
	      end;
	  end
	else       { must be moonunit or external bitmap }
	  begin
	    if (address < minrealisc) or (address > maxrealisc) then escape(1);
	    {Replaced following line BJS 7-23-85;  address will always
	     be equal to select_code since 7-9-85 bug fix.  Determine if
	     a bit map by looking at int_ext_bitmap being equal to 0 }
	    {if (address = select_code) and (not odd(int_ext_bitmap)) then}
	    if ((int_ext_bitmap <> 0) and (not odd(int_ext_bitmap))) then
	     set_bitmap_vals
	    else
	     set_moon_vals;
	  end;
d536 4
a539 14
	{control set}
	if (odd(control DIV 256)) and (not moon)  then
	 if
	   ((currentcrt = bitmaptype) and (odd(int_ext_bitmap)) and
						   {is bitmap, primary,  }
	     (not secondary))                      { bitmap is there     }
			     or                    {       or            }
	   (((currentcrt = alphatype) or (currentcrt = nocrt)) and
						   {is alpha/none,gr bd, }
	    (graphics_bd) and (secondary) and (odd(int_ext_bitmap)))
						   {second,bitmap there  }
			     or                    {        or           }
	   (address > 6) and (not odd(int_ext_bitmap))  {ext. bitmap there }
	 then expand_screen;
d541 5
a545 7
	{control not set, but bitmap is not console}
	if (((currentcrt = alphatype) or (currentcrt = nocrt)) and
	    (int_ext_bitmap <>0) and
	    (secondary))
			     or
	   (((currentcrt = alphatype) or (currentcrt = nocrt)) and
	    (not graphics_bd) and (int_ext_bitmap <>0))
d547 13
a559 2
			     or
	   ((address >= 8) and (not moon))       {SFB 7/10/85}{jws 6/18/86}
d561 1
a561 1
	then expand_screen;
d563 7
a569 1
	gle_init_raster_output (gcb);
d571 5
a575 2
	if (error_return = 0) and (not knob_echo_gcb) then
	 dgl_raster_init(control);
d577 16
a592 9
	{if error_return <> 0 then
	     dispose(device_work_area);} { clean up }
      recover
	{ ignore all escapes (except stop key), user may look at
	 escapecode to determine error }
	if escapecode = -20 then escape(-20)
	else error_return := 1
    else
      error_return := 1; { raster devices may not be spooled }
d608 7
a614 7
	begin
	  save_ioresult := ioresult;   { | ioresult problem fix 12/83--BDS}
	  file_term(iocb_ptr);         { perform io term then release mem }
	  ioresult := save_ioresult;   { | ioresult problem fix 12/83--BDS}
	  iocb_ptr_file := iocb;
	  {dispose(iocb_ptr_file);}
	end
d616 5
a620 5
	begin
	  hpib_term(iocb_ptr);         { perform io term then release mem }
	  iocb_ptr_hpib := iocb;
	  {dispose(iocb_ptr_hpib);}
	end;
d638 1
a638 1
  save_ioresult    : integer;               { | fix clobbering ioresult -- 12/83}
d647 2
a648 2
	address := gle_read_integer(device_info_char_count,device_info,cnt);
	address_found := true;
d650 1
a650 1
	if escapecode <> -8 { value range error } then escape(escapecode);
d658 30
a687 30
	begin
	  iocb_ptr_file := addr(file_iocb_space);
	  iocb := iocb_ptr_file;
	  io_write := file_write;
	  io_term := termhpgl;
	  io_inq_timeout := file_inq_timeout;
	  io_set_timeout := file_set_timeout;
	  with iocb_ptr_file^ do
	    begin
	      file_name := device_info;
	      name_size := device_info_char_count;
	      try
		lock_on_close := 0;                { do not save file by default }
		file_init ( iocb_ptr_file );
		gle_init_hpgl_output (gcb);
		if error_return = 0 then
		  begin
		    dgl_hpgl_init(control);
		    lock_on_close := 1;            { save file }
		  end
		else
		  begin
		    save_ioresult := ioresult;     {| ioresult fix 12/83--BDS}
		    file_term ( iocb_ptr_file );
		    ioresult := save_ioresult;     {| ioresult fix 12/83--BDS}
		  end;
	      recover
		if escapecode <> -10 then escape(escapecode)
		else                      error_return := 1;
	    end;
d689 7
a695 7
	  if error_return <> 0 then
	    begin { clean up }
	      save_ioresult := ioresult;           {| ioresult fix 1/84--BDS}
	     {dispose(iocb_ptr_file); dispose(buf); dispose(device_work_area);}
	      ioresult := save_ioresult;           {| ioresult fix 1/84--BDS}
	    end;
	end
d698 27
a724 27
	begin
	  iocb_ptr_hpib := addr(hpib_iocb_space);
	  iocb := iocb_ptr_hpib;
	  io_write := hpib_write;
	  io_read := hpib_read;
	  io_term := termhpgl;
	  io_inq_timeout := hpib_inq_timeout;
	  io_set_timeout := hpib_set_timeout;
	  with iocb_ptr_hpib^ do
	    begin
	      device_addr := device_info;
	      name_size   := device_info_char_count;
	    end;
	  hpib_init ( iocb_ptr_hpib );
	  if iocb_ptr_hpib^.error = 0 then
	    begin
	      gle_init_hpgl_output (gcb);
	      if error_return = 0 then dgl_hpgl_init(control)
	       { if error then clean up hpib bus (2.1 bug fix) }
	      else                     hpib_init ( iocb_ptr_hpib );
	    end
	  else error_return := 1;
	  if error_return <> 0 then
	    begin { clean up }
	     {dispose(iocb_ptr_hpib); dispose(buf); dispose(device_work_area);}
	    end;
	end
d726 1
a726 1
	error_return := 1;
@


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.2
log
@For CATSEYE support
@
text
@@


25.1
log
@Automatic bump of revision number for PWS version 3.2Y
@
text
@d67 1
d82 4
a85 2
				9=int LCC CATSEYE, 10=ext LCC CATSEYE}
			      {additions 9/09/86 SFB}
d130 16
d149 2
a150 2
    low_id   = 1;       {GATORBOX; added 9/09/86 SFB}
    hi_id    = 5;       {LCC CATSEYE; added 9/09/86 SFB}
d157 3
a159 2
     tertiary_ids[3, 5, 0, 0, 9]; {map to GB internal, BOBCAT internal,
				   unsupp, unsupp, LCC CATSEYE internal}
d195 2
a196 1
	 if (int_ext_bitmap >= 3) and (int_ext_bitmap <= 10 {SFB 9/09/86}) then
a263 1

d306 1
a306 1
end;
d341 1
a341 1
		      else gbase := addr(goff);
d393 2
d496 1
@


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.2
log
@Pws2unix automatic delta on Wed Nov 19 15:16:12 MST 1986
@
text
@@


6.1
log
@Automatic bump of revision number for PWS version 3.2k
@
text
@a35 3
{
$SEARCH 'BLIBS:GRAPHICS.','BLIBS:IO.'$
}
@


5.2
log
@Changes from Scott Bayes.
@
text
@@


5.1
log
@Automatic bump of revision number for PWS version 3.2j
@
text
@d36 3
a38 1

d82 4
a85 1
				5=internal BOBCAT,  6=external BOBCAT}
d133 2
d138 5
d151 1
d170 9
a178 2
	 int_ext_bitmap := 2 * value + ord(int_ext) + 1;
	 if (int_ext_bitmap >= 3) and (int_ext_bitmap <= 6) then
d229 1
a229 1
     setupbitmaptype(int)
d244 1
a244 1
     setupbitmaptype(ext);
d375 1
d472 1
a472 1
	   (address >= 8)       {SFB 7/10/85}
@


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


3.6
log
@Revert to 3.1 version so we can turn 3.2i.
@
text
@@


3.5
log
@Change search string for Scott Bayes.
@
text
@d36 1
a36 3
{
$SEARCH 'BLIBS:GRAPHICS.','BLIBS:IO.'$
}
d80 1
a80 4
				5=internal BOBCAT,  6=external BOBCAT,
				7=int LO-RES BOB,   8=ext LORES BOB,
				9=int LCC CATSEYE, 10=ext LCC CATSEYE}
			      {additions 9/09/86 SFB}
a127 2
    low_id   = 1;       {GATORBOX; added 9/09/86 SFB}
    hi_id    = 5;       {LCC CATSEYE; added 9/09/86 SFB}
a130 5
    tertiary_ids = array[low_id..hi_id] of shortint;
const
    supported_tertiaries =
     tertiary_ids[3, 5, 0, 0, 9]; {map to GB internal, BOBCAT internal,
				   unsupp, unsupp, LCC CATSEYE internal}
a138 1
	tvalue : shortint;      {SFB 9/09/86}
d157 2
a158 9
	 tvalue := value;       {SFB 9/09/86}
	 {int_ext_bitmap := 2 * value + ord(int_ext) + 1;}
	 if (tvalue >= low_id) and (tvalue <= hi_id) then       {SFB 9/09/86}
	  begin
	   int_ext_bitmap := supported_tertiaries[tvalue];
	   if int_ext_bitmap <> 0 then
	    int_ext_bitmap := int_ext_bitmap + ord(int_ext);
	  end;
	 if (int_ext_bitmap >= 3) and (int_ext_bitmap <= 10 {SFB 9/09/86}) then
a354 1
	 4 : info1 := mcatseye;         {SFB 9/09/86}
d451 1
a451 1
	   ((address >= 8) and (not moon))       {SFB 7/10/85}{jws 6/18/86}
@


3.4
log
@Change SEARCH list as requested by Scott Bayes.
@
text
@d36 1
d38 2
a39 1
{$SEARCH 'GLE_LIB',
@


3.3
log
@Changes from Scott Bayes.
@
text
@a35 1
{
d37 1
a37 2
}
$SEARCH 'GLE_LIB',
@


3.2
log
@Change sent from Scott Bayes, invlolving screen expansion
with moon units.
@
text
@d36 1
d38 2
a39 1
{$SEARCH 'GLE_LIB',
d82 4
a85 1
				5=internal BOBCAT,  6=external BOBCAT}
d133 2
d138 5
d151 1
d170 9
a178 2
	 int_ext_bitmap := 2 * value + ord(int_ext) + 1;
	 if (int_ext_bitmap >= 3) and (int_ext_bitmap <= 6) then
d375 1
@


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

$SEARCH 'GLE_LIB',
d451 1
a451 1
	   (address >= 8)       {SFB 7/10/85}
@


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


1.1
log
@Initial revision
@
text
@@
