modernc.org/knuth@v0.0.4/web/testdata/ctan.org/tex-archive/systems/knuth/dist/etc/vftovp.web (about) 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 \titlefalse % 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. 38 The \.{VFtoVP} utility program converts a virtual font (``\.{VF}'') file 39 and its associated \TeX\ font metric (``\.{TFM}'') 40 file into an equivalent virtual-property-list (``\.{VPL}'') file. It also 41 makes a thorough check of the given files, using algorithms that are 42 essentially the same as those used by 43 \.{DVI} device drivers and by \TeX. Thus if \TeX\ or a \.{DVI} driver 44 complains that a \.{TFM} or \.{VF} 45 file is ``bad,'' this program will pinpoint the source or sources of 46 badness. A \.{VPL} file output by this program can be edited with 47 a normal text editor, and the result can be converted back to \.{VF} and \.{TFM} 48 format using the companion program \.{VPtoVF}. 49 50 \indent\.{VFtoVP} is an extended version of the program \.{TFtoPL}, which 51 is part of the standard \TeX ware library. 52 The idea of a virtual font was inspired by the work of David R. Fuchs 53 @^Fuchs, David Raymond@> 54 who designed a similar set of conventions in 1984 while developing a 55 device driver for ArborText, Inc. He wrote a somewhat similar program 56 called \.{AMFtoXPL}. 57 58 The |banner| string defined here should be changed whenever \.{VFtoVP} 59 gets 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 64 it occasionally has lower case letters in strings that are output. 65 Such letters can be converted to upper case if necessary. The input is read 66 from |vf_file| and |tfm_file|; the output is written on |vpl_file|. 67 Error messages and 68 other remarks are written on the |output| file, which the user may 69 choose to assign to the terminal if the system permits it. 70 @^system dependencies@> 71 72 The term |print| is used instead of |write| when this program writes on 73 the |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); 79 label @<Labels in the outer block@>@/ 80 const @<Constants in the outer block@>@/ 81 type @<Types in the outer block@>@/ 82 var @<Globals in the outer block@>@/ 83 procedure 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 97 reduce \.{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 123 interface mechanism is needed to switch between the myriad font 124 layouts provided by different suppliers of typesetting equipment. 125 Without such a mechanism, people must go to great lengths writing 126 inscrutable macros whenever they want to use typesetting conventions 127 based on one font layout in connection with actual fonts that have 128 another layout. This puts an extra burden on the typesetting system, 129 interfering with the other things it needs to do (like kerning, 130 hyphenation, and ligature formation). 131 132 These difficulties go away when we have a ``virtual font,'' 133 i.e., a font that exists in a logical sense but not a physical sense. 134 A typesetting system like \TeX\ can do its job without knowing where the 135 actual characters come from; a device driver can then do its job by 136 letting a \.{VF} file tell what actual characters correspond to the 137 characters \TeX\ imagined were present. The actual characters 138 can be shifted and/or magnified and/or combined with other characters 139 from many different fonts. A virtual font can even make use of characters 140 from virtual fonts, including itself. 141 142 Virtual fonts also allow convenient character substitutions for proofreading 143 purposes, 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 146 borrowed from \.{DVI} and \.{PK} files. Thus, a device driver that knows 147 about \.{DVI} and \.{PK} format will already 148 contain most of the mechanisms necessary to process \.{VF} files. 149 We shall assume that \.{DVI} format is understood; the conventions in the 150 \.{DVI} documentation (see, for example, {\sl \TeX: The Program}, part 31) 151 are adopted here to define \.{VF} format. 152 153 A preamble 154 appears at the beginning, followed by a sequence of character definitions, 155 followed by a postamble. More precisely, the first byte of every \.{VF} file 156 must 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]|. 159 Here |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. 161 Parameters |cs| and |ds| are respectively the check sum and the design size 162 of the virtual font; they should match the first two words in the header of 163 the \.{TFM} file, as described below. 164 165 \yskip 166 After the |pre| command, the preamble continues with font definitions; 167 every font needed to specify ``actual'' characters in later 168 \\{set\_char} commands is defined here. The font definitions are 169 exactly the same in \.{VF} files as they are in \.{DVI} files, except 170 that 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]|. 173 Define 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]|. 176 Define 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]|. 179 Define 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]|. 182 Define font |k|, where |@t$-2^{31}$@><=k<@t$2^{31}$@>|. 183 184 \yskip\noindent 185 These font numbers |k| are ``local''; they have no relation to font numbers 186 defined in the \.{DVI} file that uses this virtual font. The dimension~|s|, 187 which represents the scaled size of the local font being defined, 188 is a |fix_word| relative to the design size of the virtual font. 189 Thus if the local font is to be used at the same size 190 as the design size of the virtual font itself, |s| will be the 191 integer 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|). 193 The dimension~|d| is a |fix_word| in units of printer's points; hence it 194 is 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 202 character packet begins with a byte that is $<243$. Character packets have 203 two formats, one long and one short: 204 205 \yskip\hang|long_char| 242 |pl[4]| |cc[4]| |tfm[4]| |dvi[pl]|. This long form 206 specifies 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 210 virtual character in the common case 211 when |0<=pl<242| and |0<=cc<256| and $0\le|tfm|<2^{24}$. 212 213 \yskip\noindent 214 Here |pl| denotes the packet length following the |tfm| value; |cc| is 215 the 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 217 packet having any given |cc| code. 218 219 The |dvi| bytes are a sequence of complete \.{DVI} commands, properly 220 nested with respect to |push| and |pop|. All \.{DVI} operations are 221 permitted except |bop|, |eop|, and commands with opcodes |>=243|. 222 Font selection commands (|fnt_num0| through |fnt4|) must refer to fonts 223 defined in the preamble. 224 225 Dimensions that appear in the \.{DVI} instructions are analogous to 226 |fix_word| quantities; i.e., they are integer multiples of $2^{-20}$ times 227 the design size of the virtual font. For example, if the virtual font 228 has design size $10\,$pt, the \.{DVI} command to move down $5\,$pt 229 would be a \\{down} instruction with parameter $2^{19}$. The virtual font 230 itself might be used at a different size, say $12\,$pt; then that 231 \\{down} instruction would move down $6\,$pt instead. Each dimension 232 must be less than $2^{24}$ in absolute value. 233 234 Device drivers processing \.{VF} files treat the sequences of |dvi| bytes 235 as subroutines or macros, implicitly enclosing them with |push| and |pop|. 236 Each subroutine begins with |w=x=y=z=0|, and with current font~|f| the 237 number of the first-defined in the preamble (undefined if there's no 238 such font). After the |dvi| commands have been 239 performed, the |h| and~|v| position registers of \.{DVI} format and the 240 current font~|f| are restored to their former values; 241 then, if the subroutine has been invoked by a \\{set\_char} or \\{set} 242 command, |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 275 one or more bytes all equal to |post| (248). The total number of bytes 276 in the file should be a multiple of~4. 277 278 @* Font metric data. 279 The idea behind \.{TFM} files is that typesetting routines like \TeX\ 280 need a compact way to store the relevant information about several 281 dozen fonts, and computer centers need a compact way to store the 282 relevant information about several hundred fonts. \.{TFM} files are 283 compact, and most of the information they contain is highly relevant, 284 so they provide a solution to the problem. 285 286 The information in a \.{TFM} file appears in a sequence of 8-bit bytes. 287 Since the number of bytes is always a multiple of 4, we could 288 also regard the file as a sequence of 32-bit words; but \TeX\ uses the 289 byte interpretation, and so does \.{VFtoVP}. Note that the bytes 290 are 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 296 packed file of bytes. For example, the following code didn't work 297 when it was first tried at Stanford, because packed files have to be 298 opened with a special switch setting on the \PASCAL\ that was used. 299 @^system dependencies@> 300 301 @<Set init...@>= 302 reset(tfm_file); reset(vf_file); 303 304 @ The first 24 bytes (6 words) of a \.{TFM} file contain twelve 16-bit 305 integers that give the lengths of the various subsequent portions 306 of 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}}$$ 320 They 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|.}$$ 323 Note that a font may contain as many as 256 characters (if |bc=0| and |ec=255|), 324 and as few as 0 characters (if |bc=ec+1|). 325 326 Incidentally, when two or more 8-bit bytes are combined to form an integer of 327 16 or more bits, the most significant bytes appear first in the file. 328 This 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 335 arrays having the informal specification 336 $$\def\arr$[#1]#2${\&{array} $[#1]$ \&{of} #2} 337 \vbox{\halign{\hfil\\{#}&$\,:\,$\arr#\hfil\cr 338 header&|[0..lh-1]stuff|\cr 339 char\_info&|[bc..ec]char_info_word|\cr 340 width&|[0..nw-1]fix_word|\cr 341 height&|[0..nh-1]fix_word|\cr 342 depth&|[0..nd-1]fix_word|\cr 343 italic&|[0..ni-1]fix_word|\cr 344 lig\_kern&|[0..nl-1]lig_kern_command|\cr 345 kern&|[0..nk-1]fix_word|\cr 346 exten&|[0..ne-1]extensible_recipe|\cr 347 param&|[1..np]fix_word|\cr}}$$ 348 The most important data type used here is a |@!fix_word|, which is 349 a 32-bit representation of a binary fraction. A |fix_word| is a signed 350 quantity, with the two's complement of the entire word used to represent 351 negation. Of the 32 bits in a |fix_word|, exactly 12 are to the left of the 352 binary point; thus, the largest |fix_word| value is $2048-2^{-20}$, and 353 the smallest is $-2048$. We will see below, however, that all but one of 354 the |fix_word| values will lie between $-16$ and $+16$. 355 356 @ The first data array is a block of header information, which contains 357 general facts about the font. The header must contain at least two words, 358 and for \.{TFM} files to be used with Xerox printing software it must 359 contain at least 18 words, allocated as described below. When different 360 kinds of devices need to be interfaced, it may be necessary to add further 361 words 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} 365 file is printed, possibly on another computer, the actual font that gets 366 used 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 368 potential incompatibilities. (However, if the check sum is zero in either 369 the font file or the \.{TFM} file, no check is made.) The actual relation 370 between this check sum and the rest of the \.{TFM} file is not important; 371 the check sum is simply an identification number with the property that 372 incompatible 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 376 font, in units of \TeX\ points (7227 \TeX\ points = 254 cm). This number 377 must be at least 1.0; it is fairly arbitrary, but usually the design size 378 is 10.0 for a ``10 point'' font, i.e., a font that was designed to look 379 best at a 10-point size, whatever that really means. When a \TeX\ user 380 asks for a font `\.{at} $\delta$ \.{pt}', the effect is to override the 381 design size and replace it by $\delta$, and to multiply the $x$ and~$y$ 382 coordinates of the points in the font image by a factor of $\delta$ 383 divided by the design size. {\sl All other dimensions in the\/\ \.{TFM} 384 file are |fix_word|\kern-1pt\ numbers in design-size units.} Thus, for example, 385 the value of |param[6]|, one \.{em} or \.{\\quad}, is often the |fix_word| 386 value $2^{20}=1.0$, since many fonts have a design size equal to one em. 387 The other dimensions must be less than 16 design-size units in absolute 388 value; thus, |header[1]| and |param[1]| are the only |fix_word| entries in 389 the whole \.{TFM} file whose first byte might be something besides 0 or 390 255. @^design size@> 391 392 \yskip\hang|header[2..11]|, if present, contains 40 bytes that identify 393 the character coding scheme. The first byte, which must be between 0 and 394 39, is the number of subsequent ASCII bytes actually relevant in this 395 string, which is intended to specify what character-code-to-symbol 396 convention is present in the font. Examples are \.{ASCII} for standard 397 ASCII, \.{TeX text} for fonts like \.{cmr10} and \.{cmti9}, \.{TeX math 398 extension} for \.{cmex10}, \.{XEROX text} for Xerox fonts, \.{GRAPHIC} for 399 special-purpose non-alphabetic fonts, \.{UNSPECIFIED} for the default case 400 when 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 405 font family (e.g., \.{CMR} or \.{HELVETICA}), in {\mc BCPL} format. 406 This 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 412 called the |face|. If the value of the fourth byte is less than 18, it has 413 the following interpretation as a ``weight, slope, and expansion'': Add 0 414 or 2 or 4 (for medium or bold or light) to 0 or 1 (for roman or italic) to 415 0 or 6 or 12 (for regular or condensed or extended). For example, 13 is 416 0+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 420 words 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| 423 per character. Each |char_info_word| contains six fields packed into 424 four 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 433 The actual width of a character is |width[width_index]|, in design-size 434 units; this is a device for compressing information, since many characters 435 have the same width. Since it is quite common for many characters 436 to have the same height, depth, or italic correction, the \.{TFM} format 437 imposes a limit of 16 different heights, 16 different depths, and 438 64 different italic corrections. 439 440 Incidentally, the relation |width[0]=height[0]=depth[0]=italic[0]=0| 441 should always hold, so that an index of zero implies a value of zero. 442 The |width_index| should never be zero unless the character does 443 not exist in the font, since a character is valid if and only if it lies 444 between |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 447 interpret 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 451 program starting at |lig_kern[remainder]|.\par 452 \hang|tag=2| (|list_tag|) means that this character is part of a chain of 453 characters 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 456 extensible character, i.e., a character that is built up of smaller pieces 457 so 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 466 that 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 478 In a kern step, an 479 additional space equal to |kern[256*(op_byte-128)+remainder]| is inserted 480 between the current character and |next_char|. This amount is 481 often negative, so that the characters are brought closer together 482 by kerning; but it might be positive. 483 484 There 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|; 487 then the current character is deleted if $b=0$, and |next_char| is 488 deleted if $c=0$; then we pass over $a$~characters to reach the next 489 current character (which may have a ligature/kerning program of its own). 490 491 Notice 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 493 unchanged. \.{VFtoVP} will check to see that infinite loops are avoided. 494 495 If the very first instruction of the |lig_kern| array has |skip_byte=255|, 496 the |next_char| byte is the so-called right boundary character of this font; 497 the value of |next_char| need not lie between |bc| and~|ec|. 498 If the very last instruction of the |lig_kern| array has |skip_byte=255|, 499 there is a special ligature/kerning program for a left boundary character, 500 beginning at location |256*op_byte+remainder|. 501 The interpretation is that \TeX\ puts implicit boundary characters 502 before and after each consecutive string of characters from the same font. 503 These implicit characters do not appear in the output, but they can affect 504 ligatures and kerning. 505 506 If 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| 509 arrays, because the first instruction must otherwise 510 appear in a location |<=255|. 511 512 Any 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 514 normal program execution, it denotes an unconditional halt; no ligature 515 command 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|, 521 which consists of four bytes called |top|, |mid|, 522 |bot|, and |rep| (in this order). These bytes are the character codes 523 of individual pieces used to build up a large symbol. 524 If |top|, |mid|, or |bot| are zero, 525 they are not present in the built-up result. For example, an extensible 526 vertical line is like an extensible bracket, except that the top and 527 bottom pieces are missing. 528 529 530 @ The final portion of a \.{TFM} file is the |param| array, which is another 531 sequence of |fix_word| values. 532 533 \yskip\hang|param[1]=@!slant| is the amount of italic slant, which is used 534 to help position accents. For example, |slant=.25| means that when you go 535 up one unit, you also go .25 units to the right. The |slant| is a pure 536 number; it's the only |fix_word| other than the design size itself that is 537 not scaled by the design size. 538 539 \hang|param[2]=space| is the normal spacing between words in text. 540 Note that character |" "| in the font need not have anything to do with 541 blank 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 548 have 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 553 ends of sentences. 554 555 When the character coding scheme is \.{TeX math symbols}, the font is 556 supposed 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 559 character coding scheme is \.{TeX math extension}, the font is supposed to 560 have 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 565 documentation of the companion program, \.{VPtoVF}, so it will not 566 be 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 568 subset of the possible constructions that might appear in a \.{VPL} file. 569 Furthermore, hardly anybody really wants to look at the formal 570 definition of \.{VPL} format, because it is almost self-explanatory when 571 you see an example or two. 572 573 @<Glob...@>= 574 @!vpl_file:text; 575 576 @ @<Set init...@>= 577 rewrite(vpl_file); 578 579 @* Unpacking the TFM file. 580 The first thing \.{VFtoVP} does is read the entire |tfm_file| into an array of 581 bytes, |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 591 at 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@>= 599 read(tfm_file,tfm[0]); 600 if tfm[0]>127 then abort('The first byte of the input file exceeds 127!'); 601 @.The first byte...@> 602 if eof(tfm_file) then abort('The input file is only one byte long!'); 603 @.The input...one byte long@> 604 read(tfm_file,tfm[1]); lf:=tfm[0]*@'400+tfm[1]; 605 if lf=0 then 606 abort('The file claims to have length zero, but that''s impossible!'); 607 @.The file claims...@> 608 if 4*lf-1>tfm_size then abort('The file is bigger than I can handle!'); 609 @.The file is bigger...@> 610 for 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; 616 if 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 623 to 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|@>= 633 begin tfm_ptr:=2;@/ 634 eval_two_bytes(lh); 635 eval_two_bytes(bc); 636 eval_two_bytes(ec); 637 eval_two_bytes(nw); 638 eval_two_bytes(nh); 639 eval_two_bytes(nd); 640 eval_two_bytes(ni); 641 eval_two_bytes(nl); 642 eval_two_bytes(nk); 643 eval_two_bytes(ne); 644 eval_two_bytes(np); 645 if lh<2 then abort('The header length is only ',lh:1,'!'); 646 @.The header length...@> 647 if nl>lig_size then 648 abort('The lig/kern program is longer than I can handle!'); 649 @.The lig/kern program...@> 650 if (bc>ec+1)or(ec>255) then abort('The character code range ', 651 @.The character code range...@> 652 bc:1,'..',ec:1,' is illegal!'); 653 if (nw=0)or(nh=0)or(nd=0)or(ni=0) then 654 abort('Incomplete subfiles for character dimensions!'); 655 @.Incomplete subfiles...@> 656 if ne>256 then abort('There are ',ne:1,' extensible recipes!'); 657 @.There are ... recipes@> 658 if 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...@> 661 end 662 663 @ Once the input data successfully passes these basic checks, 664 \.{VFtoVP} believes that it is a \.{TFM} file, and the conversion 665 to \.{VPL} format will take place. Access to the various subfiles 666 is facilitated by computing the following base addresses. For example, 667 the |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@>= 676 begin char_base:=6+lh-bc; 677 width_base:=char_base+ec+1; 678 height_base:=width_base+nw; 679 depth_base:=height_base+nh; 680 italic_base:=depth_base+nd; 681 lig_kern_base:=italic_base+ni; 682 kern_base:=lig_kern_base+nl; 683 exten_base:=kern_base+nk; 684 param_base:=exten_base+ne-1; 685 end 686 687 @ Of course we want to define macros that suppress the detail of how the 688 font information is actually encoded. Each word will be referred to by 689 the |tfm| index of its first byte. For example, if |c| is a character 690 code between |bc| and |ec|, then |tfm[char_info(c)]| will be the 691 first 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 718 character coding scheme is \.{TeX math symbols} or \.{TeX math extension}; 719 we 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. 730 Once the \.{TFM} file has been brought into memory, \.{VFtoVP} completes 731 the input phase by reading the \.{VF} information into another array of bytes. 732 In this case we don't store all the data; we check the redundant bytes 733 for consistency with their \.{TFM} counterparts, and we partially decode 734 the 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@>= 760 read_vf(temp_byte); 761 if 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@>= 778 if eof(vf_file) then vf_abort('The input file is only one byte long!'); 779 @.The input...one byte long@> 780 read_vf(temp_byte); 781 if temp_byte<>id_byte then vf_abort('Wrong VF version number in second byte!'); 782 @.Wrong VF version...@> 783 if eof(vf_file) then vf_abort('The input file is only two bytes long!'); 784 read_vf(temp_byte); {read the length of introductory comment} 785 vf_count:=11; vf_ptr:=0; vf_store(temp_byte); 786 for k:=0 to vf_ptr-1 do print(xchr[vf[k]]); 787 print_ln(' '); count:=0; 788 for 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; 794 real_dsize:=(((tfm[design_size]*256+tfm[design_size+1])*256+tfm[design_size+2]) 795 *256+tfm[design_size+3])/@'4000000; 796 if 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@>= 803 for k:=0 to 255 do packet_start[k]:=vf_size; 804 font_ptr:=0; packet_found:=false; font_start[0]:=vf_ptr; 805 repeat 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 809 else 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; 814 until temp_byte=post 815 816 @ @<Read and verify the postamble@>= 817 while (temp_byte=post)and not eof(vf_file) do 818 begin read_vf(temp_byte); incr(vf_count); 819 end; 820 if 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; 825 if 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@>= 830 begin if packet_found or(temp_byte>=pre) then 831 vf_abort('Illegal byte ',temp_byte:1,' at beginning of character packet!'); 832 @.Illegal byte...@> 833 font_number[font_ptr]:=vf_read(temp_byte-fnt_def1+1); 834 if font_ptr=max_fonts then vf_abort('I can''t handle that many fonts!'); 835 @.I can't handle that many fonts@> 836 vf_store(14); {|c[4]| |s[4]| |d[4]| |a[1]| |l[1]|} 837 if 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@> 840 a:=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@>; 843 incr(font_ptr); font_start[font_ptr]:=vf_ptr; 844 end 845 846 @ The font area may need to be separated from the font name on some systems. 847 Here we simply reproduce the font area and font name (with no space 848 or punctuation between them). 849 @^system dependencies@> 850 851 @<Print the name...@>= 852 print('MAPFONT ',font_ptr:1,': '); 853 for k:=font_start[font_ptr]+14 to vf_ptr-1 do print(xchr[vf[k]]); 854 k:=font_start[font_ptr]+5; 855 print_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 859 careful, because we merely want to discover which characters are present. 860 The next few sections of the program are copied pretty much verbatim from 861 \.{DVItype}, so that system-dependent modifications can be copied from existing 862 software. 863 864 It turns out to be convenient to read four bytes at a time, when we are 865 inputting 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| 867 the 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 879 four 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; 885 begin read_tfm(b0); read_tfm(b1); 886 read_tfm(b2); read_tfm(b3); 887 end; 888 889 @ We use the |vf| array to store a list of all valid characters in the 890 local font, beginning at location |font_chars[f]|. 891 892 @<Read the local font's \.{TFM} file...@>= 893 font_chars[font_ptr]:=vf_ptr; 894 @<Move font name into the |cur_name| string@>; 895 reset(tfm_file,cur_name); 896 @^system dependencies@> 897 if eof(tfm_file) then 898 print_ln('---not loaded, TFM file can''t be opened!') 899 @.TFM file can\'t be opened@> 900 else 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; 929 incr(vf_ptr) {leave space for character search later} 930 931 @ @<Check the check sum@>= 932 if 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@>= 946 if(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 959 is supposed to use the default font directory, which is a 960 system-dependent place where the standard fonts are kept. 961 The 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...@>= 971 default_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 975 prepend the name of the default directory, and 976 to append the suffix `\.{.TFM}'. Furthermore, we change lower case letters 977 to upper case, since |cur_name| is a \PASCAL\ string. 978 @^system dependencies@> 979 980 @<Move font name into the |cur_name| string@>= 981 for k:=1 to name_length do cur_name[k]:=' '; 982 if 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 987 else r:=0; 988 for 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; 996 cur_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 1000 that 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|} 1005 var @!b:byte; {input byte} 1006 @!a:integer; {accumulator} 1007 begin vf_count:=vf_count+k; get_vf(b); a:=b; 1008 if k=4 then if b>=128 then a:=a-256; {4-byte numbers are signed} 1009 while k>1 do 1010 begin get_vf(b); 1011 a:=256*a+b; decr(k); 1012 end; 1013 vf_read:=a; 1014 end; 1015 1016 @ The \.{VF} format supports arbitrary 4-byte character codes, 1017 but \.{VPL} format presently does not. 1018 Therefore we give up if the character code is 1019 not between 0 and~255. 1020 1021 After more experience is gained with present-day \.{VPL} files, the 1022 best way to extend them to arbitrary character codes will become clear; 1023 the extensions to \.{VFtoVP} and \.{VPtoVF} should not be difficult. 1024 1025 @<Read and store a character packet@>= 1026 begin 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 1030 else begin pl:=temp_byte; c:=vf_read(1); count:=vf_read(3); 1031 {|pl[1]| |cc[1]| |tfm[3]|} 1032 end; 1033 if nonexistent(c) then vf_abort('Character ',c:1,' does not exist!'); 1034 @.Character c does not exist@> 1035 if packet_start[c]<vf_size then 1036 print_ln('Discarding earlier packet for character ',c:1); 1037 @.Discarding earlier packet...@> 1038 if count<>tfm_width(c) then 1039 print_ln('Incorrect TFM width for character ',c:1,' in VF file'); 1040 @.Incorrect TFM width...@> 1041 if pl<0 then vf_abort('Negative packet length!'); 1042 @.Negative packet length@> 1043 packet_start[c]:=vf_ptr; vf_store(pl); packet_end[c]:=vf_ptr-1; 1044 packet_found:=true; 1045 end 1046 1047 @ The preceding code requires a simple subroutine that evaluates \.{TFM} data. 1048 1049 @p function tfm_width(@!c:byte):integer; 1050 var @!a:integer; {accumulator} 1051 @!k:index; {index into |tfm|} 1052 begin k:=width(c); {we assume that character |c| exists} 1053 a:=tfm[k]; 1054 if a>=128 then a:=a-256; 1055 tfm_width:=((256*a+tfm[k+1])*256+tfm[k+2])*256+tfm[k+3]; 1056 end; 1057 1058 @* Basic output subroutines. 1059 Let us now define some procedures that will reduce the rest of \.{VFtoVP}'s 1060 work to a triviality. 1061 1062 First 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 1068 appropriate conversion of ASCII codes. Three other little strings are 1069 used 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...@>= 1079 ASCII_04:=' !"#$%&''()*+,-./0123456789:;<=>?';@/ 1080 ASCII_10:='@@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_';@/ 1081 ASCII_14:='`abcdefghijklmnopqrstuvwxyz{|}~?';@/ 1082 for k:=0 to 255 do xchr[k]:='?'; 1083 for 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; 1088 MBL_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]|, 1096 given $j>0$. 1097 1098 @p procedure out_digs(j:integer); {outputs |j| digits} 1099 begin repeat decr(j); out(dig[j]:1); 1100 until j=0; 1101 end; 1102 @# 1103 procedure print_digs(j:integer); {prints |j| digits} 1104 begin repeat decr(j); print(dig[j]:1); 1105 until j=0; 1106 end; 1107 1108 @ The |print_octal| procedure indicates how |print_digs| can be used. 1109 Since this procedure is used only to print character codes, it always 1110 produces three digits. 1111 1112 @p procedure print_octal(c:byte); {prints octal value of |c|} 1113 var j:0..2; {index into |dig|} 1114 begin print(''''); {an apostrophe indicates the octal notation} 1115 for j:=0 to 2 do 1116 begin dig[j]:=c mod 8; c:=c div 8; 1117 end; 1118 print_digs(3); 1119 end; 1120 1121 @ A \.{VPL} file has nested parentheses, and we want to format the output 1122 so that its structure is clear. The |level| variable keeps track of the 1123 depth of nesting. 1124 1125 @<Glob...@>= 1126 @!level:0..5; 1127 1128 @ @<Set init...@>= 1129 level:=0; 1130 1131 @ Three simple procedures suffice to produce the desired structure in the 1132 output. 1133 1134 @p procedure out_ln; {finishes one line, indents the next} 1135 var l:0..5; 1136 begin write_ln(vpl_file); 1137 for l:=1 to level do out(' '); 1138 end; 1139 @# 1140 procedure left; {outputs a left parenthesis} 1141 begin incr(level); out('('); 1142 end; 1143 @# 1144 procedure right; {outputs a right parenthesis and finishes a line} 1145 begin decr(level); out(')'); out_ln; 1146 end; 1147 1148 @ The value associated with a property can be output in a variety of 1149 ways. For example, we might want to output a {\mc BCPL} string that 1150 begins in |tfm[k]|: 1151 1152 @p procedure out_BCPL(@!k:index); {outputs a string, preceded by a blank space} 1153 var l:0..39; {the number of bytes remaining} 1154 begin out(' '); l:=tfm[k]; 1155 while l>0 do 1156 begin incr(k); decr(l); out(xchr[tfm[k]]); 1157 end; 1158 end; 1159 1160 @ The property value might also be a sequence of |l| bytes, beginning 1161 in |tfm[k]|, that we would like to output in octal notation. 1162 The following procedure assumes that |l<=4|, but larger values of |l| 1163 could be handled easily by enlarging the |dig| array and increasing 1164 the upper bounds on |b| and |j|. 1165 1166 @p procedure out_octal(@!k,@!l:index); {outputs |l| bytes in octal} 1167 var 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} 1170 begin out(' O '); {specify octal format} 1171 a:=0; b:=0; j:=0; 1172 while l>0 do @<Reduce \(1)|l| by one, preserving the invariants@>; 1173 while (a>0)or(j=0) do 1174 begin dig[j]:=a mod 8; a:=a div 8; incr(j); 1175 end; 1176 out_digs(j); 1177 end; 1178 1179 @ @<Reduce \(1)|l|...@>= 1180 begin decr(l); 1181 if 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; 1191 b:=b+8; 1192 end 1193 1194 @ The property value may be a character, which is output in octal 1195 unless it is a letter or a digit. 1196 @^system dependencies@> 1197 1198 @p procedure out_char(@!c:byte); {outputs a character} 1199 begin if font_type>vanilla then 1200 begin tfm[0]:=c; out_octal(0,1) 1201 end 1202 else 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]) 1205 else begin tfm[0]:=c; out_octal(0,1); 1206 end; 1207 end; 1208 1209 @ The property value might be a ``face'' byte, which is output in the 1210 curious code mentioned earlier, provided that it is less than 18. 1211 1212 @p procedure out_face(@!k:index); {outputs a |face|} 1213 var s:0..1; {the slope} 1214 @!b:0..8; {the weight and expansion} 1215 begin if tfm[k]>=18 then out_octal(k,1) 1216 else 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; 1222 end; 1223 1224 @ And finally, the value might be a |fix_word|, which is output in 1225 decimal notation with just enough decimal places for \.{VPtoVF} 1226 to recover every bit of the given |fix_word|. 1227 1228 All of the numbers involved in the intermediate calculations of 1229 this procedure will be nonnegative and less than $10\cdot2^{24}$. 1230 1231 @p procedure out_fix(@!k:index); {outputs a |fix_word|} 1232 var 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} 1236 begin out(' R '); {specify real format} 1237 a:=(tfm[k]*16)+(tfm[k+1] div 16); 1238 f:=((tfm[k+1] mod 16)*@'400+tfm[k+2])*@'400+tfm[k+3]; 1239 if 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@>; 1242 end; 1243 1244 @ The following code outputs at least one digit even if |a=0|. 1245 1246 @<Output the integer...@>= 1247 begin j:=0; 1248 repeat dig[j]:=a mod 10; a:=a div 10; incr(j); 1249 until a=0; 1250 out_digs(j); 1251 end 1252 1253 @ And the following code outputs at least one digit to the right 1254 of the decimal point. 1255 1256 @<Output the fraction...@>= 1257 begin out('.'); f:=10*f+5; delta:=10; 1258 repeat if delta>@'4000000 then f:=f+@'2000000-(delta div 2); 1259 out(f div @'4000000:1); f:=10*(f mod @'4000000); delta:=delta*10; 1260 until f<=delta; 1261 end; 1262 1263 @ @<Reduce \(2)negative to positive@>= 1264 begin out('-'); a:=@'10000-a; 1265 if f>0 then 1266 begin f:=@'4000000-f; decr(a); 1267 end; 1268 end 1269 1270 @* Outputting the TFM info. 1271 \TeX\ checks the information of a \.{TFM} file for validity as the 1272 file is being read in, so that no further checks will be needed when 1273 typesetting is going on. And when it finds something wrong, it just 1274 calls the file ``bad,'' without identifying the nature of the problem, 1275 since \.{TFM} files are supposed to be good almost all of the time. 1276 1277 Of 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. 1280 All of the errors are corrected, so that the \.{VPL} output will 1281 be correct (unless, of course, the \.{TFM} file was so loused up 1282 that no attempt is being made to fathom it). 1283 1284 @ Just before each character is processed, its code is printed in octal 1285 notation. Up to eight such codes appear on a line; so we have a variable 1286 to keep track of how many are currently there. We also keep track of 1287 whether 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...@>= 1294 chars_on_line:=0;@/ 1295 perfect:=true; {innocent until proved guilty} 1296 1297 @ Error messages are given with the help of the |bad| and |range_error| 1298 and |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 1329 at a time, so we might as well get down to business. The first things 1330 that \.{VFtoVP} will put into the \.{VPL} file appear in the header part. 1331 1332 @<Do the header@>= 1333 begin font_type:=vanilla; 1334 if 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|@>; 1345 end 1346 1347 @ @<Output the check sum@>= 1348 left; out('CHECKSUM'); out_octal(check_sum,4); 1349 right 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@>= 1360 left; out('DESIGNSIZE'); 1361 if tfm[design_size]>127 then bad_design('negative') 1362 else if (tfm[design_size]=0)and(tfm[design_size+1]<16) then 1363 bad_design('too small') 1364 else out_fix(design_size); 1365 right; 1366 out('(COMMENT DESIGNSIZE IS IN POINTS)'); out_ln; 1367 out('(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, 1371 we 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|} 1374 var j:index; {runs through the string} 1375 @!c:byte; {character being checked} 1376 begin 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; 1381 for 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; 1395 end; 1396 1397 @ The |font_type| starts out |vanilla|; possibly we need to reset it. 1398 1399 @<Set the true |font_type|@>= 1400 begin check_BCPL(scheme,40); 1401 if (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; 1409 end 1410 1411 @ @<Output the character coding scheme@>= 1412 left; out('CODINGSCHEME'); 1413 out_BCPL(scheme); 1414 right 1415 1416 @ @<Output the family name@>= 1417 left; out('FAMILY'); 1418 check_BCPL(family,20); 1419 out_BCPL(family); 1420 right 1421 1422 @ @<Output the rest of the header@>= 1423 begin left; out('FACE'); out_face(random_word+3); right; 1424 for 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; 1428 end 1429 1430 @ This program does not check to see if the |seven_bit_safe_flag| has the 1431 correct setting, i.e., if it really reflects the seven-bit-safety of 1432 the \.{TFM} file; the stated value is merely put into the \.{VPL} file. 1433 The \.{VPtoVF} program will store a correct value and give a warning 1434 message if a file falsely claims to be safe. 1435 1436 @<Output the |seven_bit_safe_flag|@>= 1437 if (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@>= 1444 if 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|...@>= 1452 if (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).') 1456 else 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 1461 will be checked to make sure that they are less than 16.0 in magnitude, 1462 using 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@>= 1472 begin left; 1473 if i=1 then out('SLANT') {this parameter is not checked} 1474 else begin check_fix(param(i))('Parameter');@/ 1475 @.Parameter n is too big@> 1476 @<Output the name of parameter $i$@>; 1477 end; 1478 out_fix(param(i)); right; 1479 end 1480 1481 @ @<Output the name...@>= 1482 if 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 1485 else 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 1493 else if (i<=13)and(font_type=mathex) then 1494 if i=8 then out('DEFAULTRULETHICKNESS') 1495 else out('BIGOPSPACING',i-8:1) 1496 else out('PARAMETER D ',i:1) 1497 1498 @ We need to check the range of all the remaining |fix_word| values, 1499 and 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@>= 1504 if nonzero_fix(4*width_base) then bad('width[0] should be zero.'); 1505 @.should be zero@> 1506 if nonzero_fix(4*height_base) then bad('height[0] should be zero.'); 1507 if nonzero_fix(4*depth_base) then bad('depth[0] should be zero.'); 1508 if nonzero_fix(4*italic_base) then bad('italic[0] should be zero.'); 1509 for i:=0 to nw-1 do check_fix(4*(width_base+i))('Width'); 1510 @.Width n is too big@> 1511 for i:=0 to nh-1 do check_fix(4*(height_base+i))('Height'); 1512 @.Height n is too big@> 1513 for i:=0 to nd-1 do check_fix(4*(depth_base+i))('Depth'); 1514 @.Depth n is too big@> 1515 for i:=0 to ni-1 do check_fix(4*(italic_base+i))('Italic correction'); 1516 @.Italic correction n is too big@> 1517 if 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 1522 into the program. For each character |c| whose |tag| is |lig_tag| and 1523 whose 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|, 1525 we also store the pair |(256,r)|. 1526 This array is sorted by its second components, using the 1527 simple 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...@>= 1537 boundary_char:=256; bchar_label:=@'77777;@/ 1538 label_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@>= 1552 if 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@>; 1557 if 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 1566 that would not otherwise be detected. 1567 1568 @<Build...@>= 1569 for 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; 1586 label_table[label_ptr+1].rr:=lig_size; {put ``infinite'' sentinel at the end} 1587 1588 @ @<Insert |(c,r)|...@>= 1589 begin sort_ptr:=label_ptr; {there's a hole at position |sort_ptr+1|} 1590 while 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; 1594 label_table[sort_ptr+1].cc:=c; 1595 label_table[sort_ptr+1].rr:=r; {fill the hole} 1596 incr(label_ptr); activity[r]:=accessible; 1597 end 1598 1599 @ @<Check for a bound...@>= 1600 if 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; 1605 if 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@>= 1620 for 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 1634 the \.{VPL} file. 1635 1636 @<Output and correct the ligature...@>= 1637 sort_ptr:=1; {point to the next label that will be needed} 1638 for 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; 1643 if level=2 then right {the final step was unreachable} 1644 1645 @ @<Output any labels...@>= 1646 while 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...@>= 1654 if 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 1659 else if level=2 then right 1660 1661 @ @<Output step $i$...@>= 1662 begin k:=lig_step(i); 1663 if 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 1668 else if tfm[k+2]>=kern_flag then @<Output a kern step@> 1669 else @<Output a ligature step@>; 1670 if tfm[k]>0 then 1671 if level=1 then @<Output either \.{SKIP} or \.{STOP}@>; 1672 end 1673 1674 @ The \.{SKIP} command is a bit tricky, because we will be omitting all 1675 inaccessible commands. 1676 1677 @<Output either...@>= 1678 begin if tfm[k]>=stop_flag then out('(STOP)') 1679 else 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; 1683 out_ln; 1684 end 1685 1686 @ @<Output a kern step@>= 1687 begin 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...@> 1690 left; out('KRN'); out_char(tfm[k+1]); 1691 r:=256*(tfm[k+2]-kern_flag)+tfm[k+3]; 1692 if r>=nk then 1693 begin bad('Kern index too large.'); 1694 @.Kern index too large@> 1695 out(' R 0.0'); 1696 end 1697 else out_fix(kern(r)); 1698 right; 1699 end 1700 1701 @ @<Output a ligature step@>= 1702 begin 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...@> 1705 if nonexistent(tfm[k+3]) then 1706 correct_bad_char('Ligature step produces the')(k+3); 1707 @.Ligature step produces...@> 1708 left; r:=tfm[k+2]; 1709 if (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; 1713 if r mod 4>1 then out('/'); 1714 out('LIG'); 1715 if odd(r) then out('/'); 1716 while r>3 do 1717 begin out('>'); r:=r-4; 1718 end; 1719 out_char(tfm[k+1]); out_char(tfm[k+3]); right; 1720 end 1721 1722 @ The last thing on \.{VFtoVP}'s agenda is to go through the 1723 list of |char_info| and spew out the information about each individual 1724 character. 1725 1726 @<Do the characters@>= 1727 sort_ptr:=0; {this will suppress `\.{STOP}' lines in ligature comments} 1728 for 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@>= 1753 begin left; out('CHARWD'); 1754 if width_index(c)>=nw then range_error('Width') 1755 else out_fix(width(c)); 1756 right; 1757 end 1758 1759 @ @<Output the character's height@>= 1760 if height_index(c)>=nh then range_error('Height') 1761 @.Height index for char...@> 1762 else begin left; out('CHARHT'); out_fix(height(c)); right; 1763 end 1764 1765 @ @<Output the character's depth@>= 1766 if depth_index(c)>=nd then range_error('Depth') 1767 @.Depth index for char@> 1768 else begin left; out('CHARDP'); out_fix(depth(c)); right; 1769 end 1770 1771 @ @<Output the italic correction@>= 1772 if italic_index(c)>=ni then range_error('Italic correction') 1773 @.Italic correction index for char...@> 1774 else begin left; out('CHARIC'); out_fix(italic(c)); right; 1775 end 1776 1777 @ @<Output the applicable part of the ligature...@>= 1778 begin left; out('COMMENT'); out_ln;@/ 1779 i:=remainder(c); r:=lig_step(i); 1780 if tfm[r]>stop_flag then i:=256*tfm[r+2]+tfm[r+3]; 1781 repeat @<Output step...@>; 1782 if tfm[k]>=stop_flag then i:=nl 1783 else i:=i+1+tfm[k]; 1784 until i>=nl; 1785 right; 1786 end 1787 1788 @ We want to make sure that there is no cycle of characters linked together 1789 by |list_tag| entries, since such a cycle would get \TeX\ into an endless 1790 loop. If such a cycle exists, the routine here detects it when processing 1791 the largest character code in the cycle. 1792 1793 @<Output the character link unless there is a problem@>= 1794 begin r:=remainder(c); 1795 if nonexistent(r) then 1796 begin bad_char('Character list link to')(r); reset_tag(c); 1797 @.Character list link...@> 1798 end 1799 else 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; 1811 end 1812 1813 @ @<Output an extensible character recipe@>= 1814 if remainder(c)>=ne then 1815 begin range_error('Extensible'); reset_tag(c); 1816 @.Extensible index for char@> 1817 end 1818 else begin left; out('VARCHAR'); out_ln; 1819 @<Output the extensible pieces that exist@>; 1820 right; 1821 end 1822 1823 @ @<Output the extensible pieces that...@>= 1824 for 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 1834 complain about them anyway if they refer to nonexistent characters. 1835 Therefore \.{VFtoVP} must check them too. 1836 1837 @<Check the extensible recipes@>= 1838 if 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. 1850 We have programmed almost everything but the most interesting calculation of 1851 all, which has been saved for last as a special treat. \TeX's extended ligature 1852 mechanism allows unwary users to specify sequences of ligature replacements 1853 that never terminate. For example, the pair of commands 1854 $$\.{(/LIG $x$ $y$) (/LIG $y$ $x$)}$$ 1855 alternately replaces character $x$ by character $y$ and vice versa. A similar 1856 loop occurs if \.{(LIG/ $z$ $y$)} occurs in the program for $x$ and 1857 \.{(LIG/ $z$ $x$)} occurs in the program for $y$. 1858 1859 More complicated loops are also possible. For example, suppose the ligature 1860 programs 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}}$$ 1864 then 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 1869 follows: 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 1871 first 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 1873 generated when the cursor is between $x$ and~$y$. 1874 1875 The 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 1877 happens 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$; 1880 then $f(x,y)=z$. Otherwise we always have $f(x,y)$ equal to 1881 either $f(x,z)$ or $f(z,y)$ or $f(f(x,z),y)$, where $z$ is the inserted 1882 ligature character. 1883 1884 The 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. 1886 For technical reasons we allow $x$ to be 256 (for the boundary character 1887 at the left) or 257 (in cases when an error has been detected). 1888 1889 For 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@>= 1908 hash_ptr:=0; y_lig_cycle:=256; 1909 for hh:=0 to hash_size do hash[hh]:=0; {clear the hash table} 1910 for 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; 1916 if 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; 1920 if 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; 1925 for 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; 1930 if 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$...@>= 1939 repeat hash_input; k:=tfm[lig_step(i)]; 1940 if k>=stop_flag then i:=nl 1941 else i:=i+1+k; 1942 until i>=nl 1943 1944 @ We use an ``ordered hash table'' with linear probing, because such a table 1945 is 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|} 1948 label exit; 1949 var @!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} 1954 begin if hash_ptr=hash_size then return; 1955 @<Compute the command parameters |y|, |cc|, and |zz|@>; 1956 key:=256*c+y+1; h:=(1009*key) mod hash_size; 1957 while 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; 1966 hash[h]:=key; class[h]:=cc; lig_z[h]:=zz; 1967 incr(hash_ptr); hash_list[hash_ptr]:=h; 1968 exit:end; 1969 1970 @ We must store kern commands as well as ligature commands, because the former 1971 might make the latter inapplicable. 1972 1973 @<Compute the command param...@>= 1974 k:=lig_step(i); y:=tfm[k+1]; t:=tfm[k+2]; cc:=simple; zz:=tfm[k+3]; 1975 if t>=kern_flag then zz:=y 1976 else 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. 1986 Kind 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]|} 1990 function eval(@!x,@!y:index):index; {compute $f(x,y)$ with hashtable lookup} 1991 var @!key:integer; {value sought in hash table} 1992 begin key:=256*x+y+1; h:=(1009*key) mod hash_size; 1993 while hash[h]>key do 1994 if h>0 then decr(h)@+else h:=hash_size; 1995 if hash[h]<key then eval:=y {not in ordered hash table} 1996 else eval:=f(h,x,y); 1997 end; 1998 1999 @ Pascal's beastly convention for |forward| declarations prevents us from 2000 saying |function f(h,x,y:index):index| here. 2001 2002 @p function f; 2003 begin case class[h] of 2004 simple: do_nothing; 2005 left_z: begin class[h]:=pending; lig_z[h]:=eval(lig_z[h],y); class[h]:=simple; 2006 end; 2007 right_z: begin class[h]:=pending; lig_z[h]:=eval(x,lig_z[h]); class[h]:=simple; 2008 end; 2009 both_z: begin class[h]:=pending; lig_z[h]:=eval(eval(x,lig_z[h]),y); 2010 class[h]:=simple; 2011 end; 2012 pending: 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|} 2014 end; {there are no other cases} 2015 f:=lig_z[h]; 2016 end; 2017 2018 @* Outputting the VF info. 2019 The routines we've used for output from the |tfm| array have counterparts 2020 for output from |vf|. One difference is that the string outputs from |vf| 2021 need to be checked for balanced parentheses. The |string_balance| routine 2022 tests the string of length~|l| that starts at location~|k|. 2023 2024 @p function string_balance(@!k,@!l:integer):boolean; 2025 label not_found,exit; 2026 var @!j,@!bal:integer; 2027 begin if l>0 then if vf[k]=" " then goto not_found; 2028 {a leading blank is considered unbalanced} 2029 bal:=0; 2030 for 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; 2036 if bal>0 then goto not_found; 2037 string_balance:=true; return; 2038 not_found:string_balance:=false; 2039 exit: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@>= 2047 if 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 2052 else 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 2056 fact that the design size has already been output. 2057 2058 @p procedure out_as_fix(@!x:integer); 2059 var @!k:1..3; 2060 begin if abs(x)>=@'100000000 then 2061 begin bad_vf('Oversize dimension has been reset to zero.'); 2062 @.Oversize dimension...@> 2063 x:=0; 2064 end; 2065 if x>=0 then tfm[design_size]:=0 2066 else begin tfm[design_size]:=255; x:=x+@'100000000; 2067 end; 2068 for k:=3 downto 1 do 2069 begin tfm[design_size+k]:=x mod 256; x:=x div 256; 2070 end; 2071 out_fix(design_size); 2072 end; 2073 2074 @ @<Do the local fonts@>= 2075 for 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@>= 2087 a:=vf[font_start[f]+12]; l:=vf[font_start[f]+13]; 2088 if 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; 2096 if (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@> 2099 else 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} 2105 commands are translated into symbolic form. The \.{VPL} language is a subset 2106 of \.{DVI}, so we sometimes need to output semantic equivalents of 2107 the commands instead of producing a literal translation. This causes a 2108 small but tolerable loss of efficiency. We need to simulate the stack 2109 used 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|@>= 2119 if packet_start[c]=vf_size then 2120 bad_vf('Missing packet for character ',c:1) 2121 @.Missing packet@> 2122 else 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; 2143 var @!a:integer; {accumulator} 2144 begin if vf_ptr+k>vf_limit then 2145 begin bad_vf('Packet ended prematurely'); k:=vf_limit-vf_ptr; 2146 end; 2147 a:=vf[vf_ptr]; 2148 if (k=4) or signed then 2149 if a>=128 then a:=a-256; 2150 incr(vf_ptr); 2151 while k>1 do 2152 begin a:=a*256+vf[vf_ptr]; incr(vf_ptr); decr(k); 2153 end; 2154 get_bytes:=a; 2155 end; 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...@>= 2166 nop:do_nothing; 2167 push: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; 2175 pop: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; 2179 set_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} 2187 lingo. 2188 2189 @<Cases...@>= 2190 four_cases(right1):begin out('(MOVERIGHT'); 2191 out_as_fix(get_bytes(o-right1+1,true)); 2192 out(')'); out_ln;@+end; 2193 w0,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; 2195 x0,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; 2197 four_cases(down1):begin out('(MOVEDOWN'); out_as_fix(get_bytes(o-down1+1,true)); 2198 out(')'); out_ln;@+end; 2199 y0,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; 2201 z0,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 2205 a font that hasn't been defined (so its characters will be ignored). 2206 2207 @<Cases...@>= 2208 sixty_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...@>= 2221 sixty_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. 2245 We use a hexadecimal 2246 output 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...@>= 2254 four_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. 2280 The routines sketched out so far need to be packaged into separate procedures, 2281 on some systems, since some \PASCAL\ compilers place a strict limit on the 2282 size of a routine. The packaging is done here in an attempt to avoid some 2283 system-dependent changes. 2284 2285 First come the |vf_input| and |organize| procedures, which read the input data 2286 and get ready for subsequent events. If something goes wrong, the routines 2287 return |false|. 2288 2289 @p function vf_input:boolean; 2290 label final_end, exit; 2291 var vf_ptr:0..vf_size; {an index into |vf|} 2292 @!k:integer; {all-purpose index} 2293 @!c:integer; {character code} 2294 begin @<Read the whole \.{VF} file@>; 2295 vf_input:=true; return; 2296 final_end: vf_input:=false; 2297 exit: end; 2298 @# 2299 function organize:boolean; 2300 label final_end, exit; 2301 var tfm_ptr:index; {an index into |tfm|} 2302 begin @<Read the whole \.{TFM} file@>; 2303 @<Set subfile sizes |lh|, |bc|, \dots, |np|@>; 2304 @<Compute the base addresses@>; 2305 organize:=vf_input; return; 2306 final_end: organize:=false; 2307 exit: end; 2308 2309 @ Next we do the simple things. 2310 2311 @p procedure do_simple_things; 2312 var i:0..@'77777; {an index to words of a subfile} 2313 @!f:0..vf_size; {local font number} 2314 @!k:integer; {all-purpose index} 2315 begin @<Do the virtual font title@>; 2316 @<Do the header@>; 2317 @<Do the parameters@>; 2318 @<Do the local fonts@>; 2319 @<Check the |fix_word| entries@>; 2320 end; 2321 2322 @ And then there's a routine for individual characters. 2323 2324 @p function do_map(@!c:byte):boolean; 2325 label final_end,exit; 2326 var @!k:integer; 2327 @!f:0..vf_size; {current font number} 2328 begin @<Do the packet for character |c|@>; 2329 do_map:=true; return; 2330 final_end: do_map:=false; 2331 exit:end; 2332 @# 2333 function do_characters:boolean; 2334 label final_end, exit; 2335 var @!c:byte; {character being done} 2336 @!k:index; {a random index} 2337 @!ai:0..lig_size; {index into |activity|} 2338 begin @<Do the characters@>;@/ 2339 do_characters:=true; return; 2340 final_end: do_characters:=false; 2341 exit:end; 2342 2343 @ Here is where \.{VFtoVP} begins and ends. 2344 @p begin initialize;@/ 2345 if not organize then goto final_end; 2346 do_simple_things;@/ 2347 @<Do the ligatures and kerns@>; 2348 @<Check the extensible recipes@>; 2349 if not do_characters then goto final_end; 2350 print_ln('.');@/ 2351 if level<>0 then print_ln('This program isn''t working!'); 2352 @.This program isn't working@> 2353 if 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...@> 2359 final_end:end. 2360 2361 @* System-dependent changes. 2362 This section should be replaced, if necessary, by changes to the program 2363 that are necessary to make \.{VFtoVP} work at a particular installation. 2364 It is usually best to design your change file so that all changes to 2365 previous sections preserve the section numbering; then everybody's version 2366 will be consistent with the printed program. More extensive changes, 2367 which introduce new sections, can be inserted here; then only the index 2368 itself will get a new section number. 2369 @^system dependencies@> 2370 2371 @* Index. 2372 Pointers to error messages appear here together with the section numbers 2373 where each ident\-i\-fier is used.