1% odvicopy.web: Omega version of file dvicopy.web 2% 3% This file is part of the Omega project, which 4% is based in the web2c distribution of TeX. 5% 6% Copyright (c) 1994--1998 John Plaice and Yannis Haralambous 7% applies only to the changes to the original dvicopy.web. 8% 9% This program is free software; you can redistribute it and/or modify 10% it under the terms of the GNU General Public License as published by 11% the Free Software Foundation; either version 1, or (at your option) 12% any later version. 13% 14% You should have received a copy of the GNU General Public License 15% along with this program; if not, write to the Free Software 16% Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 17% 18% Version 0.9 was finished May 21, 1990. 19% Version 1.0 pixel rounding for real devices (August 6, 1990). 20% Version 1.1 major rearrangements for DVIprint (October 7, 1990). 21% Version 1.2 fixed some bugs, page selection (February 13, 1991). 22% Version 1.3 several more changes, command line options, 23% don't load fonts that are never used (August 25, 1992). 24% Version 1.4 fixed a typo (March 28, 1995). 25% Version 1.5 avoided cur_name_length identifier conflict (October 15, 1995). 26% Version 1.6 minor cleanup: avoid unused or uninitialized variables, 27% diagnose impossible cases (September 2009). 28% bug fix (not for Web2C) and some typos (May 2014) 29% from Udo Wermuth (u.wermuth@@icloud.com). 30 31% Here is TeX material that gets inserted after \input webmac 32\def\hang{\hangindent 3em\indent\ignorespaces} 33\font\ninerm=cmr9 34\let\mc=\ninerm % medium caps for names like SAIL 35\def\PASCAL{Pascal} 36\font\logo=manfnt % font used for the METAFONT logo 37\def\MF{{\logo META}\-{\logo FONT}} 38\mathchardef\RA="3221 % right arrow 39 40\def\(#1){} % this is used to make section names sort themselves better 41\def\9#1{} % this is used for sort keys in the index 42 43\def\title{ODVI\lowercase{copy}} % don't change this line! 44\def\contentspagenumber{1} 45\def\topofcontents{\null 46 \def\titlepage{F} % include headline on the contents page 47 \def\rheader{\mainfont\hfil \contentspagenumber} 48 \vfill 49 \centerline{\titlefont The {\ttitlefont ODVIcopy} processor} 50 \vskip 5pt 51 \centerline{Copyright (C) 1990--2014 Peter Breitenlohner, 521994--1998 John Plaice and Yannis Haralambous} 53 \centerline{Distributed under terms of GNU General Public License} 54 \vskip 15pt 55 \centerline{(Version 1.6, September 2009)} 56 \vfill} 57\def\botofcontents{\vfill 58 \centerline{\hsize 5in\baselineskip9pt 59 \vbox{\ninerm\noindent 60 This program was developed at the Max-Planck-Institut f\"ur Physik 61 (Werner-Heisenberg-Institut), Munich, Germany. 62 And modified at the Universit\'e Laval, Qu\'ebec, Canada. 63 `\TeX' is a trademark of the American Mathematical Society. 64 `{\logo hijklmnj}\kern1pt' is a trademark of Addison-Wesley 65 Publishing Company.}}} 66\pageno=\contentspagenumber \advance\pageno by 1 67 68@* Introduction. 69The \.{ODVIcopy} utility program copies (selected pages of) binary 70device-independent (``\.{DVI}'') files that are produced by document 71compilers such as \TeX and $\Omega$, 72and replaces all references to characters from 73virtual fonts by the typesetting instructions specified for them in 74binary virtual-font (``\.{VF}'' or ``OVF'') files. 75This program has two chief purposes: (1)~It can be used as preprocessor 76for existing \.{DVI}-related software in cases where this software is 77unable to handle virtual fonts or (given suitable \.{VF} or \.{OVF} files) 78where this software cannot handle fonts with more than 128~characters; 79and (2)~it serves as an example of a program that reads \.{DVI}, 80\.{VF} and \.{OVF} files correctly, for system programmers who are developing 81\.{DVI}-related software. 82 83Goal number (1) is important since quite a few existing programs have 84to be adapted to the extened capabilities of Version~3 of \TeX\ which 85will require some time. Moreover some existing programs are `as is' and 86the source code is, unfortunately, not available. 87Goal number (2) needs perhaps a bit more explanation. Programs for 88typesetting need to be especially careful about how they do arithmetic; if 89rounding errors accumulate, margins won't be straight, vertical rules 90won't line up, and so on (see the documentaion of \.{DVItype} for more 91details). This program is written as if it were a \.{DVI}-driver for a 92hypothetical typesetting device |out_file|, the output file receiving 93the copy of the input |dvi_file|. In addition all code related to 94|out_file| is concentrated in two chapters at the end of this program 95and quite independent of the rest of the code concerned with the 96decoding of \.{DVI}, \.{VF} and \.{OVF} files and with font substitutions. Thus 97it should be relatively easy to replace the device dependent code of 98this program by the corresponding code required for a real typesetting 99device. Having this in mind \.{DVItype}'s pixel rounding algorithms are 100included as conditional code not used by \.{ODVIcopy}. 101 102The \.{ODVIcopy} program is an extension of \.{DVIcopy} that allows 103the use of \.{OVF} and \.{OFM} files, which are used by the $\Omega$ 104typesetting system. These files allows fonts with 65536 characters, 105unlike ordinary \.{VF} and \.{TFM} files, which only allow 256 106characters. The definition for \.{OVF} files is identical to the one for 107\.{VF} files. On the other hand, \.{OFM} files are different; their 108documentation can be found in the $\Omega$ web. 109 110Unless the contrary is specified below, all references to \.{TFM} files 111also refer to \.{OFM} files, similarly for \.{VF} and \.{OVF} files. 112References to \.{DVIcopy} also apply to \.{ODVIcopy}. 113 114 115The |banner| and |preamble_comment| strings defined here should be 116changed whenever \.{ODVIcopy} gets modified. 117 118@d banner=='This is ODVIcopy, Version 1.6' {printed when the program starts} 119@d title=='ODVIcopy' {the name of this program, used in some messages} 120@d copyright== 121 '(C) 1990,2009 P. Breitenlohner, 1994,98 J. Plaice and Y. Haralambous' 122@# 123@d preamble_comment=='ODVIcopy 1.6 output from ' 124@d comm_length=25 {length of |preamble_comment|} 125@d from_length=6 {length of its |' from '| part} 126 127@ This program is written in standard \PASCAL, except where it is necessary 128to use extensions; for example, \.{DVIcopy} must read files whose names 129are dynamically specified, and that would be impossible in pure \PASCAL. 130All places where nonstandard constructions are used have been listed in 131the index under ``system dependencies.'' 132@!@^system dependencies@> 133 134One of the extensions to standard \PASCAL\ that we shall deal with is the 135ability to move to a random place in a binary file; another is to 136determine the length of a binary file. Such extensions are not necessary 137for reading \.{DVI} files; since \.{DVIcopy} is (a model for) a 138production program it should, however, be made as efficient as possible 139for a particular system. If \.{DVIcopy} is being used with 140\PASCAL s for which random file positioning is not efficiently available, 141the following definition should be changed from |true| to |false|; in such 142cases, \.{DVIcopy} will not include the optional feature that reads the 143postamble first. 144 145@d random_reading==true {should we skip around in the file?} 146 147@ The program begins with a fairly normal header, made up of pieces that 148@^system dependencies@> 149will mostly be filled in later. The \.{DVI} input comes from file 150|dvi_file|, the \.{DVI} output goes to file |out_file|, and messages 151go to \PASCAL's standard |output| file. 152The \.{TFM} and \.{VF} files are defined later since their external 153names are determined dynamically. 154 155If it is necessary to abort the job because of a fatal error, the program 156calls the `|jump_out|' procedure, which goes to the label |final_end|. 157 158@d final_end = 9999 {go here to wrap it up} 159 160@p @t\4@>@<Compiler directives@>@/ 161program ODVI_copy(@!dvi_file,@!out_file,@!output); 162label final_end; 163const @<Constants in the outer block@>@/ 164type @<Types in the outer block@>@/ 165var @<Globals in the outer block@>@/ 166@<Error handling procedures@>@/ 167procedure initialize; {this procedure gets things started properly} 168 var @<Local variables for initialization@>@/ 169 begin print_ln(banner);@/ 170 print_ln(copyright); 171 print_ln('Distributed under terms of GNU General Public License');@/ 172 @<Set initial values@>@/ 173 end; 174 175@ The definition of |max_font_type| should be adapted to the number of 176font types used by the program; the first three values have a fixed 177meaning: |defined_font=0| indicates that a font has been defined, 178|loaded_font=1| indicates that the \.{TFM} file has been loaded but the 179font has not yet been used, and |vf_font_type=2| indicates a virtual 180font. Font type values |>=real_font=3| indicate real fonts and 181different font types are used to distinguish various kinds of font files 182(\.{GF} or \.{PK} or \.{PXL}). \.{DVIcopy} uses |out_font_type=3| for 183fonts that appear in the output \.{DVI} file. 184@!@^font types@> 185 186@d defined_font=0 {this font has been defined} 187@d loaded_font=1 {this font has been defined and loaded} 188@d vf_font_type=2 {this font is a virtual font} 189@d real_font=3 {smallest font type for real fonts} 190@# 191@d out_font_type=3 {this font appears in the output file} 192@d max_font_type=3 193 194@ The following parameters can be changed at compile time to extend or 195reduce \.{DVIcopy}'s capacity. 196 197@d max_select=10 {maximum number of page selection ranges} 198 199@<Constants...@>= 200@!max_fonts=100; {maximum number of distinct fonts} 201@!max_chars=10000; {maximum number of different characters among all fonts} 202@!max_widths=3000; {maximum number of different characters widths} 203@!max_packets=5000; {maximum number of different characters packets; 204 must be less than 65536} 205@!max_bytes=30000; {maximum number of bytes for characters packets} 206@!max_recursion=10; {\.{VF} files shouldn't recurse beyond this level} 207@!stack_size=100; {\.{DVI} files shouldn't |push| beyond this depth} 208@!terminal_line_length=150; {maximum number of characters input in a single 209 line of input from the terminal} 210@!name_length=50; {a file name shouldn't be longer than this} 211@!neg_max_chars=-10000; {maximum number of different characters among all fonts} 212 213@ As mentioned above, \.{DVIcopy} has two chief purposes: (1)~It produces 214a copy of the input \.{DVI} file with all references to characters from 215virtual fonts replaced by their expansion as specified in the character 216packets of \.{VF} files; and (2)~it serves as an example of a program 217that reads \.{DVI} and \.{VF} files correctly, for system programmers 218who are developing \.{DVI}-related software. 219 220In fact, a very large section of code (starting with the second chapter 221`Introduction (continued)' and ending with the fifteenth chapter 222`The main program') is used in identical form in \.{DVIcopy} and in 223\.{DVIprint}, a prototype \.{DVI}-driver. This has been made possible 224mostly by using several \.{WEB} coding tricks, such as not to make the 225resulting \PASCAL\ program inefficient in any way. 226 227Parts of the program that are needed in \.{DVIprint} but not in 228\.{DVIcopy} are delimited by the codewords `$|device|\ldots|ecived|$'; 229these are mostly the pixel rounding algorithms used to convert the 230\.{DVI} units of a \.{DVI} file to the raster units of a real output 231device and have been copied more or less verbatim from \.{DVItype}. 232 233@d device==@{ {change this to `$\\{device}\equiv\null$' when output 234 for a real device is produced} 235@d ecived==@t@>@} {change this to `$\\{ecived}\equiv\null$' when output 236 for a real device is produced} 237@f device==begin 238@f ecived==end 239 240@* Introduction (continued). 241On some systems it is necessary to use various integer subrange types 242in order to make \.{\title} efficient; this is true in particular for 243frequently used variables such as loop indices. Consider an integer 244variable |x| with values in the range |0..255|: on most small systems 245|x| should be a one or two byte integer whereas on most large systems 246|x| should be a four byte integer. 247Clearly the author of a program knows best which range of values is 248required for each variable; thus \.{\title} never uses \PASCAL's |integer| 249type. All integer variables are declared as one of the integer subrange 250types defined below as \.{WEB} macros or \PASCAL\ types; these definitions 251can be used without system-dependent changes, provided the signed 32~bit 252integers are a subset of the standard type |integer|, and the compiler 253automatically uses the optimal representation for integer subranges 254(both conditions need not be satisfied for a particular system). 255@^system dependencies@> 256 257The complementary problem of storing large arrays of integer type 258variables as compactly as possible is addressed differently; here 259\.{\title} uses a \PASCAL\ |type|~declaration for each kind of array 260element. 261 262Note that the primary purpose of these definitions is optimizations, not 263range checking. All places where optimization for a particular system is 264highly desirable have been listed in the index under ``optimization.'' 265@!@^optimization@> 266 267@d int_32 == integer {signed 32~bit integers} 268 269@<Types...@>= 270@!int_31 = 0..@"7FFFFFFF; {unsigned 31~bit integer} 271@!int_24u = 0..@"FFFFFF; {unsigned 24~bit integer} 272@!int_24 = -@"800000..@"7FFFFF; {signed 24~bit integer} 273@!int_23 = 0..@"7FFFFF; {unsigned 23~bit integer} 274@!int_16u = 0..@"FFFF; {unsigned 16~bit integer} 275@!int_16 = -@"8000..@"7FFF; {signed 16~bit integer} 276@!int_15 = 0..@"7FFF; {unsigned 15~bit integer} 277@!int_8u = 0..@"FF; {unsigned 8~bit integer} 278@!int_8 = -@"80..@"7F; {signed 8~bit integer} 279@!int_7 = 0..@"7F; {unsigned 7~bit integer} 280 281@ Some of this code is optional for use when debugging only; 282such material is enclosed between the delimiters |debug| and $|gubed|$. 283Other parts, delimited by |stat| and $|tats|$, are optionally included 284if statistics about \.{\title}'s memory usage are desired. 285 286@d debug==@{ {change this to `$\\{debug}\equiv\null$' when debugging} 287@d gubed==@t@>@} {change this to `$\\{gubed}\equiv\null$' when debugging} 288@f debug==begin 289@f gubed==end 290@# 291@d stat==@{ {change this to `$\\{stat}\equiv\null$' 292 when gathering usage statistics} 293@d tats==@t@>@} {change this to `$\\{tats}\equiv\null$' 294 when gathering usage statistics} 295@f stat==begin 296@f tats==end 297 298@ The \PASCAL\ compiler used to develop this program has ``compiler 299directives'' that can appear in comments whose first character is a dollar sign. 300In production versions of \.{\title} these directives tell the compiler that 301@^system dependencies@> 302it is safe to avoid range checks and to leave out the extra code it inserts 303for the \PASCAL\ debugger's benefit, although interrupts will occur if 304there is arithmetic overflow. 305 306@<Compiler directives@>= 307@{@&$C-,A+,D-@} {no range check, catch arithmetic overflow, no debug overhead} 308@!debug @{@&$C+,D+@}@+ gubed {but turn everything on when debugging} 309 310@ Labels are given symbolic names by the following definitions. We insert 311the label `|exit|:' just before the `\ignorespaces|end|\unskip' of a 312procedure in which we have used the `|return|' statement defined below; 313the label `|restart|' is occasionally used at the very beginning of a 314procedure; and the label `|reswitch|' is occasionally used just prior to 315a \&{case} statement in which some cases change the conditions and we wish to 316branch to the newly applicable case. 317Loops that are set up with the \&{loop} construction defined below are 318commonly exited by going to `|done|' or to `|found|' or to `|not_found|', 319and they are sometimes repeated by going to `|continue|'. 320 321@d exit=10 {go here to leave a procedure} 322@d restart=20 {go here to start a procedure again} 323@d reswitch=21 {go here to start a case statement again} 324@d continue=22 {go here to resume a loop} 325@d done=30 {go here to exit a loop} 326@d found=31 {go here when you've found it} 327@d not_found=32 {go here when you've found something else} 328 329@ The term |print| is used instead of |write| when this program writes on 330|output|, so that all such output could easily be redirected if desired; 331the term |d_print| is used for conditional output if we are debugging. 332 333@d print(#)==write(output,#) 334@d print_ln(#)==write_ln(output,#) 335@d new_line==write_ln(output) {start new line} 336@d print_nl(#)== {print information starting on a new line} 337 begin new_line; print(#); 338 end 339@# 340@d d_print(#)==@!debug print(#) @; @+ gubed 341@d d_print_ln(#)==@! debug print_ln(#) @; @+ gubed 342 343@ Here are some macros for common programming idioms. 344 345@d incr(#) == #:=#+1 {increase a variable by unity} 346@d decr(#) == #:=#-1 {decrease a variable by unity} 347@# 348@d Incr_Decr_end(#)==# 349@d Incr(#)==#:=#+Incr_Decr_end {we use |Incr(a)(b)| to increase \dots} 350@d Decr(#)==#:=#-Incr_Decr_end {\dots\ and |Decr(a)(b)| to decrease 351 variable |a| by |b|; this can be optimized for some compilers} 352@# 353@d loop == @+ while true do@+ {repeat over and over until a |goto| happens} 354@d do_nothing == {empty statement} 355@d return == goto exit {terminate a procedure call} 356@f return == nil 357@f loop == xclause 358 359@ We assume that |case| statements may include a default case that applies 360if no matching label is found. Thus, we shall use constructions like 361@^system dependencies@> 362$$\vbox{\halign{#\hfil\cr 363|case x of|\cr 3641: $\langle\,$code for $x=1\,\rangle$;\cr 3653: $\langle\,$code for $x=3\,\rangle$;\cr 366|othercases| $\langle\,$code for |x<>1| and |x<>3|$\,\rangle$\cr 367|endcases|\cr}}$$ 368since most \PASCAL\ compilers have plugged this hole in the language by 369incorporating some sort of default mechanism. For example, the compiler 370used to develop \.{WEB} and \TeX\ allows `|others|:' as a default label, 371and other \PASCAL s allow syntaxes like `\ignorespaces|else|\unskip' or 372`\&{otherwise}' or `\\{otherwise}:', etc. The definitions of |othercases| 373and |endcases| should be changed to agree with local conventions. (Of 374course, if no default mechanism is available, the |case| statements of 375this program must be extended by listing all remaining cases. 376Donald~E. Knuth, the author of the \.{WEB} system program \.{TANGLE}, 377@^Knuth, Donald Ervin@> 378would have taken the trouble to modify \.{TANGLE} so that such extensions 379were done automatically, if he had not wanted to encourage \PASCAL\ 380compiler writers to make this important change in \PASCAL, where it belongs.) 381 382@d othercases == others: {default for cases not listed explicitly} 383@d endcases == @+end {follows the default case in an extended |case| statement} 384@f othercases == else 385@f endcases == end 386 387@* The character set. 388Like all programs written with the \.{WEB} system, \.{\title} can be 389used with any character set. But it uses ASCII code internally, because 390the programming for portable input-output is easier when a fixed internal 391code is used, and because \.{DVI} and \.{VF} files use ASCII code for 392file names and certain other strings. 393 394The next few sections of \.{\title} have therefore been copied from the 395analogous ones in the \.{WEB} system routines. They have been considerably 396simplified, since \.{\title} need not deal with the controversial 397ASCII codes less than @'40 or greater than @'176. 398If such codes appear in the \.{DVI} file, 399they will be printed as question marks. 400 401@<Types...@>= 402@!ASCII_code=" ".."~"; {a subrange of the integers} 403 404@ The original \PASCAL\ compiler was designed in the late 60s, when six-bit 405character sets were common, so it did not make provision for lower case 406letters. Nowadays, of course, we need to deal with both upper and lower case 407alphabets in a convenient way, especially in a program like \.{\title}. 408So we shall assume that the \PASCAL\ system being used for \.{\title} 409has a character set containing at least the standard visible characters 410of ASCII code (|"!"| through |"~"|). 411 412Some \PASCAL\ compilers use the original name |char| for the data type 413associated with the characters in text files, while other \PASCAL s 414consider |char| to be a 64-element subrange of a larger data type that has 415some other name. In order to accommodate this difference, we shall use 416the name |text_char| to stand for the data type of the characters in the 417output file. We shall also assume that |text_char| consists of 418the elements |chr(first_text_char)| through |chr(last_text_char)|, 419inclusive. The following definitions should be adjusted if necessary. 420@^system dependencies@> 421 422@d text_char == char {the data type of characters in text files} 423@d first_text_char=0 {ordinal number of the smallest element of |text_char|} 424@d last_text_char=127 {ordinal number of the largest element of |text_char|} 425 426@<Types...@>= 427@!text_file=packed file of text_char; 428 429@ @<Local variables for init...@>= 430@!i:int_16; {loop index for initializations} 431 432@ The \.{\title} processor converts between ASCII code and 433the user's external character set by means of arrays |xord| and |xchr| 434that are analogous to \PASCAL's |ord| and |chr| functions. 435 436@<Globals...@>= 437@!xord: array [text_char] of ASCII_code; 438 {specifies conversion of input characters} 439@!xchr: array [0..255] of text_char; 440 {specifies conversion of output characters} 441 442@ Under our assumption that the visible characters of standard ASCII are 443all present, the following assignment statements initialize the 444|xchr| array properly, without needing any system-dependent changes. 445 446@<Set init...@>= 447for i:=0 to @'37 do xchr[i]:='?'; 448xchr[@'40]:=' '; 449xchr[@'41]:='!'; 450xchr[@'42]:='"'; 451xchr[@'43]:='#'; 452xchr[@'44]:='$'; 453xchr[@'45]:='%'; 454xchr[@'46]:='&'; 455xchr[@'47]:='''';@/ 456xchr[@'50]:='('; 457xchr[@'51]:=')'; 458xchr[@'52]:='*'; 459xchr[@'53]:='+'; 460xchr[@'54]:=','; 461xchr[@'55]:='-'; 462xchr[@'56]:='.'; 463xchr[@'57]:='/';@/ 464xchr[@'60]:='0'; 465xchr[@'61]:='1'; 466xchr[@'62]:='2'; 467xchr[@'63]:='3'; 468xchr[@'64]:='4'; 469xchr[@'65]:='5'; 470xchr[@'66]:='6'; 471xchr[@'67]:='7';@/ 472xchr[@'70]:='8'; 473xchr[@'71]:='9'; 474xchr[@'72]:=':'; 475xchr[@'73]:=';'; 476xchr[@'74]:='<'; 477xchr[@'75]:='='; 478xchr[@'76]:='>'; 479xchr[@'77]:='?';@/ 480xchr[@'100]:='@@'; 481xchr[@'101]:='A'; 482xchr[@'102]:='B'; 483xchr[@'103]:='C'; 484xchr[@'104]:='D'; 485xchr[@'105]:='E'; 486xchr[@'106]:='F'; 487xchr[@'107]:='G';@/ 488xchr[@'110]:='H'; 489xchr[@'111]:='I'; 490xchr[@'112]:='J'; 491xchr[@'113]:='K'; 492xchr[@'114]:='L'; 493xchr[@'115]:='M'; 494xchr[@'116]:='N'; 495xchr[@'117]:='O';@/ 496xchr[@'120]:='P'; 497xchr[@'121]:='Q'; 498xchr[@'122]:='R'; 499xchr[@'123]:='S'; 500xchr[@'124]:='T'; 501xchr[@'125]:='U'; 502xchr[@'126]:='V'; 503xchr[@'127]:='W';@/ 504xchr[@'130]:='X'; 505xchr[@'131]:='Y'; 506xchr[@'132]:='Z'; 507xchr[@'133]:='['; 508xchr[@'134]:='\'; 509xchr[@'135]:=']'; 510xchr[@'136]:='^'; 511xchr[@'137]:='_';@/ 512xchr[@'140]:='`'; 513xchr[@'141]:='a'; 514xchr[@'142]:='b'; 515xchr[@'143]:='c'; 516xchr[@'144]:='d'; 517xchr[@'145]:='e'; 518xchr[@'146]:='f'; 519xchr[@'147]:='g';@/ 520xchr[@'150]:='h'; 521xchr[@'151]:='i'; 522xchr[@'152]:='j'; 523xchr[@'153]:='k'; 524xchr[@'154]:='l'; 525xchr[@'155]:='m'; 526xchr[@'156]:='n'; 527xchr[@'157]:='o';@/ 528xchr[@'160]:='p'; 529xchr[@'161]:='q'; 530xchr[@'162]:='r'; 531xchr[@'163]:='s'; 532xchr[@'164]:='t'; 533xchr[@'165]:='u'; 534xchr[@'166]:='v'; 535xchr[@'167]:='w';@/ 536xchr[@'170]:='x'; 537xchr[@'171]:='y'; 538xchr[@'172]:='z'; 539xchr[@'173]:='{'; 540xchr[@'174]:='|'; 541xchr[@'175]:='}'; 542xchr[@'176]:='~'; 543for i:=@'177 to 255 do xchr[i]:='?'; 544 545@ The following system-independent code makes the |xord| array contain a 546suitable inverse to the information in |xchr|. 547 548@<Set init...@>= 549for i:=first_text_char to last_text_char do xord[chr(i)]:=@'40; 550for i:=" " to "~" do xord[xchr[i]]:=i; 551 552@* Reporting errors to the user. 553The \.{\title} processor does not verify that every single bit read from 554one of its binary input files is meaningful and consistent; there are 555other programs, e.g., \.{DVItype}, \.{TFtoPL}, and \.{VFtoPL}, specially 556designed for that purpose. 557 558On the other hand, \.{\title} is designed to avoid unpredictable results 559due to undetected arithmetic overflow, or due to violation of integer 560subranges or array bounds under {\it all\/} circumstances. Thus a fair 561amount of checking is done when reading and analyzing the input data, 562even in cases where such checking reduces the efficiency of the program 563to some extent. 564 565@ A global variable called |history| will contain one of four values 566at the end of every run: |spotless| means that no unusual messages were 567printed; |harmless_message| means that a message of possible interest 568was printed but no serious errors were detected; |error_message| means that 569at least one error was found; |fatal_message| means that the program 570terminated abnormally. The value of |history| does not influence the 571behavior of the program; it is simply computed for the convenience 572of systems that might want to use such information. 573 574@d spotless=0 {|history| value for normal jobs} 575@d harmless_message=1 {|history| value when non-serious info was printed} 576@d error_message=2 {|history| value when an error was noted} 577@d fatal_message=3 {|history| value when we had to stop prematurely} 578@# 579@d mark_harmless==@t@>@+if history=spotless then history:=harmless_message 580@d mark_error==history:=error_message 581@d mark_fatal==history:=fatal_message 582 583@<Glob...@>=@!history:spotless..fatal_message; {how bad was this run?} 584 585@ @<Set init...@>=history:=spotless; 586 587@ If an input (\.{DVI}, \.{TFM}, \.{VF}, or other) file is badly malformed, 588the whole process must be aborted; \.{\title} will give up, after issuing 589an error message about what caused the error. These messages will, however, 590in most cases just indicate which input file caused the error. One of the 591programs \.{DVItype}, \.{TFtoPL} or \.{VFtoVP} should then be used to 592diagnose the error in full detail. 593 594Such errors might be discovered inside of subroutines inside of subroutines, 595so a procedure called |jump_out| has been introduced. This procedure, which 596transfers control to the label |final_end| at the end of the program, 597contains the only non-local |@!goto| statement in \.{\title}. 598@^system dependencies@> 599Some \PASCAL\ compilers do not implement non-local |goto| statements. In 600such cases the |goto final_end| in |jump_out| should simply be replaced 601by a call on some system procedure that quietly terminates the program. 602@^system dependencies@> 603 604@d abort(#)==begin print_ln(' ',#,'.'); jump_out; 605 end 606 607@<Error handling...@>= 608@<Basic printing procedures@>@; 609procedure close_files_and_terminate; forward; 610@# 611procedure jump_out; 612begin mark_fatal; close_files_and_terminate; 613goto final_end; 614end; 615 616@ Sometimes the program's behavior is far different from what it should 617be, and \.{\title} prints an error message that is really for the 618\.{\title} maintenance person, not the user. In such cases the program 619says |confusion(|indication of where we are|)|. 620 621@<Error handling...@>= 622procedure confusion(@!p:pckt_pointer); 623begin print(' !This can''t happen ('); print_packet(p); print_ln(').'); 624@.This can't happen@> 625jump_out; 626end; 627 628@ An overflow stop occurs if \.{\title}'s tables aren't large enough. 629 630@<Error handling...@>= 631procedure overflow(@!p:pckt_pointer;@!n:int_16u); 632begin print(' !Sorry, ',title,' capacity exceeded ['); print_packet(p); 633@.Sorry, {\title} capacity exceeded@> 634print_ln('=',n:1,'].'); 635jump_out; 636end; 637 638@* Binary data and binary files. 639A detailed description of the \.{DVI} file format can be found in the 640documentation of \TeX, \.{DVItype}, or \.{GFtoDVI}; here we just define 641symbolic names for some of the \.{DVI} command bytes. 642 643@d set_char_0=0 {typeset character 0 and move right} 644@d set1=128 {typeset a character and move right} 645@d set_rule=132 {typeset a rule and move right} 646@d put1=133 {typeset a character} 647@d put_rule=137 {typeset a rule} 648@d nop=138 {no operation} 649@d bop=139 {beginning of page} 650@d eop=140 {ending of page} 651@d push=141 {save the current positions} 652@d pop=142 {restore previous positions} 653@d right1=143 {move right} 654@d w0=147 {move right by |w|} 655@d w1=148 {move right and set |w|} 656@d x0=152 {move right by |x|} 657@d x1=153 {move right and set |x|} 658@d down1=157 {move down} 659@d y0=161 {move down by |y|} 660@d y1=162 {move down and set |y|} 661@d z0=166 {move down by |z|} 662@d z1=167 {move down and set |z|} 663@d fnt_num_0=171 {set current font to 0} 664@d fnt1=235 {set current font} 665@d xxx1=239 {extension to \.{DVI} primitives} 666@d xxx4=242 {potentially long extension to \.{DVI} primitives} 667@d fnt_def1=243 {define the meaning of a font number} 668@d pre=247 {preamble} 669@d post=248 {postamble beginning} 670@d post_post=249 {postamble ending} 671@# 672@d dvi_id=2 {identifies \.{DVI} files} 673@d dvi_pad=223 {pad bytes at end of \.{DVI} file} 674 675@ A \.{DVI}, \.{VF}, or \.{TFM} file is a sequence of 8-bit bytes. 676The bytes appear physically in what is called a `|packed file of 0..255|' 677in \PASCAL\ lingo. One, two, three, or four consecutive bytes are often 678interpreted as (signed or unsigned) integers. 679We might as well define the corresponding data types. 680@!@^system dependencies@> 681 682@<Types...@>= 683@!signed_byte=-@"80..@"7F; {signed one-byte quantity} 684@!eight_bits=0..@"FF; {unsigned one-byte quantity} 685@!signed_pair=-@"8000..@"7FFF; {signed two-byte quantity} 686@!sixteen_bits=0..@"FFFF; {unsigned two-byte quantity} 687@!signed_trio=-@"800000..@"7FFFFF; {signed three-byte quantity} 688@!twentyfour_bits=0..@"FFFFFF; {unsigned three-byte quantity} 689@!signed_quad=int_32; {signed four-byte quantity} 690 691@ Packing is system dependent, and many \PASCAL\ systems fail to implement 692such files in a sensible way (at least, from the viewpoint of producing 693good production software). For example, some systems treat all 694byte-oriented files as text, looking for end-of-line marks and such 695things. Therefore some system-dependent code is often needed to deal with 696binary files, even though most of the program in this section of 697\.{\title} is written in standard \PASCAL. 698@^system dependencies@> 699 700One common way to solve the problem is to consider files of |integer| 701numbers, and to convert an integer in the range $-2^{31}\L x<2^{31}$ to 702a sequence of four bytes $(a,b,c,d)$ using the following code, which 703avoids the controversial integer division of negative numbers: 704$$\vbox{\halign{#\hfil\cr 705|if x>=0 then a:=x div @'100000000|\cr 706|else begin x:=(x+@'10000000000)+@'10000000000; a:=x div @'100000000+128;|\cr 707\quad|end|\cr 708|x:=x mod @'100000000;|\cr 709|b:=x div @'200000; x:=x mod @'200000;|\cr 710|c:=x div @'400; d:=x mod @'400;|\cr}}$$ 711The four bytes are then kept in a buffer and output one by one. (On 36-bit 712computers, an additional division by 16 is necessary at the beginning. 713Another way to separate an integer into four bytes is to use/abuse 714\PASCAL's variant records, storing an integer and retrieving bytes that are 715packed in the same place; {\sl caveat implementor!\/}) It is also desirable 716in some cases to read a hundred or so integers at a time, maintaining a 717larger buffer. 718 719@ We shall stick to simple \PASCAL\ in the standard version of this program, 720for reasons of clarity, even if such simplicity is sometimes unrealistic. 721 722@<Types...@>= 723@!byte_file=packed file of eight_bits; {files that contain binary data} 724 725@ For some operating systems it may be convenient or even necessary to 726close the input files. 727 728@d close_in(#)==do_nothing {close an input file} 729 730@ Character packets extracted from \.{VF} files will be stored in a large 731array |byte_mem|. Other packets of bytes, e.g., character packets 732extracted from a \.{GF} or \.{PK} or \.{PXL} file could be stored in the 733same way. A `|pckt_pointer|' variable, which signifies a packet, 734is an index into another array |pckt_start|. The actual sequence of bytes 735in the packet pointed to by |p| appears in positions |pckt_start[p]| to 736|pckt_start[p+1]-1|, inclusive, in |byte_mem|. 737 738Packets will also be used to store sequences of |ASCII_code|s; in this 739respect the |byte_mem| array is very similar to \TeX's string pool and 740part of the following code has, in fact, been copied more or less 741verbatim from \TeX. 742 743In other respects the packets resemble the identifiers used by 744\.{TANGLE} and \.{WEAVE} (also stored in an array called |byte_mem|) 745since there is, in general, at most one packet with a given contents; 746thus part of the code below has been adapted from the corresponding code 747in these programs. 748 749Some \PASCAL\ compilers won't pack integers into a single byte unless the 750integers lie in the range |-128..127|. To accommodate such systems we 751access the array |byte_mem| only via macros that can easily be redefined. 752@^system dependencies@> 753 754@d bi(#) == # {convert from |eight_bits| to |packed_byte|} 755@d bo(#) == # {convert from |packed_byte| to |eight_bits|} 756 757@<Types...@>= 758@!packed_byte = eight_bits; {elements of |byte_mem| array} 759@!byte_pointer = 0..max_bytes; {an index into |byte_mem|} 760@!pckt_pointer = 0..max_packets; {an index into |pckt_start|} 761 762@ The global variable |byte_ptr| points to the first unused location in 763|byte_mem| and |pckt_ptr| points to the first unused location in 764|pckt_start|. 765 766@<Globals...@>= 767@!byte_mem: packed array [byte_pointer] of packed_byte; {bytes of packets} 768@!pckt_start: array [pckt_pointer] of byte_pointer; 769 {directory into |byte_mem|} 770@!byte_ptr: byte_pointer; 771@!pckt_ptr: pckt_pointer; 772 773@ Several of the elementary operations with packets are performed using 774\.{WEB} macros instead of \PASCAL\ procedures, because many of the 775operations are done quite frequently and we want to avoid the 776overhead of procedure calls. For example, here is 777a simple macro that computes the length of a packet. 778@.WEB@> 779 780@d pckt_length(#)==(pckt_start[#+1]-pckt_start[#]) {the number of bytes 781 in packet number \#} 782 783@ Packets are created by appending bytes to |byte_mem|. 784The |append_byte| macro, defined here, does not check to see if the 785value of |byte_ptr| has gotten too high; this test is supposed to be 786made before |append_byte| is used. There is also a |flush_byte| 787macro, which erases the last byte appended. 788 789To test if there is room to append |l| more bytes to |byte_mem|, 790we shall write |pckt_room(l)|, which aborts \.{\title} and gives an 791apologetic error message if there isn't enough room. 792 793@d append_byte(#) == {put byte \# at the end of |byte_mem|} 794begin byte_mem[byte_ptr]:=bi(#); incr(byte_ptr); 795end 796@d flush_byte == decr(byte_ptr) {forget the last byte in |byte_mem|} 797@d pckt_room(#) == {make sure that |byte_mem| hasn't overflowed} 798 if max_bytes-byte_ptr<# then overflow(str_bytes,max_bytes) 799@# 800@d append_one(#) == 801begin pckt_room(1); append_byte(#); 802end 803 804@ The length of the current packet is called |cur_pckt_length|: 805 806@d cur_pckt_length == (byte_ptr - pckt_start[pckt_ptr]) 807 808@ Once a sequence of bytes has been appended to |byte_mem|, it 809officially becomes a packet when the |make_packet| function is called. 810This function returns as its value the identification number of either 811an existing packet with the same contents or, if no such packet exists, 812of the new packet. Thus two packets have the same contents if and only 813if they have the same identification number. In order to locate the 814packet with a given contents, or to find out that no such packet exists, 815we need a hash table. The hash table is kept by the method of simple 816chaining, where the heads of the individual lists appear in the |p_hash| 817array. If |h| is a hash code, the hash table list starts at |p_hash[h]| 818and proceeds through |p_link| pointers. 819 820@d hash_size=353 {should be prime, must be |>256|} 821 822@<Types...@>= 823@!hash_code=0..hash_size; 824 825@ @<Glob...@>= 826@!p_link:array[pckt_pointer] of pckt_pointer; {hash table} 827@!p_hash:array[hash_code] of pckt_pointer; 828 829@ Initially |byte_mem| and all the hash lists are empty; |empty_packet| 830is the empty packet. 831 832@d empty_packet=0 {the empty packet} 833@d invalid_packet==max_packets {used when there is no packet} 834 835@<Set init...@>= 836pckt_ptr:=1; byte_ptr:=1; 837pckt_start[0]:=1; pckt_start[1]:=1; 838for h:=0 to hash_size-1 do p_hash[h]:=0; 839 840@ @<Local variables for init...@>= 841@!h:hash_code; {index into hash-head arrays} 842 843@ Here now is the |make_packet| function used to create packets (and 844strings). 845 846@p function make_packet:pckt_pointer; 847label found; 848var i,@!k:byte_pointer; {indices into |byte_mem|} 849@!h:hash_code; {hash code} 850@!s,@!l:byte_pointer; {start and length of the given packet} 851@!p:pckt_pointer; {where the packet is being sought} 852begin s:=pckt_start[pckt_ptr]; l:=byte_ptr-s; {compute start and length} 853if l=0 then p:=empty_packet 854else begin @<Compute the packet hash code |h|@>; 855 @<Compute the packet location |p|@>; 856 if pckt_ptr=max_packets then overflow(str_packets,max_packets); 857 incr(pckt_ptr); pckt_start[pckt_ptr]:=byte_ptr; 858 end; 859found:make_packet:=p; 860end; 861 862@ A simple hash code is used: If the sequence of bytes is 863$b_1b_2\ldots b_n$, its hash value will be 864$$(2^{n-1}b_1+2^{n-2}b_2+\cdots+b_n)\,\bmod\,|hash_size|.$$ 865 866@<Compute the packet hash...@>= 867h:=bo(byte_mem[s]); i:=s+1; 868while i<byte_ptr do 869 begin h:=(h+h+bo(byte_mem[i])) mod hash_size; incr(i); 870 end 871 872@ If the packet is new, it will be placed in position |p=pckt_ptr|, 873otherwise |p| will point to its existing location. 874 875@<Compute the packet location...@>= 876p:=p_hash[h]; 877while p<>0 do 878 begin if pckt_length(p)=l then 879 @<Compare packet |p| with current packet, |goto found| if equal@>; 880 p:=p_link[p]; 881 end; 882p:=pckt_ptr; {the current packet is new} 883p_link[p]:=p_hash[h]; p_hash[h]:=p {insert |p| at beginning of hash list} 884 885@ @<Compare packet |p|...@>= 886begin i:=s; k:=pckt_start[p]; 887while (i<byte_ptr)and(byte_mem[i]=byte_mem[k]) do 888 begin incr(i); incr(k); 889 end; 890if i=byte_ptr then {all bytes agree} 891 begin byte_ptr:=pckt_start[pckt_ptr]; goto found; 892 end; 893end 894 895@ Some packets are initialized with predefined strings of |ASCII_code|s; 896a few macros permit us to do the initialization with a compact program. 897Since this initialization is done when |byte_mem| is still empty, and 898since |byte_mem| is supposed to be large enough for all the predefined 899strings, |pckt_room| is used only if we are debugging. 900 901@d pid0(#)==#:=make_packet 902@d pid1(#)==byte_mem[byte_ptr-1]:=bi(#); pid0 903@d pid2(#)==byte_mem[byte_ptr-2]:=bi(#); pid1 904@d pid3(#)==byte_mem[byte_ptr-3]:=bi(#); pid2 905@d pid4(#)==byte_mem[byte_ptr-4]:=bi(#); pid3 906@d pid5(#)==byte_mem[byte_ptr-5]:=bi(#); pid4 907@d pid6(#)==byte_mem[byte_ptr-6]:=bi(#); pid5 908@d pid7(#)==byte_mem[byte_ptr-7]:=bi(#); pid6 909@d pid8(#)==byte_mem[byte_ptr-8]:=bi(#); pid7 910@d pid9(#)==byte_mem[byte_ptr-9]:=bi(#); pid8 911@d pid10(#)==byte_mem[byte_ptr-10]:=bi(#); pid9 912@# 913@d pid_init(#)== 914 @!debug pckt_room(#); @+ gubed @; 915 Incr(byte_ptr)(#) 916@# 917@d id1==pid_init(1); pid1 918@d id2==pid_init(2); pid2 919@d id3==pid_init(3); pid3 920@d id4==pid_init(4); pid4 921@d id5==pid_init(5); pid5 922@d id6==pid_init(6); pid6 923@d id7==pid_init(7); pid7 924@d id8==pid_init(8); pid8 925@d id9==pid_init(9); pid9 926@d id10==pid_init(10); pid10 927 928@ Here we initialize some strings used as argument of the |overflow| and 929|confusion| procedures. 930 931@<Initialize predefined strings@>= 932id5("f")("o")("n")("t")("s")(str_fonts); 933id5("c")("h")("a")("r")("s")(str_chars); 934id6("w")("i")("d")("t")("h")("s")(str_widths); 935id7("p")("a")("c")("k")("e")("t")("s")(str_packets); 936id5("b")("y")("t")("e")("s")(str_bytes); 937id9("r")("e")("c")("u")("r")("s")("i")("o")("n")(str_recursion); 938id5("s")("t")("a")("c")("k")(str_stack); 939id10("n")("a")("m")("e")("l")("e")("n")("g")("t")("h")(str_name_length); 940 941@ @<Glob...@>= 942@!str_fonts,@!str_chars,@!str_widths,@!str_packets,@!str_bytes, 943@!str_recursion,@!str_stack,@!str_name_length:pckt_pointer; 944 945@ Some packets, e.g., the preamble comments of \.{DVI} and \.{VF} files, 946are needed only temporarily. In such cases |new_packet| is used to 947create a packet (which might duplicate an existing packet) and 948|flush_packet| is used to discard it; the calls to |new_packet| and 949|flush_packet| must occur in balanced pairs, without any intervening 950calls to |make_packet|. 951 952@p function new_packet: pckt_pointer; 953begin if pckt_ptr=max_packets then overflow(str_packets,max_packets); 954new_packet:=pckt_ptr; incr(pckt_ptr); pckt_start[pckt_ptr]:=byte_ptr; 955end; 956@# 957procedure flush_packet; 958begin decr(pckt_ptr); byte_ptr:=pckt_start[pckt_ptr]; 959end; 960 961@ The |print_packet| procedure prints the contents of a packet; such a 962packet should, of course, consists of a sequence of |ASCII_code|s. 963 964@<Basic printing...@>= 965procedure print_packet(p:pckt_pointer); 966var k:byte_pointer; 967begin for k:=pckt_start[p] to pckt_start[p+1]-1 do 968 print(xchr[bo(byte_mem[k])]); 969end; 970 971@ When we interpret a packet we will use two (global or local) variables: 972|cur_loc| will point to the byte to be used next, and |cur_limit| will 973point to the start of the next packet. The macro |pckt_extract| will be 974used to extract one byte; it should, however, never be used with 975|cur_loc>=cur_limit|. 976 977@d pckt_extract(#) == 978@!debug if cur_loc>=cur_limit then confusion(str_packets) @+ else @/ 979gubed @; 980 begin #:=bo(byte_mem[cur_loc]); incr(cur_loc); @+ end 981 982@<Globals...@>= 983@!cur_pckt: pckt_pointer; {the current packet} 984@!cur_loc: byte_pointer; {current location in a packet} 985@!cur_limit: byte_pointer; {start of next packet} 986 987@ We will need routines to extract one, two, three, or four bytes from 988|byte_mem|, from the \.{DVI} file, or from a \.{VF} file and assemble 989them into (signed or unsigned) integers and these routines should be 990optimized for efficiency. Here we define \.{WEB} macros to be used for 991the body of these routines; thus the changes for system dependent 992optimization have to be applied only once. 993@^system dependencies@> 994@^optimization@> 995 996In addition we demonstrates how these macros can be used to define 997functions that extract one, two, three, or four bytes from a character 998packet and assemble them into signed or unsigned integers (assuming that 999|cur_loc| and |cur_limit| are initialized suitably). 1000 1001@d begin_byte(#) == 1002var a:eight_bits; 1003begin #(a) 1004@d comp_sbyte(#) == if a<128 then #:=a @+ else #:=a-256 1005@d comp_ubyte(#) == #:=a 1006@f begin_byte == begin 1007 1008@p function pckt_sbyte:int_8; {returns the next byte, signed} 1009@!begin_byte(pckt_extract); comp_sbyte(pckt_sbyte); 1010end; 1011@# 1012function pckt_ubyte:int_8u; {returns the next byte, unsigned} 1013@!begin_byte(pckt_extract); comp_ubyte(pckt_ubyte); 1014end; 1015 1016@ @d begin_pair(#) == 1017var a,@!b:eight_bits; 1018begin #(a); #(b) 1019@d comp_spair(#) == if a<128 then #:=a*256+b @+ else #:=(a-256)*256+b 1020@d comp_upair(#) == #:=a*256+b 1021@f begin_pair == begin 1022 1023@p function pckt_spair:int_16; {returns the next two bytes, signed} 1024@!begin_pair(pckt_extract); comp_spair(pckt_spair); 1025end; 1026@# 1027function pckt_upair:int_16u; {returns the next two bytes, unsigned} 1028@!begin_pair(pckt_extract); comp_upair(pckt_upair); 1029end; 1030 1031@ @d begin_trio(#) == 1032var a,@!b,@!c:eight_bits; 1033begin #(a); #(b); #(c) 1034@d comp_strio(#) == 1035if a<128 then #:=(a*256+b)*256+c @+ else #:=((a-256)*256+b)*256+c 1036@d comp_utrio(#) == #:=(a*256+b)*256+c 1037@f begin_trio == begin 1038 1039@p function pckt_strio:int_24; {returns the next three bytes, signed} 1040@!begin_trio(pckt_extract); comp_strio(pckt_strio); 1041end; 1042@# 1043function pckt_utrio:int_24u; {returns the next three bytes, unsigned} 1044@!begin_trio(pckt_extract); comp_utrio(pckt_utrio); 1045end; 1046 1047@ @d begin_quad(#) == 1048var a,@!b,@!c,@!d:eight_bits; 1049begin #(a); #(b); #(c); #(d) 1050@d comp_squad(#) == 1051if a<128 then #:=((a*256+b)*256+c)*256+d 1052else #:=(((a-256)*256+b)*256+c)*256+d 1053@f begin_quad == begin 1054 1055@p function pckt_squad:int_32; {returns the next four bytes, signed} 1056@!begin_quad(pckt_extract); comp_squad(pckt_squad); 1057end; 1058 1059@ A similar set of routines is needed for the inverse task of 1060decomposing a \.{DVI} command into a sequence of bytes to be appended 1061to |byte_mem| or, in the case of \.{DVIcopy}, to be written to the 1062output file. Again we define \.{WEB} macros to be used for the body 1063of these routines; thus the changes for system dependent optimization 1064have to be applied only once. 1065@^system dependencies@> 1066@^optimization@> 1067 1068First, the |pckt_one| outputs one byte, negative values are represented 1069in two's complement notation. 1070 1071@d begin_one == begin 1072@d comp_one(#) == 1073if x<0 then Incr(x)(256); 1074#(x) 1075@f begin_one == begin 1076 1077@p @!device 1078procedure pckt_one(@!x:int_32); {output one byte} 1079@!begin_one; pckt_room(1); comp_one(append_byte); 1080end; 1081ecived 1082 1083@ The |pckt_two| outputs two bytes, negative values are represented in 1084two's complement notation. 1085 1086@d begin_two == begin 1087@d comp_two(#) == 1088if x<0 then Incr(x)(@"10000); 1089#(x div @"100); #(x mod @"100) 1090@f begin_two == begin 1091 1092@p @!device 1093procedure pckt_two(@!x:int_32); {output two byte} 1094@!begin_two; pckt_room(2); comp_two(append_byte); 1095end; 1096ecived 1097 1098@ The |pckt_four| procedure outputs four bytes in two's complement 1099notation, without risking arithmetic overflow. 1100 1101@d begin_four == begin 1102@d comp_four(#) == 1103if x>=0 then #(x div @"1000000) 1104else begin Incr(x)(@"40000000); Incr(x)(@"40000000); 1105 #((x div @"1000000) + 128); 1106 end; 1107x:=x mod @"1000000; #(x div @"10000); 1108x:=x mod @"10000; #(x div @"100); 1109#(x mod @"100) 1110@f begin_four == begin 1111 1112@p procedure pckt_four(@!x:int_32); {output four bytes} 1113@!begin_four; pckt_room(4); comp_four(append_byte); 1114end; 1115 1116@ Next, the |pckt_char| procedure outputs a |set_char| or \\{set} command 1117or, if |upd=false|, a |put| command. 1118 1119@d begin_char == 1120var o:eight_bits; {|set1| or |put1|} 1121begin 1122@d comp_char(#) == 1123o:=dvi_char_cmd[upd]; {|set1| or |put1|} 1124if (res>=0) and (res<@"100) then begin 1125 if (not upd)or(res>127)or(ext<>0) then 1126 begin if ext<0 then Incr(ext)(@"1000000); 1127 if ext=0 then #(o) @+ else @; 1128 begin if ext<@"100 then #(o+1) @+ else @; 1129 begin if ext<@"10000 then #(o+2) @+ else @; 1130 begin #(o+3); #(ext div @"10000); ext:=ext mod @"10000; 1131 end; 1132 #(ext div @"100); ext:=ext mod @"100; 1133 end; 1134 #(ext); 1135 end; 1136 end; 1137 #(res) 1138 end 1139else 1140 begin if (res>=0) and (res<@"10000) then #(o+1) @+ else @; 1141 begin if (res>=0) and (res<@"1000000) then #(o+2) @+ else @; 1142 begin #(o+3); 1143 if res>=0 then #(res div @"1000000) 1144 else begin Incr(res)(@"40000000); Incr(res)(@"40000000); 1145 #((res div @"1000000) + 128); res:=res mod @"1000000; 1146 end; 1147 res:=res mod @"1000000 1148 end; 1149 #(res div @"10000); res:= res mod @"10000 1150 end; 1151 #(res div @"100); res:=res mod @"100; #(res) 1152 end 1153 1154@f begin_char == begin 1155 1156@p procedure pckt_char(@!upd:boolean;@!ext:int_32;@!res:int_32); 1157 {output \\{set} or |put|} 1158@!begin_char; pckt_room(5); comp_char(append_byte); 1159end; 1160 1161@ Then, the |pckt_unsigned| procedure outputs a |fnt| or |xxx| 1162command with its first parameter (normally unsigned); a |fnt| command 1163is converted into |fnt_num| whenever this is possible. 1164 1165@d begin_unsigned == begin 1166@d comp_unsigned(#) == 1167if (x<@"100)and(x>=0) then 1168 if (o=fnt1)and(x<64) then Incr(x)(fnt_num_0) @+ else #(o) 1169else 1170 begin if (x<@"10000)and(x>=0) then #(o+1) @+ else @; 1171 begin if (x<@"1000000)and(x>=0) then #(o+2) @+ else @; 1172 begin #(o+3); 1173 if x>=0 then #(x div @"1000000) 1174 else begin Incr(x)(@"40000000); Incr(x)(@"40000000); 1175 #((x div @"1000000) + 128); 1176 end; 1177 x:=x mod @"1000000; 1178 end; 1179 #(x div @"10000); x:=x mod @"10000; 1180 end; 1181 #(x div @"100); x:=x mod @"100; 1182 end; 1183#(x) 1184@f begin_unsigned == begin 1185 1186@p procedure pckt_unsigned(@!o:eight_bits;@!x:int_32); 1187 {output |fnt_num|, |fnt|, or |xxx|} 1188@!begin_unsigned; pckt_room(5); comp_unsigned(append_byte); 1189end; 1190 1191@ Finally, the |pckt_signed| procedure outputs a movement (|right|, |w|, 1192|x|, |down|, |y|, or |z|) command with its (signed) parameter. 1193 1194@d begin_signed == 1195var xx:int_31; {`absolute value' of |x|} 1196begin 1197@d comp_signed(#) == 1198if x>=0 then xx:=x @+ else xx:=-(x+1); 1199if xx<@"80 then 1200 begin #(o); @+ if x<0 then Incr(x)(@"100); @+ end 1201else begin if xx<@"8000 then 1202 begin #(o+1); @+ if x<0 then Incr(x)(@"10000); @+ end 1203 else begin if xx<@"800000 then 1204 begin #(o+2); @+ if x<0 then Incr(x)(@"1000000); @+ end 1205 else begin #(o+3); 1206 if x>=0 then #(x div @"1000000) 1207 else begin x:=@"7FFFFFFF-xx; #((x div @"1000000) + 128); @+ end; 1208 x:=x mod @"1000000; 1209 end; 1210 #(x div @"10000); x:=x mod @"10000; 1211 end; 1212 #(x div @"100); x:=x mod @"100; 1213 end; 1214#(x) 1215@f begin_signed == begin 1216 1217@p procedure pckt_signed(@!o:eight_bits;@!x:int_32); 1218 {output |right|, |w|, |x|, |down|, |y|, or |z|} 1219@!begin_signed; pckt_room(5); comp_signed(append_byte); 1220end; 1221 1222@ The |hex_packet| procedure prints the contents of a packet in 1223hexadecimal form. 1224 1225@<Basic printing...@>= 1226@!debug procedure hex_packet(@!p:pckt_pointer); {prints a packet in hex} 1227var j,@!k,@!l:byte_pointer; {indices into |byte_mem|} 1228@!d:int_8u; 1229begin j:=pckt_start[p]-1; k:=pckt_start[p+1]-1; 1230print_ln(' packet=',p:1,' start=',j+1:1,' length=',k-j:1); 1231for l:=j+1 to k do 1232 begin d:=(bo(byte_mem[l])) div 16; 1233 if d<10 then print(xchr[d+"0"]) @+ else print(xchr[d-10+"A"]); 1234 d:=(bo(byte_mem[l])) mod 16; 1235 if d<10 then print(xchr[d+"0"]) @+ else print(xchr[d-10+"A"]); 1236 if (l=k)or(((l-j) mod 16)=0) then new_line 1237 else if ((l-j) mod 4)=0 then print(' ') 1238 else print(' '); 1239 end; 1240end; 1241gubed 1242 1243@* File names. 1244The structure of file names is different for different systems; therefore 1245this part of the program will, in most cases, require system dependent 1246modifications. Here we assume that a file name consists of three parts: 1247an area or directory specifying where the file can be found, a name 1248proper and an extension; \.{\title} assumes that these three parts appear 1249in order stated above but this need not be true in all cases. 1250 1251The font names extracted from \.{DVI} and \.{VF} files consist of an area 1252part and a name proper; these are stored as packets consisting of the 1253length of the area part followed by the area and the name proper. 1254When we print an external font name we simple print the area and the name 1255contained in the `file name packet' without delimiter between them. 1256This may need to be modified for some systems. 1257@^system dependencies@> 1258 1259@<Basic printing...@>= 1260procedure print_font(@!f:font_number); 1261var p:pckt_pointer; {the font name packet} 1262@!k:byte_pointer; {index into |byte_mem|} 1263@!m:int_31; {font magnification} 1264begin print(' = '); p:=font_name(f); 1265for k:=pckt_start[p]+1 to pckt_start[p+1]-1 do 1266 print(xchr[bo(byte_mem[k])]); 1267m:=round((font_scaled(f)/font_design(f))*out_mag); 1268if m<>1000 then print(' scaled ',m:1); 1269end; 1270 1271@ Before a font file can be opened for input we must build a string 1272with its external name. 1273 1274@<Glob...@>= 1275@!cur_name:packed array[1..name_length] of char; {external name, 1276 with no lower case letters} 1277@!l_cur_name:int_15; {this many characters are actually relevant in 1278 |cur_name|} 1279 1280@ For \.{TFM} and \.{VF} files we just append the appropriate extension 1281to the file name packet; in addition a system dependent area part 1282(usually different for \.{TFM} and \.{VF} files) is prepended if 1283the file name packet contains no area part. 1284@^system dependencies@> 1285 1286@d append_to_name(#)== 1287 if l_cur_name<name_length then 1288 begin incr(l_cur_name); cur_name[l_cur_name]:=#; 1289 end 1290 else overflow(str_name_length,name_length) 1291@d make_font_name_end(#)== 1292 append_to_name(#[l]); make_name 1293@d make_font_name(#)== 1294 l_cur_name:=0; for l:=1 to # do make_font_name_end 1295 1296@ For files with character raster data (e.g., \.{GF} or \.{PK} files) the 1297extension and\slash or area part will in most cases depend on the 1298resolution of the output device (corrected for font magnification). 1299If the special character |res_char| occurs in the extension and\slash or 1300default area, a character string representing the device resolution will 1301be substituted. 1302@^system dependencies@> 1303 1304@d res_char=='?' {character to be replaced by font resolution} 1305@d res_ASCII="?" {|xord[res_char]|} 1306@# 1307@d append_res_to_name(#)== 1308 begin c:=#; 1309 @!device if c=res_char then 1310 for ll:=n_res_digits downto 1 do append_to_name(res_digits[ll]) 1311 else ecived@;@/ 1312 append_to_name(c); 1313 end 1314@d make_font_res_end(#)== 1315 append_res_to_name(#[l]); make_name 1316@d make_font_res(#)== 1317 make_res; l_cur_name:=0; for l:=1 to # do make_font_res_end 1318 1319@ @<Glob...@>= 1320@!device 1321@!f_res:int_16u; {font resolution} 1322@!res_digits:array [1..5] of char; 1323@!n_res_digits:int_7; {number of significant characters in |res_digits|} 1324ecived 1325 1326@ The |make_res| procedure creates a sequence of characters representing 1327to the font resolution |f_res|. 1328 1329@p @!device procedure make_res; 1330var r:int_16u; 1331begin n_res_digits:=0; r:=f_res; 1332repeat incr(n_res_digits); 1333 res_digits[n_res_digits]:=xchr["0"+(r mod 10)]; r:=r div 10; 1334until r=0; 1335end; 1336ecived 1337 1338@ The |make_name| procedure used to build the external file name. The 1339global variable |l_cur_name| contains the length of a default area 1340which has been copied to |cur_name| before |make_name| is called. 1341@^system dependencies@> 1342 1343@p procedure make_name(@!e:pckt_pointer); 1344var b:eight_bits; {a byte extracted from |byte_mem|} 1345@!n:pckt_pointer; {file name packet} 1346@!cur_loc,@!cur_limit:byte_pointer; {indices into |byte_mem|} 1347@!device 1348@!ll:int_15; {loop index} 1349ecived@;@/ 1350@!c:char; {a character to be appended to |cur_name|} 1351begin n:=font_name(cur_fnt); 1352cur_loc:=pckt_start[n]; cur_limit:=pckt_start[n+1]; 1353pckt_extract(b); {length of area part} 1354if b>0 then l_cur_name:=0; 1355while cur_loc<cur_limit do 1356 begin pckt_extract(b); 1357 if (b>="a")and(b<="z") then Decr(b)(("a"-"A")); {convert to upper case} 1358 append_to_name(xchr[b]); 1359 end; 1360cur_loc:=pckt_start[e]; cur_limit:=pckt_start[e+1]; 1361while cur_loc<cur_limit do 1362 begin pckt_extract(b); append_res_to_name(xchr[b]); 1363 end; 1364while l_cur_name<name_length do 1365 begin incr(l_cur_name); cur_name[l_cur_name]:=' '; 1366 end; 1367end; 1368 1369@* Font data. 1370\.{DVI} file format does not include information about character widths, since 1371that would tend to make the files a lot longer. But a program that reads 1372a \.{DVI} file is supposed to know the widths of the characters that appear 1373in \\{set\_char} commands. Therefore \.{\title} looks at the font metric 1374(\.{TFM}) files for the fonts that are involved. 1375@.TFM {\rm files}@> 1376@.OFM {\rm files}@> 1377 1378The character-width data appears also in other files (e.g., in \.{VF} files 1379or in \.{GF} and \.{PK} files that specify bit patterns for digitized 1380characters); thus, it is usually possible for \.{DVI} reading programs 1381to get by with accessing only one file per font. For \.{VF} reading 1382programs there is, however, a problem: (1)~when reading the character 1383packets from a \.{VF} file the \.{TFM} width for its local fonts should 1384be known in order to analyze and optimize the packets (e.g., determine 1385if a packet must indeed be enclosed with |push| and |pop| as implied by 1386the \.{VF} format); and (2)~ in order to avoid infinite recursion such 1387programs must not try to read a \.{VF} file for a font before a 1388character from that font is actually used. Thus \.{\title} reads the 1389\.{TFM} file whenever a new font is encountered and delays the decision 1390whether this is a virtual font or not. 1391 1392@ First of all we need to know for each font~|f| such things as its 1393external name, design and scaled size, and the approximate size of 1394inter-word spaces. In addition we need to know the range |bc..ec| of 1395valid characters for this font, and for each character~|c| in~|f| we 1396need to know if this character exists and if so what is the width of~|c|. 1397Depending on the font type of~|f| we may want to know a few other things 1398about character~|c| in~|f| such as the character packet from a \.{VF} 1399file or the raster data from a \.{PK} file. 1400@^font types@> 1401 1402In \.{\title} we want to be able to handle the full range 1403|@t$-2^{31}$@><=c<@t$2^{31}$@>| of character codes; each character code 1404is decomposed into a character residue |0<=res<256| and character 1405extension |@t$-2^{23}$@><=ext<@t$2^{23}$@>| such that |c=256*ext+res|. 1406At present \.{VFtoVP}, \.{VPtoVF}, and the standard version of \TeX\ use 1407only characters in the range |0<=c<256| (i.e., |ext=0|), there are, 1408however, extensions of \TeX\ which use characters with |ext<>0|. 1409In any case characters with |ext<>0| will be used rather infrequently 1410and we want to handle this possibility without too much overhead. 1411 1412Some of the data for each character~|c| depend only on its residue: 1413first of all its width and escapement; others, such as \.{VF} packets or 1414raster data will also depend on its extension. The later will be stored 1415as packets in |byte_mem|, and the packets for characters with the same 1416residue but different extension will be chained. 1417 1418Thus we have to maintain several variables for each character 1419residue~|bc<=res<=ec| from each font~|f|; we store each type of variable 1420in a large array such that the array index |font_chars(f)+res| points to 1421the value for characters with residue |res| from font~|f|. 1422 1423Although \TeX\ was designed to be used with 256 characters, $\Omega$ 1424has no such restrictions. Therefore when \.{OVF} and \.{OFM} files 1425are being used, |ext| will remain 0 and |res| will vary over the full 1426range of values. 1427 1428@ Quite often a particular width value is shared by several characters in 1429a font or even by characters from different fonts; the later will 1430probably occur in particular for virtual fonts and the local fonts used 1431by them. Thus the array |widths| is used to store all different \.{TFM} 1432width values of all legal characters in all fonts; a variable of type 1433|width_pointer| is an index into |widths| or is zero if a characters does 1434not exist. 1435 1436In order to locate a given width value we use again a hash 1437table with simple chaining; this time the heads of the individual lists 1438appear in the |w_hash| array and the lists proceed through |w_link| 1439pointers. 1440 1441@<Types...@>= 1442@!width_pointer=0..max_widths; {an index into |widths|} 1443 1444@ @<Glob...@>= 1445@!widths:array[width_pointer] of int_32; {the different width values} 1446@!w_link:array[width_pointer] of width_pointer; {hash table} 1447@!w_hash:array[hash_code] of width_pointer; 1448@!n_widths:width_pointer; {first unoccupied position in |widths|} 1449 1450@ Initially the |widths| array and all the hash lists are empty, except 1451for one entry: the width value zero; in addition we set |widths[0]:=0|. 1452 1453@d invalid_width=0 {width pointer for invalid characters} 1454@d zero_width=1 {a width pointer to the value zero} 1455 1456@<Set init...@>= 1457w_hash[0]:=1; w_link[1]:=0; widths[0]:=0; widths[1]:=0; n_widths:=2; 1458for h:=1 to hash_size-1 do w_hash[h]:=0; 1459 1460@ The |make_width| function returns an index into |widths| and, if 1461necessary, adds a new width value; thus two characters will have the 1462same |width_pointer| if and only if their widths agree. 1463 1464@p function make_width(@!w:int_32):width_pointer; 1465label found; 1466var h:hash_code; {hash code} 1467@!p:width_pointer; {where the identifier is being sought} 1468@!x:int_16; {intermediate value} 1469begin widths[n_widths]:=w; 1470@<Compute the width hash code |h|@>; 1471@<Compute the width location |p|, |goto| found unless the value is new@>; 1472if n_widths=max_widths then overflow(str_widths,max_widths); 1473incr(n_widths); 1474found:make_width:=p; 1475end; 1476 1477@ A simple hash code is used: If the width value consists of the four 1478bytes $b_0b_1b_2b_3$, its hash value will be 1479$$(8*b_0+4*b_1+2*b_2+b_3)\,\bmod\,|hash_size|.$$ 1480 1481@<Compute the width hash...@>= 1482if w>=0 then x:=w div @"1000000 1483else begin w:=w+@"40000000; w:=w+@"40000000; x:=(w div @"1000000)+@"80; 1484 end; 1485w:=w mod @"1000000; x:=x+x+(w div @"10000); 1486w:=w mod @"10000; x:=x+x+(w div @"100); 1487h:=(x+x+(w mod @"100)) mod hash_size 1488 1489@ If the width is new, it has been placed into position |p=n_widths|, 1490otherwise |p| will point to its existing location. 1491 1492@<Compute the width location...@>= 1493p:=w_hash[h]; 1494while p<>0 do 1495 begin if widths[p]=widths[n_widths] then goto found; 1496 p:=w_link[p]; 1497 end; 1498p:=n_widths; {the current width is new} 1499w_link[p]:=w_hash[h]; w_hash[h]:=p {insert |p| at beginning of hash list} 1500 1501@ The |char_widths| array is used to store the |width_pointer|s for all 1502different characters among all fonts. The |char_packets| array is used 1503to store the |pckt_pointer|s for all different characters among all 1504fonts; they can point to character packets from \.{VF} files or, e.g., 1505raster packets from \.{PK} files. 1506 1507@<Types...@>= 1508@!char_offset=neg_max_chars..max_chars; {|char_pointer| offset for a font} 1509@!char_pointer=0..max_chars; {index into |char_widths| or similar arrays} 1510 1511@ @<Glob...@>= 1512@!char_widths:array[char_pointer] of width_pointer; {width pointers} 1513@!char_packets:array[char_pointer] of pckt_pointer; {packet pointers} 1514@!n_chars:char_pointer; {first unused position in |char_widths|} 1515 1516@ @<Set init...@>= 1517n_chars:=0; 1518 1519@ The current number of known fonts is |nf|; each known font has an 1520internal number |f|, where |0<=f<nf|. For the moment we need for each 1521known font: |font_check|, |font_scaled|, |font_design|, |font_name|, 1522|font_bc|, |font_ec|, |font_chars|, and |font_type|. Here |font_scaled| 1523and |font_design| are measured in \.{DVI} units and |font_chars| is of 1524type |char_offset|: the width pointer for character~|c| of the font is 1525stored in |char_widths[char_offset+c]| (for |font_bc<=c<=font_ec|). 1526Later on we will need additional information depending on the font type: 1527\.{VF} or real (\.{GF}, \.{PK}, or \.{PXL}). 1528 1529@<Types...@>= 1530@!f_type=defined_font..max_font_type; {type of a font} 1531@!font_number=0..max_fonts; 1532 1533@ @<Glob...@>= 1534@!nf:font_number; 1535 1536@ These data are stored in several arrays and we use \.{WEB} macros 1537to access the various fields. Thus it would be simple to store the 1538data in an array of record structures and adapt the \.{WEB} macros 1539accordingly. 1540 1541We will say, e.g., |font_name(f)| for the name field of font~|f|, and 1542|font_width(f)(c)| for the width pointer of character~|c| in font~|f| 1543and |font_packet(f)(c)| for its character packet (this character 1544exists provided |font_bc(f)<=c<=font_ec(f)| and 1545|font_width(f)(c)<>invalid_width|). The actual width of character~|c| in 1546font~|f| is stored in |widths[font_width(f)(c)]|. 1547 1548@d font_check(#)==fnt_check[#] {checksum} 1549@d font_scaled(#)==fnt_scaled[#] {scaled or `at' size} 1550@d font_design(#)==fnt_design[#] {design size} 1551@d font_name(#)==fnt_name[#] {area plus name packet} 1552@d font_bc(#)==fnt_bc[#] {first character} 1553@d font_ec(#)==fnt_ec[#] {last character} 1554@d font_chars(#)==fnt_chars[#] {character info offset} 1555@d font_type(#)==fnt_type[#] {type of this font} 1556@d font_font(#)==fnt_font[#] {use depends on |font_type|} 1557@# 1558@d font_width_end(#)==#] 1559@d font_width(#)==char_widths[font_chars(#)+font_width_end 1560@d font_packet(#)==char_packets[font_chars(#)+font_width_end 1561@d font_extend(#)==fnt_extended[#] 1562 1563@<Glob...@>= 1564@!fnt_check:array [font_number] of int_32; {checksum} 1565@!fnt_scaled:array [font_number] of int_31; {scaled size} 1566@!fnt_design:array [font_number] of int_31; {design size} 1567@!device @<Declare device dependent font data arrays@>@; @+ ecived @; @/ 1568@!fnt_name:array [font_number] of pckt_pointer; {pointer to area plus 1569 name packet} 1570@!fnt_bc:array [font_number] of int_31; {first character} 1571@!fnt_ec:array [font_number] of int_31; {last character} 1572@!fnt_chars:array [font_number] of char_offset; {character info offset} 1573@!fnt_type:array [font_number] of f_type; {type of font} 1574@!fnt_font:array [font_number] of font_number; {use depends on |font_type|} 1575@!fnt_extended:array [font_number] of boolean; {\.{TFM} or \.{OFM} file} 1576 1577@ @d invalid_font==max_fonts {used when there is no valid font} 1578 1579@<Set init...@>= 1580@!device @<Initialize device dependent font data@>@; @+ ecived @;@/ 1581nf:=0; 1582 1583@ A \.{VF}, or \.{GF}, or \.{PK} file may contain information for 1584several characters with the same residue but with different extension; 1585all except the first of the corresponding packets in |byte_mem| will 1586contain a pointer to the previous one and |font_packet(f)(res)| 1587identifies the last such packet. 1588 1589A character packet in |byte_mem| starts with a flag byte 1590$$\hbox{|flag=@"40*ext_flag+@"20*chain_flag+type_flag|}$$ 1591with |0<=ext_flag<=3|, |0<=chain_flag<=1|, |0<=type_flag<=@"1F|, 1592followed by |ext_flag| bytes with the character extension for this 1593packet and, if |chain_flag=1|, by a two byte packet pointer to the 1594previous packet for the same font and character residue. The actual 1595character packet follows after these header bytes and the 1596interpretation of the |type_flag| depends on whether this is a \.{VF} 1597packet or a packet for raster data. 1598 1599The empty packet is interpreted as a special case of a packet with 1600|flag=0|. 1601 1602@d ext_flag=@"40 1603@d chain_flag=@"20 1604 1605@<Types...@>= 1606@!type_flag=0..chain_flag-1; {the range of values for the |type_flag|} 1607 1608@ The global variable |cur_fnt| is the internal font number of the 1609currently selected font, or equals |invalid_font| if no font has 1610been selected; |cur_res| and |cur_ext| are the residue and extension 1611part of the current character code. The type of a character packet 1612located by the |find_packet| function defined below is |cur_type|. 1613While building a character packet for a character, |pckt_ext| and 1614|pckt_res| are the extension and residue of this character; |pckt_dup| 1615indicates whether a packet for this extension exists already. 1616 1617@<Glob...@>= 1618@!cur_fnt:font_number; {the currently selected font} 1619@!cur_ext:int_24; {the current character extension} 1620@!cur_res:int_32; {the current character residue} 1621@!cur_type:type_flag; {type of the current character packet} 1622@!pckt_ext:int_24; {character extension for the current character packet} 1623@!pckt_res:int_32; {character residue for the current character packet} 1624@!pckt_dup:boolean; {is there a previous packet for the same extension?} 1625@!pckt_prev:pckt_pointer; {a previous packet for the same extension} 1626@!pckt_m_msg,@!pckt_s_msg,@!pckt_d_msg:int_7; {counts for various character 1627 packet error messages} 1628 1629@ @<Set init...@>= 1630cur_fnt:=invalid_font; pckt_m_msg:=0; pckt_s_msg:=0; pckt_d_msg:=0; 1631 1632@ The |find_packet| functions is used to locate the character packet for 1633the character with residue~|cur_res| and extension~|cur_ext| from 1634font~|cur_fnt| and returns |false| if no packet exists for any extension; 1635otherwise the result is |true| and the global variables |cur_packet|, 1636|cur_type|, |cur_loc|, and |cur_limit| are initialized. In case none of 1637the character packets has the correct extension, the last one in the 1638chain (the one defined first) is used instead and |cur_ext| is changed 1639accordingly. 1640 1641@p function find_packet:boolean; 1642label found,exit; 1643var p,@!q:pckt_pointer; {current and next packet} 1644@!f:eight_bits; {a flag byte} 1645@!e:int_24; {extension for a packet} 1646begin q:=font_packet(cur_fnt)(cur_res); 1647if q=invalid_packet then 1648 begin if pckt_m_msg<10 then {stop telling after first 10 times} 1649 begin print_ln('---missing character packet for character ',cur_res:1, 1650@.missing character packet...@> 1651 ' font ',cur_fnt:1); 1652 incr(pckt_m_msg); mark_error; 1653 if pckt_m_msg=10 then print_ln('---further messages suppressed.'); 1654 end; 1655 find_packet:=false; return; 1656 end; 1657@<Locate a character packet and |goto found| if found@>; 1658if pckt_s_msg<10 then {stop telling after first 10 times} 1659 begin print_ln('---substituted character packet with extension ', 1660@.substituted character packet...@> 1661 e:1,' instead of ',cur_ext:1,' for character ',cur_res:1, 1662 ' font ',cur_fnt:1); 1663 incr(pckt_s_msg); mark_error; 1664 if pckt_s_msg=10 then print_ln('---further messages suppressed.'); 1665 end; 1666cur_ext:=e; 1667found: cur_pckt:=p; cur_type:=f; find_packet:=true; 1668exit: end; 1669 1670@ @<Locate a character packet and |goto found| if found@>= 1671repeat p:=q; q:=invalid_packet; 1672 cur_loc:=pckt_start[p]; cur_limit:=pckt_start[p+1]; 1673 if p=empty_packet then 1674 begin e:=0; f:=0; 1675 end 1676 else begin pckt_extract(f); 1677 case (f div ext_flag) of 1678 0: e:=0; 1679 1: e:=pckt_ubyte; 1680 2: e:=pckt_upair; 1681 othercases e:=pckt_strio; {|f div ext_flag = 3|} 1682 endcases; 1683 if (f mod ext_flag)>=chain_flag then q:=pckt_upair; 1684 f:=f mod chain_flag; 1685 end; 1686 if e=cur_ext then goto found; 1687until q=invalid_packet 1688 1689@ The |start_packet| procedure is used to create the header bytes of a 1690character packet for the character with residue~|cur_res| and 1691extension~|cur_ext| from font~|cur_fnt|; if a previous such packet 1692exists, we try to build an exact duplicate, i.e., use the chain field of 1693that previous packet. 1694 1695@p procedure start_packet(@!t:type_flag); 1696label found,not_found; 1697var p,@!q:pckt_pointer; {current and next packet} 1698@!f:int_8u; {a flag byte} 1699@!e:int_32; {extension for a packet} 1700@!cur_loc: byte_pointer; {current location in a packet} 1701@!cur_limit: byte_pointer; {start of next packet} 1702begin q:=font_packet(cur_fnt)(cur_res); 1703if q<>invalid_packet then @<Locate a character packet...@>; 1704q:=font_packet(cur_fnt)(cur_res); pckt_dup:=false; goto not_found; 1705found: pckt_dup:=true; pckt_prev:=p; 1706not_found: pckt_ext:=cur_ext; pckt_res:=cur_res; pckt_room(6); 1707@!debug if byte_ptr<>pckt_start[pckt_ptr] then confusion(str_packets); 1708gubed @;@/ 1709if q=invalid_packet then f:=t @+ else f:=t+chain_flag; 1710e:=cur_ext; 1711if e<0 then Incr(e)(@"1000000); 1712if e=0 then append_byte(f) @+ else @; 1713 begin if e<@"100 then append_byte(f+ext_flag) @+ else @; 1714 begin if e<@"10000 then append_byte(f+ext_flag+ext_flag) @+ else @; 1715 begin append_byte(f+ext_flag+ext_flag+ext_flag); 1716 append_byte(e div @"10000); e:=e mod @"10000; 1717 end; 1718 append_byte(e div @"100); e:=e mod @"100; 1719 end; 1720 append_byte(e); 1721 end; 1722if q<>invalid_packet then 1723 begin append_byte(q div @"100); append_byte(q mod @"100); 1724 end; 1725end; 1726 1727@ The |build_packet| procedure is used to finish a character packet. 1728If a previous packet for the same character extension exists, the new 1729one is discarded; if the two packets are identical, as it occasionally 1730occurs for raster files, this is done without an error message. 1731 1732@p procedure build_packet; 1733var k,@!l:byte_pointer; {indices into |byte_mem|} 1734begin if pckt_dup then 1735 begin k:=pckt_start[pckt_prev+1]; l:=pckt_start[pckt_ptr]; 1736 if (byte_ptr-l)<>(k-pckt_start[pckt_prev]) then pckt_dup:=false; 1737 while pckt_dup and(byte_ptr>l) do 1738 begin flush_byte; decr(k); 1739 if byte_mem[byte_ptr]<>byte_mem[k] then pckt_dup:=false; 1740 end; 1741 if (not pckt_dup)and(pckt_d_msg<10) then {stop telling after first 10 times} 1742 begin print('---duplicate packet for character ',pckt_res:1); 1743@.duplicate packet for character...@> 1744 if pckt_ext<>0 then print('.',pckt_ext:1); 1745 print_ln(' font ',cur_fnt:1); 1746 incr(pckt_d_msg); mark_error; 1747 if pckt_d_msg=10 then print_ln('---further messages suppressed.'); 1748 end; 1749 byte_ptr:=l; 1750 end 1751else font_packet(cur_fnt)(pckt_res):=make_packet; 1752end; 1753 1754@* Defining fonts. 1755A detailed description of the \.{TFM} file format can be found in the 1756documentation of \TeX, \MF, or \.{TFtoPL}. In order to read \.{TFM} 1757files the program uses the binary file variable |tfm_file|. 1758 1759@<Glob...@>= 1760@!tfm_file:byte_file; {a \.{TFM} file} 1761@!tfm_ext:pckt_pointer; {extension for \.{TFM} files} 1762@!ofm_ext:pckt_pointer; {extension for \.{OFM} files} 1763 1764@ @<Initialize predefined strings@>= 1765id4(".")("T")("F")("M")(tfm_ext); {file name extension for \.{TFM} files} 1766id4(".")("O")("F")("M")(ofm_ext); {file name extension for \.{OFM} files} 1767 1768@ If no font directory has been specified, \.{\title} is supposed to use 1769the default \.{TFM} directory, which is a system-dependent place where 1770the \.{TFM} files for standard fonts are kept. 1771The string variable |TFM_default_area| contains the name of this area. 1772@^system dependencies@> 1773 1774@d TFM_default_area_name=='TeXfonts:' {change this to the correct name} 1775@d OFM_default_area_name=='TeXfonts:' {change this to the correct name} 1776@d TFM_default_area_name_length=9 {change this to the correct length} 1777@d OFM_default_area_name_length=9 {change this to the correct length} 1778 1779@<Glob...@>= 1780@!TFM_default_area:packed array[1..TFM_default_area_name_length] of char; 1781@!OFM_default_area:packed array[1..OFM_default_area_name_length] of char; 1782 1783@ @<Set init...@>= 1784TFM_default_area:=TFM_default_area_name; 1785OFM_default_area:=OFM_default_area_name; 1786 1787@ If a \.{TFM} file is badly malformed, we say |bad_font|; for a \.{TFM} 1788file the |bad_tfm| procedure is used to give an error message which 1789refers the user to \.{TFtoPL} and \.{PLtoTF}, and terminates \.{\title}. 1790 1791@<Error handling...@>= 1792procedure bad_tfm; 1793begin print('Bad TFM or OFM file'); print_font(cur_fnt); print_ln('!'); 1794@.Bad TFM or OFM file@> 1795abort('Use OFM2OPL/OPL2OFM/TFtoPL/PLtoTF to diagnose and correct the problem'); 1796@.Use OFM2OPL/OPL2OFM/TFtoPL/PLtoTF@> 1797end; 1798@# 1799procedure bad_font; 1800begin new_line; 1801case font_type(cur_fnt) of 1802 defined_font: confusion(str_fonts); 1803 loaded_font: bad_tfm; 1804 @<Cases for |bad_font|@>@;@/ 1805 othercases abort('internal error'); 1806 endcases; 1807end; 1808 1809@ To prepare |tfm_file| for input we |reset| it. 1810 1811@<TFM: Open |tfm_file|@>= 1812make_font_name(TFM_default_area_name_length)(TFM_default_area)(tfm_ext); 1813reset(tfm_file,cur_name); 1814if eof(tfm_file) then begin 1815 make_font_name(OFM_default_area_name_length)(OFM_default_area)(ofm_ext); 1816 reset(tfm_file,cur_name); 1817 if eof(tfm_file) then 1818@^system dependencies@> 1819 abort('---not loaded, TFM or OFM file can''t be opened!') 1820@.TFM or OFM file can\'t be opened@> 1821 end 1822 1823@ It turns out to be convenient to read four bytes at a time, when we 1824are inputting from \.{TFM} files. The input goes into global variables 1825|tfm_b0|, |tfm_b1|, |tfm_b2|, and |tfm_b3|, with |tfm_b0| getting the 1826first byte and |tfm_b3| the fourth. 1827 1828@<Glob...@>= 1829@!tfm_b0,@!tfm_b1,@!tfm_b2,@!tfm_b3: eight_bits; {four bytes input at once} 1830 1831@ Reading a \.{TFM} file should be done as efficient as possible for a 1832particular system; on many systems this means that a large number of 1833bytes from |tfm_file| is read into a buffer and will then be extracted 1834from that buffer. In order to simplify such system dependent changes 1835we use the \.{WEB} macro |tfm_byte| to extract the next \.{TFM} or \.{OFM} byte; 1836this macro and |eof(tfm_file)| are used only in the |read_tfm_word| 1837procedure which sets |tfm_b0| through |tfm_b3| to the next four bytes 1838in the current \.{TFM} file. Here we give simple minded definitions in 1839terms of standard \PASCAL. 1840@^system dependencies@> 1841@^optimization@> 1842 1843@d tfm_byte(#)==read(tfm_file,#) {read next \.{TFM} byte} 1844 1845@p procedure read_tfm_word; 1846begin tfm_byte(tfm_b0); tfm_byte(tfm_b1); 1847tfm_byte(tfm_b2); tfm_byte(tfm_b3); 1848if eof(tfm_file) then bad_font; 1849end; 1850 1851@ Here are three procedures used to check the consistency of font files: 1852First, the |check_check_sum| procedure compares two check sum values: a 1853warning is given if they differ and are both non-zero; if the second 1854value is not zero it may replace the first one. 1855Next, the |check_design_size| procedure compares two design size 1856values: a warning is given if they differ by more than a small amount. 1857Finally, the |check_width| function compares the character width value 1858for character |cur_res| read from a \.{VF} or raster file for font 1859|cur_fnt| with the value previously read from the \.{TFM} file and 1860returns the width pointer for that value; a warning is given if the two 1861values differ. 1862 1863@p procedure check_check_sum(@!c:int_32;@!u:boolean); 1864 {compare |font_check(cur_fnt)| with |c|} 1865begin if (c<>font_check(cur_fnt))and(c<>0) then 1866 begin 1867 if font_check(cur_fnt)<>0 then 1868 begin new_line; print_ln('---beware: check sums do not agree! (', 1869@.beware: check sums do not agree@> 1870@.check sums do not agree@> 1871 c:1,' vs. ',font_check(cur_fnt):1,')'); 1872 mark_harmless; 1873 end; 1874 if u then font_check(cur_fnt):=c; 1875 end; 1876end; 1877@# 1878procedure check_design_size(@!d:int_32); 1879 {compare |font_design(cur_fnt)| with |d|} 1880begin if abs(d-font_design(cur_fnt))>2 then 1881 begin new_line; print_ln('---beware: design sizes do not agree! (', 1882@.beware: design sizes do not agree@> 1883@.design sizes do not agree@> 1884 d:1,' vs. ',font_design(cur_fnt):1,')'); 1885 mark_error; 1886 end; 1887end; 1888@# 1889procedure print_hex(@!num:int_31); 1890var c:int_31; 1891begin print('"'); 1892c:=num div @"10000000; 1893if (c<10) then print(xchr[c+'0']) else print(xchr[c-10+'a']); 1894num:=num mod @"10000000; 1895c:=num div @"1000000; 1896if (c<10) then print(xchr[c+'0']) else print(xchr[c-10+'a']); 1897num:=num mod @"1000000; 1898c:=num div @"100000; 1899if (c<10) then print(xchr[c+'0']) else print(xchr[c-10+'a']); 1900num:=num mod @"100000; 1901c:=num div @"10000; 1902if (c<10) then print(xchr[c+'0']) else print(xchr[c-10+'a']); 1903num:=num mod @"10000; 1904c:=num div @"1000; 1905if (c<10) then print(xchr[c+'0']) else print(xchr[c-10+'a']); 1906num:=num mod @"1000; 1907c:=num div @"100; 1908if (c<10) then print(xchr[c+'0']) else print(xchr[c-10+'a']); 1909num:=num mod @"100; 1910c:=num div @"10; 1911if (c<10) then print(xchr[c+'0']) else print(xchr[c-10+'a']); 1912num:=num mod @"10; 1913c:=num; 1914if (c<10) then print(xchr[c+'0']) else print(xchr[c-10+'a']); 1915end; 1916@# 1917function check_width(w:int_32):width_pointer; 1918 {compare |widths[font_width(cur_fnt)(cur_res)]| with |w|} 1919var wp:width_pointer; {pointer to \.{TFM} width value} 1920begin if (cur_res>=font_bc(cur_fnt))and(cur_res<=font_ec(cur_fnt)) then 1921 wp:=font_width(cur_fnt)(cur_res) 1922else wp:=invalid_width; 1923if wp=invalid_width then 1924 begin print_nl('Bad char ',cur_res:1); 1925@.Bad char c@> 1926 if cur_ext<>0 then print('.',cur_ext:1); 1927 print(' font ',cur_fnt:1); print_font(cur_fnt); 1928 abort(' (compare TFM or OFM file)'); 1929 end; 1930if w<>widths[wp] then 1931 begin 1932 print_hex(cur_ext); 1933 print(' '); 1934 print_hex(cur_res); 1935 print(': char widths do not agree! ('); 1936@.beware: char widths do not agree@> 1937@.char widths do not agree@> 1938 print_hex(w); 1939 print(' vs. '); 1940 print_hex(widths[wp]); 1941 print_ln(')'); 1942 mark_error; 1943 end; 1944check_width:=wp; 1945end; 1946 1947@ The |load_font| procedure reads the \.{TFM} file for a font and puts 1948the data extracted into position |cur_fnt| of the font data arrays. 1949 1950@p procedure load_font; {reads a \.{TFM} file} 1951var l,j,lprime:int_32; {loop index} 1952@!p:char_pointer; {index into |char_widths|} 1953@!q:width_pointer; {index into |widths|} 1954@!bc,@!ec:int_31; {first and last character in this font} 1955@!lf:int_31; {length of file in four byte words} 1956@!lh:int_31; {length of header in four byte words} 1957@!nw:int_31; {number of words in width table} 1958@!w:int_32; {a four byte integer} 1959@!first_two:int_31; 1960@!ofm_level:int_32; 1961@!nco,@!extra_words:int_31; 1962@!tfm_width:int_31; 1963@<Variables for scaling computation@>@; 1964begin print('TFM: font ',cur_fnt:1); print_font(cur_fnt); 1965font_type(cur_fnt):=loaded_font; 1966@<TFM: Open |tfm_file|@>; 1967@<TFM: Read past the header data@>; 1968@<TFM: Store character-width indices@>; 1969@<TFM: Read and convert the width values@>; 1970@<TFM: Convert character-width indices to character-width pointers@>; 1971close_in(tfm_file); 1972@!device @<Initialize device dependent data for a font@>@; @+ ecived @; @/ 1973d_print(' loaded at ',font_scaled(cur_fnt):1,' DVI units'); 1974print_ln('.'); 1975end; 1976 1977@ @<Glob...@>= 1978@!tfm_conv:real; {\.{DVI} units per absolute \.{TFM} unit} 1979 1980@ We will use the following \.{WEB} macros to construct integers from 1981two or four of the four bytes read by |read_tfm_word|. 1982@^system dependencies@> 1983 1984@d tfm_b03(#)== {|tfm_b0..tfm_b3| as non-negative integer} 1985if tfm_b0>127 then bad_font 1986else #:=tfm_b0*@"1000000+tfm_b1*@"10000+tfm_b2*@"100+tfm_b3 1987 1988@d tfm_b01(#)== {|tfm_b0..tfm_b1| as non-negative integer} 1989if tfm_b0>127 then bad_font 1990else #:=tfm_b0*256+tfm_b1 1991@d tfm_b23(#)== {|tfm_b2..tfm_b3| as non-negative integer} 1992if tfm_b2>127 then bad_font 1993else #:=tfm_b2*256+tfm_b3 1994@d tfm_squad(#)== {|tfm_b0..tfm_b3| as signed integer} 1995if tfm_b0<128 then #:=((tfm_b0*256+tfm_b1)*256+tfm_b2)*256+tfm_b3 1996else #:=(((tfm_b0-256)*256+tfm_b1)*256+tfm_b2)*256+tfm_b3 1997@d tfm_uquad== {|tfm_b0..tfm_b3| as unsigned integer} 1998(((tfm_b0*256+tfm_b1)*256+tfm_b2)*256+tfm_b3) 1999 2000@d read_tfm_width(#)==begin 2001read_tfm_word; 2002if first_two<>0 then tfm_width:=tfm_b0 2003else begin 2004 if # then read_tfm_word; 2005 tfm_width:=tfm_b0*256+tfm_b1; 2006 end 2007end 2008 2009@<TFM: Read past the header data@>= 2010read_tfm_word; tfm_b01(first_two); 2011if (first_two<>0) then begin 2012 font_extend(cur_fnt):=false; 2013 ofm_level:=-1; 2014 tfm_b23(lh); 2015 read_tfm_word; tfm_b01(bc); tfm_b23(ec); 2016 if ec<bc then 2017 begin bc:=1; ec:=0; 2018 end 2019 else if ec>255 then bad_font; 2020 read_tfm_word; tfm_b01(nw); 2021 if (nw=0)or(nw>256) then bad_font; 2022 for l:=-2 to lh do 2023 begin read_tfm_word; 2024 if l=1 then 2025 begin tfm_squad(w); check_check_sum(w,true); 2026 end 2027 else if l=2 then 2028 begin if tfm_b0>127 then bad_font; 2029 check_design_size(round(tfm_conv*tfm_uquad)); 2030 end 2031 end 2032 end 2033else begin 2034 font_extend(cur_fnt):=true; 2035 tfm_b23(ofm_level); 2036 read_tfm_word; tfm_b03(lf); 2037 read_tfm_word; tfm_b03(lh); 2038 read_tfm_word; tfm_b03(bc); 2039 read_tfm_word; tfm_b03(ec); 2040 if ec<bc then begin 2041 bc:=1; ec:=0; 2042 end 2043 else if ec>65535 then bad_font; 2044 read_tfm_word; tfm_b03(nw); 2045 if (nw=0)or(nw>65536) then bad_font; 2046 for l:=1 to 8 do 2047 begin if eof(tfm_file) then bad_font; 2048 read_tfm_word; 2049 end; 2050 if ofm_level=1 then begin 2051 read_tfm_word; 2052 nco:=((tfm_b0*256+tfm_b1)*256+tfm_b2)*256+tfm_b3; 2053 read_tfm_word; read_tfm_word; 2054 extra_words:=(((tfm_b0*256+tfm_b1)*256+tfm_b2)*256+tfm_b3) div 2; 2055 for l:=1 to 12 do 2056 begin if eof(tfm_file) then bad_font; 2057 read_tfm_word; 2058 end; 2059 end; 2060 for l:=1 to lh do begin 2061 read_tfm_word; 2062 if l=1 then begin 2063 tfm_squad(w); check_check_sum(w,true); 2064 end 2065 else if l=2 then begin 2066 if tfm_b0>127 then bad_font; 2067 check_design_size(round(tfm_conv*tfm_uquad)); 2068 end 2069 end; 2070 if ofm_level>0 then 2071 for l:=1 to (nco-29-lh) do 2072 read_tfm_word; 2073 end 2074 2075@ The width indices for the characters are stored in positions |n_chars| 2076through |n_chars-bc+ec| of the |char_widths| array; if characters on 2077either end of the range |bc..ec| do not exist, they are ignored and the 2078range is adjusted accordingly. 2079 2080@<TFM: Store character-width indices@>= 2081if ofm_level<=0 then begin 2082 read_tfm_width(false); 2083 while (tfm_width=0)and(bc<=ec) do 2084 begin incr(bc); read_tfm_width(true); 2085 end; 2086 font_bc(cur_fnt):=bc; font_chars(cur_fnt):=n_chars-bc; 2087 if ec>=max_chars-font_chars(cur_fnt) then overflow(str_chars,max_chars); 2088 for l:=bc to ec do 2089 begin char_widths[n_chars]:=tfm_width; incr(n_chars); read_tfm_width(true); 2090 end; 2091 while (char_widths[n_chars-1]=0)and(ec>=bc) do 2092 begin decr(n_chars); decr(ec); 2093 end; 2094 font_ec(cur_fnt):=ec 2095 end 2096else begin 2097 font_bc(cur_fnt):=bc; font_chars(cur_fnt):=n_chars-bc; 2098 if ec>=max_chars-font_chars(cur_fnt) then overflow(str_chars,max_chars); 2099 font_ec(cur_fnt):=ec; 2100 l:=bc; 2101 while l<=ec do begin 2102 read_tfm_word; 2103 tfm_width:=tfm_b0*256+tfm_b1; 2104 char_widths[n_chars]:=tfm_width; incr(n_chars); 2105 read_tfm_word; read_tfm_word; 2106 lprime:=l+(tfm_b0*256+tfm_b1); 2107 for j:=l+1 to lprime do begin 2108 char_widths[n_chars]:=tfm_width; incr(n_chars); 2109 end; 2110 l:=lprime+1; 2111 for j:=1 to extra_words do 2112 read_tfm_word; 2113 end; 2114 read_tfm_word; 2115 end 2116 2117@ The most important part of |load_font| is the width computation, which 2118involves multiplying the relative widths in the \.{TFM} file by the 2119scaling factor in the \.{DVI} file. A similar computation is used for 2120dimensions read from \.{VF} files. This fixed-point multiplication must 2121be done with precisely the same accuracy by all \.{DVI}-reading programs, 2122in order to validate the assumptions made by \.{DVI}-writing programs 2123like \TeX82. 2124 2125Let us therefore summarize what needs to be done. Each width in a \.{TFM} 2126file appears as a four-byte quantity called a |fix_word|. A |fix_word| 2127whose respective bytes are $(a,b,c,d)$ represents the number 2128$$x=\left\{\vcenter{\halign{$#$,\hfil\qquad&if $#$\hfil\cr 2129b\cdot2^{-4}+c\cdot2^{-12}+d\cdot2^{-20}&a=0;\cr 2130-16+b\cdot2^{-4}+c\cdot2^{-12}+d\cdot2^{-20}&a=255.\cr}}\right.$$ 2131(No other choices of $a$ are allowed, since the magnitude of a \.{TFM} 2132dimension must be less than 16.) We want to multiply this quantity by the 2133integer~|z|, which is known to be less than $2^{27}$. 2134If $|z|<2^{23}$, the individual multiplications $b\cdot z$, $c\cdot z$, 2135$d\cdot z$ cannot overflow; otherwise we will divide |z| by 2, 4, 8, or 213616, to obtain a multiplier less than $2^{23}$, and we can compensate for 2137this later. If |z| has thereby been replaced by $|z|^\prime=|z|/2^e$, let 2138$\beta=2^{4-e}$; we shall compute 2139$$\lfloor(b+c\cdot2^{-8}+d\cdot2^{-16})\,z^\prime/\beta\rfloor$$ if $a=0$, 2140or the same quantity minus $\alpha=2^{4+e}z^\prime$ if $a=255$. 2141This calculation must be done exactly, for the reasons stated above; the 2142following program does the job in a system-independent way, assuming 2143that arithmetic is exact on numbers less than $2^{31}$ in magnitude. We 2144use \.{WEB} macros for various versions of this computation. 2145@^system dependencies@> 2146@^optimization@> 2147 2148@d tfm_fix3u== {convert |tfm_b1..tfm_b3| to an unsigned scaled dimension} 2149(((((tfm_b3*z)div@'400)+(tfm_b2*z))div@'400)+(tfm_b1*z))div beta 2150@# 2151@d tfm_fix4(#)== {convert |tfm_b0..tfm_b3| to a scaled dimension} 2152 #:=tfm_fix3u; 2153 if tfm_b0>0 then if tfm_b0=255 then Decr(#)(alpha) else bad_font 2154@d tfm_fix3(#)== {convert |tfm_b1..tfm_b3| to a scaled dimension} 2155 #:=tfm_fix3u; @+ if tfm_b1>127 then Decr(#)(alpha) 2156@d tfm_fix2== {convert |tfm_b2..tfm_b3| to a scaled dimension} 2157 if tfm_b2>127 then tfm_b1:=255 else tfm_b1:=0; 2158 tfm_fix3 2159@d tfm_fix1== {convert |tfm_b3| to a scaled dimension} 2160 if tfm_b3>127 then tfm_b1:=255 else tfm_b1:=0; 2161 tfm_b2:=tfm_b1; tfm_fix3 2162 2163@<Variables for scaling computation@>= 2164@!z:int_32; {multiplier} 2165@!alpha:int_32; {correction for negative values} 2166@!beta:int_15; {divisor} 2167 2168@ @<Replace |z| by $|z|^\prime$ and compute $\alpha,\beta$@>= 2169alpha:=16; 2170while z>=@'40000000 do 2171 begin z:=z div 2; alpha:=alpha+alpha; 2172 end; 2173beta:=256 div alpha; alpha:=alpha*z 2174 2175@ The first width value, which indicates that a character does not exist 2176and which must vanish, is converted to |invalid_width|; the other width 2177values are scaled by |font_scaled(cur_fnt)| and converted to width 2178pointers by |make_width|. The resulting width pointers are stored 2179temporarily in the |char_widths| array, following the with indices. 2180 2181@<TFM: Read and convert the width values@>= 2182if nw-1>max_chars-n_chars then overflow(str_chars,max_chars); 2183if (tfm_b0<>0)or(tfm_b1<>0)or(tfm_b2<>0)or(tfm_b3<>0) then bad_font 2184 else char_widths[n_chars]:=invalid_width; 2185z:=font_scaled(cur_fnt); 2186@<Replace |z|...@>; 2187for p:=n_chars+1 to n_chars+nw-1 do 2188 begin read_tfm_word; tfm_fix4(w); 2189 char_widths[p]:=make_width(w); 2190 end 2191 2192@ We simply translate the width indices into width pointers. In addition 2193we initialize the character packets with the invalid packet. 2194 2195@<TFM: Convert character-width indices to character-width pointers@>= 2196for p:=font_chars(cur_fnt)+bc to n_chars-1 do 2197 begin q:=char_widths[n_chars+char_widths[p]]; char_widths[p]:=q; 2198 char_packets[p]:=invalid_packet; 2199 end 2200 2201@ When processing a font definition we put the data extracted from the 2202\.{DVI} or \.{VF} file into position |nf| of the font data arrays and 2203call |define_font| to obtain the internal font number for this font. 2204The parameter |load| is true if the \.{TFM} file should be loaded. 2205 2206@p function define_font(@!load:boolean):font_number; 2207var save_fnt:font_number; {used to save |cur_fnt|} 2208begin save_fnt:=cur_fnt; {save} 2209cur_fnt:=0; 2210while (font_name(cur_fnt)<>font_name(nf))or@| 2211 (font_scaled(cur_fnt)<>font_scaled(nf)) do incr(cur_fnt); 2212d_print(' => ',cur_fnt:1); print_font(cur_fnt); 2213if cur_fnt<nf then 2214 begin check_check_sum(font_check(nf),true); 2215 check_design_size(font_design(nf)); 2216 @!debug if font_type(cur_fnt)=defined_font then print(' defined') 2217 else print(' loaded'); 2218 print(' previously'); 2219 gubed@; 2220 end 2221else begin if nf=max_fonts then overflow(str_fonts,max_fonts); 2222 incr(nf); font_font(cur_fnt):=invalid_font; 2223 font_type(cur_fnt):=defined_font; 2224 d_print(' defined'); 2225 end; 2226print_ln('.'); 2227if load and(font_type(cur_fnt)=defined_font) then load_font; 2228define_font:=cur_fnt; 2229cur_fnt:=save_fnt; {restore} 2230end; 2231 2232@* Low-level DVI input routines. 2233The program uses the binary file variable |dvi_file| for its main input 2234file; |dvi_loc| is the number of the byte about to be read next from 2235|dvi_file|. 2236 2237@<Glob...@>= 2238@!dvi_file:byte_file; {the stuff we are \.{\title}ing} 2239@!dvi_loc:int_32; {where we are about to look, in |dvi_file|} 2240 2241@ If the \.{DVI} file is badly malformed, we say |bad_dvi|; this 2242procedure gives an error message which refers the user to \.{DVItype}, 2243and terminates \.{\title}. 2244 2245@<Error handling...@>= 2246procedure bad_dvi; 2247begin new_line; print_ln('Bad DVI file: loc=',dvi_loc:1,'!'); 2248@.Bad DVI file@> 2249print(' Use DVItype with output level'); 2250@.Use DVItype@> 2251if random_reading then print('=4') @+ else print('<4'); 2252abort('to diagnose the problem'); 2253end; 2254 2255@ To prepare |dvi_file| for input, we |reset| it. 2256 2257@<Open input file(s)@>= 2258reset(dvi_file); {prepares to read packed bytes from |dvi_file|} 2259dvi_loc:=0; 2260 2261@ Reading the \.{DVI} file should be done as efficient as possible for a 2262particular system; on many systems this means that a large number of 2263bytes from |dvi_file| is read into a buffer and will then be extracted 2264from that buffer. In order to simplify such system dependent changes 2265we use a pair of \.{WEB} macros: |dvi_byte| extracts the next \.{DVI} 2266byte and |dvi_eof| is |true| if we have reached the end of the \.{DVI} 2267file. Here we give simple minded definitions for these macros in terms 2268of standard \PASCAL. 2269@^system dependencies@> 2270@^optimization@> 2271 2272@d dvi_eof == eof(dvi_file) {has the \.{DVI} file been exhausted?} 2273@d dvi_byte(#) == 2274 if dvi_eof then bad_dvi 2275 else read(dvi_file,#) {obtain next \.{DVI} byte} 2276 2277@ Next we come to the routines that are used only if |random_reading| is 2278|true|. The driver program below needs two such routines: |dvi_length| should 2279compute the total number of bytes in |dvi_file|, possibly also 2280causing |eof(dvi_file)| to be true; and |dvi_move(n)| should position 2281|dvi_file| so that the next |dvi_byte| will read byte |n|, starting with 2282|n=0| for the first byte in the file. 2283@^system dependencies@> 2284 2285Such routines are, of course, highly system dependent. They are implemented 2286here in terms of two assumed system routines called |set_pos| and |cur_pos|. 2287The call |set_pos(f,n)| moves to item |n| in file |f|, unless |n| is 2288negative or larger than the total number of items in |f|; in the latter 2289case, |set_pos(f,n)| moves to the end of file |f|. 2290The call |cur_pos(f)| gives the total number of items in |f|, if 2291|eof(f)| is true; we use |cur_pos| only in such a situation. 2292 2293@p function dvi_length:int_32; 2294begin set_pos(dvi_file,-1); dvi_length:=cur_pos(dvi_file); 2295end; 2296@# 2297procedure dvi_move(@!n:int_32); 2298begin set_pos(dvi_file,n); dvi_loc:=n; 2299end; 2300 2301@ We need seven simple functions to read the next byte or bytes 2302from |dvi_file|. 2303 2304@p function dvi_sbyte:int_8; {returns the next byte, signed} 2305@!begin_byte(dvi_byte); incr(dvi_loc); comp_sbyte(dvi_sbyte); 2306end; 2307@# 2308function dvi_ubyte:int_8u; {returns the next byte, unsigned} 2309@!begin_byte(dvi_byte); incr(dvi_loc); comp_ubyte(dvi_ubyte); 2310end; 2311@# 2312function dvi_spair:int_16; {returns the next two bytes, signed} 2313@!begin_pair(dvi_byte); Incr(dvi_loc)(2); comp_spair(dvi_spair); 2314end; 2315@# 2316function dvi_upair:int_16u; {returns the next two bytes, unsigned} 2317@!begin_pair(dvi_byte); Incr(dvi_loc)(2); comp_upair(dvi_upair); 2318end; 2319@# 2320function dvi_strio:int_24; {returns the next three bytes, signed} 2321@!begin_trio(dvi_byte); Incr(dvi_loc)(3); comp_strio(dvi_strio); 2322end; 2323@# 2324function dvi_utrio:int_24u; {returns the next three bytes, unsigned} 2325@!begin_trio(dvi_byte); Incr(dvi_loc)(3); comp_utrio(dvi_utrio); 2326end; 2327@# 2328function dvi_squad:int_32; {returns the next four bytes, signed} 2329@!begin_quad(dvi_byte); Incr(dvi_loc)(4); comp_squad(dvi_squad); 2330end; 2331 2332@ Three other functions are used in cases where a four byte integer 2333(which is always signed) must have a non-negative value, a positive 2334value, or is a pointer which must be either positive or |=-1|. 2335 2336@p function dvi_uquad:int_31; {result must be non-negative} 2337var x:int_32; 2338begin x:=dvi_squad; if x<0 then bad_dvi 2339else dvi_uquad:=x; 2340end; 2341@# 2342function dvi_pquad:int_31; {result must be positive} 2343var x:int_32; 2344begin x:=dvi_squad; if x<=0 then bad_dvi 2345else dvi_pquad:=x; 2346end; 2347@# 2348function dvi_pointer:int_32; {result must be positive or |=-1|} 2349var x:int_32; 2350begin x:=dvi_squad; if (x<=0)and(x<>-1) then bad_dvi 2351else dvi_pointer:=x; 2352end; 2353 2354@ Given the structure of the \.{DVI} commands it is fairly obvious 2355that their interpretation consists of two steps: First zero to four 2356bytes are read in order to obtain the value of the first parameter 2357(e.g., zero bytes for |set_char_0|, four bytes for |set4|); then, 2358depending on the command class, a specific action is performed (e.g., 2359typeset a character but don't move the reference point for |put1..put4|). 2360 2361The \.{DVItype} program uses large case statements for both steps; 2362unfortunately some \PASCAL\ compilers fail to implement large case 2363statements efficiently -- in particular those as the one used in the 2364|first_par| function of \.{DVItype}. Here we use a pair of look up tables: 2365|dvi_par| determines how to obtain the value of the first parameter, and 2366|dvi_cl| determines the command class. 2367 2368A slight complication arises from the fact that we want to decompose the 2369character code of each character to be typeset into a residue 2370|0<=char_res<256| and extension: |char_code=char_res+256*char_ext|; 2371the \.{TFM} widths as well as the pixel widths for a given resolution 2372are the same for all characters in a font with the same residue. 2373For \.{OFM} files, |char_res| can have any value and |char_ext=0|. 2374 2375@d two_cases(#)==#,#+1 2376@d three_cases(#)==#,#+1,#+2 2377@d five_cases(#)==#,#+1,#+2,#+3,#+4 2378 2379@ First we define the values used as array elements of |dvi_par|; we 2380distinguish between pure numbers and dimensions because dimensions read 2381from a \.{VF} file must be scaled. 2382 2383@d char_par=0 {character for \\{set} and |put|} 2384@d no_par=1 {no parameter} 2385@d dim1_par=2 {one-byte signed dimension} 2386@d num1_par=3 {one-byte unsigned number} 2387@d dim2_par=4 {two-byte signed dimension} 2388@d num2_par=5 {two-byte unsigned number} 2389@d dim3_par=6 {three-byte signed dimension} 2390@d num3_par=7 {three-byte unsigned number} 2391@d dim4_par=8 {four-byte signed dimension} 2392@d num4_par=9 {four-byte signed number} 2393@d numu_par=10 {four-byte non-negative number} 2394@d rule_par=11 {dimensions for |set_rule| and |put_rule|} 2395@d fnt_par=12 {font for |fnt_num| commands} 2396@d max_par=12 {largest possible value} 2397 2398@<Types...@>= 2399@!cmd_par=char_par..max_par; 2400 2401@ Here we declare the array |dvi_par|. 2402 2403@<Globals...@>= 2404@!dvi_par:packed array [eight_bits] of cmd_par; 2405 2406@ And here we initialize it. 2407 2408@<Set init...@>= 2409for i:=0 to put1+3 do dvi_par[i]:=char_par;@/ 2410for i:=nop to 255 do dvi_par[i]:=no_par;@/ 2411dvi_par[set_rule]:=rule_par; dvi_par[put_rule]:=rule_par;@/ 2412dvi_par[right1]:=dim1_par; dvi_par[right1+1]:=dim2_par; 2413dvi_par[right1+2]:=dim3_par; dvi_par[right1+3]:=dim4_par;@/ 2414for i:=fnt_num_0 to fnt_num_0+63 do dvi_par[i]:=fnt_par;@/ 2415dvi_par[fnt1]:=num1_par; dvi_par[fnt1+1]:=num2_par; 2416dvi_par[fnt1+2]:=num3_par; dvi_par[fnt1+3]:=num4_par;@/ 2417dvi_par[xxx1]:=num1_par; dvi_par[xxx1+1]:=num2_par; 2418dvi_par[xxx1+2]:=num3_par; dvi_par[xxx1+3]:=numu_par;@/ 2419for i:=0 to 3 do 2420 begin dvi_par[i+w1]:=dvi_par[i+right1]; 2421 dvi_par[i+x1]:=dvi_par[i+right1]; 2422 dvi_par[i+down1]:=dvi_par[i+right1]; 2423 dvi_par[i+y1]:=dvi_par[i+right1]; 2424 dvi_par[i+z1]:=dvi_par[i+right1]; 2425 dvi_par[i+fnt_def1]:=dvi_par[i+fnt1]; 2426 end; 2427 2428@ Next we define the values used as array elements of |dvi_cl|; 2429several \.{DVI} commands (e.g., |nop|, |bop|, |eop|, |pre|, |post|) will 2430always be treated separately and are therefore assigned to the invalid 2431class here. 2432 2433@d char_cl=0 2434@d rule_cl=char_cl+1 2435@d xxx_cl=char_cl+2 2436@d push_cl=3 2437@d pop_cl=4 2438@d w0_cl=5 2439@d x0_cl=w0_cl+1 2440@d right_cl=w0_cl+2 2441@d w_cl=w0_cl+3 2442@d x_cl=w0_cl+4 2443@d y0_cl=10 2444@d z0_cl=y0_cl+1 2445@d down_cl=y0_cl+2 2446@d y_cl=y0_cl+3 2447@d z_cl=y0_cl+4 2448@d fnt_cl=15 2449@d fnt_def_cl=16 2450@d invalid_cl=17 2451@d max_cl=invalid_cl {largest possible value} 2452 2453@<Types...@>= 2454@!cmd_cl=char_cl..max_cl; 2455 2456@ Here we declare the array |dvi_cl|. 2457 2458@<Globals...@>= 2459@!dvi_cl:packed array [eight_bits] of cmd_cl; 2460 2461@ And here we initialize it. 2462 2463@<Set init...@>= 2464for i:=set_char_0 to put1+3 do dvi_cl[i]:=char_cl; 2465dvi_cl[set_rule]:=rule_cl; dvi_cl[put_rule]:=rule_cl;@/ 2466dvi_cl[nop]:=invalid_cl; 2467dvi_cl[bop]:=invalid_cl; dvi_cl[eop]:=invalid_cl;@/ 2468dvi_cl[push]:=push_cl; dvi_cl[pop]:=pop_cl;@/ 2469dvi_cl[w0]:=w0_cl; dvi_cl[x0]:=x0_cl;@/ 2470dvi_cl[y0]:=y0_cl; dvi_cl[z0]:=z0_cl;@/ 2471for i:=0 to 3 do 2472 begin dvi_cl[i+right1]:=right_cl; 2473 dvi_cl[i+w1]:=w_cl; 2474 dvi_cl[i+x1]:=x_cl;@/ 2475 dvi_cl[i+down1]:=down_cl; 2476 dvi_cl[i+y1]:=y_cl; 2477 dvi_cl[i+z1]:=z_cl;@/ 2478 dvi_cl[i+xxx1]:=xxx_cl; 2479 dvi_cl[i+fnt_def1]:=fnt_def_cl; 2480 end; 2481for i:=fnt_num_0 to fnt1+3 do dvi_cl[i]:=fnt_cl; 2482for i:=pre to 255 do dvi_cl[i]:=invalid_cl; 2483 2484@ A few small arrays are used to generate \.{DVI} commands. 2485 2486@<Glob...@>= 2487@!dvi_char_cmd:array[boolean] of eight_bits; {|put1| and |set1|} 2488@!dvi_rule_cmd:array[boolean] of eight_bits; {|put_rule| and |set_rule|} 2489@!dvi_right_cmd:array[right_cl..x_cl] of eight_bits; {|right1|, |w1|, and |x1|} 2490@!dvi_down_cmd:array[down_cl..z_cl] of eight_bits; {|down1|, |y1|, and |z1|} 2491 2492@ @<Set init...@>= 2493dvi_char_cmd[false]:=put1; 2494dvi_char_cmd[true]:=set1;@/ 2495dvi_rule_cmd[false]:=put_rule; 2496dvi_rule_cmd[true]:=set_rule;@/ 2497dvi_right_cmd[right_cl]:=right1; 2498dvi_right_cmd[w_cl]:=w1; 2499dvi_right_cmd[x_cl]:=x1;@/ 2500dvi_down_cmd[down_cl]:=down1; 2501dvi_down_cmd[y_cl]:=y1; 2502dvi_down_cmd[z_cl]:=z1; 2503 2504@ The global variables |cur_cmd|, |cur_parm|, and |cur_class| are used 2505for the current \.{DVI} command, its first parameter (if any), and its 2506command class respectively. 2507 2508@<Glob...@>= 2509@!cur_cmd:eight_bits; {current \.{DVI} command byte} 2510@!cur_parm:int_32; {its first parameter (if any)} 2511@!cur_class:cmd_cl; {its class} 2512 2513@ When typesetting a character or rule, the boolean variable |cur_upd| 2514is |true| for \\{set} commands, |false| for |put| commands. 2515 2516@<Glob...@>= 2517@!cur_cp:char_pointer; {|char_widths| index for the current character} 2518@!cur_wp:width_pointer; {width pointer of the current character} 2519@!cur_upd:boolean; {is this a \\{set} or |set_rule| command ?} 2520@!cur_v_dimen:int_32; {a vertical dimension} 2521@!cur_h_dimen:int_32; {a horizontal dimension} 2522 2523@ @<Set init...@>= 2524cur_cp:=0; cur_wp:=invalid_width; {so they can be saved and restored!} 2525 2526@ The |dvi_first_par| procedure first reads \.{DVI} command bytes into 2527|cur_cmd| until |cur_cmd<>nop|; then |cur_parm| is set to the value of 2528the first parameter (if any) and |cur_class| to the command class. 2529 2530@d set_cur_char(#)== {set up |cur_res|, |cur_ext|, and |cur_upd|} 2531begin cur_ext:=0; 2532if cur_cmd<set1 then 2533 begin cur_res:=cur_cmd; cur_upd:=true 2534 end 2535else begin cur_res:=#; cur_upd:=(cur_cmd<put1); 2536 Decr(cur_cmd)(dvi_char_cmd[cur_upd]); 2537 if (cur_cmd=3)and(cur_res>127) then cur_res:=cur_res-128; 2538 while cur_cmd>0 do 2539 begin cur_ext:=cur_ext*256+cur_res; cur_res:=#; decr(cur_cmd); 2540 end; 2541 set_cur_char_tail 2542@d set_cur_char_tail(#)== 2543 if font_extend(#) then 2544 begin cur_res:=256*cur_ext+cur_res; cur_ext:=0; 2545 end 2546 end; 2547end 2548 2549@p procedure dvi_first_par; 2550begin repeat cur_cmd:=dvi_ubyte; 2551until cur_cmd<>nop; {skip over |nop|s} 2552case dvi_par[cur_cmd] of 2553char_par: set_cur_char(dvi_ubyte)(cur_fnt); 2554no_par: do_nothing; 2555dim1_par: cur_parm:=dvi_sbyte; 2556num1_par: cur_parm:=dvi_ubyte; 2557dim2_par: cur_parm:=dvi_spair; 2558num2_par: cur_parm:=dvi_upair; 2559dim3_par: cur_parm:=dvi_strio; 2560num3_par: cur_parm:=dvi_utrio; 2561two_cases(dim4_par): cur_parm:=dvi_squad; {|dim4_par| and |num4_par|} 2562numu_par: cur_parm:=dvi_uquad; 2563rule_par: 2564 begin cur_v_dimen:=dvi_squad; cur_h_dimen:=dvi_squad; 2565 cur_upd:=(cur_cmd=set_rule); 2566 end; 2567fnt_par:cur_parm:=cur_cmd-fnt_num_0; 2568othercases abort('internal error'); 2569endcases; 2570cur_class:=dvi_cl[cur_cmd]; 2571end; 2572 2573@ The global variable |dvi_nf| is used for the number of different 2574\.{DVI} fonts defined so far; their external font numbers (as extracted 2575from the \.{DVI} file) are stored in the array |dvi_e_fnts|, the 2576corresponding internal font numbers used internally by \.{\title} are 2577stored in the array |dvi_i_fnts|. 2578 2579@<Glob...@>= 2580@!dvi_e_fnts:array[font_number] of int_32; {external font numbers} 2581@!dvi_i_fnts:array[font_number] of font_number; {corresponding 2582 internal font numbers} 2583@!dvi_nf:font_number; {number of \.{DVI} fonts defined so far} 2584 2585@ @<Set ini...@>= 2586dvi_nf:=0; 2587 2588@ The |dvi_font| procedure sets |cur_fnt| to the internal font number 2589corresponding to the external font number |cur_parm| (or aborts the 2590program if such a font was never defined). 2591 2592@p procedure dvi_font; {computes |cur_fnt| corresponding to |cur_parm|} 2593var f:font_number; {where the font is sought} 2594begin @<DVI: Locate font |cur_parm|@>; 2595if f=dvi_nf then bad_dvi; 2596cur_fnt:=dvi_i_fnts[f]; 2597if font_type(cur_fnt)=defined_font then load_font; 2598end; 2599 2600@ @<DVI: Locate font |cur_parm|@>= 2601f:=0; dvi_e_fnts[dvi_nf]:=cur_parm; 2602while cur_parm<>dvi_e_fnts[f] do incr(f) 2603 2604@ Finally the |dvi_do_font| procedure is called when one of the commands 2605|fnt_def1..fnt_def4| and its first parameter have been read from the 2606\.{DVI} file; the argument indicates whether this should be the second 2607definition of the font (|true|) or not (|false|). 2608 2609@p procedure dvi_do_font(@!second:boolean); 2610var f:font_number; {where the font is sought} 2611@!k:int_15; {general purpose variable} 2612begin print('DVI: font ',cur_parm:1); 2613@<DVI: Locate font |cur_parm|@>; 2614if (f=dvi_nf)=second then bad_dvi; 2615font_check(nf):=dvi_squad; 2616font_scaled(nf):=dvi_pquad; 2617font_design(nf):=dvi_pquad; 2618k:=dvi_ubyte; pckt_room(1); append_byte(k); 2619Incr(k)(dvi_ubyte); pckt_room(k); 2620while k>0 do begin append_byte(dvi_ubyte); decr(k); 2621 end; 2622font_name(nf):=make_packet; {the font area plus name} 2623dvi_i_fnts[dvi_nf]:=define_font(false); 2624if not second then 2625 begin if dvi_nf=max_fonts then overflow(str_fonts,max_fonts); 2626 incr(dvi_nf); 2627 end 2628else if dvi_i_fnts[f]<>dvi_i_fnts[dvi_nf] then bad_dvi; 2629end; 2630 2631@* Low-level VF input routines. 2632A detailed description of the \.{VF} file format can be found in the 2633documentation of \.{VFtoVP}; here we just define symbolic names for 2634some of the \.{VF} command bytes. 2635 2636@d long_char=242 {\.{VF} command for general character packet} 2637@# 2638@d vf_id=202 {identifies \.{VF} files} 2639 2640@ The program uses the binary file variable |vf_file| for input from 2641\.{VF} files; |vf_loc| is the number of the byte about to be read next 2642from |vf_file|. 2643 2644@<Glob...@>= 2645@!vf_file:byte_file; {a \.{VF} file} 2646@!vf_loc:int_32; {where we are about to look, in |vf_file|} 2647@!vf_limit:int_32; {value of |vf_loc| at end of a character packet} 2648@!vf_ext:pckt_pointer; {extension for \.{VF} files} 2649@!ovf_ext:pckt_pointer; {extension for \.{OVF} files} 2650@!vf_cur_fnt:font_number; {current font number in a \.{VF} file} 2651 2652@ @<Initialize predefined strings@>= 2653id3(".")("V")("F")(vf_ext); {file name extension for \.{VF} files} 2654id4(".")("O")("V")("F")(ovf_ext); {file name extension for \.{OVF} files} 2655 2656@ If a \.{VF} file is badly malformed, we say |bad_font|; this procedure 2657gives an error message which refers the user to \.{VFtoVP} and \.{OVPtoOVF}, 2658and terminates \.{\title}. 2659 2660@<Cases for |bad_font|@>= 2661vf_font_type: begin print('Bad (O)VF file'); print_font(cur_fnt); 2662@.Bad (O)VF file@> 2663 print_ln(' loc=',vf_loc:1); 2664 abort( 2665 'Use OVF2OVP/OVP2OVF/VFtoVP/VPtoVF to diagnose and correct the problem'); 2666@.Use OVF2OVP/OVP2OVF/VFtoVP/VPtoVF@> 2667 end; 2668 2669@ If no font directory has been specified, \.{\title} is supposed to use 2670the default \.{VF} directory, which is a system-dependent place where 2671the \.{VF} files for standard fonts are kept. 2672The string variable |VF_default_area| contains the name of this area. 2673@^system dependencies@> 2674 2675@d VF_default_area_name=='TeXvfonts:' {change this to the correct name} 2676@d VF_default_area_name_length=10 {change this to the correct length} 2677@d OVF_default_area_name=='TeXvfonts:' {change this to the correct name} 2678@d OVF_default_area_name_length=10 {change this to the correct length} 2679 2680@<Glob...@>= 2681@!VF_default_area:packed array[1..VF_default_area_name_length] of char; 2682@!OVF_default_area:packed array[1..OVF_default_area_name_length] of char; 2683 2684@ @<Set init...@>= 2685VF_default_area:=VF_default_area_name; 2686OVF_default_area:=OVF_default_area_name; 2687 2688@ To prepare |vf_file| for input we |reset| it. 2689 2690@<VF: Open |vf_file| or |goto not_found|@>= 2691make_font_name(VF_default_area_name_length)(VF_default_area)(vf_ext); 2692reset(vf_file,cur_name); 2693if eof(vf_file) then begin 2694 make_font_name(OVF_default_area_name_length)(OVF_default_area)(ovf_ext); 2695 reset(vf_file,cur_name); 2696 if eof(vf_file) then 2697@^system dependencies@> 2698 goto not_found 2699 end; 2700vf_loc:=0 2701 2702@ Reading a \.{VF} file should be done as efficient as possible for a 2703particular system; on many systems this means that a large number of 2704bytes from |vf_file| is read into a buffer and will then be extracted 2705from that buffer. In order to simplify such system dependent changes 2706we use a pair of \.{WEB} macros: |vf_byte| extracts the next \.{VF} 2707byte and |vf_eof| is |true| if we have reached the end of the \.{VF} 2708file. Here we give simple minded definitions for these macros in terms 2709of standard \PASCAL. 2710@^system dependencies@> 2711@^optimization@> 2712 2713@d vf_eof == eof(vf_file) {has the \.{VF} file been exhausted?} 2714@d vf_byte(#) == 2715 if vf_eof then bad_font 2716 else read(vf_file,#) {obtain next \.{VF} byte} 2717 2718@ We need several simple functions to read the next byte or bytes 2719from |vf_file|. 2720 2721@p function vf_ubyte:int_8u; {returns the next byte, unsigned} 2722@!begin_byte(vf_byte); incr(vf_loc); comp_ubyte(vf_ubyte); 2723end; 2724@# 2725function vf_upair:int_16u; {returns the next two bytes, unsigned} 2726@!begin_pair(vf_byte); Incr(vf_loc)(2); comp_upair(vf_upair); 2727end; 2728@# 2729function vf_strio:int_24; {returns the next three bytes, signed} 2730@!begin_trio(vf_byte); Incr(vf_loc)(3); comp_strio(vf_strio); 2731end; 2732@# 2733function vf_utrio:int_24u; {returns the next three bytes, unsigned} 2734@!begin_trio(vf_byte); Incr(vf_loc)(3); comp_utrio(vf_utrio); 2735end; 2736@# 2737function vf_squad:int_32; {returns the next four bytes, signed} 2738@!begin_quad(vf_byte); Incr(vf_loc)(4); comp_squad(vf_squad); 2739end; 2740 2741@ All dimensions in a \.{VF} file, except the design sizes of a virtual 2742font and its local fonts, are |fix_word|s that must be scaled in exactly 2743the same way as the character widths from a \.{TFM} file; we can use the 2744same code, but this time |z|, |alpha|, and |beta| are global variables. 2745 2746@<Glob...@>= 2747@<Variables for scaling computation@>@; 2748 2749@ We need five functions to read the next byte or bytes and convert a 2750|fix_word| to a scaled dimension. 2751 2752@p function vf_fix1:int_32; {returns the next byte as scaled value} 2753var x:int_32; {accumulator} 2754begin vf_byte(tfm_b3); incr(vf_loc); 2755tfm_fix1(x); vf_fix1:=x; 2756end; 2757@# 2758function vf_fix2:int_32; {returns the next two bytes as scaled value} 2759var x:int_32; {accumulator} 2760begin vf_byte(tfm_b2); vf_byte(tfm_b3); Incr(vf_loc)(2); 2761tfm_fix2(x); vf_fix2:=x; 2762end; 2763@# 2764function vf_fix3:int_32; {returns the next three bytes as scaled value} 2765var x:int_32; {accumulator} 2766begin vf_byte(tfm_b1); vf_byte(tfm_b2); vf_byte(tfm_b3); 2767Incr(vf_loc)(3);@/ 2768tfm_fix3(x); vf_fix3:=x; 2769end; 2770@# 2771function vf_fix3u:int_32; {returns the next three bytes as scaled value} 2772begin vf_byte(tfm_b1); vf_byte(tfm_b2); vf_byte(tfm_b3); 2773Incr(vf_loc)(3);@/ 2774vf_fix3u:=tfm_fix3u; 2775end; 2776@# 2777function vf_fix4:int_32; {returns the next four bytes as scaled value} 2778var x:int_32; {accumulator} 2779begin vf_byte(tfm_b0); vf_byte(tfm_b1); vf_byte(tfm_b2); vf_byte(tfm_b3); 2780Incr(vf_loc)(4);@/ 2781tfm_fix4(x); vf_fix4:=x; 2782end; 2783 2784@ Three other functions are used in cases where the result must have a 2785non-negative value or a positive value. 2786 2787@p function vf_uquad:int_31; {result must be non-negative} 2788var x:int_32; 2789begin x:=vf_squad; if x<0 then bad_font @+ else vf_uquad:=x; 2790end; 2791@# 2792function vf_pquad:int_31; {result must be positive} 2793var x:int_32; 2794begin x:=vf_squad; if x<=0 then bad_font @+ else vf_pquad:=x; 2795end; 2796@# 2797function vf_fixp:int_31; {result must be positive} 2798begin vf_byte(tfm_b0); vf_byte(tfm_b1); vf_byte(tfm_b2); vf_byte(tfm_b3); 2799Incr(vf_loc)(4);@/ 2800if tfm_b0>0 then bad_font; 2801vf_fixp:=tfm_fix3u; 2802end; 2803 2804@ The |vf_first_par| procedure first reads a \.{VF} command byte into 2805|cur_cmd|; then |cur_parm| is set to the value of the first parameter 2806(if any) and |cur_class| to the command class. 2807 2808@d set_cur_wp_end(#)== if cur_wp=invalid_width then # 2809@d set_cur_wp(#)== {set |cur_wp| to the char's width pointer} 2810cur_wp:=invalid_width; 2811if #<>invalid_font then 2812 if (cur_res>=font_bc(#))and(cur_res<=font_ec(#)) then 2813 begin cur_cp:=font_chars(#)+cur_res; cur_wp:=char_widths[cur_cp]; 2814 end; 2815set_cur_wp_end 2816 2817@p procedure vf_first_par; 2818begin cur_cmd:=vf_ubyte; 2819case dvi_par[cur_cmd] of 2820char_par: 2821 begin set_cur_char(vf_ubyte)(vf_cur_fnt); set_cur_wp(vf_cur_fnt)(bad_font); 2822 end; 2823no_par: do_nothing; 2824dim1_par: cur_parm:=vf_fix1; 2825num1_par: cur_parm:=vf_ubyte; 2826dim2_par: cur_parm:=vf_fix2; 2827num2_par: cur_parm:=vf_upair; 2828dim3_par: cur_parm:=vf_fix3; 2829num3_par: cur_parm:=vf_utrio; 2830dim4_par: cur_parm:=vf_fix4; 2831num4_par: cur_parm:=vf_squad; 2832numu_par: cur_parm:=vf_uquad; 2833rule_par: 2834 begin cur_v_dimen:=vf_fix4; cur_h_dimen:=vf_fix4; 2835 cur_upd:=(cur_cmd=set_rule); 2836 end; 2837fnt_par:cur_parm:=cur_cmd-fnt_num_0; 2838othercases abort('internal error'); 2839endcases; 2840cur_class:=dvi_cl[cur_cmd]; 2841end; 2842 2843@ For a virtual font we set |font_type(f):=vf_font_type|; in this case 2844|font_font(f)| is the default font for character packets from virtual 2845font~|f|. 2846@^font types@> 2847 2848The global variable |vf_nf| is used for the number of different local 2849fonts defined in a \.{VF} file so far; their external font numbers (as 2850extracted from the \.{VF} file) are stored in the array |vf_e_fnts|, the 2851corresponding internal font numbers used internally by \.{\title} are 2852stored in the array |vf_i_fnts|. 2853 2854@<Glob...@>= 2855@!vf_e_fnts:array[font_number] of int_32; {external font numbers} 2856@!vf_i_fnts:array[font_number] of font_number; {corresponding 2857 internal font numbers} 2858@!vf_nf:font_number; {number of local fonts defined so far} 2859@!lcl_nf:font_number; {largest |vf_nf| value for any \.{VF} file} 2860 2861@ @<Set init...@>= 2862lcl_nf:=0; 2863 2864@ The |vf_font| procedure sets |vf_cur_fnt| to the internal font number 2865corresponding to the external font number |cur_parm| (or aborts the 2866program if such a font was never defined). 2867 2868@p procedure vf_font; {computes |vf_cur_fnt| corresponding to |cur_parm|} 2869var f:font_number; {where the font is sought} 2870begin @<VF: Locate font |cur_parm|@>; 2871if f=vf_nf then bad_font; 2872vf_cur_fnt:=vf_i_fnts[f]; 2873end; 2874 2875@ @<VF: Locate font |cur_parm|@>= 2876f:=0; vf_e_fnts[vf_nf]:=cur_parm; 2877while cur_parm<>vf_e_fnts[f] do incr(f) 2878 2879@ Finally the |vf_do_font| procedure is called when one of the commands 2880|fnt_def1..fnt_def4| and its first parameter have been read from the 2881\.{VF} file. 2882 2883@p procedure vf_do_font; 2884var f:font_number; {where the font is sought} 2885@!k:int_31; {general purpose variable} 2886begin print('VF: font ',cur_parm:1);@/ 2887@<VF: Locate font |cur_parm|@>; 2888if f<>vf_nf then bad_font; 2889font_check(nf):=vf_squad; 2890font_scaled(nf):=vf_fixp; 2891font_design(nf):=round(tfm_conv*vf_pquad); 2892k:=vf_ubyte; pckt_room(1); append_byte(k); 2893Incr(k)(vf_ubyte); pckt_room(k); 2894while k>0 do begin append_byte(vf_ubyte); decr(k); 2895 end; 2896font_name(nf):=make_packet; {the font area plus name} 2897vf_i_fnts[vf_nf]:=define_font(true); 2898if vf_nf=lcl_nf then 2899 if lcl_nf=max_fonts then overflow(str_fonts,max_fonts) 2900 else incr(lcl_nf); 2901incr(vf_nf); 2902end; 2903 2904@* Reading VF and OVF files. 2905The |do_vf| function attempts to read the \.{VF} file for a font and 2906returns |false| if the \.{VF} file could not be found; otherwise the 2907font type is changed to |vf_font_type|. 2908 2909@p function do_vf:boolean; {read a \.{VF} file} 2910label reswitch,done,not_found,exit; 2911var temp_byte:int_8u; {byte for temporary variables} 2912@!k:byte_pointer; {index into |byte_mem|} 2913@!l:int_15; {general purpose variable} 2914@!save_ext:int_24; {used to save |cur_ext|} 2915@!save_res:int_32; {used to save |cur_res|} 2916@!save_cp:width_pointer; {used to save |cur_cp|} 2917@!save_wp:width_pointer; {used to save |cur_wp|} 2918@!save_upd:boolean; {used to save |cur_upd|} 2919@!vf_wp:width_pointer; {width pointer for the current character packet} 2920@!vf_fnt:font_number; {current font in the current character packet} 2921@!move_zero:boolean; {|true| if rule 1 is used} 2922@!last_pop:boolean; {|true| if final |pop| has been manufactured} 2923begin @<VF: Open |vf_file| or |goto not_found|@>; 2924save_ext:=cur_ext; save_res:=cur_res; save_cp:=cur_cp; save_wp:=cur_wp; 2925save_upd:=cur_upd; {save} 2926font_type(cur_fnt):=vf_font_type;@/ 2927@<VF: Process the preamble@>;@/ 2928@<VF: Process the font definitions@>;@/ 2929while cur_cmd<=long_char do @<VF: Build a character packet@>; 2930if cur_cmd<>post then bad_font; 2931@!debug print('VF file for font ',cur_fnt:1); print_font(cur_fnt); 2932print_ln(' loaded.'); 2933gubed @;@/ 2934close_in(vf_file); 2935cur_ext:=save_ext; cur_res:=save_res; cur_cp:=save_cp; cur_wp:=save_wp; 2936cur_upd:=save_upd; {restore} 2937do_vf:=true; return; 2938not_found:do_vf:=false; 2939exit:end; 2940 2941@ @<VF: Process the preamble@>= 2942if vf_ubyte<>pre then bad_font; 2943if vf_ubyte<>vf_id then bad_font; 2944temp_byte:=vf_ubyte; pckt_room(temp_byte); 2945for l:=1 to temp_byte do append_byte(vf_ubyte); 2946if font_extend(cur_fnt) then print('O'); 2947print('VF file: '''); print_packet(new_packet); print(''','); 2948flush_packet;@/ 2949check_check_sum(vf_squad,false); 2950check_design_size(round(tfm_conv*vf_pquad));@/ 2951z:=font_scaled(cur_fnt); 2952@<Replace |z|...@>;@/ 2953print_nl(' for font ',cur_fnt:1); print_font(cur_fnt); print_ln('.') 2954 2955@ @<VF: Process the font definitions@>= 2956vf_i_fnts[0]:=invalid_font; vf_nf:=0;@/ 2957cur_cmd:=vf_ubyte; 2958while (cur_cmd>=fnt_def1)and(cur_cmd<=fnt_def1+3) do 2959 begin case cur_cmd-fnt_def1 of 2960 0: cur_parm:=vf_ubyte; 2961 1: cur_parm:=vf_upair; 2962 2: cur_parm:=vf_utrio; 2963 3: cur_parm:=vf_squad; 2964 end; {there are no other cases} 2965 vf_do_font; 2966 cur_cmd:=vf_ubyte; 2967 end; 2968font_font(cur_fnt):=vf_i_fnts[0] 2969 2970@ The \.{VF} format specifies that the interpretation of each packet 2971begins with |w=x=y=z=0|; any |w0|, |x0|, |y0|, or |z0| command using 2972these initial values will be ignored. 2973 2974@<Types...@>= 2975@!vf_state=array[0..1,0..1] of boolean; {state of |w|, |x|, |y|, and |z|} 2976 2977@ As implied by the \.{VF} format the \.{DVI} commands read from the \.{VF} 2978file are enclosed by |push| and |pop|; as we read \.{DVI} 2979commands and append them to |byte_mem|, we perform a set of 2980transformations in order to simplify the resulting packet: Let |zero| be 2981any of the commands |put|, |put_rule|, |fnt_num|, |fnt|, or |xxx| which 2982all leave the current position on the page unchanged, let |move| be any 2983of the horizontal or vertical movement commands |right1..z4|, and let 2984|any| be any sequence of commands containing |push| and |pop| in 2985properly nested pairs; whenever possible we apply one of the following 2986transformation rules: $$\def\n#1:{\hbox to 3cm{\hfil#1:}} 2987\leqalignno{ 2988\hbox{|push| |zero|}&\RA\hbox{|zero| |push|}&\n1:\cr 2989\hbox{|move| |pop|}&\RA\hbox{|pop|}&\n2:\cr 2990\hbox{|push| |pop|}&\RA{}&\n3:\cr 2991\hbox{|push| |set_char| |pop|}&\RA\hbox{|put|}&\n4a:\cr 2992\hbox{|push| \\{set} |pop|}&\RA\hbox{|put|}&\n4b:\cr 2993\hbox{|push| |set_rule| |pop|}&\RA\hbox{|put_rule|}&\n4c:\cr 2994\hbox{|push| |push| |any| |pop|}&\RA\hbox{|push| |any| |pop| |push|}&\n5:\cr 2995\hbox{|push| |any| |pop| |pop|}&\RA\hbox{|any| |pop|}&\n6:\cr 2996}$$ 2997 2998@ In order to perform these transformations we need a stack which is 2999indexed by |vf_ptr|, the number of |push| commands without corresponding 3000|pop| in the packet we are building; the |vf_push_loc| array contains 3001the locations in |byte_mem| following such |push| commands. 3002In view of rule~5 consecutive |push| commands are never stored, the 3003|vf_push_num| array is used to count them. 3004The |vf_last| array indicates the type of the last non-discardable item: 3005a character, a rule, or a group enclosed by |push| and |pop|; 3006the |vf_last_end| array points to the ending locations and, if 3007|vf_last<>vf_other|, the |vf_last_loc| array points to the starting 3008locations of these items. 3009 3010@d vf_set=0 {|vf_set=char_cl|, last item is a |set_char| or \\{set}} 3011@d vf_rule=1 {|vf_rule=rule_cl|, last item is a |set_rule|} 3012@d vf_group=2 {last item is a group enclosed by |push| and |pop|} 3013@d vf_put=3 {last item is a |put|} 3014@d vf_other=4 {last item (if any) is none of the above} 3015 3016@<Types...@>= 3017@!vf_type=vf_set..vf_other; 3018 3019@ @<Glob...@>= 3020@!vf_move: array[stack_pointer] of vf_state; {state of |w|, |x|, |y|, and |z|} 3021@!vf_push_loc: array[stack_pointer] of byte_pointer; {end of a |push|} 3022@!vf_last_loc: array[stack_pointer] of byte_pointer; {start of an item} 3023@!vf_last_end: array[stack_pointer] of byte_pointer; {end of an item} 3024@!vf_push_num: array[stack_pointer] of eight_bits; {|push| count} 3025@!vf_last: array[stack_pointer] of vf_type; {type of last item} 3026@!vf_ptr:stack_pointer; {current number of unfinished groups} 3027@!stack_used:stack_pointer; {largest |vf_ptr| or |stack_ptr| value} 3028 3029@ We use two small arrays to determine the item type of a character or a 3030rule. 3031 3032@<Glob...@>= 3033@!vf_char_type:array[boolean] of vf_type; 3034@!vf_rule_type:array[boolean] of vf_type; 3035 3036@ @<Set init...@>= 3037vf_move[0][0][0]:=false; vf_move[0][0][1]:=false; 3038vf_move[0][1][0]:=false; vf_move[0][1][1]:=false;@/ 3039stack_used:=0;@/ 3040vf_char_type[false]:=vf_put; vf_char_type[true]:=vf_set;@/ 3041vf_rule_type[false]:=vf_other; vf_rule_type[true]:=vf_rule; 3042 3043@ Here we read the first bytes of a character packet from the \.{VF} or \.{OVF} 3044file and initialize the packet being built in |byte_mem|; the start of 3045the whole packet is stored in |vf_push_loc[0]|. When the character 3046packet is finished, a type is assigned to it: |vf_simple| if the 3047packet ends with a character of the correct width, or |vf_complex| 3048otherwise. Moreover, if such a packet for a character with 3049extension zero consists of just one character with extension zero and 3050the same residue, and if there is no previous packet, the whole packet 3051is replaced by the empty packet. 3052 3053@d vf_simple=0 {the packet ends with a character of the correct width} 3054@d vf_complex=vf_simple+1 {otherwise} 3055 3056@<VF: Build a character packet@>= 3057begin if cur_cmd<long_char then 3058 begin vf_limit:=cur_cmd; 3059 cur_ext:=0; cur_res:=vf_ubyte; vf_wp:=check_width(vf_fix3u); 3060 end 3061else begin vf_limit:=vf_uquad; 3062 cur_ext:=vf_strio; cur_res:=vf_ubyte; 3063 if font_extend(cur_fnt) then 3064 begin cur_res:=256*cur_ext+cur_res; cur_ext:=0; 3065 end; 3066 vf_wp:=check_width(vf_fix4); 3067 end; 3068Incr(vf_limit)(vf_loc); 3069vf_push_loc[0]:=byte_ptr; vf_last_end[0]:=byte_ptr; 3070vf_last[0]:=vf_other; vf_ptr:=0;@/ 3071start_packet(vf_complex); 3072@<VF: Append \.{DVI} commands to the character packet@>;@/ 3073k:=pckt_start[pckt_ptr]; 3074if vf_last[0]=vf_put then if cur_wp=vf_wp then 3075 begin decr(byte_mem[k]); {change |vf_complex| into |vf_simple|} 3076 if (byte_mem[k]=bi(0))and@|(vf_push_loc[0]=vf_last_loc[0])and@| 3077 (cur_ext=0)and@|(cur_res=pckt_res) then byte_ptr:=k; 3078 end; 3079build_packet; 3080cur_cmd:=vf_ubyte; 3081end 3082 3083@ For every \.{DVI} command read from the \.{VF} file some action is 3084performed; in addition the initial |push| and the final |pop| are 3085manufactured here. 3086 3087@<VF: Append \.{DVI} commands to the character packet@>= 3088vf_cur_fnt:=font_font(cur_fnt); vf_fnt:=vf_cur_fnt;@/ 3089last_pop:=false; cur_class:=push_cl; {initial |push|} 3090loop begin 3091reswitch:case cur_class of 3092 three_cases(char_cl): @<VF: Do a |char|, |rule|, or |xxx|@>; 3093 push_cl: @<VF: Do a |push|@>; 3094 pop_cl: @<VF: Do a |pop|@>; 3095 two_cases(w0_cl): 3096 if vf_move[vf_ptr][0][cur_class-w0_cl] then append_one(cur_cmd); 3097 three_cases(right_cl): 3098 begin pckt_signed(dvi_right_cmd[cur_class],cur_parm); 3099 if cur_class>=w_cl then vf_move[vf_ptr][0][cur_class-w_cl]:=true; 3100 end; 3101 two_cases(y0_cl): 3102 if vf_move[vf_ptr][1][cur_class-y0_cl] then append_one(cur_cmd); 3103 three_cases(down_cl): 3104 begin pckt_signed(dvi_down_cmd[cur_class],cur_parm); 3105 if cur_class>=y_cl then vf_move[vf_ptr][1][cur_class-y_cl]:=true; 3106 end; 3107 fnt_cl: vf_font; 3108 fnt_def_cl: bad_font; 3109 invalid_cl: if cur_cmd<>nop then bad_font; 3110 othercases abort('internal error'); 3111 endcases; 3112 if vf_loc<vf_limit then vf_first_par 3113 else if last_pop then goto done 3114 else begin cur_class:=pop_cl; last_pop:=true; {final |pop|} 3115 end; 3116 end; 3117done:if (vf_ptr<>0)or(vf_loc<>vf_limit) then bad_font 3118 3119@ For a |push| we either increase |vf_push_num| or start a new level and 3120append a |push|. 3121 3122@d incr_stack(#)== 3123if #=stack_used then 3124 if stack_used=stack_size then overflow(str_stack,stack_size) 3125 else incr(stack_used); 3126incr(#) 3127 3128@<VF: Do a |push|@>= 3129if (vf_ptr>0)and(vf_push_loc[vf_ptr]=byte_ptr) then 3130 begin if vf_push_num[vf_ptr]=255 then overflow(str_stack,255); 3131 incr(vf_push_num[vf_ptr]); 3132 end 3133else begin incr_stack(vf_ptr); 3134 @<VF: Start a new level@>; 3135 vf_push_num[vf_ptr]:=0; 3136 end 3137 3138@ @<VF: Start a new level@>= 3139append_one(push); 3140vf_move[vf_ptr]:=vf_move[vf_ptr-1]; 3141vf_push_loc[vf_ptr]:=byte_ptr; 3142vf_last_end[vf_ptr]:=byte_ptr; 3143vf_last[vf_ptr]:=vf_other 3144 3145@ When a character, a rule, or an |xxx| is appended, transformation 3146rule~1 might be applicable. 3147 3148@<VF: Do a |char|, |rule|, or |xxx|@>= 3149begin if (vf_ptr=0)or(byte_ptr>vf_push_loc[vf_ptr]) then move_zero:=false 3150else case cur_class of 3151char_cl: move_zero:=(not cur_upd)or(vf_cur_fnt<>vf_fnt); 3152rule_cl: move_zero:=not cur_upd; 3153xxx_cl: move_zero:=true; 3154othercases abort('internal error'); 3155endcases; 3156if move_zero then 3157 begin decr(byte_ptr); decr(vf_ptr); 3158 end; 3159case cur_class of 3160char_cl: @<VF: Do a |fnt|, a |char|, or both@>; 3161rule_cl: @<VF: Do a |rule|@>; 3162xxx_cl: @<VF: Do an |xxx|@>; 3163end; {there are no other cases} 3164vf_last_end[vf_ptr]:=byte_ptr; 3165if move_zero then 3166 begin incr(vf_ptr); append_one(push); vf_push_loc[vf_ptr]:=byte_ptr; 3167 vf_last_end[vf_ptr]:=byte_ptr; 3168 if cur_class=char_cl then if cur_upd then goto reswitch; 3169 end; 3170end 3171 3172@ A special situation arises if transformation rule~1 is applied to a 3173|fnt_num| of |fnt| command, but not to the |set_char| or \\{set} command 3174following it; in this case |cur_upd| and |move_zero| are both |true| and 3175the |set_char| or \\{set} command will be appended later. 3176 3177@<VF: Do a |fnt|, a |char|, or both@>= 3178begin if vf_cur_fnt<>vf_fnt then 3179 begin vf_last[vf_ptr]:=vf_other; 3180 pckt_unsigned(fnt1,vf_cur_fnt); vf_fnt:=vf_cur_fnt; 3181 end; 3182if (not move_zero)or(not cur_upd) then 3183 begin vf_last[vf_ptr]:=vf_char_type[cur_upd]; 3184 vf_last_loc[vf_ptr]:=byte_ptr; 3185 pckt_char(cur_upd,cur_ext,cur_res); 3186 end; 3187end 3188 3189@ @<VF: Do a |rule|@>= 3190begin vf_last[vf_ptr]:=vf_rule_type[cur_upd]; 3191vf_last_loc[vf_ptr]:=byte_ptr; 3192append_one(dvi_rule_cmd[cur_upd]); 3193pckt_four(cur_v_dimen); pckt_four(cur_h_dimen); 3194end 3195 3196@ @<VF: Do an |xxx|@>= 3197begin vf_last[vf_ptr]:=vf_other; 3198pckt_unsigned(xxx1,cur_parm); pckt_room(cur_parm); 3199while cur_parm>0 do 3200 begin append_byte(vf_ubyte); decr(cur_parm); 3201 end; 3202end 3203 3204@ Transformation rules 2--6 are triggered by a |pop|, either read from 3205the \.{VF} file or manufactured at the end of the packet. 3206 3207@<VF: Do a |pop|@>= 3208begin if vf_ptr<1 then bad_font; 3209byte_ptr:=vf_last_end[vf_ptr]; {this is rule 2} 3210if vf_last[vf_ptr]<=vf_rule then 3211 if vf_last_loc[vf_ptr]=vf_push_loc[vf_ptr] then 3212 @<VF: Prepare for rule 4@>; 3213if byte_ptr=vf_push_loc[vf_ptr] then @<VF: Apply rule 3 or 4@> 3214else begin if vf_last[vf_ptr]=vf_group then @<VF: Apply rule 6@>; 3215 append_one(pop); decr(vf_ptr); vf_last[vf_ptr]:=vf_group; 3216 vf_last_loc[vf_ptr]:=vf_push_loc[vf_ptr+1]-1; 3217 vf_last_end[vf_ptr]:=byte_ptr; 3218 if vf_push_num[vf_ptr+1]>0 then @<VF: Apply rule 5@>; 3219 end; 3220end 3221 3222@ In order to implement transformation rule~4, we cancel the |set_char|, 3223\\{set}, or |set_rule|, append a |pop|, and insert a |put| or |put_rule| 3224with the old parameters. 3225 3226@<VF: Prepare for rule 4@>= 3227begin cur_class:=vf_last[vf_ptr]; cur_upd:=false; 3228byte_ptr:=vf_push_loc[vf_ptr]; 3229end 3230 3231@ @<VF: Apply rule 3 or 4@>= 3232begin if vf_push_num[vf_ptr]>0 then 3233 begin decr(vf_push_num[vf_ptr]); 3234 vf_move[vf_ptr]:=vf_move[vf_ptr-1]; 3235 end 3236else begin decr(byte_ptr); decr(vf_ptr); 3237 end; 3238if cur_class<>pop_cl then goto reswitch; {this is rule 4} 3239end 3240 3241@ @<VF: Apply rule 6@>= 3242begin Decr(byte_ptr)(2); 3243for k:=vf_last_loc[vf_ptr]+1 to byte_ptr do byte_mem[k-1]:=byte_mem[k]; 3244vf_last[vf_ptr]:=vf_other; vf_last_end[vf_ptr]:=byte_ptr; 3245end 3246 3247@ @<VF: Apply rule 5@>= 3248begin incr(vf_ptr); 3249@<VF: Start a new level@>; 3250decr(vf_push_num[vf_ptr]); 3251end 3252 3253@ The \.{VF} format specifies that after a character packet invoked by a 3254|set_char| or \\{set} command, ``|h|~is increased by the \.{TFM} width 3255(properly scaled)---just as if a simple character had been typeset''; 3256for |vf_simple| packets this is achieved by changing the final |put| 3257command into |set_char| or \\{set}, but for |vf_complex| packets an 3258explicit movement must be done. This poses a problem for programs, 3259such as \.{DVIcopy}, which write a new \.{DVI} file with all references 3260to characters from virtual fonts replaced by their character packets: 3261The \.{DVItype} program specifies that the horizontal movements after a 3262|set_char| or \\{set} command, after a |set_rule| command, and after one 3263of the commands |right1..x4|, are all treated differently when \.{DVI} 3264units are converted to pixels. 3265 3266Thus we introduce a slight extension of \.{DVItype}'s pixel rounding 3267algorithm and hope that this extension will become part of the standard 3268\.{DVItype} program in the near future: If a \.{DVI} file contains a 3269|set_rule| command for a rule with the negative height |width_dimen|, 3270then this rule shall be treated in exactly the same way as a ficticious 3271character whose width is the width of that rule; as value of |width_dimen| 3272we choose $-2^{31}$, the smallest signed 32-bit integer. 3273 3274@<Glob...@>= 3275@!width_dimen:int_32; {vertical dimension of special rules} 3276 3277@ When initializing |width_dimen| we are careful to avoid arithmetic 3278overflow. 3279 3280@<Set init...@>= 3281width_dimen:=-@"40000000; Decr(width_dimen)(@"40000000); 3282 3283@* Terminal communication. 3284When \.{\title} begins, it engages the user in a brief dialog so that 3285various options may be specified. This part of \.{\title} requires 3286nonstandard \PASCAL\ constructions to handle the online interaction; so 3287it may be preferable in some cases to omit the dialog and simply to 3288stick to the default options. On other hand, the system-dependent 3289routines that are needed are not complicated, so it will not be terribly 3290difficult to introduce them; furthermore they are similar to those in 3291\.{DVItype}. 3292 3293It may be desirable to (optionally) specify all the options in the 3294command line and skip the dialog with the user, provided the operating 3295system permits this. Here we just define the system-indepent part of the 3296code required for this possibility. Since a complete option (a keyword 3297possibly followed by one or several parameters) may have embedded blanks 3298it might be necessary to replace these blanks by some other separator, 3299e.g., by a '/'. Using, e.g., \.{UNIX} style options one might then say 3300$$\.{\title\space-mag/2000 -sel/17.3/5 -sel/47 ...}$$ 3301to override the magnification factor that is stated in the \.{DVI} file, 3302and to select five pages starting with the page numbered~17.3 as well as 3303all remaining pages starting with the one numbered~47; alternatively one 3304might simply say 3305$$\.{\title\space- ...}$$ 3306to skip the dialog and use the default options. 3307 3308The system-dependent initialization code should set the |n_opt| variable 3309to the number of options found in the command line. If |n_opt=0| the 3310|input_ln| procedure defined below will prompt the user for options. If 3311|n_opt>0| the |k_opt| variable will be incremented and another piece of 3312system-dependent code is invoked instead of the dialog; that code should 3313place the value of command line option number |k_opt| as temporary 3314string into the |byte-mem| array. This process will be repeated until 3315|k_opt=n_opt|, indicating that all command line options have been 3316processed. 3317@^system dependencies@> 3318 3319@d opt_separator="/" {acts as blank when scanning (command line) options} 3320 3321@<Set init...@>= 3322n_opt:=0; {change this to indicate the presence of command line options} 3323k_opt:=0; {just in case} 3324 3325@ The |input_ln| routine waits for the user to type a line at his or her 3326terminal; then it puts ASCII-code equivalents for the characters on that 3327line into the |byte_mem| array as a temporary string. \PASCAL's 3328standard |input| file is used for terminal input, as |output| is used 3329for terminal output. 3330 3331Since the terminal is being used for both input and output, some systems 3332need a special routine to make sure that the user can see a prompt message 3333before waiting for input based on that message. (Otherwise the message 3334may just be sitting in a hidden buffer somewhere, and the user will have 3335no idea what the program is waiting for.) We shall invoke a system-dependent 3336subroutine |update_terminal| in order to avoid this problem. 3337@^system dependencies@> 3338 3339@d update_terminal == break(output) {empty the terminal output buffer} 3340@# 3341@d scan_blank(#)== {tests for `blank' when scanning (command line) options} 3342 ((byte_mem[#]=bi(" "))or(byte_mem[#]=bi(opt_separator))) 3343@d scan_skip== {skip `blanks'} 3344 while scan_blank(scan_ptr)and(scan_ptr<byte_ptr) do incr(scan_ptr) 3345@d scan_init== {initialize |scan_ptr|} 3346 byte_mem[byte_ptr]:=bi(" "); scan_ptr:=pckt_start[pckt_ptr-1]; scan_skip 3347 3348@<Action procedures for |dialog|@>= 3349procedure input_ln; {inputs a line from the terminal} 3350var k:0..terminal_line_length; 3351begin if n_opt=0 then 3352 begin print('Enter option: '); update_terminal; reset(input); 3353 if eoln(input) then read_ln(input); 3354 k:=0; pckt_room(terminal_line_length); 3355 while (k<terminal_line_length)and not eoln(input) do 3356 begin append_byte(xord[input^]); incr(k); get(input); 3357 end; 3358 end 3359else if k_opt<n_opt then 3360 begin incr(k_opt); 3361 {Copy command line option number |k_opt| into |byte_mem| array!} 3362 end; 3363end; 3364 3365@ The global variable |scan_ptr| is used while scanning the temporary 3366packet; it points to the next byte in |byte_mem| to be examined. 3367 3368@<Glob...@>= 3369@!n_opt:int_16; {number of options found in command line} 3370@!k_opt:int_16; {number of command line options processed} 3371@!scan_ptr:byte_pointer; {pointer to next byte to be examined} 3372@!sep_char:text_char; {|' '| or |xchr[opt_separator]|} 3373 3374@ The |scan_keyword| function is used to test for keywords in a character 3375string stored as temporary packet in |byte_mem|; the result is |true| 3376(and |scan_ptr| is updated) if the characters starting at position 3377|scan_ptr| are an abbreviation of a given keyword followed by at least 3378one blank. 3379 3380@<Action procedures for |dialog|@>= 3381function scan_keyword(@!p:pckt_pointer;@!l:int_7):boolean; 3382var i,@!j,@!k:byte_pointer; {indices into |byte_mem|} 3383begin i:=pckt_start[p]; j:=pckt_start[p+1]; k:=scan_ptr; 3384while (i<j)and((byte_mem[k]=byte_mem[i])or(byte_mem[k]=byte_mem[i]-"a"+"A")) do 3385 begin incr(i); incr(k); 3386 end; 3387if scan_blank(k)and(i-pckt_start[p]>=l) then 3388 begin scan_ptr:=k; scan_skip; scan_keyword:=true; 3389 end 3390else scan_keyword:=false; 3391end; 3392 3393@ Here is a routine that scans a (possibly signed) integer and computes 3394the decimal value. If no decimal integer starts at |scan_ptr|, the 3395value~0 is returned. The integer should be less than $2^{31}$ in 3396absolute value. 3397 3398@<Action procedures for |dialog|@>= 3399function scan_int:int_32; 3400var x:int_32; {accumulates the value} 3401@!negative:boolean; {should the value be negated?} 3402begin if byte_mem[scan_ptr]="-" then 3403 begin negative:=true; incr(scan_ptr); 3404 end 3405else negative:=false; 3406x:=0; 3407while (byte_mem[scan_ptr]>="0")and(byte_mem[scan_ptr]<="9") do 3408 begin x:=10*x+byte_mem[scan_ptr]-"0"; incr(scan_ptr); 3409 end; 3410scan_skip; 3411if negative then scan_int:=-x @+ else scan_int:=x; 3412end; 3413 3414@ The selected options are put into global variables by the |dialog| 3415procedure, which is called just as \.{\title} begins. 3416@^system dependencies@> 3417 3418@p @<Action procedures for |dialog|@>@; 3419procedure dialog; 3420label exit; 3421var p:pckt_pointer; {packet being created} 3422begin @<Initialize options@>@; 3423loop begin input_ln; p:=new_packet; scan_init; 3424 if scan_ptr=byte_ptr then 3425 begin flush_packet; return; 3426 end@;@/ 3427 @<Cases for options@>@;@/ 3428 else begin if n_opt=0 then sep_char:=' ' 3429 else sep_char:=xchr[opt_separator]; 3430 print_options; 3431 if n_opt>0 then 3432 begin print('Bad command line option: '); 3433 print_packet(p); abort('---run terminated'); 3434 end; 3435 end; 3436 flush_packet; 3437 end; 3438exit:end; 3439 3440@ The |print_options| procedure might be used in a `Usage message' 3441displaying the command line syntax. 3442 3443@<Basic printing...@>= 3444procedure print_options; 3445begin print_ln('Valid options are:'); 3446@<Print valid options@>@; 3447end; 3448 3449@* Subroutines for typesetting commands. 3450This is the central part of the whole \.{\title} program: 3451When a typesetting command from the \.{DVI} file or from a \.{VF} packet 3452has been decoded, one of the typesetting routines defined below is 3453invoked to execute the command; apart from the necessary book keeping, 3454these routines invoke device dependent code defined later. 3455 3456@p @<Declare typesetting procedures@> 3457 3458@ These typesetting routines communicate with the rest of the program 3459through global variables. 3460 3461@<Glob...@>= 3462@!type_setting:boolean; {|true| while typesetting a page} 3463 3464@ @<Set init...@>= 3465type_setting:=false; 3466 3467@ The user may select up to |max_select| ranges of consecutive pages to 3468be processed. Each starting page specification is recorded in two global 3469arrays called |start_count| and |start_there|. For example, `\.{1.*.-5}' 3470is represented by |start_there[0]=true|, |start_count[0]=1|, 3471|start_there[1]=false|, |start_there[2]=true|, |start_count[2]=-5|. We 3472also set |start_vals=2|, to indicate that count 2 was the last one 3473mentioned. The other values of |start_count| and |start_there| are not 3474important, in this example. The number of pages is recorded in 3475|max_pages|; a non positive value indicates that there is no limit. 3476 3477@d start_count==select_count[cur_select] {count values to select 3478 starting page} 3479@d start_there==select_there[cur_select] {is the |start_count| value 3480 relevant?} 3481@d start_vals==select_vals[cur_select] {the last count considered 3482 significant} 3483@d max_pages==select_max[cur_select] {at most this many |bop..eop| pages 3484 will be printed} 3485 3486@<Glob...@>= 3487@!select_count:array[0..max_select-1,0..9] of int_32; 3488@!select_there:array[0..max_select-1,0..9] of boolean; 3489@!select_vals:array[0..max_select-1] of 0..9; 3490@!select_max:array[0..max_select-1] of int_32; 3491@!out_mag:int_32; {output maginfication} 3492@!count:array[0..9] of int_32; {the count values on the current page} 3493@!num_select:0..max_select; {number of page selection ranges specified} 3494@!cur_select:0..max_select; {current page selection range} 3495@!selected:boolean; {has starting page been found?} 3496@!all_done:boolean; {have all selected pages been processed?} 3497@!str_mag,@!str_select:pckt_pointer; 3498 3499@ Here is a simple subroutine that tests if the current page might be the 3500starting page. 3501 3502@p function start_match:boolean; {does |count| match the starting spec?} 3503var k:0..9; {loop index} 3504@!match:boolean; {does everything match so far?} 3505begin match:=true; 3506for k:=0 to start_vals do 3507 if start_there[k]and(start_count[k]<>count[k]) then match:=false; 3508start_match:=match; 3509end; 3510 3511@ @<Initialize options@>= 3512out_mag:=0; cur_select:=0; max_pages:=0; selected:=true; 3513 3514@ @<Print valid options@>= 3515print_ln(' mag',sep_char,'<new_mag>'); 3516print_ln(' select',sep_char,'<start_count>',sep_char, 3517 '[<max_pages>] (up to ',max_select:1,' ranges)'); 3518 3519@ @<Action procedures for |dialog|@>= 3520procedure scan_count; {scan a |start_count| value} 3521begin if byte_mem[scan_ptr]=bi("*") then 3522 begin start_there[start_vals]:=false; incr(scan_ptr); scan_skip; 3523 end 3524else begin start_there[start_vals]:=true; 3525 start_count[start_vals]:=scan_int; 3526 if cur_select=0 then selected:=false; {don't start at first page} 3527 end; 3528end; 3529 3530@ @<Cases for options@>= 3531else if scan_keyword(str_mag,3) then out_mag:=scan_int 3532else if scan_keyword(str_select,3) then 3533 if cur_select=max_select then print_ln('Too many page selections') 3534 else begin start_vals:=0; scan_count; 3535 while (start_vals<9)and(byte_mem[scan_ptr]=bi(".")) do 3536 begin incr(start_vals); incr(scan_ptr); scan_count; 3537 end; 3538 max_pages:=scan_int; incr(cur_select); 3539 end 3540 3541@ @<Initialize predefined strings@>= 3542id3("m")("a")("g")(str_mag); 3543id6("s")("e")("l")("e")("c")("t")(str_select); 3544 3545@ A stack is used to keep track of the current horizonal and vertical 3546position, |h| and |v|, and the four registers |w|, |x|, |y|, and |z|; 3547the register pairs |(w,x)| and |(y,z)| are maintained as arrays. 3548 3549@<Types...@>= 3550@!device @<Declare device dependend types@>@; @+ ecived @; @/ 3551@!stack_pointer=0..stack_size;@/ 3552@!stack_index=1..stack_size;@/ 3553@!pair_32=array[0..1] of int_32; {a pair of |int_32| variables} 3554@!stack_record=record@;@/ 3555 @!h_field:int_32; {horizontal position |h|} 3556 @!v_field:int_32; {vertical position |v|} 3557 @!w_x_field:pair_32; {|w| and |x| register for horizontal movements} 3558 @!y_z_field:pair_32; {|y| and |z| register for vertical movements} 3559 @!device @<Device dependent stack record fields@>@; @+ ecived @; @/ 3560 end; 3561 3562@ The current values are kept in |cur_stack|; they are pushed onto and 3563popped from |stack|. We use \.{WEB} macros to access the current values. 3564 3565@d cur_h==cur_stack.h_field {the current |@!h| value} 3566@d cur_v==cur_stack.v_field {the current |@!v| value} 3567@d cur_w_x==cur_stack.w_x_field {the current |@!w| and |@!x| value} 3568@d cur_y_z==cur_stack.y_z_field {the current |@!y| and |@!z| value} 3569 3570@<Glob...@>= 3571@!stack:array[stack_index] of stack_record; {the pushed values} 3572@!cur_stack:stack_record; {the current values} 3573@!zero_stack:stack_record; {initial values} 3574@!stack_ptr:stack_pointer; {last used position in |stack|} 3575 3576@ @<Set init...@>= 3577zero_stack.h_field:=0; zero_stack.v_field:=0; 3578for i:=0 to 1 do 3579 begin zero_stack.w_x_field[i]:=0; zero_stack.y_z_field[i]:=0; 3580 end; 3581@!device @<Initialize device dependent stack record fields@>@; @+ ecived @; @/ 3582 3583@ When typesetting for a real device we must convert the current 3584position from \.{DVI} units to pixels, i.e., |cur_h| and |cur_v| into 3585|cur_hh| and |cur_vv|. This might be a good place to collect everything 3586related to the conversion from \.{DVI} units to pixels and in particular 3587all the pixel rounding algorithms. 3588 3589@d font_space(#)==fnt_space[#] {boundary between ``small'' and ``large'' 3590 spaces} 3591 3592@<Declare device dependent font data arrays@>= 3593@!fnt_space:array [font_number] of int_32; {boundary between ``small'' 3594 and ``large'' spaces} 3595 3596@ @<Initialize device dependent font data@>= 3597font_space(invalid_font):=0; 3598 3599@ @<Initialize device dependent data for a font@>= 3600font_space(cur_fnt):=font_scaled(cur_fnt) div 6; 3601 {this is a 3-unit ``thin space''} 3602 3603@ The |char_pixels| array is used to store the horizontal character 3604escapements: for \.{PK} or \.{GF} files we use the values given there, 3605otherwise we must convert the character widths to (horizontal) pixels. 3606The horizontal escapement of character~|c| in font~|f| is given by 3607|font_pixel(f)(c)|. 3608 3609@d font_pixel(#)==char_pixels[font_chars(#)+font_width_end 3610@# 3611@d max_pix_value==@"7FFF {largest allowed pixel value; this range may not 3612 suffice for high resolution output devices} 3613 3614@<Declare device dependend types@>= 3615@!pix_value=-max_pix_value..max_pix_value; {a pixel coordinate or displacement} 3616 3617@ @<Glob...@>= 3618@!device 3619@!char_pixels:array[char_pointer] of pix_value; {character escapements} 3620@!h_pixels:pix_value; {a horizontal dimension in pixels} 3621@!v_pixels:pix_value; {a vertical dimension in pixels} 3622@!temp_pix:pix_value; {temporary value for pixel rounding} 3623ecived 3624 3625@ @d cur_hh==cur_stack.hh_field {the current |@!hh| value} 3626@d cur_vv==cur_stack.vv_field {the current |@!vv| value} 3627 3628@<Device dependent stack record fields@>= 3629@!hh_field:pix_value; {horizontal pixel position |hh|} 3630@!vv_field:pix_value; {vertical pixel position |vv|} 3631 3632@ @<Initialize device dependent stack record fields@>= 3633zero_stack.hh_field:=0; zero_stack.vv_field:=0; 3634 3635@ For small movements we round the increment in position, for large 3636movements we round the incremented position. The same applies to rule 3637dimensions with the only difference that they will always be rounded 3638towards larger values. For characters we increment the horizontal 3639position by the escapement values obtained, e.g., from a \.{PK} file or 3640by the \.{TFM} width converted to pixels. 3641 3642@d h_pixel_round(#)==round(h_conv*(#)) 3643@d v_pixel_round(#)==round(v_conv*(#)) 3644@^system dependencies@> 3645@# 3646@d large_h_space(#)==(#>=font_space(cur_fnt))or(#<=-4*font_space(cur_fnt)) 3647 {is this a ``large'' horizontal distance?} 3648@d large_v_space(#)==(abs(#)>=5*font_space(cur_fnt)) 3649 {is this a ``large'' vertical distance?} 3650@# 3651@d h_rule_pixels== {converts the rule width |cur_h_dimen| to pixels} 3652@!device if large_h_space(cur_h_dimen) then 3653 begin h_pixels:=h_pixel_round(cur_h+cur_h_dimen)-cur_hh; 3654 if h_pixels<=0 then if cur_h_dimen>0 then h_pixels:=1; 3655 end 3656else begin h_pixels:=trunc(h_conv*cur_h_dimen); 3657 if h_pixels<h_conv*cur_h_dimen then incr(h_pixels); 3658 end; 3659ecived 3660@# 3661@d v_rule_pixels== {converts the rule height |cur_v_dimen| to pixels} 3662@!device if large_v_space(cur_v_dimen) then 3663 begin v_pixels:=cur_vv-v_pixel_round(cur_v-cur_v_dimen); 3664 if v_pixels<=0 then v_pixels:=1; {used only for |cur_v_dimen>0|} 3665 end 3666else begin v_pixels:=trunc(v_conv*cur_v_dimen); 3667 if v_pixels<v_conv*cur_v_dimen then incr(v_pixels); 3668 end; 3669ecived 3670 3671@ A sequence of consecutive rules, or consecutive characters in a 3672fixed-width font whose width is not an integer number of pixels, can 3673cause |hh| to drift far away from a correctly rounded value. \.{\title} 3674ensures that the amount of drift will never exceed |max_h_drift| pixels; 3675similarly |vv| shall never drift away from the correctly rounded value 3676by more than |max_v_drift| pixels. 3677 3678@d h_upd_end(#)== {check for proper horizontal pixel rounding} 3679begin Incr(cur_hh)(#); temp_pix:=h_pixel_round(cur_h); 3680if abs(temp_pix-cur_hh)>max_h_drift then 3681 if temp_pix>cur_hh then cur_hh:=temp_pix-max_h_drift 3682 else cur_hh:=temp_pix+max_h_drift; 3683end @+ ecived 3684@d h_upd_char(#)==Incr(cur_h)(#)@; 3685 @!device; h_upd_end 3686@d h_upd_move(#)==Incr(cur_h)(#)@; 3687 @!device; if large_h_space(#) then cur_hh:=h_pixel_round(cur_h) 3688 else h_upd_end 3689@# 3690@d v_upd_end(#)== {check for proper vertical pixel rounding} 3691begin Incr(cur_vv)(#); temp_pix:=v_pixel_round(cur_v); 3692if abs(temp_pix-cur_vv)>max_v_drift then 3693 if temp_pix>cur_vv then cur_vv:=temp_pix-max_v_drift 3694 else cur_vv:=temp_pix+max_v_drift; 3695end @+ ecived 3696@d v_upd_move(#)==Incr(cur_v)(#)@; 3697 @!device; if large_v_space(#) then cur_vv:=v_pixel_round(cur_v) 3698 else v_upd_end 3699 3700@ The routines defined below use sections named `Declare local variables 3701(if any) for \dots' or `Declare additional local variables for \dots'; 3702the former may declare variables (including the keyword \&{var}), whereas 3703the later must at least contain the keyword \&{var}. In general, both may 3704start with the declaration of labels, constants, and\slash or types. 3705 3706Let us start with the simple cases: 3707The |do_pre| procedure is called when the preamble has been read from 3708the \.{DVI} file; the preamble comment has just been converted into a 3709temporary packet with the |new_packet| procedure. 3710 3711@p procedure do_pre;@/ 3712@<OUT: Declare local variables (if any) for |do_pre|@>@; 3713begin all_done:=false; num_select:=cur_select; cur_select:=0; 3714if num_select=0 then max_pages:=0; 3715@!device 3716h_conv:=(dvi_num/254000.0)*(h_resolution/dvi_den)*(out_mag/1000.0); 3717v_conv:=(dvi_num/254000.0)*(v_resolution/dvi_den)*(out_mag/1000.0); 3718ecived @; @/ 3719@<OUT: Process the |pre|@>@;@/ 3720end; 3721 3722@ The |do_bop| procedure is called when a |bop| has been read. This 3723routine determines whether a page shall be processed or skipped and sets 3724the variable |type_setting| accordingly. 3725 3726@p procedure do_bop;@/ 3727@<OUT: Declare additional local variables |do_bop|@>@; 3728@!i,@!j:0..9; {indices into |count|} 3729begin @<Determine whether this page should be processed or skipped@>; 3730print('DVI: '); 3731if type_setting then print('process') @+ else print('skipp'); 3732print('ing page ',count[0]:1); j:=9; 3733while (j>0)and(count[j]=0) do decr(j); 3734for i:=1 to j do print('.',count[i]:1); 3735d_print(' at ',dvi_loc-45:1); 3736print_ln('.'); 3737if type_setting then 3738 begin stack_ptr:=0; cur_stack:=zero_stack; cur_fnt:=invalid_font;@/ 3739 @<OUT: Process a |bop|@>@;@/ 3740 end; 3741end; 3742 3743@ Note that the device dependent code `OUT: Process a |bop|' may choose 3744to set |type_setting| to false even if |selected| is true. 3745 3746@<Determine whether this page...@>= 3747if not selected then selected:=start_match; 3748type_setting:=selected 3749 3750@ The |do_eop| procedure is called in order to process an |eop|; the 3751stack should be empty. 3752 3753@p procedure do_eop;@/ 3754@<OUT: Declare local variables (if any) for |do_eop|@>@; 3755begin if stack_ptr<>0 then bad_dvi; 3756@<OUT: Process an |eop|@>@; 3757if max_pages>0 then 3758 begin decr(max_pages); 3759 if max_pages=0 then 3760 begin selected:=false; incr(cur_select); 3761 if cur_select=num_select then all_done:=true; 3762 end; 3763 end; 3764type_setting:=false; 3765end; 3766 3767@ The procedures |do_push| and |do_pop| are called in order to process 3768|push| and |pop| commands; |do_push| must check for stack overflow, 3769|do_pop| should never be called when the stack is empty. 3770 3771@p procedure do_push; {push onto stack} 3772@<OUT: Declare local variables (if any) for |do_push|@>@; 3773begin incr_stack(stack_ptr); stack[stack_ptr]:=cur_stack;@/ 3774@<OUT: Process a |push|@>@; 3775end; 3776@# 3777procedure do_pop; {pop from stack} 3778@<OUT: Declare local variables (if any) for |do_pop|@>@; 3779begin if stack_ptr=0 then bad_dvi; 3780cur_stack:=stack[stack_ptr]; decr(stack_ptr); 3781@<OUT: Process a |pop|@>@;@/ 3782end; 3783 3784@ The |do_xxx| procedure is called in order to process a special command. 3785The bytes of the special string have been put into |byte_mem| as the 3786current string. They are converted to a temporary packet and discarded 3787again. 3788 3789@p procedure do_xxx;@/ 3790@<OUT: Declare additional local variables for |do_xxx|@>@; 3791@!p:pckt_pointer; {temporary packet} 3792begin p:=new_packet;@/ 3793@<OUT: Process an |xxx|@>@;@/ 3794flush_packet; 3795end; 3796 3797@ Next are the movement commands: 3798The |do_right| procedure is called in order to process the horizontal 3799movement commands |right|, |w|, and |x|. 3800 3801 3802@p procedure do_right;@/ 3803@<OUT: Declare local variables (if any) for |do_right|@>@; 3804begin if cur_class>=w_cl then cur_w_x[cur_class-w_cl]:=cur_parm 3805else if cur_class<right_cl then cur_parm:=cur_w_x[cur_class-w0_cl]; 3806@<OUT: Process a |right| or |w| or |x|@>@;@/ 3807h_upd_move(cur_parm)(h_pixel_round(cur_parm)); 3808@<OUT: Move right@>@; 3809end; 3810 3811@ The |do_down| procedure is called in order to process the vertical 3812movement commands |down|, |y|, and |z|. 3813 3814@p procedure do_down;@/ 3815@<OUT: Declare local variables (if any) for |do_down|@>@; 3816begin if cur_class>=y_cl then cur_y_z[cur_class-y_cl]:=cur_parm 3817else if cur_class<down_cl then cur_parm:=cur_y_z[cur_class-y0_cl]; 3818@<OUT: Process a |down| or |y| or |z|@>@;@/ 3819v_upd_move(cur_parm)(v_pixel_round(cur_parm)); 3820@<OUT: Move down@>@; 3821end; 3822 3823@ The |do_width| procedure, or actually the |do_a_width| macro, is 3824called in order to increase the current horizontal position |cur_h| by 3825|cur_h_dimen| in exactly the same way as if a character of width 3826|cur_h_dimen| had been typeset. 3827 3828@d do_a_width(#)== 3829 begin @!device h_pixels:=#; @+ ecived @; @+ do_width; 3830 end 3831 3832@p procedure do_width;@/ 3833@<OUT: Declare local variables (if any) for |do_width|@>@; 3834begin @<OUT: Typeset a |width|@>@;@/ 3835h_upd_char(cur_h_dimen)(h_pixels); 3836@<OUT: Move right@>@; 3837end; 3838 3839@ Finally we have the commands for the typesetting of rules and characters; 3840the global variable |cur_upd| is |true| if the horizontal position shall 3841be updated (\\{set} commands). 3842 3843The |do_rule| procedure is called in order to typeset a rule. 3844 3845@p procedure do_rule;@/ 3846@<OUT: Declare additional local variables |do_rule|@>@; 3847@!visible:boolean; 3848begin h_rule_pixels@; 3849if (cur_h_dimen>0)and(cur_v_dimen>0) then 3850 begin visible:=true; v_rule_pixels@; 3851 @<OUT: Typeset a visible |rule|@>@; 3852 end 3853else begin visible:=false; 3854 @<OUT: Typeset an invisible |rule|@>@; 3855 end; 3856if cur_upd then 3857 begin h_upd_move(cur_h_dimen)(h_pixels); 3858 @<OUT: Move right@>@; 3859 end; 3860end; 3861 3862@ Last not least the |do_char| procedure is called in order to typeset 3863character~|cur_res| with extension~|cur_ext| from the real font~|cur_fnt|. 3864 3865@p procedure do_char;@/ 3866@<OUT: Declare local variables (if any) for |do_char|@>@; 3867begin @<OUT: Typeset a |char|@>@; 3868if cur_upd then 3869 begin h_upd_char(widths[cur_wp])(char_pixels[cur_cp]); 3870 @<OUT: Move right@>@; 3871 end; 3872end; 3873 3874@ If the program terminates abnormally, the following code may be 3875invoked in the middle of a page. 3876 3877@<Finish output file(s)@>= 3878begin if type_setting then @<OUT: Finish incomplete page@>; 3879@<OUT: Finish output file(s)@>@; 3880end 3881 3882@ When the first character of font~|cur_fnt| is about to be typeset, the 3883|do_font| procedure is called in order to decide whether this is a 3884virtual font or a real font. 3885 3886One step in this decision is the attempt to find and read the \.{VF} 3887file for this font; other attempts to locate a font file may be 3888performed before and after that, depending on the nature of the output 3889device and on the structure of the file system at a particular 3890installation. For a real device we convert the character widths to 3891(horizontal) pixels. 3892 3893In any case |do_font| must change |font_type(cur_fnt)| to a value 3894|>defined_font|; as a last resort one might use the \.{TFM} width data 3895and draw boxes or leave blank spaces in the output. 3896 3897@p procedure do_font;@/ 3898label done;@/ 3899@<OUT: Declare additional local variables for |do_font|@>@; 3900@!p:char_pointer; {index into |char_widths| and |char_pixels|} 3901begin @!debug if font_type(cur_fnt)=defined_font then confusion(str_fonts); 3902gubed@; 3903p:=0; {such that |p| is used} 3904@!device for p:=font_chars(cur_fnt)+font_bc(cur_fnt) 3905 to font_chars(cur_fnt)+font_ec(cur_fnt) do 3906 char_pixels[p]:=h_pixel_round(widths[char_widths[p]]); 3907ecived@; 3908@<OUT: Look for a font file before trying to read the \.{VF} file; 3909 if found |goto done|@>@;@/ 3910if do_vf then goto done; {try to read the \.{VF} file} 3911@<OUT: Look for a font file after trying to read the \.{VF} file@>@;@/ 3912done: 3913@!debug if font_type(cur_fnt)<=loaded_font then confusion(str_fonts); 3914gubed@; 3915end; 3916 3917@ Before a character of font~|cur_fnt| is typeset the following piece of 3918code ensures that the font is ready to be used. 3919 3920@<Prepare to use font |cur_fnt|@>= 3921@<OUT: Prepare to use font |cur_fnt|@>@; 3922if font_type(cur_fnt)<=loaded_font then do_font {|cur_fnt| was not yet used} 3923 3924@* Interpreting VF packets. 3925The |pckt_first_par| procedure first reads a \.{DVI} command byte from 3926the packet into |cur_cmd|; then |cur_parm| is set to the value of the 3927first parameter (if any) and |cur_class| to the command class. 3928 3929@p procedure pckt_first_par; 3930begin cur_cmd:=pckt_ubyte; 3931case dvi_par[cur_cmd] of 3932char_par: set_cur_char(pckt_ubyte)(cur_fnt); 3933no_par: do_nothing; 3934dim1_par: cur_parm:=pckt_sbyte; 3935num1_par: cur_parm:=pckt_ubyte; 3936dim2_par: cur_parm:=pckt_spair; 3937num2_par: cur_parm:=pckt_upair; 3938dim3_par: cur_parm:=pckt_strio; 3939num3_par: cur_parm:=pckt_utrio; 3940three_cases(dim4_par): cur_parm:=pckt_squad; {|dim4|, |num4|, or |numu|} 3941rule_par: 3942 begin cur_v_dimen:=pckt_squad; cur_h_dimen:=pckt_squad; 3943 cur_upd:=(cur_cmd=set_rule); 3944 end; 3945fnt_par:cur_parm:=cur_cmd-fnt_num_0; 3946othercases abort('internal error'); 3947endcases; 3948cur_class:=dvi_cl[cur_cmd]; 3949end; 3950 3951@ The |do_vf_packet| procedure is called in order to interpret the 3952character packet for a virtual character. Such a packet may contain the 3953instruction to typeset a character from the same or an other virtual 3954font; in such cases |do_vf_packet| calls itself recursively. The 3955recursion level, i.e., the number of times this has happened, is kept 3956in the global variable |n_recur| and should not exceed |max_recursion|. 3957@^recursion@> 3958 3959@<Types...@>= 3960@!recur_pointer=0..max_recursion; 3961 3962@ The \.{\title} processor should detect an infinite recursion caused by 3963bad \.{VF} files; thus a new recursion level is entered even in cases 3964where this could be avoided without difficulty. 3965 3966If the recursion level exceeds the allowed maximum, we want to give 3967a traceback how this has happened; thus some of the global variables 3968used in different invocations of |do_vf_packet| are saved in a stack, 3969others are saved as local variables of |do_vf_packet|. 3970 3971@<Glob...@>= 3972@!recur_fnt:array[recur_pointer] of font_number; {this packet's font} 3973@!recur_ext:array[recur_pointer] of int_24; {this packet's extension} 3974@!recur_res:array[recur_pointer] of int_32; {this packet's residue} 3975@!recur_pckt:array[recur_pointer] of pckt_pointer; {the packet} 3976@!recur_loc:array[recur_pointer] of byte_pointer; {next byte of packet} 3977@!n_recur:recur_pointer; {current recursion level} 3978@!recur_used:recur_pointer; {highest recursion level used so far} 3979 3980@ @<Set init...@>= 3981n_recur:=0; recur_used:=0; 3982 3983@ Here now is the |do_vf_packet| procedure. 3984 3985@p procedure do_vf_packet; 3986label continue,found,done; 3987var k:recur_pointer; {loop index} 3988@!f:int_8u; {packet type flag} 3989@!save_upd:boolean; {used to save |cur_upd|} 3990@!save_cp:width_pointer; {used to save |cur_cp|} 3991@!save_wp:width_pointer; {used to save |cur_wp|} 3992@!save_limit:byte_pointer; {used to save |cur_limit|} 3993begin @<VF: Save values on entry to |do_vf_packet|@>;@/ 3994@<VF: Interpret the \.{DVI} commands in the packet@>@;@/ 3995if save_upd then 3996 begin cur_h_dimen:=widths[save_wp]; do_a_width(char_pixels[save_cp]); 3997 end; 3998@<VF: Restore values on exit from |do_vf_packet|@>;@/ 3999end; 4000 4001@ On entry to |do_vf_packet| several values must be saved. 4002 4003@<VF: Save values on entry to |do_vf_packet|@>= 4004save_upd:=cur_upd; save_cp:=cur_cp; save_wp:=cur_wp;@/ 4005recur_fnt[n_recur]:=cur_fnt; 4006recur_ext[n_recur]:=cur_ext; 4007recur_res[n_recur]:=cur_res 4008 4009@ Some of these values must be restored on exit from |do_vf_packet|. 4010 4011@<VF: Restore values on exit from |do_vf_packet|@>= 4012cur_fnt:=recur_fnt[n_recur] 4013 4014@ If |cur_pckt| is the empty packet, we manufacture a |put| command; 4015otherwise we read and interpret \.{DVI} commands from the packet. 4016 4017@<VF: Interpret the \.{DVI} commands in the packet@>= 4018if find_packet then f:=cur_type @+ else goto done; 4019recur_pckt[n_recur]:=cur_pckt; 4020save_limit:=cur_limit; 4021cur_fnt:=font_font(cur_fnt); 4022if cur_pckt=empty_packet then 4023 begin cur_class:=char_cl; goto found; 4024 end; 4025if cur_loc>=cur_limit then goto done; 4026continue: pckt_first_par; 4027found: case cur_class of 4028char_cl: @<VF: Typeset a |char|@>; 4029rule_cl: do_rule; 4030xxx_cl: 4031 begin pckt_room(cur_parm); 4032 while cur_parm>0 do 4033 begin append_byte(pckt_ubyte); decr(cur_parm); 4034 end; 4035 do_xxx; 4036 end; 4037push_cl: do_push; 4038pop_cl: do_pop; 4039five_cases(w0_cl): do_right; {|right|, |w|, or |x|} 4040five_cases(y0_cl): do_down; {|down|, |y|, or |z|} 4041fnt_cl: cur_fnt:=cur_parm; 4042othercases confusion(str_packets); {font definition or invalid} 4043endcases; 4044if cur_loc<cur_limit then goto continue; 4045done: 4046 4047@ The final |put| of a simple packet may be changed into |set_char| or 4048\\{set}. 4049 4050@<VF: Typeset a |char|@>= 4051begin @<Prepare to use font |cur_fnt|@>; 4052cur_cp:=font_chars(cur_fnt)+cur_res; cur_wp:=char_widths[cur_cp]; 4053if (cur_loc=cur_limit)and(f=vf_simple) and save_upd then 4054 begin save_upd:=false; cur_upd:=true; 4055 end; 4056if font_type(cur_fnt)=vf_font_type then 4057 @<VF: Enter a new recursion level@> 4058else do_char; 4059end 4060 4061@ Before entering a new recursion level we must test for overflow; in 4062addition a few variables must be saved and restored. 4063A |set_char| or \\{set} followed by |pop| is changed into |put|. 4064 4065@<VF: Enter a new recursion level@>= 4066begin recur_loc[n_recur]:=cur_loc; {save} 4067if cur_loc<cur_limit then 4068 if byte_mem[cur_loc]=bi(pop) then cur_upd:=false; 4069if n_recur=recur_used then 4070 if recur_used=max_recursion then 4071 @<VF: Display the recursion traceback and terminate@> 4072 else incr(recur_used);@/ 4073incr(n_recur); do_vf_packet; decr(n_recur); {recurse} 4074cur_loc:=recur_loc[n_recur]; cur_limit:=save_limit; {restore} 4075end 4076 4077@ @<VF: Display the recursion traceback and terminate@>= 4078begin print_ln(' !Infinite VF recursion?'); 4079@.Infinite VF recursion?@> 4080for k:=max_recursion downto 0 do 4081 begin print('level=',k:1,' font'); 4082 d_print('=',recur_fnt[k]:1); 4083 print_font(recur_fnt[k]); 4084 print(' char=',recur_res[k]:1); 4085 if recur_ext[k]<>0 then print('.',recur_ext[k]:1); 4086 new_line; 4087 @!debug hex_packet(recur_pckt[k]); print_ln('loc=',recur_loc[k]:1); 4088 gubed@; 4089 end; 4090overflow(str_recursion,max_recursion); 4091end 4092 4093@* Interpreting the DVI file. 4094The |do_dvi| procedure reads the entire \.{DVI} file and initiates 4095whatever actions may be necessary. 4096 4097@p procedure do_dvi; 4098label done,exit; 4099var temp_byte:int_8u; {byte for temporary variables} 4100@!temp_int:int_32; {integer for temporary variables} 4101@!dvi_start:int_32; {starting location} 4102@!dvi_bop_post:int_32; {location of |bop| or |post|} 4103@!dvi_back:int_32; {a back pointer} 4104@!k:int_15; {general purpose variable} 4105begin @<DVI: Process the preamble@>; 4106if random_reading then @<DVI: Process the postamble@>; 4107repeat dvi_first_par; 4108 while cur_class=fnt_def_cl do 4109 begin dvi_do_font(random_reading); dvi_first_par; 4110 end; 4111 if cur_cmd=bop then @<DVI: Process one page@>; 4112until cur_cmd<>eop; 4113if cur_cmd<>post then bad_dvi; 4114exit:end; 4115 4116@ @<DVI: Process the preamble@>= 4117if dvi_ubyte<>pre then bad_dvi; 4118if dvi_ubyte<>dvi_id then bad_dvi; 4119dvi_num:=dvi_pquad; dvi_den:=dvi_pquad; dvi_mag:=dvi_pquad; 4120tfm_conv:=(25400000.0/dvi_num)*(dvi_den/473628672)/16.0; 4121temp_byte:=dvi_ubyte; pckt_room(temp_byte); 4122for k:=1 to temp_byte do append_byte(dvi_ubyte); 4123print('DVI file: '''); print_packet(new_packet); print_ln(''','); 4124print(' num=',dvi_num:1,', den=',dvi_den:1,', mag=',dvi_mag:1); 4125if out_mag<=0 then out_mag:=dvi_mag @+ else print(' => ',out_mag:1); 4126print_ln('.'); 4127do_pre; flush_packet 4128 4129@ @<Glob...@>= 4130@!dvi_num:int_31; {numerator} 4131@!dvi_den:int_31; {denominator} 4132@!dvi_mag:int_31; {magnification} 4133 4134@ @<DVI: Process the postamble@>= 4135begin dvi_start:=dvi_loc; {remember start of first page} 4136@<DVI: Find the postamble@>; 4137d_print_ln('DVI: postamble at ',dvi_bop_post:1); 4138dvi_back:=dvi_pointer; 4139if dvi_num<>dvi_pquad then bad_dvi; 4140if dvi_den<>dvi_pquad then bad_dvi; 4141if dvi_mag<>dvi_pquad then bad_dvi; 4142temp_int:=dvi_squad; temp_int:=dvi_squad; 4143if stack_size<dvi_upair then overflow(str_stack,stack_size); 4144temp_int:=dvi_upair; 4145dvi_first_par; 4146while cur_class=fnt_def_cl do 4147 begin dvi_do_font(false); dvi_first_par; 4148 end; 4149if cur_cmd<>post_post then bad_dvi; 4150if not selected then @<DVI: Find the starting page@>; 4151dvi_move(dvi_start); {go to first or starting page} 4152end 4153 4154@ @<DVI: Find the postamble@>= 4155temp_int:=dvi_length-5; 4156repeat if temp_int<49 then bad_dvi; 4157dvi_move(temp_int); temp_byte:=dvi_ubyte; decr(temp_int); 4158until temp_byte<>dvi_pad; 4159if temp_byte<>dvi_id then bad_dvi; 4160dvi_move(temp_int-4); if dvi_ubyte<>post_post then bad_dvi; 4161dvi_bop_post:=dvi_pointer; 4162if (dvi_bop_post<15)or(dvi_bop_post>dvi_loc-34) then bad_dvi; 4163dvi_move(dvi_bop_post); if dvi_ubyte<>post then bad_dvi 4164 4165@ @<DVI: Find the starting page@>= 4166begin dvi_start:=dvi_bop_post; {just in case} 4167while dvi_back<>-1 do 4168 begin if (dvi_back<15)or(dvi_back>dvi_bop_post-46) then bad_dvi; 4169 dvi_bop_post:=dvi_back; dvi_move(dvi_back); 4170 if dvi_ubyte<>bop then bad_dvi; 4171 for k:=0 to 9 do count[k]:=dvi_squad; 4172 if start_match then dvi_start:=dvi_bop_post; 4173 dvi_back:=dvi_pointer; 4174 end; 4175end 4176 4177@ When a |bop| has been read, the \.{DVI} commands for one page are 4178interpreted until an |eop| is found. 4179 4180@<DVI: Process one page@>= 4181begin for k:=0 to 9 do count[k]:=dvi_squad; 4182temp_int:=dvi_pointer; do_bop; 4183dvi_first_par; 4184if type_setting then @<DVI: Process a page; then |goto done|@> 4185else @<DVI: Skip a page; then |goto done|@>; 4186done:if cur_cmd<>eop then bad_dvi; 4187if selected then 4188 begin do_eop; 4189 if all_done then return; 4190 end; 4191end 4192 4193@ All \.{DVI} commands are processed, as long as |cur_class<>invalid_cl|; 4194then we should have found an |eop|. 4195 4196@<DVI: Process a page; then |goto done|@>= 4197loop begin 4198 case cur_class of 4199 char_cl: @<DVI: Typeset a |char|@>; 4200 rule_cl: 4201 if cur_upd and(cur_v_dimen=width_dimen) then 4202 do_a_width(h_pixel_round(cur_h_dimen)) 4203 else do_rule; 4204 xxx_cl: 4205 begin pckt_room(cur_parm); 4206 while cur_parm>0 do 4207 begin append_byte(dvi_ubyte); decr(cur_parm); 4208 end; 4209 do_xxx; 4210 end; 4211 push_cl: do_push; 4212 pop_cl: do_pop; 4213 five_cases(w0_cl): do_right; {|right|, |w|, or |x|} 4214 five_cases(y0_cl): do_down; {|down|, |y|, or |z|} 4215 fnt_cl: dvi_font; 4216 fnt_def_cl: dvi_do_font(random_reading); 4217 invalid_cl: goto done; 4218 othercases abort('internal error'); 4219 endcases; 4220dvi_first_par; {get the next command} 4221end 4222 4223@ While skipping a page all commands other than font definitions are 4224ignored. 4225 4226@<DVI: Skip a page; then |goto done|@>= 4227loop begin 4228 case cur_class of 4229 xxx_cl: while cur_parm>0 do 4230 begin temp_byte:=dvi_ubyte; decr(cur_parm); 4231 end; 4232 fnt_def_cl: dvi_do_font(random_reading); 4233 invalid_cl: goto done; 4234 othercases do_nothing; 4235 endcases; 4236dvi_first_par; {get the next command} 4237end 4238 4239@ @<DVI: Typeset a |char|@>= 4240begin @<Prepare to use font |cur_fnt|@>; 4241set_cur_wp(cur_fnt)(bad_dvi); 4242if font_type(cur_fnt)=vf_font_type then do_vf_packet @+ else do_char; 4243end 4244 4245@* The main program. 4246The code for real devices is still rather incomplete. 4247Moreover several branches of the program have not been tested because 4248they are never used with \.{DVI} files made by \TeX\ and \.{VF} files 4249made by \.{VPtoVF}. The same holds true for~$\Omega$. 4250 4251@ At the end of the program the output file(s) have to be finished and 4252on some systems it may be necessary to close input and\slash or output 4253files. 4254@^system dependencies@> 4255 4256@p procedure close_files_and_terminate; 4257var k:@!int_15; {general purpose index} 4258begin close_in(dvi_file); 4259if history<fatal_message then @<Finish output file(s)@>; 4260stat @<Print memory usage statistics@>;@+tats@;@/ 4261@<Close output file(s)@>@; 4262@<Print the job |history|@>; 4263end; 4264 4265@ Now we are ready to put it all together. 4266Here is where \.{\title} starts, and where it ends. 4267@^system dependencies@> 4268 4269@p begin initialize; {get all variables initialized} 4270@<Initialize predefined strings@>@; 4271dialog; {get options} 4272@<Open input file(s)@>@; 4273@<Open output file(s)@>@; 4274do_dvi; {process the entire \.{DVI} file} 4275close_files_and_terminate; 4276final_end:end. 4277 4278@ @<Print memory usage statistics@>= 4279print_ln('Memory usage statistics:'); 4280print(dvi_nf:1,' dvi, ',lcl_nf:1,' local, '); 4281@<Print more font usage statistics@>@;@/ 4282print_ln('and ',nf:1,' internal fonts of ',max_fonts:1); 4283print_ln(n_widths:1,' widths of ',max_widths:1,' for ', 4284 n_chars:1,' characters of ',max_chars:1); 4285print_ln(pckt_ptr:1,' byte packets of ',max_packets:1,' with ', 4286 byte_ptr:1,' bytes of ',max_bytes:1); 4287@<Print more memory usage statistics@>@;@/ 4288print_ln(stack_used:1,' of ',stack_size:1,' stack and ', 4289 recur_used:1,' of ',max_recursion:1,' recursion levels.') 4290 4291@ Some implementations may wish to pass the |history| value to the 4292operating system so that it can be used to govern whether or not other 4293programs are started. Here we simply report the history to the user. 4294@^system dependencies@> 4295 4296@<Print the job |history|@>= 4297case history of 4298spotless: print_ln('(No errors were found.)'); 4299harmless_message: print_ln('(Did you see the warning message above?)'); 4300error_message: print_ln('(Pardon me, but I think I spotted something wrong.)'); 4301fatal_message: print_ln('(That was a fatal error, my friend.)'); 4302end {there are no other cases} 4303 4304@* Low-level output routines. 4305The program uses the binary file variable |out_file| for its main output 4306file; |out_loc| is the number of the byte about to be written next on 4307|out_file|. 4308 4309@<Glob...@>= 4310@!out_file:byte_file; {the \.{DVI} file we are writing} 4311@!out_loc:int_32; {where we are about to write, in |out_file|} 4312@!out_back:int_32; {a back pointer} 4313@!out_max_v:int_31; {maximum |v| value so far} 4314@!out_max_h:int_31; {maximum |h| value so far} 4315@!out_stack:int_16u; {maximum stack depth} 4316@!out_pages:int_16u; {total number of pages} 4317 4318@ @<Set ini...@>= 4319out_loc:=0; out_back:=-1; 4320out_max_v:=0; out_max_h:=0; 4321out_stack:=0; out_pages:=0; 4322 4323@ To prepare |out_file| for output, we |rewrite| it. 4324 4325@<Open output file(s)@>= 4326rewrite(out_file); {prepares to write packed bytes to |out_file|} 4327 4328@ For some operating systems it may be necessary to close |out_file|. 4329 4330@<Close output file(s)@>= 4331 4332@ Writing the |out_file| should be done as efficient as possible for a 4333particular system; on many systems this means that a large number of 4334bytes will be accumulated in a buffer and is then written from that 4335buffer to |out_file|. In order to simplify such system dependent changes 4336we use the \.{WEB} macro |out_byte| to write the next \.{DVI} byte. Here 4337we give a simple minded definition for this macro in terms of standard 4338\PASCAL. 4339@^system dependencies@> 4340@^optimization@> 4341 4342@d out_byte(#) == write(out_file,#) {write next \.{DVI} byte} 4343 4344@ The \.{WEB} macro |out_one| is used to write one byte and to update 4345|out_loc|. 4346 4347@d out_one(#) == begin out_byte(#); incr(out_loc); @+ end 4348 4349@ First the |out_packet| procedure copies a packet to |out_file|. 4350 4351@<Declare typesetting procedures@>= 4352procedure out_packet(@!p:pckt_pointer); 4353var k:byte_pointer; {index into |byte_mem|} 4354begin Incr(out_loc)(pckt_length(p)); 4355for k:=pckt_start[p] to pckt_start[p+1]-1 do out_byte(bo(byte_mem[k])); 4356end; 4357 4358@ Next are the procedures used to write integer numbers or even complete 4359\.{DVI} commands to |out_file|; they all keep |out_loc| up to date. 4360 4361The |out_four| procedure outputs four bytes in two's complement notation, 4362without risking arithmetic overflow. 4363 4364@<Declare typesetting procedures@>= 4365procedure out_four(@!x:int_32); {output four bytes} 4366@!begin_four; comp_four(out_byte); Incr(out_loc)(4); 4367end; 4368 4369@ The |out_char| procedure outputs a |set_char| or \\{set} command or, if 4370|upd=false|, a |put| command. 4371 4372@<Declare typesetting procedures@>= 4373procedure out_char(@!upd:boolean;@!ext:int_32;@!res:int_32); 4374 {output \\{set} or |put|} 4375@!begin_char; comp_char(out_one); 4376end; 4377 4378@ The |out_unsigned| procedure outputs a |fnt|, |xxx|, or |fnt_def| 4379command with its first parameter (normally unsigned); a |fnt| command 4380is converted into |fnt_num| whenever this is possible. 4381 4382@<Declare typesetting procedures@>= 4383procedure out_unsigned(@!o:eight_bits;@!x:int_32); 4384 {output |fnt_num|, |fnt|, |xxx|, or |fnt_def|} 4385@!begin_unsigned; comp_unsigned(out_one); 4386end; 4387 4388@ The |out_signed| procedure outputs a movement (|right|, |w|, 4389|x|, |down|, |y|, or |z|) command with its (signed) parameter. 4390 4391@<Declare typesetting procedures@>= 4392procedure out_signed(@!o:eight_bits;@!x:int_32); 4393 {output |right|, |w|, |x|, |down|, |y|, or |z|} 4394@!begin_signed; comp_signed(out_one); 4395end; 4396 4397@ For an output font we set |font_type(f):=out_font_type|; in this case 4398|font_font(f)| is the font number used for font~|f| in |out_file|. 4399@^font types@> 4400 4401The global variable |out_nf| is the number of fonts already used in 4402|out_file| and the array |out_fnts| contains their internal font numbers; 4403the current font in |out_file| is called |out_fnt|. 4404 4405@<Glob...@>= 4406@!out_fnts:array[font_number] of font_number; {internal font numbers} 4407@!out_nf:font_number; {number of fonts used in |out_file|} 4408@!out_fnt:font_number; {internal font number of current output font} 4409 4410@ @<Set init...@>= 4411out_nf:=0; 4412 4413@ @<Print more font usage statistics@>= 4414print(out_nf:1,' out, '); 4415 4416@ The |out_fnt_def| procedure outputs a complete font definition 4417command. 4418 4419@<Declare typesetting procedures@>= 4420procedure out_fnt_def(@!f:font_number); 4421var p:pckt_pointer; {the font name packet} 4422@!k,@!l:byte_pointer; {indices into |byte_mem|} 4423@!a:eight_bits; {length of area part} 4424begin out_unsigned(fnt_def1,font_font(f)); out_four(font_check(f)); 4425out_four(font_scaled(f)); out_four(font_design(f));@/ 4426p:=font_name(f); k:=pckt_start[p]; l:=pckt_start[p+1]-1; 4427a:=bo(byte_mem[k]);@/ 4428Incr(out_loc)(l-k+2); out_byte(a); out_byte(l-k-a); 4429while k<l do 4430 begin incr(k); out_byte(bo(byte_mem[k])); 4431 end; 4432end; 4433 4434@* Writing the output file. 4435Here we define the device dependent parts of the typesetting routines 4436described earlier in this program. 4437 4438First we define a few quantities required by the device dependent code 4439for a real output device in order to demonstrate how they might be 4440defined and in order to be able to compile \.{DVIcopy} with the device 4441dependent code included. 4442 4443@d h_resolution==300 {horizontal resolution in pixels per inch (dpi)} 4444@d v_resolution==300 {vertical resolution in pixels per inch (dpi)} 4445 4446@d max_h_drift==2 {we insist that |abs(hh-h_pixel_round(h))<=max_h_drift|} 4447@d max_v_drift==2 {we insist that |abs(vv-v_pixel_round(v))<=max_v_drift|} 4448 4449@<Glob...@>= 4450@!device 4451@!h_conv:real; {converts \.{DVI} units to horizontal pixels} 4452@!v_conv:real; {converts \.{DVI} units to vertical pixels} 4453ecived 4454 4455@ These are the local variables (if any) needed for |do_pre|. 4456 4457@<OUT: Declare local variables (if any) for |do_pre|@>= 4458var k:int_15; {general purpose variable} 4459@!p,@!q,@!r:byte_pointer; {indices into |byte_mem|} 4460@!comment:packed array[1..comm_length] of char; {preamble comment prefix} 4461 4462@ And here is the device dependent code for |do_pre|; the \.{DVI} preamble 4463comment written to |out_file| is similar to the one produced by \.{GFtoPK}, 4464but we want to apply our preamble comment prefix only once. 4465 4466@<OUT: Process the |pre|@>= 4467out_one(pre); out_one(dvi_id); 4468out_four(dvi_num); out_four(dvi_den); out_four(out_mag);@/ 4469p:=pckt_start[pckt_ptr-1]; q:=byte_ptr; {location of old \.{DVI} comment} 4470comment:=preamble_comment; pckt_room(comm_length); 4471for k:=1 to comm_length do append_byte(xord[comment[k]]); 4472while byte_mem[p]=bi(" ") do incr(p); {remove leading blanks} 4473if p=q then Decr(byte_ptr)(from_length) 4474else begin k:=0; 4475 while (k<comm_length)and(byte_mem[p+k]=byte_mem[q+k]) do incr(k); 4476 if k=comm_length then Incr(p)(comm_length); 4477 end; 4478k:=byte_ptr-p; {total length} 4479if k>255 then 4480 begin k:=255; q:=p+255-comm_length; {at most 255 bytes} 4481 end; 4482out_one(k); out_packet(new_packet); flush_packet; 4483for r:=p to q-1 do out_one(bo(byte_mem[r])); 4484 4485@ These are the additional local variables (if any) needed for |do_bop|; 4486the variables |@!i| and |@!j| are already declared. 4487 4488@<OUT: Declare additional local variables |do_bop|@>= 4489var 4490 4491@ And here is the device dependent code for |do_bop|. 4492 4493@<OUT: Process a |bop|@>= 4494out_one(bop); incr(out_pages); 4495for i:=0 to 9 do out_four(count[i]); 4496out_four(out_back); out_back:=out_loc-45; 4497out_fnt:=invalid_font; 4498 4499@ These are the local variables (if any) needed for |do_eop|. 4500 4501@<OUT: Declare local variables (if any) for |do_eop|@>= 4502 4503@ And here is the device dependent code for |do_eop|. 4504 4505@<OUT: Process an |eop|@>= 4506out_one(eop); 4507 4508@ These are the local variables (if any) needed for |do_push|. 4509 4510@<OUT: Declare local variables (if any) for |do_push|@>= 4511 4512@ And here is the device dependent code for |do_push|. 4513 4514@<OUT: Process a |push|@>= 4515if stack_ptr>out_stack then out_stack:=stack_ptr; 4516out_one(push); 4517 4518@ These are the local variables (if any) needed for |do_pop|. 4519 4520@<OUT: Declare local variables (if any) for |do_pop|@>= 4521 4522@ And here is the device dependent code for |do_pop|. 4523 4524@<OUT: Process a |pop|@>= 4525out_one(pop); 4526 4527@ These are the additional local variables (if any) needed for |do_xxx|; 4528the variable |@!p|, the pointer to the packet containing the special 4529string, is already declared. 4530 4531@<OUT: Declare additional local variables for |do_xxx|@>= 4532var 4533 4534@ And here is the device dependent code for |do_xxx|. 4535 4536@<OUT: Process an |xxx|@>= 4537out_unsigned(xxx1,pckt_length(p)); out_packet(p); 4538 4539@ These are the local variables (if any) needed for |do_right|. 4540 4541@<OUT: Declare local variables (if any) for |do_right|@>= 4542 4543@ And here is the device dependent code for |do_right|. 4544 4545@<OUT: Process a |right| or |w| or |x|@>= 4546if cur_class<right_cl then out_one(cur_cmd) {|w0| or |x0|} 4547else out_signed(dvi_right_cmd[cur_class],cur_parm); {|right|, |w|, or |x|} 4548 4549@ Here we update the |out_max_h| value. 4550 4551@<OUT: Move right@>= 4552if abs(cur_h)>out_max_h then out_max_h:=abs(cur_h); 4553 4554@ These are the local variables (if any) needed for |do_down|. 4555 4556@<OUT: Declare local variables (if any) for |do_down|@>= 4557 4558@ And here is the device dependent code for |do_down|. 4559 4560@<OUT: Process a |down| or |y| or |z|@>= 4561if cur_class<down_cl then out_one(cur_cmd) {|y0| or |z0|} 4562else out_signed(dvi_down_cmd[cur_class],cur_parm); {|down|, |y|, or |z|} 4563 4564@ Here we update the |out_max_v| value. 4565 4566@<OUT: Move down@>= 4567if abs(cur_v)>out_max_v then out_max_v:=abs(cur_v); 4568 4569@ These are the local variables (if any) needed for |do_width|. 4570 4571@<OUT: Declare local variables (if any) for |do_width|@>= 4572 4573@ And here is the device dependent code for |do_width|. 4574 4575@<OUT: Typeset a |width|@>= 4576out_one(set_rule); 4577out_four(width_dimen); out_four(cur_h_dimen); 4578 4579@ These are the additional local variables (if any) needed for |do_rule|; 4580the variable |@!visible| is already declared. 4581 4582@<OUT: Declare additional local variables |do_rule|@>= 4583var 4584 4585@ And here is the device dependent code for |do_rule|. 4586 4587@<OUT: Typeset a visible |rule|@>= 4588out_one(dvi_rule_cmd[cur_upd]); 4589out_four(cur_v_dimen); out_four(cur_h_dimen); 4590 4591@ @<OUT: Typeset an invisible |rule|@>= 4592@<OUT: Typeset a visible |rule|@> 4593 4594@ These are the additional local variables (if any) needed for |do_font|; 4595the variable |@!p| is already declared. 4596 4597@<OUT: Declare additional local variables for |do_font|@>= 4598var 4599 4600@ And here is the device dependent code for |do_font|; if the \.{VF} file 4601for a font could not be found, we simply assume this must be a real font. 4602 4603@<OUT: Look for a font file before trying to read the \.{VF} file; 4604 if found |goto done|@>= 4605 4606@ @<OUT: Look for a font file after trying to read the \.{VF} file@>= 4607if(out_nf>=max_fonts) then overflow(str_fonts,max_fonts); 4608print('OUT: font ',cur_fnt:1); d_print(' => ',out_nf:1); 4609print_font(cur_fnt); 4610d_print(' at ',font_scaled(cur_fnt):1,' DVI units'); print_ln('.'); 4611font_type(cur_fnt):=out_font_type; font_font(cur_fnt):=out_nf; 4612out_fnts[out_nf]:=cur_fnt; incr(out_nf); 4613out_fnt_def(cur_fnt); 4614 4615@ And here is some device dependent code used before each character. 4616 4617@<OUT: Prepare to use font |cur_fnt|@>= 4618 4619@ These are the local variables (if any) needed for |do_char|. 4620 4621@<OUT: Declare local variables (if any) for |do_char|@>= 4622 4623@ And here is the device dependent code for |do_char|. 4624 4625@<OUT: Typeset a |char|@>= 4626@!debug if font_type(cur_fnt)<>out_font_type then confusion(str_fonts); 4627gubed @; 4628if cur_fnt<>out_fnt then 4629 begin out_unsigned(fnt1,font_font(cur_fnt)); out_fnt:=cur_fnt; 4630 end; 4631out_char(cur_upd,cur_ext,cur_res); 4632 4633@ If the program terminates in the middle of a page, we write as many 4634|pop|s as necessary and one |eop|. 4635 4636@<OUT: Finish incomplete page@>= 4637begin while stack_ptr>0 do 4638 begin out_one(pop); decr(stack_ptr); 4639 end; 4640 out_one(eop); 4641end 4642 4643@ If the output file has been started, we write the postamble; in 4644addition we print the number of bytes and pages written to |out_file|. 4645 4646@<OUT: Finish output file(s)@>= 4647if out_loc>0 then 4648 begin @<OUT: Write the postamble@>; 4649 k:=7-((out_loc-1) mod 4); {the number of |dvi_pad| bytes} 4650 while k>0 do 4651 begin out_one(dvi_pad); decr(k); 4652 end; 4653 print('OUT file: ',out_loc:1,' bytes, ',out_pages:1,' page'); 4654 if out_pages<>1 then print('s'); 4655 end 4656else print('OUT file: no output'); 4657print_ln(' written.'); 4658if out_pages=0 then mark_harmless; 4659 4660@ Here we simply write the values accumulated during the \.{DVI} output. 4661 4662@<OUT: Write the postamble@>= 4663out_one(post); out_four(out_back); out_back:=out_loc-5;@/ 4664out_four(dvi_num); out_four(dvi_den); out_four(out_mag);@/ 4665out_four(out_max_v); out_four(out_max_h);@/ 4666out_one(out_stack div @"100); out_one(out_stack mod @"100);@/ 4667out_one(out_pages div @"100); out_one(out_pages mod @"100);@/ 4668k:=out_nf; 4669while k>0 do 4670 begin decr(k); out_fnt_def(out_fnts[k]); 4671 end; 4672out_one(post_post); out_four(out_back);@/ 4673out_one(dvi_id) 4674 4675@ Here we could print more memory usage statistics; this possibility is, 4676however, not used for \.{DVIcopy}. 4677 4678@<Print more memory usage statistics@>= 4679 4680@* System-dependent changes. 4681This section should be replaced, if necessary, by changes to the program 4682that are necessary to make \.{DVIcopy} work at a particular installation. 4683It is usually best to design your change file so that all changes to 4684previous sections preserve the section numbering; then everybody's version 4685will be consistent with the printed program. More extensive changes, 4686which introduce new sections, can be inserted here; then only the index 4687itself will get a new section number. 4688@^system dependencies@> 4689 4690@* Index. 4691Pointers to error messages appear here together with the section numbers 4692where each ident\-i\-fier is used. 4693