{ files terminal, output, TTYout & TTYin should be implemented
  with lazy IO if possible}

Program cifSys (
{       Takes Edwin Files:-     } input, output, TTYout,  TTYin,
                                  PDFout, PDFin,

{             Cif Sys Files:-   }  terminal, results              );

{=====================================================================}
{                                                                     }
{     Constant definitions for CifSys.                                }
{     ~~~~~~~~ ~~~~~~~~~~~ ~~~ ~~~~~~~                                }
{                                                                     }
{=====================================================================}

const
    BBCdevice      = 200;

    infinity       = 1073741824;  { 2**30 }

    libMax         = 250; { Maximum number of Symbols allowed in library. }

    maxTstack      = 25;    { the Transformation stack }

    maxElements    = 200;   { The maximum number of elements  }
                            { allowed in a polygon/wire.      }

    maxLnameLength = 4;

    stringMax      = 30;

    expandMax      = 99;

{=====================================================================}
{                                                                     }
{    Constant Definitions for Cif View.                               }
{    ~~~~~~~~ ~~~~~~~~~~~ ~~~ ~~~ ~~~~~                               }
{                                                                     }
{                                                                     }
{=====================================================================}

    maxLinesOnTektronix  =  32;

   visible      = true;       { Passed to CLIP to determine      }
   invisible    = false;      { whether to draw line or move     }

   One          = 32;         { Internal representation of unity }

   NumDev       = 4;          { Number of last EDWIN Device.     }

   NumChar      = 2000;       { Elements in CHAR PDF             }

   MaxString    = 255;        { Size of largest string drawable  }

   MaxLine = 64;

   DC1 = 17;
   SUB = 26;
   Escape = 27;
   GraphMode = 29;
   AlphaMode = 31;
   EraseScreen = 12;
   NUL = 0;
   DEL = 127;

{=====================================================================}
{                                                                     }
{           Global Types.                                             }
{           ~~~~~~ ~~~~~~                                             }
{                                                                     }
{=====================================================================}

   type

    stringLength = 0..stringMax;
    strBodyType  = packed array [ stringLength ] of char;
    string       = record
                    length :stringLength;
                    body   :strBodyType
                   end;

    pointfPtr = ^pointf;
    pointf    = record
                 X, Y  :integer;
                end;

    arrayPtrPointf  = array [1..maxElements] of pointfPtr;

    event           = ( endOfFile, faultDetected );

{=====================================================================}
{                                                                     }
{           Type Definitions for CifSys.                              }
{           ~~~~ ~~~~~~~~~~~ ~~~ ~~~~~~~                              }
{                                                                     }
{=====================================================================}

    layerType = (ND, NP, NM, NI, NG, NB, NC, NX, ZZZ);

    analCifParam = (analysis, normalCall, rotatedCall);

    libRange    = 0..libMax;

    elementPtr  = ^elementType;

    symbolPtr   = ^symbolType;

    symbolType = record
                  ID  :integer;  { The numeric symbol identifier. }

                  lowerPoint,
                  upperPoint  :pointf; { Describing the minimum
                                          bounding box of the Symbol. }

                  EP  :array [ layerType ] of elementPtr;
                       { Points to the data structure of boxes
                          and Symbol calls which make up the Symbol. }

                  valid,
                  deleted,
                  mbb,
                  annot    :boolean;  { ON/OFF, used to limit expansion}
                                      { of the Symbol.                 }

                  comment  :string { The Plap name of the Symbol }
                  end; { of Symbol Definition }

    element   = ( eleSimpleBox, eleBox, eleSymbolCall,
                      eleDefineFinishCommand, elePolygon,
                      eleFlash, eleWire );

    packedCallTrans  = array [0..5] of real;

    recordOfPoints   = ^recOfPoints;

    elementType   = record

                    next  :elementPtr;

                    case whichElement  :element of

                         eleSimpleBox:
                          ( sLower, sUpper  :pointf );

                         eleBox:
                          ( width,
                            length    :stringLength;
                            current,
                            delta     :pointf );

                         eleSymbolCall: 
                          ( ID          :integer;
                            defined     :boolean;
                            packedTrans :packedCallTrans );

                         eleDefineFinishCommand:
                          ( { no field used }  );

                         elePolygon:
                          ( numOfPpoints :stringLength;
                            firstPcoord  :recordOfPoints );

                         eleFlash:
                          ( flashWidth    :stringLength;
                            flashPoint    :pointf );

                         eleWire:
                          ( numOfWpoints  :stringLength;
                            wireWidth     :integer;
                            firstWcoord   :recordOfPoints )

                     end; { Element Definition. }

    recOfPoints        = record
                          next  :recordOfPoints;
                          point :pointf
                         end; { of point Record Definition. }

    findRecord         = record
                          libIndex   :libRange;
                          isPresent  :boolean
                         end; { of findRecord. }


    arrayOfElementPtrs = array [ layerType ] of elementPtr;

    context            = record
                          olValid,
                          errorDetected :boolean;
                          oLayer        :layerType;
                          oEndLayerPtrs :arrayOfElementPtrs;
                          oErrors       :integer
                         end;

    const4string       = array [ 1..maxLnameLength ] of char;

    constLayerArray    = array [ layerType         ] of const4String;

    boolLayerArray     = array [ layerType ] of boolean;

    expandRange        = 0..expandMax;

{=====================================================================}
{                                                                     }
{       The Transformation Stack Types.                               }
{       ~~~ ~~~~~~~~~~~~~~ ~~~~~ ~~~~~~                               }
{                                                                     }
{=====================================================================}

    tStackSize   =  0..maxTstack;
    order        =  0..8;
    matrix       =  array [order] of real;
    matrixRecord =  record
                     M  :matrix
                    end;

    transf       =  array [tStackSize] of matrixRecord;


{=====================================================================}
{                                                                     }
{     Cif View Global Types.                                          }
{     ~~~ ~~~~ ~~~~~~ ~~~~~~                                          }
{                                                                     }
{                                                                     }
{=====================================================================}

    deviceModes   =  ( drawMode, textMode );

    prompts       =  array [ 0..4 ] of char;

   StipplePat = (Hatch1 ,Hatch2, Hatch3, Hatch4, None);

   byte = 0..255;
   alfa = array [1..MaxString] of char;
   ImpString = record
                  Length :0..MaxString;
                  Charno :alfa 
               end;

{=====================================================================}
{                                                                     }
{           Global  Variable  Declarations.                           }
{           ~~~~~~  ~~~~~~~~  ~~~~~~~~~~~~~                           }
{                                                                     }
{=====================================================================}

   var

    results     :text;
    terminal    :text;

    lines,
    statements,
    wErrors,
    fErrors     :integer;

    init,
    ignore,
    lValid,
    inDef,
    debugEdwin,
    debugParser,
    debugSemantics :boolean;

    rScale      :real;

    K           :libRange;

{=====================================================================}
{                                                                     }
{           Cif Sys Variable declarations.                            }
{           ~~~ ~~~ ~~~~~~~~ ~~~~~~~~~~~~~                            }
{                                                                     }
{=====================================================================}

    lib                :array [ libRange ] of symbolPtr;
    fastFind           :array [ libRange ] of findRecord;
    nextDefinition     :librange;

    callLayer,                      { "Constant" which is initialised  }
                                    { to the call Layer (ZZZ).         }
    curLayer           :layerType;

    endLayerPtrs       :arrayOfElementPtrs;
                        { This array points to the last element on     }
                        { each layer of the currently cdefined Symbol. }

    level,              { The required level of Symbol exapnsion. }
    curLevel           :expandRange;  { The present level. }

    curSymbol          :symbolPtr;

    curElement         :elementPtr;

    levelZeroContext   :context;

    mbbUsed,
    forwardRefs        :boolean;

    P,
    PU,
    PL,
    PD                 :pointf;

    curWinXL, curWinXR,
    curWinYB, curWinYT :integer;


    Nmos               :constLayerArray;
                        { This array holds the string names of }
                        { the N-Mos layers.                    }

    TT                 :matrix;

{=====================================================================}
{                                                                     }
{        Own variables used in the Cif Parser.                        }
{        ~~~ ~~~~~~~~~ ~~~~ ~~ ~~~ ~~~ ~~~~~~~                        }
{                                                                     }
{    These are initialised in procedure initAnalyseCif.               }
{                                       ~~~~~~~~~~~~~~~               }
{=====================================================================}

    endOfComment,
    trace,
    NLinComment,
    NLinUserCode       :boolean;

    NL, EM             :char;

{=====================================================================}
{                                                                     }
{          The Transformation Stack Own Variables.                    }
{          ~~~ ~~~~~~~~~~~~~~ ~~~~~ ~~~ ~~~~~~~~~~                    }
{                                                                     }
{=====================================================================}

    stackTop  :tStackSize;
    unity     :matrix;
    tStack    :transf;



   DontBotherUser    :boolean;

   CIFColour         :array [ layerType ] of integer;
                                     {Look-up table for Mead/Conway layers}
                                     {to EDWIN colours.                   }

   CIFStipple,
   DrawingLayers     :boolLayerArray;
                                          {Which layers are we drawing??  }

                                          {Stipple patterns for each layer}
   DefStipple        :array [LayerType] of StipplePat;
                                          {Default stipple patterns for   }
                                          {each layer.                    }

   CurStipple        :StipplePat;
                                          {Stipple pattern currently      }
                                          {being drawn.                   }

   CIFViewLineNum    :1..MaxLinesOnTektronix;
   OutPos     :integer;
   DevNo      :integer;
   InvokeCursor :integer;

   AMode     :boolean;
   Alpha     :boolean;

   SX,
   SY        :integer;

   XR2       :integer;

   Vis2      :boolean;

   TCS       :integer;

   XO,      { Origin (Bottom left) of DEVICE WINDOW }
   YO,

   XS,      { Size of DEVICE WINDOW                 }
   YS,

   CX,      { Current VIRTUAL POSITION              }
   CY,

   XV,      { Size of VIRTUAL WINDOW                }
   YV,

   XL,      { Origin (bottom left) of VIRTUAL WINDOW }
   YB,
   XR,      {  ''    (top right)            ''       }
   YT,

   OTX,     { Last point moved to by VECTOR          }
   OTY,           { used to optimise moves }

   OWXL,    { Old window bounds for ASPECT RATIOing  }
   OWXR,
   OWYB,
   OWYT         : integer;

   Storing,                      { Are we storing the commands produced ? }

   Vis,                          { Is the current point visible ?         }

   Viewing,                      { Are we viewing interactively ?         }

   Clipping     : boolean;       { Is clipping turned off for speed ?     }

   Device       : integer;                          { Current device code }

   RX,                           { Transformation matrix for rotations    }
   RY,

   RA           : array [0..3] of integer;

   MK           : array [0..10] of integer;  { EDWIN Markers for VDUs     }

   Attributes   : array [0..15] of integer;

   DVX,                                               { Default VIEWPORTs }
   DVY          : array [0..NumDev] of integer;

   AspectM,                                    { ASPECT RATIOing defaults }
   AspectD      : array [0..Numdev] of integer;

   XLim,                                   { Max VIEWPORT for each device }
   YLim         : array [0..NumDev] of integer;

   CharPDF      : array [0..NumChar] of integer;   { PDF of Software chars}

   PDFin,                     { Streams for STOREON / REVIEW }
   PDFout,
   TTYout,
   TTYin           : file of char;     { Streams reserved for console I/O }

   GDPColour, GDPsize, GDPstyle :INTEGER;   { OWNS for GDP device driver  } 

{*********************************************************************}
{                                                                     }
{       String  Manipulation  Procedures.                             }
{       ~~~~~~  ~~~~~~~~~~~~  ~~~~~~~~~~~                             }
{                                                                     }
{*********************************************************************}

procedure toString( var STR  :string; ch  :char);
   begin
     with STR do begin
      body[length] := ch;
      length := length + 1
      end;
   end; { To String. }

{!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}

procedure null(var STR   :string);
   var
    I  :stringLength;
   begin
    with STR do begin
         for I := 0 to stringMax do
             str.body[I] := ' ';
         length := 0
         end { with STR }
   end; { null. }

{!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}

procedure trim ( var S  :string );
   var
    I  :stringLength;
   begin
    with S do begin
        if length > 1 then begin
            I := pred ( length );
            while (body [ I ] = ' ') and (I <> 1) do
                  I := pred ( I );
   
            length := succ ( I )
            end
         end
   end; { of Trim. }

{!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}

procedure itos ( num  :integer; var  S  :string );
   var
    nDiv10, I, zero  :integer;
    digit, delta      :stringLength;
   begin
    null ( S );
    zero := ord ('0');
    if num > 9 then begin
     digit := stringMax;
     with S do begin
          while num > 0 do begin
                nDiv10 := num div 10;
                body [ digit ] := chr( num - ( ndiv10 * 10 ) + zero );
                digit := pred ( digit );
                num   := nDiv10
                end;
          digit := succ ( digit );
          delta := stringMax - digit;
          for I := 0 to delta do 
              body[I] := body[I+digit];
          length := delta;
          end { with } 
     end
    else begin
     if num < 0 then num := 0;
     S.body[0] := chr( num + zero );
     S.length  := 1
     end
    end; { itos }

{!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}

{ external } function strEquals ( var body1, body2  :strBodyType;
                                  length  :stringLength           ) :boolean;
             { Compares the bodies of two strings, irrespective }
             { of case e.g. Stop == STOP == stop == StOp.       }

   label
    1;       { Used to return if a match is not found. }
   var{iables}
    CH1,
    CH2  :char;
    I    :stringLength;
   begin
    for I := 0 to pred ( length ) do begin
        CH1 := body1[I]; CH2 := body2[I];
        if CH1 <> CH2 then begin
           if CH1 in ['a'..'z'] then 
              CH1 := chr ( ord(CH1) - 32 );
           if CH2 in ['a'..'z'] then
              CH2 := chr ( ord(CH2) - 32 );
           if CH1 <> CH2 then begin
              strEquals := false;
              goto 1
              end
           end;
        end; { Loop over strings. }

        { Strings Matched. }
        strEquals := true;
1: end; { of String Equals. }

{!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}

procedure swop ( var A,B  :integer );
   var
    dump  :integer;
   begin
    dump := A;
    A    := B;
    B    := dump
   end; { Swop. }

{======================================================================}
{                                                                      }
{   Procedures   that   implement  the  Transformation  Stack.         }
{   ~~~~~~~~~~   ~~~~   ~~~~~~~~~  ~~~  ~~~~~~~~~~~~~~  ~~~~~          }
{                                                                      }
{                                                                      }
{======================================================================}

procedure mTranslate ( X,Y  :integer; var T  :matrix);
   begin
   T := unity;
   T [6] := X;
   T [7] := Y
   end; { of mTranslate }

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

procedure mmX ( var T  :matrix );
   begin
   T := unity;
   T [0] := -1
   end; { of mmX }

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

procedure mmY ( var T  :matrix );
   begin
   T := unity;
   T [4] := -1
   end; { of mmY }

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

procedure mRotate ( A,B  :integer; var T  :matrix);
   function dir ( A, B  :real) :real;
      { Calculates DIR = A/SQRT(A*A + B*B) }
     begin
      dir := A/sqrt(A*A + B*B)
     end; { of function dir }

   begin { mRotate }
   T := unity;
   if (A = 0) and (B = 0) then A := 1;
   T [0] := dir(A,B);
   T [4] := T [0];
   T [1] := dir (B,A);
   T [3] := - T[1]
   end; { of mRotate }

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

procedure matMul ( var A,B,C  :matrix );
   { Performs the matrix multiplication C = A*B on the arrays in parameters. }
   var
    I,J,K  :integer;

   begin
   for I := 0 to  8  do
        C[I] := 0;

   for I := 0 to 2  do
        for J := 0 to 2  do
             for K:=0 to 2  do
                  C[I*3+J] := C[I*3+J] + A[I*3+K] * B[K*3+J]
   end; { of matMul }

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

procedure initTrans;
   var
    i   :integer;
   begin

    { Initilaise the Unity matrix. }
    unity[0] := 1; unity[1] := 0; unity[2] := 0; unity[3] := 0;
    unity[4] := 1; unity[5] := 0; unity[6] := 0; unity[7] := 0;
    unity[8] := 1;

    { Initialise the Transformation Stack. }
    stackTop := 0;
    with tstack[ stackTop ] do
         M := unity

   end; { of initTrans }

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

procedure pushTrans ( var T  :matrix );
   begin
    if stackTop = maxTstack then begin
       writeLn('*** Transformation Stack Error:-');
       writeLn('    >>> stack full !')
       end;

    stackTop := succ(stackTop);
    matmul( T, { * present Transformation } tStack[pred(stackTop)].M,
          { => }   tStack[stackTop].M                              );

  end; { of push trans }

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

