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