%test version
\font\twelvept=cmbx12
\font\tentex=cmr10
\def\topofcontents{\null
\def\titlepage{T}
\centerline{{\twelvept The FONTTEX Program}}
\vskip15pt
\centerline{Version 2, July 1986}
\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 version of fonttex writes font and driver information
into elements. Infile, a data file, must be assigned prior
the font data.
Fonttex reads a font description source element, and creates
a \TeX\ font file (TFM) and an 8600 driver element.
The font description source is divided into three sections.
The first section includes comments and parameters for the
entire font, the second describes the individual characters,
and the third provides information about ligatures, kerns,
linked math characters, and limit conventions on math
operators. Numeric information is given as integers,
or fractions depending on the context in which it
occurs. All sizes given will be scaled by the point size by
\TeX\ and so should reflect the sizes for 1-point
type.
The first section can include comments, which begin with a
"*" in column one of the line. It also includes definitions
of numeric parameters for the \TeX\ and driver font files.
The parameter definitions consist of an alphabetic name
beginning in column 1 and ending with one or more blanks;
and a numeric value. Comments and parameters can be
interspersed. This section is ended by a line containing a
dollar sign in column 1. Although the order the parameters
are given in is not significant, we will discuss them in a
conventional order. The first two parameters are the
scaling factors for the heights, widths, and depths of the
characters given in section 2. These scaling factors are
called |HUNITS| and |VUNITS|. Both have real values. All
character widths are implicitly multiplied by |HUNITS|, and
all heights and depths by |VUNITS|. For the Compugraphic 8600
we use |HUNITS|=1/54 and |VUNITS|=1/64, because of the internal
units used on the machine. The next several parameters give
information about the font needed by the 8600 driver.
|DEFFONT| specifies a font number on the typesetter. Unless
otherwise defined, all characters in this file come from
this font. |DEFWIDTH| gives the width multiplier. All
character widths are also multiplied by |DEFWIDTH|. Typically
|DEFWIDTH| is 1, but it could be less for condensed type and
more for expanded type. The remaining parameters are for
the \TeX\ font file. They all take real values.
There should be 128 character entries in section two.
Information about character is given in free format columns,
which are separated by one or more blanks. Beginning in
column 1 is the character mnemonic. Most fonts use standard
ascii codes, so that character 65 is A, etc. For this
reason, any single character name will be checked to see
that it corresponds to the appropriate ascii value. If not a
warning is issued.
Following this may be the keyword
LIGATURE or BUILD describing ligatures and built-up math
delimiters. This is omitted for ordinary characters. The
ligature keyword indicates that this character should be
substituted for a combination of two other characters.
Following the keyword should be the names of the two
characters separated by a plus sign. For example, fi
LIGATURE f+i and: ff LIGATURE f+f ffl LIGATURE ff+l.
For the
BUILD keyword, the character will be made from pieces.
There can be a top, bottom, middle, and extension character.
All are optional except the extension character. This is
specified as BUILD keyword=charname,keyword=charname,...
For instance, bigparen BUILD
TOP=parentop,MID=parenmid,BOT=parenmid.
The third field of
information is the character width, the fourth the height,
and the fifth the depth. Widths are given relative to the
point size and are implicitly multiplied by the |HUNITS|
parameter. Likewise height and depth are relative and are
multiplied by |VUNITS|. For example, the typical value of
|HUNITS| is 1/54. Then a character width given as 27 means
that the character is 0.5 times the point size in width. The
point size will be determined when the file is referred to
in \TeX , and the character sizes will be multiplied by it as
the file is read into \TeX . The sixth column gives 8600
commands and character codes. The commands have integer or
real parameters. Most characters will have a single character
code, and will be selected from the default font. An
alternate font can be specified by the F command. 8600 code
can also include point size commands, psuedo-italic
commands, etc. Refer to the module discussing ``Reading the
8600 Codes.''
The final section specifies kerns, linked math characters,
and math operator conventions. A kern is an amount of
horizontal space to be subtracted between two characters.
It is specified as KERN A+W 5/100 for instance, to shave
5/100 of the point size between occurences of A and W.
Linking occurs in math extension fonts where various sizes
of parentheses, brackets, and so forth occur. To link one
character to the next larger size of the same symbol,
specify LINK charname1 charname2 Finally, a character is
specified to be a mathop by the MATHOP keyword. (Common
mathops are sum and integral signs.) Following the keyword
is the character name and a real number. If the real number
is zero, limits for the operator will be centered above and
below it in display style. If non-zero, limits are set to
the right of the symbol, and the lower limit is moved left
by this amount.
Some further detail on the methods and data structures used
by Fonttex. Widths, heights, depths, and italic corrections
are stored in arrays of reals (type realarray). Entry -1
gives the highest numbered entry used so far. When a height,
depth, etc is read from the input file, procedure |AddToList|
is called to add the value to the array and return the index
of the entry in the array. If two or more characters have
the same dimension, the value is stored only once and the
characters have identical indices pointing to it. In the TFM
format font files, each character has an index into the
width, height, depth, italic correction arrays, and the
arrays of values are given separately. (See TUGboat volume
2, no 1; or the comments in Sysdep at |ReadFontInfo| for more
details on the font file format.)
Ligatures are specified by giving the name of the two
"component" characters of the ligature. These are saved in
an array of records, "lig" until the entire pre-file has
been read. Then a pass is made through these records to look
up all the names of the component characters, and a another
pass is made through the lig records to group them by the
first character of the ligature and add a pointer in the
outstuff array for that character pointing to the
ligature/kern program. The same is done with kern
specifications and the final pass over both is done
simultaneously.
Extendible characters made from top, bottom, middle, and
extension pieces are marked at the character entry, and the
names of the pieces are saved in array ext until the file
has been read. The tag value and pointer into the ext array
are set in outstuff when the line is read in |ReadBuildStuff|,
but the character numbers for the ext array itself are not
found until after the entire file has been read.
When records are written to the driver and font files they
can be displayed by compiling Fonttex with "drvdump" and
"dump" respectively set to true.
@ 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 fonttex(terminal,sysprint,fontpkt,drvpkt,infile);
const
@<Global Constants@>@/
type
@<Global Types@>@/
var
@<Global Variables@>@/
static@/
@^system dependencies@>
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';@/
%include pasclib(asciicvt)@/
@* 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 Constants@>=
maxkerns = 255;
num_entries = 128; {maximum number of characters entered}
@
@<Global Types@>=
oneoftwo = packed 1..2;
oneoffour = packed 1..4;
bytes4 = packed record
byte0 :packed 0..255;
byte1 :packed 0..255;
case oneoftwo of
1 :(rhword :packed 0..65535);
2 :(byte2 :packed 0..255;
byte3 :packed 0..255)
end;
charindex = 0..127;@\
comm = (HDR,CHWIDTH,RT,PS,SS,VMF,VMR,RW,RD,IR,SL,
RTWT,RTWB,AU,F,HMR,HML,TTS,MAXCMD);@\
driverrec = record
cmd :integer;
case oneoftwo of
1 :(param :shortreal);
2 :(code :integer);
end;
extrec = record
sourceline:integer;
topname,botname,extname,midname :string(40);
top,bot,mid,ext :charindex;
end;
fonttypes = (standard,mathex,mathsy);
halves2 = packed record
lhword :packed 0..65535;
case oneoftwo of
1 :(rhword :packed 0..65535);
2 :(byte2 :packed 0..255;
byte3 :packed 0..255)
end;
kernrec = record
frstchar :charindex;
scndchar :charindex;
kernslot :integer;
end;
ligrec = record
sourceline :integer;
firstname :string(40);
scndname :string(40);
frstchar :charindex;
scndchar :charindex;
ligcode :charindex;
end;
memoryword = packed record case oneoffour of
1 :(pts :shortreal);
2 :(int :integer);
3 :(twohalves :halves2);
4 :(fourbytes :bytes4)
end;
outarray = array[charindex] of memoryword;
parameter = (slant,spacee,spstretch,spshrink,
xheight,quad,extraspace,
raisen1,raisen2,raisen3,
denom1,denom2,sup1,sup2,
sup3,sub1,sub2,supdrop,subdrop,
dlims1,dlims2,axisheight,
defthickness,bgopsp1,
bgopsp2,bgopsp3,
bgopsp4,bgopsp5);
realarray = array[-1..num_entries] of real;
@ This function 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 || str(chtable[character])
else buildit := buildit || str(character);
end;
allcaps := buildit;
end;
@ 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(8);
var
i :integer;
j :integer;
k16 :integer;
stri :string(8);
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 < 0 then begin
stri := 'FF';
i := 'FFFFFF'x + i + 1;
end;
k16 := 1048576;
repeat
if i >= k16
then begin
j := i div k16;
stri := stri || hexarray[j];
i := i - (j * k16);
end
else if length(stri) > 0
then stri := stri || '0';
k16 := k16 div 16;
until k16 = 1;
stri := stri || hexarray[i];
i := length(stri);
if (i = 1) or (i = 3) or (i = 5)
then stri := '0' || stri;
hex := stri;
end;
@
@<Global Types@>=
oneofsix = 1..6;
@
@<Global Variables@>=
dump :boolean;
fontpkt :file of memoryword;
inx :integer;
name :array[0..127] of string(40);
outcount :integer;
outrec :memoryword;
@
@p procedure writeout(outrec :memoryword;
outtype :oneofsix);
var
length :integer;
begin
if dump then begin
write(outcount:6,': ');
case outtype of
1 :writeln('Pts=',outrec.pts);
2 :begin
writeln('Fix=',outrec.int);
end;
3 :with outrec.twohalves do
writeln('lhword=',lhword,',rhword=',rhword);
4 :with outrec.fourbytes do
writeln(' Byte0=',byte0:3,'=>"',hex(byte0),'"',
',Byte1=',byte1:3,'=>"',hex(byte1),'"',
',Byte2=',byte2:3,'=>"',hex(byte2),'"',
',Byte3=',byte3:3,'=>"',hex(byte3),'"');
5 :with outrec.fourbytes do
writeln(' Width inx =',byte0:3,
',Height inx= ',byte1 div 16:2,
',Depth inx =',byte1 mod 16:2,
',ItCor inx= ',byte2 div 4:2,
',Tag =',byte2 mod 4:1,
',Rem =',byte3:2,
',chr="',name[inx],'"');
6 :writeln(outrec.int:1);
end;{case}
end;{if}
outcount := outcount + 1; {count it}
fontpkt@@ := outrec;
put(fontpkt);
end; {writeout}
@
@<Global Types@>=
@!error_severity = (fatal,notreallyfatal,overlookable);
@
@<Global Variables@>=
@!currchar :charindex;
@!errlin :integer;
@!errlstr :string(10);
@!errmax :integer;
@!errmin :integer;
@!errnum :integer;
@!errstr :string(133);
@!infile :text;
@!lenfile :integer;
@!lineno :integer;
@!sysprint :text;
@ 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(err :integer;
howbad :error_severity);
begin
if errlin = 0 then errlin := lineno;
{The caller can override the current line by setting errlin}
case err of
0 :writeln('Empty input file');
1 :writeln('Unrecognized keyword :',errstr);
2 :begin
write('Number of entries must be specified');
writeln(' before the entries appear');
end;
4 :begin
write('Integer expected but not found: next char=');
if eoln(infile)
then writeln('end of line')
else writeln(infile@@);
end;
5 :writeln('Too many unique widths, depths, or heights');
6 :begin
writeln('Entries in font file are out of sequence:');
writeln('The entry labelled ',errstr[1],
' has a sequence ', 'of ',currchar:3,
', not its Ascii value ',ordx[errstr[1]]:3);
end;
7 :writeln('Ran out of entries in font file prematurely');
8 :writeln('Real value given for parameter ',errstr,
', but integer required');
9 :writeln('The character names in a ligature or kern ',
'have to be separated by a "+"');
10 :writeln('Knave! No space should follow thine plus sign');
11 :writeln('We expected to see a keyword here, not ',
errstr,'. Perhaps you have too many ',
'character entries, or (gasp!) a typo');
12 :writeln('You never specified "',errstr,
'" as a character name');
13 :writeln('Keyword should be TOP,BOT,MID,EXT, not "',
errstr:3,'"');
14 :writeln('You''ve specified parameters for both ',
'mathex and mathsy fonts');
15 :writeln('Expected to write ',lenfile:3,' records, ',
'but actually wrote ',outcount:3);
16 :writeln('After character name should be BUILD, ',
'LIGATURE, or integer, not ',errstr);
17 :writeln('Invalid value for parameter ',errlstr,', ',
errnum,' is <',errmin,' or >',errmax);
18 :writeln('TTS codes must be within 0 to 127');
19 :writeln(errlstr,' is not a valid 8600 command');
20 :writeln('There is no 8600 code given for character ',
errstr:1);
21 :writeln('Bad character for 8600 code :',infile@@);
24 :writeln('Major font number should be between 1 and ',
maxfont:3);
27 :writeln('Fontname too long, truncated to 8 characters');
28 :writeln('Invalid input values for tracing, ',
'record "',errlstr,'" skipped');
otherwise writeln('Unspecified error number ',err:3);
end; {case}
if howbad = fatal
then begin
writeln('Fatal error ends program at input line',
errlin:4);
trace(sysprint);
halt;
end
else writeln('Error at input line',errlin:4);
if (not eof(infile)) and (howbad = overlookable)
then begin
readln(infile);
writeln('rest of this string has been overlooked');
end;
errlin := 0; {reset default line to lineno}
end; {Error}
@
@p procedure skipblanks;
begin
while (infile@@=' ') and not eoln(infile) do
get(infile); {advance one character}
end;
@
@<Global Types@>=
@!chrset = set of char;
@ This procedure reads a string from infile to be delimited by
a character in the set delimiters.
@p procedure readmnemonic(var mn :string(40);
delimiters :chrset);
var
str :string(1);
begin
mn := '';
while (length(mn) <= 40) and not (infile@@ in delimiters) do begin
read(infile,str);
{writeln('character="',str);}
mn := mn || str;
end;
errstr := mn; {save globally for error messages}
end; {readmnemonic}
@
@<Global Constants@>=
exspacekey = 'EXTRASPACE';
quadkey = 'QUAD';
slantkey = 'SLANT';
spaceekey = 'SPACE';
spshrkey = 'SPSHRINK';
spstrkey = 'SPSTRETCH';
xhtkey = 'XHEIGHT';
@
@p procedure printparam(p :parameter);
begin
case p of
slant :write(slantkey:5);
spacee :write(spaceekey:6);
spstretch :write(spstrkey:9);
spshrink :write(spshrkey:8);
xheight :write(xhtkey:7);
quad :write(quadkey:4);
extraspace:write(exspacekey:10);
otherwise write(' next math parm');
end; {case}
end; {printparam}
@ This converts the byte to an integer, for further evaluation by
the program.
@p procedure readinteger(var int :integer);
var
minusint :integer;
begin
skipblanks;
if not (infile@@ in ['0'..'9','-']) then error(4,fatal);
if infile@@ = '-'
then begin
get(infile);
readinteger(minusint);
int := 0 - minusint;
end
else read(infile,int);
end; {readinteger}
@ Reads series of integers separated by * and /. Returns
value in fractional form: multiplier/divisor is the real value
@p procedure readexpr(var multiplier :integer;
var divisor :integer);
var
op :char;
int :integer;
begin
skipblanks;
if infile@@ = ' ' then error(4,fatal);
op := '*';
multiplier := 1;
divisor := 1;
while not (infile@@ in [' ',',']) do begin
readinteger(int);
if op = '*'
then multiplier := multiplier * int
else divisor := divisor * int;
if (infile@@ = '*') or (infile@@ = '/')
then read(infile,op);
end; {while}
end; {readexpr}
@
@p procedure readreal(var r :real);
var
mult :integer;
divs :integer;
begin
readexpr(mult,divs);
r := (1.0 * mult)/(1.0 * divs);
end;
@
@<Global Constants@>=@/
axishtkey = 'AXISHEIGHT';
bosp1key = 'BIGOPSPACE1';
bosp2key = 'BIGOPSPACE2';
bosp3key = 'BIGOPSPACE3';
bosp4key = 'BIGOPSPACE4';
bosp5key = 'BIGOPSPACE5';
codingschemekey = 'CODINGSCHEME';
deffontkey = 'DEFFONT';
dethicknesskey = 'DEFTHICKNESS';
dewidthkey = 'DEFWIDTH';
dlims1key = 'DELIMSIZE1';
dlims2key = 'DELIMSIZE2';
denom1key = 'DENOMLOWER1';
denom2key = 'DENOMLOWER2';
fntnamekey = 'FONTNAME';
hunitskey = 'HUNITS';
raizen1key = 'NUMRAISE1';
raizen2key = 'NUMRAISE2';
raizen3key = 'NUMRAISE3';
ptsizekey = 'POINTSIZE';
subdrpkey = 'SUBDROP';
sub1key = 'SUB1';
sub2key = 'SUB2';
supdrpkey = 'SUPDROP';
sup1key = 'SUP1';
sup2key = 'SUP2';
sup3key = 'SUP3';
vunitskey = 'VUNITS';
maxfont = 255;
uninitialized = -5000.0;
@
@<Global Variables@>=
codescheme :string(40);
def_ft_stuff :driverrec;
def_width_stuff :driverrec;
fontname :string(40);
fontype :fonttypes;
hunits :real;
params :array[parameter] of real;
paramset :array[fonttypes] of set of parameter;
pointsize :integer;
uniquecode :integer;
vunits :real;
@
@p procedure read_the_parameters;
label 0;
var
mn :string(40);
int :integer;
realval :real;
mult :integer;
divs :integer;
isint :boolean;
pp :parameter;
parmerror :boolean;
begin
while infile@@ in ['A'..'Z','a'..'z','*'] do
if (infile@@ = '*')
then begin
readln(infile);
errlin := errlin + 1;
end
else begin
@<read vunits or hunits or parameter@>
{You can end the parameters with a '\$' line -- check it}
if infile@@ = '$'
then begin
readln(infile); {Skip end params marker}
errlin := errlin + 1;
end;
{now check that all parameters are given}
0: parmerror := false;
for pp := slant to bgopsp5 do
if (params[pp] = uninitialized) and
(pp in paramset[fontype]+paramset[standard])
then begin
write('Parameter ');
printparam(pp);
writeln(' was not specified');
parmerror := true;
end;
if parmerror then error(7,fatal);
end; {|read_the_parameters|}
@
@<read vunits or hunits or parameter@>=
readmnemonic(mn,[' ']);
if dump then write('Parameter ',mn);
mn := allcaps(mn);
if mn = 'ENDPARAMS'
@<endparams@>
if (mn <> fntnamekey) and (mn <> codingschemekey)
then readexpr(mult,divs);
if divs = 0
then realval := 1.0 * mult
else realval := (1.0 * mult)/(1.0 * divs);
int := mult;
if divs = 1
then isint := true
else isint := false; {only reals have divisor}
if mn = hunitskey
@<hunits@>
else if mn = vunitskey
@<vunits@>
else if mn = fntnamekey
@<fontname@>
else if mn = codingschemekey
@<codingscheme@>
else if mn = deffontkey
@<deffont@>
else if mn = dewidthkey
@<defwidth@>
else if mn = ptsizekey
@<pointsize@>
else begin
@<TEX standard parameter@>
readln(infile);
errlin := errlin + 1;
end; {else..begin}
@
@<endparams@>=
then begin
readln(infile);
errlin := errlin + 1;
goto 0; {marks end of parameters}
end;
@
@<hunits@>=
then begin
hunits := realval;
if dump then writeln(' = ',realval);
end
@
@<vunits@>=
then begin
vunits := realval;
if dump then writeln(' = ',realval);
end
@
@<fontname@>=
then begin
skipblanks;
readmnemonic(fontname,[' ','.']);
fontname := allcaps(fontname);
if dump then writeln(' = ',fontname);
end
@
@<codingscheme@>=
then begin
skipblanks;
readmnemonic(codescheme,[' ','.']);
codescheme := allcaps(codescheme);
if dump then writeln(' = ',codescheme);
end
@
@<deffont@>=
then {set up |def_ft_stuff| record}
with def_ft_stuff do begin
cmd := ord(F); {8600 font command}
if int > maxfont
then error(24,notreallyfatal);
code := int * 10;
uniquecode := int;
if dump then writeln(' = ',int);
end
@
@<defwidth@>=
then {set up |def_width_stuff| record}
with def_width_stuff do begin
{ratio of set width to point size}
cmd := ord(CHWIDTH);
param := realval;
if dump then writeln(' = ',realval);
end
@
@<pointsize@>=
then begin
pointsize := int;
if dump then writeln(' = ',int);
end
@
@<TEX standard parameter@>=
if mn = slantkey
then pp := slant
else if mn = spaceekey
then pp := spacee
else if mn = spstrkey
then pp := spstretch
else if mn = spshrkey
then pp := spshrink
else if mn = xhtkey
then pp := xheight
else if mn = quadkey
then pp := quad
else if mn = exspacekey
then pp := extraspace
@<TEX mathsy parameter@>
@<TEX mathex parameter@>
else error(1,fatal);
params[pp] := realval; {save value of it}
if dump then writeln(' = ',realval);
if pp in paramset[mathex]
then begin
if fontype = standard
then fontype := mathex
else if fontype <> mathex
then error(14,fatal);
end
else if pp in paramset[mathsy]
then begin
if fontype = standard
{change assumption}
then fontype := mathsy
else if fontype <> mathsy
then error(14,fatal);
end; {then..begin}
end; {else..begin TEX}
@
@<TEX mathsy parameter@>=
else if mn = raizen1key
then pp := raisen1
else if mn = raizen2key
then pp := raisen2
else if mn = raizen3key
then pp := raisen3
else if mn = denom1key
then pp := denom1
else if mn = denom2key
then pp := denom2
else if mn = sup1key
then pp := sup1
else if mn = sup2key
then pp := sup2
else if mn = sup3key
then pp := sup3
else if mn = sub1key
then pp := sub1
else if mn = sub2key
then pp := sub2
else if mn = supdrpkey
then pp := supdrop
else if mn = subdrpkey
then pp := subdrop
else if mn = dlims1key
then pp := dlims1
else if mn = dlims2key
then pp := dlims2
else if mn = axishtkey
then pp := axisheight
@
@<TEX mathex parameter@>=
else if mn = dethicknesskey
then pp := defthickness
else if mn = bosp1key
then pp := bgopsp1
else if mn = bosp2key
then pp := bgopsp2
else if mn = bosp3key
then pp := bgopsp3
else if mn = bosp4key
then pp := bgopsp4
else if mn = bosp5key
then pp := bgopsp5
@ finds entry in array list if present and returns its index
as slot. otherwise it adds it at the end of list (specified
by list[-1]) and returns that index as slot.
@p procedure add_to_list(var list :realarray;
entry :real;
lmax :integer;
var slot :integer);
var
linx :integer;
begin
if entry = 0 then begin
slot := 0;
return;
end;
for linx := 1 to trunc(list[-1]) do
if entry = list[linx]
then begin
slot := linx;
return;
end;
{not found}
if trunc(list[-1]) = lmax then error(5,fatal);
list[-1] := list[-1] + 1.0;
list[trunc(list[-1])] := entry;
slot := trunc(list[-1]);
end; {|add_to_list|}
@
@<Global Variables@>=
max :array[comm] of integer;
min :array[comm] of integer;
@ Sets up info needed to read driver file info from the input
file, and write it in proper format into the driver output file
@p procedure init8600commands;
var
cmd :comm;
begin
for cmd := HDR to MAXCMD do begin {initialize 8600 commands}
if cmd in [PS,SS] then begin
min[cmd] := 0;
max[cmd] := 1275;
end
else if cmd in [VMF, VMR, RD] then begin
min[cmd] := 1;
max[cmd] := 1736;
end
else if cmd in [RW, HML, HMR] then begin
min[cmd] := 1;
max[cmd] := 14688;
end
else if cmd in [SL] then begin
min[cmd] := 0;
max[cmd] := 48;
end
else if cmd in [RTWT, RTWB] then begin
min[cmd] := 0;
max[cmd] := 1440;
end
else if cmd in [F] then begin
min[cmd] := 1;
max[cmd] := 255;
end
else begin {catch any others}
min[cmd] := 0;
max[cmd] := 65535; {largest 2 byte integer}
end;
end; {FOR..begin}
end; {init8600commands}
@
@<Global Variables@>=
depth :realarray;
drvdump :boolean;
drvpkt :file of driverrec;
drvoutcount :integer;
dumpval :boolean;
height :realarray;
inrec :string(30);
itcorr :realarray;
kernout :realarray;
numext :integer;
numkerns :integer;
numligs :integer;
numparams :array[fonttypes] of integer;
outstuff :outarray;
str1 :string(30);
str2 :string(30);
terminal :text;
width :realarray;
@
@p procedure initialize;
var
pp :parameter;
outinx :integer;
begin
fontname := trim(parms);
termout(terminal);
termout(output);
rewrite(fontpkt,'NAME='||fontname||'.PRTFM.A');
rewrite(drvpkt,'NAME='||fontname||'.CGINFO.A');
reset(infile,'NAME='||fontname||'.FONTINFO.*');
dump := false;
drvdump := false;
{
while not eof(terminal) do begin
readln(terminal,inrec);
inx := index(inrec,'=');
if inx < 1
then begin
errstr := inrec;
error(28,notreallyfatal);
end
else begin
str1 := substr(inrec,1,inx-1);
str2 := substr(inrec,inx+1,length(inrec)-inx);
str1 := allcaps(ltrim(trim(str1)));
str2 := allcaps(ltrim(trim(str2)));
if str2 = 'false'
then dumpval := false
else if str2 = 'true'
then dumpval := true;
if ((str2 <> 'false') and (str2 <> 'true')) or
((str1 <> 'DUMP') and (str1 <> 'DRVDUMP'))
then begin
errstr := inrec;
error(28,notreallyfatal);
end
else if str1 = 'DUMP'
then dump := dumpval
else drvdump := dumpval;
end;
end;
}
hunits := 1.0 / 54.0;
vunits := 1.0 / 8.0;
lineno := 1;
width[-1] := 0;
width[0] := 0.0; {for non-existent chars}
height[-1] := 0;
height[0] := 0.0; {for non-existent chars}
depth[-1] := 0;
depth[0] := 0.0; {for non-existent chars}
itcorr[-1] := 0;
itcorr[0] := 0.0; {for non-existent chars}
kernout[-1] := 0.0;
kernout[0] := 0.0;
{Set all tag values to 0 = vanilla}
for outinx := 0 to 127 do outstuff[outinx].fourbytes.byte2 := 0;
numkerns := -1;
numligs := -1;
numext := -1;
fontname := ' ';
codescheme := 'PARC TEXT';
fontype := standard;
paramset[standard] := [slant..quad,extraspace];
paramset[mathsy] := [raisen1..axisheight];
paramset[mathex] := [defthickness..bgopsp5];
pointsize := 1;
numparams[standard] := 7;
numparams[mathex] := 13;
numparams[mathsy] := 22;
for pp := slant to extraspace do params[pp] := uninitialized;
drvoutcount := 0; {no records to driver file yet}
init8600commands;
with def_ft_stuff do begin
cmd := ord(F);
code := 10; {font 1, fontlet 0 = def}
end;
with def_width_stuff do begin
cmd := ord(CHWIDTH);
param := 1.0; {normal width type is def}
end;
end;{initialize}
@
@p procedure readentry(var list :realarray;
lmax :integer;
var slot :integer;
units :real);
var
entry :real;
multiplier :integer;
divisor :integer; {save value in expression}
begin
readexpr(multiplier,divisor);
entry := (1.0 * multiplier) / (1.0 * divisor) * units;
if dump then writeln('entry read is ',multiplier:4,'/',
divisor:4,' * ',units:4:2, '=',entry);
add_to_list(list,entry,lmax,slot);
end; {readentry}
@
@<Global Variables@>=
lig :array[0..255] of ligrec;
@ The keyword LIGATURE has just been scanned in the input for one of
characters 0 to 127. Now we expect to find blank separators followed
by the names of the two characters the ligature replaces. These will
be separated by a '+' sign. Since the characters in question may
not have been specified yet, the names will be saved for now, and
looked up after all 128 character entries have been read.
@
@p procedure read_ligature_stuff;
begin
skipblanks;
numligs := numligs+1;
with lig[numligs] do begin
sourceline := lineno; {save line for later error messages}
readmnemonic(firstname,[' ','+']);
if dump then writeln('first char of ligature is ',firstname);
if infile@@ <> '+'
then error(9,notreallyfatal)
else begin
get(infile); {skip plus sign}
if infile@@ = ' ' then error(10,overlookable);
skipblanks; {overlook}
readmnemonic(scndname,[' ']); {read second name}
if dump then writeln('second character of ligature',
' is ',scndname);
end; {else..begin}
ligcode := currchar;
end; {with..begin}
end; {|read_ligature_stuff|}
@
@<Global Variables@>=@/
charno :charindex;
@ look up this name in the name array and tell where and if it was
@p procedure lookup(lookee :string(40);
var charno :charindex; {where if found}
var found :boolean); {was it found}
var
inx :integer;
begin
found := false;
inx := 0;
while not found and (inx<128) do
if name[inx] = lookee
then found := true {found}
else inx := inx + 1; {check next}
if found
then charno := inx
else charno := 127; {not found, avoid out of range err}
if not found
then begin
errstr := lookee; {string for message}
error(12,notreallyfatal);
end; {then..begin}
end; {lookup}
@ Set Tag value in lower 2 bits of byte 2 of outstuff record
@p procedure set_tag_val(chinx :charindex;
tagval :integer);
begin
with outstuff[chinx].fourbytes do begin
if (byte2 mod 4) <> 0
then writeln('Tag for char ',chinx:1,
' already set to ',byte2 mod 4);
if tagval > 3 then error(25,fatal);
byte2 := (byte2 div 4 * 4) + tagval;
end; {with..begin}
end; {|set_tag_val|}
@ Convert a real to a "FIX" which is a 32-bit number stored in the
leftmost 32 bits of a word. The first 12 bits are the integer part, and
the last 20 are the fraction. The left most bit is the sign
@p function scaleout(r :real) :integer;
var
stri :string(8);
int :integer;
begin
int := round(r*'100000'x);
if dump then begin
stri := hex(int);
if length(stri) < 8
then stri := substr('00000000',1,8-length(stri)) || stri;
writeln('FIX of ',r,' is ',int,', hex value="',stri,'"');
end;
scaleout := int;
end; {scaleout}
@
@<Global Variables@>=
found :boolean;
kern :array[0..maxkerns] of kernrec;
mnem :string(40);
@ The keyword KERN has been read: process the rest of the line
@p procedure read_kern_stuff;
begin
numkerns := numkerns + 1;
skipblanks;
with kern[numkerns] do begin
readmnemonic(mnem,[' ','+']);
lookup(mnem,charno,found);
if found
then frstchar := charno
else begin
frstchar := 127;
error(12,notreallyfatal);
end; {else..begin}
if infile@@ = ' '
then begin
error(9,notreallyfatal);
scndchar := 127; {put any old value there}
end
else begin
get(infile); {skip plus sign}
if infile@@ = ' '
then error(10,overlookable);
skipblanks;{overlook it!}
readmnemonic(mnem,[' ','-']);
lookup(mnem,charno,found);
if found
then scndchar := charno
else scndchar := 127;
end; {else..begin}
readentry(kernout,maxkerns,kernslot,hunits);
end; {with}
readln(infile);
errlin := errlin + 1;
end; {|read_kern_stuff|}
@
@<Global Constants@>=
linktag = 2;
@
@p procedure read_link_stuff;
var
mn1 :string(40);
mn2 :string(40);
char1 :charindex;
char2 :charindex;
found :boolean;
begin
skipblanks;
readmnemonic(mn1,[' ']);
lookup(mn1,char1,found);
skipblanks;
readmnemonic(mn2,[' ']);
lookup(mn2,char2,found);
set_tag_val(char1,linktag); {set tag type for special info}
outstuff[char1].fourbytes.byte3 := char2; {next bigger char}
readln(infile);
errlin := errlin + 1;
end;
@
@<Global Constants@>=
maxitcorr = 63;
@
@p procedure read_mathop_stuff;
var
mn :string(40);
charno :charindex;
realval :real;
found :boolean;
slot :integer; {index into itcorr array for kerns}
tag :integer; {saves "tag" value from outstuff array}
begin
skipblanks;
readmnemonic(mn,[' ']);
lookup(mn,charno,found);
readreal(realval);
add_to_list(itcorr,realval,maxitcorr,slot); {add value to list}
with outstuff[charno].fourbytes do begin
tag := byte2 mod 4; {tag is lower 2 bits}
byte2 := slot * 4 + tag; {and ic index is upper 6 bits}
end;{with..begin}
readln(infile);
errlin := errlin + 1;
end; {|read_mathop_stuff|}
@
@<Global Constants@>=
botkey = 'BOT';
extkey = 'EXT';
midkey = 'MID';
topkey = 'TOP';
exttag = 3;
@
@<Global Variables@>=
ext :array[0..127] of extrec;
@ Name and keyword BUILD already read. Now expect keyword=value,
keyword=value, ... Keywords are TOP, MID, BOT, EXT, and values are
char names. Add a miscellaneous entry and point to it from this
character record. initialize the four names in the ext record
and set the four character values to zero. Later we will look up the
names to determine the actual character numbers of the components.
@p procedure read_build_stuff;
var
key :string(40);
charname :string(40);
begin
numext := numext + 1;
with ext[numext] do begin
sourceline := lineno; {save line for later error messages}
top := 0;
mid := 0;
bot := 0;
ext := 0;
topname := '';
midname := '';
botname := '';
extname := '';
end;
set_tag_val(currchar,exttag);
outstuff[currchar].fourbytes.byte3 := numext; {ptr into EXT array}
skipblanks;
repeat
if infile@@ = ',' then get(infile); {skip separator}
readmnemonic(key,['=']);
key := allcaps(key);
get(infile); {skip equal sign delimiter}
readmnemonic(charname,[',',' ']);
if key = topkey then ext[numext].topname := charname
else if key = midkey then ext[numext].midname := charname
else if key = botkey then ext[numext].botname := charname
else if key = extkey then ext[numext].extname := charname
else error(13,fatal);
until infile@@ <> ',';
end; {|read_build_stuff|}
@
@<Global Variables@>=
drvrec :driverrec;
@ Print out the record about to be written to the driver file. This can
be turned on or off by setting constant 'drvdump' to true or false.
@p procedure dump_driver_rec(cmdord :integer);
begin
with drvrec do begin
if drvoutcount = 0
then writeln('*** Driver File Output ***');
write(drvoutcount:3,': ');
drvoutcount := drvoutcount + 1;
write('Command=',com_table[cmdord],', Parameter=');
if (cmdord = ord(CHWIDTH)) or
((cmdord >= ord(VMF)) and (cmdord <= ord(IR))) or
(cmdord = ord(RTWT)) or
(cmdord = ord(RTWB)) or
(cmdord = ord(HMR)) or
(cmdord = ord(HML))
then writeln(param)
else writeln(code);
end; {with..begin}
end; {|dump_driver_rec|}
@
@<Global Variables@>=
stk :array [0..20] of driverrec;
@ Push a record with an integer character code
@p procedure pushcode(var stktop :integer);
var
icode :integer;
begin
readinteger(icode);
if icode > 127 then error(18,notreallyfatal);
stktop := stktop + 1;
with stk[stktop] do begin
cmd := ord(TTS);
code := icode;
end; {with..begin}
end; {pushcode}
@ Reads a command or letter from the input file -- i.e., reads the
1 to 4 char mnemonic and looks it up in array cmdname to find
the enumeration value of type "command" corresponding to it.
A letter is distinguished from a command because a letter has no
parameter whereas all one-character commands do.
@p procedure readcmd(var cmd :comm);
label 99;
var
name :string(9);
ch :string(1);
cmdind :comm;
begin
name := '';
while infile@@ in ['a'..'z','A'..'Z'] do begin
read(infile,ch);
name := name || ch;
end;
name := allcaps(name);
errlstr := name; {save name for error message (if needed)}
{cmd will be the command or MAXCMD if not found}
for cmdind := HDR to MAXCMD do
if name = com_table[ord(cmdind)] then goto 99;
99: cmd := cmdind;
if cmdind = MAXCMD then error(19,notreallyfatal); {bad command}
end; {readcmd}
@ Read the command "cmnd" -- see if it has any parameters, and
if so read them. Push a record on the local stack for this command
@p procedure readparams(var stktop :integer);
var
cmnd :comm;
begin
readcmd(cmnd);
stktop := stktop + 1; {push}
with stk[stktop] do begin
cmd := ord(cmnd);
if cmnd in [AU] {this one has no parameters}
then code := 0
else begin {read integer parm, stuff it into record}
if cmnd in [IR,VMF,VMR,RW,RD,RTWT,RTWB,HMR,HML]
then begin
readreal(param);
if (round(param) < min[cmnd]) or
(round(param) > max[cmnd]) then begin
errlstr := com_table[ord(cmnd)];
errnum := round(param);
errmax := max[cmnd];
errmin := min[cmnd];
error(17,notreallyfatal);
param := min[cmnd];
end; {then..begin}
if cmnd in [VMF,VMR,RD]
then param := param * vunits
else param := param * hunits;
end {then..end}
else begin
readinteger(code);
if (code < min[cmnd]) or
(code > max[cmnd]) then begin
errlstr := com_table[ord(cmnd)];
errnum := code;
errmax := max[cmnd];
errmin := min[cmnd];
error(17,notreallyfatal);
code := min[cmnd];
end; {then..begin}
end; {else..begin}
end; {else..begin}
end; {with..begin}
end; {readparams}
@* Read 8600 Codes.
The 8600 code info corresponding to this character will consist of 1
or more entries separated by commas and containing no blanks. An entry
can be a decimal character code or an 8600 command in which case it
begins with a letter. The command name will be up to 4 letters long and
may be followed by a parameter. Some commands take integer parameters
and others take reals which will be given in the same format as widths,
etc: i.e., as products and quotients of integer values.
Following are listed the possible codes.
\settabs\+\indent&RTWB = &Reverse Type Window Bottom\quad&value=0--1440
in 10ths of a point\cr
\+&PS\hfill =&Point Size\hfill&value=0--1275 in 10ths of a point.\cr
\+&SS\hfill =&Set Size\hfill&value=0--1275 in 10ths of a point.\cr
\+&VMF\hfill =&Vertical Move Forward\hfill&value=1--1736 in 8ths of a
point\cr
\+&VMR\hfill =&Vertical Move Reverse\hfill&value=1--1736 in 8ths of a
point\cr
\+&RD\hfill =&Rule Depth\hfill&value=1--1736 in 8ths of a point\cr
\+&RW\hfill =&Rule Width\hfill&value=1--1736 in 8ths of a point\cr
\+&HML\hfill =&Horizontal Move Left\hfill&value=1--14688 in 18ths of a
point\cr
\+&HMR\hfill =&Horizontal Move Right\hfill&value=1--14688 in 18ths of a
point\cr
\+&SL\hfill =&Slant\hfill&value=0 or 48\cr
\+&IR\hfill =&Insert Rule\cr
\+&AU\hfill =&Auxiliary Font\cr
\+&F\hfill =&Font\hfill&value=1--255\cr
\+&RTWT\hfill =&Reverse Type Window Top\hfill&value=0--1440 in 16ths of
a point\cr
\+&RTWB =&Reverse Type Window Bottom&value=0--1440 in 16ths of a point\cr
@p procedure read8600codes;
var
more_to_come :boolean;
stktop :integer; {gives index of last used (initially 0)}
inx :integer;
begin
skipblanks;
stktop := -1; {no code yet}
if eoln(infile)
then error(20,notreallyfatal) {no code given}
else begin
{Repeat until next is no longer a comma, in which case it
had better be a blank!}
repeat
if infile@@ in ['0'..'9']
then pushcode(stktop) {decimal character code}
else if infile@@ in ['A'..'Z','a'..'z']
{read command and optional parms}
then readparams(stktop)
else error(21,notreallyfatal);
if infile@@ = ','
then begin
more_to_come := true;
get(infile);
end {then..begin}
else more_to_come := false;
until not more_to_come;
end; {else..begin}
{put header record out}
drvrec.cmd := ord(HDR);
drvrec.code := stktop; {how many codes for this character}
if drvdump then dump_driver_rec(drvrec.cmd);
drvpkt@@ := drvrec;
put(drvpkt);
{write out character width record}
drvrec.cmd := ord(CHWIDTH);
drvrec.param := width[outstuff[currchar].fourbytes.byte0];
{nw for the current character indexes its width in points}
if drvdump then dump_driver_rec(drvrec.cmd);
drvpkt@@ := drvrec;
put(drvpkt);
{Put out rec for each code or command}
for inx := 0 to stktop do begin
drvrec := stk[inx];
if drvdump then dump_driver_rec(drvrec.cmd);
drvpkt@@ := drvrec;
put(drvpkt);
end; {FOR..begin}
end; {read8600codes}
@* MAIN PROGRAM.
@<Global Constants@>=
buildkey = 'BUILD';
kernkey = 'KERN';
ligaturekey = 'LIGATURE';
linkkey = 'LINK';
mathopkey = 'MATHOP';
maxdp = 15;
maxht = 15;
maxwd = 255;
ligkerntag = 1;
@
@<Global Variables@>=
chnum :0..127;
chrt :char;
first :boolean;
heightslot :integer;
iny :integer;
itc :real;
ligcnt :integer;
ligout :array[0..255] of memoryword;
pp :parameter;
slot :integer;
tag :integer;
@
@p begin
{--------------- initialize -----------------------}
initialize;
{---------------- read input -------------------------}
read_the_parameters;
{Write first three entries to driver file}
drvrec.cmd := ord(HDR);
drvrec.code := ord(MAXCMD);
if drvdump then dump_driver_rec(drvrec.cmd);
drvpkt@@ := drvrec;
put(drvpkt);
drvrec := def_ft_stuff;
if drvdump then dump_driver_rec(drvrec.cmd);
drvpkt@@ := drvrec;
put(drvpkt);
drvrec := def_width_stuff;
if drvdump then dump_driver_rec(drvrec.cmd);
drvpkt@@ := drvrec;
put(drvpkt);
drvrec.cmd := ord(SL);
if params[slant] = uninitialized
then drvrec.code := 0
else drvrec.code := trunc(params[slant]);
if drvdump then dump_driver_rec(drvrec.cmd);
drvpkt@@ := drvrec;
put(drvpkt);
{Now read entries...}
for currchar := 0 to num_entries-1 do begin
if eof(infile) then error(7,fatal);
with outstuff[currchar].fourbytes do
byte3 := 0; {set remainder to 0}
readmnemonic(mnem,[' ']); {if any}
if dump then writeln('** Processing font info for "',mnem,'"');
name[currchar] := mnem; {save for later use!}
{one non-blank character -- check sequencing}
readstr(mnem,chrt);
if (length(mnem) = 1) and (ordx[chrt] <> currchar)
then error(6,notreallyfatal);
skipblanks; {look at next non-blank}
if infile@@ in ['A'..'Z','a'..'z']
then begin
readmnemonic(mnem,[' ']);
mnem := allcaps(mnem);
if mnem = ligaturekey
then read_ligature_stuff
else if mnem = buildkey
then read_build_stuff
else error(16,fatal);
end; {then..begin}
readentry(width,maxwd,slot,hunits); {read width}
outstuff[currchar].fourbytes.byte0 := slot; {save wid index}
readentry(height,maxht,slot,vunits); {read height}
heightslot := slot; {remember ht slot until depth read}
itc := height[slot] * params[slant]; {it corr = ht * slant}
add_to_list(itcorr,itc,maxitcorr,slot);
with outstuff[currchar].fourbytes do begin
tag := byte2 mod 4; {save tag value}
byte2 := slot * 4 + tag; {put itcorr in 6 bits, tag in 2}
end;
readentry(depth,maxdp,slot,vunits); {read depth}
outstuff[currchar].fourbytes.byte1 := heightslot * 16 + slot;
{now read 8600 information...}
read8600codes;
if not eoln(infile)
then begin
readln(infile);
errlin := errlin + 1;
end;
end; {FOR..begin}
{character entries have all been read...remaining entries
must begin with a keyword: KERN, Link, MATHOP These supply
additional information about certain characters}
while not eof(infile) do begin
readmnemonic(mnem,[' ']);
mnem := allcaps(mnem);
if mnem = kernkey
then read_kern_stuff
else if mnem = linkkey
then read_link_stuff
else if mnem = mathopkey
then read_mathop_stuff
else error(11,fatal);
end; {while..begin}
@<look up lignames@>@/
@<set up ligature info@>@/
@<write font file@>@/
end.
@
@<look up lignames@>=
for inx:= 0 to numligs do
with lig[inx] do begin
errlin := sourceline;
lookup(firstname,frstchar,found);
if not found
then begin
errlin := sourceline;
error(12,notreallyfatal);
frstchar := 127;
end; {then..begin}
lookup(scndname,scndchar,found);
if not found
then begin
errlin := sourceline;
error(12,notreallyfatal);
scndchar := 127;
end; {then..begin}
end; {with..begin}
for inx := 0 to numext do
with ext[inx] do begin
errlin := sourceline;
if topname <> '' then lookup(topname,top,found);
if midname <> '' then lookup(midname,mid,found);
if botname <> '' then lookup(botname,bot,found);
if extname <> '' then lookup(extname,ext,found);
end; {with..begin}
@
@<set up ligature info@>=
ligcnt := 0;
for chnum := 0 to 127 do begin
first := true;
for inx := 0 to numligs do
if lig[inx].frstchar = chnum
then begin
if first then begin
{ptr to first ligature}
outstuff[chnum].fourbytes.byte3 := ligcnt;
set_tag_val(chnum,ligkerntag);
first := false;
end; {then..begin}
with ligout[ligcnt].fourbytes, lig[inx] do
begin {transfer info into output records}
{byte0=1 if last ligature
byte1=next chararacter of ligature
byte2=0 for a ligature
byte3=code of ligature character}
byte0 := '00000000'B;
byte1 := scndchar;
byte2 := '00000000'B;
byte3 := ligcode;
end; {with..begin}
ligcnt := ligcnt+1; {ready for next one}
end; {then..begin}
{Now do same with kerns}
for inx := 0 to numkerns do
if kern[inx].frstchar = chnum
then begin
if first then begin
{link to ligature record}
outstuff[chnum].fourbytes.byte3 := ligcnt;
set_tag_val(chnum,ligkerntag);
first := false; {not anymore}
end; {then..begin}
with ligout[ligcnt].fourbytes, kern[inx] do
begin {transfer info into output records}
{byte0=1 if last kern
byte1=next chararacter of kern
byte2=1 for a kern
byte3=index of kern character}
byte0 := '00000000'B;
byte1 := scndchar;
byte2 := '10000000'B;
byte3 := kernslot;
end; {with..begin}
ligcnt := ligcnt + 1;
end; {FOR,then..begin}
if not first
then ligout[ligcnt-1].fourbytes.byte0 := '10000000'B;
{there was at least one record, so flag the last of 'em}
end; {FOR..begin} {that's all the characters}
@ Now write out in TEX format. TUGboat vol 2, no 1 article
TEX FONT METRIC fileS says the first 12 half-words of the
file are lengths, and obey the following equation:
lenfile=6 + lh + (ec-be+1) + nw + nh + nd + ni + nk + nl + ne + np
lh=length of header=18 words ec=end character=127,
bc=beginning char=0, hence:
lenfile = 6 + 18 + 128 + nw + nh + nd + ni + nk + nl + ne + np
Calculate its value:
@<write font file@>=
if not eof(infile) then error(7,fatal);
lenfile := 6 + 18 + 128 + trunc(width[-1]) + trunc(height[-1])@/
+ trunc(depth[-1]) + trunc(itcorr[-1])@/
+ numkerns + numligs + numext + trunc(kernout[-1])@/
+ numparams[fontype] {num parameters}@/
+ 8; {off by one on nw,nh,nd,ni,nk,nl,ne and kernout}@/
if dump then writeln('Writing info to TEX-readable file');
outcount := 0; {start counting}
writeln('Number of records is ',lenfile:4);
if dump then write('* lf, lh:');
outrec.twohalves.lhword := lenfile; {len of file}
outrec.fourbytes.rhword := 18; {len of header}
writeout(outrec,3);
if dump then write('* bc, ec:');
outrec.twohalves.lhword := 0; {first char code}
outrec.twohalves.rhword := 127; {last char code}
writeout(outrec,3);
if dump then write('* nw, nh:');
outrec.twohalves.lhword := trunc(width[-1]+1);
outrec.twohalves.rhword := trunc(height[-1]+1);
writeout(outrec,3);
if dump then write('* nd, ni:');
outrec.twohalves.lhword := trunc(depth[-1]+1);
outrec.twohalves.rhword := trunc(itcorr[-1]+1);
writeout(outrec,3);
if dump then write('* nl, nk:');
outrec.twohalves.lhword := numligs + numkerns + 2;
outrec.twohalves.rhword := trunc(kernout[-1]+1);
writeout(outrec,3);
if dump then write('* ne, np:');
outrec.twohalves.lhword := numext+1;
outrec.twohalves.rhword := numparams[fontype];
writeout(outrec,3);
if dump then writeln('*** Header info');
outrec.int := uniquecode;
writeout(outrec,6);
outrec.int := scaleout(float(pointsize)); {def = 1 point}
writeout(outrec,2);
writeln('*** Coding Scheme = ',codescheme);
outrec.fourbytes.byte0 := length(codescheme);
for inx := 2 to 40 do begin
iny := inx mod 4;
if iny = 0 then iny := 4;
iny := iny - 1;
if inx-1 <= length(codescheme)
then readstr(substr(codescheme,inx-1,1),chrt)
else chrt := chrx['00'X];
with outrec.fourbytes do case iny of
0 :byte0 := ordx[chrt];
1 :byte1 := ordx[chrt];
2 :byte2 := ordx[chrt];
3 :begin
byte3 := ordx[chrt];
writeout(outrec,4);
end;
otherwise error(99,fatal);
end;
end;
if length(fontname) > 8
then begin
error(27,notreallyfatal);
fontname := substr(fontname,1,8);
end;
writeln('*** Font Name = ',fontname);
outrec.fourbytes.byte0 := length(fontname);
for inx := 2 to 20 do begin
iny := inx mod 4;
if iny = 0 then iny := 4;
iny := iny - 1;
if inx-1 <= length(fontname)
then readstr(substr(fontname,inx-1,1),chrt)
else chrt := chrx['00'X];
with outrec.fourbytes do case iny of
0 :byte0 := ordx[chrt];
1 :byte1 := ordx[chrt];
2 :byte2 := ordx[chrt];
3 :begin
byte3 := ordx[chrt];
writeout(outrec,4);
end;
otherwise error(99,fatal);
end;
end;
outrec.int := 0;
writeout(outrec,6); {no Parc face byte now}
@<Write out FINFO part of font file@>
@<write out widths@>
@<write out heights@>
@<write out depths@>
@<write out itcorrs@>
@<write out ligature/kern programs@>
@<write out extension chars@>
@<write params@>
writeln('End of font file preprocessor');
@
@<Write out FINFO part of font file@>=
for inx := 0 to num_entries-1 do writeout(outstuff[inx],5);
@
@<write out widths@>=
if dump then writeln('*** Widths');
for inx := 0 to trunc(width[-1]) do begin
outrec.int := scaleout(width[inx]);
writeout(outrec,2);
end;
@
@<write out heights@>=
if dump then writeln('*** Heights');
for inx := 0 to trunc(height[-1]) do begin
outrec.int := scaleout(height[inx]);
writeout(outrec,2);
end;
@
@<write out depths@>=
if dump then writeln('*** Depths');
for inx := 0 to trunc(depth[-1]) do begin
outrec.int := scaleout(depth[inx]);
writeout(outrec,2);
end;
@
@<write out itcorrs@>=
if dump then writeln('*** itcorrs');
for inx := 0 to trunc(itcorr[-1]) do begin
outrec.int := scaleout(itcorr[inx]);
writeout(outrec,2);
end;
@
@<write out ligature/kern programs@>=
if dump then writeln('*** Lig/Kern programs');
for inx := 0 to numligs + numkerns + 1 do
writeout(ligout[inx],4);
{write out kern values as fixes}
if dump then writeln('*** Kern values');
for inx := 0 to trunc(kernout[-1]) do begin
outrec.int := scaleout(kernout[inx]);
writeout(outrec,2);
end;
@
@<write out extension chars@>=
if dump then writeln('*** Extension chars');
for inx := 0 to numext do
with ext[inx], outrec.fourbytes do begin
byte0 := top;
byte1 := mid;
byte2 := bot;
byte3 := ext;
writeout(outrec,4);
end; {with..begin}
@
@<write params@>=
if dump then writeln('*** Params');
for pp := slant to bgopsp5 do
if pp in paramset[standard]+paramset[fontype]
then begin
if dump then begin
printparam(pp);
write(': ');
end;
outrec.int := scaleout(params[pp]);
writeout(outrec,2);
end; {then..begin}
@* INDEX.