path: root/macros/text1/compugraphics_8600/tex8600.web

\font\twelvept=cmbx12
\font\tentex=cmr10
\def\topofcontents{\null\vfill\eject
    \def\titlepage{T}
    \centerline{{\twelvept The \TeX 8600 Driver}}
    \vskip15pt
    \centerline{Version 2.2, June 1988}
    \hbox{\vbox{\hsize\the\hsize This work is
   protected as an unpublished work under U.S. copyright laws.
   Copyright $\copyright$ 1986 by WSUCSC.  All rights Reserved.}}
   \vskip18pt
    \hbox{\vbox{\hsize\the\hsize This software is furnished under a
    license for
    use only on a single computer system and may be copied only
  with the inclusion of the above copyright notice.
 This software, or any other copies
 thereof, may not be provided or otherwise made available to any
 other person except for use on such system and to one who agrees to
 these license terms.  Title to and ownership of the software shall
 at all times remain in WSUCSC.}}
    \vfill}
 
@* Introduction.
This program takes a \TeX\ DVI file and converts it into CG 8600
Universal Slave Mode commands. Five bytes have been added to each
record. These five bytes are stripped off by the Datum 5095 tape
drive as it passes the file onto the 8600.
 
The \TeX 8600 program is written in WEB. You will need the TANGLE
and WEAVE programs to make changes. The WEB code was written
originally for IBM Pascal/VS on VM/CMS.
 
If you have a CG font that is not one of the ones on the \TeX 8600
distribution tape, you need to modify the SAMPLE.FONTINFO file for
that font and process it through FONTTEX.
 
@ Following are a  few macros and definitions used throughout program:
 