procedure popTrans;
   begin
    if stackTop = 0 then begin
       writeLn('*** Transformation Stack Error:-');
       writeLn('    >>> stack empty !')
       end;

    stackTop := pred(stackTop)
   end; { of popTrans }

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

procedure transPoint ( var P, NP  :pointf );
   begin
    { Transforms a point P to NP under the current transformation. }
    with tStack[stackTop], P do begin
         NP.X := round( X*M[0] + Y*M[3] + M[6] );
         NP.Y := round( X*M[1] + Y*M[4] + M[7] )
         end
   end; { of transPoint }

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

procedure transVector ( var V, VN  :pointf );
   begin
    { Transforms the vector V to VN under the current transformation }
    with tStack[stackTop], V do begin
         VN.X := round( X*M[0] + Y*M[3] );
         VN.Y := round( X*M[1] + Y*M[4] )
         end
   end; { of transVector }

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

procedure transInquire ( var TX  :matrix );
    begin
     with tStack[stackTop] do TX := M
    end; { of inquire Transformation }

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

procedure printMatrix ( var T  :matrix );
   begin { only used if debugging information is required. }
    writeLn(T[0]:3:1, T[1]:3:1, T[2]:3:1 );
    writeLn(T[3]:3:1, T[4]:3:1, T[5]:3:1 );
    writeLn(T[6]:3:1, T[7]:3:1, T[8]:3:1 )
   end; { of printMatrix }


{=====================================================================}
{                                                                     }
{        Data   Structure   Primitives.                               }
{        ~~~~   ~~~~~~~~~   ~~~~~~~~~~~                               }
{                                                                     }
{=====================================================================}

{ external } procedure attachSymbolToDataStructure ( name  :integer );
   var
    I  :layerType;
   begin
    new ( curSymbol );
    lib [ nextDefinition ] := curSymbol;

    with curSymbol^ do begin
         ID      := name;
         null( comment );
         valid   := false;
         deleted := false;
         mbb     := false;
         annot   := false;
         for I := ND to callLayer do
             EP [ I ] := nil;

         { The Bounding Box of the Symbol is initialised to }
         { impossibly large values.                         }
         lowerPoint.X :=  infinity;
         lowerPoint.Y :=  infinity;
         upperPoint.X := -infinity;
         upperPoint.Y := -infinity
         end;

    for I := ND to callLayer do
        endLayerPtrs [ I ] := nil;

    if ( 0 <= name ) and  ( name <= libMax ) then
       with fastFind [ name ] do begin
            libIndex  := nextDefinition;
            isPresent := true
            end;

    nextDefinition := succ ( nextDefinition );

   end; { of Attach Symbol To Data Structure. }

{!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}

{ external } procedure initLevelZero;
   var
    I      :layerType;
    chip   :array [0..4] of char;
    K      :0..4;
   begin
    for I := ND to callLayer do endLayerPtrs[I] := nil;

    chip := '#chip';

    attachSymbolToDataStructure ( 0 );

    with curSymbol^ do
         with comment do begin
              for K := 0 to 4 do
                  body [ K ] := chip [ K ];
              length := 5
              end;

    with levelZeroContext do begin
         oErrors       := 0;
         errorDetected := false
         end;

   end; { of Init Level Zero. }

{!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}

{ external } procedure addEle ( selected  :element );
   { This procedure adds an element ( e.g. Box )  to the string   }
   { of elements on current Symbol definition, at  the currently  }
   { selected layer.                                              }
   var
    newPtr  :elementPtr;
    I       :0..5;
   begin
    case selected of

         eleSimpleBox:
            begin
             new ( newPtr, eleSimpleBox );
             newPtr^.whichElement := eleSimpleBox
            end;

         eleBox:
            begin
             new ( newPtr, eleBox );
             newPtr^.whichElement := eleBox
            end;

         eleSymbolCall:
            begin
             new ( newPtr, eleSymbolCall );
             with newPtr^ do begin
                  whichElement := eleSymbolCall;
                  defined      := false;
                  for I := 0 to 5 do
                      packedTrans [ I ] := 0
                  end { with. }
            end;

         eleDefineFinishCommand:
            begin
             new ( newPtr, eleDefineFinishCommand );
             newPtr^.whichElement := eleDefineFinishCommand
            end;

         elePolygon:
            begin
             new ( newPtr, elePolygon );
             with newPtr^ do begin
                  whichElement := elePolygon;
                  numOfPpoints  := 0;
                  firstPcoord   := nil
                  end
            end;

         eleFlash:
            begin
             new ( newPtr, eleFlash );
             with newPtr^ do begin
                  whichElement := eleFlash;
                  flashWidth := 0
                  end
            end;

         eleWire:
            begin
             new ( newPtr, eleWire );
             with newPtr^ do begin
                  whichElement := eleWire;
                  numOfWpoints := 0;
                  wireWidth    := 0;
                  firstWcoord  := nil
                  end
            end

      end; { case Selected of. }

    newPtr^.next := nil;

    if curSymbol^.EP [ curLayer ] <> nil then
       curElement^.next := newPtr
    else
       curSymbol^.EP [ curLayer ] := newPtr;

    curElement       := newPtr;
    curElement^.next := nil;

    endLayerPtrs [ curLayer ] := curElement
   end; { of Add Element. }

{!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}

{ external } procedure addTrans ( var T  :matrix );
   begin
     { Add the matrix T to the transformation field of }
     { the Symbol Call.                                }

     with curElement^ do
      if whichElement = eleSymbolCall then begin
          packedTrans[0] := T[0];
          packedTrans[1] := T[1];

          packedTrans[2] := T[3];
          packedTrans[3] := T[4];

          packedTrans[4] := T[6];
          packedTrans[5] := T[7]
          end
       else begin
          writeLn('*** Data Structure fault:-');
          writeLn('    >>> wrong tag field in addTrans');
          writeLn('        >>> eleSymbolCall expected.')
          end

   end; { of addTrans. }

{!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}

{ external } procedure getTrans 
                          ( var { from    } packedTrans  :packedCallTrans;
                            var { returns } T            :matrix           );

   begin
    T[0] := packedTrans[0];
    T[1] := packedTrans[1];
    T[2] := 0;
    T[3] := packedTrans[2];
    T[4] := packedTrans[3];
    T[5] := 0;
    T[6] := packedTrans[4];
    T[7] := packedTrans[5];
    T[8] := 1
   end; { of Get Transformation. }

{!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}

{=====================================================================}
{           Fault / Warning  Procedures.                              }
{           ~~~~~   ~~~~~~~                                           }
{=====================================================================}

procedure warn;
   begin
    write('? Line', lines:4,'  ');
    wErrors := wErrors + 1;
   end; { of warn }

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

procedure fault;
   begin
    write('* Line', lines:4,'  ');
    fErrors := fErrors + 1;
   end; { of fault }

{=====================================================================}
{                                                                     }
{      Semantic  Analysis of Cif:                                     }
{      ~~~~~~~~  ~~~~~~~~ ~~ ~~~~                                     }
{       Called from the Cif Parser, the following set of              }
{       procedures check the correctness of Cif and construct         }
{       the data structure.                                           }
{                                                                     }
{       "D" "W" stands for Deal With, no doubt you were wondering!    }
{                                                                     }
{=====================================================================}

procedure debugPrintSym;
   begin
    with cursymbol^ do begin
         writeLn(results,' curSymbol = ');
         writeLn(results,' CS.ID=',ID:1);
         writeLn(results,' CS.mbb=');
         if mbb then writeLn(results,' true.')
                else writeLN(results,' false.');
         end;
   end;

{!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}

procedure boundCheck ( var P  :pointf );
   begin
    with curSymbol^, P  do begin
         if X < lowerPoint.X then
            lowerPoint.X := X
         else if  X > upperPoint.X then
            upperPoint.X := X;

         if Y < lowerPoint.Y then
            lowerPoint.Y := Y
         else if Y > upperPoint.Y then
            upperPoint.Y := Y
         end
   end; { of bound check. }

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function find ( ID  :integer )  :integer;
   label 1;
   var
    libIndex  :libRange;
   begin

    if ( 0 <= ID ) and ( ID <= libMax ) then
       if fastFind[ID].isPresent then begin
          find := fastFind [ ID ].libIndex;
          goto 1 { return:- the Symbol ID was found. }
          end;

    for libIndex := 0 to pred(nextDefinition) do
        if lib[libIndex] <> nil then
           if ID = lib[libIndex]^.ID then begin
              find := libIndex;
              goto 1 { return:- the symbol ID was found. }
              end;

    find := -1; { Symbol not in library. }

1: end; { of find }

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

{ external } procedure dwBox ( L, W  :integer;  P, D  :pointfPtr );
   label
    1;        { Used to Return from this procedure. }
   var
    NS  :integer;
    PL, PU  :pointf;
   begin
    if ignore then goto 1; { Return if a foult was found. }

    if (D^.X = 0) or (D^.Y = 0) then begin
       { Simple box. }
       if D^.X = 0 then swop(L, W);
       with PL do begin
            X := P^.X - L  div 2;
            Y := P^.Y - W  div 2
            end;
       with PU do begin
            X := P^.X + L  div 2;
            Y := P^.Y + W  div 2
            end;
       addEle (eleSimpleBox);
       with curElement^ do begin
            sLower := PL;
            sUpper := PU
            end { The simple box is now connected. }
       end
     else begin { Normal Box. }
       { To save calculation a bad (i.e. too large ) estimate is found. }
       if L > W then
          NS := L
       else
          NS := W;
       with PL do begin
            X := P^.X - NS;
            Y := P^.Y - NS
            end;
       with PU do begin
            X := P^.X + NS;
            Y := P^.Y + NS
            end;
       addEle ( eleBox );
       with curElement^ do begin
            width := W;
            length := L;
            current := P^;
            delta   := D^
            end { The new box is now connected to the data structure. }
       end; { Boxes }
       boundCheck ( PL );
       boundCheck ( PU );
1: end; { of D W Box. }

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

{ external } procedure dwCall ( sym  :integer; var TX  :matrix);
   label
    1;   { Return if a fault is found. }
   var
    foundID  :integer;
    PU, PL :pointf;
    L  :layerType;
   begin
    if ignore then goto 1; { return }

    if sym = curSymbol^.ID then begin
       fault; writeLn('Recursive Calls are not allowed');
       goto 1  { return }
       end;

    foundID := find ( sym );
    if foundID < 0 then
       forwardRefs := true;

    if not forwardRefs then begin
       { Calculate BB as analysis is done. }
       pushTrans  ( TX );
       transPoint ( lib[foundID]^.lowerPoint, PL );
       transPoint ( lib[foundID]^.upperPoint, PU );
       if PL.X > PU.X then
          swop ( PL.X, PU.X );
       if PL.Y > PU.Y then
          swop ( PL.Y, PU.Y );
       boundCheck ( PL );
       boundCheck ( PU );
       popTrans
       end;

   { Now add the call onto the Call Layer of the present symbol. }

   { Remember the current layer. }
   L  :=  curLayer;

   { Switch to the Calling Layer. }
   curLayer   := callLayer;
   curElement := endLayerPtrs [ curLayer ];

   addEle ( eleSymbolCall );
   with curElement^ do
        if foundID > 0 then begin
           defined := true;
           ID := foundID
           end
        else begin
           defined := false;
           ID := sym
           end;

    addTrans ( TX );

    { Switch Back to the original layer. }
    curLayer  :=  L;

1: end; { of dwCall. }

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

{ external } procedure dwDef ( ID  :char; info  :integer );
   label
    1;    { Return if a fault is detected. }
   var
    I  :libRange;
    inSequence  :boolean;
   begin
    if ID = 'S' then begin { Define Start Command }
       if nextDefinition > libMax then begin
          fault; writeLn('Too many symbol definitions');
          goto 1  { return }
          end;

       if find( info ) > 0 then begin
          warn; writeLn('Multiple definition of symbol ',info:1)
          end;

       { Save level Zero Context. }
       with levelZeroContext do begin
            if not errorDetected then
               if fErrors - oErrors <> 0 then
                  errorDetected := true
               else
                  oErrors       := fErrors;

            olValid       := lValid;
            oLayer        := curLayer;
            oEndLayerPtrs := endLayerPtrs
            end; { Level Zero Context. }

       attachSymbolToDataStructure ( info );

       if debugSemantics then debugPrintSym
       end

    else if ID = 'F' then begin  { Define Finish Command. }
       with curSymbol^ do begin
            annot := true;
            if info = 0 then
               valid := true
            else
               mbb := true
            end; { with curSymbol }

       { Recover level zero context. }
       with levelZeroContext do begin
            lValid       := olValid;
            oErrors      := fErrors;
            curLayer     := oLayer;
            endLayerPtrs := oEndLayerPtrs;
            curElement   := endLayerPtrs [ curLayer ];
            curSymbol    := lib [ 0 ]
            end
       end

    else if ID = 'D' then begin { Definition Delete Command. }
         inSequence := true;
         for I := pred(nextDefinition) downto 1 do begin
             with lib [ I ]^ do
               if ID >= info then begin
                  if ( 0 <= ID ) and ( ID <= libMax ) then
                     fastFind[ ID ].isPresent := false;

                  lib[I] := nil; { not using dispose yet!!! }

                  if inSequence then
                     nextDefinition := pred( nextDefinition )
                  end
               else
                  inSequence := false;
             end { loop over symbol library. }
         end; { Delete Command. }

    if debugSemantics then begin
       writeLn(results,' Returning from dwDef');
       end;

1: end; { of dwDef }

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

{ external } procedure dwEnd;
   var
    CS         :symbolPtr;
    first      :elementPtr;
    I          :libRange;
   procedure findBB ( CS         :symbolPtr;
                      elePtr     :elementPtr;
                      libIndex   :libRange          );
      var
       newSymbol  :symbolPtr;
       name       :integer;
       TX  :matrix;
      begin
       while elePtr <> nil do begin
            with elePtr^ do begin
                 { Pick up the transformation from field }
                 { "packedTrans" of element.             }
                 getTrans ( packedTrans, TX );
                 name := ID;

                 if not defined then
                    name := find ( ID );

                 if name < 0 then begin
                    warn;
                    writeLn('Symbol ',CS^.ID:1,
                            ' uses undefined symbol ',ID:1);
                    with CS^ do begin
                         mbb   := true;
                         valid := false
                         end { with CS^ }
                    end
                 else begin { Symbol is found. }
                    newSymbol := lib [ name ];
                    with newSymbol^ do
                         if EP [ callLayer ] <> nil then
                            findBB ( newSymbol, EP[ callLayer ], name );
    
                    { The Bounding Box of this symbol is now known. }

                    { Global assignment for Bound Check. }
                    curSymbol := lib [ libIndex ];

                    pushTrans ( TX );

                    transPoint ( newSymbol^.lowerPoint, PL );
                    transPoint ( newSymbol^.upperPoint, PU );

                    if PL.X > PU.X then
                       swop ( PL.X, PU.X );
                    if PL.Y > PU.Y then
                       swop ( PL.Y, PU.Y );
    
                    boundCheck ( PL );
                    boundCheck ( PU );

                    popTrans
                    end
                 end; { with elePtr^ }
                 elePtr := elePtr^.next
             end { Loop over all Symbol calls. }
     end; { findBB. }

   procedure closeLevelZeroDefs;
      var
       usedLevelZero  :boolean;
       I              :layerType;
      begin
       { If there are no level zero elements then }
       { delete the entry from the library.       }
       with curSymbol^ do begin
            usedLevelZero := false;
            for I := ND to callLayer do 
                if EP[I] <> nil then usedLevelZero := true
            end;

       if not usedLevelZero then begin
          { Delete Entry. }
          lib [ 0 ]              := nil;
          fastFind [0].isPresent := false
          end
       else
          with levelZeroContext do begin
               if not errorDetected then
                  if fErrors - oErrors <> 0 then
                     errorDetected := true;

               with curSymbol^ do begin
                    annot := true;
                    if not errorDetected then
                       valid := true
                    else
                       mbb   := true
                    end
               end { Level Zero Context. }

      end; { Close Level Zero Definitions. }

   begin    {  dwEnd. }

      closeLevelZeroDefs;

      if forwardRefs then
         { Satisfy the forward references. }
         for I := pred ( nextDefinition ) downto 0 do begin
             CS := lib [ I ];
             if CS <> nil then begin
                first := CS^.EP [ callLayer ];
                if first <> nil then
                   findBB ( CS, first, I )
                end
             end { Loop over library. }
   end; { of D W END. }

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

