! VIEW RCO  an Interpreter for RCO standard plotter files.
! J.R.C.C.  Summer 1981

! Machine specifics
! VAX
!%include "$EDWIN:.INC"
!%const %string (1) sep = "."
! EMAS
%include "ECSLIB.EDWIN_INC"
%external %routine %spec prompt (%string (15) S)
%external %routine %spec open input (%integer I, %string (255) FILE)
%external %routine %spec open output (%integer I, %string (255) FILE)
%const %string (1) sep = "#"

%own %string (31) PROGRAM = "VIEWRCO"

%external %routine VIEW RCO (%string (255) CLI PARAM)

%external %integer %spec device
%system %routine %spec grafio (%integer %name IOF, %integer CHAN, AD)
%external %routine %spec set default (%string (5) ST)

! Terminal code constants
 %constant %integer Tektronix      = 0
 %constant %integer Tektronix 4014 = 1
 %constant %integer Charles        = 2
 %constant %integer Hp 7221        = 3
 %constant %integer Calcomp        = 4
!%constant %integer Igor           = 5
!%constant %integer Printronix     = 6
!%constant %integer HC terminal    = 7
!%constant %integer Medium lp      = 8
!%constant %integer Wide lp        = 9
 %constant %integer Smart terminal = 10
!%constant %integer Hp 2648        = 11
 %constant %integer Hp 7580        = 12
 %constant %integer Hp 7220        = 13

! Program constants
%constant %integer directive    = 8_100
%constant %integer  byte len    =     7
%constant %integer       yes    =     1
%constant %integer        no    =     0
%constant %integer    raised    =     0
%constant %integer   lowered    =     1
%constant %integer store stream =     2
%constant %real cms per inch    =  2.54

%record %format pen definition (%integer type, colour, width)
%record (pen definition) pen temp;              ! A neccessary evil.
%record (pen definition) %name pen in use;      ! Ptr to pen being used.
%record (pen definition) %array pens (0:7);     ! The actual definitions.
%const %byte %integer %array default colours (0:7) = 1, 4, 2, 3, 5, 6, 7, 8
%const %byte %integer %array default types   (0:7) = 0, 1, 2, 3, 4, 0 (*)

%integer size, plot size y, upcm, overlay
%integer step number, record number
%integer pen status
%integer x, y, x data bytes, y data bytes
%integer max frame x, max frame y, x extent, y extent
%integer bytes remaining, count, N, i, last, last but one
%integer absolute, abort plot, croak, step
%integer steps per unit
%integer print op mess 
%integer dev, buff ptr, io flag, storing

%byte ptr, ptr2

%byte %integer %array buff (0:79)

%switch dir(0:63)

%routine error (%string (255) errmess)
   update
   select output (0)
   print string(PROGRAM." fails - ".errmess)
   new line
   %stop
%end

%routine read ch (%byte %integer %name CH)
   %if buff ptr > 79 %start
       grafio (ioflag, 0, addr (buff(0)))
       %signal 9 %if ioflag<0
       buff ptr = 0
   %finish
   ch = buff (buff ptr)
   buff ptr = buff ptr + 1
%end

%routine sook
   skip symbol %while next symbol # nl
   skip symbol
%end

%routine set up io (%string (255) streams)
   %string(127) in, out
   %integer sym

   %on %event 9 %start
       %stop
   %finish

   %routine squeege (%string (*) %name mop)
      %integer i, lim
      lim = 0
      %for i = 1,1,length (mop) %cycle
         charno (mop, i) = '/' %if charno (mop, i) = ','
         %if charno (mop, i) # ' ' %start
            lim = lim + 1
            charno (mop, lim) = charno (mop, i)
         %finish
      %repeat
      length (mop) = lim
   %end

   in = ""
   out = ""
   %if streams = "" %start
      prompt ("File:")
      read symbol (sym) %until sym > ' '
      %cycle
         streams = streams. to string (sym)
         read symbol (sym)
      %repeat %until sym = nl
   %finish
   squeege (streams)
   %if streams -> in . ("/") . out %and out#"" %start
      set default (sep."PDF")
      %begin
         %on 9 %start
             error ("Cannot open output file ".out)
         %finish
         open output (store stream, out)
      %end
      storing = store stream
   %finish %else %start
      in = streams
      storing = -1  { Off }
   %finish
   !
   set default (sep."GP")
   %begin
      %on 9 %start
          error ("Cannot open input file ".in)
      %finish
      in = in . "-F80"
      open input (1, in)
      grafio (IOFLAG, 0, 1); ! Open file
      %signal 9 %if ioflag<0
      grafio (IOFLAG, 0, addr(BUFF(0))); ! Read first record
      %signal 9 %if ioflag<0
      buff ptr = 0
   %end
   !