@d incr(#) == # := # + 1
@d decr(#) == # := # - 1
@d do_nothing == begin; end
@d ccat==@=||@>
@f static == var
@f value == var
 
@ The beginning of the program.
 
@p program tex8600(dumpout,sysprint,addrline,setfile,cgfonts,infofile);
const
@<Global Constants@>@/
type
@<Global Types@>@/
var
@<Global Variables@>@/
static@/
@!com_table       :packed array[0..18] of string(7);@/
value@/
    com_table[0] := 'HDR';    {Header Record}@/
    com_table[1] := 'CHWIDTH';{Character Width}@/
    com_table[2] := 'RT';     {Reverse Type}@/
    com_table[3] := 'PS';     {Point Size}@/
    com_table[4] := 'SS';     {Set Size}@/
    com_table[5] := 'VMF';    {Vertical Move Forward}@/
    com_table[6] := 'VMR';    {Vertical Move Reverse}@/
    com_table[7] := 'RW';     {Rule Width}@/
    com_table[8] := 'RD';     {Rule Depth}@/
    com_table[9] := 'IR';     {Insert Rule}@/
    com_table[10] := 'SL';    {Slant Mode}@/
    com_table[11] := 'RTWT';  {Reverse Type Window Top}@/
    com_table[12] := 'RTWB';  {Reverse Type Window Bottom}@/
    com_table[13] := 'AU';    {Auxiliary Character Set}@/
    com_table[14] := 'F';     {Change Fonts}@/
    com_table[15] := 'HMR';   {Horizontal Move Right}@/
    com_table[16] := 'HML';   {Horizontal Move Left}@/
    com_table[17] := 'TTS';   {8600 character, in decimal}@/
    com_table[18] := 'MAXCMD';@/
@<CMS Includes@>
 
@ This is a collection of arrays for converting ASCII to EBCDIC.
 
@<CMS Includes@>=
@{This is a very long comment. It is designed to force a break@}
%include pasclib(asciicvt);
 
@ This is a collection of arrays for converting ASCII to EBCDIC.
 
@<CMS Includes@>=
@{This is a very long comment. It is designed to force a break@}
%include cms;
@{This is a very long comment. It is designed to force a break@}
 
@* Beginning section.
This section includes some basic functions for reading the DVI file
as well as a couple of procedures, like error and allcaps. Nothing
tricky or noteworthy in these.
 
@<Global Variables@>=
@!count : integer;
@!fileend :boolean;
 
@ The function for reading a byte of information from the DVI file.
 
@p function getbyte:integer;
var c    :integer;
    byte :char;
begin
    read(byte);
    getbyte := ord(byte);
    c := count mod pv_dvi_lrecl;
    if (c=(pv_dvi_lrecl-1)) and not (eof(input))
         then get(input)
         else if (c=(pv_dvi_lrecl-1)) and eof(input)
              then fileend:=true;
    end;
 
@ This is necessary because tangle doesn't let us get away with
using RETCODE by itself in more than one spot.
 
@p procedure setretcode(rc:integer);
begin retcode(rc); end;
 
@  This converts the byte to an integer, for further evaluation by
the program.
 
@p function readinteger(length :integer):integer;
var
    inx       :integer;
    int       :integer;
begin
    if (length<1) or (length>4)
         then begin;
              trace(output);
              halt;
              end;
    int:=0;
    for inx := 1 to length do begin
         int := int * 256 + getbyte;
                          {check for cvt to negative...}
         if (inx = 1) and (length > 1) and (int >= 128)
              then int := int - 256;
         incr(count);
         end;
    readinteger := int;
    end;      {readinteger}
 
@ This function receives an integer value and converts it to its
hex value and returns that value as a string.
 
@^system dependencies@>
@p function hex(int   :integer) :string(2);
var
    i              :integer;
    j              :integer;
    stri           :string(2);
static
    hexarray       :array[0..15] of string(1);
value
    hexarray[0]  := '0';
    hexarray[1]  := '1';
    hexarray[2]  := '2';@/
    hexarray[3]  := '3';
    hexarray[4]  := '4';
    hexarray[5]  := '5';@/
    hexarray[6]  := '6';
    hexarray[7]  := '7';
    hexarray[8]  := '8';@/
    hexarray[9]  := '9';
    hexarray[10] := 'A';
    hexarray[11] := 'B';@/
    hexarray[12] := 'C';
    hexarray[13] := 'D';
    hexarray[14] := 'E';
    hexarray[15] := 'F';
begin
    stri := '';
    i := int;
    if i >= 16
         then begin
              j := i div 16;
              stri := hexarray[j];
              i := i - (j * 16);
              end
         else stri := '0';
    stri := stri  ccat hexarray[i];@/
    hex := stri;
    end;
 
@
@<Global Variables@>=
@! savecount :integer;
@^system dependencies@>
@! filename  :string(8);
@^system dependencies@>
@! errstr :string(256);
 
@ The error procedure. When a byte is read that does not jive with
what the program was expecting, it goes to this procedure with a
return code of some kind and an appropriate message is printed to user.
 
@p procedure error(number  :integer;
                critical:boolean;
                intval  :integer);
begin
    case number of
    1    :writeln('Error in file ',filename,', no header record');
    2    :writeln('Error in file ',filename,', the highest 8600 ',
                  'command has a value of ',ord(MAXCMD):3,' but ',
                  intval,' was read instead');
    3    :writeln('Expected a font command and got "',
                  com_table[intval],'" instead');
    4    :writeln('Expected a character width definition and got "',
                  com_table[intval],'" instead in file ',filename);
    5    :writeln('File ',filename,' is out of order for character ',
                  intval:3,' (',chrx[intval],')');
    6    :writeln('Error in file ',filename,', the value of byte ',
                  intval,' is >= 218 and <= 255 at byte ',savecount);
    7    :writeln('Expected a Slantmode command and got ',
                  com_table[intval],' instead');
    10   :writeln('No address information given');
    28   :writeln('Unidentified input option "',errstr,'"');
    otherwise writeln('Unidentified error ',number);
    end; {case}
    if critical then begin
         writeln('TeX8600 run aborted; See your consultant');
         trace(output);
         halt;
         end;
    writeln('Tape will not be sent to operator');
    setretcode(32);
    end; {error}
 
@ Finally, a function that will convert whatever is passed to it into
all capital letters. It translates lower case letters into upper case
letters.  All  other  characters   outside   of   the   range
a$<$=character$<$=z are returned as their original value.
 
@^system dependencies@>
@p function allcaps(instring    :string(40))   :string(40);
var
    i              :integer;
    character      :char;
    buildit        :string(40);
static@/
    chtable        :packed array['81'xc..'e9'xc] of char;@/
value@/
    chtable['81'xc] := 'A';
    chtable['82'xc] := 'B';
    chtable['83'xc] := 'C';
    chtable['84'xc] := 'D';@/
    chtable['85'xc] := 'E';
    chtable['86'xc] := 'F';
    chtable['87'xc] := 'G';
    chtable['88'xc] := 'H';@/
    chtable['89'xc] := 'I';
    chtable['91'xc] := 'J';
    chtable['92'xc] := 'K';
    chtable['93'xc] := 'L';@/
    chtable['94'xc] := 'M';
    chtable['95'xc] := 'N';
    chtable['96'xc] := 'O';
    chtable['97'xc] := 'P';@/
    chtable['98'xc] := 'Q';
    chtable['99'xc] := 'R';
    chtable['a2'xc] := 'S';
    chtable['a3'xc] := 'T';@/
    chtable['a4'xc] := 'U';
    chtable['a5'xc] := 'V';
    chtable['a6'xc] := 'W';@/
    chtable['a7'xc] := 'X';
    chtable['a8'xc] := 'Y';
    chtable['a9'xc] := 'Z';
begin
    buildit := '';
    for i := 1 to length(instring) do begin
         readstr(substr(instring,i,1),character);
         if character in ['a'..'z']
              then buildit := buildit  ccat str(chtable[character])
              else buildit := buildit  ccat str(character);
         end;
    allcaps := buildit;
    end;
 
@* Font Related Procedures.
This first font procedure reads the font matrix information for the
current font from an outside file called cginfo defined as cgfonts.
 
@<Global Constants@>=
@!    maxfunctions = 15;@/
@!    maxChar=127;@/
@!    fatal = true;@/
@!    fontsperrun = 76;@/
@!    maxFont=256;@/
 
@
@<Global Types@>=
@!    oneoftwo = packed 1..2;
    command        = (HDR,CHWIDTH,RT,PS,SS,VMF,VMR,RW,RD,IR,SL,
                      RTWT,RTWB,AU,F,HMR,HML,TTS,MAXCMD);@/
@!    storerec = packed record
         comcode    :packed -128..127;
         case oneoftwo of
         1    :(argument       :integer);
         2    :(real_argument  :shortreal);
         end;
@!    charrec = packed record
         num            :-1..maxfunctions;
         charwidth      :shortreal;
         comarray   :packed array[0..maxfunctions] of storerec;
         end;
@!    driverrec      = record
         cmd       :integer;
         case oneoftwo of
              1      :(param  :shortreal);
              2      :(code   :integer);
         end;
@!    font_def       = packed record
        pointsize    : 0..255;
        designsize   : 0..255;
        fontindex    : 0..255;
        end;
@^system dependencies@>
@!    fontrec        = record
        fontno8600   : 0..2550;
        name         : string(8);
        a8600chars   : packed array[0..maxChar] of charrec;
        end;
 
@
@<Global Variables@>=
@!currfont : -1..maxFont;
@!a8600fontrec : packed array[1..fontsperrun] of fontrec;
@!fontcode : driverrec;
@^system dependencies@>
@!fontname : string(8);
@!dumpin : boolean;
@!fontenviron : packed array[-1..maxFont] of font_def;
 
@ A new font is being used so it must have its font metrics read; this
procedure does just that.
 
@p procedure readfontinfo(fontnum,a8600index:integer);
var
    auxiliary      :boolean;
    cgfonts        :file of driverrec;
    changefont     :boolean;
    charmult       :shortreal;
    i,j,rc,
    numcommands    :integer;
begin
 @<open cginfo file@>
 @<read beginning info@>
 @<read character info@>
 @<close cginfo file@>
end;
 
@ First open the cginfo file
 
 @<open cginfo file@>=
  fontenviron[fontnum].fontindex := a8600index;
  a8600fontrec[a8600index].name:= fontname;
  cms('ESTATE 'ccat fontname ccat ' CGINFO *',rc);
  if rc = 0
    then reset(cgfonts,'NAME='  ccat fontname  ccat '.CGINFO.*')
    else begin
       reset(cgfonts,'NAME=ETR.CGINFO.*');
       writeln('Error!! Font ',fontname,' is not on the 8600');
       writeln('You will not be able to continue');
       setretcode(8);
       end;
 
@ Now read the first few records that give overall font info.
 
 @<read beginning info@>=
    fontcode := cgfonts@@;{Read the first record of the file}
    get(cgfonts);@/
    with fontcode do begin
         if cmd <> ord(HDR) then error(1,fatal,0);
         if code <> ord(MAXCMD) then error(2,fatal,code);
         end; {with..begin}
    fontcode := cgfonts@@; {read the second record of the file}
    get(cgfonts);@/
    with fontcode do begin
         if cmd <> ord(F) then error(3,fatal,cmd); {Must be font cmnd}
  a8600fontrec[a8600index].fontno8600 := code;
         end; {with..begin}
    fontcode := cgfonts@@;
    get(cgfonts);
    with fontcode do begin
         if cmd <> ord(CHWIDTH) then error(4,fatal,cmd); {charac mult}
         charmult := param;
         end; {with..begin}
              {Each character (maxChar) has one header record (HDR)
               and one character width record. The number of records
               for each character that follows the width record is
               contained as "code" in the header record. Each
               character will have at least one record.}
    fontcode := cgfonts@@; {slantmode option no longer used}
    get(cgfonts);
    with fontcode do begin
         if cmd <> ord(SL) then error(7,fatal,cmd);
         end;
    if dumpin
        then with a8600fontrec[fontenviron[fontnum].fontindex]
          do begin
           writeln(dumpout,
           '          The character width multiplier for ',
                      filename,' is ',charmult:5:2);
           writeln(dumpout,
           '          The 8600 font number is ',fontno8600:3);
           end;
 
@ The individual character heights, depths, widths and positions
come next.
 
 @<read character info@>=
    for i := 0 to maxChar do begin
         with a8600fontrec[a8600index].a8600chars[i]
do begin
              fontcode := cgfonts@@;
              get(cgfonts);
              with fontcode do begin
                   if cmd <> ord(HDR) then error(5,fatal,i);
                   numcommands := code; {number for this character}
                   end; {with..begin}
              num := -1;
              @<read character width@>
              auxiliary := false;
              changefont := false;
              for j := 0 to numcommands do begin
              @<read next command@>
                   end;
              if auxiliary then begin
                   @<Auxiliary change@>
                   end;
              if changefont then begin
                   @<Font change@>
                   end;
              end;
         end;
 
@ Font is all read and safely tucked into appropriate places to
be used later, so close the door and shut off the lights on the
way out.
 
 @<close cginfo file@>=
    close(cgfonts);
 
@
  @<read character width@>=
  fontcode := cgfonts@@; {read the character width}
  get(cgfonts);
  with fontcode do begin
      if cmd <> ord(CHWIDTH) then error(5,fatal,i);
      charwidth := param * charmult;
      end; {with..begin}
 
@
  @<read next command@>=
  fontcode := cgfonts@@;
  get(cgfonts);
  num := num + 1; {increment number of commands}
  with fontcode, comarray[num] do begin
       if ((cmd >= 5) and (cmd <= 8)) or
          (cmd = 11) or (cmd = 12) or (cmd = 16)
          then real_argument := param
          else argument := code;
          case cmd of
              2  :comcode := 3; {reverse type}
              3  :comcode := 7; {Point Size Change}
              4  :comcode := 8; {Set Size Change}
              5  :comcode := 9; {Vertical Move Forward}
              6  :comcode := 10; {Vertical Move Reverse}
              7  :comcode := 12; {Rule Width}
              8  :comcode := 13; {Rule Depth}
              9  :comcode := 14; {Insert Rule}
              10  :comcode := 15; {Slant Mode}
              11  :comcode := 16; {Reverse Window Top}
              12  :comcode := 17; {Reverse Window Bot}
              13  :begin
                     @<Change to Auxiliary Characters@>
                   end;
              14  :begin
                     @<Change Font@>
                     end;
              15  :comcode := 27; {Horiz. Move Right}
              16  :comcode := 28; {Horiz. Move Left}
              17  :comcode := -1; {Decimal Char Code}
              otherwise begin
                     @<Invalid Command Number@>
                     end;
              end;
       end;
 
@
 @<Auxiliary change@>=
 num := num + 1;
 with comarray[num] do begin
     comcode := 20;
     argument := 1;
     end;
 
@
 @<Font change@>=
 num := num + 1;
 with comarray[num] do begin
     comcode := 25;
     argument := -1; {for quick ID in font changes}
     end;
 
@
 @<Change to Auxiliary Characters@>=
 comcode := 20;
 if auxiliary
 then begin
      argument := 1;
      auxiliary := false;
      end
 else begin
      argument := 2;
      auxiliary := true;
      end;
 
@
 @<Change Font@>=
 comcode := 25;
 if code <> fontnum
    then changefont := true;
 argument := code * 10;
 
@
  @<Invalid Command Number@>=
  writeln('Invalid 8600 Command Number ', cmd);
  error(5,fatal,cmd);
 
@ This procedure checks to see if the current font has been
  previously defined. If it has, it returns to the main program,
  if it hasn't, |readfontinfo| is called.
 
@p procedure checkfont;
var
    i              :integer;
static
    in_count       :integer;
value
    in_count      := 0;
begin
@<check fonts@>
readfontinfo(currfont,in_count);
    end;
 
@ Each time a font is encountered in the DVI file, one is added to
the |in_count|. The following section checks to see if the |curr_font|
has ever been used before in this file. If it has, nothing is done and
it returns to main program. If it is a new file, it continues on in
procedure to read the new font metrics.
 
@<check fonts@>=
    incr(in_count);
    for i := 1 to in_count do begin
       if a8600fontrec[i].name = fontname
          then begin
             fontenviron[currfont].fontindex := i;
             return;
             end;
        end;
 
@ This procedure reads the DVI file to get all pertinent information
for the |MAIN| program.
 
@<Global Constants@>=
@!  SPsPerPt = 65536;@/
@!  pc_dvi_lrecl=1024;
 
@
@<Global Variables@>=
@!checksumtest : integer;
@!pv_dvi_lrecl :integer;
 
@
@p procedure fontinfo;
var
   fnlength : integer;
   temp : integer;
   temp2 : integer;
   inx : integer;
begin
   with fontenviron[currfont] do begin
        checksumtest := readinteger(4);{check sum}
        temp := readinteger(4);{scale}
        temp2:= readinteger(4);{design size}
        pointsize := temp2 * (temp div temp2) div SPsPerPt;
        designsize := temp2 div SPsPerPt;
        end; {WITH..begin}
   temp := readinteger(1);{font name area}
   fnlength := readinteger(1);{file length}
   fnlength := fnlength + temp;
   fontname := '';
   for inx := 1 to fnlength do begin
        temp := readinteger(1);
        fontname := fontname  ccat allcaps(str(chrx[temp]));
        end;
   checkfont;
end;
 
@* Tape-writing functions and procedures.
These next few functions and procedures prepare or write information
to a tape file
 
@  This function converts an integer to a string or something like that
 
@^system dependencies@>
@p function strconv(intnum : integer): string(5);
var
    hdrec          :string(5);
    j              :integer;
    k10            :integer;
    temphdr        :integer;
begin
    hdrec := '';
    k10 := 10000;
    temphdr := intnum;
    repeat
         if temphdr >= k10 then begin
              j := temphdr div k10;
              hdrec := hdrec  ccat str(chr(j + ord('0')));
              temphdr := temphdr - (j * k10);
              end;
         k10 := k10 div 10;
         until k10 = 1;
    hdrec := hdrec  ccat str(chr(temphdr + ord('0')));
    if length(hdrec) < 5
         then hdrec := substr('00000',1,5-length(hdrec))  ccat hdrec;
    strconv := hdrec;
    end;
 
@ This procedure is to add the 5 bytes at the beginning
  of each record that will be read by the 5095 tape
  drive. It should be noted that these 5 bytes are
 discarded by the 5095 before it sends the rest of the record to the 8600.
 
@<Global Constants@>=
@!  maxbuffer = 1029;@/
 
@
@<Global Variables@>=
@!doingpages : boolean;
@!setfile : text;
@!dumpout : text;
@!bufferlen : 0..maxbuffer;
@!headernum : integer;
 
@
@p procedure writeheader; {only needed when using Datum 5095}
var
    hdrec               :string(5);
begin
    if doingpages = true
    then begin
       hdrec := strconv(headernum);
       write(setfile,hdrec);
       bufferlen := 5;
       end; {then..begin}
    end; {writeheader}
 
@
@<Global Constants@>=
@!  allzeros = '00'xc;@/
 
@
@<Global Variables@>=
@!postam_found : boolean;
 
@ This procedure is used to write the tape file for the  5095
drive on the 8600
 
@p @^system dependencies@>
procedure write8600rec(codes      :string(17));
var
    i              :integer;
    codesize       :integer;
begin
    codesize := length(codes);
    if doingpages=true
    then begin
      if bufferlen + codesize < maxbuffer
         then begin
              @<record length less than maximum@>
              end {then..begin}
         else if bufferlen + codesize = maxbuffer
              then begin
              @<record length equal to maximum@>
                   end  {then..begin}
              else begin
              @<record length greater than maximum@>
                   end; {else..begin}
       end; {then..begin}
    end; {write8600rec}
 
@
 @<record length less than maximum@>=
 write(setfile,codes);
 bufferlen := bufferlen + codesize;
 if postam_found then begin
     while bufferlen < maxbuffer do begin
         write(setfile,allzeros);
         codesize := length(allzeros);
         bufferlen := bufferlen + codesize;
         end; {while..begin}
     end; {then..begin}
 
@
 @<record length equal to maximum@>=
 writeln(setfile,codes);
 if not postam_found then writeheader;
 
@
 @<record length greater than maximum@>=
 i := maxbuffer - bufferlen;
                   writeln(setfile,substr(codes,1,i));
                   writeheader;
                   write(setfile,substr(codes,i+1,codesize-i));
                   bufferlen := bufferlen + codesize - i;
                   if postam_found then begin
                      while bufferlen < maxbuffer do begin
                         write(setfile,allzeros);
                         codesize := length(allzeros);
                         bufferlen := bufferlen + codesize;
                         end; {while..begin}
                      end; {then..begin}
 
@
@<Global Variables@>=
@!print_hmove : boolean;
 
@ This function,
given amount in scale points, converts it to floating-point
points and print it.
 
@p function getpts(amt    :integer)  :real;
var
    temp           :real;
begin
    temp := float(amt) / SPsPerPt;
   if dumpin and print_hmove then write(dumpout,temp:4:1,' pts.');
    getpts := temp;
    end;
 
@* Main tape-writing procedures.
These next few procedures are the main ones for writing information
to the tape file.
 
@
@<Global Constants@>=
@!    high1 = '8000'@&x;@/
@!    SPsPer8th = 8192;@/
@!    SPsPer18th = 3640.8888;@/
 
@
@<Global Type...@>=
@!    valrec = packed record case oneoftwo of
         1         :(hexcode      :char;
                     argument     :packed -32768..32767);
         2         :(byte1        :packed 0..255;
                     byte2        :packed 0..255;
                     byte3        :packed 0..255)
         end;
@!    stackrec = packed record
         H         :integer;
         V         :integer;
         W         :integer;
         X         :integer;
         Y         :integer;
         Z         :integer;
         end;
 
@
@<Global Variables@>=
@!stack : packed array[1..50] of stackrec;
@!stacktop : integer;
@!outrec : valrec;
@!in_reverse_type : boolean;
@!in_slant_mode  : boolean;
 
@ This procedure is called to format the output record
  in a 1 or 3 byte word to be added to the 8600 output
  record buffer. Each command used by the slave mode
  is represented here by their appropriate code number
  assigned by Compugraphics. The code "-1" was not
  assigned by them. It was assigned to denote the use
   of a character in the current font.
 
@p @^system dependencies@>
procedure writecommand(codenum    :integer;
                       inargument :real);
var
    temp           :string(3);
    realtemp       :real;
begin
    with outrec do begin
         case codenum of
         -2 :@<long character form@>@/
         -1 :@<individual character code@>@/
          0 :@<start of take@>@/
          1 :@<end of take@>@/
          2 :@<change reverse type@>@/
          7 :@<change point size@>@/
          8 :@<change set size@>@/
          9 :@<forward vertical move@>@/
         10 :@<reverse vertical move@>@/
         11 :@<absolute horizontal positioning@>@/
         12 :@<rule width@>@/
         13 :@<rule depth@>@/
         14 :@<insert rule@>@/
         15 :@<slant mode@>@/
         16 :@<reverse type window top@>@/
         17 :@<reverse type window bottom@>@/
         20 :@<change auxiliary character set@>@/
         25 :@<change fonts@>@/
         27 :@<right horizontal move@>@/
         28 :@<left horizontal move@>@/
         otherwise @<all other cases@>
              end; {case}
         byte2 := byte2 + '10000000'B;
         temp := str(chr(byte1)) ccat
                 str(chr(byte2)) ccat str(chr(byte3));
         write8600rec(temp);
         end; {with..begin}
    end;      {writecommand}
 
@
@<long character...@>=
  begin
  hexcode := chr(trunc(inargument)+high1);
  argument := round(getpts(stack[stacktop].H) * 18);
  temp := str(chr(byte1))  ccat str(chr(byte2));
  temp := temp  ccat str(chr(byte3));
  write8600rec(temp);
  return;
  end;
 
@
@<individual character code@>=
              begin
                       {change inargument into a one character
                        string (hex) value}
                   argument := trunc(inargument);
                   write8600rec(str(chr(byte3)));
                   return;
                   end;
@
@<start of take@>=
               begin
                   hexcode := '80'xc;
                   argument := trunc(inargument);
                   end;
 
@
@<end of take@>=
               begin
                   hexcode := '81'xc;
                   argument := trunc(inargument);
                   end;
 
@
@<change reverse type@>=
               begin
                   if not in_reverse_type and (inargument = 0)
                        then return; {8600 warning if you try to
                                      turn it off when its already off}
                   if inargument = 0
                        then in_reverse_type := false
                        else in_reverse_type := true;
                   if in_reverse_type then begin
                        realtemp :=     {76\% of the current leading}
                          (fontenviron[currfont].pointsize + 2)*0.76;
                        writecommand(16,realtemp); {window top}
                        realtemp :=     {30\% of the current leading}
                          (fontenviron[currfont].pointsize + 2)*0.30;
                        writecommand(17,realtemp); {window bottom}
                        end; {then..begin}
                   hexcode := '83'xc;
                   argument := trunc(inargument);
                   end;
 
@
@<change point size@>=
               begin
                   hexcode := '87'xc;
                   argument := round(inargument*2) * 4; {in eighths}
                   end;
 
@
@<change set size@>=
               begin
                   hexcode := '88'xc;
                   argument := round((fontenviron[currfont].pointsize*
                        (inargument/100.0)) * 2) * 4; {in eighths}
                   end;
 
@
@<forward vertical move@>=
               begin
                   if inargument = 0 then return; {0 invalid on 8600}
                   hexcode := '89'xc;
                             {in sixteenths}
                   argument := round(inargument / SPsPer8th) * 2;
                   end;
 
@
@<reverse vertical move@>=
              begin
                   if inargument = 0 then return; {0 invalid on 8600}
                   hexcode := '8a'xc;
                             {in sixteenths}
                   argument := round(inargument / SPsPer8th) * 2;
                   end;
 
@
@<absolute horizontal positioning@>=
              begin
                   hexcode := '8b'xc;
                             {eighteenths}
                   if inargument < -72.27 then begin
                        if dumpin then writeln(dumpout,
                                            '  HP less than zero');
                        inargument := 0;
                        end;
                   argument := round(inargument / SPsPer18th);
                   end;
 
@
@<rule width@>=
              begin
                   if inargument = 0 then return; {0 invalid on 8600}
                   hexcode := '8c'xc;
                   argument := round(inargument * 18);
                   end;
 
@
@<rule depth@>=
              begin
                   if inargument = 0 then return; {0 invalid on 8600}
                   hexcode := '8d'xc;
                   argument := round(inargument * 8) * 2;
                   end;
 
@
@<insert rule@>=
              begin
                   hexcode := '8e'xc;
                   if inargument < 0 then begin
                        if dumpin then writeln(dumpout,
                                     '  IR less than zero');
                        inargument := 0;
                        end;
                   argument := round(inargument / SPsPer18th);
                   end;
 
@
@<slant mode@>=
              begin
                   hexcode := '8f'xc;
                   argument := trunc(inargument);
                   if argument = 0
                        then in_slant_mode := false
                        else in_slant_mode := true;
                   end;
 
@
@<reverse type window top@>=
              begin
                   hexcode := '90'xc;
                   argument := round(inargument*8) * 2; {in sixteenths}
                   end;
 
@
@<reverse type window bottom@>=
              begin
                   hexcode := '91'xc;
                   argument := round(inargument*8) * 2; {in sixteenths}
                   end;
 
@
@<change auxiliary character set@>=
              begin
                   hexcode := '94'xc;
                   argument := trunc(inargument);
                   end;
 
@
@<change fonts@>=
              begin
                   hexcode := '99'xc;
                   argument := trunc(inargument);
                   end;
 
@
@<right horizontal move@>=
              begin
                   if inargument = 0 then return; {if no move}
                   hexcode := '9b'xc;
                             {eighteenths}
                   argument := round(inargument / SPsPer18th);
                   end;
 
@
@<left horizontal move@>=
              begin
                   if inargument = 0 then return; {if no move}
                   hexcode := '9c'xc;
                             {eighteenths}
                   argument := round(inargument / SPsPer18th);
                   end;
 
@
@<all other cases@>=
               begin
                   writeln('Invalid 8600 command code = ',codenum);
                   error(5,fatal,codenum);
                   end; {otherwise}
 
@* Billing and identification information procedures.
 
@ The first procedure is the one that writes out all the resource-type
information. It first checks to see if the character it is about to
write out is one of several special characters, if it is the hex code
is changed.
 
@^system dependencies@>
@p procedure writeinfo(info:string(30));
   var
     inx : integer;
   begin
     for inx := 1 to length(info)
        do begin
           if info[inx] = ' '
              then write8600rec('1F'xc)
              else if info[inx] = '('
                 then write8600rec('3A'xc)
              else if info[inx] = ')'
                 then write8600rec('3B'xc)
              else if info[inx] = '*'
                 then write8600rec('5C'xc)
              else if info[inx] = '_'
                 then begin
                    writecommand(20,2); {aux. char. set}
                    write8600rec('50'xc);
                    writecommand(20,1); {back to primary}
                    end {then..begin}
             else write8600rec(str(chr(ordx[info[inx]])));
           end; {do..begin}
     end; {writeinfo}
 
@
@<Global Variables@>=
@^system dependencies@>
@!job_len_conv : string(5);
@!job_length : integer;
@^system dependencies@>
@!parmvalue : string(80);
@^system dependencies@>
@!pages_conv : string(5);
@!pages_set  : integer;
@!galley_length : real;
@^system dependencies@>
@!real_filename : string(8);
 
@ The following procedure writes the information within the accounting
box at the end of each job.
 
@p @^system dependencies@>
    procedure setaccountbox (infoname       :string(30);
                             infophone      :string(14);
                             infodelivery   :string(8);
                             infozip        :string(10);
                             infobin        :string(8);
                             infoid         :string(22));
    var
       inx            :integer;
    begin
     @<set constant values@>@/
     @<draw accounting box@>@/
     @<write name in box@>@/
     @<write phone number in box@>@/
     @<write delivery method in box@>@/
     @<write zipcode in box@>@/
     @<write center bin in box@>@/
     @<write user id in box@>@/
     @<write job length in box@>@/
     @<write file name in box@>@/
     @<write number of pages set, in box@>@/
     @<write tape number in box@>@/
         galley_length := galley_length + 140;
    end; {setaccountbox}
 
@
@<set constant...@>=
       different_setsize := false;
       in_slant_mode := false;
       in_reverse_type := false;
 
@
@<draw account...@>=
       writecommand(12,410);          {rule width in points}
       writecommand(13,8);            {rule depth in points}
       writecommand(14,0);            {set top rule}
       writecommand(12,8);            {rule width in points}
       writecommand(13,84);           {rule depth in points}
       writecommand(14,402*SPsPerPt); {set left rule}
       writecommand(14,0);            {set right rule}
       writecommand(9,83.8*SPsPerPt); {VMF to bottom in pts}
       writecommand(12,410);          {rule width in points}
       writecommand(13,8);            {rule depth in points}
       writecommand(14,0);            {set bottom rule}
       writecommand(11,32*SPsPerPt);  {32pt indent}
       writecommand(10,56*SPsPerPt);  {Move back up}
       writecommand(25,320);          {define bold font}
       writecommand(7,11);            {11pt size}
 
@
@<write name...@>=
       write8600rec('4e616d65231e'xc); {'Name: '}
       writecommand(25,330);           {change to Bold Ital}
       writeinfo(infoname);
       writecommand(11,265*SPsPerPt);  {265pt Indent}
       writecommand(25,320);           {Bold}
 
@
@<write phone...@>=
       write8600rec('50686f6e65231e'xc); {'Phone: '}
       writecommand(25,330);             {Bold Italic}
       writeinfo(infophone);
 
@
@<write delivery meth...@>=
         writecommand(11,50*SPsPerPt);   {50pt indent}
         writecommand(9,16*SPsPerPt);    {VMF 16pt}
         writecommand(25,320);           {Bold}
         write8600rec('44656c6976657279231e'xc);  {'Delivery: '}
         writecommand(25,330);           {Bold Italic}
         writeinfo(infodelivery);
 
@
@<write zipcode...@>=
         if infozip <> 'NA'
               then begin
                  writecommand(11,190*SPsPerPt);   {190pt indent}
                  writecommand(25,320);            {Bold}
                  write8600rec('5a6970636f6465231e'xc);  {'Zipcode: '}
                  writecommand(25,330);            {Bold Italic}
                  writeinfo(infozip);
                  end;
 
@
@<write center...@>=
         if infobin <> 'NA'
               then begin
                  writecommand(11,284*SPsPerPt);   {284pt indent}
                  writecommand(25,320);            {Bold}
                  write8600rec('42696e231e'xc);    {'Bin: '}
                  writecommand(25,330);            {Bold Italic}
                  writeinfo(infobin);
                  end; {then..begin}
 
@
@<write user id...@>=
         writecommand(9,14*SPsPerPt);              {VMF 14pt}
         if infoid <> 'NA'
               then begin
                  writecommand(11,30*SPsPerPt);    {30pt indent}
                  writecommand(25,320);            {Bold}
                  write8600rec('4944231e'xc);      {'ID: '}
                  writecommand(25,330);            {Bold Italic}
                  writeinfo(infoid);
                  end; {then..begin}
@
@<write job length...@>=
         writecommand(11,250*SPsPerPt);      {indent for job length}
         writecommand(25,320);               {BOLD}
         write8600rec('4a6f621e'xc);         {'Job '}
         write8600rec('4c656e677468231e'xc); {'Length: '}
         writecommand(25,330);               {Bold Italic}
         job_len_conv := strconv(job_length);
               for inx := 1 to 5
                  do write8600rec(str(chr
                      (ordx[job_len_conv[inx]])));
         write8600rec('1e696e63686573'xc);   {' inches'}
         writecommand(11,20*SPsPerPt);       {get ready for DSN}
 
@
@<write file name...@>=
         writecommand(9,16*SPsPerPt);   {VMF 16pt}
         writecommand(25,320);          {Bold}
         write8600rec('46696c656e616d65231f'xc);  {'Filename: '}
         writecommand(25,330);          {Bold Italic}
         parmvalue := real_filename;
         writeinfo(parmvalue);
 
@
@<write number of...@>=
         writecommand(11,155*SPsPerPt);   {155pt indent}
         writecommand(25,320);            {Bold}
         write8600rec('50616765731e'xc);  {'Pages '}
         write8600rec('536574231e1e'xc);  {'Set: '}
         writecommand(25,330);            {Bold Italic}
         pages_conv := strconv(pages_set);
               for inx := 1 to 5
                  do write8600rec(str(chr(ordx
                      [pages_conv[inx]])));
         writecommand(11,265*SPsPerPt);   {get ready for Tape \#}
 
@
@<write tape numb...@>=
         writecommand(25,320);            {Bold}
         write8600rec('546170651e'xc);    {'Tape '}
         writecommand(20,2);              {aux. char. set}
         write8600rec('72'xc);              {'\#'}
         writecommand(20,1);              {pri. char. set}
         write8600rec('231e1e1e1e'xc);      {': '}
         postam_found := true;
         writecommand(25,330);            {bold italic}
 
 
@ The information procedure reads the billing information from an outside
file called the |addrfile|, and sends that information to the
|setaccountbox| procedure. It also writes the information to another file
called the |infofile|.
 
@<Global Constants@>=
@!    notfatal = false;@/
 
@
@<Global Variables@>=
@!addrline : text;
@!infofile : text;
@^system dependencies@>
@!resource_info : string(256);
@^system dependencies@>
@!str1 : string(256);
@^system dependencies@>
@!str2 : string(256);
@!minimum_width  : integer;@/
 
@
@p @^system dependencies@>
procedure information;
    var
       int            :integer;
       inx            :integer;
       infoname       :string(30);
       infophone      :string(14);
       infodelivery   :string(10);
       infozip        :string(10);
       infobin        :string(8);
       infoid         :string(22);
       infoprocedure  :string(4);
       infobudget     :string(20);
       tempbool       :boolean;
 begin
  @<set initial values for strings@>
  @<open address file and read and close@>@/
  @<parse info from address file@>
  @<send info to accounting procedure and write infofile@>
 end; {information}
 
@
@<set initial values...@>=
    infozip := 'NA';
    infoid := 'NA';
    infobin := 'NA';
    infoprocedure := 'NA';
    infobudget := 'NA';
 
@
@<open address...@>=
    termin(addrline);
    readln(addrline,resource_info);
    close(addrline);
 
@
@<parse info...@>=
    rewrite(infofile,'NAME='  ccat filename  ccat '.INFOFILE.*');
    while length(resource_info) > 0 do begin
        inx := index(resource_info,':');
        if inx < 1
           then begin
                errstr := resource_info;
                error(28,notfatal,0);
                end
           else begin
                str1 := substr(resource_info,1,inx-1);
                resource_info := ltrim(substr(resource_info,inx+1));
                inx := index(resource_info,':');
                if inx = 0
                   then begin
                        str2 := resource_info;
                        resource_info := '';
                        end
                   else begin
                        int := inx - 1; {no sense starting at a colon:}
                        tempbool := false;
                        repeat
                          if substr(resource_info,int,1) = ' '
                               then tempbool := true
                               else int := int - 1;
                          until tempbool; {which means we found a blank}
                        str2 := trim(substr(resource_info,1,int-1));
                        resource_info := substr(resource_info,int+1);
                        end;
                str1 := allcaps(ltrim(trim(str1)));
                str2 := allcaps(ltrim(trim(str2)));
                if str1 = 'NAME' then
                     infoname := str2
                   else if str1 = 'PHONE' then
                     infophone := str2
                   else if str1 = 'PROCEDURE_NUMBER'
                     then infoprocedure := str2
                   else if str1 = 'BUDGET_PROJECT'
                     then infobudget := str2
                   else if str1 = 'PICKUP' then
                     infodelivery := str2
                   else if str1 = 'CAMPUS_ZIP' then
                     infozip := str2
                   else if str1 = 'BIN' then
                     infobin := str2
                   else if str1 = 'ID' then
                     infoid := str2
                   else begin
                          errstr := resource_info;
                          error(28,notfatal,0);
                          end
                end;
                end;
 
@
@<send info...@>=
    setaccountbox(infoname,infophone,infodelivery,infozip,
                  infobin,infoid);
    writeln(infofile,infoname);
    writeln(infofile,infophone);
    writeln(infofile,infoprocedure);
    writeln(infofile,infobudget);
    writeln(infofile,infodelivery);
    writeln(infofile,infozip);
    writeln(infofile,infoid);
    writeln(infofile,infobin);
    writeln(infofile,job_length);
    writeln(infofile,pages_set);
    writeln(infofile,minimum_width);
    writeln(infofile,real_filename);
 
@* End of File procedures.
At the end of the \TeX DVI file is a postamble command, when that
command is encountered |readpostamble| and |post_amble| are called.
 
@ The second procedure called but first listed is the |post_amble|
procedure, it calls the |information| procedure and writes the job
length and number of pages to the terminal.
 
@<Global Variables@>=
@!num_of_pages : integer;
@^system dependencies@>
@!job_type : string(6);
 
@
@p procedure post_amble;
        begin
          @<prepare and write information info@>
          @<give job length to user on terminal@>@/
          @<set final values for galleylength, etc.@>
        end; {Postamble}
 
@
@<prepare and write...@>=
              if dumpin then writeln(dumpout,
                              'PST -- post-amble: End of Run');
              doingpages := true;
              writecommand(11,0);      {Move to left col.}
              writecommand(9,30.0*SPsPerPt);    {VMF 30 pts}
              information;
 
@
@<give job length...@>=
              writeln;
              writeln('Total length of run = ',
                        galley_length:9:1,' pts.');
              writeln('                    = ',
                        galley_length/72.0:9:1,' inches.');
              writeln('                    = ',
                        num_of_pages:9,' pages.');
 
@
@<set final...@>=
              job_length := round(galley_length/72.0);
              pages_set := num_of_pages;
              job_type := 'TeX';
 
@ This second procedure is called first and reads the final job
information for the file. Things like job length, widest page,
tallest page are set and the information sent to |post_amble|.
 
@<Global Variables@>=
@!byte : integer;@/
@!width  : real;@/
@!even_page_margin : real;@/
@!odd_page_margin : real;@/
@!totalpg : integer;@/
 
@
@p procedure readpostamble;
var
    int            :integer;@/
    inx            :integer;@/
begin
    job_length := round(galley_length / 72.0);@/
    pages_set  := num_of_pages;@/
    for inx := 1 to 3 do byte := readinteger(4);
    byte := readinteger(4); {Get magnification}@/
    if dumpin
          then writeln(dumpout,
                   '** Font magnification = ',byte/1000.0:3:1);
    writeln;
    writeln('Tallest page is ',readinteger(4)/SPsPerPt/72.0:2:1,
            ' inches.');
    width := readinteger(4) / SPsPerPt / 72.27;
    width := max(width,put_width,even_page_margin/72.27,
    odd_page_margin/72.27);
    writeln('Widest page is ',width:2:1,' inches.');@/
    width := width + 0.31;   {5/16" on the left that cannot be used.}
    if width < 8.0 then int := 8
              else int := 12;
    minimum_width := int;
    writeln('The smallest paper you can use is ',int:2,'"');
    totalpg := 9999;
    post_amble;
    if galley_length = 0 then begin
       writeln('Error!! No pages set. ');
       setretcode(12);
       end;
    end; {readpostamble}
 
@* Conversion Functions.
The following two functions will convert strings to integers
(|whole_value|) or to real numbers (|decimal_value|).
 
@^system dependencies@>
@p function whole_value(str1 :string(10)) :integer;
var
     inx, inz : integer;@/
     divisor  : real;@/
     number   : real;@/
begin
     number := 0;
     inx := index(str1,'-');
     if inx > 0
         then begin
             divisor := (-1 * 0.1);
             str1 := substr(str1,2);
             end {then..begin}
         else divisor := 0.1;
    for inz := 0 to (length(str1)-1) do begin
        divisor := divisor * 10.0;
        number := number + ((ordx[str1[length(str1) - inz]] -
              ordx['0']) * divisor);
        end;
    whole_value := round(number);
end; {|whole_value|}
 
@
@^system dependencies@>
@p function decimal_value(str2 :string(40)): real;
var
     inx, inz : integer;
     divisor  : real;
     str3     : string(30);
     number   : real;
begin
     number := 0.0;
     inx := index(str2, '.');@/
     @<value with decimal, but nothing to right@>
     @<value with decimal, and something to right@>@/
     @<value without decimal@>
    decimal_value := number;
    end;   {|decimal_value|}
 
@
@<value with decimal, but...@>=
     if inx = length(str2) then begin {read left side of decimal}
         str2 := substr(str2,1,inx-1);
         end
@
@<value with decimal, and...@>=
         else begin
         if inx > 0 then begin
         str3 := substr(str2,inx+1);
             divisor := 1.0;
             for inz := inx+1 to length(str3) do begin
                divisor := divisor * 0.1;
                number := number +
                 (ordx[str3[inz]] - ordx['0'] * divisor);
                end;
         if inx = 1 then return;
        str2 := substr(str2,1,inx-1);
        end;
        end;
 
@
@<value without...@>=
    divisor := 0.1;
    for inz := 0 to (length(str2)-1) do begin
        divisor := divisor * 10.0;
        number := number + ((ordx[str2[length(str2) - inz]] -
              ordx['0']) * divisor);
        end;
@* Parm-reading procedure.
This procedure reads and parses the parameters entered with the
call to this program; it is expecting the following form of some
sort:
 
\centerline{\tt tex8600 fn ft (1stpg \#ofpgs) realfn lrecl}
 
@<Global Variables@>=
@^system dependencies@>
@!filetype : string(8);
@!firstpg : integer;
 
@
@p @^system dependencies@>
procedure readparms;
var
    namepage : string(256);
    temp     : integer;
    temp2    : integer;
    temp3    : integer;
    str1     : string(10);
    lrecl    : string(8);
 
begin
    namepage := ltrim(trim(parms));
    @<file name and real filename@>
    @<file type not supplied@>
    @<file type supplied@>
    end; {readparms}
 
@
    @<file name and real filename@>=
    temp := index(namepage,' ');
    temp2 := index(namepage,')');
    if temp2 > 0
       then @<parse real name and lrecl@>
       else error(10,fatal,0);
    filename := substr(namepage,1,temp-1);
 
@
    @<parse real name and lrecl@>=
       begin
       temp3 := index(substr(namepage,temp2+2),' ');
       if temp3 = 0
        then begin
          real_filename := substr(namepage,temp2 + 2);
          lrecl := '';
          end
        else begin
          real_filename := substr(namepage,temp2 + 2,temp3-1);
          lrecl := substr(namepage,temp2+2+temp3);
          end;
     if lrecl = ''
        then pv_dvi_lrecl := pc_dvi_lrecl
        else readstr(lrecl,pv_dvi_lrecl);
     end
 
@
    @<file type not...@>=
    namepage := substr(namepage,temp+1,(temp2-temp));
    temp := index(namepage,'(');
    if temp = 1
       then begin
          filetype := 'DVI';
          if length(namepage) > 1
             then begin
                namepage := substr(namepage,temp+2);
                temp := index(namepage,' ');
                if temp > 0
                   then begin
                      str1 := substr(namepage,1,temp-1);
                      firstpg := whole_value(str1);
                      str1 := substr(namepage,temp+1);
                      if length(str1) > 0 then
                         totalpg := whole_value(str1);
                      end {then..begin}
                   else begin
                      str1 := substr(namepage,1);
                      firstpg := whole_value(str1);
                      end {ELSE..begin}
                end {then..begin}
          end {then..begin}
 
@
    @<file type supplied...@>=
       else begin
          filetype := substr(namepage,1,temp-2);
          namepage := ltrim(substr(namepage,temp+1));
          temp := index(namepage,')');
          if temp > 1
             then begin
                temp2 := index(namepage,' ');
                str1 := substr(namepage,1,temp2-1);
                if str1='*'
                   then firstpg := -99999
                   else firstpg := whole_value(str1);
                str1 := substr(namepage,temp2+1,(temp-temp2)-2);
                if str1='*'
                   then totalpg := 99999
                   else totalpg := whole_value(str1);
                end; {then..begin}
          end; {ELSE..begin}
 
@* Print Position Procedures.
The next three procedures are called whenever there is to be a
vertical or horizontal move of any kind.
 
@
@<Global Type...@>=
@!movetype = (horiz,vert);
 
@ This procedure will print the horizontal or vertical
  distance that the 8600 is to move the paper.
 
@p procedure figuredir(typ  :movetype;
                   amt  :integer);
var
    temp           :real;
begin
   if dumpin and print_hmove then begin
         writeln(dumpout);
         write(dumpout,'          *** move ');
         end;
    @<horizontal move@>
       @<move right@>
       @<move left@>
    @<vertical move@>
       @<move down@>
       @<move up@>
    if dumpin and print_hmove
         then temp := getpts(abs(amt));
    end; {FigureDir}
 
@
@<horizontal move@>=
   if typ = horiz
      then if amt >= 0
 
@
@<move right@>=
         then begin
              if dumpin and print_hmove then write(dumpout,'right ');
              writecommand(11,stack[stacktop].H);
              end
 
@
@<move left@>=
         else begin
              if dumpin and print_hmove then write(dumpout,'left ');
              writecommand(11,stack[stacktop].H);
              end
 
@
    @<vertical move@>=
         else if amt >= 0
 
@
       @<move down@>=
              then begin
                   if dumpin then write(dumpout,'down ');
                   writecommand(9,amt);
                   end
 
@
       @<move up@>=
              else begin
                   if dumpin then write(dumpout,'up ');
                   writecommand(10,abs(amt));
                   end;
 
@
@<Global Variables@>=
@!hmove_pending : boolean;
@!hmove_amt : integer;
@!vmove_pending : boolean;
@!vmove_amt : integer;
@!length_of_take : real;
 
@ This procedure is invoked in the main program each
  time something is actually to be set (such as a
  character). If there is a vertical or horizontal
  move pending, they will be set here, before continuing
  on to the next set command (such as set character).
 
@p procedure checkmoves;
var
    tempbool       :boolean;
begin
    if hmove_pending then begin
         figuredir(horiz,hmove_amt);
         hmove_amt := 0;
         hmove_pending := false;
         print_hmove := true;
         end; {then..begin}
    if vmove_pending then begin
         figuredir(vert,vmove_amt);
         tempbool := dumpin;
         dumpin := false;
         if doingpages=true
           then begin
             galley_length := galley_length + getpts(vmove_amt);
             length_of_take := length_of_take + getpts(vmove_amt);
             end;
         dumpin := tempbool;
         vmove_amt := 0;
         vmove_pending := false;
         end; {then..begin}
    end;      {checkmoves}
 
@
@<Global Variables@>=
@!font8600 : 0..2550;
@!ptsize : 0..255;
@!different_setsize : boolean;
@!setsize : 0..255;
 
@ This procedure sets the page environment to be that of ``font"
 
@p procedure establish_font_parameters(font  :integer);
begin
   @<new font name@>
   @<new font size@>
   @<new set size@>
end; {|establish_font_parameters|}
 
@
@<new font name@>=
    with a8600fontrec[fontenviron[font].fontindex]
         do begin
            if (fontno8600 <> font8600) and (fontno8600 <> 0)
               then begin
                 writecommand(25,float(fontno8600));
                 font8600 := fontno8600;
                 end; {then..begin}
         end; {WITH..begin}
 
@
@<new font size@>=
    if fontenviron[font].pointsize <> ptsize
         then begin
            ptsize := fontenviron[font].pointsize;
            writecommand(7,float(ptsize));
         end; {then..begin}
 
@
@<new set size@>=
    if different_setsize
         then writecommand(8,float(setsize));
 
 
@* ``Special'' Procedures.
The next few procedures enable the 8600 to do ``special'' things
like setting line footnotes, or slant type, or expanded type, etc.
 
@
@<Global Constants@>=
@!    maxNote = 100;@/
 
@ This procedure establishes the line number reference in
|footnote_line_array| with the line number in which a line note was
called.
 
@<Global Variables@>=
@!foot_area_ref : 0..255;
@!footnote_line_array : packed array[0..maxNote] of 0..255;
@!foot_line_ref : 0..255;
@!line_note_pending : boolean;
@!line_ref_pend_seq : 0..255;
@!counting_lines : boolean;
@!number_of_lines : integer;
 
@
@p procedure line_footnote_reference;
begin
    if not counting_lines then begin
        incr(foot_area_ref);
        line_note_pending := true;
        line_ref_pend_seq := 1;
        end
    else begin
        incr(foot_line_ref);
        footnote_line_array[foot_line_ref] := number_of_lines + 1;
        end;
    end; {|line_footnote_reference|}
 
@
@<Global Constants@>=
@!    linefont = 256;@/
@!    linenumfont = 76;@/
 
@
@<Global Variables@>=
@^system dependencies@>
@!special : string(40);
@!line_interval : 0..255;
@!margin_note : boolean;
@!numbering_lines : boolean;
@!printing_numbers : boolean;
@!pop_level : integer;
 
@ This procedure reads and interprets all the \\special commands
entered in the \TeX\ file. Its primary purpose is for reading the
the instructions pertaining to linenotes.
 
@p @^system dependencies@>
procedure readspecials;
var
    int : integer;
    inx : integer;
   temp : string(40);
  temp2 : string(40);
  temp3 : string(40);
  temp4 : string(40);
 
begin
  @<read special command@>
          if temp = 'EVEN_PAGE_MARGIN'
             then begin
               temp := (substr(temp2, 1, length(temp2)-2));
               even_page_margin := decimal_value(temp);
             end
          else if temp = 'ODD_PAGE_MARGIN'
             then begin
               temp := (substr(temp2, 1, length(temp2)-2));
               odd_page_margin := decimal_value(temp);
             end
          else if temp = 'LINE_NUMBER_FONT'
              @<linenumber font@>
          else if temp = 'POP_LEVEL'
              then pop_level := whole_value(temp2)
          else if temp = 'LINE_INTERVAL'
              then line_interval := whole_value(temp2)
          else if temp = 'NUMBERING_LINES'
              then begin
                   @<boolean value@>
                   then numbering_lines := true
                   else numbering_lines := false;
              end {then..begin}
          else if temp = 'COUNTING_LINES'
              then begin
                   @<boolean value@>
                   then counting_lines := true
                   else counting_lines := false;
               end {then..begin}
          else if (temp = 'MARGINNOTE')
              then margin_note := true
          else if temp = 'PRINTING_NUMBERS'
               then begin
                   @<boolean value@>
                   then printing_numbers := true
                   else printing_numbers := false;
                end {then..begin}
          else if temp = 'LINE_FOOTNOTE_REFERENCE'
                then line_footnote_reference;
          end; {then..begin}
    end; {ReadSpecials}
 
@ This gives default values for even and odd page margins that
will be reset if the user specified them in his file. It also reads
the special command.
 
@<read special command@>=
    int := index(special, '=');
    if int > 0
       then begin
          temp := trim(ltrim(substr(special, 1, int-1)));
          temp2 := substr(special, int+1);
 
@ If the special command is a Line Number Font, the command must
be further broken down to find the point size, as well as the name.
 
  @<linenumber font@>=
               then begin
                  int := index(temp2, ' ');
                  if int > 0
                  then begin
                  @<point size given@>
                     end
                  else  begin
                  @<no point size given@>
                     end;
                  fontname := allcaps(temp3);
                  readfontinfo(linefont,linenumfont);
                  end
 
@ A point size is given and that size must be sent along with the
name to the |readfontinfo| procedure.
 
@<point size given...@>=
  temp3 := trim(ltrim(substr(temp2, 1, int-1)));
  temp4 := substr(temp2, int+1);
  with fontenviron[linefont] do begin
       inx := whole_value(temp4);
       pointsize := inx;
       designsize := inx;
       end;
 
@ No point size is given, so the default point size will be used
(ten-point).
 
@<no point size...@>=
  temp3 := trim(ltrim(substr(temp2, 1, int-1)));
  inx := 10;
  with fontenviron[linefont] do begin
       pointsize := inx;
       designsize := inx;
       end;
 
@ The boolean value module is used when the response to the
special command is true or false.
 
@<boolean value@>=
        temp2 := allcaps(ltrim(trim(temp2)));
        if temp2 = 'TRUE'
 
@ This procedure is used in conjunction with the 0 font and
 handles the special functions codes like slant,
 reverse type, set size, etc.
 
@p procedure call_specials_routine(funcname         :integer);
var
    inx            :integer;
    num            :integer;
begin
    if dumpin then writeln(dumpout,'Function [',funcname:3,'] ');
    if funcname = 10
        then counting_lines := true
    else if funcname = 11
        then counting_lines := false
    else if funcname = 12
        then printing_numbers := true
    else if funcname = 13
        then printing_numbers := false
    else if funcname = 14
       then line_footnote_reference;
    if (funcname=14) or (funcname=13) or (funcname=12) or
        (funcname=11) or (funcname=10) then return;
  with stack[stacktop],
       a8600fontrec[fontenviron[currfont].fontindex],
       fontenviron[currfont] do begin
       with a8600chars[funcname] do begin
               for inx := 0 to num
               do with comarray[inx]
                   do writecommand(comcode,float(argument));
            end; {DO..begin}
         end; {DO..begin}
    end; {|call_specials_routine|}
 
@* Set the characters procedures.
The first procedure is called from the second one if a line
number is to be printed.
The second procedure actually sets an individual character.
First it checks
to make sure the character is a real one and not from the zero or
specials' font, then
it checks to see if a move needs to be made before the character is
printed. It makes the move and then
checks to see if a line number is to be printed; if it does, it prints
the line number, if it doesn't it sets the character.
 
@<Global Variables@>=
@!points : real;
@!we_add_the_character_width : boolean;
 
@ When \TeX\  formats the footnotes entered with a linenote reference
command, it simply inserts two zeros for the linenumber. This procedure
replaces those two zeros with the line number in which the linenote
reference was called.
 
@p procedure setline_footnote_ref(font            :integer);
var
    temp           :integer;
    inx            :integer;
    tempreal       :real;
    return_ps      :boolean;
    return_ss      :boolean;
begin
@<determine correct line number@>
@<print line number@>
@<reset line number values@>
end; {|setline_footnote_ref|}
 
@
@<determine correct line number@>=
    if line_ref_pend_seq = 1
       then temp := footnote_line_array[foot_area_ref] div 10
       else temp := footnote_line_array[foot_area_ref] mod 10;
    with fontenviron[font], stack[stacktop] do
           H := H + round(pointsize *
                a8600fontrec[fontindex].a8600chars[48].charwidth
                * SPsPerPt);
    if (line_ref_pend_seq = 1) and (temp = 0) then begin
       hmove_pending := true;
       line_ref_pend_seq := 2;
       return;
       end;
 
@
@<print line number@>=
  with stack[stacktop], a8600fontrec[fontenviron[font].fontindex],
     fontenviron[font] do begin
       with a8600chars[48 + temp] do begin
           @<set character commands@>
     end; {WITH..begin}
       end; {WITH..begin}
 
@
@<reset line number values@>=
    if line_ref_pend_seq = 1 then begin
       line_ref_pend_seq := 2;
       return; end
       else begin
           line_ref_pend_seq := 0;
             line_note_pending := false;
             return; end;
     if line_note_pending
        then begin
             line_note_pending := false;
             return;
             end;
 
@ The |setcharacter| procedure is the main procedure for setting
any and all characters, except the |line_footnote| references.
 
@p procedure setcharacter(character       :integer;
                          font            :integer);
var
    inx            :integer;
    tempreal       :real;
    temppt         :integer;
    tempbool       :boolean;
    return_ps      :boolean;
    return_ss      :boolean;
begin
    @<specials font or dumpin@>
    checkmoves;
    @<linenote-footnote@>
    @<debug info@>
    @<begin character@>
    end; {setcharacter}
 
@
@<specials font or dumpin@>=
if font8600 = 0 then begin
   call_specials_routine(character);
   return;
   end;  {then..begin}
if dumpin and (hmove_pending or vmove_pending)
   then tempbool := true
   else tempbool := false;
 
@
@<linenote-footnote@>=
   if line_note_pending and (character = 48)
      then begin
         setline_footnote_ref(font);
         return;
         end;
 
@
@<debug info@>=
   if dumpin and tempbool then writeln(dumpout);
   if dumpin
       then if (character >= 32) and (character < 127)
           then write(dumpout,chrx[character])
           else write(dumpout,'?<',character:3,'>');
 
@
@<begin character@>=
    return_ps := false;
    return_ss := false;
    with stack[stacktop], a8600fontrec[fontenviron[font].fontindex],
         fontenviron[font] do begin
         with a8600chars[character] do begin
               if different_setsize
                   then temppt := trunc(float(setsize) /
                           100.0 * pointsize)
                   else  temppt := pointsize;
               if we_add_the_character_width
                   then H := H + round(temppt * charwidth * SPsPerPt);
               @<set character commands@>
           end; {WITH..begin}
     end; {WITH..begin}
 
@
@<set character commands@>=
for inx := 0 to num do
    with comarray[inx] do
        if (comcode = 25) and (argument = -1)
           then writecommand(25,fontno8600)
                         {Some commands need to be scaled by
                              the set size factor}
            else if (comcode=9) or (comcode=10) or
                     (comcode = 27) or (comcode = 28)
                 then begin
                      points := float(pointsize) *
                                       SPsPerPt * real_argument;
                      writecommand(comcode,points);
                      end {then..begin}
            else if (comcode = 12) or (comcode = 13)
                 then begin
                      points :=float(pointsize) * real_argument;
                      writecommand(comcode,points);
                      end {then..begin}
            else if comcode = 14
                 then begin
                      tempreal := SPsPerPt * (getpts(H) +
                               (real_argument * pointsize));
                      if we_add_the_character_width
                           then tempreal := tempreal -
                                   round(pointsize*charwidth*SPsPerPt);
                      writecommand(14,tempreal);
                      end
            else if comcode = 7
                 then begin
                      writecommand(7,pointsize+float(argument));
                      return_ps := true;
                      end
            else if comcode = 8
                 then begin
                      writecommand(8,designsize+float(argument));
                      return_ss := true;
                      end
            else writecommand(comcode,float(argument));
        if return_ss then writecommand(8,designsize);
        if return_ps then writecommand(7,pointsize);
 
@
@<Global Variables@>=
@!size : integer;
 
@ This next procedure sets the line number if that option is used.
It will print the line number according to
|odd_page_margin| or |even_page_margin|. The number will
 be set in the |line_number_font|. The line numbers
 will print every five lines by default or according to
|line_interval|, and begin at 1 on each page.
 
@p procedure print_line_number;
var
    j         :integer;
begin
    incr(number_of_lines);
    if not printing_numbers then return;
    if (number_of_lines <> ((number_of_lines div
          line_interval) * line_interval))
         then return; {If this is not a line number divisible by
                       |line_interval|}
    size := headernum div 2;
    size := size * 2;
    if even_page_margin = 0 then
    even_page_margin := 50.8;
    if odd_page_margin = 0 then
    odd_page_margin := 407.7;
    if size = headernum
         then writecommand(11,even_page_margin*SPsPerPt)  {H position}
         else writecommand(11,odd_page_margin*SPsPerPt);  {H position}
    establish_font_parameters(linefont);
    size := number_of_lines;
    if dumpin then begin
         writeln;
         write(dumpout,'*** set line number ');
         end;
    we_add_the_character_width := false;
    if size >= 10
         then begin
              j := size div 10;
              setcharacter(j+48,linefont); {set 1st digit}
              size := size -(j * 10);
              end
         else with
a8600fontrec[fontenviron[linefont].fontindex].a8600chars[48]
              do       {set nothing, but move the width of a "0"}
              writecommand(27, fontenviron[linefont].pointsize *
                   charwidth * SPsPerPt);
    setcharacter(size+48,linefont); {+48 for ASCII code}
    we_add_the_character_width := true;
    if dumpin then writeln(dumpout);
    establish_font_parameters(currfont); {return to active font}
    end; {|print_line_number|}
 
@* Initialization procedures.
These next few procedures, get the whole thing started by assigning
values to all necessary items.
 
@<Global Constants@>=
@!    version = 2;@/
@!    level = 7;@/
 
@
@<Global Variables@>=
@!takenum : integer;
@!currpage : integer;
@!prevpage : integer;
 
@
@p @^system dependencies@>
procedure initialize8600;
begin
    @<page-setting values@>
    @<setting output/input values@>
    @<line-numbering font values@>@/
    @<page and font values@>
    @<line numbering values@>
    @<miscellaneous values@>
    end; {initialize8600}
 
@
    @<page-setting values@>=
    firstpg := -99999;
    totalpg := 99999;
    doingpages := false;
 
@
    @<setting output/input values@>=
    termout(output);
    readparms;
    reset(input,'NAME='  ccat filename  ccat '.'  ccat filetype  ccat '.*');
    writeln('******* tex8600 Version ',version:2,' Level ',
         level:3,' *******');
    rewrite(setfile,'LRECL=1029,RECFM=F,NAME='  ccat filename  ccat
'.TAPEFILE.*');
 
@
    @<line-numbering font values@>=
    with fontenviron[-1] do begin
         pointsize := 10;
         designsize   := 1;
         fontindex := 0;
         end; {WITH..begin}
 
@
@<page and font values@>=
    currfont := -1;
    currpage := 0;
    prevpage := -99999;
    ptsize := 0;
    setsize := 100;
 
@
@<line numbering values@>=
    counting_lines := false;
    margin_note := false;
    numbering_lines := false;
    printing_numbers := false;
    line_note_pending := false;
    line_ref_pend_seq := 0;
    even_page_margin := 0.0;
    odd_page_margin := 0.0;
    line_interval := 5;
    pop_level := 3;
    bufferlen := 0;
 
@
@<miscellaneous values@>=
    takenum := -1;
    num_of_pages := 0;
    length_of_take := 0;
    dumpin := false;
 
@ This procedure initializes values that pertain to the overall run.
 
@<Global Variables@>=
@!last_command : 0..255;
@!outputpending : boolean;
@!page_counter : integer;
@!second_to_last_cmnd : 0..255;
 
@
@p procedure init_run;
begin
    initialize8600;
    @<debugging statements@>
    count          := 0;
    fileend        := false;
    galley_length  := 0;
    hmove_amt      := 0;
    hmove_pending  := false;
    last_command   := 0;
    outputpending  := false;
    page_counter   := 0;
    postam_found   := false;
    put_width      := 0.0;
    print_hmove    := true;
    second_to_last_cmnd := 0;
    stacktop       := 1;    {initialize stack}
    vmove_amt      := 0;
    vmove_pending  := false;
    we_add_the_character_width := true;
    @<initialize job's main record--stack@>
    end; {|init_run|}
 
@
    @<debugging statements@>=
    if dumpin then begin
         writeln(dumpout);
         writeln(dumpout);
         writeln(dumpout,'********************************************');
         writeln(dumpout,'byte:code meaning');
         writeln(dumpout);
         end;
 
@
@<initialize job's main record--stack@>=
    with stack[stacktop] do begin
         H := 0;
         V := 0;
         W := 0;
         X := 0;
         Y := 0;
         Z := 0;
         end;  {WITH loop}
 
@* Rule-setting Procedures.
The |setrule| procedure is called when the horizontal position
is to be advanced. |putrule| is called when the horizontal position
is not to be advanced.
 
@ This procedure sets a rule.
 
@<Global Variables@>=
@!ruleht : integer;
@!rulewidth : integer;
@!height : real;
@!fudge : real;
 
@
@p procedure drawrule;
begin
    checkmoves;
    points := getpts(ruleht);
    height := points * SPsPerPt;
    if points <> 0 then begin
       writecommand(13,points);
       points := getpts(rulewidth);
       writecommand(12,points);
       if points <> 0 then begin
           writecommand(10,height); {Move back the rule height}
           writecommand(14,stack[stacktop].H); {set it}
           writecommand(9,height); {move down after setting}
           writecommand(11,stack[stacktop].H); {set it}
           end; {then...begin}
       end;{then..begin}
end;
 
@ Rule and increase the value of H (horizontal position).
 
@p procedure setrule;
begin
     drawrule;
     hmove_amt := rulewidth;
     hmove_pending := true;
     stack[stacktop].H := stack[stacktop].H + rulewidth;
end;  {setrule}
 
@ Rule and do not increase the value of H (horizontal position).
 
@p procedure putrule;
begin
    drawrule;
end; {putrule}
 
@* Page procedures.
The |doendofpage| procedure is called at the end of each page and the
|dobeginningofpage| procedure at the beginning of each page.
 
@ This procedure is entirely for the user's information. It prints
out to the terminal the number of pages set in the job. If there are
are more than 8 page numbers a carriage return is thrown.
 
@p procedure doendofpage;
begin
     incr(page_counter);
     if page_counter >= 8 then begin
          writeln;
          page_counter := 0;
          end;
     if doingpages=true
        then begin
          decr(totalpg);
          if totalpg = 0
             then begin
                writeln('<',currpage:1,'> ');
                return;
                end {then..begin}
             else write('<',currpage:1,'> ');
          end;
     end;
 
@ This procedure does all of the 8600 initialization
               for the start of each new page.
 
@<Global Constants@>=
@!    indent='                 ';@/
@!    nullstring = '00000000000000000000'xc;@/
 
@
@<Global Variables@>=
@!int : integer;
@!newtake : boolean;
 
@
@p procedure dobeginningofpage;
var
inx       :integer;
begin
    @<general initializations@>
    @<read first page number@>
    @<determine if current page is to be set@>
    @<read counters@>
    if doingpages=true
       then begin
         if (currpage = firstpg) or (int = -1)
            or (length_of_take >= 5184)
           then begin
              @<first page or 6 feet in film canister@>
              end {then..begin}
           else begin
              @<any other page@>
              end;  {ELSE..begin}
           with fontenviron[currfont] do begin
              if int = -1 then begin
              @<first page font environment@>
                  end
              else begin
                  @<all other pages font environment@>
                  @<print end of page rule@>
                  end; {ELSE..begin}
           end;{WITH..begin}
       incr(num_of_pages);
       end; {then..begin}
end; {DoBeginningOfPage}
 
@
@<general initializations@>=
    foot_line_ref := 0;
    foot_area_ref := 0;
    number_of_lines := 0;
    newtake := false;
    with stack[stacktop] do begin
       H := 4718592;
       V := 0; {start 1" over and 1" down}
vmove_amt := 4718592;
vmove_pending := true;
hmove_pending := true;
       end;      {WITH ... do begin}
 
@
@<read first page number@>=
    int := readinteger(4);
    if dumpin then writeln(dumpout,'BOP -- Beginning Of Page ',int);
    headernum := int;
        prevpage := currpage;
    currpage := int;
 
@
@<determine if current...@>=
if (firstpg = -99999)
   then
      doingpages := true;
if not doingpages
then
   if ((firstpg >= 0) and (firstpg <= currpage))
      or ((firstpg < 0) and (firstpg >= currpage))
      then
         doingpages := true;
if (totalpg < 1)
  then
    doingpages := false;
 
@
@<read counters@>=
    for inx := 1 to 9 do begin
         int := readinteger(4);
         if dumpin then writeln(dumpout,'Counter ',inx:1,' = ',int);
         end;      {FOR ... do begin}
    int := readinteger(4);
    if dumpin
       then writeln(dumpout,indent,'previous page pointer = ',int);
 
@
@<first page or 6 feet in film canister@>=
              incr(takenum);
              length_of_take := 0;
              if (int = -1) or (currpage = firstpg) {On first page}
                   then writeheader
                   else begin
                        inx := headernum;
                        headernum := 88888;
                        repeat  {pad end of record with hex FF}
                             write8600rec(allzeros);
                             until bufferlen <= 5;
                        headernum := inx;
                        writecommand(1,0.0); {End of Take}
                        repeat  {pad record with '00'xc}
                             write8600rec(allzeros);
                             until bufferlen <= 5;
                        end;
              write8600rec(nullstring); {10 hex zeros}
              writecommand(0,takenum); {Start of Take}
              newtake := true;
 
@
@<any other page@>=
                 repeat  {pad end of record with hex FF}
                   write8600rec(allzeros);
                   until bufferlen <= 5;
 
@
@<first page font environment@>=
                  different_setsize := false;
                  in_slant_mode := false;
                  in_reverse_type := false;
 
@
@<all other pages font environment@>=
                  writecommand(25,font8600);
                  writecommand(7,pointsize);
                  if different_setsize
                     then writecommand(8,float(setsize));
                  if in_slant_mode
                     then writecommand(15,48);
                  if in_reverse_type
                     then writecommand(3,1);
 
@
@<print end of page rule@>=
                  writecommand(11,0);      {Move to left col.}
                  writecommand(9,12.0*SPsPerPt);    {VMF 12 pts}
                  writecommand(12,30.0);   {set width of rule}
                  writecommand(13,1.5);    {set depth of rule}
                  writecommand(14,0);      {page separator}
                  writecommand(11,0);      {quad left}
                  writecommand(9,12.0*SPsPerPt);    {VMF 12 pts}
                  galley_length := galley_length + 24;
 
@* MAIN PROGRAM.
 
@<Global Variables@>=
@!tempstack : stackrec;
@!inx : integer;
@!temp : integer;
@!temp2 : integer;
@!put_width : real;
@!realtemp : real;
 
@
@p begin {MAIN}
                     {=== Initialize ===}
    init_run;
    while not postam_found do begin
         savecount := count;     {don't change it in readinteger}
         byte := readinteger(1); {1-byte code}
         if printing_numbers
              then if ((byte > 128) and (byte < 218)) then begin
                   second_to_last_cmnd := last_command;
                   last_command := byte;
                   end; {then..begin}
         if byte < 128 then begin {This is a character}
              outputpending := true;
              setcharacter(byte,currfont);
              end  {then..begin}
              else if (byte>=250) and (byte<=255)
                   then error(6,fatal,byte)
      else case byte of
    128: @<set horizontal character1@>@/
    129: @<set horizontal character2@>@/
    130: @<set horizontal character3@>@/
    131: @<set horizontal character4@>@/
    132: @<set a rule@>@/
    133: @<put horizontal character1@>@/
    134: @<put horizontal character2@>@/
    135: @<put horizontal character3@>@/
    136: @<put horizontal character4@>@/
    137: @<put a rule@>@/
    138: do_nothing; {NOP}
    139: dobeginningofpage;{BOP}
    140: doendofpage; {EOP}
    141: @<push@>@/
    142: @<pop@>@/
    143: @<right1 move@>@/
    144: @<right2 move@>@/
    145: @<right3 move@>@/
    146: @<right4 move@>@/
    147: @<``W'' horizontal move@>@/
    148..151: @<``W''1-4 horizontal move@>@/
    152: @<``X'' horizontal move@>@/
    153..156: @<``X''1-4 horizontal move@>@/
    157..160: @<down1@>@/
    161: @<``Y'' vertical move@>@/
    162..165:@<``Y''1-4 vertical move@>@/
    166: @<``Z'' vertical move@>@/
    167..170: @<``Z''1-4 vertical move@>@/
    171..234: @<set font@>@/
    235: @<font1 set@>@/
    236: @<font2 set@>@/
    237: @<font3 set@>@/
    238: @<font4 set@>@/
    239: @<nop1@>@/
    240: @<nop2@>@/
    241: @<nop3@>@/
    242: @<nop4@>@/
    243: @<font1 def $0<k<64$@>@/
    244: @<font2 def $0<k<65536$@>@/
    245: @<font3 def $0<k<2^{24}$@>@/
    246: @<font4 def $-2^{31}<k<2{30}$@>@/
    247: @<preamble@>@/
    248: readpostamble; {Post-amble}@/
    249: do_nothing; {Post-post-amble}
   otherwise writeln('oops...forgot about ',byte:12);
      end;{CASE}
   end;{while}
end.
 
@
@<set horizontal character1@>=
   begin
              int := readinteger(1);
              we_add_the_character_width := true;
              hmove_pending := true;
              setcharacter(int,currfont);
              end;
 
@
@<set horizontal character2@>=
begin
              int := readinteger(2);
              we_add_the_character_width := true;
              hmove_pending := true;
              setcharacter(int,currfont);
              end;
 
@
 @<set horizontal character3@>=
 begin
              int := readinteger(3);
              we_add_the_character_width := true;
              hmove_pending := true;
              setcharacter(int,currfont);
              end;
 
@
@<set horizontal character4@>=
begin
              int := readinteger(4);
              we_add_the_character_width := true;
              hmove_pending := true;
              setcharacter(int,currfont);
              end;
 
@
@<set a rule@>=
begin
              ruleht := readinteger(4);
              rulewidth := readinteger(4);
              setrule;
             end;
 
@
@<put horizontal character1@>=
begin
              int := readinteger(1);
              we_add_the_character_width := false;
              hmove_pending := true;
              setcharacter(int,currfont);
              we_add_the_character_width := true;
              end;
 
@
@<put horizontal character2@>=
begin
              int := readinteger(2);
              we_add_the_character_width := false;
              hmove_pending := true;
              setcharacter(int,currfont);
              we_add_the_character_width := true;
              end;
 
@
@<put horizontal character3@>=
begin
              int := readinteger(3);
              we_add_the_character_width := false;
              hmove_pending := true;
              setcharacter(int,currfont);
              we_add_the_character_width := true;
              end;
 
@
@<put horizontal character4@>=
begin {Put Horizontal Character}
              int := readinteger(4);
              we_add_the_character_width := false;
              hmove_pending := true;
              setcharacter(int,currfont);
              we_add_the_character_width := true;
              end;
 
@
@<put a rule@>=
begin
              ruleht := readinteger(4);
              rulewidth := readinteger(4);
              realtemp := rulewidth / SPsPerPt / 72.27;
              putrule;
             end;
 
@
@<push@>=
begin
              tempstack := stack[stacktop];
              stacktop := stacktop + 1;
              stack[stacktop] := tempstack;
              with stack[stacktop] do begin
                   end; {WITH..begin}
              end;
 
@
@<pop@>=
begin
              tempstack := stack[stacktop];
              inx := stacktop;
              stacktop := stacktop - 1;
              with stack[stacktop] do begin
                   hmove_pending := false;
                   hmove_amt     := 0;
                   print_hmove := true;
                   vmove_amt := vmove_amt + V - tempstack.V;
                   vmove_pending := true;
                   if margin_note and counting_lines
                      then margin_note := false
                      else if numbering_lines and counting_lines
                      and (inx = pop_level)
                         then print_line_number;
                   writecommand(11,H); {HPOS to left margin}
                   end;           {WITH .. do begin}
with tempstack do begin
if put_width = 12.0 then
 else if H / SPsPerPt > 554 then
 put_width := 12.0;
 end;
              end;                {POP}
 
@
@<right1 move@>=
begin
         int := readinteger(1);
         with stack[stacktop] do begin
           hmove_amt := hmove_amt + int;
           hmove_pending := true;
           h := h + int;
           end; {DO..begin}
         end;
 
@
@<right2 move@>=
begin
         int := readinteger(2);
         with stack[stacktop] do begin
           hmove_amt := hmove_amt + int;
           hmove_pending := true;
           h := h + int;
           end; {DO..begin}
         end;
 
@
@<right3 move@>=
begin
         int := readinteger(3);
         with stack[stacktop] do begin
           hmove_amt := hmove_amt + int;
           hmove_pending := true;
           h := h + int;
           end; {DO..begin}
         end;
 
@
@<right4 move@>=
begin
         int := readinteger(4);
         with stack[stacktop] do begin
           hmove_amt := hmove_amt + int;
           hmove_pending := true;
           h := h + int;
           end; {DO..begin}
         end;
 
@
@<``W'' horizontal move@>=
begin
              with stack[stacktop] do begin
                   hmove_amt := hmove_amt + W;
                   hmove_pending := true;
                   H := H + W;
                   end; {WITH..begin}
              end;      {"W" amount change}
 
@
@<``W''1-4 horizontal move@>=
         begin
              size := 4 + (byte - 151);
              int := readinteger(size);
              points := getpts(int);
              hmove_amt := hmove_amt + int;
              hmove_pending := true;
              with stack[stacktop] do begin
                   W := int;       {int is in scalepts}
                   H := H + W;
                   end;      {WITH..begin}
              end;           {"W" change}
 
@
@<``X'' horizontal move@>=
begin
              with stack[stacktop] do begin
                   hmove_amt := hmove_amt + X;
                   hmove_pending := true;
                   H := H + X;
                   end; {WITH..begin}
              end;      {"X" amount move}
 
@
@<``X''1-4 horizontal move@>=
         begin
              size := 4 + (byte - 156);
              int := readinteger(size);
              points := getpts(int);
              hmove_amt := hmove_amt + int;
              hmove_pending := true;
              with stack[stacktop] do begin
                   X := int;      ; {saveamt.}
                   H := H + X;    {record the move}
                   end;                {WITH..begin}
              end;                     {"X" amount change}
 
@
@<down1@>=
begin
              size := 4 + (byte - 160);
              int := readinteger(size);
              points := getpts(int);
              with stack[stacktop] do begin
                   vmove_amt := vmove_amt + int;
                   vmove_pending := true;
                   V := V + int;
                   end; {WITH..begin}
              end;      {"Down" amount move}
 
@
@<``Y'' vertical move@>=
begin
              with stack[stacktop] do begin
                   vmove_amt := vmove_amt + Y;
                   vmove_pending := true;
                   V := V + Y;
                   end; {WITH..begin}
              end;      {"Y" amount move}
 
@
@<``Y''1-4 vertical move@>=
         begin
              size := 4 + (byte - 165);
              int := readinteger(size);
              points := getpts(int);
              vmove_amt := vmove_amt + int;
              vmove_pending := true;
              with stack[stacktop] do begin
                   Y := int;          {save amt.}
                   V := V + Y;
                   end;      {WITH..DO begin}
              end; {"Y" amount move}
 
@
@<``Z'' vertical move@>=
begin
              with stack[stacktop] do begin
                   vmove_amt := vmove_amt + Z;
                   vmove_pending := true;
                   V := V + Z;
                   end; {WITH..begin}
              end; {"Z" amount move}
 
@
@<``Z''1-4 vertical move@>=
         begin
              size := 4 + (byte - 170);
              int := readinteger(size);
              points := getpts(int);
              vmove_amt := vmove_amt + int;
              vmove_pending := true;
              with stack[stacktop] do begin
                   Z := int;           {save amt.}
                   V := V + Z;
                   end;      {WITH..begin}
              end; {"Z" amount move}
 
@
@<set font@>=
         begin
         currfont := byte - 171;
         establish_font_parameters(currfont);
         end;
 
@
@<font1 set@>=
begin
         currfont := readinteger(1);
         establish_font_parameters(currfont);
         end;
 
@
@<font2 set@>=
begin
         currfont := readinteger(2);
         establish_font_parameters(currfont);
         end;
 
@
@<font3 set@>=
begin
         currfont := readinteger(3);
{       |establish_font_parameters(currfont);|}
         end;
 
@
@<font4 set@>=
begin
         currfont := readinteger(4);
 {       |establish_font_parameters(currfont);|}
         end;
 
@
@<nop1@>=
begin
         int := readinteger(1);
         special := '';
         for inx := 1 to int do begin
            temp := readinteger(1);
            special := special  ccat allcaps(str(chrx[temp]));
           end; {DO..begin}
         readspecials;
         end;
 
@
@<nop2@>=
begin
         int := readinteger(2);
         special := '';
         for inx := 1 to int do begin
            temp := readinteger(1);
            special := special  ccat allcaps(str(chrx[temp]));
           end; {DO..begin}
         readspecials;
         end;
 
@
@<nop3@>=
begin
         int := readinteger(3);
         special := '';
         for inx := 1 to int do begin
            temp := readinteger(1);
            special := special  ccat allcaps(str(chrx[temp]));
           end; {DO..begin}
         readspecials;
         end;
 
@
@<nop4@>=
begin
         int := readinteger(4);
         special := '';
         for inx := 1 to int do begin
            temp := readinteger(1);
            special := special  ccat allcaps(str(chrx[temp]));
           end; {DO..begin}
         readspecials;
         end;
 
@
@<font1 def...@>=
begin
         currfont := readinteger(1);
         fontinfo;
         end;
 
@
@<font2 def...@>=
begin
         currfont := readinteger(2);
         fontinfo;
         end;
 
@
@<font3 def...@>=
begin
         currfont := readinteger(3);
         fontinfo;
end;
 
@
@<font4 def...@>=
begin
         currfont := readinteger(4);
         fontinfo;
         end;
 
@
@<preamble@>=
begin
         int := readinteger(1);
         int := readinteger(4);
         temp := readinteger(4);
         temp2 := readinteger(4);
         temp := readinteger(1);
         for int := 1 to temp do
            inx := readinteger(1);
         end;
 
@* INDEX.