%external %routine initialise %alias "S#INITIALISE"

   ! Note: this version of PRINTINIT7 assumes that the printer is a Philips
   !       GP300 dot matrix printer or a Xerox 2700 laser printer.
   !       Various permission checks (terminal, process used etc.) have been
   !       removed. If required in the future, the original listing of
   !       PRINTINIT7A should be examined and the relevant code used.

   %constant %integer save max=7
   %record %format crrf(%integer conad, filetype, datastart, dataend)
   %record %format fhf(%integer end, start, size, type, fhole, dt, sp1, sp2)
   %record %format infof(%integer vsn, state, %string (7) ident, user, %string (15) dest, srce,
     output, %string (31) name, delivery, %string (63) message, %integer dtrec, dtst, dtopst,
     dtdel, start, length, time, (%integer oplim %or %integer cc), %integer size,
     (%integer prior %or %integer pc), %integer aftdt, ahead, %byte %integer forms,
     mode, copies, order, rerun, decks, drives, fails) {256 bytes}
   %record (infof) %name info
   %record (infof) %array %name saveinfo
   %record %format profrecf(%integer cc, pbar, %string (6) %array bar(0:save max),
     %integer pfile, %record (infof) %array saveinfo(0:save max), %integer gcc,
     %string (8) gdate, %integer pc, gpc)
   %record (profrecf) profrec
   %record %format pe(%integer dest, srce, p1, p2, p3, p4, p5, p6)
   %record %format reqf(%integer dest, srce, flag, %string (6) user, file, %integer p6)
   %record %format iostatf(%integer inpos, %string (15) intmess)
   %record (iostatf) %name iostat
   %record %format itf(%integer inbase, inlength, inpointer, outbase, outlength, outpointer,
     outbusy, omwaiting, intt waiting, jnbase, jncur, last free, sp5, sp6, sp7)
   %record (itf) %name it

   %constant %integer ncommands=29
   %switch act(1:ncommands)
   %constant %string (7) %array commands(1:ncommands)="PRINT","P","STOP","QUIT","S",
                                               "QUEUE","Q","UNBAR","U","MODE","M",
                                               "DELETE","D","REPRINT","R","EXIT","E",
                                               "BAR","B","LIMIT","L","FORMS","F","COUNT","C",
                                               "VERIFY","V","GCOUNT","G"
   %constant %integer nowners=8, nfont families=10
   %string (6) %array %name bar
   %constant %string (6) %array ownerlist(1:nowners)= "ERCC99","ERCC98","ERCC97","EKJC99",
"ERCC96","EGMT99","ERCE99","ERCY99"
   %constant %string (6) %array qlist(1:nowners)= "DP15","DP25","DPERCC","DPCES","DP23","DPMET",
