%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 @@/ type @@/ var @@/ 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. @= maxkerns = 255; num_entries = 128; {maximum number of characters entered} @ @= 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; @ @= oneofsix = 1..6; @ @= 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} @ @= @!error_severity = (fatal,notreallyfatal,overlookable); @ @= @!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; @ @= @!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} @ @= 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; @ @=@/ 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; @ @= 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 @ {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|} @ @= readmnemonic(mn,[' ']); if dump then write('Parameter ',mn); mn := allcaps(mn); if mn = '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 @ else if mn = vunitskey @ else if mn = fntnamekey @ else if mn = codingschemekey @ else if mn = deffontkey @ else if mn = dewidthkey @ else if mn = ptsizekey @ else begin @ readln(infile); errlin := errlin + 1; end; {else..begin} @ @= then begin readln(infile); errlin := errlin + 1; goto 0; {marks end of parameters} end; @ @= then begin hunits := realval; if dump then writeln(' = ',realval); end @ @= then begin vunits := realval; if dump then writeln(' = ',realval); end @ @= then begin skipblanks; readmnemonic(fontname,[' ','.']); fontname := allcaps(fontname); if dump then writeln(' = ',fontname); end @ @= then begin skipblanks; readmnemonic(codescheme,[' ','.']); codescheme := allcaps(codescheme); if dump then writeln(' = ',codescheme); end @ @= 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 @ @= 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 @ @= then begin pointsize := int; if dump then writeln(' = ',int); end @ @= 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 @ @ 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} @ @= 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 @ @= 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|} @ @= 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} @ @= 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} @ @= 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|} @ @=@/ 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} @ @= 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|} @ @= 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; @ @= 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|} @ @= botkey = 'BOT'; extkey = 'EXT'; midkey = 'MID'; topkey = 'TOP'; exttag = 3; @ @= 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|} @ @= 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|} @ @= 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. @= buildkey = 'BUILD'; kernkey = 'KERN'; ligaturekey = 'LIGATURE'; linkkey = 'LINK'; mathopkey = 'MATHOP'; maxdp = 15; maxht = 15; maxwd = 255; ligkerntag = 1; @ @= 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} @@/ @@/ @@/ end. @ @= 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} @ @= 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: @= 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} @ @ @ @ @ @ @ @ writeln('End of font file preprocessor'); @ @= for inx := 0 to num_entries-1 do writeout(outstuff[inx],5); @ @= if dump then writeln('*** Widths'); for inx := 0 to trunc(width[-1]) do begin outrec.int := scaleout(width[inx]); writeout(outrec,2); end; @ @= if dump then writeln('*** Heights'); for inx := 0 to trunc(height[-1]) do begin outrec.int := scaleout(height[inx]); writeout(outrec,2); end; @ @= if dump then writeln('*** Depths'); for inx := 0 to trunc(depth[-1]) do begin outrec.int := scaleout(depth[inx]); writeout(outrec,2); end; @ @= if dump then writeln('*** itcorrs'); for inx := 0 to trunc(itcorr[-1]) do begin outrec.int := scaleout(itcorr[inx]); writeout(outrec,2); end; @ @= 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; @ @= 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} @ @= 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.