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