! CIF VIEW        J. Gordon Hughes    May 1984

{#######################################################################}
{#                                                                     #}
{#     This program is part of the ILAP library, and was written in    #}
{#  The Department of Computer Science at the University of Edinburgh  #}
{#      (James Clerk Maxwell Building, Kings Buildings, Edinburgh)     #}
{#                                                                     #}
{#  This software is available free to other educational establisments #}
{#  but the University of Edinburgh, retains all commercial rights.    #}
{#  It is a condition of having this software is that the sources are  #}
{#  not passed on to any other site, and that Edinburgh University is  #}
{#  given credit in any re-implementations of any of the algorithms    #}
{#  used, or articles published which refer to the software.           #}
{#                                                                     #}
{#  There is no formal support for this software, but any bugs should  #}
{#  be reported to Gordon Hughes or David Rees at the above address,   #}
{#  and these are likely to be fixed in a future release.              #}
{#                                                                     #}
{#######################################################################}

%const %integer TRUE=1, FALSE = 0
%record %format POINTFM (%integer X, Y)

! The routine interface to CIFSYS -

%external %string (31) %fn %spec CIFSYS VERSION
%external %integer %spec MAX ELEMENTS
%external %routine %spec ANAL OR DRAW CIF (%integer PARM, CELL, MAX LAYERS, FACTOR,
   %string (4) %array %name  LAYER NAMES(1:15),
   %integer %array %name VALID(1:15),
   %integer %array %name PERCENTAGES(1:15))
%external %routine %spec LIST CELLS (%integer ILAP SCALE, INTERACTS, NUM ON PAGE)
%external %integer %fn %spec FIND CELL (%string (255) NAME, %integer N, %integer %name XL, YB, XR, YT)
%external %routine %spec SET CELL (%integer CELL ID, WHICH, ONOFF)
%external %routine %spec CIFSYS LEVEL (%integer I)
%external %routine %spec CIFSYS MONITOR (%integer I)
%external %string (63) %fn %spec CIFSYS ERROR (%integer I)
%external %routine %spec D W DEF (%integer D, ID)
%external %integer %fn %spec CIF CELL NUMBER (%integer CIFSYSID)

! Use of streams -    in   1.... Secondary command file (USE)
!                          1.... CIF input files (with include files)
!                     out  1  -  Output from CELLS
!                          2  -  EDWIN PDF
!                          3  -  Other graphics output.

! For all systems -
!%external %routine %spec SET DEFAULT (%string (7) EXT)
%const %integer VAX = M'VAX', EMAS = M'EMAS'

! For VAX
%const %integer MACHINE = VAX
%const %string (1) SYSTEM = "A"
%include "edwin:CONSTS.INC"
%include "EDWIN:SPECS.INC"
%include "EDWIN:SHAPES.INC"
%include "EDWIN:TXSTACK.INC"

%const %string (31) HELP FILE = "VLSI:CIFVIEW.DOC", USE DIR = "VLSI:"
%const %string (7) CELLS EXT = ".LIS",  CIF EXT = ".CIF",
                     USE EXT = ".COM",  PDF EXT = ".PDF",    HP EXT = ".HP",
                      GP EXT = ".GP-F80",LP EXT = ".LP"
%const %string (3) TTIN = ":T",   TTOUT = ":T"

%include "Inc:FS.IMP"
%include "Inc:Util.imp"
%integer %fn SEXISTS (%string(127) FILE)
    %integer xno
    %on 3,9 %start; %result = FALSE; %finish
    xno = fcomm('S'<<8,file)
    %if xno > 0 %start
        xno = fcomm('H'<<8+Xno+'0',"")
        %result = TRUE
    %finish
    %result = FALSE
%end

! For EMAS

!%const %integer MACHINE = EMAS
!%const %string (1) SYSTEM = "E"
!%include "ECSLIB.EDWIN_CON"
!%include "ECSLIB.EDWIN_INC"
!%include "ECSLIB.EDWIN_GEO"
!%include "ECSLIB.EDWIN_TXS"
!%include "ECSC17.IMP77SPECS"
!
!%const %string (31) HELP FILE = "ECSLIB.VLSIUSE_CIFVIEW", USE DIR = "ECSLIB.VLSIUSE_"
!%const %string (5) CELLS EXT = "#LIS",  CIF EXT = "#CIF",
!                     USE EXT = "",      PDF EXT = "#PDF",    HP EXT = "#HP",
!                      GP EXT = "#GP",    LP EXT = "#LP"
!%const %string (5) TTIN = ".IN",   TTOUT = ".OUT"
!
!%external %integer %fn %spec SEXISTS %alias "EXIST" (%string (255) FILE)
!{ and remove the %begin block at the end of the file }

%const %integer MAX LAYERS = 15
%own %integer N LAYERS = 10
%own %string (1) TECH = "?"
%own %integer DEVICE = -1
%own %string (4) %array L NAMES (1 : MAX LAYERS) = "ND", "NP", "NM", "NI", "NB", "NC", "NG", "NV", "NX", "ZZZ" (*)
%own %integer %array PERCENTS (1 : MAX LAYERS) =  18, 15, 18, 6, 3, 10, 1, 3, 1, 23, 0 (*)

%const %integer DEF ILAP SCALE = 250;  ! no. of 100ths micron/lambda.
! DEF LAYER COL the default colour of each layer
%own %byte %integer %array DEF LAYER COL (1:MAX LAYERS) = 3,4,2,4,1(*)
! LAYER COL the colour of each layer
%own %byte %integer %array LAYER COL (1:MAX LAYERS) = 3,4,2,4,1(*)
! LAYER STYLE  is the line style used
%own %byte %integer %array       LAYER STYLE (1:MAX LAYERS) = 0 (3), 1, 0, 1, 0 (*)
! VALID is used to indicate if a layer is visible.
%own %integer %array VALID (1:MAX LAYERS) = TRUE (*)

%external %routine DO LAYER (%string (5) LAY)
   %const %integer ON = 1, OFF = 0
   %integer L, MODE, COL, SHADE, RASTER

   RASTER = OFF
   RASTER = ON %if DEVICE=CHARLES %or DEVICE=SIGMA %c
               %or DEVICE=APM Level 1  %or DEVICE=BBC Micro %c
               %or device=APM level 2
   %for L=1,1,N LAYERS %cycle
        %if LAY = L NAMES (L) %start
            SET LINE STYLE (LAYER STYLE (L))
            COL = LAYER COL (L)
            MODE = OR MODE
            SHADE = SOLID
            %if CHARNO(LAY,2)='C' %start { Contacts }
                MODE = Replace Mode
                COL = 0 %if RASTER = ON %and LENGTH(LAY)=2
            %finish %else %if CHARNO(LAY,2)='I' %or CHARNO(LAY,2)='W' %start
                SHADE = OUTLINE %if DEVICE=APM Level 1 %or DEVICE=BBC Micro %c
                                %or device=APM level 2
                SHADE = OUTLINE %if LAY="CWP"
            %finish %else %if LAY="NB" %start
                SHADE = OUTLINE
                COL = 1 %if RASTER = ON
            %finish
            SET COLOUR MODE (MODE)
            SET SHADE MODE (SHADE)
            SET COLOUR (COL)
            %return
        %finish
   %repeat
   UPDATE
   PRINT STRING ("Unknown layer - ".LAY)
   NEWLINE
   %signal 12
%end

%external %routine DO TEXT (%integer SIZE, DIR, X, Y, %string (255) STR)
   SET CHAR SIZE (SIZE)
   SET CHAR ROT (DIR)
   MOVE ABS (X, Y)
   TEXT (STR)
%end

%external %routine GET WINDOW (%integer %name XL, XR, YB, YT)
   INQUIRE WINDOW (XL, XR, YB, YT)
%end

%external %routine DO MB BOX (%string (255) NAME, %integer XL, YL, XU, YU)
   ! Draws a Minimum Bounding BOX for cell.
   %integer SX, SY, DX, DY, ROT, DXU, DXL, DYU, DYL
   %const %integer WIDTH=4

   SET LINE STYLE (0)
   %if DEVICE#CHARLES %start
       SET COLOUR (1)
       MOVE ABS (XL, YL)
       LINE ABS (XU, YL)
       LINE ABS (XU, YU)
       LINE ABS (XL, YU)
       LINE ABS (XL, YL)
   %else
       SET COLOUR MODE (Replace Mode)
       SET COLOUR (7)
       DXL = XL;   DYL = YL
       DXU = XU;   DYU = YU
       MAP TO DEVICE COORDS (DXL, DYL)
       MAP TO DEVICE COORDS (DXU, DYU)
       DRIVE DEVICE (12, DXL, DYL);   DRIVE DEVICE (13, DXU, DYL+WIDTH)
       DRIVE DEVICE (12, DXU-WIDTH, DYL);   DRIVE DEVICE (13, DXU, DYU)
       DRIVE DEVICE (12, DXL, DYU-WIDTH);   DRIVE DEVICE (13, DXU, DYU)
       DRIVE DEVICE (12, DXL, DYL);   DRIVE DEVICE (13, DXL+WIDTH, DYU)
   %finish
   %return %if NAME=""
   DX = XU - XL
   DY = YU - YL
   %if DY > DX %start
       SX = DX;   DX = DY;   DY = SX;
       ROT = 90
   %finish %else ROT = 0
   %cycle
      NAME = " " . NAME . " "
      %return %if LENGTH(NAME)>253
      SX = DX//(LENGTH(NAME))
      %return %if SX = 0
      SY = DY//5;   ! Max char size of 0.2 * DY
      %return %if SY = 0
      %exit %if SY*2 > SX
   %repeat
   %if ROT#0 %then MOVE ABS (XL + 3*SY, YL) %else MOVE ABS (XL, YL + (3*SY)//2)
   SET CHAR SIZE (SX)
   SET CHAR ROT (ROT)
   TEXT (NAME)
%end

%external %routine DO BOX (%integer L, W, %record (POINTFM) %name C, D)
   ! Draw box of length L, width W, at centre C with direction vector D.
   BOX (L, W, C, D)
%end

%external %routine DO POLYGON (%integer NE, %record (POINTFM) %array %name P(1:*))
   ! Draw a polygon with number of elements NE, contained in P.
   POLYGON (NE, P)
%end

%external %routine DO WIRE (%integer W, NP, %record (POINTFM) %array %name P(1:*))
   ! Draw a wire of width W, with number of points NP, contained in P.
   WIRE (W, NP, P)
%end

!###########################################################################
!#                                                                         #
!#              T h e   M a i n   B o d y   of   C I F V I E W             #
!#                                                                         #
!###########################################################################

%external %routine CIFVIEW (%string (255) PARAM)

%const %string (31) DEVICE SET TO = "Current device set to be "
%const %string (63) NOT PLOTTER   = "Current device is not a plotter"
%const %string (31) NOT COLOUR    = "Unknown colour specified"
%const %string (31) UNKNOWN STYLE = "Unknown line style specifed"
%const %string (63) NO DIGITS     = "Too few digits at the start of the parameter list"
%const %string (63) NO TECHNOLOGY = "No technology set - Analyse some CIF"

%const %real CM TO INS = 2.54;  ! Convertion of Centimeters to inches
%const %real MIN SIGNIFICANT LAMBDA = 0.001
%const %integer NO PLOTTER = 1; ! UNITS per CM set to this if it is not a plotter.

%const %integer HELP=0, DEVIC=1, ANALYSE=2, USE=3, END=4, STOP=5, DRAW=6
%const %integer CALL=7, POINT=8, REDRAW=9, CELLS=10, LEVEL=11, ON=12, OFF=13
%const %integer SIZE=14, NCIRCLE=15, PAN=16, STORE=17, WINDO=18, LAYER=19
%const %integer MON=20, ROTATE=21, SCALE=22, SPEED=23, DELETE=24, SETLAM=25
%const %integer WIPE=26, BCALL=27, VSN=28, IDENT=29, MCALL=30, ZOOM=31
%const %integer WCALL=32, GRID=33
%const %integer LAST=GRID

%conststring(7)%array KNOWN(0:LAST)=%c
"HELP", "DEVICE", "ANALYSE", "USE", "END", "STOP", "DRAW", "CALL", "POINT",
"REDRAW", "CELLS", "LEVEL", "ON", "OFF", "SIZE", "NCIRCLE", "PAN", "STORE",
"WINDOW", "LAYERS", "%MON", "ROTATE", "SCALE", "SPEED", "DISPOSE", "SETLAM",
"WIPE", "BCALL", "VERSION", "IDENT", "MCALL", "ZOOM", "WCALL", "GRID"

%const %integer NO OF CLASHES=11
%const %string (3) %array AMBIGUOUS (1:NO OF CLASHES) = "D", "P", "R", "C", "S", "L", "O", "WI", "W", "STO", "ST"

%switch EXEC(0:LAST)
%integer ROUTINE, A, B, C, D, DX, DY, FACTOR, UNITS PER CM, I, XL, YB
%integer %name ZWXL, ZWXR, ZWYT, ZWYB
%integer CWXL, CWXR, CWYB, CWYT, ZSP, ROTATION
%own %real %array ROT 90 AC (0:8) = 0, -1, 0, 1, 0, 0, 0, 0, 1
%own %real %array ROT 90 C  (0:8) = 0, 1, 0, -1, 0, 0, 0, 0, 1
%record (TRANSFM) %name BASE TRANS
%const %integer MAX ZOOM STACK = 7
%record %format ZOOMF (%integer XL, XR, YB, YT)
%record (ZOOMF) %array ZOOMSTACK (0:MAX ZOOM STACK)
%own %string (127) LAST CELL = ""
%own %integer INIT = FALSE
%own %integer TEK POS = -1;       ! Unknown position
%own %integer GRID SIZE = -1;     ! Undefined (off)
%own %integer ILAP SCALE = DEF ILAP SCALE
%own %integer REQ LEVEL = TRANSFORM STACK DEPTH;    ! Transformation stack size
%own %integer RANDOM WINDOW = -1; ! <0 => not set, 0 => BB window, >0 => random window
%own %integer COMMAND STREAM = 0
%own %real REQ LAMBDA = 0;        ! 0 => not significant.
%real RX, RY, RXO, RYO
%const %integer  MAX COM LEN  = 255;        ! Length of command words
%const %integer  MAX FILE LEN = 127;        ! Length of filename string
%const %integer  MAX OUT LEN  = 127;        ! Length of output line
%string (MAX FILE LEN) LAST FILE ANALED
%string (MAX COM LEN) COMMAND, LINE, REST, TRASH

%routine SWAP (%integer %name A, B)
   %integer C

   C = A;   A = B;   B = C
%end

%routine GET REPLY (%integer %name R)
   %integer I
   READ SYMBOL (R) %and R=R&95 %until R='Y' %or R='N'
   READ SYMBOL (I) %until I=NL
%end

%routine READ COMMAND LINE
   %integer CHAR

   %on 3,9 %start
       COMMAND="STOP"
       %return
   %finish

   LINE = ""
   COMMAND = ""

   %cycle
      READ SYMBOL (CHAR)
      TEKPOS = TEKPOS + 1 %if CHAR = NL %and TEKPOS>0
   %repeat %until CHAR > ' '

   %cycle
      CHAR = CHAR & 95 %if 'a'<=CHAR<='z'
      COMMAND = COMMAND.TO STRING (CHAR)
      READ SYMBOL (CHAR)
   %repeat %until CHAR <= ' ' %or LENGTH(COMMAND)=MAX COM LEN

   READ SYMBOL (CHAR) %while CHAR <= ' ' %and CHAR # NL
   %return %if CHAR = NL

   %cycle
      CHAR = CHAR & 95 %if 'a'<=CHAR<='z'
      LINE = LINE.TO STRING(CHAR)
      READ SYMBOL (CHAR)
   %repeat %until CHAR = NL %or LENGTH(LINE)=MAX COM LEN
%end

%routine MESSAGE (%string (255) S)
   PRINT STRING (S)
   NEWLINE
%end

%routine FAULT(%string(255) S)
   SELECT OUTPUT(0)
   MESSAGE (COMMAND." fails - ".S)
   COMMAND STREAM = 0;                ! Reset to terminal if in a command file
   %signal 12
%end

%routine OPEN WRITE(%integer STREAM, %string(MAX FILE LEN) FILE)
   %on 3,9 %start
       FAULT("Cannot access output file ".FILE)
   %finish
   FILE = TTOUT %if FILE=""
   OPEN OUTPUT (STREAM, FILE)
%end

%routine OPEN READ(%integer STREAM, %string(MAX FILE LEN) FILE)
   %on 3,9 %start
       FAULT("Cannot access input file ".FILE)
   %finish
   FILE = TTIN %if FILE=""
   OPEN INPUT (STREAM, FILE)
%end


%routine READ FROM STR (%integer ADDRESS, TYPE, %string (*) %name STR)
   ! TYPE = 0 to read an integer, or >0 for a real
   %integer sign, sym, limit, digit, ptr
   %longreal value, exp, base

   %routine SKIP SYMBOL
      PTR = PTR + 1
   %end

   %integer %fn NEXT SYMBOL
      %signal 9 %if PTR>=length(STR)
      %result = charno (str, ptr+1)
   %end

   str = str." "; ! To avoid %signal 9 , unless nothing is there.
   ptr = 0
   base = 10.0
   sign = 1
   %cycle
      sym = nextsymbol
      %if sym = '-' %start
         %signal 4,1 %if sign < 0
         sign = -1
         skipsymbol;  sym = nextsymbol
         %exit
      %finish
      %exit %if sym >' ' %and sym#','
      skipsymbol
   %repeat
more:
   value = 0
   limit = int(base)
   digit = -1; sym = sym - 32 %if 'a'<= sym <= 'z'
   digit = sym-'0' %if '0' <= sym <= '9'
   digit = sym -'A'+10 %if 'A'<=sym<='Z'
   %signal 4,1 %unless 0 <= digit < limit %or (sym = '.' %and type>0)
   %while 0 <= digit < limit %cycle
      skipsymbol
      value = value*base+digit
      sym = nextsymbol
      digit = -1; sym=sym-32 %if 'a'<=sym<='z'
      digit = sym-'0' %if '0'<=sym<='9'
      digit = sym-'A'+10 %if 'A'<=sym<='Z'
   %repeat
   %if sym = '_' %start
      base = value
      skipsymbol
      sym = nextsymbol
      ->more
   %finish
   %if sym = '.' %and limit = 10  %and type>0 %start
      skipsymbol
      exp = 0.1
      %cycle
         sym = nextsymbol
         %exit %unless '0' <= sym <= '9'
         value = value+(sym-'0')*exp
         exp = exp*0.1
         skipsymbol
      %repeat
   %finish
   %if sym = '@' %and limit = 10 %and type>0 %start
      skipsymbol
      read from str (addr(sym), 16_10<<24, LINE)
      value = value*10.0\sym
   %finish
   value = -value %if sign < 0
   %if type=0 %start;       !integral
      sym = int(value)
      integer(address) = sym
   %finish %else real(address) = value
   STR = SUB STRING (STR, PTR+1, LENGTH(STR))
%end

%integer %fn DIGIT (%integername N)
   %on 3,4,5,9 %start
       %result = FALSE; ! No digit on LINE
   %finish
   READ FROM STR (ADDR(N), 0, LINE)
   %result = TRUE
%end

%integer %fn STOI
   %integer I
   %result = I %if DIGIT(I) = TRUE
   FAULT (NO DIGITS)
%end

%integer %fn RDIGIT (%real %name R)
   %on 3,4,5,9 %start
       %result = FALSE; ! No number on the line.
   %finish
   READ FROM STR (ADDR(R), 1, LINE)
   %result = TRUE
%end

%real %fn STOR
   %real R
   %result = R %if RDIGIT (R) = TRUE
   FAULT (NO DIGITS)
%end

%routine SPACES IN LINE FOR (%integer SYM)
   ! Replace all occurences of SYM in LINE by a space, & remove redundant spaces.
   %string (MAX COM LEN) REST
   %integer I

   %for I=1,1,LENGTH(LINE) %cycle
        CHARNO(LINE,I) = ' ' %if CHARNO(LINE,I)=SYM
   %repeat
   LINE = LINE." ".REST %while LINE -> LINE.("  ").REST
%end

%routine COPY FILE
   ! Make a copy of the current input to current output and then close input

   %integer I

   %on 3,9 %start
       CLOSE INPUT
       %return
   %finish

   %cycle
      READ SYMBOL (I)
      PRINT SYMBOL (I)
   %repeat
%end

%routine NEWFRAME IF INTERACTIVE DISPLAY
   NEWFRAME %if DEVICE=Terminal %or DEVICE=Tektronix -
            %or DEVICE=WESTWARD %or DEVICE=SIGMA %or DEVICE=HP 2648
%end

%routine LIST HELP
   %integer S

   %on 3,9 %start
       %if Event_sub=1 %start
           MESSAGE ("Sorry, no help info on ".LINE)
           Close input
       %else
           MESSAGE ("Cannot open HELP file")
       %finish
       %return
   %finish

   %if LINE#"" %start
       %for S = 0,1,LAST %cycle
            %if KNOWN(S) -> TRASH.(LINE).REST %and TRASH="" %start
                LINE = KNOWN(S)
                ! allows the parameters to be abreviated.
                %exit
            %finish
       %repeat
   %else
       LINE="HELP"
   %finish
   NEWFRAME IF INTERACTIVE DISPLAY
   DRIVE DEVICE (1, 0, 0) %if DEVICE=BBC Micro
   TEKPOS = -1
   OPEN INPUT (COMMAND STREAM + 1, HELP FILE)
   SELECT INPUT (COMMAND STREAM + 1)
   %cycle
      READ SYMBOL (S) %until S='!' %and NEXT SYMBOL='<'
      SKIP SYMBOL
      REST = ""
      READ SYMBOL (S) %and REST=REST.To String(S) %until NEXT SYMBOL = NL
      READ SYMBOL (S)
      %if LINE -> TRASH.(REST) %and TRASH="" %start
          %while %not (s='!' %and next symbol='>') %cycle
              print symbol (s)
              read symbol (s)
          %repeat
          close input
          %return
      %finish
   %repeat
%end

%routine MY UPDATE
   %integer A, B, C, D
   %if DEVICE=HP PLOTTER %and DEVICE DATA_MVX < 17000 %start
       INQUIRE VIEWPORT (A, B, C, D)
       VIEWPORT (0, 16000, 0, 11400)
       DRIVE DEVICE (4, 16000, 11400)
       SET COLOUR (0)
       UPDATE
       VIEWPORT (A, B, C, D)
   %else
       SET COLOUR (0) %if DEVICE=HP PLOTTER
       UPDATE
   %finish
%end

%routine PUSH ZOOM STACK
   %own %record (ZOOMF) %name Z
   ZSP = ZSP + 1
   FAULT ("Zoom stack overflow") %if ZSP = MAX ZOOM STACK
   Z == ZOOM STACK (ZSP)
   ZWXL == Z_XL;   ZWXR == Z_XR;   ZWYB == Z_YB;   ZWYT == Z_YT
%end

%routine POP ZOOM STACK
   FAULT ("Zoom stack is empty") %if ZSP = 0
   ZSP = ZSP - 2
   PUSH ZOOM STACK
%end

%routine INIT ZOOM STACK
   ZSP = -1
   PUSH ZOOM STACK
%end

%routine SET UP DEVICE (%integer DEV)
   %string (MAX FILE LEN) FILE, REST
   %integer I

   FILE = LAST FILE ANALED
   ! Reduce FILE to just the name, according to the rules -
   ! DEV:[DIR]NAME.EXT;VER    on VAX
   ! USER.PDNAME_NAME#EXT     on EMAS
   %if FILE -> (":").FILE %start; %finish
   %if FILE -> ("]").FILE %start; %finish
   %if FILE -> FILE.(".").REST %start
       FILE = REST %if MACHINE = EMAS
   %finish
   %if FILE -> ("_").FILE %start; %finish
   %if FILE -> FILE.("#") %start; %finish
   REST = ""
   REST = GP EXT %if 563<=DEV<=1051
   REST = HP EXT %if DEV=7220
   REST = LP EXT %if DEV='L' %or DEV=132 %or DEV='P' %or DEV=120 %or DEV=300 %or DEV='G'

   %if REST#"" %start
       FILE = FILE.REST
       OPEN WRITE (3, FILE)
       MESSAGE ("Graphics data being sent to ".FILE)
       VIEW ON (3)
   %finish %else VIEW ON (0)

   INITIALISE FOR (DEV)
   DEVICE = DEVICE DATA_DEV NO

   UNITS PER CM = DEVICE DATA_UNITS PER CM
   %if UNITS PER CM # 0 %start
       VIEW PORT (0, 38*UNITS PER CM, 0, 26*UNITS PER CM)
   %else
       REQ LAMBDA = 0
       %if DEVICE=Tektronix %or DEVICE=WESTWARD %start
           VIEW PORT (256, 1023, 0, 767)
       %else
           ! Use default Viewport
       %finish
   %finish
   %if DEVICE=CHARLES %or DEVICE=Tektronix %or DEVICE=SIGMA %c
   %or DEVICE=APM Level 1 %or DEVICE=WESTWARD %c
   %or device=APM level 2 %then I=1 %else I=0
   SET CHAR QUALITY (I)
   SET CHAR SIZE (9)
   TEKPOS = -1
%end

%routine NEW TEK POS
   ! Return to the correct Tektronix position.
   DRIVE DEVICE (4, 0, 780-TEKPOS*20); ! Move
   DRIVE DEVICE (7, 2, 7);             ! Set char size to small.
   DRIVE DEVICE (2, 0, 0);             ! Update
%end

%routine RESET ALL LAYERS
   ! Read in the contents of layer names, colours, styles and percentages.
   %string (5) %array NAMES (1: MAX LAYERS)
   %integer %array PERCENTAGES (1: MAX LAYERS)
   %byte %integer %array COLOUR, STYLE (1: MAX LAYERS)
   %integer I

   %routine READ NAME (%string (5) %name N)
      %string (255) T
      %integer I

      T = ""
      SKIP SYMBOL %while NEXT SYMBOL <=' '
      %cycle
         READ SYMBOL (I)
         %unless ('A'<=I<='Z' %or '0'<=I<='9') %start
             SKIP SYMBOL %while NEXT SYMBOL # NL
             FAULT ("Invalid symbol in layer name")
         %finish
         T = T.TO STRING(I)
      %repeat %until NEXT SYMBOL <=' '
      %if LENGTH(T)<=5 %then N = T %else %start
          SKIP SYMBOL %while NEXT SYMBOL # NL
          FAULT ("Layer name too long")
      %finish
   %end


   %on 1,2,3,4,5,6,7,8,9 %start
       FAULT ("Illegal format for layer".ITOS (I, 1))
   %finish

   %if COMMAND STREAM = 0 %start
       PRINT STRING ("Enter layer identification according to the next line, and end with layer ""ZZZ""")
       NEWLINE
       PRINT STRING ("<layer name>  <colour>  <Old colour>  <line style>  <% of data structure>")
       NEWLINE
   %finish

   PROMPT ("Data: ")
   %for I=1,1,MAX LAYERS %cycle
        READ NAME (NAMES(I))
        %exit %if CHARNO (NAMES(I),1)='Z'
        READ (COLOUR(I))
        READ (STYLE(I)) { Was Charles colour }
        READ (STYLE(I))
        READ (PERCENTAGES(I))
   %repeat

   N LAYERS = I
   READ SYMBOL (I) %until I=NL

   %for I=1,1,N LAYERS-1 %cycle
        L NAMES (I) = NAMES (I)
        DEF LAYER COL (I) = COLOUR (I)
        LAYER COL (I) = COLOUR (I)
        LAYER STYLE (I) = STYLE (I)
        PERCENTS (I) = PERCENTAGES (I)
   %repeat
   L NAMES (N LAYERS) = "ZZZ"
   LAYER COL (N LAYERS) = 1
   LAYER STYLE (N LAYERS) = 0
   PERCENTS (N LAYERS) = 0

   TECH = SUB STRING (NAMES(1), 1, 1)
%end

%routine IDENTIFY (%integer LAYER, COLOUR, STYLE)
   %string (15) %fn COL
      %const %integer MAX COLOUR = 8
      %const %string (7) %array COLOURS (1:MAX COLOUR) =
        "black", "blue", "green", "red", "purple", "yellow", "lime", "brown"
      %result = COLOURS(COLOUR) %if 1<=COLOUR<=MAX COLOUR
      %result = "colour".ITOS(COLOUR,1)
   %end
   %string (15) %fn STY
      %const %integer MAX STYLE = 4
      %const %string (13) %array STYLES (1:MAX STYLE) = "dotted", "chain", "short dashed", "long dashed"
      %result = STYLES(STYLE) %if 1<=STYLE<=MAX STYLE
      %result = "normal"
   %end
   LAYER COL (LAYER) = COLOUR
   LAYER STYLE (LAYER) = STYLE
   MESSAGE ("Layer ".L NAMES(LAYER)." will be drawn in ".COL." and with ".STY." lines")
%end

%string(MAX OUT LEN) %fn LAYERS BEING DRAWN
   %integer I, ALL
   %string (MAX OUT LEN) R
   %const %string (31) DRAWN = " will be used for drawing"

   ALL = TRUE
   R = ""
   %for I=N LAYERS-1,-1,1 %cycle
      %if VALID(I)=TRUE %start
          R = R." + " %if R#""
          R = R.LNAMES(I)
      %finish %else ALL = FALSE
   %repeat

   %result = "All layers".DRAWN %if ALL=TRUE
   %result = "Only bounding boxes will appear, (no layers active)" %if R=""
   R = " ".R
   R = "s".R %if LENGTH(R)>5
   %result = "Only layer".R.DRAWN
%end

%routine DO ANALYSIS
   %routine CHOOSE TECHNOLOGY
      %integer SYM
      %routine GET DEFAULT LAYERS
         %string (4) MOS
         %integer CUR STREAM
         %on 3,9 %start
             COMMAND STREAM = COMMAND STREAM - 1
             SELECT INPUT (CUR STREAM)
             %return
         %finish
         MOS = "MOS"
         CUR STREAM = DEFAULT DEVICE
         MOS = "MOS8" %if CUR STREAM='C' %or CUR STREAM='c'       { Charles } %c
                      %or CUR STREAM='I' %or CUR STREAM='i'       { Igor }    %c
                      %or CUR STREAM='F' %or CUR STREAM='f'       { Fred }    %c
                      %or CUR STREAM=5688 %or CUR STREAM=5982     { Sigma }   %c
                      %or CUR STREAM=16_BBC
         CUR STREAM = IN STREAM
         COMMAND STREAM = COMMAND STREAM + 1
         OPEN INPUT (COMMAND STREAM, USEDIR.TECH.MOS.USEEXT)
         SELECT INPUT (COMMAND STREAM)
         SKIP SYMBOL %while NEXT SYMBOL # NL; ! Skip the command 'IDENT *'
         RESET ALL LAYERS
         CLOSE INPUT
         %signal 9
      %end
      %on 3,9 %start
          RESET INPUT
          GET DEFAULT LAYERS
          %return
      %finish
      TECH = "N"; ! If all else fails use Nmos!
      %cycle
         READ SYMBOL (SYM) %until '0'<=SYM<='9' %or SYM='(' %or 'A'<=SYM<='Z'
         %if SYM = '(' %start
             READ SYMBOL (SYM) %until SYM = ')'
             %continue
         %finish
         %if SYM = 'L' %start
             READ SYMBOL (SYM) %until 'A'<=SYM<='Z'
             TECH = TO STRING (SYM)
             %signal 9
         %finish
         READ SYMBOL (SYM) %until SYM=';'
      %repeat
   %end
   ROUTINE = ANALYSE
   LINE = TTIN %if LINE=""
   LINE = LINE.CIF EXT %if charno(line,1)#':' %and %not (LINE -> ("."))
!   SET DEFAULT (CIF EXT)
   COMMAND STREAM = COMMAND STREAM + 1
   OPEN READ (COMMAND STREAM, LINE)
   SELECT INPUT (COMMAND STREAM)
   PROMPT ("CIF text: ")
   LAST FILE ANALED = LINE
   CHOOSE TECHNOLOGY %if TECH="?"
   ANAL OR DRAW CIF (0, 0, NLAYERS, FACTOR, L NAMES, VALID, PERCENTS)
   CLOSE INPUT
   COMMAND STREAM = COMMAND STREAM - 1
%end

%routine IDENTIFY CELL (%integer %name ID)
   ! This routine identifies a given cell an returns the result in ID.
   ! If the cell is not found it will never return, (fault signaled).
   %string (MAX OUT LEN) NAME

   ID = 0
   NAME=LINE
   LINE="" %if LINE#"*" %and DIGIT (ID) = TRUE
   ID = FIND CELL (LINE, ID, CWXL, CWYB, CWXR, CWYT)
   FAULT ("Cell '".NAME."' not found") %if ID<0
%end

%routine ROTATE WINDOW
   ! Change CWXL, CWXR, CWYB, CWYT to the values required for a 90' rotation.
   %return %if ROTATION = 0
   %if ROTATION > 0 %start
       SWAP (CWYB, CWXL)
       SWAP (CWYT, CWXR)
       SWAP (CWYB, CWYT)
       CWYB = - CWYB;   CWYT = - CWYT
   %else
       SWAP (CWYT, CWXL)
       SWAP (CWYB, CWXR)
       SWAP (CWYB, CWYT)
       CWXR = - CWXR;   CWXL = - CWXL
   %finish
%end

%routine DRAW GRID
   ! Draw a grid over the current picture of size GRID SIZE
   %integer I, A
   CLIP ON
   SET COLOUR MODE (Replace Mode)
   SET COLOUR (1)
   A = REM (CWXR-CWXL, GRID SIZE)
   CWXR = CWXR + GRID SIZE - A %if A#0
   A = REM (CWYT-CWYB, GRID SIZE)
   CWYT = CWYT + GRID SIZE - A %if A#0
   I = CWXL
   %while I <= CWXR %cycle
        MOVE ABS (I, CWYT)
        LINE ABS (I, CWYB)
        I = I +  GRID SIZE
   %repeat
   I = CWYB
   %while I <= CWYT %cycle
        MOVE ABS (CWXL, I)
        LINE ABS (CWXR, I)
        I = I + GRID SIZE
   %repeat
   SET COLOUR (1)
   MARKER ABS (1, 0, 0)
%end

%routine do layers
   %integer I, A, MODE, THIS BIT, CHAR
   %string (MAX COM LEN) LAYERS, REST
   %integer %array TVALID (1:MAX LAYERS)

   %if 'A'<=CHARNO(LINE,1)<='Z' %start
       ! Absolute layer settings
       TVALID(I) = FALSE %for I=1,1,MAX LAYERS
       LINE = "+".LINE
   %else
       ! Layer setting relative to the current settings
       TVALID(I) = VALID(I) %for I=1,1,MAX LAYERS
   %finish
   A = TRUE

   ! Generate a cannonical layer list -
   ! (<sign?><blanks?><layer><blanks?>)* -> (<sign><full layer>' ')*
   LAYERS = ""
   LINE = LINE." "
   THIS BIT = 1
   %cycle
      %cycle
         CHAR = CHARNO(LINE, THIS BIT)
         THIS BIT = THIS BIT + 1
      %repeat %until CHAR>' ' %or THIS BIT>LENGTH(LINE)
      %exit %if THIS BIT>LENGTH(LINE)
      %if CHAR='-' %then LAYERS=LAYERS."-" %else LAYERS=LAYERS."+"
      %while %not ('A'<=CHAR<='Z') %and THIS BIT < LENGTH(LINE) %cycle
         CHAR = CHARNO(LINE, THIS BIT)
         THIS BIT = THIS BIT + 1
      %repeat
      LAYERS = LAYERS.TECH %unless THIS BIT <= LENGTH(LINE) %and 'A'<=CHARNO(LINE,THIS BIT)<='Z'
      %cycle
         LAYERS = LAYERS.TO STRING (CHAR)
         %exit %if THIS BIT = LENGTH(LINE)
         CHAR = CHARNO(LINE, THIS BIT)
         THIS BIT = THIS BIT + 1
      %repeat %until %not ('A'<=CHAR<='Z' %or '0'<=CHAR<='9')
      THIS BIT = THIS BIT - 1 %if CHAR='-'
      LAYERS = LAYERS." "
   %repeat %until THIS BIT >= LENGTH(LINE)

   %cycle
      REST = ""
      %if LAYERS -> LAYERS.(" ").REST %start; %finish
      %if CHARNO(LAYERS,1)='-' %then MODE=FALSE %else MODE=TRUE
      LAYERS = SUB STRING (LAYERS, 2, LENGTH(LAYERS))
      %for I=1,1,N LAYERS %cycle
           TVALID(I) = MODE %and %exit %if LAYERS=LNAMES(I)
           A = FALSE %if I=N LAYERS
      %repeat
      %exit %if A#TRUE
      LAYERS = REST
   %repeat %until REST=""
   %if A=FALSE %then MESSAGE ("Unknown layer - '".LAYERS."'") %else %start
       VALID(I) = TVALID(I) %for I=1,1,N LAYERS
   %finish
%end

!***********************************************************************
!*                                                                     *
!*    Main Program starts here -                                       *
!*                                                                     *
!***********************************************************************

%on %event 9,10,11,12,13,14 %start
    UPDATE
    MESSAGE ("EDWIN error - ".EDWIN ERROR(EVENT_SUB)) %if EVENT_EVENT=14
    MESSAGE ("CIFSYS fails - ".CIFSYS ERROR(EVENT_SUB)) %if EVENT_EVENT=13
    %return %if INIT # TRUE
%finish

%if INIT # TRUE %start;    ! Initialise
    ROTATION = 0 {none}
    INIT ZOOM STACK
    COMMAND = "CIFVIEW"
!    FACTOR = 4
    FACTOR = free store
    FACTOR = FACTOR - 70000 { A guess for the size of arrays etc }
    FAULT ("Not enough memory for the data structure") %if FACTOR < 10000
!    FACTOR = FACTOR * 2 %while PARAM -> ("/BIG").PARAM
!    PARAM = PARAM.REST %while PARAM -> PARAM.(" ").REST
    LAST FILE ANALED = "T"
    INITIALISE FOR (0)
    SET UP DEVICE (0)
    %while PARAM#"" %cycle
           LINE=PARAM %and PARAM="" %unless PARAM -> LINE.(",").PARAM
           ! Note that LINE is used to give the filename to DO ANALYSIS.
           DO ANALYSIS
    %repeat
    NEWLINE
    SET UP DEVICE (default device)
    MESSAGE (DEVICE SET TO.DEVICE DATA_NAME)
    INIT = TRUE
%finish

%cycle
   %cycle
      SELECT INPUT (COMMAND STREAM)
      SELECT OUTPUT (0)
      NEWLINE %if COMMAND STREAM = 0 %and COMMAND#"CELLS"
      PROMPT ("CIF: ")
      %if DEVICE=Tektronix %start
          TEKPOS = -1 %if TEKPOS > 30
          TEKPOS = TEKPOS+3 %and NEW TEK POS %if TEKPOS>=0
      %finish %else %if DEVICE=BBC Micro %start
          DRIVE DEVICE (0, 16_BBC, 0) %if COMMAND="CELLS" %or COMMAND="HELP"
      %finish
      READ COMMAND LINE

      %for I=1,1,NO OF CLASHES %cycle
           COMMAND="CIFVIEW" %and FAULT ("Command is ambiguous") %if COMMAND=AMBIGUOUS(I)
      %repeat

      %for I=0,1,LAST %cycle
           %if KNOWN(I)->TRASH.(COMMAND).REST %and TRASH="" %start
               COMMAND = KNOWN (I)
               ROUTINE = I
               -> EXEC (ROUTINE)
           %finish
      %repeat

      LINE = USEDIR.COMMAND %and -> EXEC (USE) %if SEXISTS(USEDIR.COMMAND.USE EXT)=TRUE
      MESSAGE ("CIFVIEW fails - Command ".COMMAND." not known")
   %repeat

EXEC(HELP): ! Use VIEW to look at the HELP information
            LIST HELP
            %continue

EXEC(DEVIC): ! Find device to be used.
             FAULT ("No device specified") %if LINE=""
             %if LINE#"?" %start
                 I = -1
                 A = CHARNO (LINE,1)
                 I = A %if 'A'<=A<='Z'
                 %if I<0 %start
                     %signal 14, 0 %unless '0'<=CHARNO(LINE,1)<='9'
                     I = STOI
                 %finish
                 TERMINATE EDWIN
!                 %if I#0 %and MACHINE=VAX %start
!                     LINE = LINE.REST %while LINE -> LINE.(" ").REST
!                     LINE = "TT" %if LINE=""
!                     SET IN (LINE)
!                     SET OUT (LINE)
!                 %finish
                 SET UP DEVICE (I)
             %finish
             MESSAGE (DEVICE SET TO.DEVICE DATA_NAME)
             WINDOW (ZWXL, ZWXR, ZWYB, ZWYT) %if RANDOM WINDOW >= 0
             %continue

EXEC(DELETE): ! Delete the cell specified & all the numbers above it.
              %if LINE="*" %then C = 0 %else %start
                  IDENTIFY CELL (C)
                  C = CIF CELL NUMBER (C)
              %finish
              D W DEF ('D', C)
              MESSAGE ("Cells with numbers >= ".ITOS(C,0)." deleted")
              %continue

EXEC(ANALYSE): DO ANALYSIS
               %continue

EXEC(USE): FAULT ("No file specified") %if LINE=""
           LINE = LINE.USE EXT %if charno(line,1)#':' %and %not (LINE -> ("."))
!           SET DEFAULT (USE EXT)
           LINE=USEDIR.LINE %if SEXISTS(USEDIR.LINE)=TRUE
           OPEN READ (COMMAND STREAM + 1, LINE)
           COMMAND STREAM = COMMAND STREAM + 1
           %continue

EXEC(END): EXEC(STOP):
           %if COMMAND STREAM > 0 %start
               COMMAND STREAM = COMMAND STREAM - 1
               CLOSE INPUT
               %continue
           %finish
           TERMINATE EDWIN
           %return

EXEC(ROTATE): ! Specify a base rotation for future calls
              %if LINE#"?" %start
                  %if LINE="" %start
                      ROTATION = 0
                  %else
                      A = CHARNO (LINE,1)
                      %if A='+' %or LINE="90" %start
                          ROTATION = -1
                          BASE TRANS == record(addr(ROT 90 C(0)))
                      %finish %else %if A='-' %start
                          ROTATION = 1
                          BASE TRANS == record(addr(ROT 90 AC(0)))
                      %else
                          MESSAGE ("Parameter '".LINE."' invalid, options are '+90', '-90' '?' or none")
                          %continue
                      %finish
                  %finish
                  LAST CELL = "" { since window will now be wrong! }
                  RANDOM WINDOW = -1
                  ZSP = 0
              %finish
              %if ROTATION < 0 %start
                  LINE = "90 degrees anti-clockwise"
              %finish %else %if ROTATION=0 %start
                  LINE = "unity"
              %else { > 0 }
                  LINE = "90 degrees clockwise"
              %finish
              MESSAGE ("Current base rotation is ".LINE)
              %continue

EXEC(REDRAW): ! Redraw the last cell
              FAULT ("Use the comand DRAW to draw a cell") %if LAST CELL=""
              FAULT ("Only the last cell may be redrawn") %if LINE#""
              LINE = LAST CELL
              IDENTIFY CELL (C)
              -> EXEC (WIPE)

EXEC(MCALL):
EXEC(BCALL):
             COMMAND = "DRAW";   ROUTINE = DRAW
EXEC(DRAW):
             ! Does implicit call of WIPE after setting the window to be the BB of cell
             IDENTIFY CELL (C)
             INIT ZOOM STACK
             RANDOM WINDOW = 0
             CLIP OFF
             ROTATE WINDOW %if ROTATION#0
             WINDOW (CWXL, CWXR, CWYB, CWYT)
             INQUIRE WINDOW (ZWXL, ZWXR, ZWYB, ZWYT)

EXEC(WIPE): NEWFRAME
            TEKPOS = 0;    ! Reset Tektronix page.
            UPDATE %and %continue %if ROUTINE=WIPE

EXEC(CALL): FAULT ("No window set (you probably want the command DRAW)") %if RANDOM WINDOW<0
            IDENTIFY CELL (C) %if ROUTINE = CALL
            LAST CELL = ItoS (Cif cell number(C), 0)
            INIT TRANSFORM
            PUSH TRANSFORM (BASE TRANS) %if ROTATION#0
            %if REQ LAMBDA>MIN SIGNIFICANT LAMBDA %start
                INQUIRE WINDOW (CWXL, CWXR, CWYB, CWYT)
                XL = CWXL
                YB = CWYB
                RX = |(CWXR-CWXL)|
                RY = |(CWYT-CWYB)|
                INQUIRE VIEWPORT (A, I, B, D)
                ! DX & DY are set to be the window per sheet of paper
                DX = int ((I-A) * ILAP SCALE / UNITS PER CM / REQ LAMBDA)
                DY = int ((D-B) * ILAP SCALE / UNITS PER CM / REQ LAMBDA)
                %if RX > DX %or RY > DY %start
                    UPDATE
                    PRINT STRING ("The design will not fit on one sheet of paper at the current lambda setting")
                    NEWLINE
                    PROMPT ("Do you wish to plot it over".ItoS (int(RX/DX+0.5) * int(RY/DY+0.5), 1)." sheets (Y/N)?")
                    GET REPLY (A)
                    %continue %if A = 'N'
                    RANDOM WINDOW = 1
                    CLIP ON
                    PROMPT ("Do you want to plot all the sheets (Y/N)?")
                    GET REPLY (A)
                    ! Now Draw them
                    D = 0; ! The plot number.
                    INIT TRANSFORM
                    PUSH TRANSFORM (BASE TRANS) %if ROTATION#0
                    %cycle
                       CWXL = XL
                       %cycle
                          D = D + 1
                          %if A='N' %start; ! Selective plotting
                              PROMPT ("Do you want to plot sheet".ITOS (D, 1)." (Y/N)?")
                              GET REPLY (B)
                          %finish %else B = 'Y'
                          %if B='Y' %start
                              NEWFRAME
                              WINDOW (CWXL, CWXL + DX, CWYB, CWYB + DY)
                              ANAL OR DRAW CIF (DRAW, C, NLAYERS, FACTOR, L NAMES, VALID, PERCENTS)
                              MARKER ABS (6, CWXL, CWYB)
                              MARKER ABS (6, CWXL+DX, CWYB)
                              MARKER ABS (6, CWXL+DX, CWYB+DY)
                              MARKER ABS (6, CWXL, CWYB+DY)
                              MY UPDATE
                          %finish
                          CWXL = CWXL + DX
                       %repeat %until CWXL >= CWXR
                       CWYB = CWYB + DY
                    %repeat %until CWYB >= CWYT
                    WINDOW (ZWXL, ZWXR, ZWYB, ZWYT)
                    %continue
                %finish
                CWXL = CWXL - INT((DX - RX)/2)
                CWXR = CWXR + INT((DX - RX)/2)
                CWYB = CWYB - INT((DY - RY)/2)
                CWYT = CWYT + INT((DY - RY)/2)
                WINDOW (CWXL, CWXR, CWYB, CWYT)
            %finish
            ANAL OR DRAW CIF (DRAW, C, NLAYERS, FACTOR, L NAMES, VALID, PERCENTS)
            DRAW GRID %if GRID SIZE > 0 %and ROUTINE#CALL
            DRIVE DEVICE (4, 0, 22) %if DEVICE=Terminal; ! Move to top left of the screen
            MY UPDATE
            %continue

EXEC(CELLS): !SET DEFAULT (CELLS EXT)
             A = 17 { Lines/page }
             %if LINE#"" %start
                 OPEN WRITE (1, LINE)
                 SELECT OUTPUT (1)
                 I = FALSE { Interactive? }
             %else
                 NEWFRAME IF INTERACTIVE DISPLAY
                 DRIVE DEVICE (1, 0, 0) %if DEVICE=BBC Micro
                 I = TRUE
             %finish
             LIST CELLS (ILAP SCALE, I, A)
             CLOSE OUTPUT %if LINE#""
             TEKPOS = -1
             %continue

EXEC(LEVEL): ! The level of the data structure hierarchy which is to be interpreted
             %if LINE#"?" %start
                 %if LINE#"" %start
                     REQ LEVEL = STOI
                 %else
                     REQ LEVEL = -1
                 %finish
                 REQ LEVEL = TRANSFORM STACK DEPTH %if REQ LEVEL < 0
                 CIFSYS LEVEL (REQ LEVEL)
             %finish
             MESSAGE ("Level set to ".ITOS(REQ LEVEL,0))
             %continue

EXEC(NCIRCLE): I = STOI
               I = 15 %if I<10
               SET CHORD STEP (I)
               MESSAGE ("Circles will now be drawn with a chord step of ".ITOS(I,0)." degrees")
               %continue


EXEC(STORE): ! Store an EDWIN PDF
             %if LINE="" %start
                 STORE OFF
                 LINE = "PDF storing disabled"
             %else
                 %if LINE#"?" %start
                     LINE = LINE.PDF EXT %if charno(line,1)#':' %and %not (LINE -> ("."))
!                     SET DEFAULT (PDF EXT)
                     OPEN WRITE (2, LINE)
                     STORE ON (2)
                 %finish
                 SELECT OUTPUT (2)
                 LINE = "An EDWIN PDF is being dumped into ".OUT FILE NAME
             %finish
             SELECT OUTPUT (0)
             MESSAGE (LINE)
             %continue

EXEC(PAN): ! Either PAN X Y which moves the window by a relative X Y, or new window offset by the distance between cursor points.
           FAULT ("Use DRAW to look at a cell") %if LAST CELL = ""
           INQUIRE WINDOW (ZWXL, ZWXR, ZWYB, ZWYT)
           %if LINE#"" %start { point supplied as a parameter }
               A = STOI * ILAP SCALE
               B = 0 %unless DIGIT(B)=TRUE
               B = B * ILAP SCALE
           %else
               MESSAGE ("Give the displacement by entering two points by the cursor")
               SET COLOUR (1)
               REQUEST INPUT (I, A, B)
               MARKER ABS (6, A, B)
               DX = A;   DY = B
               MAP TO DEVICE COORDS (DX, DY)
               %cycle
                  REQUEST INPUT (I, C, D)
                  %if DEVICE=CHARLES %or A=C %or B=D %start
                      MAP TO DEVICE COORDS (C, D)
                      %continue %if |DX-C| <= 5 %and |DY-D| <= 5
                      MAP TO VIRTUAL COORDS (C, D)
                  %finish
                  %exit
               %repeat
               MARKER ABS (6, C, D)
               UPDATE
               A = A - C;   B = B - D
           %finish
           ZWXL = ZWXL + A;   ZWXR = ZWXR + A
           ZWYB = ZWYB + B;   ZWYT = ZWYT + B
           WINDOW (ZWXL, ZWXR, ZWYB, ZWYT)
           CLIP ON
           ROUTINE = REDRAW;   LINE = ""
           -> EXEC (REDRAW)

EXEC(ZOOM):  FAULT ("Use DRAW to look at a cell") %if LAST CELL = ""
             ROUTINE = WINDO %if LINE="?"
EXEC(WINDO): 
             %if LINE -> ("^") %start
                 POP ZOOM STACK
                 WINDOW (ZWXL, ZWXR, ZWYB, ZWYT)
             %finish %else %if LINE#"?" %start
                 PUSH ZOOM STACK
                 CLIP ON
                 %if LINE#"" %start
                     CWXL = STOI * ILAP SCALE
                     CWYB = STOI * ILAP SCALE
                     CWXR = STOI * ILAP SCALE
                     CWYT = STOI * ILAP SCALE
                 %finish %else %if DEVICE=APM Level 1 %or device=APM level 2 %start
                     PRINT STRING ( %c
"Use the mouse to select the required window.  Centre button selects the window,
Left button decreases the window size, Right button increases the window size.")
                     NEWLINE
                     AREA INPUT (CWXL, CWYB, CWXR, CWYT)
                 %else
                     SET COLOUR (1)
                     REQUEST INPUT (I, CWXL, CWYB)
                     MARKER ABS (6, CWXL, CWYB)
                     %cycle
                        REQUEST INPUT (I, CWXR, CWYT)
                        %if DEVICE=CHARLES %or CWXL=CWXR %or CWYB=CWYT %start
                            A = CWXL;   B = CWYB;   C = CWXR;   D = CWYT
                            MAP TO DEVICE COORDS (A, B)
                            MAP TO DEVICE COORDS (C, D)
                            %continue %if |A-C| <= 5 %or |B-D| <= 5
                        %finish
                        %exit
                     %repeat
                     MARKER ABS (6, CWXR, CWYT)
                     UPDATE
                     NEW TEK POS %and NEWLINES (2) %if DEVICE = TEKTRONIX
                 %finish
                 SWAP (CWXL, CWXR) %if CWXL>CWXR
                 SWAP (CWYB, CWYT) %if CWYB>CWYT
                 WINDOW (CWXL, CWXR, CWYB, CWYT)
                 RANDOM WINDOW = 1
             %finish
             INQUIRE WINDOW (ZWXL, ZWXR, ZWYB, ZWYT)
             ! Convert to Lambda
             A = INT (ZWXL/ILAP SCALE)
             B = INT (ZWXR/ILAP SCALE)
             C = INT (ZWYB/ILAP SCALE)
             D = INT (ZWYT/ILAP SCALE)
             MESSAGE ("Window set between ".ITOS(A,0).",".ITOS(C,0)." and ".ITOS(B,0).",".ITOS(D,0))
             %continue %if ROUTINE=WINDO
             ROUTINE = REDRAW;   LINE = ""
             -> EXEC(REDRAW)

EXEC(LAYER): ! Alter the array of layers that are to be drawn.
             FAULT (NO TECHNOLOGY) %if TECH = "?"
             %if LINE="" %start
                 VALID (I) = TRUE %for I=1,1,MAX LAYERS
                 MESSAGE ("All layers will now be drawn")
                 %continue
             %finish
             do layers %if LINE#"?"
             MESSAGE (LAYERS BEING DRAWN)
             %continue

EXEC(MON): CIFSYS MONITOR (STOI)
           %continue

EXEC(GRID): ! Draw a Grid over the current picture.
            %if LINE#"?" %start
                %if LINE -> ("OF") %then GRID SIZE = -1 %else %start
                    GRID SIZE = 1 %unless DIGIT (GRID SIZE) = TRUE
                    GRID SIZE = 1 %if GRID SIZE<=0
                    GRID SIZE = GRID SIZE * ILAP SCALE
                    DRAW GRID %if RANDOM WINDOW >= 0
                %finish
            %finish
            MESSAGE ("Grid drawing is suppressed") %and %continue %if GRID SIZE <= 0
            A = GRID SIZE
            %if LINE="?" %or LINE -> ("ON") %start
                LINE = "will be drawn after each cell displayed"
            %else
                LINE = "drawn"
                GRID SIZE = -1
            %finish
            UPDATE
            MESSAGE (ITOS(INT(A/ILAP SCALE),0)." lambda grid ".LINE)
            %continue

EXEC(IDENT): ! Assign the layer to be done in approprate colour/style
             RESET ALL LAYERS %and %continue %if LINE="*"
             FAULT (NO TECHNOLOGY) %if TECH = "?"
             MESSAGE ("Parameters should be '<layer name> <colour> <style>'") %and %continue %if LINE=""
             SPACES IN LINE FOR (',')
             REST = LINE %and LINE="" %unless LINE -> REST.(" ").LINE
             REST = TECH.REST %if LENGTH(REST)=1
             %for I=1,1,N LAYERS %cycle
                  %exit %if REST=LNAMES(I)
             %repeat
             FAULT ("Unknown layer name '".REST."'") %if I=N LAYERS

             ! Colour next
             C = -1
             %if LINE="" %start
                 ! Set the default
                 C = DEF LAYER COL (I)
             %else
                 %if CHARNO(LINE,1)='B' %start
                     %if LENGTH(LINE)>=2 %and CHARNO(LINE,2)='R' %start
                         C = 8
                     %finish %else %if CHARNO(LINE,2)='L' %start
                         %if LENGTH(LINE)>=3 %start
                             C = 1 %if CHARNO(LINE,3)='A'
                             C = 2 %if CHARNO(LINE,3)='U'
                         %finish
                     %finish
                 %finish %else %if CHARNO(LINE,1)='G' %start
                     C = 3
                 %finish %else %if CHARNO(LINE,1)='R' %start
                     C = 4
                 %finish %else %if CHARNO(LINE,1)='P' %start
                     C = 5
                 %finish %else %if CHARNO(LINE,1)='Y' %start
                     C = 6
                 %finish %else %if CHARNO(LINE,1)='L' %start
                     C = 7
                 %finish
                 %if C>0 %start
                     ! Skip the text
                     LINE = "" %unless LINE -> (" ").LINE
                 %else
                     FAULT (NOT COLOUR) %if DIGIT(C)#TRUE
                 %finish
             %finish

             ! Line style
             %if LINE -> REST.(" ").LINE %start; %finish
             D = -1
             %if LINE="" %then D=0 { the default style } %else %start
                 D = 0 %if CHARNO(LINE,1)='N'; ! Normal
                 D = 1 %if CHARNO(LINE,1)='D'; ! Dotted
                 D = 2 %if CHARNO(LINE,1)='C'; ! Chain
                 D = 3 %if CHARNO(LINE,1)='S'; ! Short Dash
                 D = 4 %if CHARNO(LINE,1)='L'; ! Long dash
             %finish
             FAULT (UNKNOWN STYLE) %if D<0 %and %not DIGIT(D)=TRUE

             IDENTIFY (I, C, D)
             %continue

EXEC(ON):
EXEC(OFF): ! Call 'SET' with apropriate parameters.
           %if ROUTINE = ON %then C='N' %else C='F'
           A = -1
           B = '?'
           B = CHARNO (LINE, 1) %if LINE#""
           FAULT ("Parameters incorrect, try HELP ON") %unless B = 'B' %or B = 'I'
           IDENTIFY CELL (A) %if LINE -> (" ").LINE
           SET CELL (A, B, C)
           %continue

EXEC(SCALE): ! Set the number of 100 microns per Lambda
             %if LINE#"?" %start
                 %if LINE#"" %start
                     A = STOI
                 %else
                     A = -1
                 %finish
                 A = DEF ILAP SCALE %if A<1
                 ILAP SCALE = A
             %finish
             MESSAGE ("The scale is set to ".ITOS(ILAP SCALE,0))
             %continue

EXEC(SIZE): ROUTINE = USE %and -> EXEC(USE) %if LINE#"" %and CHARNO(LINE,1)='A'
            ! The above caters for people who say SIZE A3 rather than USE A3
            %if LINE#"?" %start
                %if LINE="" %start
                    %if DEVICE=CALCOMP %start
                        ! Set window to give the full size of picture on last defined cell.
                        A = FIND CELL ("*", 0, CWXL, CWYB, CWXR, CWYT)
                        FAULT ("no cells defined") %if A < 0
                        A = 0
                        B = 0
                        C = INT(UNITS PER CM * 75 * ((CWXR-CWXL)/(CWYT-CWYB)))
                        D = 75 * UNITS PER CM
                    %else
                        ! Use plotter INPUT to establish the paper size.
                        VIEW PORT (0, 16000, 0, 11400)
                        UPDATE
                        ! This sets the MAX size of VIEWPORT to allow pen to be moved anywhere on the platter.
                        MESSAGE ("Enter the upper and lower paper bounds by moving the pen to each")
                        MESSAGE ("point in turn, (by the pen move controls on the plotter), and then")
                        MESSAGE ("press the ENTER button to send the point back to host.")
                        MESSAGE ("Enter first point - ")
                        NEWLINE
                        REQUEST DEVICE (I, A, B)
                        MESSAGE ("Enter second point - ")
                        NEWLINE
                        REQUEST DEVICE (I, C, D)
                        SWAP (A, C) %if C<A
                        SWAP (B, D) %if D<B
                        RX = (C - A) / UNITS PER CM
                        RY = (D - B) / UNITS PER CM
                        FAULT ("Size set too small") %if RX<1 %or RY<1; ! 1cm is mimimum size
                   %finish
                %else
                    RX = STOR
                    RY = RX %unless RDIGIT (RY) = TRUE
                    ! Optional offset, defaulting to (0,0).
                    RXO = 0 %unless RDIGIT (RXO) = TRUE
                    RYO = 0 %unless RDIGIT (RYO) = TRUE
                    %if LINE -> ("""") %or LINE -> ("IN") %start
                        RX = RX * CM TO INS
                        RY = RY * CM TO INS
                        RXO = RXO * CM TO INS
                        RYO = RYO * CM TO INS
                        LINE = """"
                    %finish
                    A = INT(RXO * UNITS PER CM)
                    B = INT(RYO * UNITS PER CM)
                    C = INT((RXO + RX) * UNITS PER CM)
                    D = INT((RYO + RY) * UNITS PER CM)
                %finish
                UPDATE %and FAULT ("Zero area specified!") %if A=C %or B=D
                VIEWPORT (A, C, B, D)
            %finish
            INQUIRE VIEWPORT (A, C, B, D)
            PRINT STRING ("Plotting area set to")
            %if LINE#"""" %start; ! cms given, so tell user in cms.
                PRINT ((C-A)/UNITS PER CM, 1, 1)
                PRINT STRING (" by")
                PRINT ((D-B)/UNITS PER CM, 1, 1)
                %if A#0 %or B#0 %start
                    PRINT STRING (" cms  offset by")
                    PRINT (A/UNITS PER CM, 1, 1)
                    PRINT SYMBOL (',')
                    PRINT (B/UNITS PER CM, 0, 1)
                %finish
                PRINT STRING (" cms")
            %else
                PRINT ((C-A)/UNITS PER CM/CM TO INS, 1, 2)
                PRINT STRING (" by")
                PRINT ((D-B)/UNITS PER CM/CM TO INS, 1, 2)
                %if A#0 %or B#0 %start
                    PRINT STRING (" ins    offset by")
                    PRINT (A/UNITS PER CM, 1, 2)
                    PRINT SYMBOL (',')
                    PRINT (B/UNITS PER CM, 0, 1)
                %finish
                PRINT STRING (" ins")
            %finish
            NEWLINE
            %continue

EXEC(POINT): ! Point to part of the screen, & tell the user where they pointed.
             ! or display the point that the user specified as a parameter.
             %if LINE = "" %start
                 REQUEST INPUT (A, B, C)
                 LINE = "Point was (".ITOS(INT(B/ILAP SCALE), 0).",".ITOS(INT(C/ILAP SCALE), 0).")"
             %else
                 SPACES IN LINE FOR (',')
                 A = STOI
                 B = STOI
                 C = 6 %unless DIGIT (C) = TRUE
                 SET COLOUR (1)
                 CLIP ON
                 MARKER ABS (C, A*ILAP SCALE, B*ILAP SCALE)
                 UPDATE
                 LINE = "Point (".ITOS(A,0).",".ITOS(B,0).") marked"
             %finish
             NEW TEK POS %and NEWLINES (2) %if DEVICE = Tektronix 
             MESSAGE (LINE)
             %continue

EXEC(SETLAM): ! record the fact, that lambda has been specified.
              FAULT (NOT PLOTTER) %if UNITS PER CM = NO PLOTTER
              %if LINE="" %start
                  REQ LAMBDA = 0
                  MESSAGE ("LAMBDA is no longer significant when plotting")
                  %continue
              %finish
              %if LINE#"?" %start
                  %if DEVICE=CALCOMP %then UNITS PER CM = 100 %else UNITS PER CM = 400
                  REQ LAMBDA = STOR
                  REQ LAMBDA = REQ LAMBDA * CM TO INS %if LINE-> ("""") %or LINE -> ("IN")
              %finish
              MESSAGE ("LAMBDA is not significant while plotting") %and %continue %if REQ LAMBDA < MIN SIGNIFICANT LAMBDA
              PRINT STRING ("LAMBDA set to")
              PRINT (REQ LAMBDA, 1, 3)
              PRINT STRING (" cms  (")
              PRINT (REQ LAMBDA/CM TO INS, 0, 4)
              MESSAGE (" ins)  for plotting")
              %continue

EXEC(SPEED): ! Set plotter speed
             %if LINE="" %then A=36 %else %start
                 A = STOI
                 A = 36 %if A<1
             %finish
             SET SPEED (A)
             MESSAGE ("Plotter speed set to".ITOS(A,1)." cm/s")
             %continue

EXEC(WCALL): ! For back wards compat. only
             IDENTIFY CELL (C)
             -> EXEC(WIPE)

EXEC(VSN): ! Give the version of CIFSYS being used.
           MESSAGE (CIFSYS VERSION)
%repeat
%end

%begin
   %string (255) str = cliparam
   %if Str -> str.("-") %start
       prompt ("Max elements: ")
       read (max elements)
   %finish
   cifview (str)
%end

%end %of %file