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