module  (output);
  (*------------------------------------------------------------------*)
  (*								      *)
  (*  Written Apr 26,'82   by Jack Gilmer			      *)
  (*								      *)
  (*  This file of absolute graphic routines implements the standard  *)
  (* graphics package for the HP 7225A plotter. All positions are in  *)
  (* mm. on a 250 by 180 mm. page.  All angles are in degrees up from *)
  (* the x-axis.						      *)
  (*								      *)
  (*------------------------------------------------------------------*)


    xfactor = 40.0;	(* # of steps/mm on the HP 7225A *)
    yfactor = 40.0;

    nulcode = 0;	(* ASCII NUL *)
    etxcode = 3;	(* ASCII ETX *)
    enqcode = 5;	(* ASCII ENQ *)
    ackcode = 6;	(* ASCII ACK *)
    esccode = 27;	(* ASCII ESC *)

    maxsent = 136;	(* # of words sent before handshake *)

    minx = 0;		(* screen co-ords in mm. *)
    maxx = 250;
    miny = 0;
    maxy = 180;

    percent = 0.32461;	(* conversion factor from mm. to % of *)
    			(* diagonal of screen co-ordinates *)

    radian = 57.2958;	(* degrees/radian *)

    maxhpstr = 10;	(* short strings for commands, etc. *)

    absp1x = 328;	(* position of lower left corner *)
    absp1y = 279;	(* in abs HP plotter units for window *)


  TYPE
    astringtype = PACKED ARRAY [1..132] OF CHAR;    (* null-terminated *)

    aendtype = (noend, point, square, triangle, cross, ecks, diamond,
                circle);

    alinetype = (noline, solid, dotted, dashed, dotdashed, 
                 dotdotdashed);

    apointtype =  RECORD	(* absolute position in millimeters *)
                    x,
		    y:  REAL;
		  END;

    cmdstrtype = PACKED ARRAY [1..2] OF CHAR;
    hpstrtype = PACKED ARRAY [1..maxhpstr] OF CHAR;

    unittype = (conunit, prunit, admunit, hpunit);


  VAR
    oldend:  aendtype;		(* last end symbol defined *)

    oldline:  alinetype;	(* last set line type *)

    oldpt, 			(* last point plotted *)
    oldleft,			(* existing window corners in mm.*)
    oldright:  apointtype;

    oldpenlifted,		(* last sent pen up/down instruction *)
    penlifted:  BOOLEAN;	(* last pen position *)

    numsent:  INTEGER;		(* co-ord counter for handshake *)

    oldesize,			(* last set end symbol radius *)
    oldrptlength:  REAL;	(* last set line pattern length *)



  FUNCTION serin(unit:  unittype):  CHAR;  EXTERNAL;

  PROCEDURE serout(unit:  unittype;  ch:  CHAR);  EXTERNAL;

  PROCEDURE exit(success:  BOOLEAN);  EXTERNAL;


  FUNCTION gethp:  CHAR;
  (*------------------------------------------------------------------*)
  (*  Gets a character from the HP port using 'serin'.		      *)
  (*------------------------------------------------------------------*)

    BEGIN (* gethp *)
      gethp := serin(hpunit);
    END; (* gethp *)



  PROCEDURE puthp(outchar:  CHAR);
  (*------------------------------------------------------------------*)
  (*  Puts out 'outchar' the port to the HP plotter.  If the	      *)
  (* system call fails, the program aborts with an error message.     *)
  (*------------------------------------------------------------------*)

    BEGIN (* puthp *)
      serout(hpunit, outchar);
    END; (* puthp *)



  PROCEDURE handshake(roomfor:  INTEGER);
  (*------------------------------------------------------------------*)
  (*  Makes sure there is room for 'roomfor' bytes in the HP 7225A    *)
  (* buffer.  Performs the handshake sequence only when necessary.    *)
  (*------------------------------------------------------------------*)

    BEGIN (* handshake *)
      numsent := numsent + roomfor;
      IF numsent > maxsent
	THEN
	  BEGIN
	    numsent := 0;
	    puthp(chr(enqcode));
	    WHILE gethp <> chr(ackcode) DO;
	  END; (* IF numsent ... *)
    END; (* handshake *)



  PROCEDURE puthpstr(str: hpstrtype);
  (*------------------------------------------------------------------*)
  (*  Puts out 'str' using 'puthp' up to but not including the first  *)
  (* blank.							      *)
  (*------------------------------------------------------------------*)

    VAR
      index: 0..maxhpstr;

    BEGIN (* puthpstr *)
      handshake(maxhpstr);
      index := 0;
      REPEAT
	index := index + 1;
	IF str[index] <> ' '
	  THEN
	    puthp(str[index]);
      UNTIL (index = maxhpstr) OR (str[index] = ' ');
    END; (* puthpstr *)



  PROCEDURE putinum(i:  INTEGER);
  (*------------------------------------------------------------------*)
  (*  Sends the integer 'i' to the HP plotter in the form: iiiii or   *)
  (* -iiiii.  Leading zeroes are suppressed.			      *)
  (*------------------------------------------------------------------*)

    VAR
      digit,			(* single digit *)
      factor:  INTEGER;		(* digit selector *)


    BEGIN (* putinum *)
      IF i < 0		(* send '-' if nec. *)
	THEN
	  BEGIN
	    puthp('-');
	    i := 0 - i;
	  END; (* IF i < 0 *)
      factor := 10000;		(* find 1st digit *)
      WHILE ((i DIV factor) = 0) AND (factor > 1) DO
	factor := factor DIV 10;
      WHILE factor > 0 DO	(* send digits *)
	BEGIN
	  digit := i DIV factor;
	  puthp(chr(ord('0') + digit));
	  i := i - (digit * factor);
	  factor := factor DIV 10;
	END; (* WHILE factor ... *)
    END; (* putinum *)



  PROCEDURE putdnum(d:  REAL);
  (*------------------------------------------------------------------*)
  (*  Sends the real number 'd' to the HP plotter in the form:        *)
  (*  ddd.ddd or -ddd.ddd.  Leading zeroes are suppressed.	      *)
  (*------------------------------------------------------------------*)

    VAR
      digit,			(* individual digit *)
      factor,			(* counts order of digit sent *)
      i:  INTEGER;		(* temporary value of d *)


    BEGIN (* putdnum *)
      i := trunc(d);	(* put the integral part, *)
      putinum(i);

      puthp('.');		(* the decimal point, *)

      i := trunc(1000.0 * abs((d - i)));  (* then the fraction *)
      factor := 100;
      WHILE factor > 0 DO
	BEGIN
	  digit := i DIV factor;  (* get digit to send *)
	  puthp(chr(ord('0') + digit));  (* and send it *)
	  i := i - (digit * factor);
	  factor := factor DIV 10;
	END; (* WHILE factor *)
    END; (* putdnum *)



  PROCEDURE putddcmd(cmd:  cmdstrtype;
	    	     d1,
	    	     d2:  REAL);
  (*------------------------------------------------------------------*)
  (*  Sends a command and two decimal parameters to the HP plotter.   *)
  (*------------------------------------------------------------------*)

    BEGIN (* putddcmd *)
      handshake(20);

      puthp(cmd[1]);		(* send command *)
      puthp(cmd[2]);

      putdnum(d1);		(* now the parameters *)
      puthp(',');
      putdnum(d2);
      puthp(';');
    END; (* putddcmd *)



  PROCEDURE putidcmd(cmd:  cmdstrtype;
	    	     i:  INTEGER;
      		     d:  REAL);
  (*------------------------------------------------------------------*)
  (*  Sends a command and an integer and a decimal parameter to the   *)
  (* HP plotter.						      *)
  (*------------------------------------------------------------------*)

    BEGIN (* putidcmd *)
      handshake(18);

      puthp(cmd[1]);		(* send command *)
      puthp(cmd[2]);

      putinum(i);		(* now the parameters *)
      puthp(',');
      putdnum(d);
      puthp(';');
    END; (* putidcmd *)



  PROCEDURE putiicmd(cmd:  cmdstrtype;
	    		 i1,
	    	         i2:  INTEGER);
  (*------------------------------------------------------------------*)
  (*  Sends a command and two integer parameters to the HP plotter.   *)
  (*------------------------------------------------------------------*)

    BEGIN (* putiicmd *)
      handshake(16);

      puthp(cmd[1]);		(* send command *)
      puthp(cmd[2]);

      putinum(i1);		(* now the parameters *)
      puthp(',');
      putinum(i2);
      puthp(';');
    END; (* putiicmd *)



  PROCEDURE putiiiicmd(cmd:  cmdstrtype;
	    	       i1,
	    	       i2,
	    	       i3,
	    	       i4:  INTEGER);
  (*------------------------------------------------------------------*)
  (*  Sends a command and four integer parameters to the HP plotter.  *)
  (*------------------------------------------------------------------*)

    BEGIN (* putiiiicmd *)
      handshake(30);

      puthp(cmd[1]);		(* send command *)
      puthp(cmd[2]);

      putinum(i1);		(* now the parameters *)
      puthp(',');
      putinum(i2);
      puthp(',');
      putinum(i3);
      puthp(',');
      putinum(i4);
      puthp(';');
    END; (* putiiiicmd *)



  PROCEDURE inithp;
  (*------------------------------------------------------------------*)
  (*  Sets up the HP plotter software handshake mode and the scaling. *)
  (*------------------------------------------------------------------*)

    BEGIN (* inithp *)
      puthpstr('IN;       ');	(* init the plotter *)

      puthp(chr(esccode));	(* shut off hardware handshake *)
      puthpstr('.@;0:     ');

      puthp(chr(esccode));	(* software handshake mode 1 *)
      puthpstr('.H        ');
      putinum(maxsent);
      puthpstr(';5;6:     ');	(* decimal equiv of enq and ack *)

      putiiiicmd('SC', 0, 10000, 0, 7200);  (* 40'ths of mm. *)
    END; (* inithp *)



  PROCEDURE penup;
  (*------------------------------------------------------------------*)
  (*  Sets the 'penlifted' indicator. The command is sent to the      *)
  (* plotter only if necessary by 'drawto'.			      *)
  (*------------------------------------------------------------------*)

    BEGIN (* penup *)
      penlifted := TRUE;
    END; (* penup *)



  PROCEDURE pendown;
  (*------------------------------------------------------------------*)
  (*  Sets the 'penlifted' indicator. The command is sent to the      *)
  (* plotter only if necessary by 'drawto'.			      *)
  (*------------------------------------------------------------------*)

    BEGIN (* pendown *)
      penlifted := FALSE;
    END; (* pendown *)



  PROCEDURE sethpplot(l:  alinetype;
      		      rptlen:  REAL;
      		      endsym:  aendtype);
  (*------------------------------------------------------------------*)
  (*  Sends the 'line type' command and sets the penup and pendown.   *)
  (*------------------------------------------------------------------*)

    VAR
      linetynum:  INTEGER;


    BEGIN (* sethpplot *)
      IF ((l = noline) AND (endsym = point)) OR (l <> noline)
	THEN
	  BEGIN
	    IF l = solid
	      THEN
		puthpstr('LT;       ')  (* set solid line or *)
	      ELSE
		BEGIN
		  CASE l OF	(* set pattern number *)
		    noline:        linetynum := 0;
		    dotted:        linetynum := 1;
		    dashed:        linetynum := 2;
		    dotdashed:     linetynum := 4;
		    dotdotdashed:  linetynum := 6;
		  END; (* CASE l *)
		  putidcmd('LT', linetynum, rptlen * percent);
		END; (* ELSE *)
	    pendown;		(* and lower pen *)
	  END (* IF ((l... *)
	ELSE
	  penup;		(* otherwise raise pen *)
    END; (* sethpplot *)



  PROCEDURE sethpstr(height,
      		     width,
      		     angle:  REAL);
  (*------------------------------------------------------------------*)
  (* Uses the 'SI' command to set the character size and the 'DI'     *)
  (* command to set the string angle.				      *)
  (*------------------------------------------------------------------*)

    BEGIN (* sethpstr *)
      putddcmd('SI', width / 10.0,    (* convert to cm. *)
      	             height / 10.0);
      putddcmd('DI', 100.0 * cos(angle / radian),  (* run *)
      		     100.0 * sin(angle / radian)); (* rise *)
    END; (* sethpstr *)



  PROCEDURE sethpwindow(left,
      			right:  apointtype);
  (*------------------------------------------------------------------*)
  (*  Sends the window size to the HP plotter.	This uses absolute    *)
  (* (not scaled) HP plotter units.				      *)
  (*------------------------------------------------------------------*)

    BEGIN (* sethpwindow *)
      putiiiicmd('IW', round((left.x * xfactor) + absp1x),  (* send to *)
      		       round((left.y * yfactor) + absp1y),  (* plotter *)
      		       round((right.x * xfactor) + absp1x),
      		       round((right.y * yfactor) + absp1y));
    END; (* sethpwindow *)



  FUNCTION isinwindow(pt:  apointtype):  BOOLEAN;
  (*------------------------------------------------------------------*)
  (*  Returns TRUE if the 'pt' is within the window defined by	      *)
  (* 'oldleft' and 'oldright'.					      *)
  (*------------------------------------------------------------------*)

    BEGIN (* isinwindow *)
      isinwindow := (pt.x <= oldright.x) AND (pt.y <= oldright.y) AND
      		    (pt.x >= oldleft.x) AND (pt.y >= oldleft.y);
    END; (* isinwindow *)



  PROCEDURE plot(dest:  apointtype);
  (*------------------------------------------------------------------*)
  (*  Plots a line from the present position to 'dest'.		      *)
  (*------------------------------------------------------------------*)



    PROCEDURE drawto(dest:  apointtype);
    (*----------------------------------------------------------------*)
    (*	Moves the pen to 'dest' with the pen specified by 'penlifted'.*)
    (*----------------------------------------------------------------*)

      BEGIN (* drawto *)
	IF penlifted AND (NOT oldpenlifted)
	  THEN
	    puthpstr('PU;       ')
	ELSE IF (NOT penlifted) AND oldpenlifted
	  THEN
	    puthpstr('PD;       ');
	oldpenlifted := penlifted;

	putiicmd('PA', round(dest.x * xfactor),
		       round(dest.y * yfactor));
	oldpt := dest;
      END; (* drawto *)



    PROCEDURE draw(what:  aendtype);
    (*----------------------------------------------------------------*)
    (*	Draws the endpoint symbol 'what' with size 'oldesize'         *)
    (* centered at the present position.   			      *)
    (*----------------------------------------------------------------*)

      VAR
	origin,			(* holds line endpoint *)
	temp:  apointtype;

	oldpenup:  BOOLEAN;	(* holds old penlifted *)



      PROCEDURE closed(initangle:  REAL;
		       npoints:  INTEGER);
      (*--------------------------------------------------------------*)
      (*  Plots a polygon of size 'oldesize' with 'npoints'           *)
      (* corners starting at 'initangle' degrees clockwise from       *)
      (* vertical centered at 'origin'.				      *)
      (*--------------------------------------------------------------*)

        VAR
	  i:  INTEGER;		(* corner counter *)

	  angle:  REAL;		(* angle counter *)


        BEGIN (* closed *)
	  FOR i := 0 to npoints DO
	    BEGIN
	      IF i = 0
	        THEN
		  penup
	      ELSE IF penlifted
	        THEN
		  pendown;
	      angle := (initangle + i * (360.0 / npoints)) / radian;
	      temp.x := origin.x + oldesize * sin(angle);
	      temp.y := origin.y + oldesize * cos(angle);
	      drawto(temp);
	    END; (* FOR i ... *)
        END; (* closed *)



      PROCEDURE open(initangle:  REAL);
      (*--------------------------------------------------------------*)
      (*  Plots a cross of size 'oldesize' with one axis at           *)
      (* 'initangle' clockwise from vertical centered at 'origin'.    *)
      (*--------------------------------------------------------------*)

        VAR
	  i,			(* loop counters *)
	  j:  INTEGER;

	  angle,		(* angle of a line segment *)
	  stangle:  REAL;	(* start angle of a line segment *)


	BEGIN (* open *)
	  FOR j := 0 TO 1 DO
	    BEGIN
	      stangle := initangle + j * 90.0;
	      FOR i := 0 TO 1 DO
		BEGIN
		  IF i = 0
		    THEN
		      penup
		    ELSE
		      pendown;
		  angle := (stangle + i * 180.0) / radian;
		  temp.x := origin.x + oldesize * sin(angle);
		  temp.y := origin.y + oldesize * cos(angle);
		  drawto(temp);
		END; (* FOR i ... *)
	    END; (* FOR j ... *)
	END; (* open *)



      BEGIN (* draw *)
	IF what IN [square, triangle, diamond, circle, cross, ecks]
	  THEN
	    BEGIN
	      origin := oldpt;	(* save endpoint *)
	      oldpenup := penlifted;	(* and pen status *)
	      IF oldline <> solid	(* set it to solid *)
		THEN
		  sethpplot(solid, 0.0, noend);
	      CASE what OF
		square:    closed(45.0, 4);
		triangle:  closed(0.0, 3);
		diamond:   closed(0.0, 4);
		circle:    closed(0.0, 10);
		cross:	 open(0.0);
		ecks:	 open(45.0);
	      END; (* CASE what *)

	      penup;			(* return to endpoint *)
	      drawto(origin);

	      IF oldline <> solid	(* restore line charact's *)
		THEN
		  sethpplot(oldline, oldrptlength, oldend);
	    END; (* IF what... *)
      END; (* draw *)



    BEGIN (* plot *)
      drawto(dest);
      draw(oldend);
    END; (* plot *)



  FUNCTION abadcall:  BOOLEAN;
  (*------------------------------------------------------------------*)
  (*  Returns TRUE if something is wrong with a procedure call.  Not  *)
  (* implemented.						      *)
  (*------------------------------------------------------------------*)

    BEGIN (* abadcall *)
      abadcall := FALSE;
    END; (* abadcall *)



  PROCEDURE adefault;
  (*------------------------------------------------------------------*)
  (*  Sets all globals to their default values.			      *)
  (*------------------------------------------------------------------*)

    BEGIN (* adefault *)
      oldline := noline;		(* simple line *)
      oldrptlength := 5.0;
      oldesize := 3.0;
      oldend := noend;
      sethpplot(oldline, oldrptlength, oldend);

      oldleft.x := minx;		(* window size to full screen *)
      oldleft.y := miny;
      oldright.x := maxx;
      oldright.y := maxy;
      sethpwindow(oldleft, oldright);

      sethpstr(2.70, 1.875, 0.0);	(* default character size *)
    END; (* adefault *)



  PROCEDURE agraph;
  (*------------------------------------------------------------------*)
  (*------------------------------------------------------------------*)

    BEGIN (* agraph *)
    END; (* agraph *)



  PROCEDURE ainit;
  (*------------------------------------------------------------------*)
  (*  Initializes the I/O to the HP plotter, and 		      *)
  (* sets all parameters to their default values, and places the pen  *)
  (* in the lower left-hand corner.				      *)  
  (*------------------------------------------------------------------*)

    BEGIN (* ainit *)
      inithp;
      adefault;
      agraph;
      oldpenlifted := TRUE;
      oldpt.x := minx;
      oldpt.y := miny;
      plot(oldpt);
      numsent := 0;
    END; (* ainit *)



  PROCEDURE amakecopy;
  (*------------------------------------------------------------------*)
  (*	This is not implemented - it could be used to indicate for    *)
  (* the paper to be changed by sending out DP;, then OS;'s till bit  *)
  (* 2 returned was a 1, then a DC;.  This would turn on the 'enter'  *)
  (* light on the plotter, wait until 'enter' was pushed (presumably  *)
  (* after the paper had been changed) by the operator, and then      *)
  (* extinguish the light and return.				      *)
  (*	See the HP plotter manual for more details.		      *)
  (*------------------------------------------------------------------*)

    BEGIN (* amakecopy *)
    END; (* amakecopy *)



  PROCEDURE aplot(endpoint:  apointtype);
  (*------------------------------------------------------------------*)
  (*  Plots to 'endpoint' using line type 'oldline' and end type      *)
  (* 'oldend'.							      *)
  (*------------------------------------------------------------------*)

    BEGIN (* aplot *)
      plot(endpoint);
    END; (* aplot *)



  PROCEDURE asetplot(line:  alinetype;
                     repeatlength,
		     endsize:  REAL;
		     endsymbol:  aendtype);
  (*------------------------------------------------------------------*)
  (*  Sets the characteristics of the line(s) to be plotted next.     *)
  (*------------------------------------------------------------------*)

    BEGIN (* asetplot *)
      sethpplot(line, repeatlength, endsymbol);

      oldline := line;		(* save the values *)
      oldrptlength := repeatlength;
      oldesize := endsize;
      oldend := endsymbol;
    END; (* asetplot *)



  PROCEDURE asetstr(charheight,
                    charwidth,
		    charangle,
		    charspace,
		    strangle:  REAL);
  (*------------------------------------------------------------------*)
  (*  Sets the characteristics of the next string(s) to be plotted.   *)
  (*  Doesn't implement the charspace or charangle settings since it  *)
  (* uses the standard plotter values.				      *)
  (*------------------------------------------------------------------*)

    BEGIN (* asetstr *)
      sethpstr(charheight, charwidth, strangle);
    END; (* asetstr *)



  PROCEDURE asetwindow(lowerleft,
                       upperright:  apointtype);
  (*------------------------------------------------------------------*)
  (*  Sets the window size.  Nothing will appear outside this window. *)
  (*------------------------------------------------------------------*)

    BEGIN (* asetwindow *)
      oldleft := lowerleft;	(* save the window value *)
      oldright := upperright;
      IF lowerleft.x < minx	(* make sure it's valid *)
	THEN
	  oldleft.x := minx;
      IF lowerleft.y < miny
	THEN
	  oldleft.y := miny;
      IF upperright.x > maxx
	THEN
	  upperright.x := maxx;
      IF upperright.y > maxy
	THEN
	  upperright.y := maxy;

      sethpwindow(oldleft, oldright);
    END; (* asetwindow *)



  PROCEDURE asize(VAR size:  apointtype);
  (*------------------------------------------------------------------*)
  (*  Returns the size of the display in mm.			      *)
  (*------------------------------------------------------------------*)

    BEGIN (* asize *)
      size.x := maxx - minx;
      size.y := maxy - miny;
    END; (* asize *)



  PROCEDURE astr(str:  astringtype);
  (*------------------------------------------------------------------*)
  (*  Writes the null-terminated string 'str' on the screen starting  *)
  (* at the current location (taken as the lower left corner of the   *)
  (* first character) and proceeding at 'strangle'.  The	      *)
  (* character angle, height, width and spacing is 'charangle',       *)
  (* 'charheight', 'charwidth' and 'charspace'.			      *)
  (* 								      *)
  (*  In this implementation, the HP 7225A mode of text writing is    *)
  (* used, so the standard spacing and character rotation (same as    *)
  (* line rotation) are used.					      *)
  (*------------------------------------------------------------------*)

    VAR
      index:  INTEGER;


    BEGIN (* astr *)
      handshake(136);	(* make sure there's enough room *)
      puthp('L');	(* send start of LB command *)
      puthp('B');

      index := 1;	(* put out characters *)
      WHILE ord(str[index]) <> nulcode DO
	BEGIN
	  puthp(str[index]);
	  index := index + 1;
	END; (* WHILE str... *)

      puthp(chr(etxcode));	(* and end of string code *)
      puthp(';');
    END; (* astr *)



  PROCEDURE atext;
  (*------------------------------------------------------------------*)
  (*  Sets the display to the text mode.			      *)
  (*------------------------------------------------------------------*)

    BEGIN (* atext *)
    END; (* atext *)



  PROCEDURE awhere(VAR where:  apointtype;
                   VAR inwindow:  BOOLEAN);
  (*------------------------------------------------------------------*)
  (*  Returns the current location and whether it's inside the        *)
  (* window.							      *)
  (*------------------------------------------------------------------*)

    BEGIN (* awhere *)
      where := oldpt;
      inwindow := isinwindow(oldpt);
    END; (* awhere *)
modend.