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