"DPGTS","DPTU"
   %constant %integer %array printertype(1:nowners)= x'180211',x'180211',
             x'180211',x'000801',x'081211',x'300201',x'010211',x'010411'
   %constant %string (11) %array ramfonts(1:nowners)= ""(3),"GBCO","X2700FONTS","","ORMIGBCO","MIGBCO"
   %string(11) fontfile
   %constant %byte %integer %array font data(1:nfont families, 1:nowners)=
   {       Data Sc., G. Sc., Orator, Micro, G. Bold, Courier, G. Italic, Box Element, Sc. Addnl, Teletex}
   {.DP15}      '1',    '7',    '5',   '4',     '6',     '3',       '2',         '7',       '8',     '7',
   {.DP25}      '1',    '7',    '5',   '4',     '6',     '3',       '2',         '7',       '8',     '7',
   {.DPERCC}    '1',    '7',    '5',   '4',     '6',     '3',       '2',         '7',       '8',     '7',
   {.DPCES}     '2',    '1',    '6',   '5',     '7',     '8',       '4',         '3',       '1',     '1',
   {.DP23}      0(nfont families),
   {.DPMET}     '1',    '1',    '5',   '4',     '1',     '3',       '2',         '1',       '1',     '1',
   {.DPGTS}     '1',    '7',    '5',   '4',     '6',     '3',       '2',         '7',       '7',     '7',
   {.DPTU}      '1',    '2',    '2',   '4',     '5',     '6',       '2',         '2',       '2',     '3'
   ! .DP23 does not use this array (X2700 laser printer).
   ! This array gives the actual font number in each printer of the fonts indicated.
   ! E.g. font data(3,4)='6' means that the 4th printer (.DPCES) holds Orator as font 6.
   ! Utilities, however, refer to Orator as font 3, whichever printer is in use.
   ! As a special, if the utility refers to font 20+n, then font n is selected, with
   ! the 8th bit set on each character.  Thus the Scientific part of Gothic Scientific
   ! can be accessed in 7-bit mode by referring to font 22.
   %byte %integer %array %format font trans f(1:nfont families)
   %byte %integer %array %name font trans
   %string(2) snl
   %constant %integer gp300=0, x2700=1, gp300code=4, x2700code=5
   %constant %integer true=1, false=0, tilde=126, on=1, off=0
   %constant %integer bs=8,ff=12,cr=13,sub=x'1A',esc=x'1B',csi=x'5B',vpr=x'65',
    cpl=x'78',tbc=x'67',hpa=x'60',lsl=x'7B',spl=x'76',sss=x'79',
    rm=x'6c',sm=x'68',snv=x'77',ltof=x'3d',sgr=x'6d' {Codes for GP300}
   %constant %string (1) studk="^"
   %constant %integer sudk='^'
   %constant %integer prog vsn=4

   %constant %integer maxfqueue=2, maxfont=20
   %string (20) %array fontname(1:maxfont)
   %record %format ffqueue(%byte %integer %array font(0:9), %byte %integer orient, snum)
   %record (ffqueue) %name fs
   %record (ffqueue) %array fqueue(1:maxfqueue)
   %byte %integer %array %name fsf
   %constant %byte %integer t12p=1, k6p=2{to be k8p}, k10p=3, k10bp=4, k12bp=5,
                            k14p=6, bpsp=7, bpsip=8, t10p=9, symc10p=10,
                            xcp125l=11, k6l=12, k8l=13, k8bl=14, k10bl=15,
                            k12bl=16, bpsl=17, bpsil=18, t10l=19, symc10l=20

   %switch prof(0:prog vsn)
   %string (63) reply, action, param, file, user, ident, work
   %string (6) owner, printerst
   %string (8) chdev
   %string (4) cursor up, chhost
   %integer cv, ownerno, entries, f, conad, flag, lead in, pstate, n, i, oldcv
   %integer prtype, barno, mode, prof vsn, forms queue, xforms queue, onehop, feb285
   %integer own fsys
   %integer %name cc, pbar, pfile, gcc, pc, gpc
   %string %name gdate
   %integer pmode, banner, bpass, initfcheck, repeat, accounting, ncopymax, rom only, printer

   %external %routine %spec console %alias "S#CONSOLE"(%integer ep, %integer %name a, b)
   %external %integer %function %spec exist(%string (31) file)
   %external %integer %function %spec ddelay(%integer n)
   %external %integer %function %spec dpon2(%string (6) user, %record (reqf) %name p,
     %integer msgtype, outno)
   %external %integer %function %spec dfsys(%string(6) user, %integer %name fsys)
   %external %integer %function %spec dtransfer(%string(6) user1, user2,
                  %string(11) file, newname, %integer fsys1, fsys2, type)
   %external %integer %function %spec dsfi(%string (6) user, %integer fsys, type, set, adr)
   %external %integer %function %spec dspool(%record (pe) %name p, %integer len, adr)
   %external %integer %function %spec x29call
   %external %routine %spec connect %alias "S#CONNECT"(%string (31) s, %integer a, m, p,
     %record (crrf) %name r, %integer %name flag)
   %external %routine %spec rename %alias "S#RENAME"(%string (63) old, new, %integer %name flag)
   %external %routine %spec newgen %alias "S#NEWGEN"(%string (63) old, new, %integer %name flag)
   %external %routine %spec destroy %alias "S#DESTROY"(%string (63) s, %integer %name flag)
   %external %routine %spec disconnect %alias "S#DISCONNECT"(%string (63) s, %integer %name flag)
   %external %routine %spec trim %alias "S#TRIM"(%string (63) s, %integer %name flag)
   %external %routine %spec sdisconnect %alias "S#SDISCONNECT"(%string (31) s, %integer fsys,
     %integer %name flag)
   %external %routine %spec define(%string (255) s)
   %external %routine %spec list(%string (255) s)
   %external %routine %spec setmode(%string(255) s)
   %external %routine %spec messages(%string (63) s)
   %external %routine %spec outfile %alias "S#OUTFILE"(%string (31) s, %integer s, h, p,
     %integer %name conad, flag)
   %external %routine %spec prompt(%string (15) s)
   %external %integer %function %spec pstoi %alias "S#PSTOI"(%string (63) s)
   %external %string (*) %function %spec itos %alias "S#ITOS"(%integer i)
   %external %routine %spec psysmes %alias "S#PSYSMES"(%integer root, flag)
   %external %routine %spec stop(%string (255) s)
   %external %string (*) %function %spec uinfs(%integer type)
   %external %string (*) %function %spec date
   %external %string (*) %function %spec time
   %external %routine %spec read profile(%string (11) key, %name info, %integer %name version,
     uflag)
   %external %routine %spec write profile(%string (11) key, %name info, %integer %name version,
     uflag)
   %external %string (8) %function %spec unpack date %alias "S#UNPACKDATE"(%integer p)
   %external %string (8) %function %spec unpack time %alias "S#UNPACKTIME"(%integer p)

   %external %integer %function %spec current packed dt %alias "S#CURRENTPACKEDDT"
   %external %integer %function %spec dtword %alias "S#DTWORD"(%integer d)
   %external %integer %function %spec pack date and time %c
                         %alias "S#PACKDATEANDTIME"(%string(8) date, time)


   %routine printstring(%string (255) s)
      %integer i
      printch(charno(s,i)) %for i = 1, 1, length(s)
   %end; ! Of %routine printstring.

   %routine gp300 trans(%integer incon, outcon, %integer %name cc, pc)
      ! Scans the input file with connect address incon, to generate an equivalent
      ! file (with connect address outcon) for the GP300 printer.
      ! On exit cc contains the number of printable characters in the output file.
      ! Translates font selection from the 'model' GP300 described in the documentation
      ! to the actual printer in use.
      ! Removes any start and finish FFs, and inserts necessary FFs in file.
      ! Converts any 8-bit codes to 7-bit equivalents, and combines consecutive
      ! newlines into a single relative vertical move.
      ! Also ensures that vertical movements keep on the A4 page, and inhibits
      ! the off-line test and the 'reset to initial state' command.
      ! Also inhibits attempts to reset the page length or the top of form posn.
      ! It does not attempt to check horizontal movements, which would require
      ! a knowledge of the font widths, etc.  Note that the GP300 will wrap lines
      ! longer than its carriage, but this should not prove to be a problem.

      %external %routine %spec move %alias "S#MOVE"(%integer bytes, from, to)
      %integer cpos, cnls, in, instart, inend, out, outstart, on lhm, nlsize, parameter, endcode,
        s, page size, scribe, ff8, t, cbit, onlsize, graphics, outff, ccff
      %constant %integer ff=12, esc=27, del=127, bit8=128, bs=8
      %constant %integer no=0, yes=15,
                      printable=1, ignore=2, newline=3, form feed=4, escape=5,
                      carriage return=6, hts=7, pld=8, tilde=9, rlf=10, dcs=11,
                      csi=12,plu=13,backspace=14,left margin=15
      %constant %byte %integer %array type(0:255)=
         ignore(8), backspace, printable, newline, ignore, form feed, carriage return,
         ignore(13), escape, ignore(4), printable(94), tilde, ignore{del},
         ignore(8), hts, ignore(2), pld, plu, rlf, ignore(2), dcs, ignore(10),
         csi, ignore(4), printable(95), ignore
      %switch effect(1:15)

      ! cnls gives accumulated newlines not yet output.  They are only accumulated
      ! when we are on the left hand margin.  Thus cnls#0 => on lhm=true.
      ! Whenever a GP300 control sequence or escape sequence is encountered, any
      ! accumulated newlines are flushed out.

      ! ******* Routines *********
      %routine code out(%integer s)
         ! s is output.  If an 8-bit code it is expressed as two 7-bit codes.
         %if s>=x'80' %start
            byteinteger(out) = esc; out = out+1
            s = s-x'40'
         %finish
         byteinteger(out) = s; out = out+1
      %end; ! Of %routine code out.

      %routine char out(%integer s)
         ! s is output.
         byteinteger(out) = s; out = out+1
      %end; ! Of %routine char out.

      %routine val out(%integer p)
         %integer n, m
         n = 1; n = 10*n %until n>p; n = n//10
         %cycle
            m = p//n
            char out('0'+m)
            p = p-m*n
            n = n//10
         %repeat %until n=0
      %end; ! Of %routine val out.

      %routine move down
         %if cpos=nlsize %start; ! At top of sheet.  An explicit nl may 'take up the slack'.
            char out(nl); cnls = cnls-1
            char out(cr)
            cpos = cpos+nlsize
         %finish
         cpos = cpos+nlsize*cnls
         %if (cnls<4 %and scribe=no) %or graphics=yes %start; ! Do it by explicit newline characters.
            ! Scribe's interpretation of nl (no cr implied) means that we must
            ! use VPR for Scribe files.
            %while cnls>0 %cycle
               char out(nl)
               cnls = cnls-1
            %repeat
            printch(cr) %unless graphics=yes; ! Needed, as FE is in graph mode.
         %finish %else %start
            code out(x'9b'); ! csi.
            val out(cnls); cnls = 0
            code out(x'65'); ! VPR.
         %finish
      %end; ! Of %routine move down.

      %routine read and write cs(%integer %name parameter, end code)
         %integer s
         ! csi just read. Analyse input to get parameter and end code.
         parameter = 0
         %if in<inend %start
            in = in+1; s = byteinteger(in)
            char out(s)
            %while '0'<=s<='9' %and in<inend %cycle
               parameter = 10*parameter+s-'0'
               in = in+1; s = byteinteger(in)
               char out(s)
            %repeat
         %finish %else s = 0
         end code = s
      %end; ! Of %routine read and write cs.


      ! ********** Start of gp300trans code ************
      ! Default vertical settings: 6 lines/inch, 144 quanta/inch.
      nlsize = 24 {1/144" units}
      cpos = nlsize; ! ff line is number 1.  cpos is measured in quanta.
      cnls = 0; ! cnls is measured in newlines.
      on lhm = yes
      scribe = no; ! Flag specifying file generated by Scribe.
      ff8 = no; ! Relates to terminals setting 8th bit (mainly affects FF).
      cc = 0; ! Printable character count.
      ccff = 0
      pc = 0; ! Page count.
      cbit = 0; ! Used when outputting printing characters.
      onlsize = 0; ! For saving nlsize when graphics mode entered.
      graphics = no
      ! File pointers.
      inend = incon+integer(incon)
      instart = incon+integer(incon+4)
      outstart = outcon+integer(outcon+4)
      out = outstart
      outff = outstart

      page size = 60*24 {60 lpp}
      in = instart
      %if byteinteger(in)=del %start
         ! File already checked - bypass translation.
         s = inend-instart
         move(s, instart, out)
         out = out+s
         integer(outcon) = out-outcon
         cc = integer(outcon+28)>>10; ! Printable character count and page count stored here.
         pc = integer(outcon+28)&1023
         %return
      %finish
      char out(del); ! Code to indicate 'translation done'.
      ! If file has a ff at start allow 66 lpp.
      %cycle
         %exit %if in>=inend
         s = type(byteinteger(in))
         %exit %if s=printable
         %if s=form feed %or s=plu %or s=backspace %or s=escape %start
            page size = 66*24
            scribe = yes %if s=backspace
            ! The Scribe trademark.  In this case 'on lhm' always remains at 'yes'.
            ff8 = yes %if s=plu; ! plu (x'8C') represents FF (x'0C').
            %exit
         %finish
         in = in+1
      %repeat

      inend = inend-1; ! Now points to last byte containing data.
      in = instart-1
      %while in<inend %cycle
         in = in+1; s = byteinteger(in)
         t = type(s)
         ->effect(t!on lhm)

effect(left margin): ! Means we are on lhm.
         %if t&7=printable %start; ! Printable or tilde.
            move down %if cnls>0
            on lhm = no %unless scribe=yes
            ! Scribe takes nl and ff to mean move down, but not to start of
            ! relevant line.  Thus, for translation to work, we keep 'on lhm'
            ! set to 'yes' at all times with Scribe files.
         %finish
         ->effect(t)

effect(printable):
         char out(s!cbit)
         cc = cc+1; ! Printable character count.
         %continue

effect(tilde): ! Same as printable, except that some 'zero effect' codes must follow.
         char out(s!cbit)
         %if graphics=no %then char out(' ') %and char out(bs) %else %c
          char out(0) %and char out(0)
         cc = cc+1; ! Printable character count.
         %continue

effect(newline):
         %if on lhm=no %start
            on lhm = yes
            char out(cr) %if graphics=no
            char out(nl)
            cpos = cpos+nlsize
            ->effect(form feed) %if cpos>page size
         %finish %else %start; ! Already on lhm.
            cnls = cnls+1
            ->effect(form feed) %if cpos+nlsize*cnls>page size
         %finish
         %continue

effect(carriage return):
         on lhm = yes
         char out(s)
         %continue

effect(form feed): ! Do not output Form Feed if page is blank.
         page size = 66*24 %if t=form feed %or (t=plu %and ff8=yes)
         %if on lhm=no %start; ! Take a newline.
            char out(cr) %if graphics=no
            char out(nl)
            cpos = cpos+nlsize
            on lhm = yes
         %finish
         %if cpos>nlsize %start; ! Non-blank page.
            outff = out; ccff = cc
            char out(ff)
            pc = pc+1; ! Page count.
         %finish
         cnls = 0; cpos = nlsize
         %continue

effect(escape): ! Possibly a GP300 command.
         move down %if cnls>0
         code out(esc)
         in = in+1; s = byteinteger(in)
         out = out-1 %and %continue %if s=x'3f' %or s=x'63' %or s=x'3d'
         ! Reject off-line test, reset initial state, load top of form.
         ->effect(type(s+x'40'))

effect(hts): ! Horizontal tab set.
         move down %if cnls>0
         code out(s)
         %continue

effect(pld): ! Partial line down (1/12").
         move down %if cnls>0
         cpos = cpos+12
         ->effect(form feed) %if cpos>page size
         code out(s)
         %continue

effect(plu): ! Partial line up (1/12").
         ->effect(form feed) %if t=plu %and ff8=yes; ! A funny: plu=x'80'!ff (as it happens).
         move down %if cnls>0
         cpos = cpos-12 %and code out(s) %if cpos>12
         %continue

effect(rlf): ! Reverse line feed.
         move down %if cnls>0
         cpos = cpos-nlsize %and code out(s) %if cpos>nlsize
         %continue

effect(dcs): ! device control string - starts font downloading data.
         ! Currently this is not allowed - data discarded.
         move down %if cnls>0
         ! code out(s)
         in = in+1; s = byteinteger(in)
         %cycle
            %while esc#s#x'9c' %and in<inend %cycle
               ! code out(s)
               in = in+1; s = byteinteger(in)
            %repeat
            %if s=esc %start
               ! code out(s)
               in = in+1; s = byteinteger(in)
               %continue %unless s=x'5c'
            %finish
            ! code out(s)
            %exit
         %repeat
         %continue

effect(csi): ! Command string introducer.
         move down %if cnls>0
         code out(s)
         read and write cs(parameter, endcode)
         %if endcode=';' %and graphics=no %start
            ! Font setting - translate.
            %if parameter>20 %start
               parameter = parameter-20
               out = out-1; byteinteger(out-1) = ';'
               cbit = bit8
            %finish %else cbit = 0
            ! N.B. The translation assumes that 'model' GP300 font codes <=9.
            byteinteger(out-2) = font trans(parameter) %if 1<=parameter<=nfont families
            read and write cs(parameter, endcode)
            %continue
         %finish
         parameter = 1 %if parameter=0
         %if endcode=x'76' %start
            ! Page length set - remove.
            out = out-1 %until byteinteger(out)=esc
         %finish %else %if endcode=x'7b' %and graphics=no %start; ! line spacing.
            nlsize = 144//parameter
         %finish %else %if endcode=x'68' %and graphics=no %and 25<=parameter<=29 %start
            ! Graphics option.
            onlsize = nlsize; graphics = yes
            %if 25<=parameter<=26 %then nlsize = 2 %else nlsize = 1
         %finish %else %if endcode=x'6c' %start; ! Reset.
            nlsize = onlsize %and graphics = no %if 25<=parameter<=29 %and graphics=yes
            ! Was in graphics mode.
         %finish %else %if x'64'<=endcode<=x'65' %and graphics=no %start; ! Abs. or rel. vertical movement.
            %if endcode=x'64' %then cpos = nlsize*parameter %else cpos = cpos+nlsize*parameter
            %if cpos>page size %start
               out = out-1 %until byteinteger(out)=esc
               ->effect(form feed)
            %finish
         %finish
         %continue

effect(backspace):
effect(ignore): ! Does not affect translation
         char out(s!cbit)
         %continue
      %repeat

      ! now tidy up file.
      out = outff %if cc=ccff; ! i.e. if no printable characters since last ff.
      pc = pc+1 %if outff<out; ! For last page.
      %if out>outstart %and 32<=byteinteger(out-1)<=126 %start
         char out(cr); char out(nl)
      %finish
      integer(outcon) = out-outcon; ! Set data size in file header.
      integer(outcon+28) = cc<<10!pc; ! Store printable character count and page count in file header.
      ! Note that the output file neither starts nor finishes with a form feed.
      ! These are added by the software controlling the listing of files to the printer.
   %end; ! Of %routine gp300trans.

   %routine x2700 trans(%integer incon, outcon, %integer %name cc, pc)
      %constant %byte %integer %array nchars(0:255) = 
         0(9), 2, 0(33), 3{+}, 0(53), 2, 0, 1{c}, 0(5), 1{i}, 0(3), 2, 0(4),
         3{r}, 0, 2, 0, 2, 0, 2(2), 3{z}, 0(5), 0(128)
      %constant %integer printing=1, skip=2, escape=3, syskey=4, equals=5, ctl=6
      %constant %integer form feed=7, newl=8, userkey=9
      %own %byte %integer %array type(0:255)= ctl(10), newl, ctl, form feed,
            ctl, skip(2), ctl(2), skip, ctl, skip, ctl(3), skip(3), escape,
            ctl(4), printing(29), equals, printing(66), printing(128)
      %switch effect(1:9)
      %constant %byte %integer %array defudk(1:4)= 'U', 'D', 'K', '='
      %integer inend, instart, outstart, out, in, s, i, j, uudk, nls2,
               lc, lcmax, ccff, outff

      %routine udk out(%integer code)
         byteinteger(out) = '='; byteinteger(out+1) = 'U'
         byteinteger(out+2) = 'D'; byteinteger(out+3) = 'K'
         byteinteger(out+4) = '='; byteinteger(out+5) = code
         out = out+6
      %end; ! Of %routine udk out.

      %routine char out(%integer s)
         byteinteger(out) = s; out = out+1
      %end; ! Of %routine char out.

      %routine string out(%string(255) s)
         %integer i, l
         l = length(s)
         char out(charno(s,i)) %for i = 1,1,l
      %end; ! Of %routine string out.

      uudk = 0; ! User UDK - no definition initially.
      type(sudk) = syskey; ! System-defined udk.
      pc = 0; ! Page count.
      lc = 0; ! Line-on-page count
      lcmax = 120; ! Half-line count limit.  Changed if ff read after non-null page.
      ! N.B. lcmax is only used for accounting purposes - not to force a new page.
      nls2 = 2; ! Physical nls per logical nl * 2
      ! N.B. This value will be varied when UDK strings are analysed.
      cc = 0; ! Printable character count.
      ccff = 0; ! Used to remove non-printables at end of file.
      ! File pointers.
      inend = incon+integer(incon)
      instart = incon+integer(incon+4)
      outstart = outcon+integer(outcon+4)
      out = outstart
      outff = outstart
      in = instart
      in = in-1; inend = inend-1
      %while in<inend %cycle
         in = in+1; s = byteinteger(in)
         ->effect(type(s))

effect(escape): ! Change to current UDK.
         %if uudk=0 %then s = sudk %else s = uudk

effect(userkey):
         ! use of udk.
         char out(s)
         in = in+1; s = byteinteger(in); char out(s)
         i = nchars(s); ! No. of chars to complete command, or a code if >1.
         %if i>2 %start; ! Special - treat separately.
            %if s='r' %start
               in = in+1; s = byteinteger(in); char out(s); ! Dirn of rel. move.
               %cycle
                  in = in+1; s = byteinteger(in); char out(s)
               %repeat %until (%not '0'<=s<='9')
            %finish %else %if s='z' %start
               in = in+1; s = byteinteger(in); char out(s)
               %if s='l' %or s='o' %start; ! One more character.
                  in = in+1; s = byteinteger(in); char out(s)
               %finish
            %finish %else %if s='+' %start
               %if byteinteger(in+1)='D' %or byteinteger(in+1)='F' %start
                  ! Attempt to switch into monitor mode or load fonts - suppress job.
                  out = outstart
                  pc = 0; cc = 0
                  %exit
               %finish
               %cycle
                  in = in+1; s = byteinteger(in); char out(s)
               %repeat %until s=nl
            %finish
         %finish %else %if i=2 %start; ! Scan for next nl.
            %cycle
               in = in+1; s = byteinteger(in); char out(s)
            %repeat %until s=nl
         %finish %else %start; ! Skip i characters.
            %while i>0 %cycle
               in = in+1; s = byteinteger(in); char out(s)
               i = i-1
            %repeat
         %finish
         %continue

effect(printing):
         char out(s); cc = cc+1
         %continue

effect(form feed):
         %if ccff<cc %start; ! Some printing characters since last page break.
            lcmax = 5000
            ! Assumes that file contains ffs at page boundaries -
            ! effectively removes page check at 'effect(newl):'.
            pc = pc+1
            lc = 0; ! Line-on-page count.
            ccff = cc; ! Character count to date.
            outff = out; ! Position of this ff.
         %finish %else %start
            out = outff; ! Nothing printable on this page - go back to end of last page.
            string out(studk."m700,20,20,60,480".snl) %if cc=0 %and %c
                          uudk=0 %and fqueue(xforms queue)_orient='P'
            ! ff before any printable character - set no. of printable lines to 66
            ! if in portrait orientation and user has not defined his own key
            ! (if he has then it is assumed that he can look after his own margins).
         %finish

effect(ctl):
         char out(s)
         %continue

effect(newl):
         lc = lc+nls2
         ! Note: we assume 60 lines/page if there are no ffs in the file.
         !       This estimate is for accounting purposes only.  It may be wrong if
         !        a) the file contains ffs but not at every page boundary.
         !        b) a non 6 lpi font is used without any ffs.
         !        c) the top and/or bottom margins have been altered.
         %if lc>=lcmax %start; ! New page will be taken by laser printer.
            lc = 0; pc = pc+1
            outff = out; ! Position of (notional) ff.
            ccff = cc
            ! Note that this position might later be assumed to be the end
            ! of an ACTUAL page.  If it is not (because of font changes, etc.
            ! without any form feeds) then curious effects might result
            ! (highly unlikely).
         %finish
         char out(cr); char out(nl)
         %continue

