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


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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

30.1
date     88.12.09.13.51.04;  author dew;  state Exp;
branches ;
next     29.2;

29.2
date     88.11.15.15.55.21;  author bayes;  state Exp;
branches ;
next     29.1;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

14.1
date     87.04.01.15.40.54;  author jws;  state Exp;
branches ;
next     13.2;

13.2
date     87.04.01.10.39.24;  author jws;  state Exp;
branches ;
next     13.1;

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

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

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

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

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

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

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

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

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

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

4.1
date     86.09.30.19.56.30;  author hal;  state Exp;
branches ;
next     3.3;

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

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

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

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

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


desc
@Base file for PWS 3.2 release.

@


56.3
log
@
pws2rcs automatic delta on Wed Jan 27 13:14:25 MST 1993
@
text
@{                                                                           }
{ Graphics Low End                                                          }
{                                                                           }
{ Module    = GLE_HPGL_OUT                                                  }
{ Programer = BJS                                                           }
{ Date      = 10- 5-82                                                      }
{                                                                           }
{ Purpose: To provide device dependent routines to drive hpgl output        }
{          plotters.                                                        }

{ Rev history                                                               }
{  Created  - 10- 5-82  BJS                                                 }
{  Modified - 11-24-82  BJS  removed refs to str routines                   }
{              6-28-83  BJS  added import of gle_astext (routine moved from }
{                            gle_stext                                      }
{              3-14-84  BDS  added identifiers for 7586B, 7550A, 7090, 7440 }
{              4-  -85  SFB  bug fixes for some string lengths              }
{              4-23-85  SFB  pass out all escape codes after current := 0   }

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

$search 'GLE_TYPES',
	'GLE_SCLIP',
	'ASM_SCLIP',
	'GLE_STEXT',
	'ASM_STEXT',
	'GLE_SMARK',
	'GLE_UTLS'$
$modcal$
$include 'OPTIONS'$  { ******************** COMPILER OPTIONS ****************** }
$linenum 7000$
$ALLOW_PACKED ON$ {JWS 3/31/87}

module GLE_HPGL_OUT;

import gle_types;

export

const
  max_buffer = 255;
  buffer_fudge = 32;

type
  ascii_buffer_ptr = ^ascii_buffer;

  ascii_buffer = packed record
		   maximum : integer;
		   current : integer;
		   data    : packed array [1..max_buffer] of char;
		 end;

  driver_state_def = (moving,drawing,start_of_buffer,unknown);

  hpgl_device_rec_ptr= ^ hpgl_device_rec;
  hpgl_device_rec =
    record
      driver_state : driver_state_def;
    end;

procedure gle_init_hpgl_output  (  gcb : graphics_control_block_ptr );

implement

import gle_stext,
       gle_astext,
       gle_asclip,
       gle_sclip,
       gle_smark,
       gle_utls;

procedure hpgl_flush_buffer ( gcb : graphics_control_block_ptr );

begin
  with gcb^,
       ascii_buffer_ptr(device_buf)^,
       hpgl_device_rec_ptr(dev_dep_stuff)^ do
    begin
      if current <> 0 then call (io_write,iocb,device_buf);
      driver_state := start_of_buffer;
    end;
end;

procedure dummy (  gcb : graphics_control_block_ptr );

begin
end;

procedure buffer_cleanup ( gcb : graphics_control_block_ptr );

begin
  with gcb^,ascii_buffer_ptr(gcb^.device_buf)^ do
    if (current > maximum - buffer_fudge) or (current_buffer_mode = 0) then
      hpgl_flush_buffer ( gcb );
end;

procedure add_char_data (  gcb : graphics_control_block_ptr;
			   count : gle_shortint;
			   s : anychar_ptr );
var
  i : gle_shortint;

begin
  with gcb^,ascii_buffer_ptr(gcb^.device_buf)^ do
    begin
      for i := 1 to count do
	data[i+current] := s^[i];
      current := current + count;
    end;
end;

procedure add_parm_data ( gcb : graphics_control_block_ptr;
			value : gle_shortint);
var
  count : gle_shortint;

begin
  with gcb^,ascii_buffer_ptr(gcb^.device_buf)^ do
    begin
      gle_write_integer (value,count,addr(data[current+1]));
      current := current + count;
    end;
end;

procedure change_state ( gcb : graphics_control_block_ptr;
		   new_state : driver_state_def );

var
  change : boolean;

begin
  with gcb^,hpgl_device_rec_ptr(dev_dep_stuff)^ do
    begin
      change := new_state <> driver_state;
      if (driver_state = unknown) or
	 (((driver_state = moving) or (driver_state = drawing)) and change) then
	add_char_data(gcb,1,addr('; '));
      if change then
	begin
	  driver_state := new_state;
	  case driver_state of
	    moving  : add_char_data ( gcb, 5, addr('PU;PA') );
	    drawing : add_char_data ( gcb, 5, addr('PD;PA') );
	    start_of_buffer,unknown : ;
	  end; { of case }
	end;
    end;
end;

procedure hpgl_output_escapeo ( gcb : graphics_control_block_ptr );

begin
  with gcb^,hpgl_device_rec_ptr(dev_dep_stuff)^ ,
       ascii_buffer_ptr(gcb^.device_buf)^do
    begin
      try
       change_state ( gcb, unknown );
       add_char_data(gcb,info1,anyptr(info_ptr1));
       buffer_cleanup ( gcb );
      recover
	   begin        {modified to pass all escapes SFB 4/23/85}
	     current := 0;
	     escape(escapecode);
	   end;
    end;
end;

procedure hpgl_output_escapei ( gcb : graphics_control_block_ptr );

var
  i : gle_shortint;
  sptr : anychar_ptr;

begin
  with gcb^,ascii_buffer_ptr(gcb^.device_buf)^ do
    begin
     try
      call (io_read, iocb,  device_buf);
      sptr := anyptr(info_ptr1);
      info1 := current;
      for i := 1 to current do
	sptr^[i] := data[i];
      current := 0;                    { reset buffer counter }
     recover
	  begin        {modified to pass all escapes SFB 4/23/85}
	    current := 0;
	    escape(escapecode);
	  end;
    end;
end;

procedure hpgl_get_p1p2 (  gcb : graphics_control_block_ptr );

var
  cnt    : gle_shortint;
  tcnt   : gle_shortint;
  temp   : integer;

begin
  with gcb^,
  ascii_buffer_ptr(gcb^.device_buf)^,
  hpgl_device_rec_ptr(dev_dep_stuff)^ do
   begin
    try
     if spooling = 0 then
	begin
	  change_state ( gcb, unknown );
	  add_char_data ( gcb, 2, addr('OP') );
	  hpgl_flush_buffer ( gcb );
	  call (io_read, iocb,  device_buf);
	  tcnt := 1;
	  info1 := gle_read_integer (current,addr(data[1]),cnt);
	  cnt := cnt + tcnt;
	  info3 := gle_read_integer (current,addr(data[cnt]),tcnt);
	  cnt := cnt + tcnt;
	  info2 := gle_read_integer (current,addr(data[cnt]),tcnt);
	  cnt := cnt + tcnt;
	  info4 := gle_read_integer (current,addr(data[cnt]),tcnt);
	  current := 0;
	  if info1 > info2 then     { make xmin <= xmax }
	    begin
	      temp := info1;
	      info1 := info2;
	      info2 := temp;
	    end;
	  if info3 > info4 then     { make ymin <= ymax }
	    begin
	      temp := info3;
	      info3 := info4;
	      info4 := temp;
	    end;
	end
      else
	begin
	  info1 := display_min_x;
	  info2 := display_max_x;
	  info3 := display_min_y;
	  info4 := display_max_y;
	end;
    recover
	 begin        {modified to pass all escapes SFB 4/23/85}
	   current := 0;
	   escape(escapecode);
	 end;
   end;
end;

procedure hpgl_get_hard_clip (  gcb : graphics_control_block_ptr );

var
  tcnt,cnt    : gle_shortint;
  tp1x,tp1y,tp2x,tp2y : gle_shortint;

begin

  with gcb^,
  ascii_buffer_ptr(gcb^.device_buf)^,
  hpgl_device_rec_ptr(dev_dep_stuff)^ do
    begin
    try
    if gle_match(4,addr(display_name),4,addr('7580')) or
       gle_match(4,addr(display_name),4,addr('7585')) or
       gle_match(4,addr(display_name),4,addr('7586')) or
       gle_match(4,addr(display_name),4,addr('7595')) or        {SFB 9/22/86}
       gle_match(4,addr(display_name),4,addr('7596')) or        {SFB 9/22/86}
       gle_match(4,addr(display_name),4,addr('7570')) or        {SFB 9/18/86}
       gle_match(4,addr(display_name),4,addr('7575')) or        {SFB 11/14/88}
       gle_match(4,addr(display_name),4,addr('7576')) then      {SFB 11/14/88}
      begin
	if spooling = 0 then
	  begin
	    add_char_data ( gcb, 2, addr('OH') );
	    hpgl_flush_buffer ( gcb );
	    call (io_read, iocb,  device_buf);
	    tcnt := 1;
	    info1 := gle_read_integer (current,addr(data[1]),cnt);
	    cnt := cnt + tcnt;
	    info3 := gle_read_integer (current,addr(data[cnt]),tcnt);
	    cnt := cnt + tcnt;
	    info2 := gle_read_integer (current,addr(data[cnt]),tcnt);
	    cnt := cnt + tcnt;
	    info4 := gle_read_integer (current,addr(data[cnt]),tcnt);
	    current := 0;
	  end
	else
	  begin
	   if ( gle_match(4,addr(display_name),4,addr('7586')) ) or
	      ( gle_match(4,addr(display_name),4,addr('7585')) ) or
	      ( gle_match(4,addr(display_name),4,addr('7596')) ) or   {SFB 9/22/86}
	      ( gle_match(4,addr(display_name),4,addr('7595')) ) or   {SFB 9/22/86}
	      ( gle_match(4,addr(display_name),4,addr('7576')) ) then {SFB 11/14/88}
	     begin
	       info1 := -23656;            { E size }
	       info2 :=  23656;
	       info3 := -17962;
	       info4 :=  17962;
	     end
	   else {7580x or 7570A or 7575A (11/14/88) spooling SFB 9/18/86}
	     begin
	       info1 := -16190;            { D size }
	       info2 :=  16190;
	       info3 := -10485;
	       info4 :=  10485;
	     end;
	  end
      end
    else
    if (gle_match(4,addr(display_name),4,addr('7470'))) or
       (gle_match(4,addr(display_name),4,addr('7440'))) then
      begin
	info1 := 0;
	info2 := 10300;
	info3 := 0;
	info4 := 7650;
      end
    else
    if (gle_match(4,addr(display_name),4,addr('7475'))) or
       (gle_match(4,addr(display_name),4,addr('7090'))) then
      begin
	info1 := 0;
	info2 := 16640;
	info3 := 0;
	info4 := 10365;
      end
    else
    if gle_match(4,addr(display_name),4,addr('7550')) then
      begin
	info1 := 0;
	info2 := 16450;
	info3 := 0;
	info4 := 10170;
      end
    else
    if gle_match(4,addr(display_name),4,addr('9872')) or (spooling = 1) then
      begin
	info1 := 0;
	info2 := 16000;
	info3 := 0;
	info4 := 11400;
      end
    else
      begin  { initialize the device and use P1/P2 values }
	hpgl_get_p1p2 ( gcb );
	tp1x := info1; tp2x := info2;
	tp1y := info3; tp2y := info4;
	add_char_data ( gcb, 3, addr('IN'));
	hpgl_flush_buffer ( gcb );              { BDS 3/28/84 }
	hpgl_get_p1p2 ( gcb );
	{ restore p1, p2 }
	add_char_data ( gcb, 2, addr('IP'));
	add_parm_data ( gcb, tp1x );
	add_char_data ( gcb, 1, addr(', '));
	add_parm_data ( gcb, tp1y );
	add_char_data ( gcb, 1, addr(', '));
	add_parm_data ( gcb, tp2x );
	add_char_data ( gcb, 1, addr(', '));
	add_parm_data ( gcb, tp2y );
	hpgl_flush_buffer ( gcb );
      end;
    recover
	begin        {modified to pass all escapes SFB 4/23/85}
	  current := 0;
	  escape(escapecode);
	end;
    end;
end;

procedure hpgl_move (  gcb : graphics_control_block_ptr );

begin
  with gcb^,hpgl_device_rec_ptr(dev_dep_stuff)^ ,
       ascii_buffer_ptr(device_buf)^ do
    begin
     try
       if driver_state = moving then
	 add_char_data ( gcb, 1, addr(', '))
       else
	 change_state ( gcb, moving );
       add_parm_data ( gcb, end_x);
       add_char_data ( gcb, 1, addr(', '));
       add_parm_data ( gcb, end_y);
       current_pos_x := end_x;
       current_pos_y := end_y;
       buffer_cleanup ( gcb );
     recover
	  begin        {modified to pass all escapes SFB 4/23/85}
	    current := 0;
	    escape(escapecode);
	  end;
    end;
end;

procedure hpgl_draw (  gcb : graphics_control_block_ptr );

begin
  with gcb^,hpgl_device_rec_ptr(dev_dep_stuff)^ ,
       ascii_buffer_ptr(device_buf)^ do
    begin
     try
      if driver_state = drawing then
	add_char_data ( gcb, 1, addr(', '))
      else
	change_state ( gcb, drawing );
      add_parm_data ( gcb, end_x);
      add_char_data ( gcb, 1, addr(', '));
      add_parm_data ( gcb, end_y);
      current_pos_x := end_x;
      current_pos_y := end_y;
      buffer_cleanup ( gcb );
     recover
	  begin        {modified to pass all escapes SFB 4/23/85}
	    current := 0;
	    escape(escapecode);
	  end;
    end;
end;

procedure hpgl_buffer_mode(  gcb : graphics_control_block_ptr );

begin
 with gcb^ ,ascii_buffer_ptr(device_buf)^ do
 begin
  try
   hpgl_flush_buffer ( gcb );
   current_buffer_mode := info1;
  recover
	begin        {modified to pass all escapes SFB 4/23/85}
	  current := 0;
	  escape(escapecode);
	end;
 end;
end;

procedure hpgl_set_color (  gcb : graphics_control_block_ptr );

begin
  with gcb^,hpgl_device_rec_ptr(dev_dep_stuff)^ ,
       ascii_buffer_ptr(gcb^.device_buf)^ do
    begin
      try
       change_state ( gcb, unknown );
       add_char_data ( gcb, 5, addr('PU;SP') );
       add_parm_data ( gcb, info1 );
       buffer_cleanup ( gcb );
       current_color_index := info1;
      recover
	   begin        {modified to pass all escapes SFB 4/23/85}
	     current := 0;
	     escape(escapecode);
	   end;
    end;
end;

{********************** this procedure is never used ***********************
procedure hpgl_fill_index_color (  gcb : graphics_control_block_ptr );

begin
  with gcb^,hpgl_device_rec_ptr(dev_dep_stuff)^ do
    current_polygon_color := info1;
end;}

procedure hpgl_linestyle (  gcb : graphics_control_block_ptr );

begin
  with gcb^,hpgl_device_rec_ptr(dev_dep_stuff)^ ,
	    ascii_buffer_ptr(gcb^.device_buf)^ do
    begin
      try
       change_state ( gcb, unknown );
       current_linestyle := info1;
       current_pattern_length := info2;
       current_linestyle_mode := info3;
       current_linestyle_pattern := info4;
       add_char_data(gcb,2,addr('LT'));
       if info1 = 0 then
	 begin
	 end
       else
       if info1 = 7 then
	 add_parm_data(gcb,0)
       else
	 begin
	   if info3 = 0 then
	     add_parm_data(gcb,info1)
	   else
	     add_parm_data(gcb,-info1);
	   add_char_data(gcb,1,addr(', '));
	   add_parm_data(gcb,info2);
	 end;
       buffer_cleanup ( gcb );
      recover
	   begin        {modified to pass all escapes SFB 4/23/85}
	     current := 0;
	     escape(escapecode);
	   end;
    end;
end;

procedure hpgl_clear(  gcb : graphics_control_block_ptr );

begin
  with gcb^,hpgl_device_rec_ptr(dev_dep_stuff)^ ,
	    ascii_buffer_ptr(gcb^.device_buf)^do
    begin
      try
       change_state ( gcb, unknown );
       add_char_data(gcb,2,addr('PG'));
       buffer_cleanup ( gcb );
      recover
	   begin        {modified to pass all escapes SFB 4/23/85}
	     current := 0;
	     escape(escapecode);
	   end;
    end;
end;

procedure hpgl_cursor (  gcb : graphics_control_block_ptr );

begin
  with gcb^,hpgl_device_rec_ptr(dev_dep_stuff)^ ,
	    ascii_buffer_ptr(gcb^.device_buf)^do
    begin
      try
       change_state  ( gcb, unknown );
       add_char_data ( gcb, 5, addr('PU;PA'));
       add_parm_data ( gcb, info1);
       add_char_data ( gcb, 1, addr(', '));
       add_parm_data ( gcb, info2);
       current_cursor_state := info3;
       hpgl_flush_buffer ( gcb );
      recover
	   begin        {modified to pass all escapes SFB 4/23/85}
	     current := 0;
	     escape(escapecode);
	   end;
    end;
end;

procedure gle_init_hpgl_output (  gcb : graphics_control_block_ptr);

var
  saved_timeout : integer;
  i : gle_shortint;

begin
  with gcb^,
       hpgl_device_rec_ptr(dev_dep_stuff)^,
       ascii_buffer_ptr(device_buf)^ do
    try
      current := 0;
      maximum := max_buffer;

      driver_state         := start_of_buffer;
      unclipped_move       := hpgl_move;
      unclipped_draw       := hpgl_draw;
      move                 := gle_soft_clip_move;
      draw                 := gle_soft_clip_draw;
      clear                := hpgl_clear;
      text                 := gle_soft_text {hpgl_text};
      char_size            := gle_soft_char_size;
      clip_limits          := gle_soft_clip_limits;
      text_spacing         := gle_soft_text_spacing;
      linestyle            := hpgl_linestyle;
      text_dir             := gle_soft_text_dir;
      text_just            := gle_soft_text_just;
      marker               := gle_soft_marker;
      marker_size          := gle_soft_marker_size;
      set_marker           := gle_soft_set_marker;
      index_color          := hpgl_set_color;
      inq_p1p2             := hpgl_get_p1p2;
      get_polygon_info     := dummy;
      graphics_on_off      := dummy;
      cursor               := hpgl_cursor;
      calc_soft_text_xform := gle_text_xform;
      buffer_mode          := hpgl_buffer_mode;
      output_escapeo       := hpgl_output_escapeo;
      output_escapei       := hpgl_output_escapei;
      define_drawing_mode  := dummy;
      define_color_map     := dummy;
      polygon              := dummy;
      fill_index_color     := dummy;
      linewidth            := dummy;
      gload                := dummy;
      gstore               := dummy;
      get_raster           := dummy;
      get_color_map        := dummy;
      await_blanking       := dummy;
      flush_buffer         := hpgl_flush_buffer;

      soft_font_ptr        := addr(font);

      error_return := 0;
      if spooling = 0 then
	try
	  call (io_inq_timeout, iocb, saved_timeout );
	  call (io_set_timeout, iocb, 500 { ms } );
	  { send command that all HPGL plotters can respond to   }
	  { if the command fails then the address does not match }
	  { the device.                                          }
	  add_char_data ( gcb, 2, addr('OE') );
	  hpgl_flush_buffer ( gcb );
	  call (io_read, iocb,  device_buf);
	  current := 0;

	  { if this point is reached then a vaild HPGL device was found }

	  try  { perform an output identify seq.  Note a 9872A will fail }
	    add_char_data ( gcb, 2, addr('OI') );
	    hpgl_flush_buffer ( gcb );
	    call (io_read, iocb,  device_buf);

	    for i := 1 to current do display_name[i] := data[i];
	    for i := current+1 to 6 do display_name[i] := ' ';
	    display_name_char_count := current;
	    current := 0;
	  recover
	    if escapecode = -26 { io system } then
	      begin
		display_name := '9872A ';
		display_name_char_count := 5;
		current := 0;
	      end
	    else if escapecode = -20 {stop key} then
	       begin
		 current := 0;
		 escape(-20);
	       end
	    else escape(escapecode);

	recover
	  if escapecode = -26 then error_return := 1
	  else if escapecode = -20 {stop key} then
	       begin
		 current := 0;
		 escape(-20);
	       end
	  else escape(escapecode); { ignor io errors }

      call (io_set_timeout, iocb, saved_timeout );

      if error_return = 0 then
	begin
	  add_char_data ( gcb, 12, addr('DF;SP1;IM30;') );
	  hpgl_flush_buffer ( gcb );
	  if gle_match(4,addr(display_name),4,addr('9111')) then { 9111 is input only }
	    escape(-26) { force io error }
	  else
	  if gle_match(display_name_char_count,addr(display_name),5,addr('7470A')) or
	     gle_match(display_name_char_count,addr(display_name),4,addr('7470')) then
	    begin
	      pallette := 2;
	      cont_linestyles := 8;
	      vect_linestyles := 0;
	    end
	  else
	  if gle_match(display_name_char_count,addr(display_name),5,addr('7440A')) or
	     gle_match(display_name_char_count,addr(display_name),4,addr('7440')) then
	    begin
	      pallette := 8;
	      cont_linestyles := 8;
	      vect_linestyles := 0;
	    end
	  else
	  if gle_match(display_name_char_count,addr(display_name),5,addr('7475A')) or
	     gle_match(display_name_char_count,addr(display_name),4,addr('7475')) or
	     gle_match(display_name_char_count,addr(display_name),4,addr('7090')) then
	     begin
	      pallette := 6;
	      cont_linestyles := 8;
	      vect_linestyles := 0;
	    end
	  else  {BUG FIXES FOR LENGTHS SFB 4/85}
if (gle_match(display_name_char_count,addr(display_name),5,addr('7580A'))) or
{SFB 9/18/86} (gle_match(display_name_char_count,addr(display_name),5,addr('7570A'))) or
{SFB 9/18/86} (gle_match(display_name_char_count,addr(display_name),4,addr('7570'))) or
{SFB 11/14/88}(gle_match(display_name_char_count,addr(display_name),5,addr('7575A'))) or
{SFB 11/14/88}(gle_match(display_name_char_count,addr(display_name),4,addr('7575'))) or
{SFB 11/14/88}(gle_match(display_name_char_count,addr(display_name),5,addr('7576A'))) or
{SFB 11/14/88}(gle_match(display_name_char_count,addr(display_name),4,addr('7576'))) or
	      (gle_match(display_name_char_count,addr(display_name),5,addr('7580B'))) or
	      (gle_match(display_name_char_count,addr(display_name),4,addr('7580'))) or
	      (gle_match(display_name_char_count,addr(display_name),5,addr('7585A'))) or
	      (gle_match(display_name_char_count,addr(display_name),5,addr('7595A'))) or
	      (gle_match(display_name_char_count,addr(display_name),5,addr('7585B'))) or
	      (gle_match(display_name_char_count,addr(display_name),4,addr('7585'))) or
	      (gle_match(display_name_char_count,addr(display_name),4,addr('7595'))) or
	      (gle_match(display_name_char_count,addr(display_name),5,addr('7586B'))) or
	      (gle_match(display_name_char_count,addr(display_name),5,addr('7596A'))) or
	      (gle_match(display_name_char_count,addr(display_name),4{SFB},addr('7586'))) or
	      (gle_match(display_name_char_count,addr(display_name),4{SFB},addr('7596'))) or
	      (gle_match(display_name_char_count,addr(display_name),5,addr('7550A'))) or
	      (gle_match(display_name_char_count,addr(display_name),4{SFB},addr('7550'))) then
	   begin
	      pallette := 8;
	      cont_linestyles := 8;
	      vect_linestyles := 8;
	    end
	  else
	    begin
	     if (gle_match(display_name_char_count,addr(display_name),5,addr('9872A'))) or
		(gle_match(display_name_char_count,addr(display_name),5,addr('9872B'))) or
		(gle_match(display_name_char_count,addr(display_name),5,addr('9872S'))) or
		(gle_match(display_name_char_count,addr(display_name),4,addr('9872'))) then
	      pallette   := 4
	     else
	      if (gle_match(display_name_char_count,addr(display_name),5,addr('9872C'))) or
		 (gle_match(display_name_char_count,addr(display_name),5,addr('9872T'))) then
		pallette := 8
	      else
		if spooling = 0 then pallette := 4   { assume 9872 like device }
	      else
		escape(-26); { can't init device, force io error }

	      cont_linestyles := 8;
	      vect_linestyles := 0;
	    end;

	  hpgl_get_hard_clip ( gcb );
	  display_min_x := info1;
	  display_min_y := info3;
	  display_max_x := info2;
	  display_max_y := info4;

	  gle_soft_clip_limits ( gcb );  { set default clipping limits }

	  gamut := pallette;
	  polygon_support := 0;             { polygon routine dummyed out }
	  display_handler_name := 'HPGL  ';
	  display_handler_char_count := 4;

	  display_res_x := 40;
	  display_res_y := 40;

	  linewidths :=  1;
	  char_sizes := -1;
	  background :=  0;
	  complement_support := 0;
	  non_dominant_support := 0;
	  erase_support := 0;
	  color_map_support := 0;
	  redef_background  := 0;

	  polygon_fill_factor := 16;
	  polygon_solid_fill  := 5;
	  dither_support      := 0;

	  current_pos_x := 0;
	  current_pos_y := 0;
	  current_cursor_state := 0; { off }

	  current_buffer_mode := 0;  { imed visb }
	end;
    recover
      begin
	if escapecode = -26 then error_return := 1
	else if escapecode = -20 {stop key} then
	   begin
	     current := 0;
	     escape(-20);
	   end
	else escape(escapecode); { ignor io errors }
      end;
end;

end. { hpgl_output }

@


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


56.1
log
@Automatic bump of revision number for PWS version 3.25
@
text
@a0 782
{                                                                           }
{ Graphics Low End                                                          }
{                                                                           }
{ Module    = GLE_HPGL_OUT                                                  }
{ Programer = BJS                                                           }
{ Date      = 10- 5-82                                                      }
{                                                                           }
{ Purpose: To provide device dependent routines to drive hpgl output        }
{          plotters.                                                        }

{ Rev history                                                               }
{  Created  - 10- 5-82  BJS                                                 }
{  Modified - 11-24-82  BJS  removed refs to str routines                   }
{              6-28-83  BJS  added import of gle_astext (routine moved from }
{                            gle_stext                                      }
{              3-14-84  BDS  added identifiers for 7586B, 7550A, 7090, 7440 }
{              4-  -85  SFB  bug fixes for some string lengths              }
{              4-23-85  SFB  pass out all escape codes after current := 0   }

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

$search 'GLE_TYPES',
	'GLE_SCLIP',
	'ASM_SCLIP',
	'GLE_STEXT',
	'ASM_STEXT',
	'GLE_SMARK',
	'GLE_UTLS'$
$modcal$
$include 'OPTIONS'$  { ******************** COMPILER OPTIONS ****************** }
$linenum 7000$
$ALLOW_PACKED ON$ {JWS 3/31/87}

module GLE_HPGL_OUT;

import gle_types;

export

const
  max_buffer = 255;
  buffer_fudge = 32;

type
  ascii_buffer_ptr = ^ascii_buffer;

  ascii_buffer = packed record
		   maximum : integer;
		   current : integer;
		   data    : packed array [1..max_buffer] of char;
		 end;

  driver_state_def = (moving,drawing,start_of_buffer,unknown);

  hpgl_device_rec_ptr= ^ hpgl_device_rec;
  hpgl_device_rec =
    record
      driver_state : driver_state_def;
    end;

procedure gle_init_hpgl_output  (  gcb : graphics_control_block_ptr );

implement

import gle_stext,
       gle_astext,
       gle_asclip,
       gle_sclip,
       gle_smark,
       gle_utls;

procedure hpgl_flush_buffer ( gcb : graphics_control_block_ptr );

begin
  with gcb^,
       ascii_buffer_ptr(device_buf)^,
       hpgl_device_rec_ptr(dev_dep_stuff)^ do
    begin
      if current <> 0 then call (io_write,iocb,device_buf);
      driver_state := start_of_buffer;
    end;
end;

procedure dummy (  gcb : graphics_control_block_ptr );

begin
end;

procedure buffer_cleanup ( gcb : graphics_control_block_ptr );

begin
  with gcb^,ascii_buffer_ptr(gcb^.device_buf)^ do
    if (current > maximum - buffer_fudge) or (current_buffer_mode = 0) then
      hpgl_flush_buffer ( gcb );
end;

procedure add_char_data (  gcb : graphics_control_block_ptr;
			   count : gle_shortint;
			   s : anychar_ptr );
var
  i : gle_shortint;

begin
  with gcb^,ascii_buffer_ptr(gcb^.device_buf)^ do
    begin
      for i := 1 to count do
	data[i+current] := s^[i];
      current := current + count;
    end;
end;

procedure add_parm_data ( gcb : graphics_control_block_ptr;
			value : gle_shortint);
var
  count : gle_shortint;

begin
  with gcb^,ascii_buffer_ptr(gcb^.device_buf)^ do
    begin
      gle_write_integer (value,count,addr(data[current+1]));
      current := current + count;
    end;
end;

procedure change_state ( gcb : graphics_control_block_ptr;
		   new_state : driver_state_def );

var
  change : boolean;

begin
  with gcb^,hpgl_device_rec_ptr(dev_dep_stuff)^ do
    begin
      change := new_state <> driver_state;
      if (driver_state = unknown) or
	 (((driver_state = moving) or (driver_state = drawing)) and change) then
	add_char_data(gcb,1,addr('; '));
      if change then
	begin
	  driver_state := new_state;
	  case driver_state of
	    moving  : add_char_data ( gcb, 5, addr('PU;PA') );
	    drawing : add_char_data ( gcb, 5, addr('PD;PA') );
	    start_of_buffer,unknown : ;
	  end; { of case }
	end;
    end;
end;

procedure hpgl_output_escapeo ( gcb : graphics_control_block_ptr );

begin
  with gcb^,hpgl_device_rec_ptr(dev_dep_stuff)^ ,
       ascii_buffer_ptr(gcb^.device_buf)^do
    begin
      try
       change_state ( gcb, unknown );
       add_char_data(gcb,info1,anyptr(info_ptr1));
       buffer_cleanup ( gcb );
      recover
	   begin        {modified to pass all escapes SFB 4/23/85}
	     current := 0;
	     escape(escapecode);
	   end;
    end;
end;

procedure hpgl_output_escapei ( gcb : graphics_control_block_ptr );

var
  i : gle_shortint;
  sptr : anychar_ptr;

begin
  with gcb^,ascii_buffer_ptr(gcb^.device_buf)^ do
    begin
     try
      call (io_read, iocb,  device_buf);
      sptr := anyptr(info_ptr1);
      info1 := current;
      for i := 1 to current do
	sptr^[i] := data[i];
      current := 0;                    { reset buffer counter }
     recover
	  begin        {modified to pass all escapes SFB 4/23/85}
	    current := 0;
	    escape(escapecode);
	  end;
    end;
end;

procedure hpgl_get_p1p2 (  gcb : graphics_control_block_ptr );

var
  cnt    : gle_shortint;
  tcnt   : gle_shortint;
  temp   : integer;

begin
  with gcb^,
  ascii_buffer_ptr(gcb^.device_buf)^,
  hpgl_device_rec_ptr(dev_dep_stuff)^ do
   begin
    try
     if spooling = 0 then
	begin
	  change_state ( gcb, unknown );
	  add_char_data ( gcb, 2, addr('OP') );
	  hpgl_flush_buffer ( gcb );
	  call (io_read, iocb,  device_buf);
	  tcnt := 1;
	  info1 := gle_read_integer (current,addr(data[1]),cnt);
	  cnt := cnt + tcnt;
	  info3 := gle_read_integer (current,addr(data[cnt]),tcnt);
	  cnt := cnt + tcnt;
	  info2 := gle_read_integer (current,addr(data[cnt]),tcnt);
	  cnt := cnt + tcnt;
	  info4 := gle_read_integer (current,addr(data[cnt]),tcnt);
	  current := 0;
	  if info1 > info2 then     { make xmin <= xmax }
	    begin
	      temp := info1;
	      info1 := info2;
	      info2 := temp;
	    end;
	  if info3 > info4 then     { make ymin <= ymax }
	    begin
	      temp := info3;
	      info3 := info4;
	      info4 := temp;
	    end;
	end
      else
	begin
	  info1 := display_min_x;
	  info2 := display_max_x;
	  info3 := display_min_y;
	  info4 := display_max_y;
	end;
    recover
	 begin        {modified to pass all escapes SFB 4/23/85}
	   current := 0;
	   escape(escapecode);
	 end;
   end;
end;

procedure hpgl_get_hard_clip (  gcb : graphics_control_block_ptr );

var
  tcnt,cnt    : gle_shortint;
  tp1x,tp1y,tp2x,tp2y : gle_shortint;

begin

  with gcb^,
  ascii_buffer_ptr(gcb^.device_buf)^,
  hpgl_device_rec_ptr(dev_dep_stuff)^ do
    begin
    try
    if gle_match(4,addr(display_name),4,addr('7580')) or
       gle_match(4,addr(display_name),4,addr('7585')) or
       gle_match(4,addr(display_name),4,addr('7586')) or
       gle_match(4,addr(display_name),4,addr('7595')) or        {SFB 9/22/86}
       gle_match(4,addr(display_name),4,addr('7596')) or        {SFB 9/22/86}
       gle_match(4,addr(display_name),4,addr('7570')) or        {SFB 9/18/86}
       gle_match(4,addr(display_name),4,addr('7575')) or        {SFB 11/14/88}
       gle_match(4,addr(display_name),4,addr('7576')) then      {SFB 11/14/88}
      begin
	if spooling = 0 then
	  begin
	    add_char_data ( gcb, 2, addr('OH') );
	    hpgl_flush_buffer ( gcb );
	    call (io_read, iocb,  device_buf);
	    tcnt := 1;
	    info1 := gle_read_integer (current,addr(data[1]),cnt);
	    cnt := cnt + tcnt;
	    info3 := gle_read_integer (current,addr(data[cnt]),tcnt);
	    cnt := cnt + tcnt;
	    info2 := gle_read_integer (current,addr(data[cnt]),tcnt);
	    cnt := cnt + tcnt;
	    info4 := gle_read_integer (current,addr(data[cnt]),tcnt);
	    current := 0;
	  end
	else
	  begin
	   if ( gle_match(4,addr(display_name),4,addr('7586')) ) or
	      ( gle_match(4,addr(display_name),4,addr('7585')) ) or
	      ( gle_match(4,addr(display_name),4,addr('7596')) ) or   {SFB 9/22/86}
	      ( gle_match(4,addr(display_name),4,addr('7595')) ) or   {SFB 9/22/86}
	      ( gle_match(4,addr(display_name),4,addr('7576')) ) then {SFB 11/14/88}
	     begin
	       info1 := -23656;            { E size }
	       info2 :=  23656;
	       info3 := -17962;
	       info4 :=  17962;
	     end
	   else {7580x or 7570A or 7575A (11/14/88) spooling SFB 9/18/86}
	     begin
	       info1 := -16190;            { D size }
	       info2 :=  16190;
	       info3 := -10485;
	       info4 :=  10485;
	     end;
	  end
      end
    else
    if (gle_match(4,addr(display_name),4,addr('7470'))) or
       (gle_match(4,addr(display_name),4,addr('7440'))) then
      begin
	info1 := 0;
	info2 := 10300;
	info3 := 0;
	info4 := 7650;
      end
    else
    if (gle_match(4,addr(display_name),4,addr('7475'))) or
       (gle_match(4,addr(display_name),4,addr('7090'))) then
      begin
	info1 := 0;
	info2 := 16640;
	info3 := 0;
	info4 := 10365;
      end
    else
    if gle_match(4,addr(display_name),4,addr('7550')) then
      begin
	info1 := 0;
	info2 := 16450;
	info3 := 0;
	info4 := 10170;
      end
    else
    if gle_match(4,addr(display_name),4,addr('9872')) or (spooling = 1) then
      begin
	info1 := 0;
	info2 := 16000;
	info3 := 0;
	info4 := 11400;
      end
    else
      begin  { initialize the device and use P1/P2 values }
	hpgl_get_p1p2 ( gcb );
	tp1x := info1; tp2x := info2;
	tp1y := info3; tp2y := info4;
	add_char_data ( gcb, 3, addr('IN'));
	hpgl_flush_buffer ( gcb );              { BDS 3/28/84 }
	hpgl_get_p1p2 ( gcb );
	{ restore p1, p2 }
	add_char_data ( gcb, 2, addr('IP'));
	add_parm_data ( gcb, tp1x );
	add_char_data ( gcb, 1, addr(', '));
	add_parm_data ( gcb, tp1y );
	add_char_data ( gcb, 1, addr(', '));
	add_parm_data ( gcb, tp2x );
	add_char_data ( gcb, 1, addr(', '));
	add_parm_data ( gcb, tp2y );
	hpgl_flush_buffer ( gcb );
      end;
    recover
	begin        {modified to pass all escapes SFB 4/23/85}
	  current := 0;
	  escape(escapecode);
	end;
    end;
end;

procedure hpgl_move (  gcb : graphics_control_block_ptr );

begin
  with gcb^,hpgl_device_rec_ptr(dev_dep_stuff)^ ,
       ascii_buffer_ptr(device_buf)^ do
    begin
     try
       if driver_state = moving then
	 add_char_data ( gcb, 1, addr(', '))
       else
	 change_state ( gcb, moving );
       add_parm_data ( gcb, end_x);
       add_char_data ( gcb, 1, addr(', '));
       add_parm_data ( gcb, end_y);
       current_pos_x := end_x;
       current_pos_y := end_y;
       buffer_cleanup ( gcb );
     recover
	  begin        {modified to pass all escapes SFB 4/23/85}
	    current := 0;
	    escape(escapecode);
	  end;
    end;
end;

procedure hpgl_draw (  gcb : graphics_control_block_ptr );

begin
  with gcb^,hpgl_device_rec_ptr(dev_dep_stuff)^ ,
       ascii_buffer_ptr(device_buf)^ do
    begin
     try
      if driver_state = drawing then
	add_char_data ( gcb, 1, addr(', '))
      else
	change_state ( gcb, drawing );
      add_parm_data ( gcb, end_x);
      add_char_data ( gcb, 1, addr(', '));
      add_parm_data ( gcb, end_y);
      current_pos_x := end_x;
      current_pos_y := end_y;
      buffer_cleanup ( gcb );
     recover
	  begin        {modified to pass all escapes SFB 4/23/85}
	    current := 0;
	    escape(escapecode);
	  end;
    end;
end;

procedure hpgl_buffer_mode(  gcb : graphics_control_block_ptr );

begin
 with gcb^ ,ascii_buffer_ptr(device_buf)^ do
 begin
  try
   hpgl_flush_buffer ( gcb );
   current_buffer_mode := info1;
  recover
	begin        {modified to pass all escapes SFB 4/23/85}
	  current := 0;
	  escape(escapecode);
	end;
 end;
end;

procedure hpgl_set_color (  gcb : graphics_control_block_ptr );

begin
  with gcb^,hpgl_device_rec_ptr(dev_dep_stuff)^ ,
       ascii_buffer_ptr(gcb^.device_buf)^ do
    begin
      try
       change_state ( gcb, unknown );
       add_char_data ( gcb, 5, addr('PU;SP') );
       add_parm_data ( gcb, info1 );
       buffer_cleanup ( gcb );
       current_color_index := info1;
      recover
	   begin        {modified to pass all escapes SFB 4/23/85}
	     current := 0;
	     escape(escapecode);
	   end;
    end;
end;

{********************** this procedure is never used ***********************
procedure hpgl_fill_index_color (  gcb : graphics_control_block_ptr );

begin
  with gcb^,hpgl_device_rec_ptr(dev_dep_stuff)^ do
    current_polygon_color := info1;
end;}

procedure hpgl_linestyle (  gcb : graphics_control_block_ptr );

begin
  with gcb^,hpgl_device_rec_ptr(dev_dep_stuff)^ ,
	    ascii_buffer_ptr(gcb^.device_buf)^ do
    begin
      try
       change_state ( gcb, unknown );
       current_linestyle := info1;
       current_pattern_length := info2;
       current_linestyle_mode := info3;
       current_linestyle_pattern := info4;
       add_char_data(gcb,2,addr('LT'));
       if info1 = 0 then
	 begin
	 end
       else
       if info1 = 7 then
	 add_parm_data(gcb,0)
       else
	 begin
	   if info3 = 0 then
	     add_parm_data(gcb,info1)
	   else
	     add_parm_data(gcb,-info1);
	   add_char_data(gcb,1,addr(', '));
	   add_parm_data(gcb,info2);
	 end;
       buffer_cleanup ( gcb );
      recover
	   begin        {modified to pass all escapes SFB 4/23/85}
	     current := 0;
	     escape(escapecode);
	   end;
    end;
end;

procedure hpgl_clear(  gcb : graphics_control_block_ptr );

begin
  with gcb^,hpgl_device_rec_ptr(dev_dep_stuff)^ ,
	    ascii_buffer_ptr(gcb^.device_buf)^do
    begin
      try
       change_state ( gcb, unknown );
       add_char_data(gcb,2,addr('PG'));
       buffer_cleanup ( gcb );
      recover
	   begin        {modified to pass all escapes SFB 4/23/85}
	     current := 0;
	     escape(escapecode);
	   end;
    end;
end;

procedure hpgl_cursor (  gcb : graphics_control_block_ptr );

begin
  with gcb^,hpgl_device_rec_ptr(dev_dep_stuff)^ ,
	    ascii_buffer_ptr(gcb^.device_buf)^do
    begin
      try
       change_state  ( gcb, unknown );
       add_char_data ( gcb, 5, addr('PU;PA'));
       add_parm_data ( gcb, info1);
       add_char_data ( gcb, 1, addr(', '));
       add_parm_data ( gcb, info2);
       current_cursor_state := info3;
       hpgl_flush_buffer ( gcb );
      recover
	   begin        {modified to pass all escapes SFB 4/23/85}
	     current := 0;
	     escape(escapecode);
	   end;
    end;
end;

procedure gle_init_hpgl_output (  gcb : graphics_control_block_ptr);

var
  saved_timeout : integer;
  i : gle_shortint;

begin
  with gcb^,
       hpgl_device_rec_ptr(dev_dep_stuff)^,
       ascii_buffer_ptr(device_buf)^ do
    try
      current := 0;
      maximum := max_buffer;

      driver_state         := start_of_buffer;
      unclipped_move       := hpgl_move;
      unclipped_draw       := hpgl_draw;
      move                 := gle_soft_clip_move;
      draw                 := gle_soft_clip_draw;
      clear                := hpgl_clear;
      text                 := gle_soft_text {hpgl_text};
      char_size            := gle_soft_char_size;
      clip_limits          := gle_soft_clip_limits;
      text_spacing         := gle_soft_text_spacing;
      linestyle            := hpgl_linestyle;
      text_dir             := gle_soft_text_dir;
      text_just            := gle_soft_text_just;
      marker               := gle_soft_marker;
      marker_size          := gle_soft_marker_size;
      set_marker           := gle_soft_set_marker;
      index_color          := hpgl_set_color;
      inq_p1p2             := hpgl_get_p1p2;
      get_polygon_info     := dummy;
      graphics_on_off      := dummy;
      cursor               := hpgl_cursor;
      calc_soft_text_xform := gle_text_xform;
      buffer_mode          := hpgl_buffer_mode;
      output_escapeo       := hpgl_output_escapeo;
      output_escapei       := hpgl_output_escapei;
      define_drawing_mode  := dummy;
      define_color_map     := dummy;
      polygon              := dummy;
      fill_index_color     := dummy;
      linewidth            := dummy;
      gload                := dummy;
      gstore               := dummy;
      get_raster           := dummy;
      get_color_map        := dummy;
      await_blanking       := dummy;
      flush_buffer         := hpgl_flush_buffer;

      soft_font_ptr        := addr(font);

      error_return := 0;
      if spooling = 0 then
	try
	  call (io_inq_timeout, iocb, saved_timeout );
	  call (io_set_timeout, iocb, 500 { ms } );
	  { send command that all HPGL plotters can respond to   }
	  { if the command fails then the address does not match }
	  { the device.                                          }
	  add_char_data ( gcb, 2, addr('OE') );
	  hpgl_flush_buffer ( gcb );
	  call (io_read, iocb,  device_buf);
	  current := 0;

	  { if this point is reached then a vaild HPGL device was found }

	  try  { perform an output identify seq.  Note a 9872A will fail }
	    add_char_data ( gcb, 2, addr('OI') );
	    hpgl_flush_buffer ( gcb );
	    call (io_read, iocb,  device_buf);

	    for i := 1 to current do display_name[i] := data[i];
	    for i := current+1 to 6 do display_name[i] := ' ';
	    display_name_char_count := current;
	    current := 0;
	  recover
	    if escapecode = -26 { io system } then
	      begin
		display_name := '9872A ';
		display_name_char_count := 5;
		current := 0;
	      end
	    else if escapecode = -20 {stop key} then
	       begin
		 current := 0;
		 escape(-20);
	       end
	    else escape(escapecode);

	recover
	  if escapecode = -26 then error_return := 1
	  else if escapecode = -20 {stop key} then
	       begin
		 current := 0;
		 escape(-20);
	       end
	  else escape(escapecode); { ignor io errors }

      call (io_set_timeout, iocb, saved_timeout );

      if error_return = 0 then
	begin
	  add_char_data ( gcb, 12, addr('DF;SP1;IM30;') );
	  hpgl_flush_buffer ( gcb );
	  if gle_match(4,addr(display_name),4,addr('9111')) then { 9111 is input only }
	    escape(-26) { force io error }
	  else
	  if gle_match(display_name_char_count,addr(display_name),5,addr('7470A')) or
	     gle_match(display_name_char_count,addr(display_name),4,addr('7470')) then
	    begin
	      pallette := 2;
	      cont_linestyles := 8;
	      vect_linestyles := 0;
	    end
	  else
	  if gle_match(display_name_char_count,addr(display_name),5,addr('7440A')) or
	     gle_match(display_name_char_count,addr(display_name),4,addr('7440')) then
	    begin
	      pallette := 8;
	      cont_linestyles := 8;
	      vect_linestyles := 0;
	    end
	  else
	  if gle_match(display_name_char_count,addr(display_name),5,addr('7475A')) or
	     gle_match(display_name_char_count,addr(display_name),4,addr('7475')) or
	     gle_match(display_name_char_count,addr(display_name),4,addr('7090')) then
	     begin
	      pallette := 6;
	      cont_linestyles := 8;
	      vect_linestyles := 0;
	    end
	  else  {BUG FIXES FOR LENGTHS SFB 4/85}
if (gle_match(display_name_char_count,addr(display_name),5,addr('7580A'))) or
{SFB 9/18/86} (gle_match(display_name_char_count,addr(display_name),5,addr('7570A'))) or
{SFB 9/18/86} (gle_match(display_name_char_count,addr(display_name),4,addr('7570'))) or
{SFB 11/14/88}(gle_match(display_name_char_count,addr(display_name),5,addr('7575A'))) or
{SFB 11/14/88}(gle_match(display_name_char_count,addr(display_name),4,addr('7575'))) or
{SFB 11/14/88}(gle_match(display_name_char_count,addr(display_name),5,addr('7576A'))) or
{SFB 11/14/88}(gle_match(display_name_char_count,addr(display_name),4,addr('7576'))) or
	      (gle_match(display_name_char_count,addr(display_name),5,addr('7580B'))) or
	      (gle_match(display_name_char_count,addr(display_name),4,addr('7580'))) or
	      (gle_match(display_name_char_count,addr(display_name),5,addr('7585A'))) or
	      (gle_match(display_name_char_count,addr(display_name),5,addr('7595A'))) or
	      (gle_match(display_name_char_count,addr(display_name),5,addr('7585B'))) or
	      (gle_match(display_name_char_count,addr(display_name),4,addr('7585'))) or
	      (gle_match(display_name_char_count,addr(display_name),4,addr('7595'))) or
	      (gle_match(display_name_char_count,addr(display_name),5,addr('7586B'))) or
	      (gle_match(display_name_char_count,addr(display_name),5,addr('7596A'))) or
	      (gle_match(display_name_char_count,addr(display_name),4{SFB},addr('7586'))) or
	      (gle_match(display_name_char_count,addr(display_name),4{SFB},addr('7596'))) or
	      (gle_match(display_name_char_count,addr(display_name),5,addr('7550A'))) or
	      (gle_match(display_name_char_count,addr(display_name),4{SFB},addr('7550'))) then
	   begin
	      pallette := 8;
	      cont_linestyles := 8;
	      vect_linestyles := 8;
	    end
	  else
	    begin
	     if (gle_match(display_name_char_count,addr(display_name),5,addr('9872A'))) or
		(gle_match(display_name_char_count,addr(display_name),5,addr('9872B'))) or
		(gle_match(display_name_char_count,addr(display_name),5,addr('9872S'))) or
		(gle_match(display_name_char_count,addr(display_name),4,addr('9872'))) then
	      pallette   := 4
	     else
	      if (gle_match(display_name_char_count,addr(display_name),5,addr('9872C'))) or
		 (gle_match(display_name_char_count,addr(display_name),5,addr('9872T'))) then
		pallette := 8
	      else
		if spooling = 0 then pallette := 4   { assume 9872 like device }
	      else
		escape(-26); { can't init device, force io error }

	      cont_linestyles := 8;
	      vect_linestyles := 0;
	    end;

	  hpgl_get_hard_clip ( gcb );
	  display_min_x := info1;
	  display_min_y := info3;
	  display_max_x := info2;
	  display_max_y := info4;

	  gle_soft_clip_limits ( gcb );  { set default clipping limits }

	  gamut := pallette;
	  polygon_support := 0;             { polygon routine dummyed out }
	  display_handler_name := 'HPGL  ';
	  display_handler_char_count := 4;

	  display_res_x := 40;
	  display_res_y := 40;

	  linewidths :=  1;
	  char_sizes := -1;
	  background :=  0;
	  complement_support := 0;
	  non_dominant_support := 0;
	  erase_support := 0;
	  color_map_support := 0;
	  redef_background  := 0;

	  polygon_fill_factor := 16;
	  polygon_solid_fill  := 5;
	  dither_support      := 0;

	  current_pos_x := 0;
	  current_pos_y := 0;
	  current_cursor_state := 0; { off }

	  current_buffer_mode := 0;  { imed visb }
	end;
    recover
      begin
	if escapecode = -26 then error_return := 1
	else if escapecode = -20 {stop key} then
	   begin
	     current := 0;
	     escape(-20);
	   end
	else escape(escapecode); { ignor io errors }
      end;
end;

end. { hpgl_output }

@


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


29.2
log
@Added support for DraftPro DXL/EXL (7575A/7576A). Scott
@
text
@@


29.1
log
@Automatic bump of revision number for PWS version 3.22b
@
text
@d280 5
a284 3
       gle_match(4,addr(display_name),4,addr('7595')) or      {SFB 9/22/86}
       gle_match(4,addr(display_name),4,addr('7596')) or      {SFB 9/22/86}
       gle_match(4,addr(display_name),4,addr('7570')) then      {SFB 9/18/86}
d305 3
a307 2
	      ( gle_match(4,addr(display_name),4,addr('7596')) ) or {SFB 9/22/86}
	      ( gle_match(4,addr(display_name),4,addr('7595')) ) then {SFB 9/22/86}
d314 1
a314 1
	   else {7580x or 7570A spooling SFB 9/18/86}
d692 4
@


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


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.2
log
@Pws2unix automatic delta on Wed Apr  1 08:30:27 MST 1987
@
text
@@


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


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


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


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


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


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


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


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


5.2
log
@Changes from Scott Bayes
@
text
@@


5.1
log
@Automatic bump of revision number for PWS version 3.2j
@
text
@d278 4
a281 1
       gle_match(4,addr(display_name),4,addr('7586')) then
d301 3
a303 1
	      ( gle_match(4,addr(display_name),4,addr('7585')) ) then
d310 1
a310 1
	   else
d685 16
a700 10
	 if (gle_match(display_name_char_count,addr(display_name),5,addr('7580A'))) or
	    (gle_match(display_name_char_count,addr(display_name),5,addr('7580B'))) or
	    (gle_match(display_name_char_count,addr(display_name),4,addr('7580'))) or
	    (gle_match(display_name_char_count,addr(display_name),5,addr('7585A'))) or
	    (gle_match(display_name_char_count,addr(display_name),5,addr('7585B'))) or
	    (gle_match(display_name_char_count,addr(display_name),4,addr('7585'))) or
	    (gle_match(display_name_char_count,addr(display_name),5,addr('7586B'))) or
	    (gle_match(display_name_char_count,addr(display_name),4{SFB},addr('7586'))) or
	    (gle_match(display_name_char_count,addr(display_name),5,addr('7550A'))) or
	    (gle_match(display_name_char_count,addr(display_name),4{SFB},addr('7550'))) then
d712 1
a712 1
		pallette   := 4
@


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


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


3.2
log
@Changes from Scott Bayes.
@
text
@d278 1
a278 4
       gle_match(4,addr(display_name),4,addr('7586')) or
       gle_match(4,addr(display_name),4,addr('7595')) or      {SFB 9/22/86}
       gle_match(4,addr(display_name),4,addr('7596')) or      {SFB 9/22/86}
       gle_match(4,addr(display_name),4,addr('7570')) then      {SFB 9/18/86}
d298 1
a298 3
	      ( gle_match(4,addr(display_name),4,addr('7585')) ) or
	      ( gle_match(4,addr(display_name),4,addr('7596')) ) or {SFB 9/22/86}
	      ( gle_match(4,addr(display_name),4,addr('7595')) ) then {SFB 9/22/86}
d305 1
a305 1
	   else {7580x or 7570A spooling SFB 9/18/86}
d680 10
a689 16
if (gle_match(display_name_char_count,addr(display_name),5,addr('7580A'))) or
{SFB 9/18/86} (gle_match(display_name_char_count,addr(display_name),5,addr('7570A'))) or
{SFB 9/18/86} (gle_match(display_name_char_count,addr(display_name),4,addr('7570'))) or
	      (gle_match(display_name_char_count,addr(display_name),5,addr('7580B'))) or
	      (gle_match(display_name_char_count,addr(display_name),4,addr('7580'))) or
	      (gle_match(display_name_char_count,addr(display_name),5,addr('7585A'))) or
	      (gle_match(display_name_char_count,addr(display_name),5,addr('7595A'))) or
	      (gle_match(display_name_char_count,addr(display_name),5,addr('7585B'))) or
	      (gle_match(display_name_char_count,addr(display_name),4,addr('7585'))) or
	      (gle_match(display_name_char_count,addr(display_name),4,addr('7595'))) or
	      (gle_match(display_name_char_count,addr(display_name),5,addr('7586B'))) or
	      (gle_match(display_name_char_count,addr(display_name),5,addr('7596A'))) or
	      (gle_match(display_name_char_count,addr(display_name),4{SFB},addr('7586'))) or
	      (gle_match(display_name_char_count,addr(display_name),4{SFB},addr('7596'))) or
	      (gle_match(display_name_char_count,addr(display_name),5,addr('7550A'))) or
	      (gle_match(display_name_char_count,addr(display_name),4{SFB},addr('7550'))) then
d701 1
a701 1
	      pallette   := 4
@


3.1
log
@Automatic bump of revision number for PWS version 3.2h
@
text
@d278 4
a281 1
       gle_match(4,addr(display_name),4,addr('7586')) then
d301 3
a303 1
	      ( gle_match(4,addr(display_name),4,addr('7585')) ) then
d310 1
a310 1
	   else
d685 16
a700 10
	 if (gle_match(display_name_char_count,addr(display_name),5,addr('7580A'))) or
	    (gle_match(display_name_char_count,addr(display_name),5,addr('7580B'))) or
	    (gle_match(display_name_char_count,addr(display_name),4,addr('7580'))) or
	    (gle_match(display_name_char_count,addr(display_name),5,addr('7585A'))) or
	    (gle_match(display_name_char_count,addr(display_name),5,addr('7585B'))) or
	    (gle_match(display_name_char_count,addr(display_name),4,addr('7585'))) or
	    (gle_match(display_name_char_count,addr(display_name),5,addr('7586B'))) or
	    (gle_match(display_name_char_count,addr(display_name),4{SFB},addr('7586'))) or
	    (gle_match(display_name_char_count,addr(display_name),5,addr('7550A'))) or
	    (gle_match(display_name_char_count,addr(display_name),4{SFB},addr('7550'))) then
d712 1
a712 1
		pallette   := 4
@


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


1.1
log
@Initial revision
@
text
@@
