1% 2% This file is part of the Omega project, which 3% is based in the web2c distribution of TeX. 4% 5% Copyright (c) 1994--2000 John Plaice and Yannis Haralambous 6% applies only to the changes to the original tftopl.web. 7% 8% This program by D. E. Knuth is not copyrighted and can be used freely. 9% Version 0 was implemented in January 1982. 10% In February 1982 a new restriction on ligature steps was added. 11% In June 1982 the routines were divided into smaller pieces for IBM people, 12% and the result was designated "Version 1" in September 1982. 13% Slight changes were made in October, 1982, for version 0.6 of TeX. 14% Version 2 (July 1983) was released with TeX version 0.999. 15% Version 2.1 (September 1983) changed TEXINFO to FONTDIMEN. 16% Version 2.2 (February 1984) simplified decimal fraction output. 17% Version 2.3 (May 1984) fixed a bug when lh=17. 18% Version 2.4 (July 1984) fixed a bug involving unused ligature code. 19% Version 2.5 (September 1985) updated the standard codingscheme names. 20% Version 3 (October 1989) introduced new ligature capabilities. 21% Version 3.1 (November 1989) renamed z[] to lig_z[] for better portability. 22% Version 3.2 (February 2008) added a newline after a warning message. 23% Version 3.3 (January 2014) added a space to an error message (Breitenlohner), 24% and tests nl>lig_size not 4*lig_size (C. M. Connelly, Melissa O'Neill). 25 26% Version 1.0 of OFM2OPL (December 1995) allows one to read OFM files. 27% Version 1.11 (February 2000). 28% Version 1.12 (September 2009) various bug fixes by Peter Breitenlohner. 29% Version 1.13 (January 2014) more bug fixes. 30 31% Here is TeX material that gets inserted after \input webmac 32\def\hang{\hangindent 3em\indent\ignorespaces} 33\font\ninerm=cmr9 34\let\mc=\ninerm % medium caps for names like SAIL 35\def\PASCAL{Pascal} 36 37\def\(#1){} % this is used to make section names sort themselves better 38\def\9#1{} % this is used for sort keys in the index 39 40\def\title{OFM2OPL} 41\def\contentspagenumber{201} 42\def\topofcontents{\null 43 \def\titlepage{F} % include headline on the contents page 44 \def\rheader{\mainfont\hfil \contentspagenumber} 45 \vfill 46 \centerline{\titlefont The {\ttitlefont OFM2OPL} processor} 47 \vskip 15pt 48 \centerline{(Version 1.13, January 2014)} 49 \vfill} 50\def\botofcontents{\vfill 51 \centerline{\hsize 5in\baselineskip9pt 52 \vbox{\ninerm\noindent 53 The preparation of the original report 54 by D. E. Knuth 55 was supported in part by the National Science 56 Foundation under grants IST-8201926 and MCS-8300984, 57 and by the System Development Foundation. `\TeX' is a 58 trademark of the American Mathematical Society.}}} 59\pageno=\contentspagenumber \advance\pageno by 1 60 61@* Introduction. 62The \.{OFM2OPL} utility program converts $\Omega$ and \TeX\ font 63metric (``\.{TFM}'' and ``\.{OFM}'') files into equivalent 64property-list (``\.{PL}'' and ``\.{OPL}'') files. It also 65makes a thorough check of the given \.{TFM} or \.{OFM} file, 66using essentially the same algorithm as \TeX\ or $\Omega$. Thus 67if \TeX\ or $\Omega$ complains that a \.{TFM} or an \.{OFM} 68file is ``bad,'' this program will pinpoint the source or sources of 69badness. A \.{PL} or \.{OPL} file output by this program can be edited 70with a normal text editor, and the result can be converted back to \.{TFM} 71or \.{OFM} format using the companion program \.{OPL2OFM}. 72 73The first \.{TFtoPL} program was designed by Leo Guibas in the summer of 741978. Contributions by Frank Liang, Doug Wyatt, and Lyle Ramshaw 75also had a significant effect on the evolution of the present code. 76 77Extensions for an enhanced ligature mechanism were added by 78D. E. Knuth in 1989. 79 80Extensions to handle extended font metric files (``\.{OFM}'') were 81added by John Plaice in December 1995 and January 1996, resulting in 82the new program \.{OFM2OPL}. In the following documentation, all 83unchanged references to the \.{TFtoPL} program and to \.{TFM} and 84\.{PL} files also apply to the \.{OFM2OPL} program and to \.{OFM} 85and \.{OPL} files. 86 87The |banner| string defined here should be changed whenever \.{OFM2OPL} 88gets modified. 89 90@d banner=='This is OFM2OPL, Version 1.13' {printed when the program starts} 91 92@ This program is written entirely in standard \PASCAL, except that 93it occasionally has lower case letters in strings that are output. 94Such letters can be converted to upper case if necessary. The input is read 95from |tfm_file|, and the output is written on |pl_file|; error messages and 96other remarks are written on the |output| file, which the user may 97choose to assign to the terminal if the system permits it. 98@^system dependencies@> 99 100The term |print| is used instead of |write| when this program writes on 101the |output| file, so that all such output can be easily deflected. 102 103@d print(#)==write(#) 104@d print_ln(#)==write_ln(#) 105 106@p program OFM2OPL(@!tfm_file,@!pl_file,@!output); 107label @<Labels in the outer block@>@/ 108const @<Constants in the outer block@>@/ 109type @<Types in the outer block@>@/ 110var @<Globals in the outer block@>@/ 111procedure initialize; {this procedure gets things started properly} 112 begin print_ln(banner);@/ 113 @<Set initial values@>@/ 114 end; 115 116@ If the program has to stop prematurely, it goes to the 117`|final_end|'. 118 119@d final_end=9999 {label for the end of it all} 120 121@<Labels...@>=final_end; 122 123@ The following parameters can be changed at compile time to extend or 124reduce \.{TFtoPL}'s capacity. 125 126@d char_max=@"FFFF 127@d xchar_max=char_max+1 128@d xxchar_max=xchar_max+1 129@d xxxchar_max=xxchar_max+1 130 131@<Constants...@>= 132@!tfm_size=2000000; {maximum length of |tfm| data, in bytes} 133@!lig_size=800000; {maximum length of |lig_kern| program, in words} 134@!hash_size=130003; {preferably a prime number, a bit larger than the number 135 of character pairs in lig/kern steps} 136@!hash_mult=16007; {another prime} 137@!max_char=char_max; {the largest character number in a font} 138@!xmax_char=xchar_max; {|max_char|+1} 139@!xxmax_char=xxchar_max;{|max_char|+2} 140@!xmax_label=80001;{must be greater than |max_lig_steps|} 141 142@ Here are some macros for common programming idioms. 143 144@d incr(#) == #:=#+1 {increase a variable by unity} 145@d decr(#) == #:=#-1 {decrease a variable by unity} 146@d do_nothing == {empty statement} 147 148@* Font metric data. 149The following description of \.{TFM} files is not sufficient for 150\.{OFM} files. The additional documentation necessary for the 151\.{OFM} files can be found in another file, such as the $\Omega$ 152change files. 153 154The idea behind \.{TFM} files is that typesetting routines like \TeX\ 155need a compact way to store the relevant information about several 156dozen fonts, and computer centers need a compact way to store the 157relevant information about several hundred fonts. \.{TFM} files are 158compact, and most of the information they contain is highly relevant, 159so they provide a solution to the problem. 160 161The information in a \.{TFM} file appears in a sequence of 8-bit bytes. 162Since the number of bytes is always a multiple of 4, we could 163also regard the file as a sequence of 32-bit words; but \TeX\ uses the 164byte interpretation, and so does \.{TFtoPL}. Note that the bytes 165are considered to be unsigned numbers. 166 167@<Glob...@>= 168@!tfm_file:packed file of 0..255; 169 170@ On some systems you may have to do something special to read a 171packed file of bytes. For example, the following code didn't work 172when it was first tried at Stanford, because packed files have to be 173opened with a special switch setting on the \PASCAL\ that was used. 174@^system dependencies@> 175 176@<Set init...@>= 177reset(tfm_file); 178 179@ The first 24 bytes (6 words) of a \.{TFM} file contain twelve 16-bit 180integers that give the lengths of the various subsequent portions 181of the file. These twelve integers are, in order: 182$$\vbox{\halign{\hfil#&$\null=\null$#\hfil\cr 183|@!lf|&length of the entire file, in words;\cr 184|@!lh|&length of the header data, in words;\cr 185|@!bc|&smallest character code in the font;\cr 186|@!ec|&largest character code in the font;\cr 187|@!nw|&number of words in the width table;\cr 188|@!nh|&number of words in the height table;\cr 189|@!nd|&number of words in the depth table;\cr 190|@!ni|&number of words in the italic correction table;\cr 191|@!nl|&number of words in the lig/kern table;\cr 192|@!nk|&number of words in the kern table;\cr 193|@!ne|&number of words in the extensible character table;\cr 194|@!np|&number of font parameter words.\cr}}$$ 195They are all nonnegative and less than $2^{15}$. We must have |bc-1<=ec<=255|, 196|ne<=256|, and 197$$\hbox{|lf=6+lh+(ec-bc+1)+nw+nh+nd+ni+nl+nk+ne+np|.}$$ 198Note that a font may contain as many as 256 characters (if |bc=0| and |ec=255|), 199and as few as 0 characters (if |bc=ec+1|). 200 201Incidentally, when two or more 8-bit bytes are combined to form an integer of 20216 or more bits, the most significant bytes appear first in the file. 203This is called BigEndian order. 204 205@<Glob...@>= 206@!ofm_level, 207@!nco,@!ncw,@!npc,@!nki,@!nwi,@!nkf,@!nwf,@!nkr,@!nwr,@!nkg,@!nwg,@!nkp,@!nwp, 208@!nkm,@!nwm,@!real_lf,@!nlw,@!neew, 209@!lf,@!lh,@!bc,@!ec,@!nw,@!nh,@!nd,@!ni,@!nl,@!nk,@!ne,@!np,@!font_dir:integer; 210 {subfile sizes} 211@!ofm_on:boolean; 212 213@ @<Set init...@>= 214ofm_on:=false; ofm_level:=-1; lf:=0; lh:=0; 215nco:=0; ncw:=0; npc:=0; bc:=0; ec:=0; nw:=0; nh:=0; nd:=0; ni:=0; 216nl:=0; nk:=0; ne:=0; np:=0; 217nki:=0; nwi:=0; nkf:=0; nwf:=0; 218nkm:=0; nwm:=0; real_lf:=0; 219nkr:=0; nwr:=0; nkg:=0; nwg:=0; 220nkp:=0; nwp:=0; font_dir:=0; 221 222@ The rest of the \.{TFM} file may be regarded as a sequence of ten data 223arrays having the informal specification 224$$\def\arr$[#1]#2${\&{array} $[#1]$ \&{of} #2} 225\vbox{\halign{\hfil\\{#}&$\,:\,$\arr#\hfil\cr 226header&|[0..lh-1]stuff|\cr 227char\_info&|[bc..ec]char_info_word|\cr 228width&|[0..nw-1]fix_word|\cr 229height&|[0..nh-1]fix_word|\cr 230depth&|[0..nd-1]fix_word|\cr 231italic&|[0..ni-1]fix_word|\cr 232lig\_kern&|[0..nl-1]lig_kern_command|\cr 233kern&|[0..nk-1]fix_word|\cr 234exten&|[0..ne-1]extensible_recipe|\cr 235param&|[1..np]fix_word|\cr}}$$ 236The most important data type used here is a |@!fix_word|, which is 237a 32-bit representation of a binary fraction. A |fix_word| is a signed 238quantity, with the two's complement of the entire word used to represent 239negation. Of the 32 bits in a |fix_word|, exactly 12 are to the left of the 240binary point; thus, the largest |fix_word| value is $2048-2^{-20}$, and 241the smallest is $-2048$. We will see below, however, that all but one of 242the |fix_word| values will lie between $-16$ and $+16$. 243 244@ The first data array is a block of header information, which contains 245general facts about the font. The header must contain at least two words, 246and for \.{TFM} files to be used with Xerox printing software it must 247contain at least 18 words, allocated as described below. When different 248kinds of devices need to be interfaced, it may be necessary to add further 249words to the header block. 250 251\yskip\hang|header[0]| is a 32-bit check sum that \TeX\ will copy into the 252\.{DVI} output file whenever it uses the font. Later on when the \.{DVI} 253file is printed, possibly on another computer, the actual font that gets 254used is supposed to have a check sum that agrees with the one in the 255\.{TFM} file used by \TeX. In this way, users will be warned about 256potential incompatibilities. (However, if the check sum is zero in either 257the font file or the \.{TFM} file, no check is made.) The actual relation 258between this check sum and the rest of the \.{TFM} file is not important; 259the check sum is simply an identification number with the property that 260incompatible fonts almost always have distinct check sums. 261@^check sum@> 262 263\yskip\hang|header[1]| is a |fix_word| containing the design size of the 264font, in units of \TeX\ points (7227 \TeX\ points = 254 cm). This number 265must be at least 1.0; it is fairly arbitrary, but usually the design size 266is 10.0 for a ``10 point'' font, i.e., a font that was designed to look 267best at a 10-point size, whatever that really means. When a \TeX\ user 268asks for a font `\.{at} $\delta$ \.{pt}', the effect is to override the 269design size and replace it by $\delta$, and to multiply the $x$ and~$y$ 270coordinates of the points in the font image by a factor of $\delta$ 271divided by the design size. {\sl All other dimensions in the\/\ \.{TFM} 272file are |fix_word|\kern-1pt\ numbers in design-size units.} Thus, for example, 273the value of |param[6]|, one \.{em} or \.{\\quad}, is often the |fix_word| 274value $2^{20}=1.0$, since many fonts have a design size equal to one em. 275The other dimensions must be less than 16 design-size units in absolute 276value; thus, |header[1]| and |param[1]| are the only |fix_word| entries in 277the whole \.{TFM} file whose first byte might be something besides 0 or 278255. @^design size@> 279 280\yskip\hang|header[2..11]|, if present, contains 40 bytes that identify 281the character coding scheme. The first byte, which must be between 0 and 28239, is the number of subsequent ASCII bytes actually relevant in this 283string, which is intended to specify what character-code-to-symbol 284convention is present in the font. Examples are \.{ASCII} for standard 285ASCII, \.{TeX text} for fonts like \.{cmr10} and \.{cmti9}, \.{TeX math 286extension} for \.{cmex10}, \.{XEROX text} for Xerox fonts, \.{GRAPHIC} for 287special-purpose non-alphabetic fonts, \.{UNSPECIFIED} for the default case 288when there is no information. Parentheses should not appear in this name. 289(Such a string is said to be in {\mc BCPL} format.) 290@^coding scheme@> 291 292\yskip\hang|header[12..16]|, if present, contains 20 bytes that name the 293font family (e.g., \.{CMR} or \.{HELVETICA}), in {\mc BCPL} format. 294This field is also known as the ``font identifier.'' 295@^family name@> 296@^font identifier@> 297 298\yskip\hang|header[17]|, if present, contains a first byte called the 299|seven_bit_safe_flag|, then two bytes that are ignored, and a fourth byte 300called the |face|. If the value of the fourth byte is less than 18, it has 301the following interpretation as a ``weight, slope, and expansion'': Add 0 302or 2 or 4 (for medium or bold or light) to 0 or 1 (for roman or italic) to 3030 or 6 or 12 (for regular or condensed or extended). For example, 13 is 3040+1+12, so it represents medium italic extended. A three-letter code 305(e.g., \.{MIE}) can be used for such |face| data. 306 307\yskip\hang|header[18..@twhatever@>]| might also be present; the individual 308words are simply called |header[18]|, |header[19]|, etc., at the moment. 309 310@ Next comes the |char_info| array, which contains one |char_info_word| 311per character. Each |char_info_word| contains six fields packed into 312four bytes as follows. 313 314\yskip\hang first byte: |width_index| (8 bits)\par 315\hang second byte: |height_index| (4 bits) times 16, plus |depth_index| 316 (4~bits)\par 317\hang third byte: |italic_index| (6 bits) times 4, plus |tag| 318 (2~bits)\par 319\hang fourth byte: |remainder| (8 bits)\par 320\yskip\noindent 321The actual width of a character is |width[width_index]|, in design-size 322units; this is a device for compressing information, since many characters 323have the same width. Since it is quite common for many characters 324to have the same height, depth, or italic correction, the \.{TFM} format 325imposes a limit of 16 different heights, 16 different depths, and 32664 different italic corrections. 327 328Incidentally, the relation |width[0]=height[0]=depth[0]=italic[0]=0| 329should always hold, so that an index of zero implies a value of zero. 330The |width_index| should never be zero unless the character does 331not exist in the font, since a character is valid if and only if it lies 332between |bc| and |ec| and has a nonzero |width_index|. 333 334@ The |tag| field in a |char_info_word| has four values that explain how to 335interpret the |remainder| field. 336 337\yskip\hang|tag=0| (|no_tag|) means that |remainder| is unused.\par 338\hang|tag=1| (|lig_tag|) means that this character has a ligature/kerning 339program starting at |lig_kern[remainder]|.\par 340\hang|tag=2| (|list_tag|) means that this character is part of a chain of 341characters of ascending sizes, and not the largest in the chain. The 342|remainder| field gives the character code of the next larger character.\par 343\hang|tag=3| (|ext_tag|) means that this character code represents an 344extensible character, i.e., a character that is built up of smaller pieces 345so that it can be made arbitrarily large. The pieces are specified in 346|exten[remainder]|.\par 347 348@d no_tag=0 {vanilla character} 349@d lig_tag=1 {character has a ligature/kerning program} 350@d list_tag=2 {character has a successor in a charlist} 351@d ext_tag=3 {character is extensible} 352 353@ The |lig_kern| array contains instructions in a simple programming language 354that explains what to do for special letter pairs. Each word is a 355|lig_kern_command| of four bytes. 356 357\yskip\hang first byte: |skip_byte|, indicates that this is the final program 358 step if the byte is 128 or more, otherwise the next step is obtained by 359 skipping this number of intervening steps.\par 360\hang second byte: |next_char|, ``if |next_char| follows the current character, 361 then perform the operation and stop, otherwise continue.''\par 362\hang third byte: |op_byte|, indicates a ligature step if less than~128, 363 a kern step otherwise.\par 364\hang fourth byte: |remainder|.\par 365\yskip\noindent 366In a kern step, an 367additional space equal to |kern[256*(op_byte-128)+remainder]| is inserted 368between the current character and |next_char|. This amount is 369often negative, so that the characters are brought closer together 370by kerning; but it might be positive. 371 372There are eight kinds of ligature steps, having |op_byte| codes $4a+2b+c$ where 373$0\le a\le b+c$ and $0\le b,c\le1$. The character whose code is 374|remainder| is inserted between the current character and |next_char|; 375then the current character is deleted if $b=0$, and |next_char| is 376deleted if $c=0$; then we pass over $a$~characters to reach the next 377current character (which may have a ligature/kerning program of its own). 378 379Notice that if $a=0$ and $b=1$, the current character is unchanged; if 380$a=b$ and $c=1$, the current character is changed but the next character is 381unchanged. \.{TFtoPL} will check to see that infinite loops are avoided. 382 383If the very first instruction of the |lig_kern| array has |skip_byte=255|, 384the |next_char| byte is the so-called right boundary character of this font; 385the value of |next_char| need not lie between |bc| and~|ec|. 386If the very last instruction of the |lig_kern| array has |skip_byte=255|, 387there is a special ligature/kerning program for a left boundary character, 388beginning at location |256*op_byte+remainder|. 389The interpretation is that \TeX\ puts implicit boundary characters 390before and after each consecutive string of characters from the same font. 391These implicit characters do not appear in the output, but they can affect 392ligatures and kerning. 393 394If the very first instruction of a character's |lig_kern| program has 395|skip_byte>128|, the program actually begins in location 396|256*op_byte+remainder|. This feature allows access to large |lig_kern| 397arrays, because the first instruction must otherwise 398appear in a location |<=255|. 399 400Any instruction with |skip_byte>128| in the |lig_kern| array must have 401|256*op_byte+remainder<nl|. If such an instruction is encountered during 402normal program execution, it denotes an unconditional halt; no ligature 403command is performed. 404 405@d stop_flag=128 {value indicating `\.{STOP}' in a lig/kern program} 406@d kern_flag=128 {op code for a kern step} 407 408@ Extensible characters are specified by an |extensible_recipe|, 409which consists of four bytes called |top|, |mid|, 410|bot|, and |rep| (in this order). These bytes are the character codes 411of individual pieces used to build up a large symbol. 412If |top|, |mid|, or |bot| are zero, 413they are not present in the built-up result. For example, an extensible 414vertical line is like an extensible bracket, except that the top and 415bottom pieces are missing. 416 417 418@ The final portion of a \.{TFM} file is the |param| array, which is another 419sequence of |fix_word| values. 420 421\yskip\hang|param[1]=@!slant| is the amount of italic slant, which is used 422to help position accents. For example, |slant=.25| means that when you go 423up one unit, you also go .25 units to the right. The |slant| is a pure 424number; it's the only |fix_word| other than the design size itself that is 425not scaled by the design size. 426 427\hang|param[2]=space| is the normal spacing between words in text. 428Note that character |" "| in the font need not have anything to do with 429blank spaces. 430 431\hang|param[3]=space_stretch| is the amount of glue stretching between words. 432 433\hang|param[4]=space_shrink| is the amount of glue shrinking between words. 434 435\hang|param[5]=x_height| is the height of letters for which accents don't 436have to be raised or lowered. 437 438\hang|param[6]=quad| is the size of one em in the font. 439 440\hang|param[7]=extra_space| is the amount added to |param[2]| at the 441ends of sentences. 442 443When the character coding scheme is \.{TeX math symbols}, the font is 444supposed to have 15 additional parameters called |num1|, |num2|, |num3|, 445|denom1|, |denom2|, |sup1|, |sup2|, |sup3|, |sub1|, |sub2|, |supdrop|, 446|subdrop|, |delim1|, |delim2|, and |axis_height|, respectively. When the 447character coding scheme is \.{TeX math extension}, the font is supposed to 448have six additional parameters called |default_rule_thickness| and 449|big_op_spacing1| through |big_op_spacing5|. 450 451@ So that is what \.{TFM} files hold. The next question is, ``What about 452\.{PL} files?'' A complete answer to that question appears in the 453documentation of the companion program, \.{PLtoTF}, so it will not 454be repeated here. Suffice it to say that a \.{PL} file is an ordinary 455\PASCAL\ text file, and that the output of \.{TFtoPL} uses only a 456subset of the possible constructions that might appear in a \.{PL} file. 457Furthermore, hardly anybody really wants to look at the formal 458definition of \.{PL} format, because it is almost self-explanatory when 459you see an example or two. 460 461@<Glob...@>= 462@!pl_file:text; 463 464@ @<Set init...@>= 465rewrite(pl_file); 466 467@* Unpacked representation. 468The first thing \.{TFtoPL} does is read the entire |tfm_file| into an array of 469bytes, |tfm[0..(4*lf-1)]|. 470 471@<Types...@>= 472@!byte=0..255; {unsigned eight-bit quantity} 473@!index=0..tfm_size; {address of a byte in |tfm|} 474@!char_type=0..char_max; 475@!xchar_type=0..xchar_max; 476@!xxchar_type=0..xxchar_max; 477@!xxxchar_type=0..xxxchar_max; 478 479@ @<Glob...@>= 480@!tfm:array [-1000..tfm_size] of byte; {the input data all goes here} 481 {the negative addresses avoid range checks for invalid characters} 482@!top_char,@!top_width,@!top_height,@!top_depth,@!top_italic:integer; 483@!start_ptr,@!check_sum,@!design_size,@!scheme,@!family,@!random_word:integer; 484@!header_length,@!char_ptr,@!copies,@!j:integer; 485 486@ The input may, of course, be all screwed up and not a \.{TFM} file 487at all. So we begin cautiously. 488 489@d abort(#)==begin print_ln(#); 490 print_ln('Sorry, but I can''t go on; are you sure this is a OFM?'); 491 goto final_end; 492 end 493 494@<Read the whole input file@>= 495read(tfm_file,tfm[0]); 496if tfm[0]>127 then abort('The first byte of the input file exceeds 127!'); 497@.The first byte...@> 498if eof(tfm_file) then abort('The input file is only one byte long!'); 499@.The input...one byte long@> 500read(tfm_file,tfm[1]); lf:=tfm[0]*@'400+tfm[1]; 501if lf=0 then 502 begin for i:=2 to 7 do 503 begin if eof(tfm_file) then 504 abort('The input file is too short to designate its length!'); 505 read(tfm_file, tfm[i]); 506 end; 507 ofm_on := true; ofm_level := tfm[2]*@"100+tfm[3]; 508 if ofm_level>1 then 509 abort('OFMLEVEL ',ofm_level:1,' not supported, must be 0 or 1!'); 510@.OFMLEVEL...must be 0 or 1@> 511 if tfm[4]>127 then abort('The fifth byte of the input file exceeds 127!'); 512@.The fifth byte...@> 513 lf := tfm[4]*@"1000000 + tfm[5]*@"10000 + tfm[6]*@"100 + tfm[7]; 514 end 515else begin ofm_on := false; 516 end; 517case ofm_level of 518-1: begin start_ptr:=2; check_sum:=24; end; 519 0: begin start_ptr:=8; check_sum:=56; end; 520 1: begin start_ptr:=8; check_sum:=116; end; 521end; 522design_size:=check_sum+4; 523scheme:=design_size+4; 524family:=scheme+40; 525random_word:=family+20; 526if lf=0 then 527 abort('The file claims to have length zero, but that''s impossible!'); 528@.The file claims...@> 529if 4*lf-1>tfm_size then abort('The file is bigger than I can handle!'); 530@.The file is bigger...@> 531for tfm_ptr:=start_ptr to 4*lf-1 do 532 begin if eof(tfm_file) then 533 abort('The file has fewer bytes than it claims!'); 534@.The file has fewer bytes...@> 535 read(tfm_file,tfm[tfm_ptr]); 536 end; 537if not eof(tfm_file) then 538 begin print_ln('There''s some extra junk at the end of the OFM file,'); 539@.There's some extra junk...@> 540 print_ln('but I''ll proceed as if it weren''t there.'); 541 end 542 543@ After the file has been read successfully, we look at the subfile sizes 544to see if they check out. 545 546@d eval_two_bytes(#)==begin if tfm[tfm_ptr]>127 then 547 abort('One of the subfile sizes is negative!'); 548@.One of the subfile sizes...@> 549 #:=tfm[tfm_ptr]*@'400+tfm[tfm_ptr+1]; 550 tfm_ptr:=tfm_ptr+2; 551 end 552@d eval_four_bytes(#)==begin if tfm[tfm_ptr]>127 then 553 abort('One of the subfile sizes is negative!'); 554@.One of the subfile sizes...@> 555 #:=tfm[tfm_ptr]*@"1000000+tfm[tfm_ptr+1]*@"10000+ 556 tfm[tfm_ptr+2]*@"100+tfm[tfm_ptr+3]; 557 tfm_ptr:=tfm_ptr+4; 558 end 559 560@<Set subfile sizes |lh|, |bc|, \dots, |np|@>= 561begin 562if not ofm_on then begin 563 tfm_ptr:=2; 564 eval_two_bytes(lh); 565 eval_two_bytes(bc); 566 eval_two_bytes(ec); 567 eval_two_bytes(nw); 568 eval_two_bytes(nh); 569 eval_two_bytes(nd); 570 eval_two_bytes(ni); 571 eval_two_bytes(nl); 572 eval_two_bytes(nk); 573 eval_two_bytes(ne); 574 eval_two_bytes(np); 575 ncw:=(ec-bc+1); 576 nlw:=nl; 577 neew:=ne; 578 header_length:=6; 579 top_char:=255; 580 top_width:=255; 581 top_height:=15; 582 top_depth:=15; 583 top_italic:=63; 584 end 585else begin 586 tfm_ptr:=8; 587 eval_four_bytes(lh); 588 eval_four_bytes(bc); 589 eval_four_bytes(ec); 590 eval_four_bytes(nw); 591 eval_four_bytes(nh); 592 eval_four_bytes(nd); 593 eval_four_bytes(ni); 594 eval_four_bytes(nl); 595 eval_four_bytes(nk); 596 eval_four_bytes(ne); 597 eval_four_bytes(np); 598 eval_four_bytes(font_dir); 599 nlw:=2*nl; 600 neew:=2*ne; 601 top_char:=char_max; 602 top_width:=char_max; 603 top_height:=255; 604 top_depth:=255; 605 top_italic:=255; 606 if ofm_level=0 then begin 607 header_length:=14; 608 ncw:=2*(ec-bc+1); 609 end 610 else begin 611 header_length:=29; 612 eval_four_bytes(nco); 613 eval_four_bytes(ncw); 614 eval_four_bytes(npc); 615 eval_four_bytes(nki); {Kinds of font ivalues} 616 eval_four_bytes(nwi); {Words of font ivalues} 617 eval_four_bytes(nkf); {Kinds of font fvalues} 618 eval_four_bytes(nwf); {Words of font fvalues} 619 eval_four_bytes(nkm); {Kinds of font mvalues} 620 eval_four_bytes(nwm); {Words of font mvalues} 621 eval_four_bytes(nkr); {Kinds of font rules} 622 eval_four_bytes(nwr); {Words of font rules} 623 eval_four_bytes(nkg); {Kinds of font glues} 624 eval_four_bytes(nwg); {Words of font glues} 625 eval_four_bytes(nkp); {Kinds of font penalties} 626 eval_four_bytes(nwp); {Words of font penalties} 627 end; 628 end; 629if lf<>(header_length+lh+ncw+nw+nh+nd+ni+nlw+nk+neew+np+ 630 nki+nwi+nkf+nwf+nkm+nwm+nkr+nwr+nkg+nwg+nkp+nwp) then 631 abort('Subfile sizes don''t add up to the stated total!'); 632@.Subfile sizes don't add up...@> 633if lh<2 then abort('The header length is only ',lh:1,'!'); 634@.The header length...@> 635if nl>lig_size then 636 abort('The lig/kern program is longer than I can handle!'); 637@.The lig/kern program...@> 638if (bc>ec+1)or(ec>top_char) then abort('The character code range ', 639@.The character code range...@> 640 bc:1,'..',ec:1,' is illegal!'); 641if ec>max_char then 642 abort('Character ',ec:1,'is too large. Ask a wizard to enlarge me.'); 643if (nw=0)or(nh=0)or(nd=0)or(ni=0) then 644 abort('Incomplete subfiles for character dimensions!'); 645@.Incomplete subfiles...@> 646if ne>(top_char+1) then abort('There are ',ne:1,' extensible recipes!'); 647@.There are ... recipes@> 648end 649 650@ Once the input data successfully passes these basic checks, 651\.{TFtoPL} believes that it is a \.{TFM} file, and the conversion 652to \.{PL} format will take place. Access to the various subfiles 653is facilitated by computing the following base addresses. For example, 654the |char_info| for character |c| in a \.{TFM} file will start in location 655|4*(char_base+c)| of the |tfm| array. 656 657@<Globals...@>= 658@!ivalues_start,@!fvalues_start,@!mvalues_start, 659@!rules_start,@!glues_start,@!penalties_start: 660integer; 661@!ivalues_base,@!fvalues_base,@!mvalues_base, 662@!rules_base,@!glues_base,@!penalties_base: 663integer; 664@!char_base,@!width_base,@!height_base,@!depth_base,@!italic_base: integer; 665@!lig_kern_base,@!kern_base,@!exten_base,@!param_base:integer; 666 {base addresses for the subfiles} 667@!char_start:array [0..max_char] of integer; 668@!bytes_per_entry:integer; 669 670@ @<Compute the base addresses@>= 671begin 672ivalues_start:=header_length+lh; 673fvalues_start:=ivalues_start+nki; 674mvalues_start:=fvalues_start+nkf; 675rules_start:=mvalues_start+nkm; 676glues_start:=rules_start+nkr; 677penalties_start:=glues_start+nkg; 678ivalues_base:=penalties_start+nkp; 679fvalues_base:=ivalues_base+nwi; 680mvalues_base:=fvalues_base+nwf; 681rules_base:=mvalues_base+nwm; 682glues_base:=rules_base+nwr; 683penalties_base:=glues_base+nwg; 684char_base:=penalties_base+nwp; 685bytes_per_entry:=(12 + 2*npc) div 4 * 4; 686if not ofm_on then begin 687 for i:=bc to ec do begin 688 char_start[i]:=4*char_base+4*(i-bc); 689 end; 690 end 691else if ofm_level=0 then begin 692 for i:=bc to ec do begin 693 char_start[i]:=4*char_base+8*(i-bc); 694 end; 695 end 696else begin 697 char_ptr:=4*char_base; 698 i:=bc; 699 while i<=ec do begin 700 copies:=1+256*tfm[char_ptr+8]+tfm[char_ptr+9]; 701 for j:=1 to copies do begin 702 char_start[i]:=char_ptr; 703 i:=i+1; 704 end; 705 char_ptr:=char_ptr + bytes_per_entry; 706 end; 707 if char_ptr<>(4*(char_base+ncw)) then 708 abort('Length of char info table does not correspond to specification'); 709 end; 710width_base:=char_base+ncw; 711height_base:=width_base+nw; 712depth_base:=height_base+nh; 713italic_base:=depth_base+nd; 714lig_kern_base:=italic_base+ni; 715kern_base:=lig_kern_base+nlw; 716exten_base:=kern_base+nk; 717param_base:=exten_base+neew-1; 718end 719 720@ Of course we want to define macros that suppress the detail of how the 721font information is actually encoded. Each word will be referred to by 722the |tfm| index of its first byte. For example, if |c| is a character 723code between |bc| and |ec|, then |tfm[char_info(c)]| will be the 724first byte of its |char_info|, i.e., the |width_index|; furthermore 725|width(c)| will point to the |fix_word| for |c|'s width. 726 727@d char_info(#)==char_start[#] 728@d nonexistent(#)==((#<bc)or(#>ec)or(width_index(#)=0)) 729@d width(#)==4*(width_base+width_index(#)) 730@d height(#)==4*(height_base+height_index(#)) 731@d depth(#)==4*(depth_base+depth_index(#)) 732@d italic(#)==4*(italic_base+italic_index(#)) 733@d kern(#)==4*(kern_base+#) {here \#\ is an index, not a character} 734@d param(#)==4*(param_base+#) {likewise} 735 736@p function width_index(c:char_type):integer; 737begin if not ofm_on then 738 width_index:=tfm[char_info(c)] 739else 740 width_index:=256*tfm[char_info(c)]+tfm[char_info(c)+1]; 741end; 742 743function height_index(c:char_type):integer; 744begin if not ofm_on then 745 height_index:=tfm[char_info(c)+1] div 16 746else 747 height_index:=tfm[char_info(c)+2]; 748end; 749 750function depth_index(c:char_type):integer; 751begin if not ofm_on then 752 depth_index:=tfm[char_info(c)+1] mod 16 753else 754 depth_index:=tfm[char_info(c)+3]; 755end; 756 757function italic_index(c:char_type):integer; 758begin if not ofm_on then 759 italic_index:=tfm[char_info(c)+2] div 4 760else 761 italic_index:=tfm[char_info(c)+4]; 762end; 763 764function tag(c:char_type):integer; 765begin if not ofm_on then 766 tag:=tfm[char_info(c)+2] mod 4 767else 768 tag:=tfm[char_info(c)+5] mod 4; 769end; 770 771procedure set_no_tag(c:char_type); 772begin if not ofm_on then 773 tfm[char_info(c)+2] := (tfm[char_info(c)+2] div 64)*64 + no_tag 774else 775 tfm[char_info(c)+5] := (tfm[char_info(c)+5] div 64)*64 + no_tag; 776end; 777 778procedure check_unused(c:char_type); 779var @!x:integer; 780begin if ofm_level=1 then x:=tfm[char_info(c)+5] div 8 781else x:=tfm[char_info(c)+5] div 4; 782if x<>0 then begin 783 if ofm_level=1 then x:=tfm[char_info(c)+5] mod 8 784 else x:=tfm[char_info(c)+5] mod 4; 785 tfm[char_info(c)+5]:=x; 786 perfect:=false; if chars_on_line>0 then print_ln(' '); 787 chars_on_line:=0; print_ln('Ignoring non-zero unused char info bits'); 788@.Ignoring non-zero unused...@> 789 end; 790end; 791 792function ctag(c:char_type):boolean; 793begin if not (ofm_level=1) then 794 ctag:=false 795else 796 ctag:=tfm[char_info(c)+5] div 4 mod 2; 797end; 798 799procedure set_no_ctag(c:char_type); 800begin if not (ofm_level=1) then 801 tfm[char_info(c)+5] := 802 tfm[char_info(c)+5] div 8 * 8 + tfm[char_info(c)+5] mod 4; 803end; 804 805function no_repeats(c:char_type):integer; 806begin if ofm_level<=0 then 807 no_repeats:=0 808else 809 no_repeats:=256*tfm[char_info(c)+8]+tfm[char_info(c)+9]; 810end; 811 812function char_param(c:char_type; i:integer):integer; 813begin 814 char_param:=256*tfm[char_info(c)+2*i+10]+tfm[char_info(c)+2*i+11]; 815end; 816 817function rremainder(c:char_type):integer; 818begin if not ofm_on then 819 rremainder:=tfm[char_info(c)+3] 820else 821 rremainder:=256*tfm[char_info(c)+6]+tfm[char_info(c)+7]; 822end; 823 824function lig_step(c:char_type):integer; 825begin if not ofm_on then 826 lig_step:=4*(lig_kern_base+c) 827else 828 lig_step:=4*(lig_kern_base+2*c); 829end; 830 831function exten(c:char_type):integer; 832begin if not ofm_on then 833 exten:=4*(exten_base+rremainder(c)) 834else 835 exten:=4*(exten_base+2*rremainder(c)); 836end; 837 838function l_skip_byte(c:integer):integer; 839begin if not ofm_on then 840 l_skip_byte:=tfm[c] 841else 842 l_skip_byte:=256*tfm[c]+tfm[c+1]; 843end; 844 845procedure set_l_skip_byte(c:integer; newc:integer); 846begin if not ofm_on then 847 tfm[c]:=newc 848else begin 849 tfm[c]:=newc div 256; 850 tfm[c+1]:=newc mod 256 851 end 852end; 853 854function l_next_char(c:integer):integer; 855begin if not ofm_on then 856 l_next_char:=tfm[c+1] 857else 858 l_next_char:=256*tfm[c+2]+tfm[c+3]; 859end; 860 861procedure set_l_next_char(c:integer; newc:char_type); 862begin if not ofm_on then 863 tfm[c+1]:=newc 864else begin 865 tfm[c+2]:=newc div 256; 866 tfm[c+3]:=newc mod 256 867 end 868end; 869 870function l_op_byte(c:integer):integer; 871begin if not ofm_on then 872 l_op_byte:=tfm[c+2] 873else 874 l_op_byte:=256*tfm[c+4]+tfm[c+5]; 875end; 876 877procedure set_l_op_byte(c:integer; newc:integer); 878begin if not ofm_on then 879 tfm[c+2]:=newc 880else begin 881 tfm[c+2]:=newc div 256; 882 tfm[c+3]:=newc mod 256 883 end 884end; 885 886function l_remainder(c:integer):integer; 887begin if not ofm_on then 888 l_remainder:=tfm[c+3] 889else 890 l_remainder:=256*tfm[c+6]+tfm[c+7]; 891end; 892 893procedure set_l_remainder(c:integer; newc:char_type); 894begin if not ofm_on then 895 tfm[c+3]:=newc 896else begin 897 tfm[c+6]:=newc div 256; 898 tfm[c+7]:=newc mod 256 899 end 900end; 901 902@ One of the things we would like to do is take cognizance of fonts whose 903character coding scheme is \.{TeX math symbols} or \.{TeX math extension}; 904we will set the |font_type| variable to one of the three choices 905|vanilla|, |mathsy|, or |mathex|. 906 907@d vanilla=0 {not a special scheme} 908@d mathsy=1 {\.{TeX math symbols} scheme} 909@d mathex=2 {\.{TeX math extension} scheme} 910 911@<Glob...@>= 912@!font_type:vanilla..mathex; {is this font special?} 913 914@* Basic output subroutines. 915Let us now define some procedures that will reduce the rest of \.{TFtoPL}'s 916work to a triviality. 917 918First of all, it is convenient to have an abbreviation for output to the 919\.{PL} file: 920 921@d out(#)==write(pl_file,#) 922 923@ In order to stick to standard \PASCAL, we use three strings called 924|ASCII_04|, |ASCII_10|, and |ASCII_14|, in terms of which we can do the 925appropriate conversion of ASCII codes. Three other little strings are 926used to produce |face| codes like \.{MIE}. 927 928@<Glob...@>= 929@!ASCII_04,@!ASCII_10,@!ASCII_14: packed array [1..32] of char; 930 {strings for output in the user's external character set} 931@!MBL_string,@!RI_string,@!RCE_string:packed array [1..3] of char; 932 {handy string constants for |face| codes} 933@!HEX: packed array [1..16] of char; 934 935@ @<Set init...@>= 936ASCII_04:=' !"#$%&''()*+,-./0123456789:;<=>?';@/ 937ASCII_10:='@@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_';@/ 938ASCII_14:='`abcdefghijklmnopqrstuvwxyz{|}~ ';@/ 939MBL_string:='MBL'; RI_string:='RI '; RCE_string:='RCE'; 940HEX:='0123456789ABCDEF';@/ 941 942@ The array |dig| will hold a sequence of digits to be output. 943 944@<Glob...@>= 945@!dig:array[0..32] of integer; 946 947@ Here, in fact, are two procedures that output |dig[j-1]|$\,\ldots\,$|dig[0]|, 948given $j>0$. 949 950@p procedure out_digs(j:integer); {outputs |j| digits} 951begin repeat decr(j); out(HEX[1+dig[j]]); 952until j=0; 953end; 954@# 955procedure print_digs(j:integer); {prints |j| digits} 956begin repeat decr(j); print(HEX[1+dig[j]]); 957until j=0; 958end; 959 960@ The |print_number| procedure indicates how |print_digs| can be used. 961This procedure can print in octal, decimal or hex notation. 962 963@d print_hex(#)==print_number(#,16) 964@d print_octal(#)==print_number(#,8) 965@d print_decimal(#)==print_number(#,10) 966 967@p procedure print_number(c:integer; form:integer); {prints value of |c|} 968var j:0..32; {index into |dig|} 969begin 970j:=0; 971if (c<0) then begin 972 print_ln('Internal error: print_number (negative value)'); 973 c:=0; 974 end; 975if form=8 then 976 print('''') {an apostrophe indicates the octal notation} 977else if form=16 then 978 print('"') { a double apostrophe indicates the hexadecimal notation} 979else if form<>10 then begin 980 print_ln('Internal error: print_number (form)'); 981 form:=16; 982 end; 983while (c>0) or (j=0) do begin 984 dig[j]:=c mod form; c:=c div form; 985 j:=j+1; 986 end; 987print_digs(j); 988end; 989 990@ A \.{PL} file has nested parentheses, and we want to format the output 991so that its structure is clear. The |level| variable keeps track of the 992depth of nesting. 993 994@<Glob...@>= 995@!level:0..5; 996 997@ @<Set init...@>= 998level:=0; 999 1000@ Three simple procedures suffice to produce the desired structure in the 1001output. 1002 1003@p procedure out_ln; {finishes one line, indents the next} 1004var l:0..5; 1005begin write_ln(pl_file); 1006for l:=1 to level do out(' '); 1007end; 1008@# 1009procedure left; {outputs a left parenthesis} 1010begin incr(level); out('('); 1011end; 1012@# 1013procedure right; {outputs a right parenthesis and finishes a line} 1014begin decr(level); out(')'); out_ln; 1015end; 1016 1017@ The value associated with a property can be output in a variety of 1018ways. For example, we might want to output a {\mc BCPL} string that 1019begins in |tfm[k]|: 1020 1021@p procedure out_BCPL(@!k:index); {outputs a string, preceded by a blank space} 1022var l:0..39; {the number of bytes remaining} 1023begin out(' '); l:=tfm[k]; 1024while l>0 do 1025 begin incr(k); decr(l); 1026 case tfm[k] div @'40 of 1027 1: out(ASCII_04[1+(tfm[k] mod @'40)]); 1028 2: out(ASCII_10[1+(tfm[k] mod @'40)]); 1029 3: out(ASCII_14[1+(tfm[k] mod @'40)]); 1030 end; 1031 end; 1032end; 1033 1034@ The property value might also be a sequence of |l| bytes, beginning 1035in |tfm[k]|, that we would like to output in hex notation. 1036The following procedure assumes that |l<=4|, but larger values of |l| 1037could be handled easily by enlarging the |dig| array and increasing 1038the upper bounds on |b| and |j|. 1039 1040@d out_octal_number(#)==out_number(#,8) 1041@d out_decimal_number(#)==out_number(#,10) 1042@d out_hex_number(#)==out_number(#,16) 1043@d out_dec(#)==out_decimal_number(#) 1044@d out_hex_char(#)==out_hex_number(#) 1045 1046@p procedure out_number(c:integer; form:integer); {outputs value of |c|} 1047var j:0..32; {index into |dig|} 1048begin 1049j:=0; 1050if (c<0) then begin 1051 print_ln('Internal error: print_number (negative value)'); 1052 c:=0; 1053 end; 1054if form=8 then 1055 out(' O ') 1056else if form=10 then 1057 out(' D ') 1058else if form=16 then 1059 out(' H ') 1060else begin 1061 print_ln('Internal error: print_number (form)'); 1062 form:=16; 1063 out(' H ') 1064 end; 1065while (c>0) or (j=0) do begin 1066 dig[j]:=c mod form; c:=c div form; 1067 j:=j+1; 1068 end; 1069out_digs(j); 1070end; 1071@# 1072procedure out_hex(@!k,@!l:index); 1073 {outputs |l| bytes in hex} 1074var a:0..@"7FFFFFFF; {accumulator for bits not yet output} 1075@!b:0..32; {the number of significant bits in |a|} 1076@!j:0..11; {the number of digits of output} 1077begin 1078out(' H '); 1079a:=0; b:=0; j:=0; 1080while l>0 do @<Reduce \(1)|l| by one, preserving the invariants@>; 1081while (a>0)or(j=0) do begin 1082 dig[j]:=a mod 16; a:=a div 16; incr(j); 1083 end; 1084out_digs(j); 1085end; 1086 1087@ @<Reduce \(1)|l|...@>= 1088begin decr(l); 1089if tfm[k+l]<>0 then begin 1090 while b>3 do begin 1091 dig[j]:=a mod 16; a:=a div 16; b:=b-4; incr(j); 1092 end; 1093 case b of 1094 0: a:=tfm[k+l]; 1095 1:a:=a+2*tfm[k+l]; 1096 2:a:=a+4*tfm[k+l]; 1097 3:a:=a+8*tfm[k+l]; 1098 end; 1099 end; 1100b:=b+8; 1101end 1102 1103@ The property value may be a character, which is output in hex 1104unless it is a letter or a digit. This procedure is the only place 1105where a lowercase letter will be output to the \.{PL} file. 1106@^system dependencies@> 1107 1108@p procedure out_char(@!c:integer); {outputs a character} 1109begin if font_type>vanilla then 1110 out_hex_char(c) 1111else if (c>="0")and(c<="9") then 1112 out(' C ',c-"0":1) 1113else if (c>="A")and(c<="Z") then 1114 out(' C ',ASCII_10[c-"A"+2]) 1115else if (c>="a")and(c<="z") then 1116 out(' C ',ASCII_14[c-"a"+2]) 1117else out_hex_char(c); 1118end; 1119 1120@ The property value might be a ``face'' byte, which is output in the 1121curious code mentioned earlier, provided that it is less than 18. 1122 1123@p procedure out_face(@!k:index); {outputs a |face|} 1124var s:0..1; {the slope} 1125@!b:0..8; {the weight and expansion} 1126begin if tfm[k]>=18 then out_hex(k,1) 1127else begin out(' F '); {specify face-code format} 1128 s:=tfm[k] mod 2; b:=tfm[k] div 2; 1129 out(MBL_string[1+(b mod 3)]); 1130 out(RI_string[1+s]); 1131 out(RCE_string[1+(b div 3)]); 1132 end; 1133end; 1134 1135@ And finally, the value might be a |fix_word|, which is output in 1136decimal notation with just enough decimal places for \.{PLtoTF} 1137to recover every bit of the given |fix_word|. 1138 1139All of the numbers involved in the intermediate calculations of 1140this procedure will be nonnegative and less than $10\cdot2^{24}$. 1141 1142@p procedure out_fix(@!k:index); {outputs a |fix_word|} 1143var a:0..@'7777; {accumulator for the integer part} 1144@!f:integer; {accumulator for the fraction part} 1145@!j:0..12; {index into |dig|} 1146@!delta:integer; {amount if allowable inaccuracy} 1147begin out(' R '); {specify real format} 1148a:=(tfm[k]*16)+(tfm[k+1] div 16); 1149f:=((tfm[k+1] mod 16)*@'400+tfm[k+2])*@'400+tfm[k+3]; 1150if a>@'3777 then @<Reduce \(2)negative to positive@>; 1151@<Output the integer part, |a|, in decimal notation@>; 1152@<Output the fraction part, $|f|/2^{20}$, in decimal notation@>; 1153end; 1154 1155@ The following code outputs at least one digit even if |a=0|. 1156 1157@<Output the integer...@>= 1158begin j:=0; 1159repeat dig[j]:=a mod 10; a:=a div 10; incr(j); 1160until a=0; 1161out_digs(j); 1162end 1163 1164@ And the following code outputs at least one digit to the right 1165of the decimal point. 1166 1167@<Output the fraction...@>= 1168begin out('.'); f:=10*f+5; delta:=10; 1169repeat if delta>@'4000000 then f:=f+@'2000000-(delta div 2); 1170out(f div @'4000000:1); f:=10*(f mod @'4000000); delta:=delta*10; 1171until f<=delta; 1172end; 1173 1174@ @<Reduce \(2)negative to positive@>= 1175begin out('-'); a:=@'10000-a; 1176if f>0 then 1177 begin f:=@'4000000-f; decr(a); 1178 end; 1179end 1180 1181@* Doing it. 1182\TeX\ checks the information of a \.{TFM} file for validity as the 1183file is being read in, so that no further checks will be needed when 1184typesetting is going on. And when it finds something wrong, it justs 1185calls the file ``bad,'' without identifying the nature of the problem, 1186since \.{TFM} files are supposed to be good almost all of the time. 1187 1188Of course, a bad file shows up every now and again, and that's where 1189\.{TFtoPL} comes in. This program wants to catch at least as many errors as 1190\TeX\ does, and to give informative error messages besides. 1191All of the errors are corrected, so that the \.{PL} output will 1192be correct (unless, of course, the \.{TFM} file was so loused up 1193that no attempt is being made to fathom it). 1194 1195@ Just before each character is processed, its code is printed in hex 1196notation. Up to eight such codes appear on a line; so we have a variable 1197to keep track of how many are currently there. We also keep track of 1198whether or not any errors have had to be corrected. 1199 1200@<Glob...@>= 1201@!chars_on_line:0..9; {the number of characters printed on the current line} 1202@!perfect:boolean; {was the file free of errors?} 1203 1204@ @<Set init...@>= 1205chars_on_line:=0;@/ 1206perfect:=true; {innocent until proved guilty} 1207 1208@ Error messages are given with the help of the |bad| and |range_error| 1209and |bad_char| macros: 1210 1211@d bad(#)==begin perfect:=false; if chars_on_line>0 then print_ln(' '); 1212 chars_on_line:=0; print_ln('Bad OFM file: ',#); 1213 end 1214@.Bad OFM file@> 1215@d range_error(#)==begin perfect:=false; print_ln(' '); 1216 print(#,' index for character '); 1217 print_hex(c); print_ln(' is too large;'); 1218 print_ln('so I reset it to zero.'); 1219 end 1220@d bad_char_tail(#)==print_hex(#); print_ln('.'); 1221 end 1222@d bad_char(#)==begin perfect:=false; if chars_on_line>0 then print_ln(' '); 1223 chars_on_line:=0; print('Bad OFM file: ',#,' nonexistent character '); 1224 bad_char_tail 1225@d correct_bad_char_tail(#)==#(k,0) 1226 end 1227@d correct_bad_char_middle(#)==print_hex(#(k)); print_ln('.'); 1228 correct_bad_char_tail 1229@d correct_bad_char(#)== begin perfect:=false; 1230 if chars_on_line>0 then print_ln(' '); 1231 chars_on_line:=0; print('Bad OFM file: ',#,' nonexistent character '); 1232 correct_bad_char_middle 1233 1234@<Glob...@>= 1235@!i:integer; {an index to words of a subfile} 1236@!c:xchar_type; {a random character} 1237@!d:0..3; {byte number in a word} 1238@!k:index; {a random index} 1239@!r:0..max_char; {a random two-byte value} 1240@!count:0..127; {for when we need to enumerate a small set} 1241 1242@ There are a lot of simple things to do, and they have to be done one 1243at a time, so we might as well get down to business. The first things 1244that \.{TFtoPL} will put into the \.{PL} file appear in the header part. 1245 1246@<Do the header@>= 1247begin 1248case ofm_level of 12490: begin out('(OFMLEVEL H 0)'); out_ln; end; 12501: begin out('(OFMLEVEL H 1)'); out_ln; end; 1251end; 1252if ofm_on then 1253 begin left; 1254 if font_dir<=7 then out('FONTDIR') 1255 else out('NFONTDIR'); 1256 case font_dir mod 8 of 1257 0: out(' TL'); 1258 1: out(' LT'); 1259 2: out(' TR'); 1260 3: out(' LB'); 1261 4: out(' BL'); 1262 5: out(' RT'); 1263 6: out(' BR'); 1264 7: out(' RB'); 1265 end; 1266 right 1267 end; 1268font_type:=vanilla; 1269if lh>=12 then begin 1270 @<Set the true |font_type|@>; 1271 if lh>=17 then begin 1272 @<Output the family name@>; 1273 if lh>=18 then @<Output the rest of the header@>; 1274 end; 1275 @<Output the character coding scheme@>; 1276 end; 1277@<Output the design size@>; 1278@<Output the check sum@>; 1279@<Output the |seven_bit_safe_flag|@>; 1280end 1281 1282@ @<Output the check sum@>= 1283left; out('CHECKSUM'); out_hex(check_sum,4); 1284right 1285 1286@ Incorrect design sizes are changed to 10 points. 1287 1288@d bad_design(#)==begin bad('Design size ',#,'!'); 1289@.Design size wrong@> 1290 print_ln('I''ve set it to 10 points.'); 1291 out(' D 10'); 1292 end 1293 1294@ @<Output the design size@>= 1295left; out('DESIGNSIZE'); 1296if tfm[design_size]>127 then bad_design('negative') 1297else if (tfm[design_size]=0)and(tfm[design_size+1]<16) then 1298 bad_design('too small') 1299else out_fix(design_size); 1300right; 1301out('(COMMENT DESIGNSIZE IS IN POINTS)'); out_ln; 1302out('(COMMENT OTHER SIZES ARE MULTIPLES OF DESIGNSIZE)'); out_ln 1303@.DESIGNSIZE IS IN POINTS@> 1304 1305@ Since we have to check two different {\mc BCPL} strings for validity, 1306we might as well write a subroutine to make the check. 1307 1308@p procedure check_BCPL(@!k,@!l:index); {checks a string of length |<l|} 1309var j:index; {runs through the string} 1310@!c:integer; {character being checked} 1311begin if tfm[k]>=l then 1312 begin bad('String is too long; I''ve shortened it drastically.'); 1313@.String is too long...@> 1314 tfm[k]:=1; 1315 end; 1316for j:=k+1 to k+tfm[k] do 1317 begin c:=tfm[j]; 1318 if (c="(")or(c=")") then 1319 begin bad('Parenthesis in string has been changed to slash.'); 1320@.Parenthesis...changed to slash@> 1321 tfm[j]:="/"; 1322 end 1323 else if (c<" ")or(c>"~") then 1324 begin bad('Nonstandard ASCII code has been blotted out.'); 1325@.Nonstandard ASCII code...@> 1326 tfm[j]:="?"; 1327 end 1328 else if (c>="a")and(c<="z") then tfm[j]:=c+"A"-"a"; {upper-casify letters} 1329 end; 1330end; 1331 1332@ The |font_type| starts out |vanilla|; possibly we need to reset it. 1333 1334@<Set the true |font_type|@>= 1335begin check_BCPL(scheme,40); 1336if (tfm[scheme]>=11)and@|(tfm[scheme+1]="T")and@| 1337 (tfm[scheme+2]="E")and@|(tfm[scheme+3]="X")and@| 1338 (tfm[scheme+4]=" ")and@|(tfm[scheme+5]="M")and@| 1339 (tfm[scheme+6]="A")and@|(tfm[scheme+7]="T")and@| 1340 (tfm[scheme+8]="H")and@|(tfm[scheme+9]=" ") then 1341 begin if (tfm[scheme+10]="S")and(tfm[scheme+11]="Y") then font_type:=mathsy 1342 else if (tfm[scheme+10]="E")and(tfm[scheme+11]="X") then font_type:=mathex; 1343 end; 1344end 1345 1346@ @<Output the character coding scheme@>= 1347left; out('CODINGSCHEME'); 1348out_BCPL(scheme); 1349right 1350 1351@ @<Output the family name@>= 1352left; out('FAMILY'); 1353check_BCPL(family,20); 1354out_BCPL(family); 1355right 1356 1357@ @<Output the rest of the header@>= 1358begin left; out('FACE'); out_face(random_word+3); right; 1359for i:=18 to lh-1 do 1360 begin left; out('HEADER D ',i:1); 1361 out_hex(check_sum+4*i,@,4); right; 1362 end; 1363end 1364 1365@ This program does not check to see if the |seven_bit_safe_flag| has the 1366correct setting, i.e., if it really reflects the seven-bit-safety of 1367the \.{TFM} file; the stated value is merely put into the \.{PL} file. 1368The \.{PLtoTF} program will store a correct value and give a warning 1369message if a file falsely claims to be safe. 1370 1371\.{OFM} files are assumed to be seven-bit-unsafe. 1372 1373@<Output the |seven_bit_safe_flag|@>= 1374if ofm_on then 1375 begin left; out('SEVENBITSAFEFLAG FALSE'); right; 1376 end 1377else if (lh>17) and (tfm[random_word]>127) then 1378 begin left; out('SEVENBITSAFEFLAG TRUE'); right; 1379 end 1380 1381@ The next thing to take care of is the list of parameters. 1382 1383@<Do the parameters@>= 1384if np>0 then 1385 begin left; out('FONTDIMEN'); out_ln; 1386 for i:=1 to np do @<Check and output the $i$th parameter@>; 1387 right; 1388 end; 1389@<Check to see if |np| is complete for this font type@>; 1390 1391@ @<Check to see if |np|...@>= 1392if (font_type=mathsy)and(np<>22) then 1393 print_ln('Unusual number of fontdimen parameters for a math symbols font (', 1394@.Unusual number of fontdimen...@> 1395 np:1,' not 22).') 1396else if (font_type=mathex)and(np<>13) then 1397 print_ln('Unusual number of fontdimen parameters for an extension font (', 1398 np:1,' not 13).') 1399 1400@ All |fix_word| values except the design size and the first parameter 1401will be checked to make sure that they are less than 16.0 in magnitude, 1402using the |check_fix| macro: 1403 1404@d check_fix_tail(#)==bad(#,' ',i:1,' is too big;'); 1405 print_ln('I have set it to zero.'); 1406 end 1407@d check_fix(#)==if (tfm[#]>0)and(tfm[#]<255) then 1408 begin tfm[#]:=0; tfm[(#)+1]:=0; tfm[(#)+2]:=0; tfm[(#)+3]:=0; 1409 check_fix_tail 1410 1411@<Check and output the $i$th parameter@>= 1412begin left; 1413if i=1 then out('SLANT') {this parameter is not checked} 1414else begin check_fix(param(i))('Parameter');@/ 1415@.Parameter n is too big@> 1416 @<Output the name of parameter $i$@>; 1417 end; 1418out_fix(param(i)); right; 1419end 1420 1421@ @<Output the name...@>= 1422if i<=7 then case i of 1423 2:out('SPACE');@+3:out('STRETCH');@+4:out('SHRINK'); 1424 5:out('XHEIGHT');@+6:out('QUAD');@+7:out('EXTRASPACE')@+end 1425else if (i<=22)and(font_type=mathsy) then case i of 1426 8:out('NUM1');@+9:out('NUM2');@+10:out('NUM3'); 1427 11:out('DENOM1');@+12:out('DENOM2'); 1428 13:out('SUP1');@+14:out('SUP2');@+15:out('SUP3'); 1429 16:out('SUB1');@+17:out('SUB2'); 1430 18:out('SUPDROP');@+19:out('SUBDROP'); 1431 20:out('DELIM1');@+21:out('DELIM2'); 1432 22:out('AXISHEIGHT')@+end 1433else if (i<=13)and(font_type=mathex) then 1434 if i=8 then out('DEFAULTRULETHICKNESS') 1435 else out('BIGOPSPACING',i-8:1) 1436else out('PARAMETER D ',i:1) 1437 1438@ @<Glob...@>= 1439@!start_counter,@!base_counter,@!number_entries:integer; 1440@!value:integer; 1441 1442@ @<Do the ivalue parameters@>= 1443if nki>0 then begin 1444 start_counter:=ivalues_start*4; 1445 base_counter:=ivalues_base*4; 1446 for i:=0 to nki-1 do @<Check and output the $i$th ivalue table@>; 1447 end; 1448 1449@ @<Check and output the $i$th ivalue table@>= 1450begin 1451left; out('FONTIVALUE'); out_hex_number(i); out_ln; 1452number_entries:=256*tfm[start_counter+2]+tfm[start_counter+3]; 1453for j:=0 to number_entries-1 do begin 1454 left; out('IVALUE'); out_hex_number(j); out_ln; 1455 value:=256*tfm[base_counter+2]+tfm[base_counter+3]; 1456 left; out('IVALUEVAL'); out_hex_number(value); right; 1457 right; 1458 base_counter:=base_counter+4; 1459 end; 1460right; 1461start_counter:=start_counter+4; 1462end; 1463 1464@ @<Do the fvalue parameters@>= 1465if nkf>0 then begin 1466 start_counter:=fvalues_start*4; 1467 base_counter:=fvalues_base*4; 1468 for i:=0 to nkf-1 do @<Check and output the $i$th fvalue table@>; 1469 end; 1470 1471@ @<Check and output the $i$th fvalue table@>= 1472begin 1473left; out('FONTFVALUE'); out_hex_number(i); out_ln; 1474number_entries:=256*tfm[start_counter+2]+tfm[start_counter+3]; 1475for j:=0 to number_entries-1 do begin 1476 left; out('FVALUE'); out_hex_number(j); out_ln; 1477 left; out('FVALUEVAL'); out_fix(base_counter); right; 1478 right; 1479 base_counter:=base_counter+4; 1480 end; 1481right; 1482start_counter:=start_counter+4; 1483end; 1484 1485@ @<Do the mvalue parameters@>= 1486if nkm>0 then begin 1487 start_counter:=mvalues_start*4; 1488 base_counter:=mvalues_base*4; 1489 for i:=0 to nkm-1 do @<Check and output the $i$th mvalue table@>; 1490 end; 1491 1492@ @<Check and output the $i$th mvalue table@>= 1493begin 1494left; out('FONTMVALUE'); out_hex_number(i); out_ln; 1495number_entries:=256*tfm[start_counter+2]+tfm[start_counter+3]; 1496for j:=0 to number_entries-1 do begin 1497 left; out('MVALUE'); out_hex_number(j); out_ln; 1498 left; out('MVALUEVAL'); out_fix(base_counter); right; 1499 right; 1500 base_counter:=base_counter+4; 1501 end; 1502right; 1503start_counter:=start_counter+4; 1504end; 1505 1506@ @<Do the rule parameters@>= 1507if nkr>0 then 1508 begin start_counter:=rules_start*4; 1509 base_counter:=rules_base*4; 1510 for i:=0 to nkr-1 do @<Check and output the $i$th rule table@>; 1511 end 1512 1513@ @<Check and output the $i$th rule table@>= 1514begin left; out('FONTRULE'); out_hex_number(i); out_ln; 1515number_entries:=256*tfm[start_counter+2]+tfm[start_counter+3]; 1516for j:=0 to number_entries-1 do 1517 begin left; out('RULE'); out_hex_number(j); out_ln; 1518 left; out('RULEWD'); out_fix(base_counter); right; 1519 left; out('RULEHT'); out_fix(base_counter+4); right; 1520 left; out('RULEDP'); out_fix(base_counter+8); right; 1521 right; 1522 base_counter:=base_counter+12; 1523 end; 1524right; 1525start_counter:=start_counter+4; 1526end; 1527 1528@ @<Do the glue parameters@>= 1529if nkg>0 then 1530 begin start_counter:=glues_start*4; 1531 base_counter:=glues_base*4; 1532 for i:=0 to nkg-1 do @<Check and output the $i$th glue table@>; 1533 end; 1534 1535@ @<Glob...@>= 1536@!glue_subtype,@!glue_argument_kind,@!glue_stretch_order, 1537@!glue_shrink_order,@!glue_argument:integer; 1538 1539@ @<Check and output the $i$th glue table@>= 1540begin left; out('FONTGLUE'); out_hex_number(i); out_ln; 1541number_entries:=256*tfm[start_counter+2]+tfm[start_counter+3]; 1542for j:=0 to number_entries-1 do 1543 begin left; out('GLUE'); out_hex_number(j); out_ln; 1544 glue_subtype:=tfm[base_counter] div 16; 1545 glue_argument_kind:=tfm[base_counter] mod 16; 1546 glue_stretch_order:=tfm[base_counter+1] div 16; 1547 glue_shrink_order:=tfm[base_counter+1] mod 16; 1548 glue_argument:=tfm[base_counter+2]*256+tfm[base_counter+3]; 1549 left; 1550 out('GLUETYPE'); 1551 case glue_subtype of 1552 0: out(' H 0'); 1553 1: out(' H 1'); 1554 2: out(' H 2'); 1555 3: out(' H 3'); 1556 end; 1557 right; 1558 case glue_argument_kind of 1559 1: begin 1560 left; out('GLUERULE'); out_hex_number(glue_argument); right; 1561 end; 1562 2: begin 1563 left; out('GLUECHAR'); out_hex_number(glue_argument); right; 1564 end; 1565 end; 1566 left; 1567 out('GLUESTRETCHORDER'); 1568 case glue_stretch_order of 1569 0: out(' H 0'); 1570 1: out(' H 1'); 1571 2: out(' H 2'); 1572 3: out(' H 3'); 1573 4: out(' H 4'); 1574 end; 1575 right; 1576 left; 1577 out('GLUESHRINKORDER'); 1578 case glue_shrink_order of 1579 0: out(' H 0'); 1580 1: out(' H 1'); 1581 2: out(' H 2'); 1582 3: out(' H 3'); 1583 4: out(' H 4'); 1584 end; 1585 right; 1586 left; out('GLUEWD'); out_fix(base_counter+4); right; 1587 left; out('GLUESTRETCH'); out_fix(base_counter+8); right; 1588 left; out('GLUESHRINK'); out_fix(base_counter+12); right; 1589 right; 1590 base_counter:=base_counter+16; 1591 end; 1592right; 1593start_counter:=start_counter+4; 1594end; 1595 1596@ @<Do the penalty parameters@>= 1597if nkp>0 then 1598 begin start_counter:=penalties_start*4; 1599 base_counter:=penalties_base*4; 1600 for i:=0 to nkp-1 do @<Check and output the $i$th penalty table@>; 1601 end; 1602 1603@ @<Check and output the $i$th penalty table@>= 1604begin 1605left; out('FONTPENALTY'); out_hex_number(i); out_ln; 1606number_entries:=256*tfm[start_counter+2]+tfm[start_counter+3]; 1607for j:=0 to number_entries-1 do begin 1608 left; out('PENALTY'); out_hex_number(j); out_ln; 1609 value:=256*tfm[base_counter+2]+tfm[base_counter+3]; 1610 left; out('PENALTYVAL'); out_hex_number(value); right; 1611 right; 1612 base_counter:=base_counter+4; 1613 end; 1614right; 1615start_counter:=start_counter+4; 1616end; 1617 1618@ We need to check the range of all the remaining |fix_word| values, 1619and to make sure that |width[0]=0|, etc. 1620 1621@d nonzero_fix(#)==(tfm[#]>0)or(tfm[#+1]>0)or(tfm[#+2]>0)or(tfm[#+3]>0) 1622 1623@<Check the |fix_word| entries@>= 1624if nonzero_fix(4*width_base) then bad('width[0] should be zero.'); 1625@.should be zero@> 1626if nonzero_fix(4*height_base) then bad('height[0] should be zero.'); 1627if nonzero_fix(4*depth_base) then bad('depth[0] should be zero.'); 1628if nonzero_fix(4*italic_base) then bad('italic[0] should be zero.'); 1629for i:=0 to nw-1 do check_fix(4*(width_base+i))('Width'); 1630@.Width n is too big@> 1631for i:=0 to nh-1 do check_fix(4*(height_base+i))('Height'); 1632@.Height n is too big@> 1633for i:=0 to nd-1 do check_fix(4*(depth_base+i))('Depth'); 1634@.Depth n is too big@> 1635for i:=0 to ni-1 do check_fix(4*(italic_base+i))('Italic correction'); 1636@.Italic correction n is too big@> 1637if nk>0 then for i:=0 to nk-1 do check_fix(kern(i))('Kern'); 1638@.Kern n is too big@> 1639 1640@ The ligature/kerning program comes next. Before we can put it out in 1641\.{PL} format, we need to make a table of ``labels'' that will be inserted 1642into the program. For each character |c| whose |tag| is |lig_tag| and 1643whose starting address is |r|, we will store the pair |(c,r)| in the 1644|label_table| array. If there's a boundary-char program starting at~|r|, 1645we also store the pair |(256,r)|. 1646This array is sorted by its second components, using the 1647simple method of straight insertion. 1648 1649@<Glob...@>= 1650@!label_table:array[xxxchar_type] of record 1651@!cc:xchar_type;@!rr:0..lig_size;ischar:boolean;end; 1652@!label_ptr:xxchar_type; {the largest entry in |label_table|} 1653@!sort_ptr:xxchar_type; {index into |label_table|} 1654@!boundary_char:xchar_type; {boundary character, or |xmax_char| if none} 1655@!bchar_label:0..xmax_label; {beginning of boundary character program} 1656 1657@ @<Set init...@>= 1658boundary_char:=xmax_char; bchar_label:=xmax_label;@/ 1659label_ptr:=0; label_table[0].rr:=0; {a sentinel appears at the bottom} 1660 1661@ We'll also identify and remove inaccessible program steps, using the 1662|activity| array. 1663 1664@d unreachable=0 {a program step not known to be reachable} 1665@d pass_through=1 {a program step passed through on initialization} 1666@d accessible=2 {a program step that can be relevant} 1667 1668@<Glob...@>= 1669@!activity:array[0..lig_size] of unreachable..accessible; 1670@!ai,@!acti:0..lig_size; {indices into |activity|} 1671 1672@ @<Do the ligatures and kerns@>= 1673if nl>0 then 1674 begin for ai:=0 to nl-1 do activity[ai]:=unreachable; 1675 @<Check for a boundary char@>; 1676 end; 1677@<Build the label table@>; 1678if nl>0 then 1679 begin left; out('LIGTABLE'); out_ln;@/ 1680 @<Compute the |activity| array@>; 1681 @<Output and correct the ligature/kern program@>; 1682 right; 1683 @<Check for ligature cycles@>; 1684 end 1685 1686@ We build the label table even when |nl=0|, because this catches errors 1687that would not otherwise be detected. 1688 1689@<Build...@>= 1690for c:=bc to ec do 1691if (tag(c)=lig_tag) or (ctag(c)) then 1692 begin r:=rremainder(c); 1693 if (l_skip_byte(lig_step(r)) div 256)=0 then begin 1694 if r<nl then begin 1695 if l_skip_byte(lig_step(r))>stop_flag then begin 1696 r:=256*l_op_byte(lig_step(r))+l_remainder(lig_step(r)); 1697 if r<nl then 1698 if activity[rremainder(c)]=unreachable then 1699 activity[rremainder(c)]:=pass_through; 1700 end; 1701 end; 1702 end; 1703 if r>=nl then 1704 begin perfect:=false; print_ln(' '); 1705 print('Ligature/kern starting index for character '); print_hex(c); 1706 print_ln(' is too large;'); print_ln('so I removed it.'); set_no_tag(c); 1707 set_no_ctag(c); 1708@.Ligature/kern starting index...@> 1709 end 1710 else @<Insert |(c,r)| into |label_table|@>; 1711 end; 1712label_table[label_ptr+1].rr:=lig_size; {put ``infinite'' sentinel at the end} 1713 1714@ @<Insert |(c,r)|...@>= 1715begin sort_ptr:=label_ptr; {there's a hole at position |sort_ptr+1|} 1716while label_table[sort_ptr].rr>r do 1717 begin label_table[sort_ptr+1]:=label_table[sort_ptr]; 1718 decr(sort_ptr); {move the hole} 1719 end; 1720label_table[sort_ptr+1].ischar:=not ctag(c); 1721if ctag(c) then 1722 label_table[sort_ptr+1].cc:=char_param(c,0) 1723else 1724 label_table[sort_ptr+1].cc:=c; 1725label_table[sort_ptr+1].rr:=r; {fill the hole} 1726incr(label_ptr); activity[r]:=accessible; 1727end 1728 1729@ @<Check for a bound...@>= 1730if l_skip_byte(lig_step(0))=255 then 1731 begin left; out('BOUNDARYCHAR'); 1732 boundary_char:=l_next_char(lig_step(0)); out_char(boundary_char); right; 1733 activity[0]:=pass_through; 1734 end; 1735if l_skip_byte(lig_step(nl-1))=255 then 1736 begin r:=256*l_op_byte(lig_step(nl-1))+l_remainder(lig_step(nl-1)); 1737 if r>=nl then 1738 begin perfect:=false; print_ln(' '); 1739 print('Ligature/kern starting index for boundarychar is too large;'); 1740 print_ln('so I removed it.'); 1741@.Ligature/kern starting index...@> 1742 end 1743 else begin label_ptr:=1; label_table[1].cc:=xmax_char; label_table[1].rr:=r; 1744 bchar_label:=r; activity[r]:=accessible; 1745 end; 1746 activity[nl-1]:=pass_through; 1747 end 1748 1749@ @<Compute the |activity| array@>= 1750for ai:=0 to (nl-1) do 1751if (l_skip_byte(lig_step(ai)) div 256)=1 then 1752 activity[ai]:=accessible 1753else if activity[ai]=accessible then begin 1754 r:=l_skip_byte(lig_step(ai)); 1755 if r<stop_flag then begin 1756 r:=r+ai+1; 1757 if r>=nl then begin 1758 bad('Ligature/kern step ',ai:1,' skips too far;'); 1759@.Lig...skips too far@> 1760 print_ln('I made it stop.'); set_l_skip_byte(lig_step(ai),stop_flag); 1761 end 1762 else activity[r]:=accessible; 1763 end; 1764 end 1765 1766@ We ignore |pass_through| items, which don't need to be mentioned in 1767the \.{PL} file. 1768 1769@<Output and correct the ligature...@>= 1770sort_ptr:=1; {point to the next label that will be needed} 1771for acti:=0 to nl-1 do if activity[acti]<>pass_through then 1772 begin i:=acti; @<Take care of commenting out unreachable steps@>; 1773 @<Output any labels for step $i$@>; 1774 @<Output step $i$ of the ligature/kern program@>; 1775 end; 1776if level=2 then right {the final step was unreachable} 1777 1778@ @<Globals...@>= 1779@!output_clabels:array[0..256] of boolean; 1780@!clabel_runner:integer; 1781 1782@ @<Set init...@>= 1783for clabel_runner:=0 to 256 do 1784 output_clabels[clabel_runner]:=false; 1785 1786@ @<Output any labels...@>= 1787while i=label_table[sort_ptr].rr do begin 1788 if label_table[sort_ptr].cc<>xmax_char and not label_table[sort_ptr].ischar then begin 1789 if not output_clabels[label_table[sort_ptr].cc] then begin 1790 output_clabels[label_table[sort_ptr].cc]:=true; 1791 left; 1792 out('CLABEL'); 1793 out_char(label_table[sort_ptr].cc); 1794 right; 1795 end 1796 end 1797 else begin 1798 left; 1799 out('LABEL'); 1800 if label_table[sort_ptr].cc=xmax_char then out(' BOUNDARYCHAR') 1801 else out_char(label_table[sort_ptr].cc); 1802 right; 1803 end; 1804 incr(sort_ptr); 1805 end 1806 1807@ @<Take care of commenting out...@>= 1808if activity[i]=unreachable then 1809 begin if level=1 then 1810 begin left; out('COMMENT THIS PART OF THE PROGRAM IS NEVER USED!'); out_ln; 1811 end 1812 end 1813else if level=2 then right 1814 1815@ @<Output step $i$...@>= 1816begin k:=lig_step(i); 1817if (l_skip_byte(k) div 256)=1 then begin 1818 case l_op_byte(k) of 1819 17: begin 1820 left; out('CPEN'); 1821 out_hex_number(l_next_char(k)); 1822 out_hex_number(l_remainder(k)); 1823 right; 1824 end; 1825 18: begin 1826 left; out('CGLUE'); 1827 out_hex_number(l_next_char(k)); 1828 out_hex_number(l_remainder(k)); 1829 right; 1830 end; 1831 19: begin 1832 left; out('CPENGLUE'); 1833 out_hex_number(l_next_char(k)); 1834 out_hex_number(l_remainder(k) div 256); 1835 out_hex_number(l_remainder(k) mod 256); 1836 right; 1837 end; 1838 20: begin 1839 left; out('CKRN'); 1840 out_hex_number(l_next_char(k)); 1841 r:=l_remainder(k); 1842 if r>=nk then begin 1843 bad('Kern index too large.'); 1844@.Kern index too large@> 1845 out(' R 0.0'); 1846 end 1847 else out_fix(kern(r)); 1848 right; 1849 end; 1850 end; 1851 end 1852else if l_skip_byte(k)>stop_flag then begin 1853 if (256*l_op_byte(k)+l_remainder(k))>=nl then 1854 bad('Ligature unconditional stop command address is too big.'); 1855@.Ligature unconditional stop...@> 1856 end 1857else if l_op_byte(k)>=kern_flag then @<Output a kern step@> 1858else @<Output a ligature step@>; 1859if (l_skip_byte(k) mod 256)>0 then 1860 if level=1 then @<Output either \.{SKIP} or \.{STOP}@>; 1861end 1862 1863@ The \.{SKIP} command is a bit tricky, because we will be omitting all 1864inaccessible commands. 1865 1866@<Output either...@>= 1867begin if (l_skip_byte(k) mod 256)>=stop_flag then out('(STOP)') 1868else begin count:=0; 1869 for ai:=i+1 to (i+(l_skip_byte(k) mod 256)) do 1870 if activity[ai]=accessible then incr(count); 1871 out('(SKIP D ',count:1,')'); {possibly $count=0$, so who cares} 1872 end; 1873out_ln; 1874end 1875 1876@ @<Output a kern step@>= 1877begin if nonexistent(l_next_char(k)) then 1878 if l_next_char(k)<>boundary_char then 1879 correct_bad_char('Kern step for')(l_next_char)(set_l_next_char); 1880@.Kern step for nonexistent...@> 1881left; out('KRN'); out_char(l_next_char(k)); 1882r:=256*(l_op_byte(k)-kern_flag)+l_remainder(k); 1883if r>=nk then 1884 begin bad('Kern index too large.'); 1885@.Kern index too large@> 1886 out(' R 0.0'); 1887 end 1888else out_fix(kern(r)); 1889right; 1890end 1891 1892@ @<Output a ligature step@>= 1893begin if nonexistent(l_next_char(k)) then 1894 if l_next_char(k)<>boundary_char then 1895 correct_bad_char('Ligature step for')(l_next_char)(set_l_next_char); 1896@.Ligature step for nonexistent...@> 1897if nonexistent(l_remainder(k)) then 1898 correct_bad_char('Ligature step produces the')(l_remainder)(set_l_remainder); 1899@.Ligature step produces...@> 1900left; r:=l_op_byte(k); 1901if (r=4)or((r>7)and(r<>11)) then 1902 begin print_ln('Ligature step with nonstandard code changed to LIG'); 1903 r:=0; set_l_op_byte(k,0); 1904 end; 1905if r mod 4>1 then out('/'); 1906out('LIG'); 1907if odd(r) then out('/'); 1908while r>3 do 1909 begin out('>'); r:=r-4; 1910 end; 1911out_char(l_next_char(k)); out_char(l_remainder(k)); right; 1912end 1913 1914@ The last thing on \.{TFtoPL}'s agenda is to go through the 1915list of |char_info| and spew out the information about each individual 1916character. 1917 1918@<Do the characters@>= 1919sort_ptr:=0; {this will suppress `\.{STOP}' lines in ligature comments} 1920c:=bc; 1921while (c<=ec) do 1922 begin if width_index(c)>0 then 1923 begin if chars_on_line>=8 then 1924 begin print_ln(' '); chars_on_line:=1; 1925 end 1926 else begin if chars_on_line>0 then print(' '); 1927 incr(chars_on_line); 1928 end; 1929 if no_repeats(c)>0 then begin 1930 print_hex(c); print('-'); print_hex(c+no_repeats(c)); incr(chars_on_line); 1931 left; out('CHARREPEAT'); out_char(c); out_char(no_repeats(c)); out_ln; 1932 end 1933 else begin 1934 print_hex(c); {progress report} 1935 left; out('CHARACTER'); out_char(c); out_ln; 1936 end; 1937 if ofm_on then check_unused(c); 1938 @<Output the character's width@>; 1939 if height_index(c)>0 then @<Output the character's height@>; 1940 if depth_index(c)>0 then @<Output the character's depth@>; 1941 if italic_index(c)>0 then @<Output the italic correction@>; 1942 case tag(c) of 1943 no_tag: do_nothing; 1944 lig_tag: @<Output the applicable part of the ligature/kern 1945 program as a comment@>; 1946 list_tag: @<Output the character link unless there is a problem@>; 1947 ext_tag: @<Output an extensible character recipe@>; 1948 end; {there are no other cases} 1949 for i:=0 to npc-1 do begin 1950 if char_param(c,i)<>0 then begin 1951 left; 1952 if i<nki then begin 1953 out('CHARIVALUE'); out_hex_number(i); 1954 end 1955 else if i<(nki+nkf) then begin 1956 out('CHARFVALUE'); out_hex_number(i-nki); 1957 end 1958 else if i<(nki+nkf+nkm) then begin 1959 out('CHARMVALUE'); out_hex_number(i-nki-nkf); 1960 end 1961 else if i<(nki+nkf+nkm+nkr) then begin 1962 out('CHARRULE'); out_hex_number(i-nki-nkf-nkm); 1963 end 1964 else if i<(nki+nkf+nkm+nkr+nkg) then begin 1965 out('CHARGLUE'); out_hex_number(i-nki-nkf-nkm-nkr); 1966 end 1967 else if i<(nki+nkf+nkm+nkr+nkg+nkp) then begin 1968 out('CHARPENALTY'); out_hex_number(i-nki-nkf-nkm-nkr-nkg); 1969 end; 1970 out_hex_number(char_param(c,i)); 1971 right; 1972 end; 1973 end; 1974 right; 1975 end; 1976 c:=c+1+no_repeats(c); 1977 end 1978 1979@ @<Output the character's width@>= 1980if width_index(c)>=nw then range_error('Width') 1981@.Width index for char...@> 1982else begin left; out('CHARWD'); out_fix(width(c)); right; 1983 end 1984 1985@ @<Output the character's height@>= 1986if height_index(c)>=nh then range_error('Height') 1987@.Height index for char...@> 1988else begin left; out('CHARHT'); out_fix(height(c)); right; 1989 end 1990 1991@ @<Output the character's depth@>= 1992if depth_index(c)>=nd then range_error('Depth') 1993@.Depth index for char@> 1994else begin left; out('CHARDP'); out_fix(depth(c)); right; 1995 end 1996 1997@ @<Output the italic correction@>= 1998if italic_index(c)>=ni then range_error('Italic correction') 1999@.Italic correction index for char...@> 2000else begin left; out('CHARIC'); out_fix(italic(c)); right; 2001 end 2002 2003@ @<Output the applicable part of the ligature...@>= 2004begin left; out('COMMENT'); out_ln;@/ 2005i:=rremainder(c); r:=lig_step(i); 2006if (l_skip_byte(r) mod 256)>stop_flag then i:=256*l_op_byte(r)+l_remainder(r); 2007repeat @<Output step...@>; 2008if (l_skip_byte(k) mod 256)>=stop_flag then i:=nl 2009else i:=i+1+(l_skip_byte(k) mod 256); 2010until i>=nl; 2011right; 2012end 2013 2014@ We want to make sure that there is no cycle of characters linked together 2015by |list_tag| entries, since \TeX\ doesn't want to risk endless loops. 2016If such a cycle exists, the routine here detects it when processing 2017the largest character code in the cycle. 2018 2019@<Output the character link unless there is a problem@>= 2020begin r:=rremainder(c); 2021if nonexistent(r) then 2022 begin bad_char('Character list link to')(r); set_no_tag(c); 2023@.Character list link...@> 2024 end 2025else begin while (r<c)and(tag(r)=list_tag) do r:=rremainder(r); 2026 if r=c then 2027 begin bad('Cycle in a character list!'); 2028@.Cycle in a character list@> 2029 print('Character '); print_hex(c); 2030 print_ln(' now ends the list.'); 2031 set_no_tag(c); 2032 end 2033 else begin left; out('NEXTLARGER'); out_char(rremainder(c)); 2034 right; 2035 end; 2036 end; 2037end 2038 2039@ @<Output an extensible character recipe@>= 2040if rremainder(c)>=ne then 2041 begin range_error('Extensible'); set_no_tag(c); 2042@.Extensible index for char@> 2043 end 2044else begin left; out('VARCHAR'); out_ln; 2045 @<Output the extensible pieces that exist@>; 2046 right; 2047 end 2048 2049@ @<Glob...@>= 2050@!exten_char:integer; 2051 2052@ @<Output the extensible pieces that...@>= 2053for d:=0 to 3 do begin 2054 if not ofm_on then begin 2055 k:=exten(c)+d; 2056 exten_char:=tfm[k]; 2057 end 2058 else begin 2059 k:=exten(c)+2*d; 2060 exten_char:=256*tfm[k]+tfm[k+1]; 2061 end; 2062 if (d=3)or(exten_char>0) then begin 2063 left; 2064 case d of 2065 0:out('TOP');@+1:out('MID');@+2:out('BOT');@+3:out('REP')@+end; 2066 if nonexistent(exten_char) then out_char(c) 2067 else out_char(exten_char); 2068 right; 2069 end 2070 end 2071 2072@ Some of the extensible recipes may not actually be used, but \TeX\ will 2073complain about them anyway if they refer to nonexistent characters. 2074Therefore \.{TFtoPL} must check them too. 2075 2076@<Check the extensible recipes@>= 2077if ne>0 then 2078 for c:=0 to ne-1 do 2079 for d:=0 to 3 do begin 2080 if not ofm_on then begin 2081 k:=4*(exten_base+c)+d; 2082 exten_char:=tfm[k]; 2083 end 2084 else begin 2085 k:=4*(exten_base+c)+2*d; 2086 exten_char:=256*tfm[k]+tfm[k+1]; 2087 end; 2088 if (exten_char>0)or(d=3) then begin 2089 if nonexistent(exten_char) then begin 2090 bad_char('Extensible recipe involves the')(exten_char); 2091@.Extensible recipe involves...@> 2092 if d<3 then begin 2093 if not ofm_on then begin 2094 tfm[k]:=0; 2095 end 2096 else begin 2097 tfm[k]:=0; 2098 tfm[k+1]:=0; 2099 end; 2100 end; 2101 end; 2102 end; 2103 end 2104 2105@* Checking for ligature loops. 2106We have programmed almost everything but the most interesting calculation of 2107all, which has been saved for last as a special treat. \TeX's extended ligature 2108mechanism allows unwary users to specify sequences of ligature replacements 2109that never terminate. For example, the pair of commands 2110$$\.{(/LIG $x$ $y$) (/LIG $y$ $x$)}$$ 2111alternately replaces character $x$ by character $y$ and vice versa. A similar 2112loop occurs if \.{(LIG/ $z$ $y$)} occurs in the program for $x$ and 2113 \.{(LIG/ $z$ $x$)} occurs in the program for $y$. 2114 2115More complicated loops are also possible. For example, suppose the ligature 2116programs for $x$ and $y$ are 2117$$\vcenter{\halign{#\hfil\cr 2118\.{(LABEL $x$)(/LIG/ $z$ $w$)(/LIG/> $w$ $y$)} \dots,\cr 2119\.{(LABEL $y$)(LIG $w$ $x$)} \dots;\cr}}$$ 2120then the adjacent characters $xz$ change to $xwz$, $xywz$, $xxz$, $xxwz$, 2121\dots, ad infinitum. 2122 2123@ To detect such loops, \.{TFtoPL} attempts to evaluate the function 2124$f(x,y)$ for all character pairs $x$ and~$y$, where $f$ is defined as 2125follows: If the current character is $x$ and the next character is 2126$y$, we say the ``cursor'' is between $x$ and $y$; when the cursor 2127first moves past $y$, the character immediately to its left is 2128$f(x,y)$. This function is defined if and only if no infinite loop is 2129generated when the cursor is between $x$ and~$y$. 2130 2131The function $f(x,y)$ can be defined recursively. It turns out that all pairs 2132$(x,y)$ belong to one of five classes. The simplest class has $f(x,y)=y$; this 2133happens if there's no ligature between $x$ and $y$, or in the cases 2134\.{LIG/>} and \.{/LIG/>>}. Another simple class arises when there's a 2135\.{LIG} or \.{/LIG>} between $x$ and~$y$, generating the character~$z$; 2136then $f(x,y)=z$. Otherwise we always have $f(x,y)$ equal to 2137either $f(x,z)$ or $f(z,y)$ or $f(f(x,z),y)$, where $z$ is the inserted 2138ligature character. 2139 2140The first two of these classes can be merged; we can also consider 2141$(x,y)$ to belong to the simple class when $f(x,y)$ has been evaluated. 2142For technical reasons we allow $x$ to be 256 (for the boundary character 2143at the left) or 257 (in cases when an error has been detected). 2144 2145For each pair $(x,y)$ having a ligature program step, we store 2146$(x,y)$ in a hash table from which the values $z$ and $class$ can be read. 2147 2148@d simple=0 {$f(x,y)=z$} 2149@d left_z=1 {$f(x,y)=f(z,y)$} 2150@d right_z=2 {$f(x,y)=f(x,z)$} 2151@d both_z=3 {$f(x,y)=f(f(x,z),y)$} 2152@d pending=4 {$f(x,y)$ is being evaluated} 2153 2154@<Glob...@>= 2155@!hash:array[0..hash_size] of integer64; 2156@!class:array[0..hash_size] of simple..pending; 2157@!lig_z:array[0..hash_size] of xxchar_type; 2158@!hash_ptr:0..hash_size; {the number of nonzero entries in |hash|} 2159@!hash_list:array[0..hash_size] of 0..hash_size; {list of those nonzero entries} 2160@!h,@!hh:0..hash_size; {indices into the hash table} 2161@!x_lig_cycle,@!y_lig_cycle:integer; {problematic ligature pair} 2162 2163@ @<Check for ligature cycles@>= 2164hash_ptr:=0; y_lig_cycle:=xmax_char; 2165for hh:=0 to hash_size do hash[hh]:=0; {clear the hash table} 2166for c:=bc to ec do if tag(c)=lig_tag then 2167 begin i:=rremainder(c); 2168 if (l_skip_byte(lig_step(i)) mod 256)>stop_flag then 2169 i:=256*l_op_byte(lig_step(i))+l_remainder(lig_step(i)); 2170 @<Enter data for character $c$ starting at location |i| in the hash table@>; 2171 end; 2172if bchar_label<nl then 2173 begin c:=xmax_char; i:=bchar_label; 2174 @<Enter data for character $c$ starting at location |i| in the hash table@>; 2175 end; 2176if hash_ptr=hash_size then 2177 begin print_ln('Sorry, I haven''t room for so many ligature/kern pairs!'); 2178@.Sorry, I haven't room...@> 2179 goto final_end; 2180 end; 2181for hh:=1 to hash_ptr do 2182 begin r:=hash_list[hh]; 2183 if class[r]>simple then {make sure $f$ is defined} 2184 r:=f(r,(hash[r]-1)div xmax_char,(hash[r]-1)mod xmax_char); 2185 end; 2186if y_lig_cycle<xmax_char then 2187 begin print('Infinite ligature loop starting with '); 2188@.Infinite ligature loop...@> 2189 if x_lig_cycle=xmax_char then print('boundary')@+else print_hex(x_lig_cycle); 2190 print(' and '); print_hex(y_lig_cycle); print_ln('!'); 2191 out('(INFINITE LIGATURE LOOP MUST BE BROKEN!)'); out_ln; perfect:=false; 2192 end 2193 2194@ @<Enter data for character $c$...@>= 2195repeat hash_input; k:=l_skip_byte(lig_step(i)); 2196if k>=stop_flag then i:=nl 2197else i:=i+1+k; 2198until i>=nl 2199 2200@ We use an ``ordered hash table'' with linear probing, because such a table 2201is efficient when the lookup of a random key tends to be unsuccessful. 2202 2203@p procedure hash_input; {enter data for character |c| and command |i|} 2204label 30; {go here for a quick exit} 2205var @!cc:simple..both_z; {class of data being entered} 2206@!zz:char_type; {function value or ligature character being entered} 2207@!y:char_type; {the character after the cursor} 2208@!key:integer64; {value to be stored in |hash|} 2209@!t64:integer64; {temporary register for swapping} 2210@!t:integer; {temporary register for swapping} 2211begin if hash_ptr=hash_size then goto 30; 2212@<Compute the command parameters |y|, |cc|, and |zz|@>; 2213key:=int64cast(xmax_char)*c+y+1; h:=(hash_mult*key) mod hash_size; 2214while hash[h]>0 do 2215 begin if hash[h]<=key then 2216 begin if hash[h]=key then goto 30; {unused ligature command} 2217 t64:=hash[h]; hash[h]:=key; key:=t64; {do ordered-hash-table insertion} 2218 t:=class[h]; class[h]:=cc; cc:=t; {namely, do a swap} 2219 t:=lig_z[h]; lig_z[h]:=zz; zz:=t; 2220 end; 2221 if h>0 then decr(h)@+else h:=hash_size; 2222 end; 2223hash[h]:=key; class[h]:=cc; lig_z[h]:=zz; 2224incr(hash_ptr); hash_list[hash_ptr]:=h; 222530:end; 2226 2227@ We must store kern commands as well as ligature commands, because the former 2228might make the latter inapplicable. 2229 2230@<Compute the command param...@>= 2231k:=lig_step(i); y:=l_next_char(k); t:=l_op_byte(k); 2232cc:=simple; zz:=l_remainder(k); 2233if t>=kern_flag then zz:=y 2234else begin case t of 2235 0,6:do_nothing; {\.{LIG},\.{/LIG>}} 2236 5,11:zz:=y; {\.{LIG/>}, \.{/LIG/>>}} 2237 1,7:cc:=left_z; {\.{LIG/}, \.{/LIG/>}} 2238 2:cc:=right_z; {\.{/LIG}} 2239 3:cc:=both_z; {\.{/LIG/}} 2240 end; {there are no other cases} 2241 end 2242 2243@ Evaluation of $f(x,y)$ is handled by two mutually recursive procedures. 2244Kind of a neat algorithm, generalizing a depth-first search. 2245 2246@p function f(@!h,@!x,@!y:index):index; forward;@t\2@> 2247 {compute $f$ for arguments known to be in |hash[h]|} 2248function eval(@!x,@!y:index):index; {compute $f(x,y)$ with hashtable lookup} 2249var @!key:integer64; {value sought in hash table} 2250begin key:=int64cast(xmax_char)*x+y+1; h:=(hash_mult*key) mod hash_size; 2251while hash[h]>key do 2252 if h>0 then decr(h)@+else h:=hash_size; 2253if hash[h]<key then eval:=y {not in ordered hash table} 2254else eval:=f(h,x,y); 2255end; 2256 2257@ Pascal's beastly convention for |forward| declarations prevents us from 2258saying |function f(h,x,y:index):index| here. 2259 2260@p function f; 2261begin case class[h] of 2262simple: do_nothing; 2263left_z: begin class[h]:=pending; lig_z[h]:=eval(lig_z[h],y); class[h]:=simple; 2264 end; 2265right_z: begin class[h]:=pending; lig_z[h]:=eval(x,lig_z[h]); class[h]:=simple; 2266 end; 2267both_z: begin class[h]:=pending; lig_z[h]:=eval(eval(x,lig_z[h]),y); 2268 class[h]:=simple; 2269 end; 2270pending: begin x_lig_cycle:=x; y_lig_cycle:=y; lig_z[h]:=xxmax_char; class[h]:=simple; 2271 end; {the value |xxmax_char| will break all cycles, since it's not in |hash|} 2272end; {there are no other cases} 2273f:=lig_z[h]; 2274end; 2275 2276@* The main program. 2277The routines sketched out so far need to be packaged into separate procedures, 2278on some systems, since some \PASCAL\ compilers place a strict limit on the 2279size of a routine. The packaging is done here in an attempt to avoid some 2280system-dependent changes. 2281 2282First comes the |organize| procedure, which reads the input data and 2283gets ready for subsequent events. If something goes wrong, the routine 2284returns |false|. 2285 2286@p function organize:boolean; 2287label final_end, 30; 2288var tfm_ptr:index; {an index into |tfm|} 2289begin @<Read the whole input file@>;@/ 2290@<Set subfile sizes |lh|, |bc|, \dots, |np|@>;@/ 2291@<Compute the base addresses@>;@/ 2292organize:=true; goto 30; 2293final_end: organize:=false; 229430: end; 2295 2296@ Next we do the simple things. 2297 2298@p procedure do_simple_things; 2299var i:integer; {an index to words of a subfile} 2300begin @<Do the header@>;@/ 2301@<Do the parameters@>;@/ 2302@<Do the ivalue parameters@>;@/ 2303@<Do the fvalue parameters@>;@/ 2304@<Do the mvalue parameters@>;@/ 2305@<Do the rule parameters@>;@/ 2306@<Do the glue parameters@>;@/ 2307@<Do the penalty parameters@>;@/ 2308@<Check the |fix_word| entries@>@/ 2309end; 2310 2311@ And then there's a routine for individual characters. 2312 2313@p procedure do_characters; 2314var @!c:integer; {character being done} 2315@!k:index; {a random index} 2316@!ai:0..lig_size; {index into |activity|} 2317begin @<Do the characters@>;@/ 2318end; 2319 2320@ Here is where \.{TFtoPL} begins and ends. 2321@p begin initialize;@/ 2322if not organize then goto final_end; 2323do_simple_things;@/ 2324@<Do the ligatures and kerns@>; 2325@<Check the extensible recipes@>; 2326do_characters; print_ln('.');@/ 2327if level<>0 then print_ln('This program isn''t working!'); 2328@.This program isn't working@> 2329if not perfect then 2330 begin out('(COMMENT THE OFM FILE WAS BAD, SO THE DATA HAS BEEN CHANGED!)'); 2331@.THE OFM FILE WAS BAD...@> 2332 write_ln(pl_file); 2333 end; 2334final_end:end. 2335 2336@* System-dependent changes. 2337This section should be replaced, if necessary, by changes to the program 2338that are necessary to make \.{TFtoPL} work at a particular installation. 2339It is usually best to design your change file so that all changes to 2340previous sections preserve the section numbering; then everybody's version 2341will be consistent with the printed program. More extensive changes, 2342which introduce new sections, can be inserted here; then only the index 2343itself will get a new section number. 2344@^system dependencies@> 2345 2346@* Index. 2347Pointers to error messages appear here together with the section numbers 2348where each ident\-i\-fier is used. 2349