{ external } procedure dwLayer ( var S  :string );
   var
    L          :const4string;
    I          :stringLength;
    newLayer,
    J          :layerType;
   begin
    L := '    ';
    ignore := false;

    with S do
         for I := 0 to pred(maxLnameLength) do
             L[succ( I )] := body[ I ];

    newLayer := ZZZ;
    J        := ND;
    while J<>ZZZ do begin
          if L = Nmos[ J ] then
             newLayer := J;
          J := succ ( J )
          end; { loop over Layer. }

    if newLayer <> ZZZ then begin
       curElement  := endLayerPtrs [ newLayer ];
       curLayer    := newLayer
       end
    else begin
       warn; writeLn('Unknown layer name ',L:4,' (ignored).');
       ignore := true
       end

   end; { of dwLayer. }

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

{ external } procedure dwPolygon ( NP  :integer;
                                  var P  :arrayPtrPointf );
                                 { var P  :recordOfPoints ); }
   begin
    writeLn(results,' dwPolygon (',NP:1,')');
   end; { of dwPolygon }

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

{ external } procedure dwRound ( width  :integer;
                                 var centre  :pointfPtr );
   begin
    writeLn(results,'  dwRound (',width:1,')');
   end; { of dwRound. }

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

{ external } procedure dwWire ( width, numPoints  :integer;
                               P      :arrayPtrPointf );
                              { P                 :recordOfPoints ); }
   begin
    writeLn(results,' dwWire (',width:1,',',numPoints:1,')');
   end; { of dwWire }

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

{ external } procedure dwComment ( comment  :string );
   begin
    { Comments Ignored. }
    if debugSemantics then
        writeLn(results,' dwComment ("',comment.body:31,'")');

   end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

{ external } procedure dwUserCode ( command  :integer;
                                    line     :string );
   begin
    if command = 9 then begin
       if debugSemantics then begin
          writeLn(results,' dwUserCode line before curSymbol^');
          end;

       curSymbol^.comment := line
       end
    else begin
       warn; writeLn('User code ',command:1,' ignored')
       end;
    if debugSemantics then begin
       writeLn(results,' returning from dwUserCode(',command:1,' line = ');
       writeLn(results,'    "',curSymbol^.comment.body:10,'"');
       end;
   end; { of dwUserCode. }

{=====================================================================}
{                                                                     }
{            Analyse  Cif, the CIF parser.                            }
{            ~~~~~~~  ~~~  ~~~ ~~~ ~~~~~~~                            }
{                                                                     }
{=====================================================================}

{ external } procedure analyseCif ( var lines,
                                        statements,
                                        wErrors,
                                        fErrors  :integer );


   { Labels are only ever used for exit, continue, or result statements}
   label
    1,2,3,4,50,777;

   const
    layerNotValid ='No layer is currently defined';
    maxValidInt   = maxInt; { should be 24 bits }

   var
    nest,
    X,
    Y,
    L,
    W,
    ID,
    sFaults,
    numElements   :integer;

    P, D           :pointfPtr;

    TT,
    OT,
    NT            :matrix;

    STR           :string;

    points  :arrayPtrPointf;

    NS,
    command  :char;

    signal   :event;

{!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}
{ Primitive procedures added by GHMS on 14:12:81                   }
{ ~~~~~~~~~ ~~~~~~~~~~ ~~~~~ ~~ ~~~~ ~~ ~~~~~~~~                   }

procedure initAnalyseCif;
   var
    I  :1..maxElements;
   begin
    { initialise the owns }
    trace := false;
    NLinUserCode := false;
    NLinComment  := false;
    NL := chr( 10 );
    EM := chr( 0  );

    { set up array of pointers }
    for I := 1 to maxElements do new (points[I]);
    new(P);  new(D);

    rScale := 1;
    inDef  := false;
    init   := true;

   end;

{---------------------------------------------------------------------}

procedure readSymbol ( var ch  :char);
   begin
    if trace then
         writeLn (results,'>>> IN read symbol');
    if eof then begin
       if debugParser then
          writeLn(' End of file reached in readSymbol ');
       signal := endOfFile;
       goto 777
       end
    else if eoln then begin
       ch := NL;
       readln
       end
    else
       read(ch);
   end;

{---------------------------------------------------------------------}

function nextSymbol  :char;
   begin
    if trace then
        writeLn (results,'>>> IN next symbol ');
    if eof then begin
      if debugParser then
         writeLn(results,' Next symbol = end of file ');
      signal := endOfFile;
      goto 777;
      end
    else if eoln then
      nextSymbol := NL
    else
      nextSymbol := input^
   end;

{---------------------------------------------------------------------}

procedure skipSymbol;
   var CH  :char;
   begin
   if trace then writeLn(results,'>>> IN skip symbol');
    if eof then begin
       if debugParser then
          writeLn(results,' Skipping past the end of file marker');
       signal := endOfFile;
       goto 777
       end
    else if eoln then
      readLn
    else
      read ( CH )
   end; { of Skip Symbol. }

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

procedure  skipSym; forward ;