%end

%string (255) %function str (%integer s)
   %string(255) st
   %if s=0 %then st = "0" %else st = ""
   %while s > 0 %cycle
      st = to string ((s & 7) + '0').st
      s = s >> 3
   %repeat
   %result = "8_".st
%end

%routine skip header garbage
   %byte %integer th
   %cycle
      th = 0 
      last = 0
      last but one = 0
      %while th # 2 %cycle
         last but one = last
         last = th
         read ch (th)
      %repeat
      %if last but one = 0 %and last = 1 %start
         ! Skip 80 bytes
         read ch (th) %until th = 'O'
         buff ptr = buff ptr - 1; ! Frig owe to non-implementation of next ch!
         ! This is silly. Why 'O' (79)?
         ! Ask a parrot. he knows as well as anyone.
         %return;        ! This protocol needs its header examined (sic)
      %finish
   %repeat
%end

%routine go to (%integer x,y)
   %if absolute = yes %start
      %if pen status = raised %then move abs (x,y) %else line abs (x,y)
   %finish %else %start
      %if pen status = raised %then move rel (x,y) %else line rel (x,y)
   %finish
%end

%integer %function notes (%byte %integer code)
   %switch note (0:8_60)
   %if %not 0 <= code <= 8_60 %then %result = 0
   -> note (code)

   note (0):
      pen status = raised
   %result = 1

   note (8_20):
      pen status = lowered
   %result = 1

   note (8_40):
      pen status = raised
      move abs (0,0)
   %result = 1

   note (8_60):
      pen status = lowered
      line abs (0,0)
   %result = 1

   note (*):
   %result = 0

%end

%routine advance (%byte %integer %name ptr, %integer how far)
   !   get next byte, remembering last two for future reference
   %integer i
   %for i = 1,1,how far %cycle
      last but one = last
      last         = ptr
      read ch (ptr)
      bytes remaining = bytes remaining - 1
   %repeat
   %if bytes remaining < 0 %and croak = yes %then error ("Command splits step")
%end

%routine choose colour (%integer colour code)
   %if colour code < 0 %then set colour (1) %else %start
       set colour (colour code)
   %finish
%end

%routine set pen (%integer pen number)
   pen in use == pens (pen number)
   choose colour (default colours (pen number))
   set line style (pen in use_type) %if device = tektronix 4014
%end

%routine strip sign (%integer %name num, %integer bytes)
   %integer sign
   sign = num & (1 << ((byte len * bytes) - 1))
   num = num & (\sign)
   %if sign # 0 %start
      num = - (num)
   %finish
%end

%on %event 9,14 %start
    error ("unexpected end of input") %if eventinf>>8=9
    error ("EDWIN error ".EDWIN ERROR (eventinf&255))
%finish

set up io (CLI param)

select output (0)
select input (0)

%if device=calcomp %then upcm = 100 %else upcm = 400

%if program="VIEWRCO" %start
    prompt ("Device type:")
    read (dev)
    sook
    initialise for (dev)

    ! Define view port bumpf.
    %if device = hp7221 %or device = hp7220 %or device = calcomp %or device = hp7580 %start
       prompt ("Size (cm):")
       skip symbol %while next symbol <=' '
       %if next symbol & 95 = 'A' %start
           skip symbol
           %if next symbol # '3' %and next symbol # '4' %start
               print string ("Options are A4 or A3 only")
               newline
               %signal 9
          %finish
          %if next symbol = '3' %then viewport (0, 40*upcm, 0, 28*upcm) %c
                                %else viewport (0, 28*upcm, 0, 20*upcm)
       %finish %else %start
           read (size)
           skip symbol %while next symbol = ' '
           %if '0'<= next symbol <= '9' %then read (dev) %else dev=size
           viewport (0, size*upcm, 0, dev*upcm)
       %finish
       sook
   %finish