effect(syskey): ! User has used symbol which happens to be system-defined key (sudk).
         udk out('*'); ! '*' had better not be sudk!
         char out(sudk); cc = cc+1
         udk out(sudk)
         %continue

effect(equals): ! Look for udk definition.
         j = true
         %for i = 1, 1, 4 %cycle
            j = false %and %exit %if in+i>inend %or byteinteger(in+i)#def udk(i)
         %repeat
         ->effect(printing) %if j=false
         in = in+5; s = byteinteger(in)
         %continue %unless 32<s<127 %and s#'=' %and s#'U' %and s#'D' %and s#'K'
         uudk = s
         udkout(uudk)
         type(uudk) = userkey
         type(sudk) = printing
         ! User has defined his own udk - no need to avoid system-defined key any more.
         %continue

effect(skip):
      %repeat

      ! Now tidy up file.
      %if cc=ccff %then out = outff %else pc = pc+1
      ! Either no text since last ff, or add one to page count.
      %if out>outstart %and 32<=byteinteger(out-1)<=126 %start
         char out(cr); char out(nl)
      %finish
      integer(outcon) = out-outcon; ! Set data size in file header.
      integer(outcon+28) = cc<<10!pc; ! Store printable character count and page count in file header.
      ! Note that the output file neither starts nor finishes with a form feed.
      ! These are added by the software controlling the listing of files to the printer.
   %end; ! Of %routine x2700 trans.

   %routine gpad
      %string(40) st
      ! Sets TCP (or PAD) and FEP, to Graph mode.  Switches echoing off.
      ! Switches flow on if not a PAD connection (already on if it is).
      st = "GRAPH=ON,ECHO=OFF"
      %if x29call=0 %then st = st.",FLOW=ON"
      setmode(st)
   %end; ! Of %routine gpad.

   %routine interpret printer type
      ! prtype interpreted as follows:
      !   BITS        ASSIGNED TO
      !    0-3        pmode
      !    4-7        banner
      !    8-11       log2(ncopymax)
      !   12-15       printer type (GP300, X2700)
      !   16          initfcheck
      !   17          bpass
      !   18          repeat
      !   19          accounting
      !   20          rom only
      !   21          one input hopper only
      ! Currently some of the variables are not used.
      %constant %integer hexmask=X'F'
      %constant %integer bitmask=B'1'
      pmode = prtype&hexmask
      banner = prtype>>4&hexmask
      ncopymax = 2\\(prtype>>8&hexmask)
      printer = prtype>>12&hexmask
      initfcheck = prtype>>16&bitmask
      bpass = prtype>>17&bitmask
      repeat = prtype>>18&bitmask
      accounting = prtype>>19&bitmask
      rom only = prtype>>20&bitmask
      one hop = prtype>>21&bitmask
   %end; ! Of %routine interpret printer type.

   %routine prepare accounts file
      %record (crrf) crr
      %integer flag, today, day, d in w, last sunday, accfsys
      connect("CHARGES",0,0,0,crr,flag)
      %if flag=0 %start; ! Charge file exists - see if it is time to transfer it to ACCNTS process.
         today = pack date and time(date,"00.00.00")
         day = (today&x'7fffffff')//86400; ! Days since 1/1/70 (a Thursday).
         d in w = day - (day//7)*7 - 3
         d in w = d in w + 7 %if d in w<0
         ! d in w now gives current day of the week (Sunday=0).
         last sunday = today - d in w*86400; ! 86400 is no. of secs in a day.
         %if dtword(integer(crr_conad+20))<last sunday %start; ! Transfer file to ACCNTS.
            trim("CHARGES", flag)
            rename("CHARGES", "OCHARGES", flag)
            newgen("CHARGES", "OCHARGES", flag) %if flag#0
            accfsys = -1
            flag = dfsys("ACCNTS", accfsys)
            flag = dtransfer(owner, "ACCNTS", "OCHARGES", printerst, ownfsys, accfsys, 1)
         %finish %else disconnect("CHARGES", flag)
      %finish
      define("76,CHARGES-MOD")
      chdev = uinfs(10); chhost = substring(chdev,3,4)
      chdev = printerst
      chdev = chdev." " %while length(chdev)<8
   %end; ! Of %routine prepare accounts file.

   %routine read as a string(%string %name s)
      %integer i
      %if mode=1 {endless printing} %and iostat_inpos=it_inpointer %start
         s = "PRINT"; ! Causes endless printing to resume.
         %return
      %finish
      s = ""
      printch(cr); printstring("Command:")
      %cycle
         read ch(i)
         %if i=nl %start
            printch(cr); printch(nl)
            %return
         %finish
         printch(i)
         %continue %if (i=' ' %and s="") %or i<' '; ! i.e. ignore other control characters.
         i = i&95 %if 'a'<=i<='z'
         s = s.tostring(i)
      %repeat
   %end; ! Of %routine read as a string.

   %integer %function barred(%record (infof) %name info)
      %integer i
      %result = true %if info_forms#forms queue; ! Effectively barred.
      %for i = 0, 1, save max %cycle
         %result = true %unless info_ident#bar(i)#info_user
      %repeat
      %result = false
   %end; ! Of %integer %function barred.

   %routine get queue(%integer %name no, barno, ad, f)
      %integer i
      %string (31) message
      %record (fhf) %name fh
      %record (infof) %name info
      %record (crrf) crr
      %record %format pe(%integer dest, srce, p1, p2, p3, p4, p5, p6)
      %record (pe) rp
      destroy("QINF", f)
      no = 0; barno = 0
      message = "COMMAND *QUEUE ".printerst.",QINF"
      rp = 0
      f = dspool(rp, length(message), addr(message)+1)
      %if f#0 %start
         printstring("Failed to access SPOOLER: ".itos(f).snl)
         %return
      %finish
      connect("QINF", 3, 0, 0, crr, f)
      %if f#0 %start
         psysmes(8, f)
         %return
      %finish
      fh == record(crr_conad)
      no = (fh_end-fh_start)//256; ! 256 is length of Spooler doc
      ad = crr_conad
      %for i = 1, 1, no %cycle
         info == record(ad+32+(i-1)*256)
         barno = barno+1 %if barred(info)=true
      %repeat
   %end

   %routine set queue param(%integer type, %string (6) %name param, %integer %name flag)
      %record (reqf) req
      ! type is 2 for forms
      !         3 for limit
      req = 0
      req_dest = x'ffff003c'
      req_flag = 1
      req_user = owner; ! owner is global - process listing the queue.
      req_p6 = type
      %if param="?" %then req_p6 = req_p6!x'00000080' %else req_file = param
      flag = dpon2("SPOOLR", req, 1, 7)
      flag = 1 %and %return %if flag#0
      param = req_file %if param="?"
   %end; ! Of %routine set queue param.

   %routine get queued file(%string (6) ident, %integer %name flag)
      %record (reqf) req
      req = 0
      req_dest = X'FFFF003C'
      req_flag = 1
      req_user = owner; ! owner is global - process listing the queue.
      req_p6 = 1
      req_file = ident
      flag = dpon2("SPOOLR", req, 1, 7)
      flag = 1 %and %return %if flag#0
      flag = req_flag>>24
      flag = 2 %if flag#0
   %end; ! Of %routine get queued file.

   %routine remove queued file(%string (6) ident, %integer %name f)
      %record (reqf) req
      %integer fsys
      ! On return, f=0:   File deleted ok
      !            f=1:   Failed to access SPOOLR
      !            f=2:   Failed to delete file
      fsys = pstoi(substring(ident, 1, 2))
      sdisconnect("SPOOLR.".ident, fsys, f)
      req = 0
      req_dest = X'FFFF003D'
      req_flag = 0
      req_user = owner; ! owner is global - process listing the queue.
      req_file = ident
      f = dpon2("SPOOLR", req, 1, 7)
      f = 1 %and %return %if f#0
      f = req_flag>>24
      f = 2 %if f#0
   %end; ! Of %routine remove queued file.

   %routine delete queued file(%string (6) ident, %integer %name flag)
      get queued file(ident, flag)
      remove queued file(ident, flag) %if flag=0
   %end; ! Of %routine delete queued file.

   %routine voff pon
      %return %if pstate=on; ! Printer on already.
      printch(leadin); printch('*'); printch(0); printch(0)
      pstate = on
   %end; ! Of %routine voff pon.

   %routine define x2700 fonts
      ! Fonts assumed loaded.  Assign default numbers to fonts.
      %integer i, n
      fs == fqueue(xforms queue)
      voff pon %if pstate=off
      %for i = 0, 1, 9 %cycle
         n = fs_font(i)
         printstring(studk."+".itos(i).fontname(n).snl) %if 1<=n<=maxfont
      %repeat
   %end; ! Of %routine define x2700 fonts.

   %routine set printer defaults
      %return %if pstate=off; ! Printer is always in default state if off.
      %if printer=gp300 %start
         printch(esc); printch(csi); ! Command String Introducer.
         printstring(tostring(font trans(2)).";2"); printch(cpl); ! Gothic 12cpi.
         printch(esc); printch(csi)
         printch('3'); printch(tbc); ! Clear all tabs.
         printch(esc); printch(csi)
         printch('6'); printch(lsl); ! 6 lines per inch.
         printch(esc); printch(csi); printch('1')
         printch(sss); ! Step size default (1/12").
         printch(esc); printch(csi)
         printstring("24"); printch(rm); ! Reset bi-directional printing.
         printch(esc); printch(csi)
         printch('2'); printch(snv); ! GB national version.
         printch(esc); printch(csi)
         printch(sgr); ! Ensure not underlining (!).
         printch(cr)
      %finish %else %if printer=x2700 %start
         printstring("=UD"."K=".studk)
         define x2700 fonts; ! Sets up the default font name-number associations.
         printstring(studk."0".studk."d".studk."e")
         ! Select font 0, clear horizontal & vertical tabs.
         printstring(studk."k".studk."w"); ! Clear justification, underlining.
         printstring(studk."i0"); ! Set single spacing.
         printstring(studk."c0".studk."zl1")
         ! Use both input hoppers, set UK language variant.
         %if fqueue(xforms queue)_orient='P' %start; ! Portrait.
            printstring(studk."m700,50,50,60,480".snl)
            ! This sets page length to 700/60, top & bottom margins to 50/60, left
            ! margin to 60/60 and (page width - right margin) to 480/60 (495/60 - 15/60).
            ! Thus right margin (min) is 1/4".
            ! Top & bottom margins leave 10" for text - 60 lines @ 6 lpi.
            printstring(studk."t75,105,135,165,195,225,255,285".snl)
            printstring(studk."t315,345,375,405".snl)
            ! Set horizontal tabs 0.5" apart, starting 0.5" from left hand margin.
         %finish %else %start; ! Landscape fonts.
            printstring(studk."m495,16,16,30,670".snl)
            ! This sets page length to 495/60, top and bottom margin to 16/60
            ! left margin to 30/60, (page width-right margin) to (700/60-30/60).
            ! Thus right margin is 30/60".
            printstring(studk."t90,120,150,180,210,240,270,300".snl)
            printstring(studk."t330,360,390,420,450,480,510,540".snl)
            ! Tabs set 0.5" apart, starting 0.5" from left hand margin.
         %finish
      %finish
   %end; ! Of %routine set printer defaults.

   %routine von poff
      ! Printer is always in default state if switched off.
      %return %if pstate=off
      ! Printer port is on - set printer to default values before switching off.
      set printer defaults
      %if printer=gp300 %start
         printch(esc); printch(csi); printstring("100")
         printch(hpa); ! Move printhead off paper, to print 'tilde ?'.
      %finish
      printch(leadin); printch('?'); printch(0); printch(0); ! Switch to video only.
      ! On X2700, this causes 'esc ?' to go to the printer, which generates an error
      ! message.  Since, however, we are not using the (Xerox) Start Job command
      ! the error report does not get printed, and the user is not left with a
      ! mysterious sheet of error codes (very user-unfriendly!).
      pstate = off
   %end; ! Of %routine von poff.

   %integer %function x2700 forms queue index(%integer forms queue)
      %integer i
      %for i = 1, 1, maxfqueue %cycle
         %result = i %if fqueue(i)_snum=forms queue
      %repeat
      %result = 0; ! forms queue not defined.
   %end; ! Of %integer %function x2700 forms queue index.

   %routine font check
      %integer conad, flag, ccinc, pcinc
      %record (crrf) crr

      %routine print x2700 fonts
         ! Prints out the currently defined fonts with their names and numbers.
         %constant %integer ht=9
         %integer i, n, n0, j, k, s, l
         printstring(studk."0"); ! Select 0 (default) font.
         fs == fqueue(xforms queue)
         printstring(snl.studk."bFonts defined in forms queue number ".itos(forms queue).":".studk."p".snl.snl.snl)
         n0 = fs_font(0)
         %for i = 0, 1, 9 %cycle
            n = fs_font(i)
            %continue %if n<1 %or n>maxfont
            write(i, 1); spaces(2)
            printstring(fontname(n).":".studk.itos(i))
            %if i=0 %or n#n0 %start
               printstring("=UD"."K="); printch(tilde)
               s = 32; l = 31
               %for j = 1, 1, 3 %cycle
                  printstring(snl)
                  printch(ht) %for k = 1, 1, 5
                  printch(s+k) %for k = 0, 1, l
                  s = s+32
                  l = 29 %if j=2
               %repeat
               printstring("=UD"."K=".studk)
               printch(tilde)
            %finish
            printstring(snl)
            printstring(studk."0"); ! Back to default font.
         %repeat
         printstring(snl)
      %end; ! Of %routine print x2700 fonts.

      %if pstate=off %then voff pon %else set printer defaults
      %if printer=gp300 %start
         %if exist("T#FCHECK")=0 %start
            outfile("T#FCHECK", x'1000', 0, 0, conad, flag)
            %return %if flag#0
            connect("ERCC99.GP300FCHECK", 0, 0, 0, crr, flag)
            %return %if flag#0
            gp300 trans(crr_conad, conad, ccinc, pcinc)
            trim("T#FCHECK", flag)
            %return %if flag#0
         %finish %else ccinc = 1000
         printch(cr)
         list("T#FCHECK")
         cc = cc+ccinc; ! cc is global.
         gcc = gcc+ccinc
         pc = pc+1; ! Page count.
         gpc = gpc+1
         printch(cr)
         printch(ff)
      %finish %else %if printer=x2700 %start
         print x2700 fonts
         printch(ff)
         cc = cc+375; ! Estimate.
         gcc = gcc+375; ! Estimate.
         pc = pc+1
         gpc = gpc+1
      %finish
      von poff
      printstring(snl."**Please check the font sheet before continuing.".snl)
   %end; ! Of %routine font check.

   %routine print next file(%record (infof) %name info, %integer %name f)
      ! Meaning of f on return from routine:
      !     0    file printed
      !     1    file not available
      !     2    operator input detected
      %record (crrf) crr
      %record (infof) %name si
      %string (31) st, ident
      %integer i, s, filead, flag, p, fsys

      %routine print doc(%record (infof) %name info, %integer charge)
         %integer copies, cc0, f, i, pages, sdt, fdt

         %routine print banner(%string (31) listed by, ident, filename)
            %string (31) surname
            %integer f, i, fsys, pence, pounds
				 %string(2) spence

            %routine bprintstring(%string (255) s)
               ! Does not print possibly eccentric graphics.
               %integer i, c
               c = 0
               %for i = 1, 1, length(s) %cycle
                  c = charno(s, i)
                  %if (printer=x2700 %and c#sudk) %or %c
                      (printer=gp300 %and (65<=c&95<=90 %or 37<=c<=62 %or 0<=c<=34)) %c
                   %then printch(c) %else space
                  printch(0) %if c=lead in
               %repeat
               printch(cr) %if c=nl
            %end; ! Of %routine bprintstring.

            %routine set default font
               %if printer=gp300 %start
                  printch(esc); printch(csi); ! Command String Introducer.
                  printstring(tostring(font trans(2)).";2"); printch(cpl); ! Gothic 12cpi.
               %finish %else %if printer=x2700 %start
                  printstring(studk."0"); ! Font 0 is always default font.
               %finish
            %end; ! Of %routine set default font.

            %routine set banner font
               %if printer=gp300 %start
                  ! Select Orator font.
                  printch(esc); printch(csi)
                  printstring(tostring(font trans(3)).";2"); printch(cpl)
               %finish %else %if printer=x2700 %start
                  ! Select font 0 (default) - fixed pitch.
                  printstring(studk."0")
               %finish
            %end; ! Of %routine set banner font.

            surname = ""
            %if charge#0 %start
               pence = 4*pages
               pounds = pence//100; pence = pence-100*pounds
               spence = itos(pence); spence = "0".spence %if length(spence)=1
            %finish
            fsys = pstoi(substring(ident, 1, 2))
            f = dsfi(listed by, fsys, 18, 0, addr(surname))
            set banner font
            printstring(snl)
            printstring(studk."b") %if printer=x2700; ! Bold on.
            %for i = 1, 1, 3 %cycle
               %if printer=gp300 %start
                  printch(esc); printch(csi)
                  printch('1'); printch('3'); printch(vpr); ! Move relative 13 lines.
               %finish %else newlines(13)
               %if i&1=1 %start
                  bprintstring("***  ".listed by."  ".surname."  ".info_delivery)
                  spaces(44-length(info_delivery)-length(surname))
                  bprintstring(date." ".time."  ***".snl)
                  bprintstring("***  Document  ".ident."  Filename ".filename)
                  spaces(33-length(filename)-length(printerst))
                  bprintstring(printerst."  EMAS ".uinfs(10)."  ***".snl)
               %finish %else %start
                  %if charge=0 %then bprintstring(".....".snl.snl) %else %c
                   %if sdt<feb285 %start
                     printstring("*** Printing charge (not yet levied): #". %c
                                 itos(pounds).".".spence.snl.snl)
                  %finish %else %start
                     printstring("*** Printing charge: #".itos(pounds).".".spence.snl)
                     printstring("*** (For information only for Edinburgh University Departments".snl)
                     printstring("***  while a method of charge collection is negotiated.)".snl)
						%finish
               %finish
            %repeat
            %if printer=x2700 %start
               printstring(studk."o"); ! Offset output paper.
               printstring(studk."p"); ! Bold off.
            %finish
            set default font
         %end; ! Of %routine print banner.

         %routine charge record
            %string(71) chrec
            chrec = date." ".time." ".chdev." D:          ".chhost
            chrec = chrec.info_ident." ".info_user." ".itos((info_size>>7+1)*copies). %c
             " ".itos((fdt-sdt)//10)." ".itos(pages).tostring(nl)
            select output(76); ! Charge file channel.
            printstring(chrec)
            select output(0)
            close stream(76); ! To cause the file header to be updated.
         %end; ! Of %routine charge record.

         copies = info_copies
         copies = ncopymax %if copies>ncopymax
         copies = 1 %if copies<=0
         info_copies = copies
         ! Device limit.
         messages("OFF")
         write profile("DPkey", profrec, prof vsn, f); ! In case System crashes later.
         von poff %if pstate=on
         printstring("Printing ".info_name)
         printstring(" for ".info_user)
         spaces(14-length(info_name))
         printstring("Length ="); write(info_length, 4)
         printstring(", Ident = ".info_ident)
         %if copies>1 %then printstring(", Copies = ".tostring(copies+'0'))
         printstring(snl)
         pages = info_pc*copies
         cc0 = cc
         sdt = current packed dt
         voff pon
         %for i = 1, 1, copies %cycle
            set printer defaults %unless i=1; ! Printer is in default state initially.
            print banner(info_user, info_ident, info_name) %if banner#0 %and i=1
            %if printer=gp300 %and (i=1 %or banner=0) %and one hop=0 %start
               ! Two hoppers are assumed if one hop=0.
               ! Deselect hopper 1.
               printch(esc); printch(csi)
               printstring("21"); printch(rm)
               ! Select hopper 2.
               printch(esc); printch(csi)
               printstring("22"); printch(sm)
            %finish
            %if banner#0 %then printch(ff) %else printch(cr)
            printstring(studk."o") %if printer=x2700 %and banner=0 %and i=1; ! Output paper offset.
            list("DP".info_ident)
            cc = cc+info_cc
            gcc = gcc+info_cc
            %if i=copies %or banner=0 %start
               %if printer=gp300 %and one hop=0 %start
                  ! Deselect hopper 2, select hopper 1.
                  printch(esc); printch(csi)
                  printstring("22"); printch(rm)
                  printch(esc); printch(csi)
                  printstring("21"); printch(sm)
               %finish
               printch(ff); ! At top of next hopper 1 sheet.
            %finish
         %repeat
         disconnect("DP".info_ident, i)
         von poff
         printstring(cursor up."Printed:".snl)
         ! Enable video & disable printer.
         pc = pc+pages
         gpc = gpc+pages
         %if cc//25000#cc0//25000 %and printer=gp300 %start
            printstring("**Character count = ".itos(cc).snl)
         %finish
         fdt = current packed dt
         charge record %unless charge=0
         messages("ON")
      %end; ! Of %routine print doc.

      ! ***Start of main code for %routine print next file***

      %while iostat_inpos#it_inpointer %or reply#"" %cycle
         ! Operator input to be dealt with.
         read as a string(reply) %while reply=""; ! Might have been read already at Command level.
         s = charno(reply, 1)
         f = 2 %and %return %unless s='R' %or s='D'; ! Handle at command level if not R or D.
         ! D(elete) or R(eprint) below.
         %unless reply->st.(" ").ident %start
            printstring("Faulty command - ignored.".snl)
            reply = ""
            %continue
         %finish
         reply = ""
         ! Now check ident.
         ident -> (" ").ident %while charno(ident, 1)=' '
         ->iderr %if length(ident)>6
         %if s='R' %and ident="?" %start
            ! give details of currently reprintable jobs.
            printstring("The following files can be reprinted:".snl)
            %for i = 0, 1, save max %cycle
               %continue %if save info(i)_ident=""
               si == save info(i)
               printstring("   ".si_user.".".si_name.",  Length =")
               write(si_length, 1)
               printstring(",  Forms queue = ".itos(si_forms)) %if printer=x2700
               printstring(",  Ident = ".si_ident.snl)
            %repeat
            printstring(snl)
            %continue
         %finish

         %for i = 1, 1, length(ident) %cycle
            ->iderr %unless '0'<=charno(ident, i)<='9'
         %repeat
         ident = "0".ident %while length(ident)<6

         %if s='D' %start; ! DELETE file.
            delete queued file(ident, flag)
            %if flag=0 %start
               printstring("File ".ident." deleted from queue.".snl)
            %finish %else %start
               printstring("Failed to delete file ".ident." from queue.".snl)
            %finish
         %finish %else %start; ! Reprint job.
            s = false
            %for i = 0, 1, save max %cycle
               s = true %and %exit %if save info(i)_ident=ident
            %repeat
            %if s=false %start
               printstring("Document ".ident." not found.".snl)
            %finish %else %if forms queue#saveinfo(i)_forms %start
               printstring("Please select forms queue ".itos(saveinfo(i)_forms))
               printstring(" and then give the Rerun command again.".snl)
            %finish %else %start
               print doc(saveinfo(i),0)
            %finish
         %finish
         %continue
iderr:
         printstring("Faulty file ident - command ignored.".snl)
      %repeat; ! Operator input cycle.

      f = 1 %and %return %if info==record(0) %or barred(info)=true
      ident = info_ident
      get queued file(ident, flag)
      %if flag#0 %start
         %if flag=1 %start; ! Serious.
            printstring("Failed to access SPOOLR: ".itos(flag).snl)
            stop("")
         %finish
         ! File not available - mark it as barred.
         pbar = (pbar+1)&save max
         bar(pbar) = ident
         f = 1; %return
      %finish
      ! Now connect file.
      fsys = pstoi(substring(ident, 1, 2))
      p = (fsys<<8)!X'80'
      connect("SPOOLR.".ident, 0, 0, p, crr, flag)
      %if flag#0 %or crr_filetype#3 {char} %or crr_dataend<crr_datastart %start
         %if flag=0 %start
            printstring("Not a character file, or file header is corrupt.".snl)
         %finish %else psysmes(8, flag) %and printch(cr)
         remove queued file(ident, f)
         f = 1; %return
      %finish %else %if integer(crr_conad+28)#0 %start
         f = integer(crr_conad+28); ! Printer code in header of file.
         %if (printer=gp300 %and f#gp300code) %or %c
             (printer=x2700 %and f#x2700code+x2700 forms queue index(forms queue)-1) %start
            printstring(info_user.".".info_name." has invalid printer code - deleted from queue.".snl)
            remove queued file(ident,f)
            f = 1
            %return
         %finish
      %finish
      ! pfile points at next file slot to be used.
      destroy("DP".saveinfo(pfile)_ident, flag)
      i = (pfile+1)&save max
      %cycle
         outfile("DP".ident, crr_dataend-crr_datastart+x'8000' {arbitrary expansion}, 0, 0, filead,
           flag)
         %exit %if flag=0 %or i=pfile
         ! I.e. file created, or no more temporary files to delete to make space.
         destroy("DP".saveinfo(i)_ident, flag)
         saveinfo(i) = 0
         i = (i+1)&save max
      %repeat
      %if flag#0 %start
         printstring("Failed to create workfile: ".itos(flag).snl)
         stop("")
      %finish
      %if printer=gp300 %start
         gp300 trans(crr_conad, filead, info_cc, info_pc)
      %finish %else %if printer=x2700 %start
         x2700 trans(crr_conad, filead, info_cc, info_pc)
      %finish
      info_size = integer(filead); ! Size of file after translation.
      trim("DP".ident, flag)
      saveinfo(pfile) = info; saveinfo(pfile)_copies = 1
      pfile = (pfile+1)&save max
      ! List file on terminal (complete with simple banner if selected for this printer).
      print doc(info, accounting)
      f = 0
      remove queued file(ident, flag)
      printstring("Failed to delete file ".ident." from queue.".snl) %if flag#0
   %end; ! Of %routine print next file.

   %on %event 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11 %start
      i = event inf
      printstring("Event, subevent:")
      write(i>>8, 1); write(i&255, 1)
      printstring(", at line ".itos(event line).snl)
      printstring("Please log off if you get this message repeatedly.".snl)
      ->prof(prog vsn)
   %finish

   ! ***Start of code for %routine initialise***

   ! Check EMAS process is accreditted as a special Printer
   snl = tostring(cr).tostring(nl)
   owner = uinfs(1)
   ownerno = 0
   %for i = 1, 1, nowners %cycle
      %continue %unless owner=ownerlist(i)
      printerst = qlist(i)
      prtype = printer type(i)
      ownerno = i
      own fsys = -1; f = dfsys(owner, own fsys)
      %exit
   %repeat
   %if ownerno=0 %start
      printstring("Printer not accreditted".snl)
      stop("")
   %finish
   font trans == array(addr(font data(1, ownerno)), font trans f); ! Used by file translation routine.
   interpret printer type
	feb285 = pack date and time("02/02/85","00.00.00")

   %if printer=x2700 %then lead in = esc %else lead in = tilde
   mode = 0; ! Command mode.  "Endless printing" is mode 1.
   gpad; ! = SETMODE(GRAPH=ON,ECHO=OFF), and FLOW=ON if a TCP.
   ! The following codes assume a Hazeltine Esprit II terminal, with a GP300 or X2700
   ! connected as auxiliary printer.  The Esprit must have lead-in set to be tilde
   ! if the printer is a GP300, and to escape if the printer is a X2700.
   cursor up = tostring(lead in).tostring(ff)
   console(13, i, f)
   it == record(i)
   iostat == record(f)

   printch(leadin); printch('?'); printch(0); printch(0)
   pstate = off; ! Printer state.
   param = "?"
   set queue param(2, param, f)
   %if f#0 %start
      printstring("Unable to determine current forms queue - 0 assumed.".snl)
      forms queue = 0; xforms queue = 1
   %finish %else %start
      forms queue = pstoi(param)
      printstring("Current forms queue = ".param.snl) %if forms queue#0
      %if printer=x2700 %start
         xforms queue = x2700 forms queue index(forms queue)
         %if xforms queue=0 %start; ! Forms queue not known.
            printstring("Not defined - set to 0".snl)
            forms queue = 0; xforms queue = 1; param = "0"
            set queue param(2, param, f)
         %finish
      %finish
   %finish

   %if rom only=0 %start
      prompt("Load fonts? ")
      readsymbol(f) %and printsymbol(f) %until f&95='Y' %or f&95='N'
      readsymbol(i) %and printsymbol(i) %until i=nl; printch(cr)
      %if f&95='Y' %start
         fontfile = ramfonts(ownerno)
         !fontfile = fontfile.itos(forms queue) %if printer=x2700 %and forms queue#0
         ! Need to change font file name to be <9 characters.
         %if exist("ERCC99.".fontfile)=0 %start
            printstring("Font data file ".fontfile." not available - please contact John Murison,".snl)
            printstring("ERCC, K.B. (Tel 667 1081 ext. 2639).".snl)
         %finish %else %start
            printstring("Loading character fonts to printer ... please wait.".snl)
            voff pon
            list("ERCC99.".fontfile)
            printch(leadin); printch('?'); printch(0); printch(0)
            pstate = off
         %finish
      %finish
   %finish

   %if printer=gp300 %start
      printstring(snl."Please switch on printer and set top of form position, if necessary.".snl)
      printstring("Press RETURN when ready.".snl)
      prompt("")
      read symbol(f) %until f=nl
      voff pon
      ! Load top of form and set page length to 11.75".
      printch(esc); printch(ltof)
      printch(esc); printch(csi)
      printch('4'); printch(lsl); ! 4 lines/inch.
      printch(esc); printch(csi)
      printstring("47"); printch(spl); ! 11.75" per page.
   %finish %else %if printer=x2700 %start
      ! Set up font references and forms queues.
      fontname(t12p) = "Titan12iso-P"
      fontname(k6p) = "Kosmos6-P"
      fontname(k10p) = "Kosmos10-P"
      fontname(k10bp) = "Kosmos10B-P"
      fontname(k12bp) = "Kosmos12B-P"
      fontname(k14p) = "Kosmos14-P"
      fontname(bpsp) = "BoldPS-P"
      fontname(bpsip) = "BoldPSI-P"
      fontname(t10p) = "Titan10iso-P"
      fontname(symc10p) = "SymbolC10-P"
      fontname(xcp125l) = "XCP12.5iso-L"
      fontname(k6l) = "Kosmos6-L"
      fontname(k8l) = "Kosmos8-L"
      fontname(k8bl) = "Kosmos8B-L"
      fontname(k10bl) = "Kosmos10B-L"
      fontname(k12bl) = "Kosmos12B-L"
      fontname(bpsl) = "BoldPS-L"
      fontname(bpsil) = "BoldPSI-L"
      fontname(t10l) = "Titan10iso-L"
      fontname(symc10l) = "SymbolC10-L"

      ! Now define forms queues.
      fs == fqueue(1); fsf == fs_font
      fs_snum = 0; ! This is the number by which the user knows the forms queue.
      fs_orient = 'P'; ! Portrait orientation.
      fsf(0) = t12p; fsf(1) = k6p; fsf(2) = k10p; fsf(3) = k10bp
      fsf(4) = k12bp; fsf(5) = k14p; fsf(6) = t12p{to be bpsp}; fsf(7) = t12p{to be bpsip}
      fsf(8) = t12p{to be t10p}; fsf(9) = symc10p

      fs == fqueue(2); fsf == fs_font
      fs_snum = 50
      fs_orient = 'L'; ! Landscape orientation.
      fsf(0) = xcp125l; fsf(1) = k6l; fsf(2) = xcp125l; fsf(3) = xcp125l
      fsf(4) = k10bl; fsf(5) = k12bl; fsf(6) = xcp125l{to be bpsl}; fsf(7) = xcp125l{to be bpsil}
      fsf(8) = xcp125l{to be t10l}; fsf(9) = symc10l
   %finish

   voff pon %if pstate=off
   von poff; printstring(snl); ! This sets the printer to its defaults.

   prepare accounts file %if accounting#0
   gpc == profrec_gpc
   pc == profrec_pc
   gcc == profrec_gcc
   gdate == profrec_gdate
   cc == profrec_cc
   pbar == profrec_pbar
   bar == profrec_bar
   pfile == profrec_pfile
   save info == profrec_saveinfo
   read profile("DPkey", profrec, prof vsn, flag)
   %if flag>4 %start
      printstring("Failed to read file SS#PROFILE.  Character count set to 0.".snl)
      prof vsn = 0
   %finish
   prof vsn = 0 %unless 0<=prof vsn<=prog vsn
   ->prof(prof vsn)

prof(0):
   cc = 0; ! Character count (remembered via profile file - i.e. mainframe-specific).

prof(1):
   pfile = 0
   save info(i) = 0 %for i = 0, 1, save max

prof(2): ! Introduce 'global' character count.
   gcc = 0; gdate = date
   printstring("Global character count to be kept from now on (".date.").".snl)
   printstring("The command GCOUNT (or just G) will cause the global count of printed".snl)
   printstring("characters to be output on the video.".snl)
   printstring("Command:G 0   will reset the global count.".snl)

prof(3): ! Keep page count, and global page count, from now on.
   ! Controlled by commands C[OUNT] and G[LOBAL].
   gcc = 0; gdate = date; gpc = 0

   prof vsn = prog vsn
   write profile("DPkey", profrec, prof vsn, flag)

prof(4):
   %for i = 0, 1, save max %cycle; ! Check that rerunnable files actually exist.
      %continue %if saveinfo(i)_ident=""
      saveinfo(i) = 0 %if exist("DP".saveinfo(i)_ident)=0
   %repeat
   %if printer=gp300 %start
      printstring("**Character count = ".itos(cc).snl)
   %finish %else %if printer=x2700 %start
      printstring("**Page count = ".itos(pc).snl)
   %finish
   font check %if initfcheck#0
   von poff %if pstate=on
   prompt(snl."Command:")
   reply = ""

   cv = 0
   %cycle
      oldcv = cv
      %cycle; ! to find which printer service is required
         read as a string(reply) %while reply=""
         param = ""
         %unless reply->action.(" ").param %then action = reply
         param = reply.param %while param->reply.(" ").param
         reply = ""
         %for cv = 1, 1, ncommands %cycle
            %if action=commands(cv) %then ->act(cv)
         %repeat
         printstring("Illegal command".snl)
      %repeat

act(1): ! PRINT
act(2): ! P
      ident = ""; user = ""; file = ""
      %if param#"" %start
         %if '0'<=charno(param, 1)<='9' %start
            ident = param
            ident = "0".ident %while length(ident)<6
         %finish %else %start
            %unless param->user.(".").file %then user = param
         %finish
      %finish %else mode = 1; ! "Endless print" mode (causes input routine to return "PRINT").
      flag = 0
      %cycle
         get queue(entries, barno, conad, f) %unless 6<=old cv<=7 {QUEUE or Q}
         old cv = 1
         ! barno is set to no. of barred queue entries + entries for other forms queues.
         %if entries=barno %and param="" %start
            ! Nothing to print at present.
            f = ddelay(120); ! Wait 2 minutes.
            flag = 2 %if iostat_inpos#it_inpointer; ! Operator input.
            %continue
         %finish
         n = 0
         %if entries>barno %start
            %for i = 1, 1, entries %cycle
               info == record(conad+32+(i-1)*256)
               %continue %unless (ident="" %or ident=info_ident) %and (user="" %or %c
                user=info_user) %and (file="" %or file=info_name) %and forms queue=info_forms
               print next file(info, flag)
               ! flag return values:
               !      0    file printed
               !      1    specified file not available
               !      2    operator input detected
               %exit %if flag=2
               n = n+1 %if flag=0
            %repeat
         %finish
         %if n=0 %and flag#2 %start
            %if param#"" %start
               %if ident#"" %start
                  printstring("Document ".ident." not in queue, or not available.".snl)
               %finish %else %if file#"" %start
                  printstring("File ".user.".".file." not in queue, or not available.".snl)
               %finish %else %start
                  printstring("No documents found (or available) for ".user.".".snl)
               %finish
            %finish %else %start; ! param="".
               ! Unexpected failure to print any files - put in a delay (2 minutes).
               f = ddelay(120)
               flag = 2 %if iostat_inpos#it_inpointer
            %finish
         %finish
      %repeat %until flag=2 %or param#""
      %continue

act(3): ! STOP
act(4): ! QUIT
act(5): ! S
      setmode("-G")
      %if printer=gp300 %start
         printstring("**Character count = ".itos(cc).snl)
      %finish %else %if printer=x2700 %start
         printstring("**Page count = ".itos(pc).snl)
      %finish
      write profile("DPkey", profrec, prof vsn, flag)
      stop("")

act(6): ! QUEUE
act(7): ! Q
      ident = ""; user = ""; file = ""
      %if param#"" %start
         %if '0'<=charno(param, 1)<='9' %start
            ident = param
            ident = "0".ident %while length(ident)<6
         %finish %else %start
            %unless param->user.(".").file %then user = param
         %finish
      %finish
      get queue(entries, barno, conad, f)
      %continue %if f#0; ! Message already printed.
      printstring("Printer queue is currently empty.".snl) %and %continue %if entries=0
      printstring(snl)
      printstring(" User     Filename   Date/time listed  ")
      printstring("Length  Identifier  Copies  Forms  Barred".snl)
      %for i = 1, 1, entries %cycle
         info == record(conad+32+(i-1)*256)
         %continue %unless (ident="" %or ident=info_ident) %and (user="" %or user=info_user) %and %c
          (file="" %or file=info_name)
         printstring(info_user)
         spaces(12-length(info_name)); printstring(info_name."  ")
         printstring(unpackdate(info_dtrec)." ".unpacktime(info_dtrec))
         write(info_length, 7); printstring("    ".info_ident)
         %if info_copies<=1 %then param = "" %else param = itos(info_copies)
         spaces(8-length(param)); printstring(param)
         %if info_forms=0 %then spaces(8) %else write(info_forms, 7)
         printstring("      *") %if barred(info)=true
         printstring(snl)
      %repeat
      printstring(snl)
      %continue

act(8): ! UNBAR
act(9): ! U
      ! Unbar doc. ident or user specified.
      %if param="" %start
         bar(i) = "" %for i = 0, 1, save max
         %continue
      %finish
      %if length(param)>6 %or (length(param)#6 %and 'A'<=charno(param, 1)<='Z') %start
         printstring("Faulty parameter.".snl)
         %continue
      %finish
      param = "0".param %while length(param)<6
      f = false
      %for i = 0, 1, save max %cycle
         f = true %and bar(i) = "" %if bar(i)=param
      %repeat
      printstring(param." not Barred.".snl) %if f=false
      %continue

act(10): ! MODE - not used at present.  (Idea was to enable 'prtype' to be reset.)
act(11): ! M
      %continue

act(12): ! DELETE
act(13): ! D
      %unless param#"" %and '0'<=charno(param, 1)<='9' %and length(param)<=6 %start
         printstring("Must give ident of file to be reprinted.".snl)
         %continue
      %finish
      param = "0".param %while length(param)<6
      delete queued file(param, flag)
      %if flag=0 %start
         printstring("File ".param." deleted from queue.".snl)
         %for i = 0, 1, save max %cycle
            bar(i) = "" %if bar(i)=param
         %repeat
      %finish %else %start
         printstring("Failed to delete file ".param." from queue.".snl)
      %finish
      %continue

act(14): ! REPRINT
act(15): ! R
      param = "?" %if param=""
      %unless '0'<=charno(param, 1)<='9' %or param="?" %start
         printstring("Must give ident of file to be reprinted.".snl)
         %continue
      %finish
      reply = "REPRINT ".param
      info == record(0)
      print next file(info, flag)
      %continue

act(16): ! EXIT
act(17): ! E
      mode = 0; ! Terminate "endless printing" mode.
      %continue

act(18): ! BAR
act(19): ! B
      ! Bar ident or user, until Freed.
      %if param="" %or length(param)>6 %or (length(param)#6 %and 'A'<=charno(param, 1)<='Z') %start
         printstring("Faulty parameter.".snl)
         %continue
      %finish
      param = "0".param %while length(param)<6
      pbar = (pbar+1)&save max
      bar(pbar) = param
      %continue

act(20): ! LIMIT
act(21): ! L
      %if param="" %or param="?" %start
         param = "?"
         set queue param(3, param, flag); ! 3 is code for queue limit.
         %if flag#0 %start
            printstring("Failed to get queue limit.".snl)
         %finish %else %start
            printstring("Queue limit is ".param." Kbytes.".snl)
         %finish
      %finish %else %start; ! Set the limit to the value of param.
         flag = pstoi(param)
         %if flag=-1 %then printstring("Faulty parameter".snl) %and %continue
         set queue param(3, param, flag)
         %if flag#0 %start
            printstring("Failed to set queue limit.".snl)
         %finish %else %start
            printstring("Queue limit set to ".param." Kbytes.".snl)
         %finish
      %finish
      %continue

act(22): ! FORMS
act(23): ! F
      %if param="?" %or param="" %start
         printstring("Current forms queue is ".itos(forms queue).snl)
      %finish %else %start; ! Set the forms queue to the value of param.
         f = pstoi(param)
         %if f=-1 %then printstring("Faulty parameter".snl) %and %continue
         %if printer=x2700 %and x2700 forms queue index(f)=0 %start
            printstring("Forms queue not defined - command ignored.".snl)
            %continue
         %finish
         set queue param(2, param, flag)
         %if flag#0 %start
            printstring("Failed to select forms queue ".param.snl)
         %finish %else %start
            forms queue = f
            %if printer=x2700 %start
               xforms queue = x2700 forms queue index(forms queue)
               define x2700 fonts
               font check %if initfcheck#0
               von poff %if pstate=on
            %finish
            printstring("Forms queue ".param." selected.".snl)
         %finish
      %finish
      %continue

act(24): ! COUNT
act(25): ! C
      %if param="?" %start
         printstring("Character count = ".itos(cc).snl)
         printstring("Page count = ".itos(pc).snl)
      %finish %else %start
         param = "0,0" %if param=""
         work = "" %unless param->param.(",").work
         %if param#"" %start
            f = pstoi(param)
            %if f<0 %then printstring(param." ?".snl) %else %start
               printstring("Character count was"); write(cc, 1)
               cc = f
               printstring(".  Now set to ".itos(cc).snl)
            %finish
         %finish
         %if work#"" %start
            f = pstoi(work)
            %if f<0 %then printstring(work." ?".snl) %else %start
               printstring("Page count was"); write(pc, 1)
               pc = f
               printstring(".  Now set to ".itos(pc).snl)
            %finish
         %finish
      %finish
      %continue

act(26): ! VERIFY
act(27): ! V
      font check
      %continue

act(28): ! GCOUNT
act(29): ! G
      %if param="0" %start; ! Reset.
         gcc = 0; gdate = date; gpc = 0
         printstring("Global character count reset to 0.".snl)
         printstring("Global page count reset to 0.".snl)
      %finish %else %start
         printstring("Characters printed since ".gdate.": ".itos(gcc).snl)
         printstring("Pages printed since ".gdate.": ".itos(gpc).snl)
      %finish

   %repeat

%end; ! OF INITIALISE

%external %integer %function allowcommand %alias "S#ALLOWCOMMAND"(%string (31) command)
   %result = 1 %unless command="STOP" %or command="QUIT"
   %result = 0
%end

%external %integer %function allowconnect %alias "S#ALLOWCONNECT"(%string (6) user,
  %string (11) file)
   %result = 1
%end

%end %of %file