IMPLEMENTATION MODULE PicADT;
  (*
  Sohail Aslam, 6/16/84
  *)

  FROM Tools IMPORT String, PutQStr, Putc, PutStr, Scopy, Ctoi,
                    Ctor  , Strlen , Strloc, FatalError , Warning,
                    Strcmp, NullString, MakeCString;
  FROM Lex   IMPORT TokenType, ShowKeyWord;
  FROM DIG   IMPORT
    (* TYPE *) GArrowHead, GLineType, GFontType, GJustType, GDeviceType,
               GColorType,
    (* VAR  *) GDevice   ,
    (* PROC *) GSlope, GInitDevice,
               GErase, GWindow, GMapWindow, GMove, GDraw,
               GBox, GCircle, GEllipse, GArc, GLine, GPolyLine, GArrow,
               GSpline, GSetLinePattern, GSetFont, GSetCharSize,
               GCharCellSize, GText, GSetColor;
  (* 
  System inports 
  *)
  FROM Storage IMPORT ALLOCATE, DEALLOCATE;
  FROM InOut IMPORT WriteLn   , WriteString    , WriteInt,WriteReal,
                    WriteCard ;
  FROM MathLib0 IMPORT sin, cos, sqrt;

  CONST
      MAXTEXT      = 5;     (* Number of text lines with each primitive *)
      MAXGUIDE     = 21;  (* Guide pts for splines *)
      MAXPICBLOCKS = 1;
      Inch         = 1.0; (* basic unit *)
      pi           = 3.1415; 

  TYPE
      (* coordinate type *)
      XYType = RECORD  
                   X : REAL;
                   Y : REAL
               END;

      DimSubRange      = [ arrowlen..rad ];
      DirSubRange      = [ up..upright ];
      LineType         = [ solid..invisible ];
      BasicElementType = [ box..spline ];
      ArrowHeadType    = [ RightArrow..TwoWayArrow ];
      ColorType        = [ black..white ];
      Annotation       = ARRAY[ 1..MAXTEXT ] OF String;

      PtrToPicElement  = POINTER TO ERecord;
      ERecord = RECORD
          PrevElement : PtrToPicElement; (* these two will link the chain *)
          NextElement : PtrToPicElement;
          Element     : TokenType;
          ELabel      : String;  (* Associated label, or alias *)
          Center      : XYType;  (* center for box,cicle,ellipse,labelled loc *)
          Start       : XYType;  (* Start for line,arc,arrow,spline *)
          Stop        : XYType;  (* Stop pt. for line,arc,arrow,spline *)
          Radius      : REAL;    (* Radius for circle,arc *)
          Head        : ArrowHeadType; (* for arrow,spline *)
          Color       : ColorType;
          Text        : Annotation; (* Text to be displayed with elt *)
          TextCount   : CARDINAL; (* how many lines of text *)
          TextHite    : REAL;
          TextWidth   : REAL;
          DisplayAs   : LineType;
          SaveDirection : DirSubRange; (* remember the def. dir. when this *)
                                       (* elt was created *)

          NextBP      : PtrToPicElement; (* These two would link together *)
          PrevBP      : PtrToPicElement; (* similar pic elements *)

          Hite      : REAL; (* these two are for boxes only *)
          Width     : REAL;

          MajAxis   : REAL; (* these two for ellipses only *)
          MinAxis   : REAL;

          Rotate    : [ acw..cw ]; (* For arcs only *)
          ArcGuide  : XYType;  (* intermediate pt to guide an arc *)

          Guide    : ARRAY [1..MAXGUIDE] OF XYType; (* for splines only *)
          GuideCount: CARDINAL
      END;  (* ERecord *)

  VAR
      DefDimRecord : RECORD
          ArrowLength : REAL;
          BoxHite     : REAL;
          BoxWidth    : REAL;
          CharHite    : REAL;
          CharWidth   : REAL;
          LineLength  : REAL;
          MajorAxis   : REAL;
          MinorAxis   : REAL;
          Radius      : REAL;
          Direction   : DirSubRange
      END;

      PicBlock : CARDINAL;
      PicChain : ARRAY[ 1..MAXPICBLOCKS ] OF
                     RECORD
                         Origin : XYType;
                         Ecount : CARDINAL;  (* number of elt's in chain *)
                         BlockLabel : String;
                         Root, 
                         Terminal : PtrToPicElement; (* start, end of chain *)
                         FirstBP, 
                         LastBP : ARRAY BasicElementType OF
                                               PtrToPicElement;
                 END;

      (* 
      pointer to current elt while it is dangling, i.e, not in chain
      *)
      CElt     : PtrToPicElement; 
      (* 
      Where the pen is, used as reference when a new element is generated 
      *)
      Cursor   : XYType;  
      LastCommand : (StartingOut, AMoveCommand, MadeAnElement );
      DirAngle : ARRAY DirSubRange OF REAL;
      DirToCompass : ARRAY DirSubRange OF CompSubRange;

(* ------------------------------------------------------------------------- *)
           (* A LOCAL MODULE *)
(* ------------------------------------------------------------------------- *)

(* This is local module set up to carry mulitpliers for compasspoints *)
MODULE Pcorners;

    IMPORT CompSubRange, INCompassSet, BugWrite;
    EXPORT Corner, CompOffsets;

    CONST 
        MAXCORNER = 13;
    TYPE
      CornerRec  = RECORD
                       h : REAL;
                       v : REAL
                   END;

      CornerType = ARRAY [1..MAXCORNER] OF CornerRec;

    VAR
      (* multipliers associated with compass points *)
      Corner : CornerType;


(* ------------------------------------------------------------------------- *)
PROCEDURE CompOffsets(
    Comp      : CompSubRange (* in *);
    VAR ch    : REAL         (* out *);
    VAR cv    : REAL         (* out *) );
    (*
    This procedure indexs Corner array for the multipliers associated
    with the compass point in "Comp".
    *)
    VAR
        J : [ 0.. MAXCORNER ];
        I : CompSubRange;
    BEGIN
        BugWrite("Entering CompOffsets ", 0.0 );
        IF INCompassSet( Comp ) THEN
            J := 0;
            FOR I := bottom TO west DO
                INC( J );
                IF I = Comp THEN
                    ch := Corner[ J ].h;
                    cv := Corner[ J ].v;
                    BugWrite("Leaving CompOffsets - return 1", ch );
                    RETURN
                 END
            END (* FOR *)
        ELSE
            ch := 0.0;
            cv := 0.0
        END;

        BugWrite("Leaving CompOffsets - return 2", 0.0 )
    END CompOffsets;

    BEGIN
    (* The following are multipliers to offsets for different compass
           points.
    *)
        Corner[ 1 ].h := 0.0 ; 
        Corner[ 1 ].v :=-1.0 ;
        Corner[ 2 ].h := 0.0 ;
        Corner[ 2 ].v := 0.0 ;
        Corner[ 3 ].h := 1.0 ; 
        Corner[ 3 ].v := 0.0 ;
        Corner[ 4 ].h := 0.0 ; 
        Corner[ 4 ].v := 0.0 ;
        Corner[ 5 ].h := 1.0 ; 
        Corner[ 5 ].v := 1.0 ;
        Corner[ 6 ].h := 0.0 ; 
        Corner[ 6 ].v := 1.0 ;
        Corner[ 7 ].h :=-1.0 ; 
        Corner[ 7 ].v := 1.0 ;
        Corner[ 8 ].h := 1.0 ; 
        Corner[ 8 ].v :=-1.0 ;
        Corner[ 9 ].h := 0.0 ; 
        Corner[ 9 ].v :=-1.0 ;
        Corner[ 10].h := 0.0 ; 
        Corner[ 10].v := 0.0 ;
        Corner[ 11].h :=-1.0 ; 
        Corner[ 11].v :=-1.0 ;
        Corner[ 12].h := 0.0 ; 
        Corner[ 12].v := 1.0 ;
        Corner[ 13].h :=-1.0 ; 
        Corner[ 13].v := 0.0 
END Pcorners;

(* ------------------------------------------------------------------------- *)
  PROCEDURE INDirSubSet( dir : TokenType (* in *) ) : BOOLEAN;
      (*
      returns true if dir is in [ up..upright ]
      *)
      VAR
          I : DirSubRange;
      BEGIN
          FOR I := up TO upright DO
              IF dir = I THEN
                  RETURN TRUE
              END
         END;
         RETURN FALSE
      END INDirSubSet;

(* ------------------------------------------------------------------------- *)
  PROCEDURE INDimSet( dim : TokenType (* in *) ) : BOOLEAN;
      (*
      returns true if dim is in [ arrowlen..rad ]
      *)
      VAR
          I : DimSubRange;
      BEGIN
          FOR I := arrowlen TO rad DO
              IF dim = I THEN
                  RETURN TRUE
              END
         END;
         RETURN FALSE
      END INDimSet;

(* ------------------------------------------------------------------------- *)
  PROCEDURE INColorSet( col : TokenType (* in *) ) : BOOLEAN;
      (*
      returns true if col is in [ black..white ]
      *)
      VAR
          I : ColorType;
      BEGIN
          FOR I := black TO white DO
              IF col = I THEN
                  RETURN TRUE
              END
         END;
         RETURN FALSE
      END INColorSet;

(* ------------------------------------------------------------------------- *)
  PROCEDURE INCompassSet( comp : TokenType (* in *) ) : BOOLEAN;
      (*
      returns true if comp  is in [ bottom..west ]
      *)
      VAR
          I : CompSubRange;
      BEGIN
          BugWrite("Entering InCompassSet ", 0.0 );
          IF PicADTDebug  THEN
              ShowKeyWord( comp )
          END;
          FOR I := bottom TO west DO
              IF comp = I THEN
                  BugWrite("Leaving InCompassSet - TRUE ", 0.0 );
                  RETURN TRUE
              END
         END;
         BugWrite("Leaving InCompassSet - FALSE ", 0.0 );
         RETURN FALSE
      END INCompassSet;

(* ------------------------------------------------------------------------- *)
  PROCEDURE INBPrimSet( bp : TokenType (* in *) ) : BOOLEAN;
      (*
      returns true if bp is in [ box..spline ]
      *)
      VAR
          I : BasicElementType;
      BEGIN
          FOR I := box TO spline DO
              IF bp = I THEN
                  RETURN TRUE
              END
         END;
         RETURN FALSE
      END INBPrimSet;

(* ------------------------------------------------------------------------- *)
  PROCEDURE BugWrite(
      msg   : ARRAY OF CHAR (* in *);
      rn    : REAL          (* in *));
  (*
  If the global variable "PicADTDebug" is true, this procedure writes out
  the "msg" followed by the real number "rn".
  *)
  BEGIN
      IF PicADTDebug THEN
          WriteString( "%PICADT-Debug," );
          WriteString( msg );
          WriteReal  ( rn,15 );
          WriteLn
      END
  END BugWrite;

(* ------------------------------------------------------------------------- *)
PROCEDURE SetDefDirection(
    Dir : TokenType (* in *) );
    (*
    By default, the pic elements will be generated along the direction
    specified by "Dir".
    *)
    VAR
        t : REAL;
    BEGIN
        BugWrite( "Entering SetDefDirection", 0.0 );

        IF INDirSubSet( Dir ) THEN
            DefDimRecord.Direction := Dir
        END;

        BugWrite( "Leaving SetDefDirection", 0.0 )

    END SetDefDirection;

(* ------------------------------------------------------------------------- *)
PROCEDURE SetDefDimension(
    Dim   : TokenType (* in *);
    Value : REAL      (* in *) );
    (*
    Set the value of the default dimension specified by "Dim" to
    "value"
    *)
    BEGIN
        BugWrite( "Entering SetDefDimension", 0.0 );

        IF Value <= 0.0 THEN
            BugWrite( "Leaving SetDefDimension - Abnormal", 0.0 );
            RETURN
        END;
        CASE Dim OF
                boxht  : DefDimRecord.BoxHite := Value |
                boxwid : DefDimRecord.BoxWidth := Value |
                cht    : DefDimRecord.CharHite := Value |
                cwid   : DefDimRecord.CharWidth := Value |
                linelen: DefDimRecord.LineLength := Value |
                majax  : DefDimRecord.MajorAxis := Value |
                minax  : DefDimRecord.MinorAxis := Value |
                rad    : DefDimRecord.Radius    := Value |
                arrowlen : DefDimRecord.ArrowLength := Value
                ELSE
                    Warning("Unknown default dimension" )
        END;  (* CASE *)
        BugWrite( "Leaving SetDefDimension", 0.0 )

    END SetDefDimension;

(* ------------------------------------------------------------------------- *)
PROCEDURE SetPicOrigin(
    X : REAL (* in *);
    Y : REAL (* in *) );
    (*
    The point of origin for PIC is recorded.
    *)
    BEGIN
        BugWrite( "Entering SetPicOrigin", 0.0 );
        WITH PicChain[PicBlock] DO
            Origin.X := X;
            Origin.Y := Y
        END;

        (* Now the cursor can be set *)
        Cursor.X := X;
        Cursor.Y := Y;

        BugWrite( "Leaving SetPicOrigin", 0.0 );

    END SetPicOrigin;

(* ------------------------------------------------------------------------- *)
PROCEDURE DefDimValue(
    DefDim : TokenType (* in *) ): REAL;
    (*
    THis FUNCTION returns the value of the specified Default Dimension
    e.g, circlerad, arrowlen, boxht etc.
    *)
    VAR
        retval : REAL;
    BEGIN
        BugWrite( "Entering DefDimValue", 0.0 );
        retval := 0.0;
        CASE DefDim OF
                boxht  : retval := DefDimRecord.BoxHite |
                boxwid : retval := DefDimRecord.BoxWidth |
                cht    : retval := DefDimRecord.CharHite |
                cwid   : retval := DefDimRecord.CharWidth |
                linelen: retval := DefDimRecord.LineLength |
                majax  : retval := DefDimRecord.MajorAxis |
                minax  : retval := DefDimRecord.MinorAxis |
                rad    : retval := DefDimRecord.Radius    |
                arrowlen : retval := DefDimRecord.ArrowLength 
                ELSE     retval := 0.0
       END;
       BugWrite( "Leaving DefDimValue - Value", retval );
       RETURN retval
    END DefDimValue;

(* ------------------------------------------------------------------------- *)
PROCEDURE FindElement(
    BasPrimitive : TokenType (* in *);
    PrimCount    : INTEGER   (* in *);
    VAR Found        : BOOLEAN   (* out *);
    VAR Enode        : PtrToPicElement (* out *) );
    (*
    This procedure looks ups "BasPrimitive" in the chain of picture
    elements of the same type as the "BasPrimitive". "PrimCount" indicates
    which one to target. Thus PrimCount = 4 and BasPrimitive = box means
    look up to see if there are 4 or more boxes in the chain of boxes so
    far specified in the PIC program commands. If there are, "Enode" is
    set to point to the fourth box and "Found" is set TRUE. A negative
    "PrimCount" means that the chain is to be searched starting at the last
    last basic primitive in the chain which would be the case for a construct
    like "fourth last box".
    *)
    VAR
        I : CARDINAL;
    BEGIN
        BugWrite( "Entering FindElement", 0.0 );

        Enode := NIL;
        Found := FALSE;
        IF NOT INBPrimSet( BasPrimitive ) THEN
            BugWrite( "Leaving FindElement - Abnormal", 0.0 );
            RETURN
        END;
    
        IF PrimCount > 0 THEN  (* go down from start *)
            Enode := PicChain[PicBlock].FirstBP[ BasPrimitive ];
            FOR I := 2 TO PrimCount DO
                IF Enode # NIL THEN
                    Enode := Enode^.NextBP
                END
            END;
            Found := Enode # NIL
        ELSIF PrimCount < 0 THEN
            Enode := PicChain[PicBlock].LastBP[ BasPrimitive ];
            FOR I := 2 TO ABS( PrimCount ) DO
                IF Enode # NIL THEN
                    Enode := Enode^.PrevBP
                END
            END;
            Found := Enode # NIL
        END;

        BugWrite( "Leaving FindElement", 0.0 );

    END FindElement;

(* ------------------------------------------------------------------------- *)
PROCEDURE CurElement( ) : PtrToPicElement;
    (*
    returns pointer to the current PIC element being processed. Every
    new PIC element becomes the current element until a new element
    is created.
    *)
    BEGIN
        BugWrite( "Entering CurElement", 0.0 );
        BugWrite( "Leaving CurElement", 0.0 );
        RETURN CElt
    END CurElement;

(* ------------------------------------------------------------------------- *)
PROCEDURE MakeNewCurrent( NewE : PtrToPicElement (* in *) );
    BEGIN
        CElt := NewE
    END MakeNewCurrent;
(* ------------------------------------------------------------------------- *)
PROCEDURE FreeCurrent( );
    BEGIN
        CElt := NIL
    END FreeCurrent;

(* ------------------------------------------------------------------------- *)
PROCEDURE GetCompassLoc(
        E : PtrToPicElement (* in *);
        Cp: CompSubRange    (* in *);
    VAR X     : REAL            (* out *);
    VAR Y     : REAL            (* out *) );
    (*
    This procedure returns the coordinates of the compass point specified
    by "Cp" of the picture element pointed to by "E".
    *)
    

(* ------------------------------------------------------------------------ *)
   (* following two proc are used by GetCompassLoc Only *)
    PROCEDURE BoxSite( Center : XYType (* in *);
                       Ht     : REAL   (* in *);
                       Wid    : REAL   (* in *);
                       Cp     : CompSubRange (* in *);
                       VAR X  : REAL (* out *);
                       VAR Y  : REAL (* out *)   );
        (*
        
        This procedure determines the coordinates of compass site of
        a box. Invoked by GetCompassLoc only.
        *)
        VAR
            hoffset, voffset : REAL;
            ch, cv           : REAL; (* multipliers of compass pt *)
        BEGIN
            BugWrite( "Entering BoxSite", 0.0 );
            IF INCompassSet( Cp ) THEN
                hoffset := Wid/2.0;
                voffset := Ht /2.0;
                BugWrite("Got h,voffset ", hoffset );
                BugWrite("Center .X ", Center.X );
                BugWrite("Center .Y ", Center.Y );
                CompOffsets( Cp, ch, cv );
                BugWrite("Corner .h ", ch );
                BugWrite("Corner .v ", cv );

                X := Center.X + ch*hoffset;
                Y := Center.Y + cv*voffset;

                BugWrite("Site is in compset ", X );
                BugWrite("                   ", Y )
            ELSE
                X := Center.X;    (* Default action for illegal compass pt *)
                Y := Center.Y
            END;
            BugWrite( "Leaving BoxSite", 0.0 );
        END BoxSite;
    
    PROCEDURE EllipseSite(
            Center : XYType (* in *);
            a      : REAL   (* in *);  (* majax/2 *)
            b      : REAL   (* in *);  (* minax/2 *)
            Cp   : CompSubRange (* in *);
        VAR X      : REAL   (* out *);
        VAR Y      : REAL   (* out *)  );
        (*
        This procedure determines coordinated of the compass site of an
        ellipse. Notice that this procedure would work for a circle too
        for which a=b=cirrad.
        *)
        VAR
            ho, vo : REAL;
            h , v  : REAL;
        BEGIN
            BugWrite( "Entering EllipseSite", 0.0 );
            IF ( Cp = ne ) OR ( Cp = nw )  OR
               ( Cp = se ) OR ( Cp = sw ) THEN
                ho := sqrt( a*a * b*b /( b*b + a*a ) );
                vo := ho
            ELSE
                ho := a;
                vo := b
            END;
        
            IF INCompassSet( Cp ) THEN
                CompOffsets( Cp, h, v );
                X := Center.X + h*ho;
                Y := Center.Y + v*vo
            ELSE
                X := Center.X;
                Y := Center.Y
            END;
            BugWrite( "Leaving EllipseSite", 0.0 )
        END EllipseSite;
    
    BEGIN (* GetCompassLoc *)
        BugWrite( "Entering GetCompassLoc", 0.0 );
        IF E = NIL THEN
            RETURN
        END;
        CASE E^.Element OF
            box : BoxSite( E^.Center, E^.Hite, E^.Width, Cp, X, Y )  |

            circle : EllipseSite( E^.Center, E^.Radius, E^.Radius, Cp,
                                  X, Y )                    |
                
            ellipse: EllipseSite( E^.Center, E^.MajAxis, E^.MinAxis, 
                                  Cp, X, Y )                    |
                
            line, arrow, arc, spline : 
                         X := E^.Stop.X;
                         Y := E^.Stop.Y;
                         IF Cp = start THEN
                             X := E^.Start.X;
                             Y := E^.Start.Y
                         END
            ELSE
                    X := E^.Center.X;  (* not a primitive, just a labelled *)
                    Y := E^.Center.Y   (* location *)
            END;
        BugWrite( "Leaving GetCompassLoc", 0.0 );
    END GetCompassLoc;

(* ------------------------------------------------------------------------- *)
PROCEDURE LabElement(
        Lab    : String          (* in  *);
    VAR Enode  : PtrToPicElement (* out *);
    VAR Found  : BOOLEAN         (* out *) );
    (*
    This procedure looks through the entire database of PIC elements to
    find an element or location that carries the label "Lab". If found,
    "Enode" is set to point to it and "Found" is set TRUE.
    *)
    BEGIN
        BugWrite( "Entering LabElement", 0.0 );
        Found := FALSE;
        Enode := PicChain[ PicBlock ].Root;
        WHILE ( Enode # NIL ) AND ( NOT Found ) DO
            IF Strcmp( Lab, Enode^.ELabel ) = 0 THEN
                Found := TRUE
            ELSE
               Enode := Enode^.NextElement
            END
        END;
        BugWrite( "Leaving LabElement", 0.0 );
    END LabElement;

(* -------------------------------------------------------------------------
   Folowing procedure set the attributes of the PIC elements.
*)

(* ------------------------------------------------------------------------- *)
PROCEDURE Setdashed(
    VAR Enode : PtrToPicElement (* in/out *) );
    (*
    The element pointed to by "Enode" is to be drawn with dashed lines.
    *)
    BEGIN
        BugWrite( "Entering Setdashed", 0.0 );
        IF Enode # NIL THEN
            Enode^.DisplayAs := dashed
        END;
        BugWrite( "Leaving Setdashed", 0.0 );
    END Setdashed;

(* ------------------------------------------------------------------------- *)
PROCEDURE Setdotted(
    VAR Enode : PtrToPicElement (* in/out *) );
    (*
    The element pointed to by "Enode" is to be drawn with dotted lines.
    *)
    BEGIN
        BugWrite( "Entering Setdotted", 0.0 );
        IF Enode # NIL THEN
            Enode^.DisplayAs := dotted
        END;
        BugWrite( "Leaving Setdotted", 0.0 );
    END Setdotted;

(* ------------------------------------------------------------------------- *)
PROCEDURE Setchop(
    VAR Enode   : PtrToPicElement (* in/out *);
        ChopAmt : REAL            (* in *)     );
    (*
    When drawing lines and arrows, chop the length by "ChopAmt".
    This would come in handy for fine tunning lines etc.
    Makes sense for lines and arrows only.
    *)
    VAR
        ang : REAL;
    BEGIN
        BugWrite( "Entering Setchop", 0.0 );
        IF Enode # NIL THEN
            ang := GSlope( Enode^.Start.X,Enode^.Start.Y,
                           Enode^.Stop.X,Enode^.Stop.Y );
            WITH Enode^ DO
                IF( Element = line ) OR ( Element = arrow ) THEN
                    Stop.X := Stop.X - ChopAmt*cos( ang );
                    Stop.Y := Stop.Y - ChopAmt*sin( ang )
                END
            END
        END;
        BugWrite( "Leaving Setchop", 0.0 );
    END Setchop;

(* ------------------------------------------------------------------------- *)
PROCEDURE Setinvisible(
    VAR Enode : PtrToPicElement (* in/out *) );
    (*
    The element pointed to by "Enode" is to be drawn with invisible lines.
    *)
    BEGIN
        BugWrite( "Entering Setinvisible", 0.0 );
        IF Enode # NIL THEN
            Enode^.DisplayAs := invisible
        END;
        BugWrite( "Leaving Setinvisible", 0.0 );
    END Setinvisible;

(* ------------------------------------------------------------------------- *)

PROCEDURE ResetCursor(
    OldE       : PtrToPicElement (* in *);
    CurE       : PtrToPicElement (* in *);
    CurEType   : TokenType (* in *);
    VAR Cursor : XYType    (* in/out *)  );
    (*
    If the dimensions of a circle, box or ellipse are changed, this    
    procedure relocates the cursor position to the point where the new    
    center of the object falls. It does so by first moving to the    
    boundary     of the last element in the pic chain     in the current
    default direction.     Once at the boundary, it looks at the     type of
    current element which is     passed in "CurEType". Using     the angle
    of current default direction and     the current dimensions    
    associated with the current element, it     determines and set the
    location     of the cursor.     If the last command,     stored in the
    global variable "LastCommand", happens     to be "StartingOut"     or
    "AMoveCommand", or the then the center of the     Last element happens
    to     none, then the current object     does not need to be relocated
    in which     case the coordinates of the center     are simply copied
    into "Cursor". 
    *)
    VAR
        off  : REAL;
        a, b : REAL;
        ddang: REAL;
        cdir : [ up..upright ];
        Bndry: XYType;
        Cp   : CompSubRange;
        hmul, vmul : REAL;
    BEGIN
        BugWrite( "Entering ResetCursor ", 0.0 );
        IF( LastCommand = StartingOut ) OR ( LastCommand = AMoveCommand ) 
          OR ( OldE = NIL ) THEN
            Cursor := CurE^.Center;
            BugWrite('Center used as cursor position ', 0.0 );
            BugWrite( "Leaving ResetCursor - return 1", 0.0 );
            RETURN
        END;
    
        (* Get coordinates of point on the boundary of the current
        element by calling GetCompassLoc.
        *)
        Cp := DirToCompass[DefDimRecord.Direction];
        GetCompassLoc( OldE, Cp, Bndry.X, Bndry.Y );
                       
        Cursor := Bndry ;   (* by default *)
        CompOffsets( Cp, hmul, vmul );
        IF INBPrimSet( CurEType ) THEN
            IF CurEType = box THEN
                Cursor.X := Cursor.X + CurE^.Width/2.0*hmul;
                Cursor.Y := Cursor.Y + CurE^.Hite/2.0*vmul
            ELSIF CurEType = circle THEN
                Cursor.X := Cursor.X + CurE^.Radius*hmul;
                Cursor.Y := Cursor.Y + CurE^.Radius*vmul
            ELSIF CurEType = ellipse THEN
                off  := CurE^.MajAxis;
                cdir := DefDimRecord.Direction;
                IF( cdir = upright ) OR ( cdir = upleft ) OR
                  ( cdir = downleft) OR ( cdir = downright ) THEN
                    a := CurE^.MajAxis;
                    b := CurE^.MinAxis;
                    off := sqrt( a*a*b*b / ( a*a + b*b ) )
                ELSIF( cdir = up ) OR ( cdir = down ) THEN
                    off := CurE^.MinAxis
                END;
                Cursor.X := Cursor.X + off*hmul;
                Cursor.Y := Cursor.Y + off*vmul
            END
        END;
        BugWrite( "Leaving ResetCursor ", 0.0 )
    END ResetCursor;

(* ------------------------------------------------------------------------- *)
PROCEDURE Setsame(
    VAR Enode : PtrToPicElement (* in/out *) );
    (*
    Use the same dimensions as the last pic element for the element pointed
    to by "Enode". Enode must be pointing to the current element.
    The last and this element better be of same type otherwise
    Default dimensions would be set for generating "Enode". Makes sense for
    boxes, ellispes and circles only.
    *)
    VAR
        p : PtrToPicElement;
    BEGIN
        BugWrite( "Entering Setsame", 0.0 );
        CASE Enode^.Element OF
            box : p := PicChain[ PicBlock ].LastBP[ box ];
                  IF p # NIL THEN
                      Enode^.Hite := p^.Hite;
                      Enode^.Width := p^.Width;
                      ResetCursor( PicChain[PicBlock].Terminal, Enode,
                                   Enode^.Element, Enode^.Center );
                      Enode^.DisplayAs := p^.DisplayAs
                  ELSE
                      Warning("No previous box for 'same' to reference")
                  END                               |
            circle : p := PicChain[ PicBlock ].LastBP[ circle ];
                  IF p # NIL THEN
                      Enode^.Radius := p^.Radius;
                      ResetCursor( PicChain[PicBlock].Terminal, Enode,
                                   Enode^.Element, Enode^.Center );
                      Enode^.DisplayAs := p^.DisplayAs
                  ELSE
                      Warning("No previous circle for 'same' to reference")
                  END                            |
            ellipse : p := PicChain[ PicBlock ].LastBP[ ellipse ];
                  IF p # NIL THEN
                      Enode^.MajAxis := p^.MajAxis;
                      Enode^.MinAxis := p^.MinAxis;
                      ResetCursor( PicChain[PicBlock].Terminal, Enode,
                                   Enode^.Element, Enode^.Center );
                      Enode^.DisplayAs := p^.DisplayAs
                  ELSE
                      Warning("No previous ellipse for 'same' to reference")
                  END
            ELSE
                Warning( 'Attribute "same" allowed with box, circle and ellipse only.' )
        END;
        BugWrite( "Leaving Setsame", 0.0 );
    END Setsame;
                
(* ------------------------------------------------------------------------- *)
PROCEDURE Setht(
    VAR Enode : PtrToPicElement (* in/out *);
        Value : REAL            (* in *)     );
    (*
    Sets the BOX ht to "Value", for other types of basic primitives, ht
    doesnot make sense.
    *)
    BEGIN
        BugWrite( "Entering Setht", 0.0 );
        IF Enode^.Element = box THEN
            IF Value > 0.0 THEN
                Enode^.Hite := Value;
                ResetCursor( PicChain[PicBlock].Terminal, Enode,
                             Enode^.Element, Enode^.Center );
            ELSE
                Warning('Value for box height is <= 0.0, attr. ignored' )
            END
        ELSE
            Warning('Attribute "ht" allowed for box only' )
        END;
        BugWrite( "Leaving Setht", 0.0 );
    END Setht;

(* ------------------------------------------------------------------------- *)
PROCEDURE Setwidth(
    VAR Enode : PtrToPicElement (* in/out *);
        Value : REAL            (* in *)     );
    (*
    Sets the BOX width to "Value", for other types of basic primitives, width
    doesnot make sense.
    *)
    BEGIN
        BugWrite( "Entering Setwidth", 0.0 );
        IF Enode^.Element = box THEN
            IF Value > 0.0 THEN
                Enode^.Width := Value;
                ResetCursor( PicChain[PicBlock].Terminal, Enode,
                             Enode^.Element, Enode^.Center );
            ELSE
                Warning('Value for box width is <= 0.0, attr. ignored' )
            END
        ELSE
            Warning('Attribute "wid" allowed for box only' )
        END;
        BugWrite( "Leaving Setwidth", 0.0 );
    END Setwidth;

(* ------------------------------------------------------------------------- *)
PROCEDURE SetRotation(
    VAR Enode : PtrToPicElement (* in/out *);
        wise  : TokenType       (* in *)     );
    (*
    For ARC only. Sets the rotation to clockwise or anticlockwise.
    *)
    BEGIN
        IF( Enode # NIL ) AND ( Enode^.Element = arc ) THEN
            IF( wise = cw ) OR ( wise = acw ) THEN
                Enode^.Rotate := wise
            END
        END
    END SetRotation;

(* ------------------------------------------------------------------------- *)
PROCEDURE Setrad(
    VAR Enode : PtrToPicElement (* in/out *);
        Value : REAL            (* in *)     );
    (*
    Sets CIRCLE and ARC radius to "Value", for other types of basic 
    primitives, radius doesnot make sense.
    *)
    BEGIN
        BugWrite( "Entering Setrad", 0.0 );
        IF ( Enode^.Element = circle ) OR ( Enode^.Element = arc ) THEN
            IF Value > 0.0 THEN
                Enode^.Radius := Value;
                IF Enode^.Element = circle THEN
                    ResetCursor( PicChain[PicBlock].Terminal, Enode,
                                 Enode^.Element, Enode^.Center )
                END
            ELSE
                Warning('Value for radius is <= 0.0, attr. ignored' )
            END
        ELSE
            Warning('Attribute "rad" allowed for circle and arc only' )
        END;
        BugWrite( "Leaving Setrad", 0.0 );
    END Setrad;

(* ------------------------------------------------------------------------- *)
PROCEDURE Setmajax(
    VAR Enode : PtrToPicElement (* in/out *);
        Value : REAL            (* in *)     );
    (*
    Sets ELLIPSE major axis to "Value", for other types of basic primitives,
    major axis doesnot make sense.
    *)
    BEGIN
        BugWrite( "Entering Setmajax", 0.0 );
        IF Enode^.Element = ellipse THEN
            IF Value > 0.0 THEN
                Enode^.MajAxis := Value;
                ResetCursor( PicChain[PicBlock].Terminal, Enode,
                             Enode^.Element, Enode^.Center );
            ELSE
                Warning('Value for Major Axis is <= 0.0, attr. ignored' )
            END
        ELSE
            Warning('Attribute "majax" allowed for ellipse only' )
        END;
        BugWrite( "Leaving Setmajax", 0.0 );
    END Setmajax;

(* ------------------------------------------------------------------------- *)
PROCEDURE Setminax(
    VAR Enode : PtrToPicElement (* in/out *);
        Value : REAL            (* in *)     );
    (*
    Sets ELLIPSE minor axis to "Value", for other types of basic primitives,
    minor axis doesnot make sense.
    *)
    BEGIN
        BugWrite( "Entering Setminax", 0.0 );
        IF Enode^.Element = ellipse THEN
            IF Value > 0.0 THEN
                Enode^.MinAxis := Value;
                ResetCursor( PicChain[PicBlock].Terminal, Enode,
                             Enode^.Element, Enode^.Center );
            ELSE
                Warning('Value for Minor Axis is <= 0.0, attr. ignored' )
            END
        ELSE
            Warning('Attribute "minax" allowed for ellipse only' )
        END;
        BugWrite( "Leaving Setminax", 0.0 );
    END Setminax;

(* ------------------------------------------------------------------------- *)
PROCEDURE Setfrom(
    VAR Enode : PtrToPicElement (* in/out *);
        X     : REAL            (* in *)    ;
        Y     : REAL            (* in *)     );
    (*
    For LINES, ARROWS, ARCS and SPLINES, whichever Enode points to, the
    point of origin is set to coordinates X,Y. For other primitives, this
    would not make any sense.
    If the element is LINE or ARROW, need to relocate the STOP point. This
    is done by determining the length of the LINE or ARROW and then using
    that as offset in the CURRENT DEFAULT DIRECTION to set the stop point.
    *)
    VAR
        dist, dd : REAL;
        p1, p2   : XYType;
    BEGIN
        BugWrite( "Entering Setfrom", 0.0 );
        IF( Enode^.Element = arc  ) OR ( Enode^.Element = spline ) THEN
            Enode^.Start.X := X;
            Enode^.Start.Y := Y
        ELSIF( Enode^.Element = line ) OR ( Enode^.Element = arrow ) THEN
            dd := DirAngle[ DefDimRecord.Direction ];
            p1 := Enode^.Start;
            p2 := Enode^.Stop;
            dist := (p2.Y-p1.Y)*(p2.Y-p1.Y) + (p2.X-p1.X)*(p2.X-p1.X) ;
            dist := sqrt( dist );
            WITH Enode^ DO
                Start.X := X;
                Start.Y := Y;
                Stop.X  := X + dist*cos( dd );
                Stop.Y  := Y + dist*sin( dd )
            END
        ELSE
            Warning('Attr. "from" allowed for line,arrow,arc and spline only')
        END;
        BugWrite( "Leaving Setfrom", 0.0 );
    END Setfrom;

(* ------------------------------------------------------------------------- *)
PROCEDURE Setto(
    VAR Enode : PtrToPicElement (* in/out *);
        X     : REAL            (* in *)    ;
        Y     : REAL            (* in *)     );
    (*
    For LINES, ARROWS, ARCS and SPLINES, whichever Enode points to, the
    point of destination is set to coordinates X,Y. For other primitives, this
    would not make any sense.
    *)
    BEGIN
        BugWrite( "Entering Setto", 0.0 );
        WITH Enode^ DO
            IF( Element = line ) OR ( Element = arrow ) OR
              ( Element = arc  ) THEN
                    Stop.X := X;
                    Stop.Y := Y
            ELSIF ( Element = spline ) THEN
                INC( GuideCount );
                IF GuideCount <= MAXGUIDE THEN
                    Guide[ GuideCount ].X := X;
                    Guide[ GuideCount ].Y := Y;
                    (* 
                    record x,y as STOP point also for cursor 
                    positioning 
                    *)
                    Stop.X := X;
                    Stop.Y := Y;
                ELSE
                     Warning("Too many guide points, this one ignored." );
                END;
            ELSE
                Warning('Attr. "to" allowed for line,arrow,arc and spline only')
            END
        END; (* WITH *)
        BugWrite( "Leaving Setto", 0.0 );
    END Setto;

(* ------------------------------------------------------------------------- *)
PROCEDURE Setat(
    VAR Enode : PtrToPicElement (* in/out *);
        X     : REAL            (* in *)    ;
        Y     : REAL            (* in *)     );
    (*
    For BOXES, CIRCLES, ELLIPSES, whichever Enode points to, the CENTER of
    primitive is set at coordinates (X,Y). For other primitives, this
    would not make any sense.
    *)
    BEGIN
        BugWrite( "Entering Setat ", 0.0 );
        IF( Enode^.Element = box ) OR ( Enode^.Element = circle ) OR
          ( Enode^.Element = ellipse )
            THEN
                Enode^.Center.X := X;
                Enode^.Center.Y := Y
        ELSE
            Warning('Attr. "at" affects position of box,circle and ellipse only')
        END;
        BugWrite( "Leaving Setat ", 0.0 );
    END Setat;

(* ------------------------------------------------------------------------- *)
PROCEDURE SetCompassat(
    VAR Enode : PtrToPicElement (* in/out *);
        Cp    : CompSubRange    (* in *)    ;
        X     : REAL            (* in *)    ;
        Y     : REAL            (* in *)     );
    (*
    For BOXES, CIRCLES, ELLIPSES, whichever Enode points to, the Compass point
    specified by "Cp" primitive is set at coordinates (X,Y). 
    Notice that this would make the CENTER of the object and all other compass
    points relocate. For other primitives, this would not make any sense.
    *)

    PROCEDURE PlaceBox(
            X : REAL;     (* in *)
            Y : REAL;     (* in *)
            Cp: CompSubRange ;(* in *)
            Hite : REAL;  (* in *)
            Width: REAL;  (* in *)
        VAR Center : XYType (* out *) );
        (*
        This procedure is called by "SetCompassat" only. Given the coordinates
        of a compass point of some other element in "X,Y", it determines and
        set the Center of the box.
        *)
        VAR
            ho, vo : REAL;
            h , v  : REAL;
        BEGIN
            BugWrite( "Entering PlaceBox ", 0.0 );
            ho := Width/2.0;
            vo := Hite /2.0;
            CompOffsets( Cp, h, v );
            Center.X := X - h*ho;
            Center.Y := Y - v*vo;
            BugWrite( "Leaving PlaceBox ", 0.0 );
        END PlaceBox;
    
    PROCEDURE PlaceEllipse(
            X : REAL; (* in *)
            Y : REAL; (* in *)
            Cp: CompSubRange; (* in *)
            a : REAL; (* in *)  (* half of major axis *)
            b : REAL; (* in *)  (* half of minor axis *)
        VAR Center : XYType (* out *) );
        (*
        This procedure is called by "SetCompassat" only. Given the coordinates
        of a compass point in "X,Y", the major and minor axis of the ellipse
        to relocate, this procedure sets the coordinates of the center.
        *)
        VAR
            ho, vo : REAL;
            h , v  : REAL;
        BEGIN
            BugWrite( "Entering PlaceEllipse ", 0.0 );
            IF( Cp = ne ) OR ( Cp = nw ) OR ( Cp = se ) OR ( Cp = sw ) THEN
                ho := sqrt( a*a*b*b/( b*b + a*a ) );
                vo := ho
            ELSE
                ho := a;
                vo := b
            END;
            CompOffsets( Cp, h, v );
            Center.X := X - h*ho;
            Center.Y := Y - v*vo;
            BugWrite( "Leaving PlaceEllipse ", 0.0 );
        END PlaceEllipse;
    
    BEGIN
        BugWrite( "Entering SetCompassat ", 0.0 );
        IF Enode # NIL THEN
            IF Enode^.Element = box THEN
                IF INCompassSet( Cp ) THEN
                    PlaceBox( X, Y, Cp, Enode^.Hite, Enode^.Width, 
                                        Enode^.Center )
                ELSE
                    Warning("Illegal compass point for placing new box")
                END
            ELSIF ( Enode^.Element = circle ) OR 
                  ( Enode^.Element = ellipse ) THEN
                IF INCompassSet( Cp ) THEN
                    IF Enode^.Element = circle THEN
                        PlaceEllipse( X, Y, Cp, Enode^.Radius, 
                             Enode^.Radius, Enode^.Center )
                    ELSE
                        PlaceEllipse( X, Y, Cp, Enode^.MajAxis,
                             Enode^.MinAxis, Enode^.Center )
                    END
                ELSE
                    Warning("Illegal compass point for placing circle or ellipse")
                END
            ELSE
                Warning("Only box,circle and ellipse can be placed at compass points")
            END
        END;
        BugWrite( "Leaving SetCompassat ", 0.0 );
    END SetCompassat;


(* ------------------------------------------------------------------------- *)
PROCEDURE MoveThisWay(
    VAR Enode    : PtrToPicElement (* in/out *);
        WhichWay : TokenType       (* in *);
        dist     : REAL            (* in *);
        X        : REAL            (* in *);
        Y        : REAL            (* in *)  );
    (*
    For LINES and ARROWS, whichever Enode points to, the DIRECTION of motion
    is set to "WhichWay" which would be right, left, up, down, downright etc.
    Notice that setting the direction of motion would affect the destination.
    If the previous destination was in a different direction, the new destin-
    ation will be computed and the LENGTH of the arrow or line will set to the
    the distance "dist" or the default length if dist=0.
    For SPLINES, the point "dist" away in the direction "whichway" would
    become one of the GUIDEPOINTS.
        The motion id the direction "whichway" could be followed by the starting
    point, e.g "arrow up from top of last box", in which case the start would
    be set to what "X,Y" contains. Negative X will indicate that
    the start point was not specified.
        For other primitives, this would not make any sense.
    *)
    VAR
       ho, vo : REAL;
       ref    : XYType;
    BEGIN
       BugWrite( "Entering MoveThisWay ", 0.0 );
       IF Enode = NIL THEN
           BugWrite( "Leaving MoveThisWay - Abnormal ", 0.0 );
           RETURN
       END;

       IF dist = 0.0 THEN
           IF Enode^.Element = line THEN
               dist := DefDimRecord.LineLength
           ELSE  (* arrow or spline *)
               dist := DefDimRecord.ArrowLength
           END
       END;

       ho := dist*cos( DirAngle[ WhichWay ] );
       vo := dist*sin( DirAngle[ WhichWay ] );
               
       IF( Enode^.Element = line ) OR ( Enode^.Element = arrow ) THEN
           IF X >= 0.0 THEN
               Enode^.Start.X := X;
               Enode^.Start.Y := Y;
           END;
           Enode^.Stop.X := Enode^.Start.X + ho;
           Enode^.Stop.Y := Enode^.Start.Y + vo
       ELSIF Enode^.Element = spline THEN
               (* first set the start at X,Y if specified *)
               IF X >= 0.0 THEN
                   Enode^.Start.X := X;
                   Enode^.Start.Y := Y;
               END;
               (* 
               a new guide point. Notice that the last guide point will
               be used as the reference point for setting this guide
               points location. If no previuos guide, then use start of
               spline.
               *)
               IF Enode^.GuideCount = 0 THEN
                   ref.X := Enode^.Start.X;  
                   ref.Y := Enode^.Start.Y   
               ELSE
                   ref.X := Enode^.Guide[Enode^.GuideCount].X;
                   ref.Y := Enode^.Guide[Enode^.GuideCount].Y
               END;
               IF Enode^.GuideCount < MAXGUIDE THEN
                   INC( Enode^.GuideCount );
                   Enode^.Guide[ Enode^.GuideCount ].X := ref.X + ho;
                   Enode^.Guide[ Enode^.GuideCount ].Y := ref.Y + vo;
                   (* set the stop at this last guide *)
                   Enode^.Stop.X := ref.X + ho;
                   Enode^.Stop.Y := ref.Y + vo;
               ELSE
                   Warning("Too many guide points for spline, this one ignored" )
               END
       END;
       BugWrite( "Leaving MoveThisWay ", 0.0 );
    END MoveThisWay;


(* ------------------------------------------------------------------------- *)
PROCEDURE SetArrowType(
    VAR Enode     : PtrToPicElement (* in/out *);
        WhichType : TokenType       (* in *)     );
    (*
    WhichType can be LeftArrow, RightArrow or TwoWayArrow. The type of arrow
    is recorded. This attribute makes sense for ARROW, SPLINE and ARC only.
    *)
    BEGIN
        BugWrite( "Entering SetArrowType ", 0.0 );
        IF Enode # NIL THEN
            WITH Enode^ DO
                IF( Element = arrow ) OR ( Element = spline ) OR
                  ( Element = arc ) THEN
                    IF (WhichType = LeftArrow ) OR (WhichType = RightArrow ) 
                       OR (WhichType = TwoWayArrow )  THEN
                        Head := WhichType
                    ELSE
                        Warning("Illegal arrow head")
                    END
                ELSE
                    Warning("Arrowhead makes sense for arrows, arcs and splines only")
                END
            END
        END;
        BugWrite( "Leaving SetArrowType ", 0.0 );
     END SetArrowType;

(* ------------------------------------------------------------------------- *)
PROCEDURE SetColor(
    VAR Enode : PtrToPicElement (* in/out *);
        EColor: TokenType       (* in *)     );
    (*
    Set the color with shich the elment will be drawn.
    Colors can be black, red, cyan, magenta, green, blue, orange, yellow,
    white.
    *)
    BEGIN
        Enode^.Color := EColor
    END SetColor;

(* ------------------------------------------------------------------------- *)
PROCEDURE SetText(
    VAR Enode      : PtrToPicElement (* in/out *);
        TextString : String (* in *)         );
    (*
    If number of text strings for the primitives has not been exceeded, this
    text string will be associated for later display with the PIC element
    pointed to by ENode.
    *)
    BEGIN
        BugWrite( "Entering SetText ", 0.0 );
        IF( Enode # NIL ) AND ( Enode^.TextCount < MAXTEXT ) THEN
            IF INBPrimSet( Enode^.Element ) THEN
                INC( Enode^.TextCount );
                Scopy( TextString, 1, Enode^.Text[ Enode^.TextCount ], 1 )
            END
        ELSE
            Warning("Too many lines of text, this one ignored " )
        END;
        BugWrite( "Leaving SetText ", 0.0 );
    END SetText;

(* ------------------------------------------------------------------------- *)
PROCEDURE SetLocation(
    VAR Enode : PtrToPicElement (* in/out *);
        X     : REAL            (* in *)    ;
        Y     : REAL            (* in *)     );
    (*
    This procedure will set the coordinates of the CENTER of primitive
    pointed to by Enode to take on the values (X,Y). This would probably
    be used to associate coordinates with a LABEL.
    *)
    BEGIN
        BugWrite( "Entering SetLocation ", 0.0 );
        IF Enode # NIL THEN
            WITH Enode^ DO
                IF INBPrimSet( Element ) THEN
                    IF( Element = box ) OR ( Element = circle ) OR
                      ( Element = ellipse ) THEN
                        Center.X := X;
                        Center.Y := Y
                    ELSE
                        Warning("Attr. good for box,circle,ellipse only")
                    END
                ELSE
                    (* A labelled location to carry coordinates *)
                    Center.X := X;
                    Center.Y := Y
                END
            END
        END;
        BugWrite( "Leaving SetLocation ", 0.0 );
    END SetLocation;
(* ------------------------------------------------------------------------- *)
PROCEDURE HandleArc( VAR Enode : PtrToPicElement (* in/out *) );
    (*
    If the Enode is an arc, we need to set the radius and end points.
    If radius is still negative, make it positive. Notice that the neg.
    radius value would be whatever the Default radius was when the arc
    was created. If the Default has since been changed, we can still 
    get the old one just by making the radius positive. If radius is 
    positive then the user specified one. If stop=start then we need 
    to set the end point, otherwise the user has specified end points. 
    In the cases above, a standard 90 degree arc is called for. This
    procedure sets the ArcGuide point and the Stop point.
    if stop#start and radius is negative then the end point has been
    specified. In this case the guide point is set at the intersection
    of two lines emerging from the start and stop at an angle "alpha".
    *)

    PROCEDURE RotPt(
        VAR pt    : XYType;         (* in/out *)
            rot   : REAL            (* in     *)   );
        (*
        This procedure is invoked locally for arcs only. It is used to
        rotate the guidept and the stoppt for standard arcs thru the
        angle indicated by "rot".
        *)
        VAR
            c, s : REAL;
            oldpt: XYType;
        BEGIN
            c := cos( rot );
            s := sin( rot );
            oldpt := pt;    (* save orignal coordinates *)
            pt.X :=  oldpt.X*c - oldpt.Y*s ;
            pt.Y :=  oldpt.X*s + oldpt.Y*c 
        END RotPt;
    
    VAR
        r, rs, rc : REAL;
        pt        : XYType;
        alpha, theta, beta : REAL;
    BEGIN (* HandleArc *)
        IF( Enode^.Start.X = Enode^.Stop.X ) AND 
          ( Enode^.Start.Y = Enode^.Stop.Y ) THEN
            IF Enode^.Radius < 0.0 THEN
                Enode^.Radius := - Enode^.Radius
            END;
            (*
            a standard 90 degree arc. Need to set the guide and
            stop points and then rotate the arc in the direction
            that was on when the arc was created. The arc is envisioned
            as connecting the diagonal ends of a square of side
            ArcRadius.
            *)
            r := Enode^.Radius;
            theta := DirAngle[ Enode^.SaveDirection ];
            pt.X  := r;
            pt.Y  := r;
            RotPt( pt, theta );
            WITH Enode^ DO
                Stop.X := Start.X + pt.X;
                Stop.Y := Start.Y + pt.Y
            END;
            rs     := r/sqrt( 2.0 );   (* rsin(45) *)
            rc     := rs;              (* rcos(45) *)
            WITH Enode^ DO
                IF Rotate = acw THEN
                    pt.X  := rs;
                    pt.Y  := ( r - rc );
                    RotPt( pt, theta )
                ELSE
                    pt.X  := ( r - rc );
                    pt.Y  :=  rs;
                    RotPt( pt, theta )
                END;
                ArcGuide.X := Start.X + pt.X;
                ArcGuide.Y := Start.Y + pt.Y
            END
        ELSE (* non standard arc. Stop has been specified. Need to
                set the guide point.
             *)
            theta := GSlope( Enode^.Start.X,Enode^.Start.Y,
                             Enode^.Stop.X,Enode^.Stop.Y );
            alpha := pi/8.0;

            (* distance between start and stop points *)
            r := sqrt( ( Enode^.Stop.Y - Enode^.Start.Y )*
                       ( Enode^.Stop.Y - Enode^.Start.Y ) +
                       ( Enode^.Stop.X - Enode^.Start.X )*
                       ( Enode^.Stop.X - Enode^.Start.X )
                      );
            r := r*0.5; 
            r := r/ cos( alpha );
            beta := theta + alpha;
            IF Enode^.Rotate = acw THEN
                beta := theta - alpha
            END;
            pt.X := r*cos( beta );
            pt.Y := r*sin( beta );
            WITH Enode^ DO
                ArcGuide.X := Start.X + pt.X;
                ArcGuide.Y := Start.Y + pt.Y
            END
        END (* IF ELSE *)
    END HandleArc;

(* ------------------------------------------------------------------------- *)
PROCEDURE MoveToLocation(
    X   : REAL (* in *);
    Y   : REAL (* in *) );
    (*
    The current cursor, or pen location ( most probably the center of
    a primitive ) will be set to (X,Y). The next primitive generated will
    use this location as reference to determine its location.
    *)
    VAR
        CurE : PtrToPicElement;
    BEGIN
        BugWrite( "Entering MoveToLocation ", 0.0 );
        Cursor.X := X;
        Cursor.Y := Y;
        LastCommand := AMoveCommand;

        CurE := CurElement( );
        (*
        If current elt is an ARC, need to do some work on it before 
        chaining
        *)
        IF( CurE # NIL ) AND ( CurE^.Element = arc ) THEN
            HandleArc( CurE )
        END;

        IF CurE # NIL THEN
            ChainCurrentElement( )
        END;
        BugWrite( "Leaving MoveToLocation ", 0.0 );
    END MoveToLocation;

(* ------------------------------------------------------------------------- *)
PROCEDURE ChainCurrentElement( );
    (*
    This procedure inserts the current element into the chain of
    pic elements. It sets all the pointers. The very first elements
    is treated as a special case. The Current element pointer CElt
    is NILed before returning.
    *)
    VAR
        NewE, LastE : PtrToPicElement;
        Cbp         : BasicElementType;
    BEGIN
        BugWrite( "Entering ChainCurrentElement ", 0.0 );
        NewE := CurElement( );
        IF NewE = NIL THEN
            RETURN       (* no current element, this could occur *)
        END;             (* if a move cmd is followed by another move *)
    
        IF PicChain[PicBlock].Root = NIL THEN   (* the very first element *)
            PicChain[PicBlock].Ecount := 1;
            PicChain[PicBlock].Root   := NewE;
            PicChain[PicBlock].Terminal := NewE;
            
            (* now the links of the chain *)
            NewE^.NextElement := NIL;
            NewE^.PrevElement := NIL;
            
            (* Set pointers to chain of individual element types *)
            Cbp := NewE^.Element;
            IF INBPrimSet( Cbp ) THEN
                PicChain[PicBlock].FirstBP[ Cbp ] := NewE;
                PicChain[PicBlock].LastBP [ Cbp ] := NewE
            END;
            FreeCurrent( );
            BugWrite('The very 1st element chained ', 0.0 )
        ELSE
            INC( PicChain[PicBlock].Ecount );
            LastE    := PicChain[PicBlock].Terminal; (* remember the last element *)
            PicChain[PicBlock].Terminal := NewE;   (* The new tail *)

            LastE^.NextElement := NewE;
            NewE^.PrevElement  := LastE;
            NewE^.NextElement  := NIL;
            
            (* set up links for individual elements if Current element
               is one of the basic primitives
            *)
            Cbp := NewE^.Element;
            IF INBPrimSet( Cbp ) THEN
                (* 
                determine if there have already been elements of
                this type. If so, set the links, otherwise init
                previously NILed Links
                *)
                IF PicChain[PicBlock].LastBP[ Cbp ] # NIL THEN
                    LastE := PicChain[PicBlock].LastBP[ Cbp ];
                    LastE^.NextBP := NewE; (* a new member of similar elt *)
                    NewE^.PrevBP  := LastE;
                    PicChain[PicBlock].LastBP[ Cbp ] := NewE
                ELSE
                    PicChain[PicBlock].FirstBP[ Cbp ] := NewE;
                    PicChain[PicBlock].LastBP [ Cbp ] := NewE
                END
            END;

            FreeCurrent( );
            BugWrite('Current element chained', 0.0 )
        END;
        BugWrite( "Leaving ChainCurrentElement ", 0.0 );
    END ChainCurrentElement;

(* ------------------------------------------------------------------------- *)
PROCEDURE CreateEnode(
    EType          : TokenType (* in *);
    LabelText      : String  (* in *) ): PtrToPicElement;
    (*
    This procedure creates a new entry for the element specified by
    EType which can be one of the basic element types or a "Label" in
    which case the element is simply a labelled location. After the
    element node is created, the label text is recorded if the elemnt
    was preceded by a label in the original PIC command. Then all
    the dimensions are set to default depending on what type of
    an element this is. For example, for a box, the ht and width
    would be set to default. The origin will be set according to
    the current default direction of movement and the current location
    of the cursor or pen. A pointer to this newly created node is returned
    as the function value.
    *)

 
    PROCEDURE XYCopy(
             in : XYType (* in *);
        VAR out : XYType (* out *) );
        (*
        Copy coordinate fields of "in" to "out"
        *)
        BEGIN
            out := in
        END XYCopy;
    
    PROCEDURE SetCursor(
        CurE       : PtrToPicElement (* in *);
        NewEType   : TokenType (* in *);
        VAR Cursor : XYType    (* in/out *)  );
        (*
        This procedure does the main task of determining and setting the
        cursor location for the newly created element. It does so
        by first moving to the boundary of the current element ( which would
        be chained AFTER this procedure has done its job ) in the current
        default direction. Once at the boundary, it looks at the type of
        the newly created element ("NewE" points to the new element ). Using
        the angle of current default direction and the default dimensions
        associated with the new element, it determines and set the location
        of the cursor.
        If this is the very first element, or the user used a move command,
        current element would not be there, i.e, CurE will end up being NIL
        when CurElement() is called. In this case the current cursor position
        will be returned.
        *)
        VAR
            off  : REAL;
            a, b : REAL;
            hmul, vmul : REAL;
            Cp   : CompSubRange;
            cdir : [ up..upright ];
            Bndry: XYType;
        BEGIN
            BugWrite( "Entering SetCursor ", 0.0 );
            IF CurE = NIL THEN
                BugWrite('Current cursor position used', 0.0 );
                BugWrite( "Leaving SetCursor ", 0.0 );
                RETURN
            END;
        
            (* Get coordinates of point on the boundary of the current
            element by calling GetCompassLoc.
            *)
            Cp := DirToCompass[DefDimRecord.Direction];
            GetCompassLoc( CurE, Cp, Bndry.X, Bndry.Y );
            XYCopy( Bndry,Cursor );   (* by default *)

            CompOffsets( Cp, hmul, vmul );
            IF INBPrimSet( NewEType ) THEN
                IF NewEType = box THEN
                    Cursor.X := Cursor.X + DefDimRecord.BoxWidth*0.5*hmul;
                    Cursor.Y := Cursor.Y + DefDimRecord.BoxHite*0.5*vmul
                ELSIF NewEType = circle THEN
                    Cursor.X := Cursor.X + DefDimRecord.Radius*hmul;
                    Cursor.Y := Cursor.Y + DefDimRecord.Radius*vmul
                ELSIF NewEType = ellipse THEN
                    off := DefDimRecord.MajorAxis;
                    cdir := DefDimRecord.Direction;
                    IF( cdir = upright ) OR ( cdir = upleft ) OR
                      ( cdir = downleft) OR ( cdir = downright ) THEN
                        a := DefDimRecord.MajorAxis;
                        b := DefDimRecord.MinorAxis;
                        off := sqrt( a*a*b*b / ( a*a + b*b ) )
                    ELSIF( cdir = up ) OR ( cdir = down ) THEN
                        off := DefDimRecord.MinorAxis
                    END;
                    Cursor.X := Cursor.X + off*hmul;
                    Cursor.Y := Cursor.Y + off*vmul
                END
            END;
            BugWrite( "Leaving SetCursor ", 0.0 )
        END SetCursor;
   
    PROCEDURE DefineDimensions(
        VAR E : PtrToPicElement (* in/out *);
            EType : TokenType (* in *);
            Cursor: XYType (* in *) );
        (*
        This procedure sets the location and dimensions of the new element.
        *)
        VAR
            ddang : REAL;
        BEGIN
            BugWrite( "Entering DefineDimensions ", 0.0 );
            ddang := DirAngle[ DefDimRecord.Direction ];
            CASE EType OF
                line : XYCopy( Cursor, E^.Start );
                     WITH E^ DO
                         Stop.X := Start.X + DefDimRecord.LineLength*cos(ddang);
                         Stop.Y := Start.Y + DefDimRecord.LineLength*sin(ddang)
                     END                                      |

                arrow : XYCopy( Cursor, E^.Start );
                     WITH E^ DO
                         Head := RightArrow;
                         Stop.X := Start.X + DefDimRecord.ArrowLength*cos(ddang);
                         Stop.Y := Start.Y + DefDimRecord.ArrowLength*sin(ddang)
                     END                                      |

                arc   : XYCopy( Cursor, E^.Start );
                     (* Set the radius < 0 and stop=start. When this elt is *)
                     (* chained, we will look at this. If radius is still <0 *)
                     (* then the user didnot specify radius. If stop=start  *)
                     (* user did not specify end location. *)
                     WITH E^ DO
                         Rotate := acw;
                         Radius := - DefDimRecord.Radius;
                         Stop.X := Start.X;
                         Stop.Y := Start.Y
                     END                                      |

                spline : XYCopy( Cursor, E^.Start );
                     WITH E^ DO
                         GuideCount := 0;
                         Stop.X := Start.X;
                         Stop.Y := Start.Y;
                     END                                      |

                box   : XYCopy( Cursor, E^.Center );
                       E^.Hite  := DefDimRecord.BoxHite;
                       E^.Width := DefDimRecord.BoxWidth      |

                circle : XYCopy( Cursor, E^.Center );
                       E^.Radius := DefDimRecord.Radius      |

                ellipse : XYCopy( Cursor, E^.Center );
                       E^.MajAxis:= DefDimRecord.MajorAxis;
                       E^.MinAxis:= DefDimRecord.MinorAxis
                ELSE
                     XYCopy( Cursor, E^.Center )
            END;
            BugWrite( "Leaving DefineDimensions ", 0.0 )
        END DefineDimensions;
    
    VAR
        CurE, NewE : PtrToPicElement;
    BEGIN
        BugWrite( "Entering CreateEnode ", 0.0 );
        CurE := CurElement( );
        (*
        If current elt is an ARC, need to do some work on it before 
        chaining
        *)
        IF( CurE # NIL ) AND ( CurE^.Element = arc ) THEN
            HandleArc( CurE )
        END;

        (*
        Set the cursor for next elt based on what the current elt is.
        *)
        SetCursor( CurE, EType, Cursor );
        IF CurE # NIL THEN
            ChainCurrentElement( )
        END;

        CASE EType OF
            box : BugWrite( 'Creating box ', 0.0 ) |
            line : BugWrite( 'Creating line ', 0.0 ) |
            arrow : BugWrite( 'Creating arrow ', 0.0 ) |
            arc : BugWrite( 'Creating arc ', 0.0 ) |
            spline : BugWrite( 'Creating spline ', 0.0 ) |
            circle : BugWrite( 'Creating circle ', 0.0 ) |
            ellipse : BugWrite( 'Creating ellipse ', 0.0 ) |
            Label : BugWrite( 'Creating Labelled location ', 0.0 ) 
            ELSE    BugWrite( 'strange Etype in CreateEnode ', 0.0 )
        END;

        NEW( NewE );  (* Moment of CREATION *)

        (* set defaults of NewE common to all elements *)
        NewE^.Element := EType;
        Scopy( LabelText, 1, NewE^.ELabel, 1 );
        NewE^.TextCount := 0;
        NewE^.TextHite  := DefDimRecord.CharHite;
        NewE^.TextWidth  := DefDimRecord.CharWidth;
        NewE^.DisplayAs := solid;
        NewE^.Color     := green;

        (* Remember the current DefDirection. We'll need this for *)
        (* deterimining the end point for arcs if user didnot supply one *)
        NewE^.SaveDirection := DefDimRecord.Direction;

        DefineDimensions( NewE, EType, Cursor );

        MakeNewCurrent( NewE );
        LastCommand := MadeAnElement;
        BugWrite( "Leaving CreateEnode ", 0.0 );
        RETURN NewE

    END CreateEnode;

(* ------------------------------------------------------------------------- *)
PROCEDURE WrapUpPassOne( );
    (*
    If there is any element waiting to chained, it is put in the chain.
    If this last dangling element is an arc, need to set its size etc. by
    calling HandleArc.
    *)
    VAR
        CurE : PtrToPicElement;
    BEGIN
        CurE := CurElement( );
        IF( CurE # NIL ) AND ( CurE^.Element = arc ) THEN
            HandleArc( CurE );
        END;
        ChainCurrentElement( )
    END WrapUpPassOne;

(* ------------------------------------------------------------------------- *)
           (* A LOCAL MODULE *)
(* ------------------------------------------------------------------------- *)
MODULE PrintPicChain;
    (*
    This module exports proc PrintChain which will go thru PicChain and
    print descriptive info about each element.
    *)
    IMPORT TokenType, PtrToPicElement, PicBlock, PicChain,
           WriteLn, WriteString, WriteReal, WriteCard, WriteInt,
           PutStr;
    EXPORT PrintChain;

    CONST
        fmt = 11;  (* for writereal *)

    PROCEDURE PrintChain( );        
 
        (*
        The following procedures do the actual printing.
        *)
        PROCEDURE PrintBlockInfo( I : CARDINAL (* in *) );
            (*
            Print informations in the PicChain[ I ] record.
            *)
            BEGIN
                WriteLn; WriteString(" Pic Block # " );
                WriteCard( I, 3 );
                WriteLn;
                WITH PicChain[ I ] DO
                    WriteString( "Origin    : " );
                    WriteReal( Origin.X, fmt );
                    WriteReal( Origin.Y, fmt );
                    WriteString("  Ecount " );
                    WriteCard( Ecount, 3 );
                    WriteString(" BlockLabel: ");
                    PutStr( BlockLabel );
                    WriteLn; WriteLn
                END (* WITH *)
            END PrintBlockInfo;
        
        PROCEDURE PrintElement( p : PtrToPicElement (* in *) );

            PROCEDURE Pline();
                BEGIN
                    WITH p^ DO
                        WriteString("line : " ); WriteLn;
                        WriteString("  Start " );
                        WriteReal( Start.X, fmt );
                        WriteReal( Start.Y, fmt );
                        WriteString("  Stop " );
                        WriteReal( Stop.X, fmt );
                        WriteReal( Stop.Y, fmt );
                        WriteLn;
                    END (* WITH *)
                END Pline;

            PROCEDURE Pspline( );
                VAR
                    I : CARDINAL;
                BEGIN
                    WITH p^ DO
                        WriteString("spline : " ); WriteLn;
                        WriteString("  Start " );
                        WriteReal( Start.X, fmt );
                        WriteReal( Start.Y, fmt );
                        WriteString("  Stop " );
                        WriteReal( Stop.X, fmt );
                        WriteReal( Stop.Y, fmt );
                        WriteLn;
                        WriteString("  " );
                        IF Head = RightArrow THEN
                            WriteString("Head --> ")
                        ELSIF Head = LeftArrow THEN
                            WriteString("Head <-- " )
                        ELSIF Head = TwoWayArrow THEN
                            WriteString("Head <--> " )
                        ELSE
                            WriteString("Head ?? " )
                        END;
                        WriteLn;
                        IF GuideCount > 0 THEN
                            WriteString("  Guides: ");
                            WriteLn;
                            FOR I := 1 TO GuideCount DO
                                WITH Guide[ I ] DO
                                    WriteReal( X,fmt );
                                    WriteReal( Y,fmt );
                                    WriteLn
                                END (* WITH *)
                            END; (* FOR *)
                        END (* IF *)
                    END (* WITH *)
                END Pspline;

            PROCEDURE Parrow( );
                BEGIN
                    WITH p^ DO
                        WriteString("arrow : " ); WriteLn;
                        WriteString("  Start " );
                        WriteReal( Start.X, fmt );
                        WriteReal( Start.Y, fmt );
                        WriteString("  Stop " );
                        WriteReal( Stop.X, fmt );
                        WriteReal( Stop.Y, fmt );
                        WriteLn;
                        WriteString("  " );
                        IF Head = RightArrow THEN
                            WriteString("Head --> ")
                        ELSIF Head = LeftArrow THEN
                            WriteString("Head <-- " )
                        ELSIF Head = TwoWayArrow THEN
                            WriteString("Head <--> " )
                        ELSE
                            WriteString("Head ?? " )
                        END;
                        WriteLn;
                    END (* WITH *)
                END Parrow;

            PROCEDURE Parc( );
                BEGIN
                    WITH p^ DO
                        WriteString("arc : " ); WriteLn;
                        WriteString("  Start " );
                        WriteReal( Start.X, fmt );
                        WriteReal( Start.Y, fmt );
                        WriteLn;
                        WriteString("  GuidePt " );
                        WriteReal( ArcGuide.X, fmt );
                        WriteReal( ArcGuide.Y, fmt );
                        WriteLn;
                        WriteString("  Stop " );
                        WriteReal( Stop.X, fmt );
                        WriteReal( Stop.Y, fmt );
                        WriteLn;
                        WriteString("  Radius : " );
                        WriteReal( Radius, fmt );
                        IF Rotate = cw THEN
                            WriteString(" rotate cw ")
                        ELSIF Rotate = acw THEN
                            WriteString(" rotate acw " )
                        ELSE
                            WriteString(" rotate ?? " )
                        END;
                        WriteLn;
                    END (* WITH *)
                END Parc;

            PROCEDURE Pbox( );
                BEGIN
                    WITH p^ DO
                        WriteString("box : " ); WriteLn;
                        WriteString("  Center " );
                        WriteReal( Center.X, fmt );
                        WriteReal( Center.Y, fmt );
                        WriteString(" Hite " );
                        WriteReal( Hite, fmt );
                        WriteString(" Width " );
                        WriteReal( Width, fmt );
                        WriteLn;
                    END (* WITH *)
                END Pbox;

            PROCEDURE Pcircle( );
                BEGIN
                    WITH p^ DO
                        WriteString("circle : " ); WriteLn;
                        WriteString("  Center " );
                        WriteReal( Center.X, fmt );
                        WriteReal( Center.Y, fmt );
                        WriteString(" Radius " );
                        WriteReal( Radius, fmt );
                        WriteLn;
                    END (* WITH *)
                END Pcircle;

            PROCEDURE Pellipse( );
                BEGIN
                    WITH p^ DO
                        WriteString("ellipse : " ); WriteLn;
                        WriteString("  Center " );
                        WriteReal( Center.X, fmt );
                        WriteReal( Center.Y, fmt );
                        WriteString(" MajAxis" );
                        WriteReal( MajAxis, fmt );
                        WriteString(" MinAxis" );
                        WriteReal( MinAxis, fmt );
                        WriteLn;
                    END (* WITH *)
                END Pellipse;

            PROCEDURE Plabel( );
                BEGIN
                    WITH p^ DO
                        WriteString("Labelled location : " ); WriteLn;
                        WriteString("  Center " );
                        WriteReal( Center.X, fmt );
                        WriteReal( Center.Y, fmt );
                        WriteLn;
                    END (* WITH *)
                END Plabel;

            VAR
                I : CARDINAL;
            BEGIN
                CASE p^.Element OF
                    line : Pline( ) |
                    arc  : Parc ( ) |
                    arrow: Parrow( ) |
                    spline : Pspline( ) |
                    box  : Pbox ( ) |
                    circle : Pcircle( ) |
                    ellipse: Pellipse( ) |
                    Label  : Plabel( )
                    ELSE
                        WriteLn;
                        WriteString("**** some strange element ***"  );
                        WriteLn
                END; (* CASE *)

                (* Print attributes common to all *)
                WITH p^ DO
                    WriteString("  ELabel: " );
                    PutStr( ELabel ); WriteString(", " );
                    IF DisplayAs = solid THEN
                        WriteString(" LineType : solid " )
                    ELSIF DisplayAs = dotted THEN
                        WriteString(" LineType : dotted " )
                    ELSIF DisplayAs = dashed THEN
                        WriteString(" LineType : dashed " )
                    ELSIF DisplayAs = invisible THEN
                        WriteString(" LineType : invisible " )
                    END;
                    WriteLn;
                    IF TextCount > 0 THEN
                        WriteString("  Text: " ); WriteLn;
                        FOR I := 1 TO TextCount DO
                            WriteString("    " );
                            PutStr( Text[ I ] );
                            WriteLn
                        END
                    END;
                END; (* WITH *)

                IF p^.NextBP # NIL THEN
                    CASE p^.NextBP^.Element OF
                    line : WriteString("  NextBP.Element is a line ")|
                    arc  : WriteString("  NextBP.Element is a arc ")|
                    arrow: WriteString("  NextBP.Element is a arrow ")|
                    spline : WriteString("  NextBP.Element is a spline ")|
                    box  : WriteString("  NextBP.Element is a box ")|
                    circle : WriteString("  NextBP.Element is a circle ")|
                    ellipse: WriteString("  NextBP.Element is a ellipse ") |
                    Label  : WriteString("  NextBP.Element is a lab location")
                    ELSE
                    END (* CASE *)
                ELSE
                    WriteString("  NextBP is NIL " )
                END;
                WriteLn;
            END PrintElement;
        
        VAR
            I : CARDINAL;
            p : PtrToPicElement;
        BEGIN
            FOR I := 1 TO PicBlock DO
                PrintBlockInfo( I ); 
                
                p := PicChain[ I ].Root;
                WHILE p # NIL DO
                    PrintElement( p );
                    p := p^.NextElement;
                END (* WHILE p *)
            END (* FOR *)
        END PrintChain
END PrintPicChain;


(* ------------------------------------------------------------------------- *)
           (* A LOCAL MODULE -- DoTheActualPlotting *)
(* ------------------------------------------------------------------------- *)
MODULE DoTheActualPlotting;
    (*
    This module exports proc "DrawPictures" which will go thru PicChain and
    draw the elements on the current device using calls to DIG routines.
    *)

    IMPORT LineType, TokenType, PtrToPicElement, PicBlock, PicChain,Annotation,
           XYType, WriteLn, WriteString, WriteReal, WriteCard, WriteInt,
           PutStr, MakeCString, ColorType, MAXGUIDE,

    (* DIG Stuff *)

    (* TYPE *) GArrowHead, GLineType, GFontType, GJustType, GDeviceType,
               GColorType,
    (* VAR  *) GDevice   ,
    (* PROC *) GInitDevice,
               GErase, GWindow, GMapWindow, GMove, GDraw,
               GBox, GCircle, GEllipse, GArc, GLine, GPolyLine, GArrow,
               GSpline, GSetLinePattern, GSetFont, GSetCharSize,
               GCharCellSize, GText, GSetColor;

    EXPORT DrawPictures;

    PROCEDURE DrawPictures( );
 
        PROCEDURE DrawOneElement( p : PtrToPicElement (* in *) );
            (*
            This procedure plots the element pointed to by "p".
            *)

            PROCEDURE ChangeLinePattern( lpat : LineType (* in *) );
                BEGIN
                    CASE lpat OF
                        solid : GSetLinePattern( GSolid ) |
                        dashed: GSetLinePattern( GDashed ) |
                        dotted: GSetLinePattern( GDotted ) 
                        ELSE    GSetLinePattern( GSolid ) 
                    END
                END ChangeLinePattern;

            PROCEDURE ChangeColor( col : ColorType (* in *) );
                BEGIN
                    CASE col OF
                        black : GSetColor( Gblack ) | 
                        red : GSetColor( Gred ) | 
                        green : GSetColor( Ggreen ) | 
                        blue : GSetColor( Gblue ) | 
                        orange : GSetColor( Gorange ) | 
                        cyan : GSetColor( Gcyan ) | 
                        yellow : GSetColor( Gyellow ) | 
                        magenta : GSetColor( Gmagenta ) | 
                        white : GSetColor( Gwhite )
                        ELSE    GSetColor( Gwhite )
                    END
                END ChangeColor;

            PROCEDURE Pline();
                (* plot a line *)
                BEGIN
                    WITH p^ DO
                        IF DisplayAs = invisible THEN
                            RETURN
                        END;
                        GLine( Start.X, Start.Y, Stop.X, Stop.Y )
                    END (* WITH *)
                END Pline;

            PROCEDURE Pspline( );
                VAR
                    I : CARDINAL;
                    Gx, Gy : ARRAY [1..MAXGUIDE] OF REAL;
                BEGIN
                    FOR I := 1 TO p^.GuideCount DO
                        Gx[I] := p^.Guide[I].X;
                        Gy[I] := p^.Guide[I].Y;
                    END;
                    WITH p^ DO
                        IF Head = RightArrow THEN
                            GSpline( Start.X,Start.Y, Stop.X,Stop.Y,
                                     GuideCount, Gx,Gy, RightHead );
                        ELSIF Head = LeftArrow THEN
                            GSpline( Start.X,Start.Y, Stop.X,Stop.Y,
                                     GuideCount, Gx,Gy, LeftHead );
                        ELSIF Head = TwoWayArrow THEN
                            GSpline( Start.X,Start.Y, Stop.X,Stop.Y,
                                     GuideCount, Gx,Gy, BothHead );
                        ELSE
                            GSpline( Start.X,Start.Y, Stop.X,Stop.Y,
                                     GuideCount, Gx,Gy, NoHead );
                        END;
                    END (* WITH *)
                END Pspline;

            PROCEDURE Parrow( );
                BEGIN
                    WITH p^ DO
                        IF Head = RightArrow THEN
                            GArrow( Start.X,Start.Y, Stop.X,Stop.Y,
                                    RightHead )
                        ELSIF Head = LeftArrow THEN
                            GArrow( Start.X,Start.Y, Stop.X,Stop.Y,
                                    LeftHead )
                        ELSIF Head = TwoWayArrow THEN
                            GArrow( Start.X,Start.Y, Stop.X,Stop.Y,
                                    BothHead )
                        ELSE
                            GArrow( Start.X,Start.Y, Stop.X,Stop.Y,
                                    RightHead )
                        END;
                    END (* WITH *)
                END Parrow;

            PROCEDURE Parc( );
                BEGIN
                    WITH p^ DO
                        IF Head = RightArrow THEN
                            GArc( Start.X,Start.Y, ArcGuide.X, ArcGuide.Y,
                                  Stop.X,Stop.Y, RightHead )
                        ELSIF Head = LeftArrow THEN
                            GArc( Start.X,Start.Y,  ArcGuide.X, ArcGuide.Y,
                                  Stop.X,Stop.Y, LeftHead )
                        ELSIF Head = TwoWayArrow THEN
                            GArc( Start.X,Start.Y,  ArcGuide.X, ArcGuide.Y,
                                  Stop.X,Stop.Y, BothHead )
                        ELSE
                            GArc( Start.X,Start.Y,  ArcGuide.X, ArcGuide.Y,
                                  Stop.X,Stop.Y, NoHead )
                        END;
                    END (* WITH *)
                END Parc;

            PROCEDURE Pbox( );
                BEGIN
                    WITH p^ DO
                        GBox( Center.X-Width/2.0, Center.Y-Hite/2.0,
                              Center.X+Width/2.0, Center.Y+Hite/2.0
                            )
                    END (* WITH *)
                END Pbox;

            PROCEDURE Pcircle( );
                BEGIN
                    WITH p^ DO
                        GCircle( Center.X, Center.Y, Radius )
                    END (* WITH *)
                END Pcircle;

            PROCEDURE Pellipse( );
                BEGIN
                    WITH p^ DO
                        GEllipse( Center.X, Center.Y, MajAxis, MinAxis )
                    END (* WITH *)
                END Pellipse;

            PROCEDURE WriteTextArray( Elt  : TokenType  (* in *);
                                  VAR Text : Annotation (* in *);
                                      Count: CARDINAL   (* in *);
                                      About: XYType     (* in *);
                                      Cht  : REAL       (* in *);
                                      Cwid : REAL       (* in *);
                                      Rot  : REAL       (* in *);
                                      Just : GJustType  (* in *)  );
                (*
                this procedure display an array of text strings about the point
                "About".
                *)
                VAR
                    off               : REAL;
                    over, under, I, J : CARDINAL;
                    Start : XYType;
                    Cellht, Cellwid, Slant : REAL;
                    Cstr : ARRAY [1..80] OF CHAR;
                BEGIN
                    IF Count = 0 THEN
                        RETURN
                    END;
                    
                    Slant := 0.0;
                    GSetCharSize( Cht, Cwid, Slant );
                    GCharCellSize( Cht, Cwid, Cellht, Cellwid );
                    off := 0.0;
                    IF GDevice = tek THEN
                        off := 0.5
                    END;
                    Start.X := About.X;
                    Start.Y := About.Y + FLOAT( INTEGER(Count) )/2.0*Cellht +
                                         FLOAT( INTEGER(Count) )/2.0*Cellht*off;

                    (* Tektronics characters are bottom justified. So an
                       extra Cellht displacement.
                    *)
                    IF GDevice = tek THEN
                        Start.Y := Start.Y + Cellht
                    END;
                    IF( Elt = line ) OR ( Elt = arrow ) THEN
                        IF ODD( Count ) THEN
                            Start.Y := Start.Y + Cellht*0.5;
                        END
                    END;
                    J := 1;
                    FOR I := 1 TO Count DO
                        MakeCString( Text[J], Cstr );
                        INC( J );
                        GText( Start.X, Start.Y, Cstr, Cht, Cwid, Rot, Just );
                        Start.Y := Start.Y - Cellht - Cellht*off
                    END;
                END WriteTextArray;
            
            VAR
                About : XYType;
                I : CARDINAL;
            BEGIN
                IF p^.DisplayAs # invisible THEN
                    ChangeLinePattern( p^.DisplayAs );
                    ChangeColor( p^.Color );
                    CASE p^.Element OF
                        line : Pline( ) |
                        arc  : Parc ( ) |
                        arrow: Parrow( ) |
                        spline : Pspline( ) |
                        box  : Pbox ( ) |
                        circle : Pcircle( ) |
                        ellipse: Pellipse( ) 
                        ELSE
                    END (* CASE *)
                END;

                (* Display text *)
                WITH p^ DO
                    CASE Element OF
                        box, circle, ellipse :
                            WriteTextArray( Element, Text, TextCount, Center, 
                                    TextHite,TextWidth, 0.0, CenterJustify ) |
                        line, arrow : 
                            About.X := ( Stop.X + Start.X ) * 0.5;
                            About.Y := ( Stop.Y + Start.Y ) * 0.5;
                            WriteTextArray( Element, Text, TextCount, About, 
                                    TextHite,TextWidth, 0.0, CenterJustify ) 
                        ELSE
                    END
                END; (* WITH *)

            END DrawOneElement;
        
        VAR
            I : CARDINAL;
            p : PtrToPicElement;
        BEGIN
            FOR I := 1 TO PicBlock DO
                p := PicChain[ I ].Root;
                WHILE p # NIL DO
                    DrawOneElement( p );
                    p := p^.NextElement;
                END (* WHILE p *)
            END (* FOR *)
        END DrawPictures
END DoTheActualPlotting;

(* ------------------------------------------------------------------------ *)
(* Initialization section for PicADT *)
    VAR
        Index : BasicElementType; 
    BEGIN
        PicBlock := 1;
        WITH PicChain[ 1 ] DO
            Origin.X := -1.0;   (* set to illegal until user gives one *)
            Origin.Y := -1.0;
            Ecount   := 0;
            NullString( BlockLabel );
            Root     := NIL;
            Terminal := NIL;
            FOR Index := box TO spline DO
                FirstBP[ Index ] := NIL;
                LastBP [ Index ] := NIL
            END;
        END;
    
        (* Set default dimensions *)
        WITH DefDimRecord DO
            ArrowLength := Inch/2.0;
            BoxHite     := Inch/2.0;
            BoxWidth    := Inch*0.75;
            CharHite    := Inch/15.0;
            CharWidth   := Inch/20.0;
            LineLength  := Inch/2.0;
            MajorAxis   := Inch*0.75*0.5;  (* the semimajor axis *)
            MinorAxis   := Inch*0.5*0.5;
            Radius      := Inch/4.0;
            Direction   := right
        END;
    
        CElt := NIL;
        Cursor.X := -1.0;
        Cursor.Y := -1.0;  (* these two are illegal until set *)


        DirAngle[ up ] := pi/2.0;
        DirAngle[ down ] := - pi/2.0;
        DirAngle[ left ] := pi;
        DirAngle[ right ] := 0.0;
        DirAngle[ upright ] := pi/4.0;
        DirAngle[ upleft ] := pi/2.0 + pi/4.0;
        DirAngle[ downleft ] := -pi/2.0 - pi/4.0;
        DirAngle[ downright] := -pi/4.0;

        (* direction to compass point mapping *)
        DirToCompass[ up ] := north;
        DirToCompass[ down ] := south;
        DirToCompass[ left ] := west;
        DirToCompass[ right ] := east;
        DirToCompass[ upright ] := ne;
        DirToCompass[ upleft ] := nw;
        DirToCompass[ downleft ] := sw;
        DirToCompass[ downright] := se;

        LastCommand := StartingOut;
        PicADTDebug := FALSE

END PicADT.