%finish

dev = device
print op mess = no
print op mess = yes %if device < 0 %or device = hp7220 %or device = hp7221 %c
                    %or device = hp7580 %or device = calcomp %or device = charles

%for I=0,1,7 %cycle
     pen in use == pens(I)
     pen in use = 0
     pen in use_colour = default colours (I)
     pen in use_type = default types (I)
%repeat
bytes  remaining = 80
last             = 0
last but one     = 0
pen status = raised
croak      = no
step       = directive

skip header garbage
advance (ptr, 1) %until ptr = 8_101;   ! Start of file directive
error ("file directive in non-directive step") %unless last but one =  0 %c
                                               %and last = 0
bytes remaining = 78; ! To take account of the two byte record header
croak = yes
%cycle
   %while bytes remaining > 0 %cycle
      %if ptr & directive = no %start
         ! Vector command
         error ("vector command in directive step") %if step = directive
         x data bytes = (ptr & 8_14) >> 2 ;    ! Bits 2 & 3
         y data bytes = (ptr & 8_3);           ! Bits 0 & 1
         %if y data bytes = 0 %start;          ! Special codes:
            %if notes (ptr) = 0 %then -> on;   ! But only if it is one.
            advance (ptr, x data bytes + 1)
         %finish %else %start;                 ! Standard vector move
