IMPLEMENTATION MODULE PicPasses;

(* The module implements a recursive descent parser for PIC. Commands
   are parsed and PicADT routines are invoked to generate a list of
   PIC elements. After this activity is over, the entire set of PIC
   commands have been parsed and a ready list of PIC elements created.
   Pass two of PIC then goes through the list and draws the elements
   desired at locations determined in pass one. 

   Pass two then can be called to generate the actual drawing of the
   elements on the specified device.
*)

  FROM InOut IMPORT WriteLn   , WriteString    , WriteInt,
                    WriteReal ;

  FROM Tools IMPORT Character , String , Ctoi, Ctor, NullString, 
                    Putc, PutStr, PutQStr, Scopy, Warning, FatalError;

  FROM Lex   IMPORT TokenType, LexDebug, Echo, ShowToken, Lexical;

  FROM TableManager IMPORT Install, LookUp, NullDef, sttype,
                           TabDebug;

  FROM PicADT IMPORT 
    (* TYPE *)  PtrToPicElement, 
    (* VAR  *)  PicADTDebug    ,
    (* PROC *)  INDimSet   , INDirSubSet, INCompassSet, INBPrimSet, INColorSet,
                DefDimValue, FindElement, CurElement, GetCompassLoc,
                LabElement , Setdashed  , Setdotted , Setchop      ,
                Setinvisible,Setsame    , Setht     , Setwidth     ,
                SetRotation, Setrad     , Setmajax   , Setminax  , 
                Setfrom    , SetColor   ,
                Setto       , Setat      , SetCompassat, MoveThisWay,
                SetArrowType, SetText    , SetLocation, CreateEnode ,
                SetDefDirection, SetDefDimension, SetPicOrigin,
                ChainCurrentElement      , MoveToLocation     ,
                WrapUpPassOne,
                DrawPictures
                ;
  FROM DIG IMPORT GDeviceType, GDevice, GInitDevice, GErase,
                  GWindow, GMapWindow, GWrapUp, GSlope;
  FROM   MathLib0     
           IMPORT cos, sin, sqrt;

  CONST
      RealZero          = 0.0;
  VAR
      TokenCode : TokenType;
      Token     : String;
(*-------------------------------------------------------------------*)
  PROCEDURE BugWrite(
      msg   : ARRAY OF CHAR (* in *);
      rn    : REAL          (* in *));
  (*
  If the global variable "Pass1Debug" is true, this procedure writes out
  the "msg" followed by the real number "rn".
  *)
  BEGIN
      IF Pass1Debug THEN
          WriteString( "%PIC1-Debug," );
          WriteString( msg );
          WriteReal  ( rn,15 );
          WriteLn
      END
  END BugWrite;