{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

procedure fail ( mode  :char);
   begin
    write ( mode,'  Line', lines:4,'  ')
   end; { of reason }

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

procedure warn;
   begin
   fail ('?');
   wErrors := wErrors + 1;
   end; { of warn }

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

procedure fault;
   begin
   fail ('*');
   fErrors := fErrors + 1;
   if command<>'E' then begin
       repeat skipSymbol until nextSymbol = ';';
       skipSymbol
   end; { of if block }
   ignore := true;
   end; { of fault }

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

procedure signalFault;
   begin
    signal := faultDetected;
    goto 777
   end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

procedure skipSym;
   begin
   if nextSymbol = NL then lines := lines + 1;
   skipSymbol;
   end; { of skipSym }

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function blank  :boolean;
   var NS  :char;
   begin
    NS := nextSymbol;
    if NS in ['A'..'Z','0'..'9','-',')','(',';'] then
       blank := false
    else
       blank := true
   end; { of blank }

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

procedure skipBlanks;
   begin
    while blank do skipSym;
   end; { of skipBlanks }

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

procedure skipSeps;
   begin
     while (nextSymbol in ['A'..'Z']) or blank do skipSym
   end; { of skipSeps }


{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function getInt ( var D  :integer) :boolean;
   label 1;
   var
    NS    :char;
    sign  :integer;
   begin
   skipSeps;
   NS := nextSymbol;
   if NS in ['0'..'9'] then
      sign := 1
   else if NS = '-' then begin
      sign := -1;
      skipSymbol;
      NS := nextSymbol
      end
   else begin { symbol is not an integer }
      getInt := false;
      goto 1    { result }
      end;

   D := 0;
   while NS in ['0'..'9'] do begin
      if D > maxValidInt div 10 then begin
         fault; writeLn ('Integer too large'); signalFault
         end;
      D := D * 10 + ord(NS) - ord('0');
      skipSymbol;
      NS := nextSymbol;
   end; { of while loop }
   D := D * sign;
   getInt := true;
    if debugParser then writeLn(results,'>>> getInt D=',D:1,'  ');
 1:end; { of getInt }


{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function getPoint (var P  :pointfPtr)  :boolean;
   begin
    if getInt (P^.X) then begin
       if not getInt(P^.Y) then begin
          fault; writeLn ('Point in path only contains one digit');
          signalFault
          end;
       if command<>'C' then begin { Call parameters are scaled later }
           P^.X := round(P^.X * rScale);
           P^.Y := round(P^.Y * rScale);
       end; { of  command <> 'C' }
       getPoint := true;
       end
   else
       getPoint := false;

  if debugParser then writeLn(results,'getPoint p^.x=',P^.X:1,' p^.y=',P^.Y:1);
  end; { of getPoint }

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

procedure checkSemi;
   begin
   skipBlanks;
   if nextSymbol <> ';' then begin
      fault; writeLn ('Semi-colon missing'); signalFault
      end;
   skipSymbol;
   end; { of checkSemi } 

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

procedure getPath;
   { Read a path of co-ordinates }
   var
    P,NP  :pointfPtr;
    CH    :char;

   begin
   if not getPoint (points[1]) then begin
      fault; writeLn ('No points in Polygon or Wire path'); signalFault
      end;
   numElements := 2;
   while getPoint (points[numElements]) do begin
      P := points [numElements-1]; {!!!!}
      NP := points [numElements]; {!!!!}
      if not( ((numElements > 1) and (P^.X = NP^.X)) and
              (P^.Y = NP^.Y)) then
              numElements := numElements + 1;
      if numElements > maxElements then begin
         fault; writeLn ('Too many points in path'); signalFault
         end
   end; { of while loop }
   if nextSymbol <> ';' then begin
      warn; writeLn ('Redundant information after path description')
      end;
   repeat
      readSymbol (CH);
      if ch = NL then lines := lines + 1;
   until CH=';' { repeat loop };
   numElements := numElements -1 ; { To balance  the books! }
   end;  { of getPath }


{++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function getUsInt ( var D  :integer )  :boolean;
   { This is called when an Un-signed integer is required }
   begin
   if getInt (D) then begin
      if D<0 then begin
         fault; writeLn ('Un-wanted negative integer ', D :1);
         signalFault
         end;
      getUsInt := true
      end
   else  { getInt (D) = false }
      getUsInt := false;

   end; { of getUsInt }

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

procedure getLayerName ( var S  :string);
   label 1;
   var
    NC  :char;
   begin
   skipBlanks;
   NC := nextSymbol;
   if not (NC in ['A'..'Z','0'..'9']) then begin
      fault; writeLn ('Invalid symbol "',NC,'" in layer name'); signalFault
      end;
   null(S);
   repeat
      skipSymbol;
      toString(S,NC);
      if S.length >= maxLnameLength then begin
         fault; writeLn ('Layer name "',S.body:6,'" too long');
         null(S);
         signalFault;
         goto 1
         end;
      NC := nextSymbol;
   until not (NC in ['A'..'Z','0'..'9']);
 1: { exit point }
   if NC = NL then lines := lines + 1;
   end; { of layerName }

 {~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
   begin { procedure ANALYSE CIF }
         {           =========== }

    {on event endOfFile,fault } if false then begin
       777: { When a fault is detected then }
            { analysis starts at the next command }
       if signal = endOfFile then begin
          warn; writeLn ('Unexpected end of CIF, End assumed');
          command := 'E'
          end;
       if command = 'E' then begin
          dwEnd;
          init := false;
          goto 50
          end;
   end; { of event block }

   if not init then initAnalyseCif;

   repeat { for ever }

      skipBlanks;
      readSymbol (command);
      if debugParser then
         writeLn (results,'>>> Command="',command,'"',lines:1);
      statements := statements + 1;
   if command in ['B','C','D','E','L','P','R','W',';','(','0'..'9'] then
      case command of 

'B':  begin { Box }
         if not getUsInt (L) then begin
            fault; writeLn ('Invalid Box length specification');
            signalFault;
            end;
         L := round(L * rScale);
         if not getUsInt (W) then begin
            fault; writeLn ('Invalid Box width specification'); signalFault
            end;
         W := round(W * rScale);
         if not getPoint (P) then begin
            fault; writeLn ('Box centre point wrong'); signalFault
            end;
         { Optional direction vector may follow }
         if not getInt(D^.X) then D^.X := 1;
         if not getInt(D^.Y) then D^.Y := 0;
         checkSemi;
         if not ignore then begin
             if not lValid then begin
                fault; writeLn(layerNotValid); signalFault
                end;
             dwBox (L, W, P, D)
             end
         end; { box }

'C':  begin { Call definition with possible transformation }
         if not getUsInt (x) then begin
             fault;
             writeLn ('Invalid definition description ',nextSymbol); signalFault
             end;
         { Optional transformation now follows. }
         { Set NT and OT to be unit transformations }
          NT := unity;    OT := unity;

         while true do begin
            skipBlanks;
            readSymbol (NS);
            if NS = ';' then goto 1 { exit };
            if not (NS in ['M','T','R']) then begin
               fault; writeLn('Invalid symbol call transformation',NS,'"');
               signalFault
               end;
            if NS = 'T' then begin
                if not getPoint (P) then begin
                   fault;
                   writeLn('Invalid symbol call Transformation Vector');
                   signalFault;
                   end;
                P^.X := round(P^.X * rScale);
                P^.Y := round(P^.Y * rScale);
                mTranslate (P^.X, P^.Y, TT)
                end
            else if NS='M' then begin
                skipBlanks;
                readSymbol (NS);
                if NS = 'X' then
                   mmX (TT)
                else if NS = 'Y' then
                   mmY (TT)
                else begin { not an X or Y symbol }
                   fault; writeLn ('Invalid symbol call mirroring operation');
                   signalFault
                   end
                end { NS = 'M' }
            else if NS='R' then begin
                if not getPoint (D) then begin
                   fault; writeLn ('Invalid symbol call Rotation vector');
                   signalFault
                   end;
                mRotate (D^.X, D^.Y, TT)
                end;
            matMul (OT,TT,NT);
            { Copy NT to OT (Old Tx becomes Newest Tx) }
            OT := NT;
         end; { of while loop }

     1:  { exit }
         if not ignore then
            dwCall (X, NT);
         end; { of 'C' ( call definition ) }

'D': begin {Start, End, Delete defn }
         ignore := false;
         { Coming back to normal analysis to give better error mess. }
         skipBlanks;
         readSymbol (NS);
         if not (NS in ['F','S','D']) then begin
            fault; writeLn ('Invalid symbol definition operation',NS,'"');
            signalFault
            end;

         if NS='F' then begin { No more parameters }
             checkSemi;
             if not inDef then begin
                fault; writeLn ('Too many Definition Finishes'); signalFault
                end;
             dwDef ('F', fErrors-sFaults);
             inDef := false;
             rScale := 1;
             goto 2; { continue }
         end; { of if block }

         if not getUsInt (ID) then begin
            fault; writeLn ('Invalid definition description ',nextSymbol);
            signalFault
            end;
         if NS='D' then begin
             checkSemi;
             Y := 0;
             if inDef then begin
                 fault; writeLn ('DD is not allowed inside a definition');
                 signalFault
                 end;
             dwDef ('D',ID);
             goto 2; { continue }
         end; { of if block }

         { Optional scaling factor }
         if not getUsInt (X) then X := 1;

         if X = 0 then begin
            warn; writeLn ('Zero value for DS scaling ignored');
            X := 1
            end;

         if not getUsInt (Y) then Y := 1;
         if Y=0 then begin
             warn;
             writeLn ('DS scaling factor included a division by 0 - IGNORED');
             rScale := 1;
             end
         else
             rScale := X/Y;

     checkSemi;
     if inDef then begin
        warn; writeLn ('Missing Definition Finish')
        end;
     dwDef ('S',ID);
     inDef   := true;
     lValid  := false;
     sFaults := fErrors; { Used to find if any faults occurred during defn. }
  2: { continue }
     end; { of 'D' ( start,delete,end  definion ) }

'E': begin { End }
         if inDef then begin
            fault; writeLn ('Missing Definition finish'); signalFault
            end;
         init := false ; { To allow for resetting on next call. }
         dwEnd;
         goto 50 { exit }
         end; { End }

'L': begin { Layer specification }
         getLayerName (STR);
         checkSemi;
         ignore := false;
         lValid := true;
         dwLayer (STR);
         end; { Layer spec }

'P': begin { Polygon }
         getPath;
         if not ignore then begin
            if not lValid then begin
               fault; writeLn(layerNotValid); signalFault
               end;
            dwPolygon (numElements, points)
            end
         end; { of Polygon }

'R': begin { Round Flash }
         if not getUsInt(W) then begin
            fault; writeLn ('Invalid flash diameter spec'); signalFault
            end;
         W := round(W * rScale);
         if not getPoint(P) then begin
            fault; writeLn ('Flash centre not correctly specified'); signalFault
            end;
         checkSemi;
         if not ignore then begin
             if not lValid then begin
                fault; writeLn (layerNotValid); signalFault
                end;
            dwRound (W, P)
            end
         end; { of 'R' ( Round flash ) }

'W': begin { Wire }
         if getUsInt(W) then begin
            fault; writeLn ('Invalid wire width spec'); signalFault
            end;
         W := round(W * rScale);
         getPath;
         if not ignore then begin
             if not lValid then begin
                fault; writeLn (layerNotValid); signalFault
                end;
            if numElements=1 then
               dwRound (W, points[1]) 
            else
               dwWire (W, numElements, points);
            end  { if not ignore }
     end; { 'W' ( wire ) }

';': begin { Ignore separators }
     end;

'(': begin { Comment }
     endOfComment := false;
     repeat { for all comments }
         nest := 1;
         null (STR);
         repeat
            repeat
               readSymbol (NS);
               if STR.length < stringMax then toString(STR,NS);
            until NS in [')','(',NL];
            if ns = ')' then nest := nest - 1;
            if nest = 0 then
               goto 3 { exit }
            else if NS = '(' then
               nest := nest +1
            else if NS = NL then begin;
                lines := lines + 1;
                if not NLinComment then begin
                   warn; writeLn ('Comment crosses line boundary')
                   end;
                NLinComment := true;
            end; { of NS = NL }
         until false;
      3: { exit point }
         skipBlanks;
         if nextSymbol = '(' then { more comments }
            skipSymbol
         else
            endOfComment := true;
  until endOfComment;
  checkSemi;
  with STR do length := length - 1; { Loose the last ')' }
  dwComment (STR);
  end; { of '(' comment }

'0', '1', '2', '3', '4', '5', '6', '7',
'8', '9': begin { User expansions }
         null(STR);
         while nextSymbol = ' ' do skipSymbol;
         repeat { for ever }
            { Only 1st. 255 chars of comment significant }
            readSymbol (NS);
            if debugParser then begin
               writeLn (results,' in Repeat loop NS=',NS);
               end;

            if NS = ';' then
               goto 4 { exit }
            else if NS = NL then begin
               if not NLinUserCode then begin
                  warn; writeLn ('User Code string crosses line boundary')
                  end;
               NLinUserCode := true;
               end;

            if STR.length < stringMax then toString ( STR, NS );
         until false;
      4: { exit point }
         trim ( STR );
         if debugParser then begin
            writeLn(results,' Calling DwUserCode');
            end;

         dwUserCode ( ord(command) - ord('0'), STR)
         end; { of User expansions }

     end { case statement }

{ otherWise } else begin
    fault; writeLn ('Invalid command symbol "',command,'"'); signalFault
    end; { otherWise }
until false;
50:  { exit point ( command = 'E' ) }

   end; { of ANALYSE CIF }

(*          MACHINE DEPENDENT SECTION         *)

function LOGOR (A, B :integer) :integer;
   begin
      LOGOR := A + B
   end;

function LOGAND (A, B :integer) :integer;
   begin
      LOGAND := A MOD (B+1)
   end;

function EXOR (A, B :integer) :integer;
   begin
      EXOR := A + B - LOGAND (A, B)
   end;

function LOGNOT (A :integer) :integer;
   begin
      LOGNOT := -1 - A
   end;

function SHIFTL (A, B :integer) :integer;
   begin
      while B > 0 do begin
         A := A * 2;
         B := B - 1
      end;
      SHIFTL := A
   end;

function SHIFTR (A, B :integer) :integer;
   begin
      while B > 0 do begin
         A := A DIV 2;
         B := B - 1
      end;
      SHIFTR := A
   end;

procedure StartIo;
   begin
   end;

function TTGet :integer;
var
   ch :char;
   begin
      ReadLn (TTYin, ch);
      TTGET := ORD (ch)
   end;

procedure FlushOutput;
begin
   if Outpos <> 0 then begin
(*                 MACHINE DEPENDENT SECTION              *)
      Flush (TTYout);   {Non-standard FLUSH}
(*              END OF MACHINE DEPENDENT SECTION          *)
   end;
   OutPos := 0
   end;

procedure TTPUT (ch :byte);
begin
   WRITE (TTYout, CHR (ch));
   OutPos := OutPos + 1;
   if OutPos = MaxLine then FlushOutput
   end;


(*         END OF MACHINE DEPENDENT SECTION       *)

procedure PAD (SYM :byte; NO :integer);
var
   I :integer;
begin
   for I := 1 to NO do TTPut (SYM)
   end;


procedure GDP (Com, X, Y :integer);
const escape = 27; GraphMode = 52; Clearall = 170;
      EchoOn = 17; EchoOff = 16;

procedure CHex (Val :integer);
procedure CHexChar (I :integer);
begin
   if I <= 9 then TTPut (I+ORD('0'))
   else TTPut (I-10+ORD('A'))
end;

begin
   CHexChar ((Val DIV 16) MOD 16);
   CHexChar (Val MOD 16)
end;

procedure GDPupdate;
begin
   TTPut (EchoOn);
   FlushOutput
end;

procedure TestAlpha;
begin
   if Alpha then TTPut (EchoOff);
   Alpha := false
end;

procedure GDPattribute;
const setcommand = 33;
begin
   TTPut (escape); TTPut (ORD ('4'));
   CHex (GDPColour); CHex (GDPSize); CHex (setcommand+GDPStyle)
end;
procedure Linby2 (X, Y :integer);
const LineRel = 57;
var
   Pen :integer;
begin
   Pen := LineRel + GDPStyle;
   if X < 0 then begin
      Pen := Pen + 128;
      X := ABS (X)
   end;
   if Y < 0 then begin
      Pen := Pen + 64;
      Y := ABS (Y)
   end;
   if (X>255) or (Y>255) then begin
      TTPut (escape); TTPut (ORD ('4'));
      CHex ((X DIV 2) + (X MOD 2));
      CHex ((Y DIV 2) + (Y MOD 2));
      CHex (Pen);
      X := X DIV 2; Y := Y DIV 2
   end;
   TTPut (escape); TTPut (ORD ('4'));
   CHex (X); CHex (Y); CHex (Pen)
end;

procedure Movto2 (X, Y :integer);
const MoveAbs = 48;
var
   Pen :integer;
begin
   Pen := MoveAbs;
   if X>255 then Pen := Pen + 128;
   if Y>255 then Pen := Pen + 64;
   TTPut (escape); TTPut (ORD ('4'));
   CHex (X MOD 256); CHex (Y MOD 256); CHex (Pen)
end;

begin
if Device=3 then begin
   COM := COM MOD 16;
   case COM of
   0: begin
         Alpha := true;
         TestAlpha;
         SX := 0; SY := 0;
         GDPattribute;
      end;
   1: begin
         GDPupdate
      end;
   2: begin
         Alpha := true;
         GDPupdate
      end;
   3: begin
         TestAlpha;
         x := GDPColour; GDPColour := clearall;
         GDPAttribute;
         GDPColour := x;
         GDPAttribute
      end;
   4: begin
         TestAlpha;
         Movto2 (X, Y);
         SX := X; SY := Y
      end;
   5: begin
         TestAlpha;
         Linby2 (X-SX, Y-SY);
         SX := X; SY := Y
      end;
   6: begin
         TestAlpha;
         ttput (escape); ttput (ord ('4'));
         ttput (x); ttput (0); ttput (16);
      end;
   7: begin
         if X in [0..2] then begin
         case X of
         0: begin
               if Y=0 then GDPColour := 0
               else if Y=1 then GDPColour := 15 {Blue?}
               else if Y=2 then GDPColour := 51 {Green?}
               else if Y=3 then GDPColour := 60 {Red?}
               else GDPColour := 0;
            end;
         1: begin
               GDPStyle := (Y*2) MOD 8;
            end;
         2: begin
               GDPSize :=(Y DIV 12) * 16 + (Y DIV 12);
               TCS := GDPsize * 6;
            end;
         end;
         TestAlpha;
         GDPAttribute;
         end;
      end;
   8,9,10,11,12,13,14,15: begin end;
   end;
end;
end;


procedure T4000 (COM, X, Y :integer);

procedure EdwinUpdate;
begin
   PAD (NUL, 4);
   TTPut (AlphaMode);
   if TCS=24 then TTPut (25);  {Set big chars on 4002}
   FlushOutput;
   Alpha := true
   end;

procedure PutChar;
begin
   if not Alpha then EdwinUpdate;
   TTPut (X);
   TTPut (0);
   SX := SX + TCS;
   if SX > XR2 then Vis2 := false
   end;

procedure MoveTo (X, Y :integer);
const
   HI   = 32;
   LY   = 96;
   LX   = 64;
   ENH  = 7;
begin
   TTPut (LOGOR (LOGAND (SHIFTR (Y, 5), 31), HI));
   TTPut (LOGOR (LOGAND (Y, 31), LY));
   if AMode then
      TTPut (LOGOR (SHIFTL (ENH, 4), LOGOR (LOGAND (SHIFTR (Y, 10), 3),
         LOGAND (SHIFTR (X, 10), 3))));
   TTPut (LOGOR (LOGAND (SHIFTR (X, 5), 31), HI));
   TTPut (LOGOR (LOGAND (X, 31), LX))
   end;

procedure ChangeAttribute;
begin
   case X of
   0: begin
      end;
   1: begin
         if DevNo = 4014 then begin
            TTPut (Escape);
            TTPut (Y+96)
         end
      end;
   2: begin
         TCS := 13;
         if DevNo = 4014 then begin
            TTPut (Escape);
            if Y < 8 then begin
               TTPut (ORD (';'));
               TCS := 7
               end
            else if Y < 10 then begin
               TTPut (ORD (':'));
               TCS := 9
               end
            else if Y < 13 then begin
               TTPut (ORD ('9'));
               TCS := 13
               end
            else begin
               TTPut (ORD ('8'));
               TCS := 14
               end
            end
         else if DevNo = 4002 then begin
            if Y > 23 then TCS := 24 else TCS := 12;
            Alpha := false
         end
      end;
   3, 4, 5, 6: begin
      end;
   7, 8, 9, 10, 11, 12, 13, 14, 15: begin
      end
   end
   end;

begin
   if (Device=0) or (Device=1) then begin
      COM := LOGAND (COM, 15);
      if COM <= 9 then begin
         case COM of
         0: begin
               AMode := false;
               Alpha := true;
               SX := 0; SY := 0;
               XR2 := 1023;
               Vis2 := true;
               TCS := 13;
               OutPos := 0;
               DevNo := X;
               if DevNo = 4002 then
                  InvokeCursor := DC1
               else
                  InvokeCursor := SUB;
               X := 1; Y := 0;
               ChangeAttribute;
               X := 2; Y := 12;
               ChangeAttribute
            end;
         1: begin
               PAD (NUL, 4);
               TTPut (AlphaMode);
               TTPut (13);
               TTPut (10);
               if DevNo = 4014 then begin
                  TTPut (Escape);
                  TTPut (ORD (';'))
               end;
               TTPut (24);  {RESET if an ADM 3}
               FlushOutput
            end;
         2: begin
               EdwinUpdate;
            end;
         3: begin
               TTPut (Escape);
               TTPut (EraseScreen);
               PAD (DEL, 960);
               SX := 0; SY := 0; Alpha := true
            end;
         4: begin
               TTPut (GraphMode);
               MoveTo (X, Y);
               SX := X; SY := Y;
               Alpha := false; Vis2 := true
            end;
         5: begin
               if Alpha then begin
                  TTPut (GraphMode);
                  MoveTo (SX, SY)
               end;
               MoveTo (X, Y);
               Alpha := false;
               SX := X; SY := Y;
               Vis2 := true
            end;
         6: begin
               if Vis2 { and Y=ORD (true)??} then PutChar
            end;
         7: begin
               ChangeAttribute
            end;
         8: begin
            end;
         9: begin
               XR2 := X;
               if (DevNo = 4014) and ( (X > 1023) or (Y > 1023)) then AMode := true
           end
         end
      end
   end
end;

procedure TCURSOR (var STATE :char; var X, Y :integer);
var
   ChA, ChB, ChC, ChD, ChE :char;
   A, B, C, D, E :integer;

begin
   PAD (NUL, 4);
   TTPut (AlphaMode);
   TTPut (Escape);
   TTPut (InvokeCursor);
   FlushOutput;
   READLN (TTYin, STATE, ChA, ChB, ChC, ChD);
   A := ORD (ChA); B := ORD (ChB); C := ORD (ChC); D := ORD (ChD);
(* STATE := CHR (TTGet);
   A := TTGet; B := TTGet; C := TTGet; D := TTGet;
   repeat X := TTGet until X<32;
*)
   X := LOGOR (SHIFTL (LOGAND (A, 31), 5), LOGAND (B, 31));
   Y := LOGOR (SHIFTL (LOGAND (C, 31), 5), LOGAND (D, 31));
   Alpha := true
   end;


procedure BBC (Com, X, Y :integer);

const
   PLOT    = 25;
   MODE    = 22;
   MOVEABS = 4;
   LINEABS = 5;
   JOIN    = 5;
   SEPER   = 4;

   procedure BBCbyte (I :integer);
   var
      J :integer;
   begin
      while I < 0 do I := I + 256;
      I := I MOD 256;
      J := I MOD 16;
      TTPut ((I DIV 16) + ORD ('0'));
      TTPut (J + ORD ('0'))
   end;

   procedure BBCword (I :integer);
   begin
      while I < 0 do I := I + 65536;
      BBCbyte (I MOD 256);
      BBCbyte (I DIV 256)
   end;

   procedure ChangeAttributes;
   begin
   end;

   procedure SetGraphics;
   begin
      TTPut (      16 );
      TTPut (ORD ('4'));
   end;

   procedure SetText;
   begin
      TTPut (      16 );
      TTput (ORD ('3'));  { Expects hex pairs still...     }
      TTPut (ORD ('7'));  { ... so this is how we send "7" }
      FlushOutput
   end;

begin
if Device=4 then begin
   COM := COM MOD 16;
   case COM of
   0: begin    { Initialise }
      end;
   1: begin    { Text mode }
         SetGraphics;
         BBCbyte (SEPER);
         SetText;
         FlushOutput;
      end;
   2: begin    { Update }
         FlushOutput;
      end;
   3: begin    { Clear screen }
         SetGraphics;
         BBCbyte (MODE);
         BBCbyte (ORD ('0'));
         SetText;
      end;
   4: begin    { Move X, Y }
         SetGraphics;
         BBCbyte (PLOT);
         BBCbyte (MOVEABS);
         BBCword (X);
         BBCword (Y);
         SetText;
      end;
   5: begin
         SetGraphics;
         BBCbyte (PLOT);
         BBCbyte (LINEABS);
         BBCword (X);
         BBCword (Y);
         SetText;
      end;
   6: begin
         SetGraphics;
         BBCbyte (JOIN);
         BBCbyte (X);
         BBCbyte (SEPER);
         SetText;
      end;
   7: begin
         ChangeAttributes;
      end;
   8,9,10,11,12,13,14,15:
      begin
      end;
   end {case}
end {if}
end {This device};

function MulDiv (A, B, C :integer) :integer;
begin
   MulDiv := (A * B) div C
   end;

procedure Signal (NO, INFO, EXTRA :integer);
begin
   WRITELN ('***Signal ',NO:1, INFO:1, EXTRA:1)
   end;


procedure DriveDev (COM, X, Y :integer);
begin
   if COM = 0 then begin
      if X = 0 then
         Device := -1
      else if X = 4014 then
         Device := 1
      else if (4002 <= X) and (X <= 4099) then
         Device := 0
      else if X = 7221 then
         Device := 2
      else if X = 100 then
         Device := 3
      else if X = BBCdevice then
         Device := 4
      else Device := SUCC (NumDev)
      end;

   if not (Device in [-1..NumDev]) then begin
      Device := -1;
      Signal (14, 0, X)
      end;

   if Device >= 0 then begin

      case Device of
      0, 1:
         begin
            {T4000 (COM, X, Y)}
         end;
      2: begin
            {P7221 (COM, X, Y)}
         end;
      3: begin
            {GDP (COM, X, Y)}
         end;
      4: begin
            BBC (COM, X, Y)
         end
      end

      end
   end;

procedure DCursor (var STATE :char;var X, Y :integer);
begin
   if not (Device in [0..NumDev]) then begin
      Signal (14, 8, Device)
      end
   else begin
      case Device of
      0, 1:
         begin
            STATE := '?'; X := 0; Y := 0;
            {TCURSOR (STATE, X, Y)}
         end;
      2: begin
            STATE := '?'; X := 0; Y := 0;
            {PCURSOR (STATE, X, Y)}
         end;
      3: begin
            STATE := '?'; X := 0; Y := 0;
            {GCURSOR (STATE, X, Y)}
         end;
      4: begin
            STATE := '?'; X := 0; Y := 0;
            {BCURSOR (STATE, X, Y)}
         end
      end
      end
   end;

procedure MapToVirtualCoOrds (var X, Y :integer); forward;
procedure Cursor (var STATE :char; var X, Y :integer);
begin
   DCursor (STATE, X, Y);
   MapToVirtualCoOrds (X, Y)
   end;

procedure SWOPW (var A, B :integer);

var
   C            : integer;

begin
   C := A;
   A := B;
   B := C
   end;

function VPGradient (Y, X :integer) :integer;
var
   ASRM,
   ASRD        : integer;
                           { ASPECT RATIOing sorts out unequal X/Y screens }
begin
   if Device in [0..NumDev] then begin
      ASRM := AspectM [Device];
      ASRD := AspectD [Device]
      end
   else begin
      ASRM := 1;
      ASRD := 1
      end;

   VPGradient := MulDiv (5000, (Y * ASRD), (X * ASRM))
   end;
                       { Convert virtual co-ordinates to hardware co-ordinates }
procedure MapToDeviceCoOrds (var X,
                                 Y  :integer);
begin
   X := MulDiv (X-XL, XS, XV) + XO;
   Y := MulDiv (Y-YB, YS, YV) + YO
   end;
                    { Convert hardware co-ordinates to EDWINs internal co-ords }
procedure MapToVirtualCoOrds {var X,
                                  Y  :integer};
begin
   X := MulDiv (X-XO, XV, XS) + XL;
   Y := MulDiv (Y-YO, YV, YS) + YB
   end;

procedure Vector (FX, FY, TX, TY :integer; V :boolean);
      { Draw line from virtual coordinates (FX, FY) to (TX, TY) }
      {   (but if not visible (NOT V) then just move)           }
begin
   MapToDeviceCoOrds (FX, FY);
   MapToDeviceCoOrds (TX, TY);
   if V then begin      { Visible ???}
                        { Don't move if already there }
      if (OTX <> FX) or (OTY <> FY) then
         DriveDev (4, FX, FY);   { move to FROM }
      DriveDev (5, TX, TY)       { draw to TO   }
      end
   else

      DriveDev (4, TX, TY);      { move to TO   }
   OTX := TX;  { note last position moved to }
   OTY := TY
   end;

procedure Clip (TX, TY :integer; V :boolean);
      { Draw a vector (visible if V true) to virtual position (TX, TY)         }
      {  but ony that part of it (if any) which lies within the virtual window }
label
   99;

type
   Directions   = (Left, Right, Above, Below);
   DirSet       = set of Directions;

var
   FX,
   FY           : integer;
   F,
   T            : DirSet;

procedure SWOPS (var A,
                    B  :DirSet);

var
   C            : DirSet;

begin
   C := A;
   A := B;
   B := C
   end;
procedure Code (X, Y :integer; var CodeSet :DirSet);
      { return one of nine possible answers depending on which sector }
      { of the world space the two points lie:                        }
      {                                                               }
      {     Above/          |   Above   |  Above/                     }
      {        Left         |           |     Right                   }
      {     ________________|___________|__________________           }
      {                     |           |                             }
      {      Left           |     OK.   |           Right             }
      {                     |           |                             }
      {     ________________|___________|__________________           }
      {     Below/          |           |  Below/                     }
      {        Left         |   Below   |     Right                   }
      {                                                               }
begin
   CodeSet := [];
   if X < XL then
      CodeSet := [Left]
   else if X > XR then
      CodeSet := [Right];
   if Y > YT then
      CodeSet := CodeSet + [Above]
   else if Y < YB then
      CodeSet := CodeSet + [Below];
   end;
begin
   if Viewing then begin   { no point if not displaying... }
      FX := CX;
      FY := CY;
      CX := TX;
      CY := TY;
      if not Clipping then begin    { User trusts his program !!! }
         Vector (FX, FY, TX, TY, V);
         goto 99
         end;
      Code (TX, TY, T);

      Vis := (T=[]);
      repeat
         Code (FX, FY, F);
         if F*T <> [] then begin
                           { both endpoints lie outside the OK region on }
                           { the same side                               }
            goto 99;
            end;
         if F+T = [] then begin
                           { both endpoints lie within the OK region     }
            Vector (FX, FY, TX, TY, V);
{!*!*!*!}
            goto 99
            end;
         if F = [] then begin
                           { The FROM component is inside the OK region  }
                           { We only ever clip the FROM component, so    }
                           { swap them over before clipping.             }
            SWOPS (F, T);
            SWOPW (FX, TX);
            SWOPW (FY, TY)
            end;
                           { Now clip the FROM component                 }
         if Left in F then begin
            FY := MulDiv (TY-FY, XL-FX, TX-FX) + FY;
            FX := XL
            end
         else if Right in F then begin
            FY := MulDiv (TY-FY, XR-FX, TX-FX) + FY;
            FX := XR
            end
         else if Above in F then begin
            FX := MulDiv (TX-FX, YT-FY, TY-FY) + FX;
            FY := YT
            end
         else if Below in F then begin
            FX := MulDiv (TX-FX, YB-FY, TY-FY) + FX;
            FY := YB
            end
         else begin
            Signal (-1, -1, -1)
            end;

                  { Having clipped FROM, we now go round again, swapping }
                  { FROM and TO to finalise the clipping                 }

         until false
      end;
   99:
   end;

procedure Insert (A, X, Y :integer);
      { Insert instruction into the DISPLAY FILE }
var
   Code         : integer;

begin
   if Storing then begin
      Code := LOGAND (A, 15);
      if (Code<=5) and (-128<=X) and (X<=127) and (-128<=Y) and (Y<=127) then begin
         WRITE (PDFout, LOGOR (A, 16));
         WRITELN (PDFout, LOGOR (SHIFTL (LOGAND (X, 255), 8), LOGAND (Y, 255)))
         end
      else begin
         WRITE (PDFout, A);
         if Code=15 then
            WRITE (PDFout, X)
         else begin
            if not (Code in [9..12]) then begin
               WRITE (PDFout, X);
               WRITE (PDFout, Y)
               end
            end;
         WRITELN (PDFout)
         end
      end
   end;

procedure SetAttribute (What, Val :integer);
begin
   Attributes [What] := Val;
   if What=2 then
            { Scale character size to device units }
      Val := MulDiv (Val, XS, XV);
   if Viewing then
      DriveDev (7, What, Val)
   end;

procedure StoreAttribute (What, It :integer);
begin
   Insert (LOGOR (SHIFTL (LOGOR (SHIFTL (What, 8), It), 4), 10), 0, 0)
   end;

function CharOffset (Dir :char) : integer;
      { Direction is X or Y and result is the current character }
      { offset in that diretion                                 }
var
   Size,
   Rot          : integer;

begin
   Rot := LOGAND (Attributes [3] div 90, 3);
   Size := Attributes [2];
   if Dir='X' then
      CharOffset := Size * RX [Rot]
   else if Dir='Y' then
      CharOffset := Size * RY [Rot]
   else
      Signal (-2,-2,-2)
   end;

procedure DoAspect;
      { Modify VIRTUAL WINDOW to accomodate aspect ratio of screen }
var
   MD,
   MV,
   N            : integer;

begin
   MD := VPGradient (YS, XS);
   MV := MulDiv (5000, ABS (YT-YB), ABS (XR-XL));
   if MD <> MV then begin
      if MD > MV then begin
         N := (MulDiv (MD, ABS (XR-XL), 5000)+YB - YT) div 2;
         YB := YB-N;
         YT := YT+N
         end
      else begin
         N := (MulDiv (5000, ABS (YT-YB), MD)+XL - XR) div 2;
         XL := XL-N;
         XR := XR+N
         end
      end
   end;

procedure Interpret (PC, Size, Orient :integer);
   forward;

procedure Marker (N :integer);
      { This draws a marker at the current position }
label
   99;

var
   Scale        : integer;

begin
   if N in [0..10] then begin
      if XLim [Device] < 250 then begin
               { for VDUs }
         DriveDev (6, MK [N], 0);
         goto 99
         end;
      Scale := One;
      if XLim [Device] > 4095 then
               { for CALCOMPS and HP - plotters }
         Scale := One * 10;
      Interpret (CharPDF [2000 - N*2], MulDiv (Scale, XV, XS), 0)
      end;
   99:
   end;

procedure Interpret {PC, Size, Orient :integer};

 {  PC = 0  =>  read from the PDF input stream, otherwise read }
 {              from the PDF stored in array CHAR PDF          }
 {                                                             }
 {  Interpret instruction in display file at PC until an END   }
 { instruction is found.                                       }
 {                                                             }
 {   Codes are:     0 LINEABS   1 MOVEABS   2 MARKERABS        }
 {                  3 LINEREL   4 MOVEREL   5 MARKERREL        }
 {                  6 SUBPIC*   7 END*      8 WINDOW           }
 {                  9 CHAR     10 ATTRIBUTES   11 END          }
 { * - No longer used                                          }

label
   66, 99;

var
   Word,
   Code,
   X,
   Y,
   P,
   LSave,
   CSize,
   OX,
   OY           : integer;
   Active       : boolean;

procedure Get (var N :integer);
begin
   if PC = 0 then begin
      READ (PDFin, N);
      if EOLN (PDFin) then
         READLN (PDFin)
      end
   else begin
      N := CharPDF [PC];
      PC := PC + 1
      end
   end;

begin
   Active := false;
   repeat
      Get (Word);
      Code := LOGAND (Word, 15);
      if Code <= 5 then begin                   { DRAW, MOVE, MARKER }
         Active := true;
         Get (X);
         if LOGAND (Word, 16) = 0 then begin    { Long form }
            Get (Y)
            end
         else begin                             { Short from }
            Y := LOGAND (X, 255);
            X := LOGAND (SHIFTR (X, 8), 255);
            if LOGAND (X, 128) <> 0 then
               X := EXOR (X, LOGNOT (255));
            if LOGAND (Y, 128) <> 0 then
               Y := LOGAND (Y, LOGNOT (255));
            end;
         if Code >= 3 then begin                { relative }
            if LOGAND (Orient, 4) <> 0 then
               SWOPW (X, Y);                    { Co-ordinate swap }
            if LOGAND (Orient, 1) <> 0 then
               X := -X;                         { X-axis reflection }
            if LOGAND (Orient, 2) <> 0 then
               Y := -Y;                         { Y-axis reflection }

                                        { change relative to absolute co-ords }
            X := MulDiv (X, Size, One) + CX;
            Y := MulDiv (Y, Size, One) + CY;
                                 { and map REL code number to ABS code number }
            Code := Code-3
            end
         end;
      case Code of
      2: begin                                     { POINT }
            Clip (X, Y, invisible);
            Marker (LOGAND (SHIFTR (Word, 12), 15))
         end;
      0: begin                                     { DRAW }
            Clip (X, Y, visible)
         end;
      1: begin                                     { MOVE }
            Clip (X, Y, invisible)
         end;
      6: begin                                     { Unused }
            Signal (14, 5, 0)
         end;
      8: begin                                     { set new window }
            Get (XL);
            Get (XR);
            Get (Code);
            Get (YB);
            Get (YT);
            if Attributes [15] <> 0 then
               DoAspect;
            XV := XR-XL;
            YV := YT-YB
         end;
      9: begin                                     { char }
            if Attributes [4] = 0 then begin
               DriveDev (6, SHIFTR (Word, 4), ORD (true));
               CX := CX + Attributes [2]
               end
            else begin
                        { software characters if character not PUT }
               P := 2000 - SHIFTL ((LOGAND (SHIFTR (Word, 4), 255) - 21), 1);
               if CSize < 8 then
                  goto 66;
               if Attributes [1] <> 0 then begin
                  LSave := Attributes [1];
                  DriveDev (7, 1, 0)
                  end
               else
                  LSave := -1;
               OX := CX;
               OY := CY;
               Interpret (CharPDF [P], CSize, RA [LOGAND (Attributes [3] div 90, 3)]);
               Clip (OX + CharOffset ('X'), OY + CharOffset ('Y'), false);
               if Lsave >= 0 then
                  DriveDev (7, 1, LSave)
               end;
            Active := true
         end;
      15, 10: begin                                { set attributes }
            if Code=10 then    { short form}
               Code := LOGAND (SHIFTR (Word, 4), 255)
            else              { long form }
               Get (Code);
            SetAttribute (LOGAND (SHIFTR (Word, 12), 15), Code)
         end;
      11: begin                                    { end }
            if Active then
               goto 99
            end;
      13, 14: begin                                { invalid }
            Signal (14, 5, Code)
         end;
      7, 12: begin                                 { no longer used }
            goto 99
         end
      end;
      66:
   until false;
   99:
   end;

{*********************************************************************}
{**                                                                 **}
{**                 U S E R   R O U T I N E S                       **}
{**                                                                 **}
{*********************************************************************}

procedure Viewport (A, B, C, D :integer);
   forward;

procedure Window (A, B, C, D :integer);
   forward;

procedure InitialiseFor (Typecode :integer);
      { Initialise device driver, and EDWIN variables }
begin

   Device := 0;
   DriveDev (0, Typecode, 0);
   if Device in [0..Numdev] then
      ViewPort (0, DVX [Device], 0, DVY [Device]);
   Window (0, 1023, 0, 1023)
   end;

procedure TerminateEdwin;
      { Tell the device driver to terminate }
begin
   DriveDev (1, 0, 0);
   Insert (12, 0, 0)
   end;

procedure LineAbs (X, Y :integer);
      { Draw line to absolute point }
begin
   Insert (0, X, Y);
   Clip (X, Y, visible)
   end;

procedure MoveAbs (X, Y :integer);
      { Move to abolute position }
begin
   Insert (1, X, Y);
   Clip (X, Y, invisible)
   end;

procedure MarkerAbs (N, X, Y :integer);
      { Draw an EDWIN marker at the absolute point given }
begin
   Insert (LOGOR (SHIFTL (N, 12), 2), X, Y);
   Clip (X, Y, invisible);
   Marker (N)
   end;

procedure LineRel (X, Y :integer);
      { Draw visible relative vector }
begin
   Insert (3, X, Y);
   Clip (X+CX, Y+CY, visible)
   end;

procedure MoveRel (X, Y :integer);
      { Make a relative move (draw an invisible vector) }
begin
   Insert (4, X, Y);
   Clip (X+CX, Y+CY, invisible)
   end;

procedure MarkerRel (N, X, Y :integer);
      { Draw an EDWIN marker at point specified by relative vector }
begin
   Insert (LOGOR (SHIFTL (N, 12), 5), X, Y);
   Clip (X+CX, Y+CY, invisible);
   Marker (N)
   end;

procedure Character (ch :char);

const
   Unit         = 12;

var
   LSave,
   Size,
   OX,
   OY           : integer;

begin
   Insert (LOGOR (SHIFTL (ORD (ch), 4), 9), 0, 0);
   if Viewing then begin
      if Attributes [4] = 0 then begin
         if Vis then
            DriveDev (6, ORD (ch), 0);
         CX := CX + Attributes [2]
         end
      else if ch in [' '..'~'] {Printable characters} then begin
         Size := MulDiv (Attributes [2], One, Unit);
         if Size >= 8 then begin
            if Attributes [1] <> 0 then begin
               LSave := Attributes [1];
               DriveDev (7, 1, 0)
               end
            else
               LSave := -1;
            OX := CX;
            OY := CY;
            Interpret (CharPDF [2000 - SHIFTL (ORD (ch) - 21, 1)], Size,
               LOGAND (RA [Attributes [3] div 90 ], 3));

            { Draw an invisible vector to keep internal co-ords up to date }
            Clip (OX + CharOffset ('X'), OY + CharOffset ('Y'), invisible);
            if LSave >= 0 then
               DriveDev (7, 1, LSave)
            end
         end
      end
   end;

procedure NewFrame;
      { Get the device driver to clear the picture by }
      { clearing the screen or throwing a new page    }
begin
   DriveDev (3, 0, 0);
   Insert (11, 0, 0);
   CX := 0;
   CY := 0
   end;

procedure Update;
      { Get the device driver to bring the picture up to date - }
      {  i.e. empty any pending I/O buffers etc...              }
begin
   DriveDev (2, 0, 0)
   end;

procedure ClipOn;
begin
   Clipping := true
   end;

procedure ClipOff;
begin
   Clipping := false
   end;

procedure StoreOn;
begin
   Storing := true
   end;

procedure StoreOff;
begin
   Storing := false
   end;

procedure ViewOn;
begin
   Viewing := true
   end;

procedure ViewOff;
begin
   Viewing := false
   end;

procedure Window {A, B, C, D :integer};
begin
   XL := A;
   OWXL := A;
   XR := B;
   OWXR := B;
   YB := C;
   OWYB := C;
   YT := D;
   OWYT := D;
   Insert (8, A, B);
   Insert (8, C, D);
   if Attributes [15] <> 0 then
      DoAspect;
   XV := XR-XL;
   YV := YT-YB
   end;

procedure ViewPort {A, B, C, D :integer};

var
   S            : boolean;

begin
   if Device >= 0 then begin
                              { No inverted window bounds }
                              { not null device either    }
      if A>B then
         SWOPW (A, B);
      if C>D then
         SWOPW (C, D);
      if A<0 then
         A := 0;
      if C<0 then
         C := 0;
      if B>XLim [Device] then
         B := XLim [Device];
      if D>YLim [Device] then
         D := YLim [Device];
      DriveDev (8, A, C);
      DriveDev (9, B, D);
      XO := A;
      XS := B-A;
      YO := C;
      YS := D-C;
      S := Storing;
      Storing := false;
      Window (OWXL, OWXR, OWYB, OWYT);
      Storing := S
      end
   end;

procedure SetColour (Val :integer);

const
   This         = 0;
   Def          = 0;
   Max          = 4;

begin
   if not (Val in [0..Max]) then
      Val := Def;
   if Attributes [This] <> Val then begin
      StoreAttribute (This, Val);
      SetAttribute (This, Val)
      end
   end;

procedure SetLineStyle (Val :integer);

const
   This         = 1;
   Def          = 0;
   Max          = 4;

begin
   if not (Val in [0..Max]) then
      Val := Def;
   if Attributes [This] <> Val then begin
      StoreAttribute (This, Val);
      SetAttribute (This, Val)
      end
   end;

procedure SetCharSize (Val :integer);

const
   This         = 2;

begin
   if Attributes [This] <> Val then begin
      Insert (LOGOR (SHIFTL (This, 12), 15), Val, 0);
      SetAttribute (This, Val)
      end
   end;

procedure SetCharRot (Val :integer);

const
   This         = 3;

begin
   if Attributes [This] <> Val then begin
      Insert (LOGOR (SHIFTL (This, 12), 15), Val, 0);
      SetAttribute (This, Val)
      end
   end;

procedure SetCharQuality (Val :integer);

const
   This         = 4;
   Def          = 0;
   Max          = 1;

begin
   if not (Val in [0..Max]) then
      Val := Def;
   if Attributes [This] <> Val then begin
      StoreAttribute (This, Val);
      SetAttribute (This, Val)
      end
   end;

procedure SetCharFont (Val :integer);

const
   This         = 5;
   Def          = 0;
   Max          = 7;

begin
   if not (Val in [0..Max]) then
      Val := Def;
   if Attributes [This] <> Val then begin
      StoreAttribute (This, Val);
      SetAttribute (This, Val)
      end
   end;

procedure SetCharAngle (Val :integer);

const
   This         = 6;
   Def          = 90;
   Max          = 180;

begin
   if not ((0<=Val) and (Val<=Max)) then
      Val := Def;
   if Attributes [This] <> Val then begin
      StoreAttribute (This, Val);
      SetAttribute (This, Val)
      end
   end;

procedure SetIntensity (Val :integer);

const
   This         = 7;
   Def          = 5;
   Max          = 7;

begin
   if not (Val in [0..Max]) then begin
      StoreAttribute (This, Val);
      SetAttribute (This, Val)
      end
   end;

procedure AspectRatioing (On :boolean);

const
   This         = 15;

var
   Mode         : integer;
   S            : boolean;

begin
   if On then Mode := 1 else Mode := 0;
   StoreAttribute (This, Mode);
   SetAttribute (This, Mode);
   S := Storing;
   Storing := false;
   Window (OWXL, OWXR, OWYB, OWYT);
   Storing := S
   end;

procedure InquirePosition (var X,
                               Y  :integer);
begin
   X := CX;
   Y := CY
   end;

procedure InquireWindow (var A,
                             B  ,
                             C  ,
                             D  :integer);
begin
   A := XL;
   B := XR;
   C := YB;
   D := YT
   end;

procedure InquireViewPort (var A,
                               B  ,
                               C  ,
                               D  :integer);
begin
   A := XO;
   B := XS+XO;
   C := YO;
   D := YS+YO
   end;

procedure Review;
      { This reads a PDF from stream PDFin }
begin
   Interpret (0, One, 0)
   end;


{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

      procedure getBool (var Bool :boolean; prompt :prompts);
         label
            99;
         var
            CH  :char;
         begin
            repeat { for ever }
               write (prompt, ': ');
(*                 MACHINE DEPENDENT SECTION                *)
               flush (output); {Non-standard FLUSH}
(*             END OF MACHINE DEPENDENT SECTION             *)
               while not eoln (terminal) do begin
                  read ( terminal, CH );
                  if CH in ['Y', 'y', 'T', 't'] then begin
                     Bool := true;
                     goto 99 { Return from function. }
                     end
                  else if CH in ['N', 'n', 'F', 'f'] then begin
                     Bool := false;
                     goto 99 { Return from function. }
                     end
                  end;
               readLn ( terminal )
               until false;
         99:   readLn ( terminal );
       end; { of get boolean reply from User. }

      procedure initEdwin;
      begin
         InitialiseFor (BBCdevice);
         ViewPort (1279-1024, 1279, 0, 1023)
         end;

{=====================================================================}
{                                                                     }
{    Graphics Applications Procedures used in Cif View.               }
{    ~~~~~~~~ ~~~~~~~~~~~~ ~~~~~~~~~~ ~~~~ ~~ ~~~ ~~~~~               }
{                                                                     }
{                                                                     }
{=====================================================================}


   procedure switchDeviceInto ( mode  :deviceModes );
    var
     XL,XR, YB,YT  :integer;
    begin
(*   if mode = drawMode then
        viewPort ( 256, 1023, 0, 767 )
        { A square view port to make aspect ratio 1:1. }

     else { mode = textMode} begin
        inquireWindow ( XL, XR, YB, YT );
        viewPort ( 0, 1023, 0, 767 );
        window ( 0, 1023, 0, 767 );
        moveAbs( 0, 760 -
                 ( (760 div maxLinesOnTektronix) * cifViewLineNum ) );
        window ( XL, XR, YB, YT );
        upDate
        end;
*)
    end; { of Switch To Draw/Text Mode. }

   procedure NewPage;
   var
      I :integer;
   begin
     CifViewLineNum := MaxLinesOnTektronix;
     SwitchDeviceInto (TextMode);
      TTPut (ORD ('R'));
      TTPut (ORD ('e'));
      TTPut (ORD ('a'));
      TTPut (ORD ('d'));
      TTPut (ORD ('y'));
      TTPut (ORD ('?')); Update; FlushOutput;
                         { FlushOutput is needed here, because if
                            no device is selected, Update does not
                            call FlushOutput
                         }
      ReadLn (TTYin);
     newFrame;
     cifViewLineNum := 1;
     dontBotherUser := false;
     SwitchDeviceInto (TextMode);

    end; { of New Page. }

   procedure NewLine;
   var I :integer;
   begin
      if CifViewLineNum >= MaxLinesOnTektronix-1 then begin
         SwitchDeviceInto (TextMode); NewPage;
         end
      else begin
         CifViewLineNum := SUCC (CifViewLineNum);
         SwitchDeviceInto (TextMode); {Optimise later...}
         end
      end;

{   procedure incLineNum;}
{    var}{iables}
{     newPageWanted  :boolean;}
{    begin}
{     if cifViewLineNum < maxLinesOnTektronix then}
{        cifViewLineNum := succ ( cifViewLineNum )}
{}
{     else begin}
{        if not dontBotherUser then}
{           getBool ( newPageWanted, 'Wipe ' );}
{}
{        if newPageWanted then}
{           newPage}
{        else begin}
{           dontBotherUser := true;}
{           cifViewLineNum := 1;}
{           end;}
{        switchDeviceInto ( textMode )}
{        end;}
{}
{    end;} { of Inc Line Num. }

   procedure squareWindow ( var XL, XR, YB, YT :integer );
    var
     deltaX,
     deltaY,
     diff    :integer;
    begin
     deltaX := XR - XL;
     deltaY := YT - YB;
     if deltaX > deltaY then begin
        { X coords are bigger. }
        diff := ( deltaX - deltaY ) div 2;
        YB := YB - diff;
        YT := deltaX + YB;
        end
     else begin
        { Y coords are bigger. }
        diff := ( deltaY - deltaX ) div 2;
        XL   := XL - diff;
        XR   := deltaY + XL
        end
   end; { of Square Window. }

procedure SimpleBox (P, Q, R, S :integer);
begin
   MoveAbs (P, Q);
   LineAbs (P, S);
   LineAbs (R, S);
   LineAbs (R, Q);
   LineAbs (P, Q)
   end;

procedure Hatch (I, J, K, L :integer);
var
   A, B, C, D, E, F,
   P, Q,
   XL2, XR2, YB2, YT2,
   LowX, LowY, HighX, HighY,
   X, Y, Step, Gradient :integer;
   RtoL :boolean;
begin
   InquireWindow (LowX, HighX, LowY, HighY);
   if I < LowX then I := LowX;
   if J < LowY then J := LowY;
   if K > HighX then K := HighX;
   if L > HighY then L := HighY;
   Gradient := HighY - LowY;
   Step := Gradient div 100;
   Y := LowY - Gradient;
   P := I; Q := J;
   MapToDeviceCoOrds (P, Q);
   XL2 := XL; XR2 := XR; YB2 := YB; YT2 := YT;
   if I > XL then XL2 := I;
   if J > YB then YB2 := J;
   if K < XR then XR2 := K;
   if L < YT then YT2 := L;
   A := XL; B := XR; C := YB; D := YT; E := XO; F := YO;
   repeat
      MoveAbs (LowX, Y);

      XL := XL2; XR := XR2; YB := YB2; YT := YT2;            {Edwin Variables}
      XO := P; YO := Q;

      LineAbs (HighX, Y+Gradient);

      XL := A; XR := B; YB := C; YT := D; XO := E; YO := F;    {Reset Edwin}

      Y := Y + Step;
   until Y > HighY;
   end;

procedure BackHatch (I, J, K, L :integer);
var
   A, B, C, D, E, F,
   P, Q,
   XL2, XR2, YB2, YT2,
   LowX, LowY, HighX, HighY,
   X, Y, Step, Gradient :integer;
   RtoL :boolean;
begin
   InquireWindow (LowX, HighX, LowY, HighY);
   if I < LowX then I := LowX;
   if J < LowY then J := LowY;
   if K > HighX then K := HighX;
   if L > HighY then L := HighY;
   Gradient := HighY - LowY;
   Step := Gradient div 100;
   Y := LowY - Gradient;
   P := I; Q := J;
   MapToDeviceCoOrds (P, Q);
   XL2 := XL; XR2 := XR; YB2 := YB; YT2 := YT;
   if I > XL then XL2 := I;
   if J > YB then YB2 := J;
   if K < XR then XR2 := K;
   if L < YT then YT2 := L;
   A := XL; B := XR; C := YB; D := YT; E := XO; F := YO;
   repeat
      MoveAbs (HighX, Y);

      XL := XL2; XR := XR2; YB := YB2; YT := YT2;            {Edwin Variables}
      XO := P; YO := Q;

      LineAbs (LowX, Y+Gradient);

      XL := A; XR := B; YB := C; YT := D; XO := E; YO := F;    {Reset Edwin}

      Y := Y + Step;
   until Y > HighY
   end;

procedure FillArea (I, J, K, L :integer);
var
   XStep { = 15;},
   YStep { = 10;},
   DX    { = 6;},
   DY    { = 3;},
   XDiff, YDiff, WXl, WXr, WYb, WYt,
   FX, FY, TX, TY, X, Y :integer;
begin
   InquireWindow (WXl, WXr, WYb, WYt);
   XDiff := WXr - WXl;
   YDiff := WYt - WYb;
   XStep := MulDiv (16, XDiff, 1280);
   YStep := MulDiv (16, YDiff, 1024);
   DX    := XStep div 4;
   DY    := YStep div 4;
   Y := J - (J mod YStep);
   repeat
      X := I - (I mod XStep);
      repeat
         FX := X; if FX < I then FX := I;
         FY := Y; if FY < J then FY := J;
         MoveAbs (FX, FY);
         TX := X+DX; if TX > K then TX := K;
         if TX < I then TX := I;
         if (TX=X+DX) and (FY=Y) then LineAbs (TX, FY) else MoveAbs (TX, FY);
         TY := Y+DY; if TY > L then TY := L;
         if TY < J then TY := J;
         if (TX=X+DX) and (TY=Y+DY) then LineAbs (TX, TY) else MoveAbs (TX, TY);
         X := X + XStep
      until X >= K;
      Y := Y + YStep;
   until Y >= L
   end;


procedure  NewLayer (New  :LayerType);
begin
   if CIFStipple [New] then begin
      CurStipple := DefStipple [New];
      ClipOn
      end
   else CurStipple := None;
   SetColour (CIFColour [new])
   end;  {New Layer}


procedure  MBBox (var Name          :string;
                      Lower, Upper  :pointf );
var
   XL, XR, YB, YT,
   CSize, Sep, Len :integer;
begin
   SimpleBox     (Lower.X, Lower.Y, Upper.X, Upper.Y);
   InquireWindow (XL, XR, YB, YT);
   if XL > Lower.X then Lower.X := XL;
   if YB > Lower.Y then Lower.Y := YB;
   CSize :=      MulDiv ((Upper.X-Lower.X) div (Name.Length), 3, 4);
   SetCharSize   (CSize);
   Len   :=      Name.Length;
   MapToDeviceCoOrds (Lower.X, Lower.Y);
   MapToDeviceCoOrds (Upper.X, Upper.Y);
   if TCS*Name.Length-1 > Upper.X-Lower.X then
      Len := ((Upper.X-Lower.X) div TCS) - 1;
   if Upper.Y-Lower.Y < TCS then begin
      SetCharSize (0);
   end;
   Lower.X := Lower.X+3;
   Lower.Y := Lower.Y+3;
   MapToVirtualCoOrds (Lower.X, Lower.Y);
   MoveAbs (Lower.X, Lower.Y);
   UpDate;
   if Len >= 1 then
      WriteLn       (Name.Body :Len)
   else
      WriteLn;
                                           {   Should use CHARACTER   }
   SetCharSize   (100000)
   end;  {Mimimum Bounding Box}


procedure  Box (    L, W  :integer;
                var C, D  :pointf   );
begin
   end;  {Box}


procedure  SBox (var Lower, Upper  :pointf );
label
   99;
var
   XL, XR, YT, YB :integer;
begin

   if Lower.X > Upper.X then SWOPW (Lower.X, Upper.X);
   if Lower.Y > Upper.Y then SWOPW (Lower.Y, Upper.Y);

   InquireWindow (XL, XR, YB, YT);
   if (Lower.X > XR) or
      (Upper.X < XL) or
      (Lower.Y > YT) or
      (Upper.Y < YB) then goto 99;

   case CurStipple of
   Hatch1:
      begin
         FillArea (Lower.X, Lower.Y, Upper.X, Upper.Y)
      end;
   Hatch2:
      begin
         BackHatch (Lower.X, Lower.Y, Upper.X, Upper.Y);
      end;
   Hatch3:
      begin
         Hatch (Lower.X, Lower.Y, Upper.X, Upper.Y);
      end;
   Hatch4:
      begin
         SimpleBox (Lower.X, Lower.Y, Upper.X, Upper.Y);
         MoveAbs (Lower.X, Lower.Y);
         LineAbs (Upper.X, Upper.Y);
         MoveAbs (Lower.X, Upper.Y);
         LineAbs (Upper.X, Lower.Y)
      end;
   None:
      begin
         SimpleBox (Lower.X, Lower.Y, Upper.X, Upper.Y)
      end;
   end; {Stipple case}

99:end; {Simple Box}


procedure  flash (var P  :pointf; Dia  :integer );
begin
   end; {Flash}


procedure  polygon (numPoints  :integer;
                   firstCoord :recordOfPoints );
begin
   end; {Polygon}


procedure  wire (width       :integer;
                 firstCoord  :recordOfPoints  );
begin
   end; {Wire}


{=====================================================================}
{                                                                     }
{         Procedures which Manipulate the Data Structure.             }
{         ~~~~~~~~~~ ~~~~~ ~~~~~~~~~~ ~~~ ~~~~ ~~~~~~~~~~             }
{                                                                     }
{   analOrDrawCif,                                                    }
{   listSymbols;                                                      }
{                                                                     }
{=====================================================================}

procedure doMbBox ( symbol  :integer );
   { Call MB BOX with the appropriate parameters. }
   var
    curSymbol  :symbolPtr;
    name       :string;
   begin
    curSymbol := lib [ symbol ];
    transPoint ( curSymbol^.lowerPoint, PL);
    transPoint ( curSymbol^.upperPoint, PU);
    if PL.X > PU.X then
       swop (PL.X, PU.X);
    if PL.Y > PU.Y then
       swop (PL.Y, PU.Y);
    with curSymbol^ do
         if annot then
            if comment.length = 0 then
             itos( ID, name )
            else
             name := comment
          else
            null ( name );

    mbBox ( name, PL, PU )
   end; { of Do MB Box. }

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

procedure cifInterpret ( thisElement  :elementPtr );
   { This procedure interprets the data structure for a CALL command. }
   label 
    1; { Continue label used for case label "symbolCall". }
   var
    thisSymbol  :symbolPtr;
    foundIndex :integer;
   begin
    curLevel := succ ( curLevel );
    while thisElement <> nil do begin
          with thisElement^ do
               case whichElement of

               eleSimpleBox:
                  begin
                   transPoint ( sLower, P );
                   transPoint ( sUpper, PD );
                   sbox ( P, PD )
                  end;

               eleBox:
                  begin
                   transPoint  ( current, P  );
                   transVector ( delta,   PD );
                   box ( length, width, P, PD )
                  end;

               eleSymbolCall:
                  begin
                   { Internal call of symbol's worth of current colour.}
                   if not defined then begin
                      foundIndex := find ( ID );

                      if debugSemantics then begin
                         write(results,'  cifInterpret -> symCall, ');
                         writeLn(results,'forward ref, ID=',ID:2)
                         end;

                      if foundIndex > 0 then begin
                         { Symbol is now in data structure. }
                         ID := foundIndex;
                         defined := true
                         end
                      else begin
                         warn;
                         writeLn('Calling undefined symbol');
                         { There is no need to tell the user
                           which symbol, as she was warned ealier
                           of symbols which were undefined.       }
                         goto 1  { Continue the while loop. }
                         end
                      end; { if symbol was not defined. }

                   thisSymbol := lib [ ID ];
                   with thisSymbol^ do begin
                        getTrans ( { from    } packedTrans,
                                   { returns } TT          );

                        pushTrans( TT );

                        transPoint ( lowerPoint, P );
                        transPoint ( upperPoint, PD);
                        if P.X > PD.X then swop ( P.X, PD.X );
                        if P.Y > PD.Y then swop ( P.Y, PD.Y );

                        if  ( P.X  > curWinXR ) or
                            ( P.Y  > curWinYT ) or
                            ( PD.X < curWinXL ) or 
                            ( PD.Y < curWinYB ) then begin
                            { Optimising Symbol calls not in window. }
                            end

                         else if mbb or ( curLevel >= level ) then
                            if curLayer = callLayer then
                               doMbBox ( thisElement^.ID )
                            else
                               { Expanding a Call within a Symbol. }
                               mbbUsed := true

                         else begin
                            if      EP [ callLayer] <> nil then
                               cifInterpret ( EP [ callLayer ] );

                            if ( EP[curLayer] <> nil )   and
                               ( curLayer <> callLayer ) then
                               cifInterpret ( EP [ curLayer ] )

                           end; { mbb = false }

                         popTrans
                   end; { with this symbol }
  1:      end; { Symbol Call }

       elePolygon:
          polygon ( numOfPpoints, firstPcoord );

       eleFlash:
          flash ( flashPoint, flashWidth );

       eleWire:
          wire ( numOfWpoints, firstWcoord )

          end; { case thisElement^ }

          thisElement := thisElement^.next
          end; { loop over a layer. }
    curLevel := pred ( curLevel )
   end; { of cifInterpret. }

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

procedure doCall ( I  :integer );
   { Call symbol I. }
   { called from procedure Analyse Or Draw Cif. }
   var
    J,
    OL    :layerType;   { oldLayer }
    CLP,                { curLayerPtr }
    P     :elementPtr;
   begin
    mbbUsed := false; { Flag to see if it is worth doing the symbol layer. }
    OL := curLayer;
    CLP := lib [ I ]^.EP [ callLayer ];
    if not ( lib[I]^.mbb or ( level=0 ) ) then begin
       for J := ND to pred(callLayer) do
           if drawingLayers [ J ] then begin
              curLayer := J;
              newLayer ( J );
              if CLP <> nil then
                 cifInterpret ( CLP );
                 { Plotting only one layer at a time, so a call on }
                 { procedure INTERPRET will only plot the          }
                 { currently selected layer.                       }

              P := lib [ I ]^.EP[ curLayer ];
              if P <> nil then
                 cifInterpret ( P );
              end; { If layer is to be drawn. }

       if mbbUsed then begin
          { N. B. - mbbUsed is set in the Procedure DO MB BOX }
          { called by the Procedure INTERPRET.                }
          curLayer := callLayer;
          cifInterpret ( CLP )
          end
       end
    else begin
       curLayer := callLayer;
       doMbBox ( I )
       end;

    curLayer := OL
   end; { of Do Call. }

{!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}

{ external } procedure analOrDrawCif ( parm     :analCifParam;
                                       libIndex :libRange;
                                       reqLevel :expandRange;
                                       valid    :boolLayerArray );

   
   {===================================================================}
   {                                                                   }
   { MAIN  MODULE  of  CIFSYS  to analyse and draw the CIF description }
   { ~~~~ ~~~~~~   ~~  ~~~~~~  ~~ ~~~~~~~ ~~~ ~~~~ ~~~ ~~~ ~~~~~~~~~~~ }
   {                                                                   }
   {===================================================================}
   
   begin
    initTrans;
    case parm of

     analysis:
         begin
          forwardRefs := false;
          rScale := 1;
          nextDefinition := 0;
          initLevelZero;
          analyseCif( lines, statements, wErrors, fErrors );
          write(statements:1,' Cif statements analysed with ',
                fErrors:1,' fault');
          if fErrors <> 1 then write('s');
          write(' and ',wErrors:1,' warning');
          if wErrors <> 1 then write('s');
          writeLn('.'); writeLn
         end; { analysis }

     normalCall:
         begin
          inquireWindow ( curWinXL, curWinXR, curWinYB, curWinYT );
          level    := reqLevel;
          curLevel := 0;
          drawingLayers := valid;
          doCall ( libIndex )
         end;

     rotatedCall:
         begin
          inquireWindow ( curWinXL, curWinXR, curWinYB, curWinYT );
          level          := reqLevel;
          curLevel       := 0;
          drawingLayers  := valid;
          mRotate ( 0, -1,
                  { result => } TT );

          pushTrans ( TT );
          doCall ( libIndex )
         end { Rotated Call. }
     end { Case param of. }
   end; { Analyse or Draw Cif. }

{!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}

{ external } procedure listSymbols ( plapScale  :integer );
   { Print out the Symbol descriptions on the terminal. }
   var
    I  :libRange;
   procedure sPrint ( R  :real );
      { Print a real number ( with scaling ) or "Unknown". }
      begin
       if (infinity-1 < abs(R)) and (abs(R) < infinity+1) then
          write('     ????')
       else
          write(R/plapScale:9:1)
    end; { sPrint }

   begin
    NewLine; { Cif View Graphics Procedure. }
writeLn('Symbol No   XL       YB      XR       YT     BB    ID  Comment');
    NewLine;
    if debugSemantics then begin
       writeLn(results,' In List Symbols: next definition=',
                       nextDefinition:1 );
       end;

    if nextDefinition > 0 then begin
       for I := 0 to pred( nextDefinition ) do
           if lib [ I ] <> nil then
              with lib [ I ]^ do begin
                   NewLine;  { Cif View Graphics procedure. }
                   if ID >= 0 then begin
                      write( ID:6 );
                      with lowerPoint do begin
                           sPrint ( X ) ; sprint ( Y )
                           end;
                      with upperPoint do begin
                           sPrint ( X ) ; sPrint ( Y )
                           end;
                      write('   ');
                      if mbb   then write(' on  ') else write('off  ');
                      if annot then write(' on  ') else write('off  ');
                      with comment do begin
                         if length >=1 then
                            writeLn( body  :length )
                         else writeLn;
                      end
                      end
                   end { with lib [ I ] }
       end { if nextDefinition > 0. }
   end; { of List Symbols. }

{!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}

{ external } function findStrSymbol ( var Str  :string )  :integer;
   label
    1;     { Used to return from function. }
   var
    I          :libRange;
    lookLength :stringLength;
    lookBody   :strBodyType;
   begin
    with str do begin
         lookLength := length;
         lookBody   := body
         end;

    for I := 0 to pred ( nextDefinition ) do
        if lib [ I ] <> nil then
           with lib [ I ]^.comment do
                if length = lookLength then
                   if strEquals( body, lookBody, length ) then begin
                      { Symbol found. }
                      findStrSymbol := I;
                      goto 1; { return }
                      end;

    { Symbol not found. }
    findStrSymbol := -1;

1: end; { of function Find String Symbol. }

procedure  cifView;

   { The Command line parser Cif View. }
   { ~~~ ~~~~~~~ ~~~~ ~~~~~~ ~~~ ~~~~~ }

   label{s}
    1,       { Used to return from command line parser. }
    777;     { This is used to recover from Command Line faults. }

   const{ants}
    blank      = ' ';
    twiddle    = '~';
    null30     = '                               ';
    on         = 'ON                             ';
    off        = 'OFF                            ';
    parmMax    = 6;
    printing   = true;  { If a fault message is to be printed. }

   type{s}
    commands       = 
      ( comDraw, comHelp, comIds,      comLayers, comLevel,
        comList, comErase, comNotFound, comPoint, comStipple,
        comStop, comWindow );

    uErrorType     = ( semantic, lexical );

    parmType       = ( intType, stringType );

    parmRange      = 1..parmMax;

    parmElement    = record
                      thisParm   :parmType;
                      str        :string;
                      int        :integer;
                     end;

    parmList       = record
                      parmLength  :parmRange;
                      parms    :array [parmRange] of parmElement
                     end;

    prompts        = array [ 0..4 ] of char;

   var{iables}
    valid        :boolLayerArray;
    lambda       :integer;

    libIndex,
    lastIndex    : -1..libMax;

    level,
    curLevel     :expandRange;

    debugCifView :boolean;

    thisCommand  :commands;
    commandLine  :parmList;
    commDict     :array [ commands ] of string;
    I,K          :stringLength;

    X, Y,
    XLdump, XRdump, YBdump, YTdump,
    XL, XR, YB, YT                   :integer;

    anyParms     :boolean;

    CH           :char;

   procedure userError( thisError :uErrorType;
                    printing  :boolean;
                    pNumber  :parmRange   );
    begin
     if thisError = lexical then readLn ( terminal );
     NewLine;
     write('*  User Error: ');
     if printing then
        if pNumber = 1 then
           write('Command ')
        else
           write('Param ',pred(pNumber):1,' ');

    end;

   procedure signalUserFault;
    begin
     goto 777;
    end; { of signal fault. }

   procedure initCifView;
      var{iables}
       I  :layerType;


      procedure initDict;
       begin
        with commDict [ comDraw ] do begin
             body := 'DRAW                           ';
             length := 4;
             end;
        with commDict [ comHelp ] do begin
             body := 'HELP                           ';
             length := 4;
             end;
        with commDict [ comList ] do begin
             body := 'LIST                           ';
             length := 4;
             end;
        with commDict [ comLayers] do begin
             body := 'LAYERS                         ';
             length := 6;
             end;
        with commDict [ comLevel] do begin
             body := 'LEVEL                          ';
             length := 5;
             end;
        with commDict [ comIds  ] do begin
             body := 'IDS                            ';
             length := 3;
             end;
        with commDict [ comPoint] do begin
             body := 'POINT                          ';
             length := 5;
             end;
        with commDict [ comErase ] do begin
             body := 'ERASE                          ';
             length := 5;
             end;
        with commDict [ comStipple ] do begin
             body := 'STIPPLE                        ';
             length := 7
             end;
        with commDict [ comStop ] do begin
             body := 'STOP                           ';
             length := 4;
             end;
        with commDict [comWindow] do begin
             body := 'WINDOW                         ';
             length := 6;
             end;
        with commDict [comNotFound] do begin
             body := null30;
             length := 0;
             end;
       end; { of initDict. }
   begin { Initialise Cif View. }

    for I := ND to ZZZ do begin
        valid [ I ] := true;
        cifStipple [ I ] := false;
        end;

    lambda   := 300;  { In Microns. }
    curLevel := 99;
    lastIndex := -1;

    cifViewLineNum  := 1;

(*              MACHINE DEPENDENT SECTION              *)
    reSet   ( terminal, '/dev/tty' );  {Non-standard RESET}
(*           END OF MACHINE DEPENDENT SECTION          *)
    reWrite ( results );

    initDict;  { Initialise the Commands. }

    dontBotherUser := false; { Used for control of new pages. }

   end; { of Initialise Cif View. }

procedure lexicalAnalyse ( var P          :parmList;
                           var anyParms   :boolean   );
   var
    startOfParm    :boolean;
    I              :parmRange;
    N              :0..parmMax;
    CH             :char;
   procedure checkForInteger ( var element  :parmElement;
                                   pNum     :parmRange     );
      label{s}
       1;      { Used to return from the Procedure. }
      var{iables}
       ptr      :stringLength;
       N,
       digit    :integer;
       positive :boolean;
       CH       :char;

      begin
       with element do begin
            CH := str.body[0];
            if not ( CH in ['+','-','0'..'9'] ) then begin
               thisParm := stringType;
               goto 1 { return. }
               end;

            if pNum = 1 then begin
               userError ( lexical, not printing, 1 );
               writeLn ('Integer Type Commands are not valid!');
               signalUserFault
               end;

            positive := true;
            if CH in ['+','-'] then begin
               if str.length = 1 then begin
                  userError( lexical, printing, pNum );
                  writeLn('Arithmetic operations are not allowed!');
                  signalUserFault
                  end;

               if CH = '-' then positive := false;
               ptr := 1
               end
            else
               ptr := 0;

            with str do begin
               N := 0;
               while ptr <> length do begin
                     CH := body [ ptr ];
                     if CH in ['0'..'9'] then begin
                        digit := ord(CH) - ord('0');
                        if (N + digit) > (infinity div 10) then begin
                           userError ( lexical, printing, pNum );
                           writeLn('Integer value too large!');
                          signalUserFault
                          end;

                        N := (N*10) + digit;
                        ptr := succ ( ptr )
                        end
                      else begin
                        thisParm := stringType;
                        goto 1 { return. }
                        end
                      end; { of loop over string. }
              end; { with Str. }
            thisParm := intType;
            if positive then
               int :=  N
            else
               int := -N;
            end; { with element. }
1: end; { of Check For Integer. }

   begin
    with P do begin
         { Clear the parameter list. }
         for I := 1 to parmMax do
             with parms [ I ] do begin
                  thisParm := stringType;
                  int      := -infinity;
                  with str do begin
                       length := 0;
                       body   := null30
                       end
                  end;

         startOfParm := true;
         N            := 0;

         while not ( eoln(terminal) or eof(terminal) ) do
               if terminal^ in [blank,','] then begin
                  read ( terminal, CH );
                  startOfParm := true
                  end
               else begin
                  if not ( terminal^ in [blank..twiddle] ) then begin
                     userError ( lexical, not printing, 1 );
                     writeLn('duff characters!');
                     signalUserFault
                     end;

                  if startOfParm then begin
                     if N = parmMax then begin
                        userError ( lexical, not printing, 1 );
                        writeLn('Too many parameters! ');
                        signalUserFault
                        end;

                      startOfParm := false;
                      N := succ ( N )
                      end;

                   read (terminal, CH );
                   with parms [ N ].str do begin
                        if CH in ['a'..'z'] then
                           CH := chr(ord(CH) + (ord('A')-ord('a')));

                        body [ length ] := CH;
                        if length = stringMax then begin
                           userError ( lexical, printing, N );
                           writeLn('too long!');
                           signalUserFault
                           end
                        else
                           length := succ ( length )
                        end { of "To String". }
                  end;
           if parms[1].str.length = 0 then begin
              anyParms := false;
              parmLength := 1
              end
           else begin
              anyParms := true;
              parmLength := N;
              for I := 1 to parmLength do
                  checkForInteger ( parms [ I ], I )

              end;

           if eof ( terminal ) then begin
              TerminateEdwin;
              WriteLn ('CIFSYS Session aborted.');
              goto 1
              end
           else
              readLn( terminal )
           end { of with P. }
   end; { of lexicalAnalyse. }

   procedure updatePrintingLayers (
               { input   }  var P      :parmList;
                            thisCommand :commands;

               { returns }  var valid  :boolLayerArray );

    label
     1;      { Used to return, if layers command has no params. }
    var{iables}
     newLayers  :boolLayerArray;
     layersON   :boolean;
     I,
     layer      :layerType;
     pNumber    :parmRange;

    function findLayer ( var body  :strBodyType )  :layerType;
     label
      1;      { Used to return if layer name Body is valid. }
     var{iables}
      L   :const4string;
      I   :1..maxLnameLength;
      K   :layerType;
     begin
      for I := 1 to maxLnameLength do
          L [ I ] := body [ pred ( I ) ];

      for K := ND to ZZZ do
          if L = Nmos [ K ] then begin
             findLayer := K;
             goto 1 { return from function. }
             end;

      findLayer := ZZZ;
 1: end; { of Find Layer. }

    begin
     with P do begin
          if parmLength = 1 then begin
             { No parameters so display currently selected layers. }
             NewLine;
             if thisCommand = comLayers then
                write(' Currently selected layers are: ')
             else
                write(' Currently selected stipple layers are:');

             for I := ND to pred ( ZZZ ) do
                 if valid [ I ] then write ( Nmos [ I ] );
             writeLn;
             goto 1       { return. }
             end;

          { Check that the layers are suceeded by the arguement }
          { ON or OFF.                                          }
          with parms[ parmLength ].str do
               if body = ON then
                  layersOn := true
               else if body = OFF then
                  layersON := false
               else begin
                  userError ( semantic, printing, parmLength );
                  writeLn('ON/OFF expected!');
                  signalUserFault
                  end;

          if parmLength = 2 then
             { All layers are to be switched ON or OFF. }
             for I := ND to ZZZ do newLayers [ I ] := layersON
          else begin
             { Otherwise check user specified layers. }

             { Initialise all the layers. }
             for I := ND to ZZZ do newLayers [ I ] := not layersON;

             { Now Check that all the layer names are valid. }
             for pNumber := 2 to pred( parmLength ) do begin
                 with parms[ pNumber ].str do begin
                      layer := findLayer ( body );

                      if layer = ZZZ then begin
                         userError ( semantic, printing, pNumber );
                         if length >= 1 then
                            writeLn('Layer ',body :length,' not valid!')
                         else
                            writeLn('Layer "" not valid!');
                         signalUserFault
                         end
                      end; { with parms[ pNumber].str }
                 newLayers[ layer ] := layersON
                 end { of loop over layers. }
             end; { Parameter check complete. }

          { Update the Valid array with new layers. }
          if layersON then
             for I := ND to ZZZ do
                 valid [ I ] := valid [ I ] or newLayers [ I ]
          else
             for I := ND to ZZZ do
                 valid [ I ] := valid [ I ] and newLayers [ I ]

          end; { with P }
1: end; { of Update Printing Layers. }


   function selectCommand ( var Str  :string )  :commands;
    label
     1;   { Used to Return from a procedure. }
    var{iables}
     I          :commands;
     lookLength :stringLength;
     lookBody   :strBodyType;
    begin
     with str do begin
          lookLength := length;
          lookBody   := body
          end;

     for I := comDraw to comWindow do
         with commDict [ I ] do
              if length = lookLength then
                 if body = lookBody then begin
                    { Command found. }
                    selectCommand := I;
                    goto 1 { return. }
                    end;

     selectCommand := comNotFound;
 1: end; { of Select Command. }

   begin { Cif View. }

    initCifView;

    initEdwin;

    switchDeviceInto ( textMode );

    { getBool ( debugSemantics, 'Debug' ); } DebugSemantics := false;

    analOrDrawCif ( analysis, 0, 0, valid );

    { getBool ( debugCifView, 'Debug' ); }   DebugCifView := false;

    newPage;

    repeat
777: { Recovery point from a faulty command line. }
      switchDeviceInto ( textMode );

     anyParms := false;
     repeat
           NewLine;
           {write('Cif: ');}
           TTPut (ORD ('C'));
           TTPut (ORD ('i'));
           TTPut (ORD ('f'));
           TTPut (ORD (':'));
           TTPut (ORD (' '));

           FlushOutput;
           lexicalAnalyse ( commandLine, anyParms );
     until anyParms;

     with commandLine do begin
          if debugCifView then begin
             for I := 1 to parmLength do
              with parms [ I ] do begin
                 if I = 1 then
                    write(' Command ')
                 else
                    write(' Param ',pred(I):1,' ');

                 write ('is of ');
                 if thisParm = intType then
                    writeLn('Integer type => ',int:1 )
                 else
                    writeLn('String  type => ',str.body  :str.length )
                 end;
             writeLn; writeLn
             end; { Debug Cif View. }

          thisCommand := selectCommand ( parms [ 1 ].str );

          case thisCommand of

              comDraw:
               begin
                if not ( parmLength in [2..3] ) then begin
                   userError ( semantic, not printing, 2 );
                   writeLn(' Draw Command takes one or two params!');
                   signalUserFault
                   end;

                with parms [ 2 ] do begin
                     if thisParm = intType then begin
                        libIndex := find ( int );
                        if libIndex = -1 then begin
                           userError ( semantic, printing, 2 );
                           writeLn('Symbol ',int:1,' not found!');
                           signalUserFault
                           end
                        end
                      else begin
                        libIndex := findStrSymbol ( str );
                        if libIndex = -1 then begin
                           userError ( semantic, printing, 2 );
                           if str.length >= 1 then
                              writeLn('Symbol ',str.body :str.length,
                                   ' not found!')
                           else
                              writeLn ('Symbol "" not found!');
                           signalUserFault
                           end
                        end
                      end;     { Semantic check of first parameter. }

                with parms [ 3 ] do begin
                     if parmLength = 2 then
                        level := curLevel

                     else if thisParm = intType then begin
                        if ( int < 0 ) or ( int > 99 ) then int := 99;
                        NewLine;
                        writeLn(' Level = ',int:1 );
                        level := int;
                        end
                     else begin
                        userError ( semantic, printing, 3 );
                        writeLn('Integer Level expected.');
                        signalUserFault
                        end;
                     end;      { Semantic check of second parameter. }

                lastIndex := libIndex; { Used in Window Command. }

                newPage;
                with lib [ libIndex ]^ do begin
                     with lowerPoint do begin
                          XL := X;
                          YB := Y
                          end;
                     with upperPoint do begin
                          XR := X;
                          YT := Y
                          end;
                     end;

                switchDeviceInto ( drawMode );

                squareWindow ( XL, XR, YB, YT );

                window       ( XL, XR, YB, YT );

                clipOFF; { Everything is going to be within the bounding     }
                         { box, so optimise Edwin by switching off clipping. }

                analOrDrawCif ( normalCall, libIndex, level, valid );

                clipON         { Resume Clipping. }
               end;           { of Draw Command. }

              comHelp:
               begin
                NewLine; WriteLn(' Commands available are :-');
                NewLine; WriteLn('   Draw   <cell name/number> <depth>');
                NewLine; WriteLn('   Layers <layer list> <ON/OFF>');
                NewLine; WriteLn('   Level  <drawing depth>');
                NewLine; WriteLn('   List');
                NewLine; WriteLn('   Erase');
                NewLine; WriteLn('   Point');
                NewLine; WriteLn('   Stipple <layer list> <ON/OFF>');
                NewLine; WriteLn('   Stop');
                NewLine; WriteLn('   Window');
                NewLine; NewLine;
                NewLine; WriteLn(' Any Problems?? Try Graham Toal,');
                NewLine; WriteLn('                     VLSI R&D Group,');
                NewLine; WriteLn('                      ext 379,');
                NewLine; WriteLn('                       Acorn Computers.');
               end;            { of Help Command. }

              comIds:
               begin
                with parms [ 2 ].str do
                     if (body = on) or (body = off) then begin
                        NewLine;
                        writeLn('setting Ids ',body:3);
                        end
                     else begin
                        userError ( semantic, printing, 2 );
                        writeLn('ON/OFF expected.');
                        signalUserFault
                        end
               end;            { of Ids Command. }

              comList:
               begin
                if parms [ 2 ].str.length <> 0 then begin
                   userError ( semantic, not printing, 2 );
                   writeLn('List does not require any parameters!');
                   signalUserFault
                   end;
                listSymbols ( lambda );
               end;    { of List Command. }

              comLayers,
              comStipple:
               begin
                if thisCommand = comLayers then
                   updatePrintingLayers ( commandLine, comLayers, valid )
                else
                   updatePrintingLayers ( commandLine, comStipple, cifStipple )
               end;    { of Layer Command. }

              comLevel:
               begin
                with parms [ 2 ] do
                     if thisParm = intType then begin
                        if ( int < 0 ) or ( int > 99 ) then int := 99;
                        NewLine;
                        writeLn(' Expansion level set to ',int:1 );
                        curLevel := int;
                        end
                     else begin
                        userError ( semantic, printing, 2 );
                        writeLn('Integer Level expected.');
                        signalUserFault
                        end;
               end;    { of Level Command. }

              comErase:
               begin
                newPage;
               end;

              comNotFound:
               begin
                NewLine;
                writeLn(' Sorry, I don''t know that one.');
               end;

              comPoint:
               begin
                if parmLength > 1 then begin
                   { Place a marker at point X,Y. }
                   if ( parmLength > 3               ) or
                      ( parms[2].thisParm <> intType ) or
                      ( parms[3].thisParm <> intType ) then
                        begin
                         userError ( semantic, not printing, 2 );
                         writeLn(' X & Y coordinates expected!');
                         signalUserFault
                        end;

                   X := parms [ 2 ].int;  Y := parms [ 3 ].int;

                   switchDeviceInto ( drawMode );

                   { Save present window. }
                   inquireWindow ( XLdump, XRdump, YBdump, YTdump );

                   { Draw a marker at point X,Y          }
                   { using Map To Device Coords, so      }
                   { the size of the marker will remain  }
                   { constant what ever the window size. }
                   mapToDeviceCoords ( X, Y );
                   window ( 256, 1023, 0, 767 );
                   moveAbs ( X - 10, Y - 10 );
                   lineRel ( 10, 10 );
                   lineRel ( 0, -10 );
                   lineRel ( -10, 10 );
                   lineRel ( 0, -10 );
                   window ( XLdump, XRdump, YBdump, YTdump );
                   end

                else begin
                  { User points to an area on the screen. }
                  switchDeviceInto ( drawMode );
                  cursor ( CH, X, Y );
                  switchDeviceInto ( textMode );
                  NewLine;
                  writeLn(' X = ',X:1,' Y = ', Y:1 );
                  end
               end;   { of Point Command. }

              comStop:
               begin
                NewLine;
                TerminateEdwin;
                writeLn(' CIFSYS session completed.');
                goto 1  { return. }
               end;

              comWindow:
               begin
                if lastIndex = -1 then begin
                   userError ( semantic, not printing, 1 );
                   writeLn(' Nothing to Window on!');
                   signalUserFault
                   end;

                if parmLength > 1 then
                   { Window by user specified coordinates. }
                   if ( parmLength > 5 ) or
                      ( parms[2].thisParm <> intType ) or
                      ( parms[3].thisParm <> intType ) or
                      ( parms[4].thisParm <> intType ) or
                      ( parms[5].thisParm <> intType ) then
                      begin
                       userError ( semantic, not printing, 2 );
                       writeLn('Window Command expects 4 integers',
                               ' XL, XR, YB, YT');
                       signalUserFault
                      end
                   else begin
                      XL := parms[2].int;  XR := parms[3].int;
                      YB := parms[4].int;  YT := parms[5].int;
                      switchDeviceInto ( drawMode )
                      end

                else begin
                   { Window defined by Cursor control. }
                   switchDeviceInto ( drawMode );
                   cursor ( CH, XL, YB );
                   cursor ( CH, XR, YT );
                   end;

                newPage;
                SwitchDeviceInto (DrawMode);
                if XL > XR then swop ( XL, XR );
                if YB > YT then swop ( YB, YT );

                squareWindow ( XL, XR, YB, YT );
                window       ( XL, XR, YB, YT );

                analOrDrawCif(normalCall, lastIndex, level,valid);
               end; { of Window Command. }

              end; { of Select Command. }
          end;  { of with Comand Line. }
    until false; { repeat for ever. }
1: end; { of Cif View. }

begin { Main program of Cifsys }

    {  Initialise the Global Variables Used in CifSys. }
    {  ~~~~~~~~~~ ~~~ ~~~~~~ ~~~~~~~~~ ~~~~ ~~ ~~~~~~~ }

    init   := false;
    ignore := false;
    lValid := false;

    lines := 1;

    for K := 0 to libMax do begin
        lib [ K ] := nil;
        fastFind [ K ].isPresent := false
        end;

    forwardRefs := false;

    { Initialise the layer array. }
    Nmos[ND] := 'ND  ';
    Nmos[NP] := 'NP  ';
    Nmos[NM] := 'NM  ';
    Nmos[NI] := 'NI  ';
    Nmos[NG] := 'NG  ';
    Nmos[NB] := 'NB  ';
    Nmos[NC] := 'NC  ';
    Nmos[NX] := 'NX  ';
    Nmos[ZZZ]:= 'ZZZ ';

    curLayer   := ZZZ;
    callLayer  := ZZZ;

    curSymbol  := nil;
    curElement := nil;

(*               MACHINE DEPENDENT SECTION               *)
   REWRITE (TTYout, '/dev/tty');  {Non-standard REWRITE}
   RESET   (TTYin, '/dev/tty');   {Non-standard RESET}
(*           END OF MACHINE DEPENDENT SECTION            *)
   StartIo;
   REWRITE (PDFout);
   RESET   (PDFin);

   viewing := true;
   storing := false;
   clipping:= true;

   Vis     := true;

   RA [0] := 0;
   RA [1] := 5;
   RA [2] := 3;
   RA [3] := 6;

   Attributes [ 0] := 1;
   Attributes [ 1] := 0;
   Attributes [ 2] := 12;
   Attributes [ 3] := 0;
   Attributes [ 4] := 0;
   Attributes [ 5] := 0;
   Attributes [ 6] := 90;
   Attributes [ 7] := 5;
   Attributes [ 8] := 0;
   Attributes [ 9] := 0;
   Attributes [10] := 0;
   Attributes [11] := 0;
   Attributes [12] := 0;
   Attributes [13] := 0;
   Attributes [14] := 0;
   Attributes [15] := 0;

   XLim [ 0] := 1023; YLim [ 0] := 767;
   XLim [ 1] := 4095; YLim [ 1] := 4095;
   XLim [ 2] := 16000;YLim [ 2] := 11400;
   XLim [ 3] := 1023; YLim [ 3] := 1023;
   XLim [ 4] := 1279; YLim [ 4] := 1023;

   DVX [ 0] :=  1023; DVY [ 0] :=   767;
   DVX [ 1] :=  1023; DVY [ 1] :=   767;
   DVX [ 2] := 11200; DVY [ 2] :=  8000;
   DVX [ 3] :=  1023; DVY [ 3] :=  1023;
   DVX [ 4] :=  1279; DVY [ 4] :=  1023;

   AspectM [ 0] :=  1;  AspectD [ 0] := 1;
   AspectM [ 1] :=  1;  AspectD [ 1] := 1;
   AspectM [ 2] :=  1;  AspectD [ 2] := 1;
   AspectM [ 3] :=  1;  AspectD [ 3] := 1;
   AspectM [ 4] :=  1;  AspectD [ 4] := 1;

   MK [ 0] := ORD ('.');  MK [ 1] := ORD ('O');
   MK [ 2] := ORD ('#');  MK [ 3] := ORD ('A');
   MK [ 4] := ORD ('X');  MK [ 5] := ORD ('*');
   MK [ 6] := ORD ('+');  MK [ 7] := ORD ('>');
   MK [ 8] := ORD ('<');  MK [ 9] := ORD ('V');
   MK [10] := ORD ('^');

   RX [0] :=  1;  RX [1] :=  0;  RX [2] := -1;  RX [3] :=  0;
   RY [0] :=  0;  RY [1] :=  1;  RY [2] :=  0;  RY [3] := -1;

   XO := 0;
   YO := 0;
   XS := 1023;
   YS := 1023;
   CX := 0;
   CY := 0;
   XV := 1023;
   YV := 1023;
   XL := 0;
   XR := 1023;
   YB := 0;
   YT := 1023;

   OWXL := 0;
   OWXR := 1023;
   OWYB := 0;
   OWYT := 1023;

   OTX := 0;
   OTY := 0;

   CIFColour [ND] := 1;
   CIFColour [NP] := 2;
   CIFColour [NM] := 3;
   CIFColour [NI] := 4;
   CIFColour [NG] := 5;
   CIFColour [NB] := 6;
   CIFColour [NC] := 7;
   CIFColour [NX] := 8;

   DefStipple [ND] := Hatch3;
   DefStipple [NP] := Hatch2;
   DefStipple [NM] := Hatch1;
   DefStipple [NI] := None;
   DefStipple [NG] := None;
   DefStipple [NB] := None;
   DefStipple [NC] := Hatch4;
   DefStipple [NX] := None;

   cifView    { Read CIF files & interact with user }

end {cifsys}.