on:         absolute = (ptr & 8_40) >> 5
            pen status = (ptr & 8_20) >> 4
            x = 0; y = 0
            advance (ptr, 1)
            %for i = 1,1,x data bytes %cycle
               x = (x << byte len) ! ptr
               advance (ptr, 1)
            %repeat
            strip sign (x, x data bytes)
            %for i = 1,1,y data bytes %cycle
               y = (y << byte len) ! ptr
               advance (ptr, 1)
            %repeat
            strip sign (y, y data bytes)
            go to (x, y)
         %finish
      %finish %else %start;   ! Directive
         N = ptr & (\directive);     ! And off with the directive flag
         %if 9 <= N <= 31 %start
            error ("reserved directive ".str (N))
         %finish %elseif 32 <= N <= 62  %start
            error ("unknown directive ".str (N))
         %finish
         advance (ptr, 1);   ! Point at count byte
         
         -> dir (N)

         dir(0):      ! Null directive
         -> done
   
         dir(1):                                ! Start of file directive
            count = ptr
            advance (ptr, 1);                   ! Point at byte 1
            abort plot = ptr
            ! The information required for windowing is this -
            !     Device type, for machine coords
            !     max size of frame, x, y
            !     The x extent and y extent recorded here
            !     are of minimal use. (ie not a lot at all.)
            x extent = 0
            %for i = 1,1,3 %cycle
               advance (ptr, 1)
               x extent = (x extent << byte len) ! ptr
            %repeat
            y extent = 0
            %for i = 1,1,3 %cycle
               advance (ptr, 1)
               y extent = (y extent << byte len) ! ptr
            %repeat
            advance (ptr, 1)
            ptr2 = ptr
            advance (ptr, 1)
            steps per unit = ptr2 << byte len ! ptr
            advance (ptr, 1)
            ! Next item is the plotter units, 1 = cm,
            !                                 2 = inches
            ! Convert inches to cm.
            %if ptr = 2 %start
               steps per unit = int (steps per unit / cms per inch)
            %finish
            ! Byte 11 is the number of pens.
            ! The number of pens the user wants is not of interest.
            advance (ptr, 3);                   ! Point at byte 12
            ! This is length of the username of the person creating the file.
            ! This is not required by this program.
            advance (ptr, count - 12); ! Skip user name
         -> done
   
         dir (2):                               ! Start of step
            step = \directive
            count = ptr
            error ("Invalid command format") %if count # 8
            advance (ptr, 1);                   ! Point at byte 1
            step number = ptr
            advance (ptr, 1);                   ! Point at byte 2
            overlay = ptr
            max frame x = 0; max frame y = 0
            ! Get three byte frame dimensions
            %for i = 1,1,3 %cycle
               advance (ptr, 1)
               max frame x = (max frame x << byte len) ! ptr
            %repeat
            %for i = 1,1,3 %cycle
               advance (ptr, 1)
               max frame y = (max frame y << byte len) ! ptr
            %repeat
            %if step number#1 %start
                ! Get user preference for plotting
                drive dev (4, 0, 760) %if device = tektronix %or device = tektronix 4014
                drive dev (4, 0, 22) %if device = smart terminal
                update
            %finish
            %if PROGRAM = "VIEWRCO" %start
                print string ("Do you wish to view frame no. ")
                write (step number, 0);print symbol ('?')
                new line
                prompt ("Yes / No ? ")
                read symbol (i) %and I=I&95 %until I='N' %or I='Y'
                sook
            %finish %else %start
                %if step number = 1 %then i='N' %else i='Y'
            %finish
            %if i='N' %start
               device = -1
               store off
            %finish %else %start
               device = dev
               store on (storing)
            %finish
            %if program#"VIEWRCO" %start
                print string ("Next plot requires")
                print (max frame x / steps per unit, 1, 1)
                print string (" by")
                print (max frame y / steps per unit, 1, 1)
                print string (" cm of paper.")
                newline
                ! set the Viewport depending on the frame size.
                viewport (0, max frame x * upcm // steps per unit,
                          0, max frame y * upcm // steps per unit)
            %finish
            window (0, max frame x, 0, max frame y)
            advance (ptr, 1)
            new frame %if overlay = 0
         -> done
   
         dir (3):                               ! Pen/linetype selection
            count = ptr
            advance (ptr, 1);                   ! Point at byte 1
            set pen (ptr);                      ! Pen number
            advance (ptr, 1);                   ! Next command
         -> done
   
         dir (4):                               ! Pen/line definition change
            count = ptr
            error("Invalid command format") %if count # 4
            advance (ptr, 1);                   ! byte 1, pen type 
            pen temp_type = ptr
            advance (ptr, 1);                   ! byte 2, pen colour
            pen temp_colour = ptr
            advance (ptr, 1);                   ! byte 3, pen width
            pen temp_width = ptr
            advance (ptr, 1);                   ! byte 4, pen number
            pens(ptr) = pen temp
            advance (ptr, 1);                   ! Next command
         -> done
   
         dir (5):                               ! Operator message, 
Imp80 compiler bug:
            count = ptr;                        ! no restart.
            advance (ptr, 1);                   ! Point at first byte of message
            %if print op mess = yes %start
               update
               %for i = 1,1,count %cycle
                  printsymbol (ptr)
                  advance (ptr, 1)
               %repeat
               new line
            %finish %else %start
               advance (ptr, count)
            %finish
         -> done
         
         dir (6):                               ! Operator message 
            update
            count = ptr;                        ! requiring restart.
            advance (ptr, 1)
            %for i = 1,1,count %cycle
               print symbol (ptr)
               advance (ptr, 1)
            %repeat
            new line
            ! New line is the restart signal
            prompt ("Hit 'Return':")
            sook
            new frame %if print op mess = no
         -> done
   
         dir (7):                               ! Hardware chars to be plotted
            count = ptr
            advance (ptr, 1)
            %for i = 1,1,count %cycle
               character (ptr)
               advance (ptr, 1)
            %repeat
         -> done
   
         dir (8):                               ! Hardware string parameters
            error("String orientations not defined")
   
         dir (63):                              ! End of file directive
            error ("unexpected end of file") %if step # directive
            terminate edwin
            %stop

         dir (*):
            error ("Unknown directive command")

         done:
         %finish
      %repeat
      bytes remaining = 80;                        ! Start of new record
      step number = ptr
      advance (ptr, 1)
      record number = ptr
      advance (ptr, 1)
      %if step number = 0 %then step = directive
   %repeat
%end

%external %routine PLOTRCO (%string (255) file)
   %external %integer %fn %spec STOI (%string (255) str)
   %string (31) dev
   program = "PLOTRCO"
   %if file -> file.(",").dev %start
       initialise for (stoi(dev))
   %finish %else initialise for (7580)
   view rco (file)
%end

!%begin
!   %external %string (255) %function %spec CLI param
!   view RCO (CLI param)
!%end

%end %of %file