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