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


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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

19.1
date     87.06.01.08.30.23;  author jws;  state Exp;
branches ;
next     18.2;

18.2
date     87.05.21.08.57.00;  author bayes;  state Exp;
branches ;
next     18.1;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

1.1
date     86.06.30.15.30.07;  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
@{                                                                           }
{ DGL device dependent init routine                                         }
{                                                                           }
{ Module    = DGL_HPGL                                                      }
{ Programer = BJS                                                           }
{ Date      = 10- 5-82                                                      }
{                                                                           }
{ Purpose: To provide device dependent initialization for HPGL devices.     }

{ Rev history                                                               }
{  Created  - 1 - 5-82  BJS                                                 }
{  Modified - 4 -03-84  BDS Changes dynamic allocations to globals for 3.0  }
{                           Added identifiers for 7586,7550,7475            }
{  Modified - 4 -85     SFB Added calls to locator_esc                      }
{  Modified - 5 -87     SFB Fixed pen_force and accleration for last pen    }

{     (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_LIB',
	'TYPES',
	'DGL_VARS'$
$modcal$
$include 'OPTIONS'$  { ******************** COMPILER OPTIONS ****************** }
$linenum 17000$

module DGL_HPGL;

export

procedure dgl_hpgl_init(control : integer);

implement

import dgl_types,
       dgl_vars,
       gle_gen,
       gle_utls,
       asm;

procedure hpgl_input_esc (       opcode : integer;
				 isize  : integer;
				 rsize  : integer;
			  anyvar ilist  : gint_list;
			  anyvar rlist  : greal_list;
			  var    ierr   : integer  );


{ Purpose : To perform an input escape function                           }

var
  s : string[40];
  cnt : integer;
  c : char;

begin
  with gle_gcb^ do
    begin
      if spooling = 1 then ierr := 4;
      if ((gle_match(4,addr(display_name),4,addr('7580'))  or
	  gle_match(4,addr(display_name),4,addr('7570'))   or     {SFB 9/18/86}
	  gle_match(4,addr(display_name),4,addr('7550'))   or
	  gle_match(4,addr(display_name),4,addr('7475'))   or
	  gle_match(4,addr(display_name),4,addr('7090'))   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('7575'))   or     {SFB 11/14/88}
	  gle_match(4,addr(display_name),4,addr('7576')))) and    {SFB 11/14/88}
	 (opcode = 2050) then
	begin
	  if (ierr = 0) then
	    begin
	      info_ptr1 := addr('OT');
	      info1     := 2;
	      gle_output_escapeo( gle_gcb );
	      gle_flush_buffer (gle_gcb);
	      info_ptr1 := addr(s[1]);
	      gle_output_escapei ( gle_gcb );
	      setstrlen(s,info1);
	      strread(s,1,cnt,ilist[1],c,ilist[2]);
	    end;
	end
      else
	ierr := 1;
    end;

  {CALL ADDED 4/10/85 SFB}
  call(gcb^.proc_locator_input_esc, opcode, isize, rsize,
       ilist, rlist, ierr); {give locator a chance at opcode SFB 4/10/85}

end; { input_esc }

procedure hpgl_output_esc (       opcode : integer;
				  isize  : integer;
				  rsize  : integer;
			   anyvar ilist  : gint_list;
			   anyvar rlist  : greal_list;
			   var    ierr   : integer  );

{ Purpose : To perform an output escape funtion                           }

var
  s : string[20];
  cnt : integer;

  procedure set_auto_pen;

  begin
    strwrite(s,1,cnt,'AP',ilist[1]:1);
  end;

  procedure control_cutter;

  begin
    s := 'EC';
    if ilist[1] = 0 then
      begin setstrlen(s,3); s[3] := '0'; end;
  end;

  procedure advance_page;

  begin
    if ilist[1] = 0 then s := 'AH'
    else s := 'AF';
  end;

  procedure set_velocity;

  begin
    strwrite(s,1,cnt,'VS',ilist[1]:1);
    if (ilist[2] > 0) and (ilist[2] <= gle_gcb^.gamut) then
      strwrite(s,cnt,cnt,',',ilist[2]:1);
  end;

  procedure set_force;

  begin
    strwrite(s,1,cnt,'FS',ilist[1]:1);
    if (ilist[2] > 0) and (ilist[2] <= gle_gcb^.gamut) then
      {changed above from "<" to "<=" for STARS bug SR#1650022251 5-20-87 SFB}
      strwrite(s,cnt,cnt,',',ilist[2]:1);
  end;

  procedure set_acceleration;

  begin
    strwrite(s,1,cnt,'AS',ilist[1]:1);
    if (ilist[2] > 0) and (ilist[2] <= gle_gcb^.gamut) then
      {changed above from "<" to "<=" for STARS bug SR#1650022251 5-20-87 SFB}
      strwrite(s,cnt,cnt,',',ilist[2]:1);
  end;

begin
  with gle_gcb^ do
    begin
      s := '';
      if gle_match(4,addr(display_name),4,addr('9872')) then
	begin
	  if (opcode = 1052) then
	    begin if (ierr = 0) then control_cutter; end
	  else
	  if (opcode = 1053) then
	    begin if (ierr = 0) then advance_page; end
	  else
	  if (opcode = 2050) then
	    begin if (ierr = 0) then set_velocity; end
	  else
	    ierr := 1;
	end
      else
      if ((gle_match(4,addr(display_name),4,addr('7470'))) or
	 (gle_match(4,addr(display_name),4,addr('7440')))) then
	begin
	  if (opcode = 2050) then
	    begin if (ierr = 0) then set_velocity; end
	  else
	    ierr := 1;
	end
      else
      if (gle_match(4,addr(display_name),4,addr('7580'))  or
	  gle_match(4,addr(display_name),4,addr('7570'))  or    {SFB 9/18/86}
	  gle_match(4,addr(display_name),4,addr('7550'))  or
	  gle_match(4,addr(display_name),4,addr('7475'))  or
	  gle_match(4,addr(display_name),4,addr('7090'))  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('7575'))  or    {SFB 11/14/88}
	  gle_match(4,addr(display_name),4,addr('7576'))) then  {SFB 11/14/88}
	 begin
	  if (opcode = 1052) then
	    begin if (ierr = 0) then set_auto_pen; end
	  else
	  if ((opcode = 1053) and
	     ((gle_match(4,addr(display_name),4,addr('7586'))) or
	     ((gle_match(4,addr(display_name),4,addr('7596'))) or {SFB 9/22/86}
	     (gle_match(4,addr(display_name),4,addr('7550'))))))
	  then
	    begin if (ierr = 0) then advance_page; end
	  else
	  if (opcode = 2050) then
	    begin if (ierr = 0) then set_velocity; end
	  else
	  if (opcode = 2051) then
	    begin if (ierr = 0) then set_force; end
	  else
	  if (opcode = 2052) then
	    begin if (ierr = 0) then set_acceleration; end
	  else
	    ierr := 1;
	end
      else
	    ierr := 1;
      if ierr = 0 then
	begin
	  info_ptr1 := addr(s[1]);
	  info1 := strlen(s);
	  gle_output_escapeo(gle_gcb);
	end;

    end;

  {CALL ADDED SFB 4/10/85}
  call(gcb^.proc_locator_output_esc, opcode, isize, rsize,
       ilist, rlist, ierr); {give locator a chance at opcode SFB 4/10/85}

end; { output_esc }

procedure hpgl_linestyle ( index : integer);

{ Purpose:  To set the linestyle that primitives are drawn with             }

type
  ls_map_def = packed array [1..13] of gbyte;
const
  ls_map = ls_map_def [0,2,3,4,5,6,1,2,3,4,5,6,1];

begin
  with gle_gcb^ do
    begin
      info1 := ls_map[index];                { map DGL to GLE def }
      info2 := 4;                            { repeat rate 4% }
      if (index > 7) then info3 := 1
      else info3 := 0;                       { linestyle mode }
      info4 := 0;
      gle_linestyle ( gle_gcb );
    end;
end; { hpgl_linestyle }

procedure hpgl_color ( index : integer );

begin
  gle_gcb^.info1 := index;
  gle_index_color ( gle_gcb );
end;

procedure hpgl_color_table ( index : integer;
			    parm1 : real;
			    parm2 : real;
			    parm3 : real);

begin
end;

procedure dgl_hpgl_init(control : integer);

type
  default_poly_table_def = array[1..16] of poly_entry_def;

const
  default_poly_table = default_poly_table_def [
    poly_entry_def [ density :  0.0  , orient :   0.0, edge : true ], { 1 }
    poly_entry_def [ density :  0.125, orient :  90.0, edge : true ], { 2 }
    poly_entry_def [ density :  0.125, orient :   0.0, edge : true ], { 3 }
    poly_entry_def [ density : -0.125, orient :   0.0, edge : true ], { 4 }
    poly_entry_def [ density :  0.125, orient :  45.0, edge : true ], { 5 }
    poly_entry_def [ density :  0.125, orient : -45.0, edge : true ], { 6 }
    poly_entry_def [ density : -0.125, orient :  45.0, edge : true ], { 7 }
    poly_entry_def [ density :  0.25 , orient :  90.0, edge : true ], { 8 }
    poly_entry_def [ density :  0.25 , orient :   0.0, edge : true ], { 9 }
    poly_entry_def [ density : -0.25 , orient :   0.0, edge : true ], { 10 }
    poly_entry_def [ density :  0.25 , orient :  45.0, edge : true ], { 11 }
    poly_entry_def [ density :  0.25 , orient : -45.0, edge : true ], { 12 }
    poly_entry_def [ density : -0.25 , orient :  45.0, edge : true ], { 13 }
    poly_entry_def [ density : -0.5  , orient :   0.0, edge : true ], { 14 }
    poly_entry_def [ density :  1.0  , orient :   0.0, edge : false], { 15 }
    poly_entry_def [ density :  1.0  , orient :   0.0, edge : true ]];{ 16 }

type
  control_def = packed record
		  case gshortint of
		    0 : (whole : gshortint);
		    1 : (part  : packed record
				   b15,b14,b13,b12,
				   b11,b10,b9, b8,
				   clr_inhibit,b6,b5,b4,
				   b3,b2,b1,b0 : boolean;
				 end);
		  end;

var
  temp_control : control_def;
  i : integer;

begin
  with gcb^ do
    begin
      disp_just := lowerleft;
      clipping_support := true;
      retroactive_color_support := false;
      retroactive_polygon_support := false;
      maximum_polygon_vertices := 0; { no hardware support }
      if gle_gcb^.vect_linestyles <> 0 then number_dgl_linestyles := 13
      else                                  number_dgl_linestyles := 7;
      number_markers := 19;

      proc_output_esc  := hpgl_output_esc;
      proc_input_esc   := hpgl_input_esc;
      proc_linestyle   := hpgl_linestyle;
      proc_color       := hpgl_color;
      proc_color_table := hpgl_color_table;
      color_table_size := 0;

      { allocate polygon table space }

      number_polygon_styles := 16;
      {newbytes(poly_table_ptr,number_polygon_styles * 18);}
      poly_table_ptr := addr(poly_table_def_space);
      for i := 1 to poly_table_size do
	poly_table_ptr^[i] := default_poly_table[i];

      display_echo_mult := 8;

      temp_control.whole := control;
      if not temp_control.part.clr_inhibit then
	with gle_gcb^ do
	  begin
	    info1 := -1;                   { clear all planes }
	    info2 := dgl_background_index;
	    gle_clear ( gle_gcb );
	  end;
    end;
end;

end. { dgl_hpgl }

@


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


56.1
log
@Automatic bump of revision number for PWS version 3.25
@
text
@a0 364
{                                                                           }
{ DGL device dependent init routine                                         }
{                                                                           }
{ Module    = DGL_HPGL                                                      }
{ Programer = BJS                                                           }
{ Date      = 10- 5-82                                                      }
{                                                                           }
{ Purpose: To provide device dependent initialization for HPGL devices.     }

{ Rev history                                                               }
{  Created  - 1 - 5-82  BJS                                                 }
{  Modified - 4 -03-84  BDS Changes dynamic allocations to globals for 3.0  }
{                           Added identifiers for 7586,7550,7475            }
{  Modified - 4 -85     SFB Added calls to locator_esc                      }
{  Modified - 5 -87     SFB Fixed pen_force and accleration for last pen    }

{     (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_LIB',
	'TYPES',
	'DGL_VARS'$
$modcal$
$include 'OPTIONS'$  { ******************** COMPILER OPTIONS ****************** }
$linenum 17000$

module DGL_HPGL;

export

procedure dgl_hpgl_init(control : integer);

implement

import dgl_types,
       dgl_vars,
       gle_gen,
       gle_utls,
       asm;

procedure hpgl_input_esc (       opcode : integer;
				 isize  : integer;
				 rsize  : integer;
			  anyvar ilist  : gint_list;
			  anyvar rlist  : greal_list;
			  var    ierr   : integer  );


{ Purpose : To perform an input escape function                           }

var
  s : string[40];
  cnt : integer;
  c : char;

begin
  with gle_gcb^ do
    begin
      if spooling = 1 then ierr := 4;
      if ((gle_match(4,addr(display_name),4,addr('7580'))  or
	  gle_match(4,addr(display_name),4,addr('7570'))   or     {SFB 9/18/86}
	  gle_match(4,addr(display_name),4,addr('7550'))   or
	  gle_match(4,addr(display_name),4,addr('7475'))   or
	  gle_match(4,addr(display_name),4,addr('7090'))   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('7575'))   or     {SFB 11/14/88}
	  gle_match(4,addr(display_name),4,addr('7576')))) and    {SFB 11/14/88}
	 (opcode = 2050) then
	begin
	  if (ierr = 0) then
	    begin
	      info_ptr1 := addr('OT');
	      info1     := 2;
	      gle_output_escapeo( gle_gcb );
	      gle_flush_buffer (gle_gcb);
	      info_ptr1 := addr(s[1]);
	      gle_output_escapei ( gle_gcb );
	      setstrlen(s,info1);
	      strread(s,1,cnt,ilist[1],c,ilist[2]);
	    end;
	end
      else
	ierr := 1;
    end;

  {CALL ADDED 4/10/85 SFB}
  call(gcb^.proc_locator_input_esc, opcode, isize, rsize,
       ilist, rlist, ierr); {give locator a chance at opcode SFB 4/10/85}

end; { input_esc }

procedure hpgl_output_esc (       opcode : integer;
				  isize  : integer;
				  rsize  : integer;
			   anyvar ilist  : gint_list;
			   anyvar rlist  : greal_list;
			   var    ierr   : integer  );

{ Purpose : To perform an output escape funtion                           }

var
  s : string[20];
  cnt : integer;

  procedure set_auto_pen;

  begin
    strwrite(s,1,cnt,'AP',ilist[1]:1);
  end;

  procedure control_cutter;

  begin
    s := 'EC';
    if ilist[1] = 0 then
      begin setstrlen(s,3); s[3] := '0'; end;
  end;

  procedure advance_page;

  begin
    if ilist[1] = 0 then s := 'AH'
    else s := 'AF';
  end;

  procedure set_velocity;

  begin
    strwrite(s,1,cnt,'VS',ilist[1]:1);
    if (ilist[2] > 0) and (ilist[2] <= gle_gcb^.gamut) then
      strwrite(s,cnt,cnt,',',ilist[2]:1);
  end;

  procedure set_force;

  begin
    strwrite(s,1,cnt,'FS',ilist[1]:1);
    if (ilist[2] > 0) and (ilist[2] <= gle_gcb^.gamut) then
      {changed above from "<" to "<=" for STARS bug SR#1650022251 5-20-87 SFB}
      strwrite(s,cnt,cnt,',',ilist[2]:1);
  end;

  procedure set_acceleration;

  begin
    strwrite(s,1,cnt,'AS',ilist[1]:1);
    if (ilist[2] > 0) and (ilist[2] <= gle_gcb^.gamut) then
      {changed above from "<" to "<=" for STARS bug SR#1650022251 5-20-87 SFB}
      strwrite(s,cnt,cnt,',',ilist[2]:1);
  end;

begin
  with gle_gcb^ do
    begin
      s := '';
      if gle_match(4,addr(display_name),4,addr('9872')) then
	begin
	  if (opcode = 1052) then
	    begin if (ierr = 0) then control_cutter; end
	  else
	  if (opcode = 1053) then
	    begin if (ierr = 0) then advance_page; end
	  else
	  if (opcode = 2050) then
	    begin if (ierr = 0) then set_velocity; end
	  else
	    ierr := 1;
	end
      else
      if ((gle_match(4,addr(display_name),4,addr('7470'))) or
	 (gle_match(4,addr(display_name),4,addr('7440')))) then
	begin
	  if (opcode = 2050) then
	    begin if (ierr = 0) then set_velocity; end
	  else
	    ierr := 1;
	end
      else
      if (gle_match(4,addr(display_name),4,addr('7580'))  or
	  gle_match(4,addr(display_name),4,addr('7570'))  or    {SFB 9/18/86}
	  gle_match(4,addr(display_name),4,addr('7550'))  or
	  gle_match(4,addr(display_name),4,addr('7475'))  or
	  gle_match(4,addr(display_name),4,addr('7090'))  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('7575'))  or    {SFB 11/14/88}
	  gle_match(4,addr(display_name),4,addr('7576'))) then  {SFB 11/14/88}
	 begin
	  if (opcode = 1052) then
	    begin if (ierr = 0) then set_auto_pen; end
	  else
	  if ((opcode = 1053) and
	     ((gle_match(4,addr(display_name),4,addr('7586'))) or
	     ((gle_match(4,addr(display_name),4,addr('7596'))) or {SFB 9/22/86}
	     (gle_match(4,addr(display_name),4,addr('7550'))))))
	  then
	    begin if (ierr = 0) then advance_page; end
	  else
	  if (opcode = 2050) then
	    begin if (ierr = 0) then set_velocity; end
	  else
	  if (opcode = 2051) then
	    begin if (ierr = 0) then set_force; end
	  else
	  if (opcode = 2052) then
	    begin if (ierr = 0) then set_acceleration; end
	  else
	    ierr := 1;
	end
      else
	    ierr := 1;
      if ierr = 0 then
	begin
	  info_ptr1 := addr(s[1]);
	  info1 := strlen(s);
	  gle_output_escapeo(gle_gcb);
	end;

    end;

  {CALL ADDED SFB 4/10/85}
  call(gcb^.proc_locator_output_esc, opcode, isize, rsize,
       ilist, rlist, ierr); {give locator a chance at opcode SFB 4/10/85}

end; { output_esc }

procedure hpgl_linestyle ( index : integer);

{ Purpose:  To set the linestyle that primitives are drawn with             }

type
  ls_map_def = packed array [1..13] of gbyte;
const
  ls_map = ls_map_def [0,2,3,4,5,6,1,2,3,4,5,6,1];

begin
  with gle_gcb^ do
    begin
      info1 := ls_map[index];                { map DGL to GLE def }
      info2 := 4;                            { repeat rate 4% }
      if (index > 7) then info3 := 1
      else info3 := 0;                       { linestyle mode }
      info4 := 0;
      gle_linestyle ( gle_gcb );
    end;
end; { hpgl_linestyle }

procedure hpgl_color ( index : integer );

begin
  gle_gcb^.info1 := index;
  gle_index_color ( gle_gcb );
end;

procedure hpgl_color_table ( index : integer;
			    parm1 : real;
			    parm2 : real;
			    parm3 : real);

begin
end;

procedure dgl_hpgl_init(control : integer);

type
  default_poly_table_def = array[1..16] of poly_entry_def;

const
  default_poly_table = default_poly_table_def [
    poly_entry_def [ density :  0.0  , orient :   0.0, edge : true ], { 1 }
    poly_entry_def [ density :  0.125, orient :  90.0, edge : true ], { 2 }
    poly_entry_def [ density :  0.125, orient :   0.0, edge : true ], { 3 }
    poly_entry_def [ density : -0.125, orient :   0.0, edge : true ], { 4 }
    poly_entry_def [ density :  0.125, orient :  45.0, edge : true ], { 5 }
    poly_entry_def [ density :  0.125, orient : -45.0, edge : true ], { 6 }
    poly_entry_def [ density : -0.125, orient :  45.0, edge : true ], { 7 }
    poly_entry_def [ density :  0.25 , orient :  90.0, edge : true ], { 8 }
    poly_entry_def [ density :  0.25 , orient :   0.0, edge : true ], { 9 }
    poly_entry_def [ density : -0.25 , orient :   0.0, edge : true ], { 10 }
    poly_entry_def [ density :  0.25 , orient :  45.0, edge : true ], { 11 }
    poly_entry_def [ density :  0.25 , orient : -45.0, edge : true ], { 12 }
    poly_entry_def [ density : -0.25 , orient :  45.0, edge : true ], { 13 }
    poly_entry_def [ density : -0.5  , orient :   0.0, edge : true ], { 14 }
    poly_entry_def [ density :  1.0  , orient :   0.0, edge : false], { 15 }
    poly_entry_def [ density :  1.0  , orient :   0.0, edge : true ]];{ 16 }

type
  control_def = packed record
		  case gshortint of
		    0 : (whole : gshortint);
		    1 : (part  : packed record
				   b15,b14,b13,b12,
				   b11,b10,b9, b8,
				   clr_inhibit,b6,b5,b4,
				   b3,b2,b1,b0 : boolean;
				 end);
		  end;

var
  temp_control : control_def;
  i : integer;

begin
  with gcb^ do
    begin
      disp_just := lowerleft;
      clipping_support := true;
      retroactive_color_support := false;
      retroactive_polygon_support := false;
      maximum_polygon_vertices := 0; { no hardware support }
      if gle_gcb^.vect_linestyles <> 0 then number_dgl_linestyles := 13
      else                                  number_dgl_linestyles := 7;
      number_markers := 19;

      proc_output_esc  := hpgl_output_esc;
      proc_input_esc   := hpgl_input_esc;
      proc_linestyle   := hpgl_linestyle;
      proc_color       := hpgl_color;
      proc_color_table := hpgl_color_table;
      color_table_size := 0;

      { allocate polygon table space }

      number_polygon_styles := 16;
      {newbytes(poly_table_ptr,number_polygon_styles * 18);}
      poly_table_ptr := addr(poly_table_def_space);
      for i := 1 to poly_table_size do
	poly_table_ptr^[i] := default_poly_table[i];

      display_echo_mult := 8;

      temp_control.whole := control;
      if not temp_control.part.clr_inhibit then
	with gle_gcb^ do
	  begin
	    info1 := -1;                   { clear all planes }
	    info2 := dgl_background_index;
	    gle_clear ( gle_gcb );
	  end;
    end;
end;

end. { dgl_hpgl }

@


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
@d75 11
a85 9
      if ((gle_match(4,addr(display_name),4,addr('7580')) or
	  gle_match(4,addr(display_name),4,addr('7570')) or     {SFB 9/18/86}
	  gle_match(4,addr(display_name),4,addr('7550')) or
	  gle_match(4,addr(display_name),4,addr('7475')) or
	  gle_match(4,addr(display_name),4,addr('7090')) 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')))) and  {SFB 9/22/86}
d197 1
a197 1
      if (gle_match(4,addr(display_name),4,addr('7580')) or
d205 3
a207 1
	  gle_match(4,addr(display_name),4,addr('7596'))) then  {SFB 9/22/86}
@


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.2
log
@Fixed STARS bug SR#1650022251 (set_pen_force, set_acceleration not working
on highest number pen)
@
text
@@


18.1
log
@Automatic bump of revision number for PWS version 3.2J
@
text
@d15 1
d154 2
a155 1
    if (ilist[2] > 0) and (ilist[2] < gle_gcb^.gamut) then
d163 2
a164 1
    if (ilist[2] > 0) and (ilist[2] < gle_gcb^.gamut) then
@


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


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


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


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


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


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


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


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


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


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


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


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


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


5.1
log
@Automatic bump of revision number for PWS version 3.2j
@
text
@d75 1
d80 3
a82 1
	  gle_match(4,addr(display_name),4,addr('7586')))) and
d193 1
d198 3
a200 1
	  gle_match(4,addr(display_name),4,addr('7586'))) then
d206 3
a208 2
	       ((gle_match(4,addr(display_name),4,addr('7586'))) or
	       (gle_match(4,addr(display_name),4,addr('7550')))))
@


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
@a74 1
	  gle_match(4,addr(display_name),4,addr('7570')) or     {SFB 9/18/86}
d79 1
a79 3
	  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')))) and  {SFB 9/22/86}
a189 1
	  gle_match(4,addr(display_name),4,addr('7570'))  or    {SFB 9/18/86}
d194 1
a194 3
	  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'))) then  {SFB 9/22/86}
d200 2
a201 3
	     ((gle_match(4,addr(display_name),4,addr('7586'))) or
	     ((gle_match(4,addr(display_name),4,addr('7596'))) or {SFB 9/22/86}
	     (gle_match(4,addr(display_name),4,addr('7550'))))))
@


3.1
log
@Automatic bump of revision number for PWS version 3.2h
@
text
@d75 1
d80 3
a82 1
	  gle_match(4,addr(display_name),4,addr('7586')))) and
d193 1
d198 3
a200 1
	  gle_match(4,addr(display_name),4,addr('7586'))) then
d206 3
a208 2
	       ((gle_match(4,addr(display_name),4,addr('7586'))) or
	       (gle_match(4,addr(display_name),4,addr('7550')))))
@


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


1.1
log
@Initial revision
@
text
@@
