MODULE GRAPH ;
  (*------------------------------------------------------------------*)
  (*								      *)
  (*  Written Mar 22,'82   by Jack Gilmer			      *)
  (*								      *)
  (*  Modified Oct 23,'82   by J.A. Koehler from Whitesmiths PASCAL   *)
  (*      as used on LSI-11 to PASCAL MT+                             *)
  (*                                                                  *)
  (*  This file of absolute graphic routines implements the standard  *)
  (* graphics package for the Lear Seigler ADM 3A+ equipped with the  *)
  (* Graphx hard copy.  All positions are in mm. on a 170 by 130 mm.  *)
  (* page.  All angles are in degrees up from the x-axis.	      *)
  (*								      *)
  (*  NOTE - The ADM 3A+ emulates a Tektronix terminal and uses a     *)
  (* virtual screen size of 1024 by 780, and translates this to pixel *)
  (* co-ordinates of 512 by 250 internally.			      *)
  (*------------------------------------------------------------------*)

  CONST
    xfactor = 6.0532;	(* # of steps/mm on the Tektronix 1024 by *)
    yfactor = 6.0387;	(* 780 - ADM 3A+ translates to 512 by 250.*)

    nulcode = 0;	(* ASCII NUL *)
    eotcode = 4;	(* ASCII EOT *)
    enqcode = 5;	(* ASCII ENQ *)
    etbcode = 23;	(* ASCII ETB *)
    cancode = 24;	(* ASCII CAN *)
    emcode = 25;	(* ASCII EM *)
    esccode = 27;	(* ASCII ESC *)
    fscode = 28;	(* ASCII FS *)
    gscode = 29;	(* ASCII GS *)
    uscode = 31;	(* ASCII US *)

    maxsent = 20;	(* # of co-ord pairs sent before handshake *)

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

    absmaxx = 10000.0;	(* absolute calculation limits *)
    absmaxy = 10000.0;

    radian = 57.2958;	(* degrees/radian *)


  TYPE
    astringtype = STRING[132];      

    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;

    byte = 0..255;

      				   (* units for 'serio' routines *)
    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;

    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 *)



  EXTERNAL FUNCTION serin(unit:  unittype):  CHAR;  

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


  FUNCTION getadm:  byte;
  (*------------------------------------------------------------------*)
  (*  Gets a byte from the ADM 3A+ terminal port using 'serin'.	      *)
  (*------------------------------------------------------------------*)

    BEGIN (* getadm *)
      getadm := ORD(serin(admunit)) MOD 128;
    END; (* getadm *)



  PROCEDURE putadm(outbyte:  byte);
  (*------------------------------------------------------------------*)
  (*  Puts out 'outbyte' to the ADM 3A+ terminal port using 'serout'. *)
  (*------------------------------------------------------------------*)

    BEGIN (* putadm *)
      serout(admunit, CHR(outbyte));
    END; (* putadm *)



  PROCEDURE handshake;
  (*------------------------------------------------------------------*)
  (*  Handshakes with the ADM 3A+.				      *)
  (*------------------------------------------------------------------*)

    BEGIN (* handshake *)
      putadm(esccode);		(* ask for response *)
      putadm(enqcode);
      WHILE getadm <> eotcode DO; (* sent when ready *)
    END; (* handshake *)



  PROCEDURE penup;
  (*------------------------------------------------------------------*)
  (*  Simply sets the 'penlifted' indicator as 'drawto' takes care of *)
  (* the ADM 3A+ 'pen'.						      *)
  (*------------------------------------------------------------------*)

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



  PROCEDURE pendown;
  (*------------------------------------------------------------------*)
  (*  Simply sets the 'penlifted' indicator as 'drawto' takes care of *)
  (* the ADM 3A+ 'pen'.						      *)
  (*------------------------------------------------------------------*)

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



  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;
		 how:  alinetype;
		 endsym:  aendtype);
  (*------------------------------------------------------------------*)
  (*  Plots a line from the present position to 'dest' using the      *)
  (* pattern in 'how' and the end symbol in 'endsym'.  The line is    *)
  (* constrained to stay within the current window.		      *)
  (*------------------------------------------------------------------*)

      VAR
	previous,		(* pattern endpoints *)
	temp:  apointtype;

	i,			(* pattern loop counter *)
	number:  INTEGER;	(* # of patterns in line *)

	dx,			(* pattern repeat spacing *)
	dy,
	len:  REAL;		(* line length *)



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

      VAR
	temp:  apointtype;	(* window crossing points *)


      PROCEDURE plotpoint(at:  apointtype);
      (*--------------------------------------------------------------*)
      (*  Moves the pen to 'at'.				      *)
      (*--------------------------------------------------------------*)

	VAR
	  xint,			(* integer plotting values, *)
	  yint:  INTEGER;	(* between 0 and 779 or 1023 *)


	BEGIN (* plotpoint *)
	  xint := round(at.x * xfactor);
	  yint := round(at.y * yfactor);

	  putadm(((yint DIV 32) MOD 32) + 32);	(* ms 1/2 of y *)
	  putadm((yint MOD 32) + 96);		(* ls 1/2 of y *)
	  putadm(((xint DIV 32) MOD 32) + 32);	(* ms 1/2 of x *)
	  putadm((xint MOD 32) + 64);		(* ls 1/2 of x *)

	  numsent := numsent + 1;		(* need to handshake? *)
	  IF numsent > maxsent
	    THEN
	      BEGIN
		numsent := 0;
		handshake;
  		putadm(gscode);		(* re-draw to the point *)
		putadm(((yint DIV 32) MOD 32) + 32);	(* ms 1/2 of y *)
		putadm((yint MOD 32) + 96);		(* ls 1/2 of y *)
		putadm(((xint DIV 32) MOD 32) + 32);	(* ms 1/2 of x *)
		putadm((xint MOD 32) + 64);		(* ls 1/2 of x *)
	      END; (* IF numsent ... *)
	END; (* plotpoint *)


      PROCEDURE interpolate(inside,
			    outside:  apointtype;
			    VAR crossing:  apointtype);
      (*--------------------------------------------------------------*)
      (*  Finds the window crossing point on the line between 'inside'*)
      (* and 'outside'.  The result is returned in 'crossing'.	      *)
      (*--------------------------------------------------------------*)



	FUNCTION vertcross(left,
			   right:  apointtype;
			   midx:  REAL):  REAL;
        (*------------------------------------------------------------*)
	(*  Finds the vertical crossing point at 'midx' on the	      *)
	(* line between 'left' and 'right'.			      *)
        (*------------------------------------------------------------*)

	  BEGIN (* vertcross *)
	    vertcross := left.y + (right.y - left.y) *
	    		 (midx - left.x) / (right.x - left.x);
	  END; (* vertcross *)



	FUNCTION horcross(bottom,
			  top:  apointtype;
			  midy:  REAL):  REAL;
        (*------------------------------------------------------------*)
	(*  Finds the horizontal crossing point at 'midy' on the      *)
	(* line between 'bottom' and 'top'.			      *)
        (*------------------------------------------------------------*)

	  BEGIN (* horcross *)
	    horcross := bottom.x + (top.x - bottom.x) *
	    		 (midy - bottom.y) / (top.y - bottom.y);
	  END; (* horcross *)



	BEGIN (* interpolate *)
	  crossing.x := -1;	(* indicate crossing not found *)
	  crossing.y := -1;

	  IF outside.x < oldleft.x	(* is it to the left? *)
	    THEN
	      BEGIN
		crossing.x := oldleft.x;
		crossing.y := vertcross(outside, inside,
		  		     oldleft.x);
	      END (* IF outside ... *)
	  ELSE IF outside.x > oldright.x  (* or to the right? *)
	    THEN
	      BEGIN
		crossing.x := oldright.x;
		crossing.y := vertcross(inside, outside,
		  		     oldright.x);
	      END; (* ELSE IF outside.x ... *)

	  IF NOT isinwindow(crossing)	(* did we not find it yet? *)
	    THEN
	      IF outside.y < oldleft.y  (* is it below? *)
		THEN
		  BEGIN
		    crossing.y := oldleft.y;
		    crossing.x := horcross(outside, inside,
		  			 oldleft.y);
		  END (* IF outside ... *)
	      ELSE IF outside.y > oldright.y  (* or above? *)
		THEN
		  BEGIN
		    crossing.y := oldright.y;
		    crossing.x := horcross(inside, outside,
		  			 oldright.y);
		  END; (* ELSE IF outside.y ... *)
	END; (* interpolate *)



      BEGIN (* drawto *)

	IF penlifted
	  THEN
	    putadm(gscode);

	IF isinwindow(oldpt)
	  THEN
	    IF isinwindow(dest)
	      THEN
		plotpoint(dest)
	      ELSE
		BEGIN
		  interpolate(oldpt, dest, temp);
		  plotpoint(temp);
		END (* ELSE *)
	ELSE IF isinwindow(dest)
	  THEN
	    BEGIN
	      interpolate(dest, oldpt, temp);
	      putadm(gscode);
	      plotpoint(temp);
	      IF penlifted
		THEN
		  putadm(gscode);
	      plotpoint(dest);
	    END; (* ELSE IF ... *)
	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 <> noend
	  THEN
	    BEGIN
	      origin := oldpt;	(* save endpoint *)
	      oldpenup := penlifted;	(* and pen status *)
	      IF what IN [square, triangle, diamond, circle, cross, ecks]
		THEN
		  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 *)
	      ELSE IF what = point
		THEN
		  BEGIN
		    pendown;
		    putadm(fscode);	(* go to point mode *)
		    drawto(origin);	(* re-draw point *)
		  END; (* ELSE IF what ... *)

	      IF NOT penlifted	(* return to last endpoint *)
		THEN
		  penup;
	      drawto(origin);		(* also resets vector mode *)
	      IF NOT oldpenup
		THEN
		  pendown;
	    END; (* IF what... *)
      END; (* draw *)



    PROCEDURE pltpat(source,
		     dest:  apointtype);
    (*----------------------------------------------------------------*)
    (*  Plots the a line segment of the pattern 'how' from 'source'   *)
    (* to 'dest'.						        *)
    (*----------------------------------------------------------------*)

      VAR
	p1,			(* pattern fraction endpoints *)
	p2,
	p3:  apointtype;

	dx,			(* pattern fraction increment *)
	dy:  REAL;


      BEGIN (* pltpat *)
	CASE how OF
	  dotted:	    BEGIN
			      IF NOT penlifted
				THEN
				  penup;
			      drawto(dest);
			      draw(point);
			    END; (* dotted: *)
	  dashed:	    BEGIN
			      p1.x := (source.x + dest.x) / 2.0;
			      p1.y := (source.y + dest.y) / 2.0;
			      IF NOT penlifted
				THEN
				  penup;
			      drawto(p1);
			      pendown;
			      drawto(dest);
			    END; (* dashed: *)
	  dotdashed:	    BEGIN
			      dx := (dest.x - source.x) / 3.0;
			      dy := (dest.y - source.y) / 3.0;
			      p1.x := source.x + dx;
			      p2.x := p1.x + dx;
			      p1.y := source.y + dy;
			      p2.y := p1.y + dy;
			      IF NOT penlifted
				THEN
				  penup;
			      drawto(p1);
			      draw(point);
			      drawto(p2);
			      pendown;
			      drawto(dest);
			    END; (* dotdashed: *)
	  dotdotdashed:	    BEGIN
			      dx := (dest.x - source.x) / 4.0;
			      dy := (dest.y - source.y) / 4.0;
			      p1.x := source.x + dx;
			      p2.x := p1.x + dx;
			      p3.x := p2.x + dx;
			      p1.y := source.y + dy;
			      p2.y := p1.y + dy;
			      p3.y := p2.y + dy;
			      IF NOT penlifted
				THEN
				  penup;
			      drawto(p1);
			      draw(point);
			      drawto(p2);
			      draw(point);
			      drawto(p3);
			      pendown;
			      drawto(dest);
			    END; (* dotdotdashed: *)
	  END; (* CASE how *)
	END; (* pltpat *)



    BEGIN (* plot *)
      IF dest.x > absmaxx
	THEN
	  dest.x := absmaxx
      ELSE IF dest.x < (0 - absmaxx)
	THEN
	  dest.x := (0 - absmaxx);
      IF dest.y > absmaxy
	THEN
	  dest.y := absmaxy
      ELSE IF dest.y < (0 - absmaxy)
	THEN
	  dest.y := (0 - absmaxy);

      IF how IN [noline, solid]		(* segmenting not needed *)
	THEN
	  BEGIN
	    IF how = noline
	      THEN
		penup
	      ELSE
		pendown;
	    drawto(dest);
	  END (* IF how ... *)
	ELSE
	  BEGIN
	    len := sqr(oldpt.x - dest.x) + sqr(oldpt.y - dest.y);
	    IF len > 0.25		(* make sure won't bomb on *)
	      THEN			(* underflow *)
		len := sqrt(len)
	      ELSE
		len := 0;
	    number := 1 + trunc(len / oldrptlength);
	    dx := (dest.x - oldpt.x) / number;
	    dy := (dest.y - oldpt.y) / number;
	    previous := oldpt;
	    FOR i := 1 TO number DO
	      BEGIN
		temp.x := previous.x + dx;
		temp.y := previous.y + dy;
		pltpat(previous, temp);
		previous := temp;
	      END; (* FOR i ... *)
	  END; (* ELSE *)

      draw(endsym);
    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 *)
      oldend := noend;		(* simple line *)
      oldesize := 3.0;
      oldrptlength := 5.0;
      oldline := noline;
      oldleft.x := minx;		(* window size to full screen *)
      oldleft.y := miny;
      oldright.x := maxx;
      oldright.y := maxy;
    END; (* adefault *)



  PROCEDURE agraph;
  (*------------------------------------------------------------------*)
  (*  Sets the  ADM 3A+ into the vector graphics mode and clears the  *)
  (* screen. 							      *)
  (*------------------------------------------------------------------*)

    BEGIN (* agraph *)
      putadm(gscode);		(* enter vector mode *)
      putadm(emcode);		(* clear the screen *)
      handshake;
    END; (* agraph *)



  PROCEDURE ainit;
  (*------------------------------------------------------------------*)
  (*  Initializes the I/O to the ADM 3A+ terminal, the character set, *)
  (* sets all paramters to their default values, and places the pen   *)
  (* in the lower left-hand corner.				      *)  
  (*------------------------------------------------------------------*)

    BEGIN (* ainit *)
      adefault;
      agraph;
      oldpt.x := 0;
      oldpt.y := 0;
      numsent := 0;
      plot(oldpt, noline, noend);
    END; (* ainit *)



  PROCEDURE amakecopy;
  (*------------------------------------------------------------------*)
  (*  Initiates a copy cycle from the ADM 3A+ to the Graphx printer   *)
  (* and waits for it to finish.				      *)
  (*------------------------------------------------------------------*)

    BEGIN (* amakecopy *)
      putadm(esccode);		(* send copy command *)
      putadm(etbcode);
      handshake;
    END; (* amakecopy *)



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

    BEGIN (* aplot *)
      plot(endpoint, oldline, oldend);
    END; (* aplot *)



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

    BEGIN (* asetplot *)
      oldline := line;
      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.   *)
  (*------------------------------------------------------------------*)

    BEGIN (* asetstr *)		(* do nothing in this implementation *)
    END; (* asetstr *)



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

    BEGIN (* asetwindow *)
      oldleft := lowerleft;
      oldright := upperright;
      IF lowerleft.x < minx
	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;
    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 'oldstrangle'.  The	      *)
  (* character angle, height, width and spacing is 'oldchangle',      *)
  (* 'oldchheight', 'oldchwidth' and 'oldchspace'.		      *)
  (* 								      *)
  (*  In this implementation, the 4010 mode of text writing is        *)
  (* used, so only one size of upper case characters at a horizontal  *)
  (* direction is possible; all the above variables are ignored.      *)
  (*------------------------------------------------------------------*)

    VAR
      index:  INTEGER;


    BEGIN (* astr *)
      handshake;
      putadm(uscode);	(* enter 4010 alpha mode *)

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

      putadm(gscode);		   (* re-enter vector mode *)
      handshake;
    END; (* astr *)



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

    BEGIN (* atext *)
      putadm(uscode);		(* enter 4010 alpha mode *)
      putadm(cancode);		(* and then to ADM 3A alpha mode *)
    END; (* atext *)



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

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