summaryrefslogtreecommitdiff
path: root/macros/text1/compugraphics_8600/tex8600.web
diff options
context:
space:
mode:
Diffstat (limited to 'macros/text1/compugraphics_8600/tex8600.web')
-rw-r--r--macros/text1/compugraphics_8600/tex8600.web3034
1 files changed, 3034 insertions, 0 deletions
diff --git a/macros/text1/compugraphics_8600/tex8600.web b/macros/text1/compugraphics_8600/tex8600.web
new file mode 100644
index 0000000000..8b99589a5a
--- /dev/null
+++ b/macros/text1/compugraphics_8600/tex8600.web
@@ -0,0 +1,3034 @@
+\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.