(*-------------------------------------------------------------------*)
  PROCEDURE Display(
      Token : String (* in *) );
      (*
      This procedure displays "Token" within "\"'s
      *)
      BEGIN
          WriteString("\");
          PutStr ( Token );
          WriteString("\");
      END Display;

(*-------------------------------------------------------------------*)
  PROCEDURE Scan( );
      (*
      Scan simply calls Lexical to give it tokens. It skips over unwanted
      tokens by repeadly calling Lexical.
      *)
      PROCEDURE PrintToken( );
          BEGIN
              IF Pass1Debug THEN
                  WriteString("  " );
                  ShowToken( Token, TokenCode )
              END
          END PrintToken;
      BEGIN
              Lexical( Token, TokenCode );
              PrintToken( );
    
              (* skip over white spaces *)
              WHILE ( TokenCode = CharToIgnore ) DO
                  Lexical( Token, TokenCode );
                  PrintToken( );
              END;
              IF TokenCode =  Continuation THEN
                  Lexical( Token, TokenCode );
                  PrintToken( );
                  WHILE ( TokenCode # EndOfRecord ) DO
                      Lexical( Token, TokenCode );
                      PrintToken( );
                  END;
                  (*
                  recursively call Scan until a good token seen 
                  *)
                  Scan( )
              END;
      END Scan;

(*-------------------------------------------------------------------*)
  PROCEDURE Arex( ): REAL;
  (*
  This function procedure implements the rule:
  
      Arex --> Term { "-"|"+" Term }

  Because the function procedure "Element" calls on "Arex", and all the
  function procedures that evaluate arithmatic expressions are never
  invoked by anyother procedure, they are nested within "Arex".
  *)

      PROCEDURE Element( ): REAL;
      (*
      This function procedure implements the rule:
      
          Element --> "(" Arex ")" | DefaultDimension | Identifier
                     | IntegerNumber | RealNumber
                     
      The Value sent back is the REAL value of the
      term on the right hand of the grammer productions. Thus for 
      an integer seen as token, its value computed is REAL. For 
      illegal Elements the Value returned is 0.0.
      *)
      VAR
          Value : REAL;  (* will hold value to be returned *)
          Fine  : BOOLEAN; (* return status from some functions invoked *)
          TempStr : String; (* values stored in tempStr and Junk are junked *)
          Junk  : sttype;
      BEGIN
          BugWrite( "Entering Element ", 0.0 );
          Value := RealZero;
    
          IF TokenCode = IntegerNumber THEN
              Value := FLOAT( Ctoi( Token ) );
              Scan( )
          ELSIF TokenCode = RealNumber THEN
              Value := Ctor( Token );
              Scan( )
          ELSIF TokenCode = Identifier THEN
              (* Get value from SymTable *)
              Fine := LookUp( Token, TempStr, Value, Junk );  
              IF Fine THEN
                  Scan( )
              ELSE
                  Value := RealZero;            
                  Display( Token );
                  Warning('Undefined identifier, 0.0 used for its value' )
              END
          ELSIF INDimSet( TokenCode ) THEN (* Default Dimension *)
              Value := DefDimValue( TokenCode );   
              Scan( )
          ELSIF TokenCode = OpenParen THEN
              Scan( );
              Value := Arex( );
    
              IF TokenCode = CloseParen THEN
                  Scan( )
              ELSE
                  Warning('Missing ")" after expression' )
              END
          ELSE
              Value := RealZero
          END;
      
          BugWrite('Value in Element ', Value );
          BugWrite( 'Leaving Element ', 0.0 );

          RETURN Value
      END Element;
    
    (*-------------------------------------------------------------------*)
      PROCEDURE Primary(  ): REAL;
      (*
      This function procedure implements the rule:
      
          Primary --> "-" Primary | Element
          
      where the "-" is unary minus.
      *)
      BEGIN
          BugWrite( "Entering Primary", 0.0 );
          IF TokenCode = MinusSign THEN
              Scan( );
              BugWrite( "Leaving Primary - return 1", 0.0 );
              RETURN -Primary( )
          END;
          BugWrite( "Leaving Primary - return normal ", 0.0 );
          RETURN Element(  )
      END Primary;
    
    (*-------------------------------------------------------------------*)
      PROCEDURE Term( ): REAL;
      (*
      This function procedure implements the rule:
      
          Term --> Primary { *|/ Primary }
          
      *)
      VAR
          Value : REAL;  (* Will hold value to be returned *)
          Temp  : REAL;
      BEGIN
          BugWrite( "Entering Term ", 0.0 );
          Value := Primary( );
          WHILE ( TokenCode = Multiply ) OR ( TokenCode = Divide ) DO
              IF TokenCode = Multiply THEN
                  Scan( );
                  Value := Value * Primary( )
              ELSE
                  Scan( );
                  Temp := Primary( );
                  IF Temp # RealZero THEN  (* don't divide by zero *)
                      Value := Value/Temp
                  END
              END
          END; (* WHILE *)

          BugWrite('Value in Term ', Value );
          BugWrite( "Leaving Term ", 0.0 );

          RETURN Value
      END Term;

  VAR
      Value : REAL; (* Will hold value to be returned *)
  BEGIN  (* Arex *)
      BugWrite( "Entering Arex ", 0.0 );
      Value := Term( );
      WHILE ( TokenCode = MinusSign ) OR ( TokenCode = PlusSign ) DO
          IF TokenCode = MinusSign THEN
              Scan( );
              Value := Value - Term( )
          ELSE
              Scan( );
              Value := Value + Term ( )
          END
      END; (* WHILE *)
  
      BugWrite('Arex Value ', Value );
      BugWrite( "Leaving Arex ", 0.0 );

      RETURN Value
  END Arex;

(*-------------------------------------------------------------------*)
  PROCEDURE BasicPrimitive( ) : BOOLEAN;
      (*
      This procedure determines whether the current Token is a basic
      primitive:
  
      BasicPrimitive --> arc | arrow | ... | spline
     *)
  BEGIN
      IF INBPrimSet( TokenCode ) THEN 
          Scan( );
          BugWrite('Basic primitive returned TRUE', RealZero );
          RETURN TRUE
      END;
      BugWrite('Basic primitive returned FALSE', RealZero );
      RETURN FALSE
  END BasicPrimitive;

(*-------------------------------------------------------------------*)
  PROCEDURE PrimCount(
      VAR PcSeen : BOOLEAN (* out *);
      VAR Pc     : INTEGER (* out *) );
      (*
      this procedure determines whether the token is one of the
      primitive counts, or "last":
  
      PrimCount -->  first|...|tenth   [last]

      If a prim count is found, its integer equivalent is sent back thru
      Pc. If the keyword "last" is seen, then Pc is set to -Pc.
      *)
     
      PROCEDURE INPcountSet ( tc : TokenType (* in *) ): BOOLEAN;
          (* 
          This function is called by PrimCount only. It returns true
          if the token "tc" is first..tenth.
          *)
          VAR
              I : [ first..tenth ];
          BEGIN
              FOR I := first TO tenth DO
                  IF I = tc THEN
                      RETURN TRUE
                  END
              END;
              RETURN FALSE
          END INPcountSet;

  BEGIN
      BugWrite( "Entering PrimCount ", 0.0 );
      PcSeen := TRUE;
      IF TokenCode = last THEN
          Scan( );
          Pc := -1
      ELSIF INPcountSet( TokenCode ) THEN
          Pc := ORD( TokenCode ) - ORD( first ) + 1;
          Scan( );
          IF TokenCode = last THEN   (* count followed by "last" *)
              Pc := -Pc;
              Scan( )
          END
      ELSE
          PcSeen := FALSE;
          BugWrite('In PrimCount, not a count', RealZero )
      END;
  
      IF PcSeen THEN
          BugWrite('In PrimCount, Pc is ', FLOAT( Pc ) )
      END;
      BugWrite( "Leaving PrimCount ", 0.0 );

  END PrimCount;

(*-------------------------------------------------------------------*)
  PROCEDURE Primitive(
      VAR Enode : PtrToPicElement (* out *) ): BOOLEAN;
  (*
  This procedure function implements the rule:
  
      Primitive --> [PrimCount] BasicPrimitive
  If a primitive is seen, Enode is returned pointing to the primitive,
  and a TRUE value returned as the function result.
  *)
  VAR
      Pc     : INTEGER;
      PcSeen : BOOLEAN;
      Bp     : TokenType;
      Found  : BOOLEAN;
  BEGIN
      BugWrite( "Entering Primitive ", 0.0 );
      (* check to see if a count preceeds the basic primitive *)
      PrimCount( PcSeen, Pc );
      IF PcSeen THEN
          Bp := TokenCode;  (* save basic prim because it'll get scanned *)
          IF BasicPrimitive( ) THEN
              FindElement( Bp, Pc, Found, Enode ); 
              IF NOT Found THEN
                  FatalError('Pic element is not present or count is wrong')
              END;
              BugWrite('In Primitive, pcounted basic prim seen', RealZero);
              BugWrite( "Leaving Primitive - return 1 ", 0.0 );
              RETURN TRUE
          END;
          FatalError('A Basic primitive (box, circle etc) required')
      ELSE
          Bp := TokenCode;
          IF BasicPrimitive( ) THEN
              Enode := CurElement( )
          ELSE
              BugWrite('In Primitive, basic prim not found', RealZero );
              BugWrite( "Leaving Primitive - return 2 ", 0.0 );
              RETURN FALSE
          END;
          BugWrite('In Primitive, basic prim found', RealZero );
          BugWrite( "Leaving Primitive - return 3 ", 0.0 );
          RETURN TRUE
      END
  END Primitive;

(*-------------------------------------------------------------------*)
  PROCEDURE Location
      ( VAR X  : REAL   (* out *);
        VAR Y  : REAL   (* out *) );
  (* 
  This procedure implements the rule:
  
      Location -->  Coordinates
                  | CompassPoint [ of Primitive [ Modify ] ]
                  | Primitive[CompassPoint] [ Modify ]
                  | Identifier[CompassPoint] [Modify]
                  | FractionWay
                  
  Because of inter dependencies, all the procedures that implement the
  productions are nested within "Location".
  *)
  
      (* -----------------------------------------------------------*)
      PROCEDURE IntFrac( ): REAL;
      (*
      This procedure implements the rule:
      
          IntFrac --> IntegerNumber "/" IntegerNumber
      
      Notice however that the result returned is REAL.
      *)
      VAR
          N, D : REAL;  (* Will hold values of numerator and denominator *)
      BEGIN
          BugWrite( "Entering IntFrac ", 0.0 );
          IF TokenCode = IntegerNumber THEN
              N := Ctor( Token );
              Scan( )
          ELSE
              Warning('Missing integer number in fraction' )
          END;

          BugWrite('IntFrac, N = ', N );
      
          IF TokenCode = Divide THEN
              Scan( )
          ELSE
              Warning('Missing "/" in fraction' )
          END;
         
          IF TokenCode = IntegerNumber THEN
              D := Ctor( Token );   
              Scan( )
          ELSE
              Warning('Missing denominator in fraction' );
              D := RealZero
          END;

          BugWrite('IntFrac, D = ', D );
      
          IF D = RealZero THEN
              Warning('Denominator in fraction is ZERO' );
              BugWrite( "Leaving IntFrac - return 1 ", 0.0 );
              RETURN D
          END;
      
          BugWrite( 'IntFrac, final N/D ', N/D );
          BugWrite( "Leaving IntFrac - return 2 ", 0.0 );
          RETURN N/D
      END IntFrac;
  
      (* -----------------------------------------------------------*)
      PROCEDURE FracWay(
          VAR X : REAL (* out *);
          VAR Y : REAL (* out *)  );
      (*
      This procedure implements the rule:
      
          FracWay --> IntFrac between Location and Location
          
      If IntFrac is found to be zero, the coordinates of the first
      Location are sent back.
      *)
      VAR
          X1, X2 : REAL;
          Y1, Y2 : REAL;
          F      : REAL;
          d, theta : REAL;
      BEGIN
          BugWrite( "Entering FracWay ", 0.0 );
          F := IntFrac( );
          BugWrite('In FracWay, F = ', F );
          
          IF TokenCode = between THEN
              Scan( )
          ELSE
              FatalError('Missing keyword "between" before location' )
          END;
      
          (* Get the coordinates of the first location *)
          Location( X1, Y1 );
          
          IF TokenCode = and THEN
              Scan( )
          ELSE
              FatalError('Missing keywod "and" after location' )
          END;
      
          (* Get coordinates of the second Location *)
          Location( X2, Y2 );
          
          IF F # RealZero THEN
              (* determine dist between the two pts *)
              X := X2 - X1;
              Y := Y2 - Y1;
              d := sqrt( X*X + Y*Y );
              (* cut the dist by F *)
              d := d*F;
              (* slope of line connecting the two pts *)
              theta := GSlope( X1,Y1, X2,Y2 );

              (* add fraction of d *)
              X := X1 + d*cos( theta );
              Y := Y1 + d*sin( theta );
          ELSE
              Warning('fraction is zero. Coordinates of the first location will be used' );
              X := X1;
              Y := Y1
          END;
          BugWrite( "Leaving FracWay ", 0.0 );
      END FracWay;
  
      (* -----------------------------------------------------------*)
      PROCEDURE Coordinates(
          VAR X  : REAL (* out *);
          VAR Y  : REAL (* out *);
          VAR GotEm : BOOLEAN (* out *) );
      (*
      This  procedure implements the rule:
      
          Coordinates --> "(" Arex "," Arex ")"
      If the first token is not "(", then some other type of location
      specification has been specified. In this case, the procedure
      sets the parameter "GotEm" to FALSE.
      *)
      BEGIN
          BugWrite( "Entering Coordinates ", 0.0 );
          GotEm := TRUE;
          IF TokenCode = OpenParen THEN
              Scan( );
              X := Arex( );
              IF TokenCode = Comma THEN
                  Scan( )
              ELSE
                  Warning('Missing "," after first coordinate' )
              END;
              Y := Arex( );
              IF TokenCode = CloseParen THEN
                  Scan ( )
              ELSE
                  Warning('Missing ")" in coordinates specification' )
              END;
          
              BugWrite('Coordinates, X = ', X );
              BugWrite('Coordinates, Y = ', Y )
          ELSE
              GotEm := FALSE
          END;
          BugWrite( "Leaving Coordinates ", 0.0 );
      END Coordinates;
  
      (*-------------------------------------------------------------------*)
      PROCEDURE ModifyLocation(
          VAR X  : REAL (* in/out *);
          VAR Y  : REAL (* in/out *));
      (*
      This procedure is invoked to modify the location coordinates. See
      the grammer rules "Location --> ..etc".
      If a "+" or "-" sign is seen, the coordinates following the
      sign are retrieved and added or subtracted from the coordinates
      of the location that preceded the +|-.
      *)
      VAR
          X2 : REAL;
          Y2 : REAL;
          GotEm : BOOLEAN;
          AddFlag : BOOLEAN;
      BEGIN
          BugWrite( "Entering ModifyLocation ", 0.0 );
          IF ( TokenCode = PlusSign ) OR ( TokenCode = MinusSign ) THEN
              AddFlag := TokenCode = PlusSign;
              Scan( );
              Coordinates( X2, Y2, GotEm );
              IF NOT GotEm THEN
                  Warning('Missing coordinates after "+"|"-"' );
                  RETURN
              END;
              IF AddFlag THEN
                  X := X + X2;
                  Y := Y + Y2
              ELSE
                  X := X - X2;
                  Y := Y - Y2
              END;
              BugWrite('In ModifyLocation, X ', X );
              BugWrite('                   Y ', Y )
          END;
          BugWrite( "Leaving ModifyLocation ", 0.0 );
      END ModifyLocation;

  VAR
      Enode : PtrToPicElement;
      Found : BOOLEAN;
      Cpt   : TokenType;
      X2    : REAL;
      Y2    : REAL;
  BEGIN (* Location *)
      BugWrite( "Entering Location ", 0.0 );
      IF TokenCode = OpenParen THEN
          Coordinates( X, Y, Found )
      ELSIF INCompassSet( TokenCode ) THEN
          Cpt := TokenCode;    (* save token from being scanned *)
          Enode := CurElement( );   (* by default, work with compass point *)
          GetCompassLoc( Enode, Cpt, X, Y );  (* of the current pic element *)
          Scan( );
          
          (* Now if the keyword "of" is present then determine the compass
             point of the primitive or Labident that follows.
          *)
          IF TokenCode = of THEN
              Scan( );
              IF Primitive( Enode ) THEN  (* If prim, Enode will be set to it *)
                  GetCompassLoc( Enode, Cpt, X, Y ) (* Notice why Cpt required *)
              ELSIF TokenCode = Identifier THEN
                  LabElement( Token, Enode, Found );
                  IF Found THEN
                      Scan( );  
                      GetCompassLoc( Enode, Cpt, X, Y )
                  ELSE
                      Display( Token );
                      FatalError(' No pic object has been assigned this label')
                  END
              ELSE
                  Display( Token );
                  Warning(' is not a pic element or label of an element' );
                  Warning('Compass point of current element used instead' )
              END
          END;
          BugWrite('In Location, Cpt of prim, X ', X );
          BugWrite('                          Y ', Y );
          
          ModifyLocation( X, Y )
      ELSIF TokenCode = Identifier THEN  (* a label used to specify location *)
          LabElement( Token, Enode, Found );  (* find it *)
          IF Found THEN
              Scan( );
              IF INCompassSet( TokenCode ) THEN
                  GetCompassLoc( Enode, TokenCode, X, Y );
                  Scan( )
              ELSE
                  GetCompassLoc( Enode, center, X, Y ) (* center is defalt *)
              END;
              BugWrite('Location, Label X ', X );
              BugWrite('                Y ', Y );
              
              ModifyLocation( X, Y )
          ELSE
              Display( Token );
              FatalError(' Label has not been specified.')
          END
      ELSIF Primitive( Enode ) THEN
          IF INCompassSet( TokenCode ) THEN
              GetCompassLoc( Enode, TokenCode, X, Y );
              Scan( )
          ELSE
              GetCompassLoc( Enode, center, X, Y )
          END;
          BugWrite('Location, Primitive X ', X );
          BugWrite('                    Y ', Y );
          
          ModifyLocation( X, Y )
      ELSIF TokenCode # IntegerNumber THEN
          Display( Token );
          FatalError(' is an incorrect token for specifying location' )
      ELSE
          FracWay( X, Y )
      END;
  
      BugWrite('Location, final X ', X );
      BugWrite('                Y ', Y );
      BugWrite( "Leaving Location ", 0.0 );
  END Location;
  
(*-------------------------------------------------------------------*)
  PROCEDURE Attribute(
      VAR Enode : PtrToPicElement (* in/out *) ) : BOOLEAN;
  (*
  This procedure implements the rule:
      Attribute -->  dashed | dotted | chop | invisible | same
                  |  ht Arex
                  |  width Arex
                  |  rad Arex
                  |  majax Arex
                  |  minax Arex
                  |  from Location
                  |  to Location
                  |  at Location
                  |  with CompassPoint at Location
                  |  Direction [ from location ]
                  |  color PicColors
                  |  ArrowHead
                  |  QuotedString
                  |  Location
    
  If an attribute is found, the procedutre functions returns TRUE, false
  otherwise.
  *)
  VAR
      X : REAL;
      Y : REAL;
      Cp : TokenType;
      ChopAmt : REAL;
      dist    : REAL;
  BEGIN
      BugWrite( 'Entering Attribute ', 0.0 );
      IF TokenCode = dashed THEN
          Scan( );
          Setdashed( Enode )        
      ELSIF TokenCode = dotted THEN
          Scan( );
          Setdotted( Enode )        
      ELSIF TokenCode = chop THEN
          Scan( );
          ChopAmt := Arex( );
          Setchop( Enode, ChopAmt )
      ELSIF TokenCode = invisible THEN
          Scan( );
          Setinvisible( Enode )        
      ELSIF TokenCode = same THEN
          Scan( );
          Setsame( Enode )        
      ELSIF TokenCode = ht THEN
          Scan( );
          Setht( Enode, Arex( ) )        
      ELSIF TokenCode = width THEN
          Scan( );
          Setwidth( Enode, Arex( ) )        
      ELSIF( TokenCode = cw) OR ( TokenCode = acw ) THEN
          SetRotation( Enode, TokenCode );
          Scan( )
      ELSIF TokenCode = rad THEN
          Scan( );
          Setrad( Enode, Arex( ) )        
      ELSIF TokenCode = majax THEN
          Scan( );
          Setmajax( Enode, Arex( ) )        
      ELSIF TokenCode = minax THEN
          Scan( );
          Setminax( Enode, Arex( ) )        
      ELSIF TokenCode = from THEN
          Scan( );
          Location( X,Y );
          Setfrom( Enode, X, Y )        
      ELSIF TokenCode = to THEN
          Scan( );
          Location( X,Y );
          Setto( Enode, X, Y )        
      ELSIF TokenCode = at THEN
          Scan( );
          Location( X,Y );
          Setat( Enode, X,Y )        
      ELSIF TokenCode = with THEN
          Scan( );
          IF INCompassSet( TokenCode ) THEN
              Cp := TokenCode;    (* Save it for setting later *)
              Scan( );
              IF TokenCode = at THEN
                  Scan( )
              ELSE
                  Warning('Missing keyword "at" after compass point')
              END;
              Location( X,Y );
              SetCompassat( Enode, Cp, X,Y ) 
          ELSE
              FatalError('Missing compass point (.ne,.se etc) after "with"')
          END
      ELSIF INDirSubSet( TokenCode ) THEN
          SetDefDirection( TokenCode );
          Cp := TokenCode;  (* save direction *)
          Scan( );
          dist := Arex( );  (* distance to move in the direction *)

          (* check if the starting point specified *)
          X := -11.0; (* neg X signals no start given *)
          IF TokenCode = from THEN
              Scan( );
              Location( X,Y )
          END;
          MoveThisWay( Enode, Cp, dist, X, Y ) 
      ELSIF TokenCode = LeftArrow THEN
          SetArrowType( Enode, TokenCode );   
          Scan( )
      ELSIF TokenCode = TwoWayArrow THEN
          SetArrowType( Enode, TokenCode );   
          Scan( )
      ELSIF TokenCode = RightArrow THEN
          SetArrowType( Enode, TokenCode );   
          Scan( )
      ELSIF TokenCode = color THEN
          Scan( );
          IF INColorSet( TokenCode ) THEN
              SetColor( Enode, TokenCode );
              Scan( )
          END
      ELSIF TokenCode = QuotedString THEN
          SetText( Enode, Token );    
          Scan( )
      ELSIF TokenCode = OpenParen THEN
          Location( X,Y );   (* coordinates given for a labelled loc *)
          SetLocation( Enode, X,Y )  
      ELSIF( TokenCode # EndOfCommand ) AND ( TokenCode # EndOfRecord ) THEN 
          IF TokenCode = EndOfFile THEN (* end of attribute list for the *)
              RETURN FALSE   (* scan will keep getting EOF from now on *)
          END;
          (*
          THe only possibilty left is that this could be a location
          to be attached with a label.
          *)
          Location( X,Y );
          SetLocation( Enode, X, Y )

      ELSIF( TokenCode = EndOfCommand ) OR ( TokenCode = EndOfRecord ) THEN
          BugWrite( 'Leaving Attribute - return FALSE ', 0.0 );
          RETURN FALSE
      END;
  
      (* Picked up a good attribute, return true *)
      BugWrite( 'Leaving Attribute - return TRUE ', 0.0 );
      RETURN TRUE
  END Attribute;

(*-------------------------------------------------------------------*)
  PROCEDURE AttributeList
      ( VAR Enode : PtrToPicElement (* in/out *) ): BOOLEAN;
  (*
  This function procedure implements the rule:
  
      AttributeList --> Attribute { Attribute }
  *)
  BEGIN
      BugWrite( 'Entering AttributeList  ', 0.0 );
      WHILE Attribute( Enode ) DO
          BugWrite( 'Grabbing the next attribute ', RealZero )
      END;
  
      BugWrite( 'Leaving AttributeList  ', 0.0 );
      RETURN TRUE
  END AttributeList;

(*-------------------------------------------------------------------*)
  PROCEDURE PicElement(
      LabelText : String  (* in *) ;
      LabelSeen : BOOLEAN (* in *) ) : BOOLEAN;
      
  (*
  This procedure implements the rule:
  
      PicElement --> BasicElement AttributeList | AttributeList
  
  If a basicElement is found, a new node is created in the PIC list
  of elements. The address of the node is then passed over to the
  AttributeList procedure. If a basic element is not specified and
  a label was the previous token, then this must a labelled location.
  *)
  
  VAR
      Enode : PtrToPicElement;
  BEGIN
      BugWrite( 'Entering PicElement ', 0.0 );
      IF INBPrimSet( TokenCode ) THEN  
          Enode := CreateEnode( TokenCode, LabelText ); 
          Scan()
      ELSIF LabelSeen THEN
          Enode := CreateEnode( Label, LabelText )   
      ELSE
          FatalError('There must be a location present here');
          BugWrite( 'Leaving PicElement - return 1 ', 0.0 );
          RETURN FALSE
      END;
  
      BugWrite( 'Leaving PicElement - return 2', 0.0 );
      RETURN AttributeList( Enode )

  END PicElement;

(*-------------------------------------------------------------------*)
  PROCEDURE Command( ): BOOLEAN;
  (*
  This procedure implements the rule:
  
      Command --> Direction 
                 |DefaultDimension "=" arex 
                 |Identifier "=" arex 
                 |move to Location 
                 |[Label] PicElement 
  *)
  VAR
      SaveTC : TokenType;
      EmptyString   : String;
      SaveToken     : String;
      Fine          : BOOLEAN;
      ArexValue     : REAL;
      X             : REAL;
      Y             : REAL;
  BEGIN
      BugWrite( 'Entering Command ', 0.0 );
      IF INDirSubSet( TokenCode ) THEN  (* Direction *) 
          SetDefDirection( TokenCode );               
          Scan( )
      ELSIF INDimSet( TokenCode ) THEN (* DefaultDimension *) 
          SaveTC := TokenCode;  (* SetDefDimension will need this *)
          Scan( );
          IF TokenCode = Assignment THEN
              Scan( )
          ELSE
              Warning('Missing "=" in default dimension command' )
          END;
      
          (* Look for arex anyway *)
          ArexValue := Arex( );
          SetDefDimension( SaveTC, ArexValue )  

      ELSIF TokenCode = Identifier THEN
          Scopy( Token, 1, SaveToken, 1 );  (* save id name for install *)
          Scan( );
          IF TokenCode = Assignment THEN
              Scan( )
          ELSE
              Warning('Missing "=" after identifier' )
          END;
          ArexValue := Arex( );
          Install( SaveToken, NullDef, ArexValue, Mactype )  

      ELSIF TokenCode = move THEN
          Scan( );
          IF TokenCode = to THEN
              Scan( )
          ELSE
              Warning('Missing keyword "to" after "move" ')
          END;
          Location( X, Y );
          MoveToLocation( X, Y )   

      ELSIF TokenCode = Label THEN
          Scopy( Token, 1, SaveToken, 1 );
          Scan( );
          (* this would pick up all the attributes *)
          Fine := PicElement( SaveToken, TRUE ) 
      ELSIF INBPrimSet( TokenCode ) THEN  (* a basic primitive first *)
          NullString( EmptyString );  (* make an empty string *)
          Fine := PicElement( EmptyString, FALSE ) (* a basic primitive *)
      END;

      IF( TokenCode # EndOfCommand ) AND ( TokenCode # EndOfRecord ) THEN
          BugWrite( 'Leaving Command - return 1', 0.0 );
          RETURN FALSE
      END;
  
      Scan( );  (* scan over ";" or NEWLINE *)
      BugWrite( 'Leaving Command - return 2 ', 0.0 );
      RETURN TRUE
  END Command;

(*-------------------------------------------------------------------*)
  PROCEDURE PicCmd( ): BOOLEAN;
  (*
  This procedure implements the rule:
  
      PicCmd --> command { command }
      
  *)
  VAR
      Fine : BOOLEAN;
  BEGIN
      BugWrite( 'Entering PicCmd ', 0.0 );
      REPEAT
          Fine := Command( )
      UNTIL NOT Fine;
      
      (* check if an EOF made us stop *)
      IF TokenCode = EndOfFile THEN
          BugWrite( 'Leaving PicCmd - return 1 ', 0.0 );
          WrapUpPassOne( );  (* if any unlinked elts in pic chain *)
          RETURN TRUE
      END;

      Display( Token );
      FatalError(' Illegal command encountered - further commands ignored' );
      BugWrite( 'Leaving PicCmd - return 2 ', 0.0 );
      RETURN FALSE
  END PicCmd;
      
(*-------------------------------------------------------------------*)
  PROCEDURE PicOrigin( ): BOOLEAN;
  (*
  This procedure implements the rule:
  
      origin "=" "(" RealNumber "," RealNumber ")" ";"
      
  i.e, the coodinates of the top left corner of the entire picture.
  *)
  VAR
      Xc, Yc : REAL;
  BEGIN
      BugWrite( 'Entering PicOrigin ', 0.0 );
      IF TokenCode # origin THEN
          FatalError('The very first command must define the "origin"');  
          RETURN FALSE
      END;
  
      Scan( );
      IF TokenCode = Assignment THEN
          Scan( )
      ELSE
          Warning('Missing "=" after command word "origin"' )   
      END;
      (* Keep going even if no "=" seen *)
      IF TokenCode = OpenParen THEN
          Scan( )
      ELSE
          Warning('Missing "(" after "=" in pic origin cmd.' )
      END;

      IF ( TokenCode = RealNumber ) OR ( TokenCode = IntegerNumber ) THEN
          Xc := Ctor( Token );    (* Keep origin coordinates real *)
          Scan( )
      ELSE
          FatalError('Missing X coordinate of origin');
          RETURN FALSE
      END;
  
      IF TokenCode = Comma THEN
          Scan( )
      ELSE
          Warning('Missing "," after X coordinate' )
      END;
  
      IF ( TokenCode = RealNumber ) OR ( TokenCode = IntegerNumber ) THEN
          Yc := Ctor( Token );    (* Keep origin coordinates real *)
          Scan( )
      ELSE
          FatalError('Missing Y coordinate of origin');
          RETURN FALSE
      END;

      IF TokenCode = CloseParen THEN
          Scan( )
      ELSE
          Warning('Missing ")" after coordinates' )
      END;
  
      IF( TokenCode = EndOfCommand ) OR ( TokenCode = EndOfRecord ) THEN
          Scan( )
      ELSE
          Warning('Missing ; or NEWLINE at end of origin command' )
      END;
  
      SetPicOrigin( Xc, Yc );               
      BugWrite( 'Leaving PicOrigin ', 0.0 );
      RETURN TRUE
  END PicOrigin;

(*-------------------------------------------------------------------*)
  PROCEDURE PassOne( EchoCmds : BOOLEAN (* in *) ): BOOLEAN;
      (*
      This is the only procedure exported from this module. It initiates
      the parsing of all the PIC commands until EOF. Echo can set to true
      if the commands are to be echoed.
      *)
      VAR
          RetVal : BOOLEAN;
      BEGIN
          BugWrite( 'Entering PassOne ', 0.0 );
          Echo := EchoCmds; (* set Echo for LEX *)
          Scan( );     (* Get the first token *)
          RetVal := ( PicOrigin( ) AND PicCmd( ) );
          BugWrite( 'Leaving PassOne ', 0.0 );
          RETURN RetVal
      END PassOne;

(*-------------------------------------------------------------------*)
PROCEDURE PassTwo( 
      GfileName : ARRAY OF CHAR (* in *);
      Device : GDeviceType      (* in *);
      BaudRate : INTEGER     (* in *);
      HardX  : REAL          (* in *);
      HardY  : REAL          (* in *) );
      (*
      This does the actual plotting of the elements. Device can be
      hp7221, hp7550, hp7580, hp7470, hp7475, hp7220, vt125, tek.
      HardX and HardY, in inches define the 
      absolute limit for the picture. No element will be drawn outside
      this boundary. The grahpics commands are written out to GfileName.
      GfileName is created as a fixed length records file, 512 bytes/rec.
      The information is written out as binary WORDS. The BaudRate is
      the speed with which the Computer is to talk to the Graphics device.
      *)
      BEGIN
          GDevice := Device;

          GInitDevice( 0.0, 0.0, HardX, HardY, BaudRate, GfileName );
          GMapWindow( 0.0, 0.0, HardX, HardY );
          GErase( );

          DrawPictures( );
   
          GWrapUp( )

      END PassTwo;

BEGIN  (* Initialization *)
    Pass1Debug := FALSE
END PicPasses.