\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.