diff options
author | Denis Bitouzé <dbitouze@wanadoo.fr> | 2021-02-25 18:23:07 +0000 |
---|---|---|
committer | Denis Bitouzé <dbitouze@wanadoo.fr> | 2021-02-25 18:23:07 +0000 |
commit | c6101f91d071883b48b1b4b51e5eba0f36d9a78d (patch) | |
tree | 1bf7f5a881d7a4f5c5bf59d0b2821943dd822372 /Build/source/texk/web2c/dvicopy.web | |
parent | 07ee7222e389b0777456b427a55c22d0e6ffd267 (diff) |
French translation for tlmgr updated
git-svn-id: svn://tug.org/texlive/trunk@57912 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Build/source/texk/web2c/dvicopy.web')
-rw-r--r-- | Build/source/texk/web2c/dvicopy.web | 4491 |
1 files changed, 0 insertions, 4491 deletions
diff --git a/Build/source/texk/web2c/dvicopy.web b/Build/source/texk/web2c/dvicopy.web deleted file mode 100644 index f3e74ea38cc..00000000000 --- a/Build/source/texk/web2c/dvicopy.web +++ /dev/null @@ -1,4491 +0,0 @@ -% Uncopyrightable trivial changes, 2018 Karl Berry (karl@@freefriends.org) -% Copyright (C) 1990--2014 Peter Breitenlohner (peb@@mppmu.mpg.de) -% -% This program is free software; you can redistribute it and/or modify -% it under the terms of the GNU General Public License as published by -% the Free Software Foundation; either version 1, or (at your option) -% any later version. -% -% You should have received a copy of the GNU General Public License -% along with this program. If not, see <http://www.gnu.org/licenses/>. -% -% Version 0.9 was finished May 21, 1990. -% Version 1.0 pixel rounding for real devices (August 6, 1990). -% Version 1.1 major rearrangements for DVIprint (October 7, 1990). -% Version 1.2 fixed some bugs, page selection (February 13, 1991). -% Version 1.3 several more changes, command line options, -% don't load fonts that are never used (August 25, 1992). -% Version 1.4 fixed a typo (March 28, 1995). -% Version 1.5 avoided cur_name_length identifier conflict (October 15, 1995). -% Version 1.6 minor cleanup: avoid unused or uninitialized variables, -% diagnose impossible cases (September 2009). -% bug fix (not for Web2C) and some typos (May 2014) -% from Udo Wermuth (u.wermuth@@icloud.com). -% 17 July 2018, still version 1.6: typos corrected, no code changes. - -% Here is TeX material that gets inserted after \input webmac -\def\hang{\hangindent 3em\indent\ignorespaces} -\font\ninerm=cmr9 -\let\mc=\ninerm % medium caps for names like SAIL -\def\PASCAL{Pascal} -\font\logo=manfnt % font used for the METAFONT logo -\def\MF{{\logo META}\-{\logo FONT}} -\mathchardef\RA="3221 % right arrow - -\def\(#1){} % this is used to make section names sort themselves better -\def\9#1{} % this is used for sort keys in the index - -\def\title{DVI\lowercase{copy}} % don't change this line! -\def\contentspagenumber{1} -\def\topofcontents{\null - \titlefalse % include headline on the contents page - \def\rheader{\mainfont\hfil \contentspagenumber} - \vfill - \centerline{\titlefont The {\ttitlefont DVIcopy} processor} - \vskip 5pt - \centerline{Copyright (C) 1990--2014 Peter Breitenlohner} - \centerline{Distributed under terms of GNU General Public License} - \vskip 15pt - \centerline{(Version 1.6, September 2009)} - \vfill} -\def\botofcontents{\vfill - \centerline{\hsize 5in\baselineskip9pt - \vbox{\ninerm\noindent - This program was developed at the Max-Planck-Institut f\"ur Physik - (Werner-Heisenberg-Institut), Munich, Germany. - `\TeX' is a trademark of the American Mathematical Society. - `{\logo hijklmnj}\kern1pt' is a trademark of Addison-Wesley - Publishing Company.}}} -\pageno=\contentspagenumber \advance\pageno by 1 - -@* Introduction. -The \.{DVIcopy} utility program copies (selected pages of) binary -device-independent (``\.{DVI}'') files that are produced by document -compilers such as \TeX, and replaces all references to characters from -virtual fonts by the typesetting instructions specified for them in -binary virtual-font (``\.{VF}'') files. -This program has two chief purposes: (1)~It can be used as preprocessor -for existing \.{DVI}-related software in cases where this software is -unable to handle virtual fonts or (given suitable \.{VF} files) where -this software cannot handle fonts with more than 128~characters; -and (2)~it serves as an example of a program that reads \.{DVI} and -\.{VF} files correctly, for system programmers who are developing -\.{DVI}-related software. - -Goal number (1) is important since quite a few existing programs have -to be adapted to the extended capabilities of Version~3 of \TeX\ which -will require some time. Moreover some existing programs are `as is' and -the source code is, unfortunately, not available. -Goal number (2) needs perhaps a bit more explanation. Programs for -typesetting need to be especially careful about how they do arithmetic; if -rounding errors accumulate, margins won't be straight, vertical rules -won't line up, and so on (see the documentation of \.{DVItype} for more -details). This program is written as if it were a \.{DVI}-driver for a -hypothetical typesetting device |out_file|, the output file receiving -the copy of the input |dvi_file|. In addition all code related to -|out_file| is concentrated in two chapters at the end of this program -and quite independent of the rest of the code concerned with the -decoding of \.{DVI} and \.{VF} files and with font substitutions. Thus -it should be relatively easy to replace the device dependent code of -this program by the corresponding code required for a real typesetting -device. Having this in mind \.{DVItype}'s pixel rounding algorithms are -included as conditional code not used by \.{DVIcopy}. - -The |banner| and |preamble_comment| strings defined here should be -changed whenever \.{DVIcopy} gets modified. - -@d banner=='This is DVIcopy, Version 1.6' {printed when the program starts} -@d title=='DVIcopy' {the name of this program, used in some messages} -@d copyright=='Copyright (C) 1990,2009 Peter Breitenlohner' -@# -@d preamble_comment=='DVIcopy 1.6 output from ' -@d comm_length=24 {length of |preamble_comment|} -@d from_length=6 {length of its |' from '| part} - -@ This program is written in standard \PASCAL, except where it is necessary -to use extensions; for example, \.{DVIcopy} must read files whose names -are dynamically specified, and that would be impossible in pure \PASCAL. -All places where nonstandard constructions are used have been listed in -the index under ``system dependencies.'' -@!@^system dependencies@> - -One of the extensions to standard \PASCAL\ that we shall deal with is the -ability to move to a random place in a binary file; another is to -determine the length of a binary file. Such extensions are not necessary -for reading \.{DVI} files; since \.{DVIcopy} is (a model for) a -production program it should, however, be made as efficient as possible -for a particular system. If \.{DVIcopy} is being used with -\PASCAL s for which random file positioning is not efficiently available, -the following definition should be changed from |true| to |false|; in such -cases, \.{DVIcopy} will not include the optional feature that reads the -postamble first. - -@d random_reading==true {should we skip around in the file?} - -@ The program begins with a fairly normal header, made up of pieces that -@^system dependencies@> -will mostly be filled in later. The \.{DVI} input comes from file -|dvi_file|, the \.{DVI} output goes to file |out_file|, and messages -go to \PASCAL's standard |output| file. -The \.{TFM} and \.{VF} files are defined later since their external -names are determined dynamically. - -If it is necessary to abort the job because of a fatal error, the program -calls the `|jump_out|' procedure, which goes to the label |final_end|. - -@d final_end = 9999 {go here to wrap it up} - -@p @t\4@>@<Compiler directives@>@/ -program DVI_copy(@!dvi_file,@!out_file,@!output); -label final_end; -const @<Constants in the outer block@>@/ -type @<Types in the outer block@>@/ -var @<Globals in the outer block@>@/ -@<Error handling procedures@>@/ -procedure initialize; {this procedure gets things started properly} - var @<Local variables for initialization@>@/ - begin print_ln(banner);@/ - print_ln(copyright); - print_ln('Distributed under terms of GNU General Public License');@/ - @<Set initial values@>@/ - end; - -@ The definition of |max_font_type| should be adapted to the number of -font types used by the program; the first three values have a fixed -meaning: |defined_font=0| indicates that a font has been defined, -|loaded_font=1| indicates that the \.{TFM} file has been loaded but the -font has not yet been used, and |vf_font_type=2| indicates a virtual -font. Font type values |>=real_font=3| indicate real fonts and -different font types are used to distinguish various kinds of font files -(\.{GF} or \.{PK} or \.{PXL}). \.{DVIcopy} uses |out_font_type=3| for -fonts that appear in the output \.{DVI} file. -@!@^font types@> - -@d defined_font=0 {this font has been defined} -@d loaded_font=1 {this font has been defined and loaded} -@d vf_font_type=2 {this font is a virtual font} -@d real_font=3 {smallest font type for real fonts} -@# -@d out_font_type=3 {this font appears in the output file} -@d max_font_type=3 - -@ The following parameters can be changed at compile time to extend or -reduce \.{DVIcopy}'s capacity. - -@d max_select=10 {maximum number of page selection ranges} - -@<Constants...@>= -@!max_fonts=100; {maximum number of distinct fonts} -@!max_chars=10000; {maximum number of different characters among all fonts} -@!max_widths=3000; {maximum number of different characters widths} -@!max_packets=5000; {maximum number of different characters packets; - must be less than 65536} -@!max_bytes=30000; {maximum number of bytes for characters packets} -@!max_recursion=10; {\.{VF} files shouldn't recurse beyond this level} -@!stack_size=100; {\.{DVI} files shouldn't |push| beyond this depth} -@!terminal_line_length=150; {maximum number of characters input in a single - line of input from the terminal} -@!name_length=50; {a file name shouldn't be longer than this} - -@ As mentioned above, \.{DVIcopy} has two chief purposes: (1)~It produces -a copy of the input \.{DVI} file with all references to characters from -virtual fonts replaced by their expansion as specified in the character -packets of \.{VF} files; and (2)~it serves as an example of a program -that reads \.{DVI} and \.{VF} files correctly, for system programmers -who are developing \.{DVI}-related software. - -In fact, a very large section of code (starting with the second chapter -`Introduction (continued)' and ending with the fifteenth chapter -`The main program') is used in identical form in \.{DVIcopy} and in -\.{DVIprint}, a prototype \.{DVI}-driver. This has been made possible -mostly by using several \.{WEB} coding tricks, such as not to make the -resulting \PASCAL\ program inefficient in any way. - -Parts of the program that are needed in \.{DVIprint} but not in -\.{DVIcopy} are delimited by the code words `$|device|\ldots|ecived|$'; -these are mostly the pixel rounding algorithms used to convert the -\.{DVI} units of a \.{DVI} file to the raster units of a real output -device and have been copied more or less verbatim from \.{DVItype}. - -@d device==@{ {change this to `$\\{device}\equiv\null$' when output - for a real device is produced} -@d ecived==@t@>@} {change this to `$\\{ecived}\equiv\null$' when output - for a real device is produced} -@f device==begin -@f ecived==end - -@* Introduction (continued). -On some systems it is necessary to use various integer subrange types -in order to make \.{\title} efficient; this is true in particular for -frequently used variables such as loop indices. Consider an integer -variable |x| with values in the range |0..255|: on most small systems -|x| should be a one or two byte integer whereas on most large systems -|x| should be a four byte integer. -Clearly the author of a program knows best which range of values is -required for each variable; thus \.{\title} never uses \PASCAL's |integer| -type. All integer variables are declared as one of the integer subrange -types defined below as \.{WEB} macros or \PASCAL\ types; these definitions -can be used without system-dependent changes, provided the signed 32~bit -integers are a subset of the standard type |integer|, and the compiler -automatically uses the optimal representation for integer subranges -(both conditions need not be satisfied for a particular system). -@^system dependencies@> - -The complementary problem of storing large arrays of integer type -variables as compactly as possible is addressed differently; here -\.{\title} uses a \PASCAL\ |type|~declaration for each kind of array -element. - -Note that the primary purpose of these definitions is optimizations, not -range checking. All places where optimization for a particular system is -highly desirable have been listed in the index under ``optimization.'' -@!@^optimization@> - -@d int_32 == integer {signed 32~bit integers} - -@<Types...@>= -@!int_31 = 0..@"7FFFFFFF; {unsigned 31~bit integer} -@!int_24u = 0..@"FFFFFF; {unsigned 24~bit integer} -@!int_24 = -@"800000..@"7FFFFF; {signed 24~bit integer} -@!int_23 = 0..@"7FFFFF; {unsigned 23~bit integer} -@!int_16u = 0..@"FFFF; {unsigned 16~bit integer} -@!int_16 = -@"8000..@"7FFF; {signed 16~bit integer} -@!int_15 = 0..@"7FFF; {unsigned 15~bit integer} -@!int_8u = 0..@"FF; {unsigned 8~bit integer} -@!int_8 = -@"80..@"7F; {signed 8~bit integer} -@!int_7 = 0..@"7F; {unsigned 7~bit integer} - -@ Some of this code is optional for use when debugging only; -such material is enclosed between the delimiters |debug| and $|gubed|$. -Other parts, delimited by |stat| and $|tats|$, are optionally included -if statistics about \.{\title}'s memory usage are desired. - -@d debug==@{ {change this to `$\\{debug}\equiv\null$' when debugging} -@d gubed==@t@>@} {change this to `$\\{gubed}\equiv\null$' when debugging} -@f debug==begin -@f gubed==end -@# -@d stat==@{ {change this to `$\\{stat}\equiv\null$' - when gathering usage statistics} -@d tats==@t@>@} {change this to `$\\{tats}\equiv\null$' - when gathering usage statistics} -@f stat==begin -@f tats==end - -@ The \PASCAL\ compiler used to develop this program has ``compiler -directives'' that can appear in comments whose first character is a dollar sign. -In production versions of \.{\title} these directives tell the compiler that -@^system dependencies@> -it is safe to avoid range checks and to leave out the extra code it inserts -for the \PASCAL\ debugger's benefit, although interrupts will occur if -there is arithmetic overflow. - -@<Compiler directives@>= -@{@&$C-,A+,D-@} {no range check, catch arithmetic overflow, no debug overhead} -@!debug @{@&$C+,D+@}@+ gubed {but turn everything on when debugging} - -@ Labels are given symbolic names by the following definitions. We insert -the label `|exit|:' just before the `\ignorespaces|end|\unskip' of a -procedure in which we have used the `|return|' statement defined below; -the label `|restart|' is occasionally used at the very beginning of a -procedure; and the label `|reswitch|' is occasionally used just prior to -a \&{case} statement in which some cases change the conditions and we wish to -branch to the newly applicable case. -Loops that are set up with the \&{loop} construction defined below are -commonly exited by going to `|done|' or to `|found|' or to `|not_found|', -and they are sometimes repeated by going to `|continue|'. - -@d exit=10 {go here to leave a procedure} -@d restart=20 {go here to start a procedure again} -@d reswitch=21 {go here to start a case statement again} -@d continue=22 {go here to resume a loop} -@d done=30 {go here to exit a loop} -@d found=31 {go here when you've found it} -@d not_found=32 {go here when you've found something else} - -@ The term |print| is used instead of |write| when this program writes on -|output|, so that all such output could easily be redirected if desired; -the term |d_print| is used for conditional output if we are debugging. - -@d print(#)==write(output,#) -@d print_ln(#)==write_ln(output,#) -@d new_line==write_ln(output) {start new line} -@d print_nl(#)== {print information starting on a new line} - begin new_line; print(#); - end -@# -@d d_print(#)==@!debug print(#) @; @+ gubed -@d d_print_ln(#)==@! debug print_ln(#) @; @+ gubed - -@ Here are some macros for common programming idioms. - -@d incr(#) == #:=#+1 {increase a variable by unity} -@d decr(#) == #:=#-1 {decrease a variable by unity} -@# -@d Incr_Decr_end(#)==# -@d Incr(#)==#:=#+Incr_Decr_end {we use |Incr(a)(b)| to increase \dots} -@d Decr(#)==#:=#-Incr_Decr_end {\dots\ and |Decr(a)(b)| to decrease - variable |a| by |b|; this can be optimized for some compilers} -@# -@d loop == @+ while true do@+ {repeat over and over until a |goto| happens} -@d do_nothing == {empty statement} -@d return == goto exit {terminate a procedure call} -@f return == nil -@f loop == xclause - -@ We assume that |case| statements may include a default case that applies -if no matching label is found. Thus, we shall use constructions like -@^system dependencies@> -$$\vbox{\halign{#\hfil\cr -|case x of|\cr -1: $\langle\,$code for $x=1\,\rangle$;\cr -3: $\langle\,$code for $x=3\,\rangle$;\cr -|othercases| $\langle\,$code for |x<>1| and |x<>3|$\,\rangle$\cr -|endcases|\cr}}$$ -since most \PASCAL\ compilers have plugged this hole in the language by -incorporating some sort of default mechanism. For example, the compiler -used to develop \.{WEB} and \TeX\ allows `|others|:' as a default label, -and other \PASCAL s allow syntaxes like `\ignorespaces|else|\unskip' or -`\&{otherwise}' or `\\{otherwise}:', etc. The definitions of |othercases| -and |endcases| should be changed to agree with local conventions. (Of -course, if no default mechanism is available, the |case| statements of -this program must be extended by listing all remaining cases. -Donald~E. Knuth, the author of the \.{WEB} system program \.{TANGLE}, -@^Knuth, Donald Ervin@> -would have taken the trouble to modify \.{TANGLE} so that such extensions -were done automatically, if he had not wanted to encourage \PASCAL\ -compiler writers to make this important change in \PASCAL, where it belongs.) - -@d othercases == others: {default for cases not listed explicitly} -@d endcases == @+end {follows the default case in an extended |case| statement} -@f othercases == else -@f endcases == end - -@* The character set. -Like all programs written with the \.{WEB} system, \.{\title} can be -used with any character set. But it uses ASCII code internally, because -the programming for portable input-output is easier when a fixed internal -code is used, and because \.{DVI} and \.{VF} files use ASCII code for -file names and certain other strings. - -The next few sections of \.{\title} have therefore been copied from the -analogous ones in the \.{WEB} system routines. They have been considerably -simplified, since \.{\title} need not deal with the controversial -ASCII codes less than @'40 or greater than @'176. -If such codes appear in the \.{DVI} file, -they will be printed as question marks. - -@<Types...@>= -@!ASCII_code=" ".."~"; {a subrange of the integers} - -@ The original \PASCAL\ compiler was designed in the late 60s, when six-bit -character sets were common, so it did not make provision for lower case -letters. Nowadays, of course, we need to deal with both upper and lower case -alphabets in a convenient way, especially in a program like \.{\title}. -So we shall assume that the \PASCAL\ system being used for \.{\title} -has a character set containing at least the standard visible characters -of ASCII code (|"!"| through |"~"|). - -Some \PASCAL\ compilers use the original name |char| for the data type -associated with the characters in text files, while other \PASCAL s -consider |char| to be a 64-element subrange of a larger data type that has -some other name. In order to accommodate this difference, we shall use -the name |text_char| to stand for the data type of the characters in the -output file. We shall also assume that |text_char| consists of -the elements |chr(first_text_char)| through |chr(last_text_char)|, -inclusive. The following definitions should be adjusted if necessary. -@^system dependencies@> - -@d text_char == char {the data type of characters in text files} -@d first_text_char=0 {ordinal number of the smallest element of |text_char|} -@d last_text_char=127 {ordinal number of the largest element of |text_char|} - -@<Types...@>= -@!text_file=packed file of text_char; - -@ @<Local variables for init...@>= -@!i:int_16; {loop index for initializations} - -@ The \.{\title} processor converts between ASCII code and -the user's external character set by means of arrays |xord| and |xchr| -that are analogous to \PASCAL's |ord| and |chr| functions. - -@<Globals...@>= -@!xord: array [text_char] of ASCII_code; - {specifies conversion of input characters} -@!xchr: array [0..255] of text_char; - {specifies conversion of output characters} - -@ Under our assumption that the visible characters of standard ASCII are -all present, the following assignment statements initialize the -|xchr| array properly, without needing any system-dependent changes. - -@<Set init...@>= -for i:=0 to @'37 do xchr[i]:='?'; -xchr[@'40]:=' '; -xchr[@'41]:='!'; -xchr[@'42]:='"'; -xchr[@'43]:='#'; -xchr[@'44]:='$'; -xchr[@'45]:='%'; -xchr[@'46]:='&'; -xchr[@'47]:='''';@/ -xchr[@'50]:='('; -xchr[@'51]:=')'; -xchr[@'52]:='*'; -xchr[@'53]:='+'; -xchr[@'54]:=','; -xchr[@'55]:='-'; -xchr[@'56]:='.'; -xchr[@'57]:='/';@/ -xchr[@'60]:='0'; -xchr[@'61]:='1'; -xchr[@'62]:='2'; -xchr[@'63]:='3'; -xchr[@'64]:='4'; -xchr[@'65]:='5'; -xchr[@'66]:='6'; -xchr[@'67]:='7';@/ -xchr[@'70]:='8'; -xchr[@'71]:='9'; -xchr[@'72]:=':'; -xchr[@'73]:=';'; -xchr[@'74]:='<'; -xchr[@'75]:='='; -xchr[@'76]:='>'; -xchr[@'77]:='?';@/ -xchr[@'100]:='@@'; -xchr[@'101]:='A'; -xchr[@'102]:='B'; -xchr[@'103]:='C'; -xchr[@'104]:='D'; -xchr[@'105]:='E'; -xchr[@'106]:='F'; -xchr[@'107]:='G';@/ -xchr[@'110]:='H'; -xchr[@'111]:='I'; -xchr[@'112]:='J'; -xchr[@'113]:='K'; -xchr[@'114]:='L'; -xchr[@'115]:='M'; -xchr[@'116]:='N'; -xchr[@'117]:='O';@/ -xchr[@'120]:='P'; -xchr[@'121]:='Q'; -xchr[@'122]:='R'; -xchr[@'123]:='S'; -xchr[@'124]:='T'; -xchr[@'125]:='U'; -xchr[@'126]:='V'; -xchr[@'127]:='W';@/ -xchr[@'130]:='X'; -xchr[@'131]:='Y'; -xchr[@'132]:='Z'; -xchr[@'133]:='['; -xchr[@'134]:='\'; -xchr[@'135]:=']'; -xchr[@'136]:='^'; -xchr[@'137]:='_';@/ -xchr[@'140]:='`'; -xchr[@'141]:='a'; -xchr[@'142]:='b'; -xchr[@'143]:='c'; -xchr[@'144]:='d'; -xchr[@'145]:='e'; -xchr[@'146]:='f'; -xchr[@'147]:='g';@/ -xchr[@'150]:='h'; -xchr[@'151]:='i'; -xchr[@'152]:='j'; -xchr[@'153]:='k'; -xchr[@'154]:='l'; -xchr[@'155]:='m'; -xchr[@'156]:='n'; -xchr[@'157]:='o';@/ -xchr[@'160]:='p'; -xchr[@'161]:='q'; -xchr[@'162]:='r'; -xchr[@'163]:='s'; -xchr[@'164]:='t'; -xchr[@'165]:='u'; -xchr[@'166]:='v'; -xchr[@'167]:='w';@/ -xchr[@'170]:='x'; -xchr[@'171]:='y'; -xchr[@'172]:='z'; -xchr[@'173]:='{'; -xchr[@'174]:='|'; -xchr[@'175]:='}'; -xchr[@'176]:='~'; -for i:=@'177 to 255 do xchr[i]:='?'; - -@ The following system-independent code makes the |xord| array contain a -suitable inverse to the information in |xchr|. - -@<Set init...@>= -for i:=first_text_char to last_text_char do xord[chr(i)]:=@'40; -for i:=" " to "~" do xord[xchr[i]]:=i; - -@* Reporting errors to the user. -The \.{\title} processor does not verify that every single bit read from -one of its binary input files is meaningful and consistent; there are -other programs, e.g., \.{DVItype}, \.{TFtoPL}, and \.{VFtoPL}, specially -designed for that purpose. - -On the other hand, \.{\title} is designed to avoid unpredictable results -due to undetected arithmetic overflow, or due to violation of integer -subranges or array bounds under {\it all\/} circumstances. Thus a fair -amount of checking is done when reading and analyzing the input data, -even in cases where such checking reduces the efficiency of the program -to some extent. - -@ A global variable called |history| will contain one of four values -at the end of every run: |spotless| means that no unusual messages were -printed; |harmless_message| means that a message of possible interest -was printed but no serious errors were detected; |error_message| means that -at least one error was found; |fatal_message| means that the program -terminated abnormally. The value of |history| does not influence the -behavior of the program; it is simply computed for the convenience -of systems that might want to use such information. - -@d spotless=0 {|history| value for normal jobs} -@d harmless_message=1 {|history| value when non-serious info was printed} -@d error_message=2 {|history| value when an error was noted} -@d fatal_message=3 {|history| value when we had to stop prematurely} -@# -@d mark_harmless==@t@>@+if history=spotless then history:=harmless_message -@d mark_error==history:=error_message -@d mark_fatal==history:=fatal_message - -@<Glob...@>=@!history:spotless..fatal_message; {how bad was this run?} - -@ @<Set init...@>=history:=spotless; - -@ If an input (\.{DVI}, \.{TFM}, \.{VF}, or other) file is badly malformed, -the whole process must be aborted; \.{\title} will give up, after issuing -an error message about what caused the error. These messages will, however, -in most cases just indicate which input file caused the error. One of the -programs \.{DVItype}, \.{TFtoPL}, or \.{VFtoVP} should then be used to -diagnose the error in full detail. - -Such errors might be discovered inside of subroutines inside of subroutines, -so a procedure called |jump_out| has been introduced. This procedure, which -transfers control to the label |final_end| at the end of the program, -contains the only non-local |@!goto| statement in \.{\title}. -@^system dependencies@> -Some \PASCAL\ compilers do not implement non-local |goto| statements. In -such cases the |goto final_end| in |jump_out| should simply be replaced -by a call on some system procedure that quietly terminates the program. -@^system dependencies@> - -@d abort(#)==begin print_ln(' ',#,'.'); jump_out; - end - -@<Error handling...@>= -@<Basic printing procedures@>@; -procedure close_files_and_terminate; forward; -@# -procedure jump_out; -begin mark_fatal; close_files_and_terminate; -goto final_end; -end; - -@ Sometimes the program's behavior is far different from what it should -be, and \.{\title} prints an error message that is really for the -\.{\title} maintenance person, not the user. In such cases the program -says |confusion(|indication of where we are|)|. - -@<Error handling...@>= -procedure confusion(@!p:pckt_pointer); -begin print(' !This can''t happen ('); print_packet(p); print_ln(').'); -@.This can't happen@> -jump_out; -end; - -@ An overflow stop occurs if \.{\title}'s tables aren't large enough. - -@<Error handling...@>= -procedure overflow(@!p:pckt_pointer;@!n:int_16u); -begin print(' !Sorry, ',title,' capacity exceeded ['); print_packet(p); -@.Sorry, {\title} capacity exceeded@> -print_ln('=',n:1,'].'); -jump_out; -end; - -@* Binary data and binary files. -A detailed description of the \.{DVI} file format can be found in the -documentation of \TeX, \.{DVItype}, or \.{GFtoDVI}; here we just define -symbolic names for some of the \.{DVI} command bytes. - -@d set_char_0=0 {typeset character 0 and move right} -@d set1=128 {typeset a character and move right} -@d set_rule=132 {typeset a rule and move right} -@d put1=133 {typeset a character} -@d put_rule=137 {typeset a rule} -@d nop=138 {no operation} -@d bop=139 {beginning of page} -@d eop=140 {ending of page} -@d push=141 {save the current positions} -@d pop=142 {restore previous positions} -@d right1=143 {move right} -@d w0=147 {move right by |w|} -@d w1=148 {move right and set |w|} -@d x0=152 {move right by |x|} -@d x1=153 {move right and set |x|} -@d down1=157 {move down} -@d y0=161 {move down by |y|} -@d y1=162 {move down and set |y|} -@d z0=166 {move down by |z|} -@d z1=167 {move down and set |z|} -@d fnt_num_0=171 {set current font to 0} -@d fnt1=235 {set current font} -@d xxx1=239 {extension to \.{DVI} primitives} -@d xxx4=242 {potentially long extension to \.{DVI} primitives} -@d fnt_def1=243 {define the meaning of a font number} -@d pre=247 {preamble} -@d post=248 {postamble beginning} -@d post_post=249 {postamble ending} -@# -@d dvi_id=2 {identifies \.{DVI} files} -@d dvi_pad=223 {pad bytes at end of \.{DVI} file} - -@ A \.{DVI}, \.{VF}, or \.{TFM} file is a sequence of 8-bit bytes. -The bytes appear physically in what is called a `|packed file of 0..255|' -in \PASCAL\ lingo. One, two, three, or four consecutive bytes are often -interpreted as (signed or unsigned) integers. -We might as well define the corresponding data types. -@!@^system dependencies@> - -@<Types...@>= -@!signed_byte=-@"80..@"7F; {signed one-byte quantity} -@!eight_bits=0..@"FF; {unsigned one-byte quantity} -@!signed_pair=-@"8000..@"7FFF; {signed two-byte quantity} -@!sixteen_bits=0..@"FFFF; {unsigned two-byte quantity} -@!signed_trio=-@"800000..@"7FFFFF; {signed three-byte quantity} -@!twentyfour_bits=0..@"FFFFFF; {unsigned three-byte quantity} -@!signed_quad=int_32; {signed four-byte quantity} - -@ Packing is system dependent, and many \PASCAL\ systems fail to implement -such files in a sensible way (at least, from the viewpoint of producing -good production software). For example, some systems treat all -byte-oriented files as text, looking for end-of-line marks and such -things. Therefore some system-dependent code is often needed to deal with -binary files, even though most of the program in this section of -\.{\title} is written in standard \PASCAL. -@^system dependencies@> - -One common way to solve the problem is to consider files of |integer| -numbers, and to convert an integer in the range $-2^{31}\L x<2^{31}$ to -a sequence of four bytes $(a,b,c,d)$ using the following code, which -avoids the controversial integer division of negative numbers: -$$\vbox{\halign{#\hfil\cr -|if x>=0 then a:=x div @'100000000|\cr -|else begin x:=(x+@'10000000000)+@'10000000000; a:=x div @'100000000+128;|\cr -\quad|end|\cr -|x:=x mod @'100000000;|\cr -|b:=x div @'200000; x:=x mod @'200000;|\cr -|c:=x div @'400; d:=x mod @'400;|\cr}}$$ -The four bytes are then kept in a buffer and output one by one. (On 36-bit -computers, an additional division by 16 is necessary at the beginning. -Another way to separate an integer into four bytes is to use/abuse -\PASCAL's variant records, storing an integer and retrieving bytes that are -packed in the same place; {\sl caveat implementor!\/}) It is also desirable -in some cases to read a hundred or so integers at a time, maintaining a -larger buffer. - -@ We shall stick to simple \PASCAL\ in the standard version of this program, -for reasons of clarity, even if such simplicity is sometimes unrealistic. - -@<Types...@>= -@!byte_file=packed file of eight_bits; {files that contain binary data} - -@ For some operating systems it may be convenient or even necessary to -close the input files. - -@d close_in(#)==do_nothing {close an input file} - -@ Character packets extracted from \.{VF} files will be stored in a large -array |byte_mem|. Other packets of bytes, e.g., character packets -extracted from a \.{GF} or \.{PK} or \.{PXL} file could be stored in the -same way. A `|pckt_pointer|' variable, which signifies a packet, -is an index into another array |pckt_start|. The actual sequence of bytes -in the packet pointed to by |p| appears in positions |pckt_start[p]| to -|pckt_start[p+1]-1|, inclusive, in |byte_mem|. - -Packets will also be used to store sequences of |ASCII_code|s; in this -respect the |byte_mem| array is very similar to \TeX's string pool and -part of the following code has, in fact, been copied more or less -verbatim from \TeX. - -In other respects the packets resemble the identifiers used by -\.{TANGLE} and \.{WEAVE} (also stored in an array called |byte_mem|) -since there is, in general, at most one packet with a given contents; -thus part of the code below has been adapted from the corresponding code -in these programs. - -Some \PASCAL\ compilers won't pack integers into a single byte unless the -integers lie in the range |-128..127|. To accommodate such systems we -access the array |byte_mem| only via macros that can easily be redefined. -@^system dependencies@> - -@d bi(#) == # {convert from |eight_bits| to |packed_byte|} -@d bo(#) == # {convert from |packed_byte| to |eight_bits|} - -@<Types...@>= -@!packed_byte = eight_bits; {elements of |byte_mem| array} -@!byte_pointer = 0..max_bytes; {an index into |byte_mem|} -@!pckt_pointer = 0..max_packets; {an index into |pckt_start|} - -@ The global variable |byte_ptr| points to the first unused location in -|byte_mem| and |pckt_ptr| points to the first unused location in -|pckt_start|. - -@<Globals...@>= -@!byte_mem: packed array [byte_pointer] of packed_byte; {bytes of packets} -@!pckt_start: array [pckt_pointer] of byte_pointer; - {directory into |byte_mem|} -@!byte_ptr: byte_pointer; -@!pckt_ptr: pckt_pointer; - -@ Several of the elementary operations with packets are performed using -\.{WEB} macros instead of \PASCAL\ procedures, because many of the -operations are done quite frequently and we want to avoid the -overhead of procedure calls. For example, here is -a simple macro that computes the length of a packet. -@.WEB@> - -@d pckt_length(#)==(pckt_start[#+1]-pckt_start[#]) {the number of bytes - in packet number \#} - -@ Packets are created by appending bytes to |byte_mem|. -The |append_byte| macro, defined here, does not check to see if the -value of |byte_ptr| has gotten too high; this test is supposed to be -made before |append_byte| is used. There is also a |flush_byte| -macro, which erases the last byte appended. - -To test if there is room to append |l| more bytes to |byte_mem|, -we shall write |pckt_room(l)|, which aborts \.{\title} and gives an -apologetic error message if there isn't enough room. - -@d append_byte(#) == {put byte \# at the end of |byte_mem|} -begin byte_mem[byte_ptr]:=bi(#); incr(byte_ptr); -end -@d flush_byte == decr(byte_ptr) {forget the last byte in |byte_mem|} -@d pckt_room(#) == {make sure that |byte_mem| hasn't overflowed} - if max_bytes-byte_ptr<# then overflow(str_bytes,max_bytes) -@# -@d append_one(#) == -begin pckt_room(1); append_byte(#); -end - -@ The length of the current packet is called |cur_pckt_length|: - -@d cur_pckt_length == (byte_ptr - pckt_start[pckt_ptr]) - -@ Once a sequence of bytes has been appended to |byte_mem|, it -officially becomes a packet when the |make_packet| function is called. -This function returns as its value the identification number of either -an existing packet with the same contents or, if no such packet exists, -of the new packet. Thus two packets have the same contents if and only -if they have the same identification number. In order to locate the -packet with a given contents, or to find out that no such packet exists, -we need a hash table. The hash table is kept by the method of simple -chaining, where the heads of the individual lists appear in the |p_hash| -array. If |h| is a hash code, the hash table list starts at |p_hash[h]| -and proceeds through |p_link| pointers. - -@d hash_size=353 {should be prime, must be |>256|} - -@<Types...@>= -@!hash_code=0..hash_size; - -@ @<Glob...@>= -@!p_link:array[pckt_pointer] of pckt_pointer; {hash table} -@!p_hash:array[hash_code] of pckt_pointer; - -@ Initially |byte_mem| and all the hash lists are empty; |empty_packet| -is the empty packet. - -@d empty_packet=0 {the empty packet} -@d invalid_packet==max_packets {used when there is no packet} - -@<Set init...@>= -pckt_ptr:=1; byte_ptr:=1; -pckt_start[0]:=1; pckt_start[1]:=1; -for h:=0 to hash_size-1 do p_hash[h]:=0; - -@ @<Local variables for init...@>= -@!h:hash_code; {index into hash-head arrays} - -@ Here now is the |make_packet| function used to create packets (and -strings). - -@p function make_packet:pckt_pointer; -label found; -var i,@!k:byte_pointer; {indices into |byte_mem|} -@!h:hash_code; {hash code} -@!s,@!l:byte_pointer; {start and length of the given packet} -@!p:pckt_pointer; {where the packet is being sought} -begin s:=pckt_start[pckt_ptr]; l:=byte_ptr-s; {compute start and length} -if l=0 then p:=empty_packet -else begin @<Compute the packet hash code |h|@>; - @<Compute the packet location |p|@>; - if pckt_ptr=max_packets then overflow(str_packets,max_packets); - incr(pckt_ptr); pckt_start[pckt_ptr]:=byte_ptr; - end; -found:make_packet:=p; -end; - -@ A simple hash code is used: If the sequence of bytes is -$b_1b_2\ldots b_n$, its hash value will be -$$(2^{n-1}b_1+2^{n-2}b_2+\cdots+b_n)\,\bmod\,|hash_size|.$$ - -@<Compute the packet hash...@>= -h:=bo(byte_mem[s]); i:=s+1; -while i<byte_ptr do - begin h:=(h+h+bo(byte_mem[i])) mod hash_size; incr(i); - end - -@ If the packet is new, it will be placed in position |p=pckt_ptr|, -otherwise |p| will point to its existing location. - -@<Compute the packet location...@>= -p:=p_hash[h]; -while p<>0 do - begin if pckt_length(p)=l then - @<Compare packet |p| with current packet, |goto found| if equal@>; - p:=p_link[p]; - end; -p:=pckt_ptr; {the current packet is new} -p_link[p]:=p_hash[h]; p_hash[h]:=p {insert |p| at beginning of hash list} - -@ @<Compare packet |p|...@>= -begin i:=s; k:=pckt_start[p]; -while (i<byte_ptr)and(byte_mem[i]=byte_mem[k]) do - begin incr(i); incr(k); - end; -if i=byte_ptr then {all bytes agree} - begin byte_ptr:=pckt_start[pckt_ptr]; goto found; - end; -end - -@ Some packets are initialized with predefined strings of |ASCII_code|s; -a few macros permit us to do the initialization with a compact program. -Since this initialization is done when |byte_mem| is still empty, and -since |byte_mem| is supposed to be large enough for all the predefined -strings, |pckt_room| is used only if we are debugging. - -@d pid0(#)==#:=make_packet -@d pid1(#)==byte_mem[byte_ptr-1]:=bi(#); pid0 -@d pid2(#)==byte_mem[byte_ptr-2]:=bi(#); pid1 -@d pid3(#)==byte_mem[byte_ptr-3]:=bi(#); pid2 -@d pid4(#)==byte_mem[byte_ptr-4]:=bi(#); pid3 -@d pid5(#)==byte_mem[byte_ptr-5]:=bi(#); pid4 -@d pid6(#)==byte_mem[byte_ptr-6]:=bi(#); pid5 -@d pid7(#)==byte_mem[byte_ptr-7]:=bi(#); pid6 -@d pid8(#)==byte_mem[byte_ptr-8]:=bi(#); pid7 -@d pid9(#)==byte_mem[byte_ptr-9]:=bi(#); pid8 -@d pid10(#)==byte_mem[byte_ptr-10]:=bi(#); pid9 -@# -@d pid_init(#)== - @!debug pckt_room(#); @+ gubed @; - Incr(byte_ptr)(#) -@# -@d id1==pid_init(1); pid1 -@d id2==pid_init(2); pid2 -@d id3==pid_init(3); pid3 -@d id4==pid_init(4); pid4 -@d id5==pid_init(5); pid5 -@d id6==pid_init(6); pid6 -@d id7==pid_init(7); pid7 -@d id8==pid_init(8); pid8 -@d id9==pid_init(9); pid9 -@d id10==pid_init(10); pid10 - -@ Here we initialize some strings used as argument of the |overflow| and -|confusion| procedures. - -@<Initialize predefined strings@>= -id5("f")("o")("n")("t")("s")(str_fonts); -id5("c")("h")("a")("r")("s")(str_chars); -id6("w")("i")("d")("t")("h")("s")(str_widths); -id7("p")("a")("c")("k")("e")("t")("s")(str_packets); -id5("b")("y")("t")("e")("s")(str_bytes); -id9("r")("e")("c")("u")("r")("s")("i")("o")("n")(str_recursion); -id5("s")("t")("a")("c")("k")(str_stack); -id10("n")("a")("m")("e")("l")("e")("n")("g")("t")("h")(str_name_length); - -@ @<Glob...@>= -@!str_fonts,@!str_chars,@!str_widths,@!str_packets,@!str_bytes, -@!str_recursion,@!str_stack,@!str_name_length:pckt_pointer; - -@ Some packets, e.g., the preamble comments of \.{DVI} and \.{VF} files, -are needed only temporarily. In such cases |new_packet| is used to -create a packet (which might duplicate an existing packet) and -|flush_packet| is used to discard it; the calls to |new_packet| and -|flush_packet| must occur in balanced pairs, without any intervening -calls to |make_packet|. - -@p function new_packet: pckt_pointer; -begin if pckt_ptr=max_packets then overflow(str_packets,max_packets); -new_packet:=pckt_ptr; incr(pckt_ptr); pckt_start[pckt_ptr]:=byte_ptr; -end; -@# -procedure flush_packet; -begin decr(pckt_ptr); byte_ptr:=pckt_start[pckt_ptr]; -end; - -@ The |print_packet| procedure prints the contents of a packet; such a -packet should, of course, consists of a sequence of |ASCII_code|s. - -@<Basic printing...@>= -procedure print_packet(p:pckt_pointer); -var k:byte_pointer; -begin for k:=pckt_start[p] to pckt_start[p+1]-1 do - print(xchr[bo(byte_mem[k])]); -end; - -@ When we interpret a packet we will use two (global or local) variables: -|cur_loc| will point to the byte to be used next, and |cur_limit| will -point to the start of the next packet. The macro |pckt_extract| will be -used to extract one byte; it should, however, never be used with -|cur_loc>=cur_limit|. - -@d pckt_extract(#) == -@!debug if cur_loc>=cur_limit then confusion(str_packets) @+ else @/ -gubed @; - begin #:=bo(byte_mem[cur_loc]); incr(cur_loc); @+ end - -@<Globals...@>= -@!cur_pckt: pckt_pointer; {the current packet} -@!cur_loc: byte_pointer; {current location in a packet} -@!cur_limit: byte_pointer; {start of next packet} - -@ We will need routines to extract one, two, three, or four bytes from -|byte_mem|, from the \.{DVI} file, or from a \.{VF} file and assemble -them into (signed or unsigned) integers and these routines should be -optimized for efficiency. Here we define \.{WEB} macros to be used for -the body of these routines; thus the changes for system dependent -optimization have to be applied only once. -@^system dependencies@> -@^optimization@> - -In addition we demonstrates how these macros can be used to define -functions that extract one, two, three, or four bytes from a character -packet and assemble them into signed or unsigned integers (assuming that -|cur_loc| and |cur_limit| are initialized suitably). - -@d begin_byte(#) == -var a:eight_bits; -begin #(a) -@d comp_sbyte(#) == if a<128 then #:=a @+ else #:=a-256 -@d comp_ubyte(#) == #:=a -@f begin_byte == begin - -@p function pckt_sbyte:int_8; {returns the next byte, signed} -@!begin_byte(pckt_extract); comp_sbyte(pckt_sbyte); -end; -@# -function pckt_ubyte:int_8u; {returns the next byte, unsigned} -@!begin_byte(pckt_extract); comp_ubyte(pckt_ubyte); -end; - -@ @d begin_pair(#) == -var a,@!b:eight_bits; -begin #(a); #(b) -@d comp_spair(#) == if a<128 then #:=a*256+b @+ else #:=(a-256)*256+b -@d comp_upair(#) == #:=a*256+b -@f begin_pair == begin - -@p function pckt_spair:int_16; {returns the next two bytes, signed} -@!begin_pair(pckt_extract); comp_spair(pckt_spair); -end; -@# -function pckt_upair:int_16u; {returns the next two bytes, unsigned} -@!begin_pair(pckt_extract); comp_upair(pckt_upair); -end; - -@ @d begin_trio(#) == -var a,@!b,@!c:eight_bits; -begin #(a); #(b); #(c) -@d comp_strio(#) == -if a<128 then #:=(a*256+b)*256+c @+ else #:=((a-256)*256+b)*256+c -@d comp_utrio(#) == #:=(a*256+b)*256+c -@f begin_trio == begin - -@p function pckt_strio:int_24; {returns the next three bytes, signed} -@!begin_trio(pckt_extract); comp_strio(pckt_strio); -end; -@# -function pckt_utrio:int_24u; {returns the next three bytes, unsigned} -@!begin_trio(pckt_extract); comp_utrio(pckt_utrio); -end; - -@ @d begin_quad(#) == -var a,@!b,@!c,@!d:eight_bits; -begin #(a); #(b); #(c); #(d) -@d comp_squad(#) == -if a<128 then #:=((a*256+b)*256+c)*256+d -else #:=(((a-256)*256+b)*256+c)*256+d -@f begin_quad == begin - -@p function pckt_squad:int_32; {returns the next four bytes, signed} -@!begin_quad(pckt_extract); comp_squad(pckt_squad); -end; - -@ A similar set of routines is needed for the inverse task of -decomposing a \.{DVI} command into a sequence of bytes to be appended -to |byte_mem| or, in the case of \.{DVIcopy}, to be written to the -output file. Again we define \.{WEB} macros to be used for the body -of these routines; thus the changes for system dependent optimization -have to be applied only once. -@^system dependencies@> -@^optimization@> - -First, the |pckt_one| outputs one byte, negative values are represented -in two's complement notation. - -@d begin_one == begin -@d comp_one(#) == -if x<0 then Incr(x)(256); -#(x) -@f begin_one == begin - -@p @!device -procedure pckt_one(@!x:int_32); {output one byte} -@!begin_one; pckt_room(1); comp_one(append_byte); -end; -ecived - -@ The |pckt_two| outputs two bytes, negative values are represented in -two's complement notation. - -@d begin_two == begin -@d comp_two(#) == -if x<0 then Incr(x)(@"10000); -#(x div @"100); #(x mod @"100) -@f begin_two == begin - -@p @!device -procedure pckt_two(@!x:int_32); {output two byte} -@!begin_two; pckt_room(2); comp_two(append_byte); -end; -ecived - -@ The |pckt_four| procedure outputs four bytes in two's complement -notation, without risking arithmetic overflow. - -@d begin_four == begin -@d comp_four(#) == -if x>=0 then #(x div @"1000000) -else begin Incr(x)(@"40000000); Incr(x)(@"40000000); - #((x div @"1000000) + 128); - end; -x:=x mod @"1000000; #(x div @"10000); -x:=x mod @"10000; #(x div @"100); -#(x mod @"100) -@f begin_four == begin - -@p procedure pckt_four(@!x:int_32); {output four bytes} -@!begin_four; pckt_room(4); comp_four(append_byte); -end; - -@ Next, the |pckt_char| procedure outputs a |set_char| or \\{set} command -or, if |upd=false|, a |put| command. - -@d begin_char == -var o:eight_bits; {|set1| or |put1|} -begin -@d comp_char(#) == -if (not upd)or(res>127)or(ext<>0) then - begin o:=dvi_char_cmd[upd]; {|set1| or |put1|} - if ext<0 then Incr(ext)(@"1000000); - if ext=0 then #(o) @+ else @; - begin if ext<@"100 then #(o+1) @+ else @; - begin if ext<@"10000 then #(o+2) @+ else @; - begin #(o+3); #(ext div @"10000); ext:=ext mod @"10000; - end; - #(ext div @"100); ext:=ext mod @"100; - end; - #(ext); - end; - end; -#(res) -@f begin_char == begin - -@p procedure pckt_char(@!upd:boolean;@!ext:int_32;@!res:eight_bits); - {output \\{set} or |put|} -@!begin_char; pckt_room(5); comp_char(append_byte); -end; - -@ Then, the |pckt_unsigned| procedure outputs a |fnt| or |xxx| -command with its first parameter (normally unsigned); a |fnt| command -is converted into |fnt_num| whenever this is possible. - -@d begin_unsigned == begin -@d comp_unsigned(#) == -if (x<@"100)and(x>=0) then - if (o=fnt1)and(x<64) then Incr(x)(fnt_num_0) @+ else #(o) -else - begin if (x<@"10000)and(x>=0) then #(o+1) @+ else @; - begin if (x<@"1000000)and(x>=0) then #(o+2) @+ else @; - begin #(o+3); - if x>=0 then #(x div @"1000000) - else begin Incr(x)(@"40000000); Incr(x)(@"40000000); - #((x div @"1000000) + 128); - end; - x:=x mod @"1000000; - end; - #(x div @"10000); x:=x mod @"10000; - end; - #(x div @"100); x:=x mod @"100; - end; -#(x) -@f begin_unsigned == begin - -@p procedure pckt_unsigned(@!o:eight_bits;@!x:int_32); - {output |fnt_num|, |fnt|, or |xxx|} -@!begin_unsigned; pckt_room(5); comp_unsigned(append_byte); -end; - -@ Finally, the |pckt_signed| procedure outputs a movement (|right|, |w|, -|x|, |down|, |y|, or |z|) command with its (signed) parameter. - -@d begin_signed == -var xx:int_31; {`absolute value' of |x|} -begin -@d comp_signed(#) == -if x>=0 then xx:=x @+ else xx:=-(x+1); -if xx<@"80 then - begin #(o); @+ if x<0 then Incr(x)(@"100); @+ end -else begin if xx<@"8000 then - begin #(o+1); @+ if x<0 then Incr(x)(@"10000); @+ end - else begin if xx<@"800000 then - begin #(o+2); @+ if x<0 then Incr(x)(@"1000000); @+ end - else begin #(o+3); - if x>=0 then #(x div @"1000000) - else begin x:=@"7FFFFFFF-xx; #((x div @"1000000) + 128); @+ end; - x:=x mod @"1000000; - end; - #(x div @"10000); x:=x mod @"10000; - end; - #(x div @"100); x:=x mod @"100; - end; -#(x) -@f begin_signed == begin - -@p procedure pckt_signed(@!o:eight_bits;@!x:int_32); - {output |right|, |w|, |x|, |down|, |y|, or |z|} -@!begin_signed; pckt_room(5); comp_signed(append_byte); -end; - -@ The |hex_packet| procedure prints the contents of a packet in -hexadecimal form. - -@<Basic printing...@>= -@!debug procedure hex_packet(@!p:pckt_pointer); {prints a packet in hex} -var j,@!k,@!l:byte_pointer; {indices into |byte_mem|} -@!d:int_8u; -begin j:=pckt_start[p]-1; k:=pckt_start[p+1]-1; -print_ln(' packet=',p:1,' start=',j+1:1,' length=',k-j:1); -for l:=j+1 to k do - begin d:=(bo(byte_mem[l])) div 16; - if d<10 then print(xchr[d+"0"]) @+ else print(xchr[d-10+"A"]); - d:=(bo(byte_mem[l])) mod 16; - if d<10 then print(xchr[d+"0"]) @+ else print(xchr[d-10+"A"]); - if (l=k)or(((l-j) mod 16)=0) then new_line - else if ((l-j) mod 4)=0 then print(' ') - else print(' '); - end; -end; -gubed - -@* File names. -The structure of file names is different for different systems; therefore -this part of the program will, in most cases, require system dependent -modifications. Here we assume that a file name consists of three parts: -an area or directory specifying where the file can be found, a name -proper and an extension; \.{\title} assumes that these three parts appear -in order stated above but this need not be true in all cases. - -The font names extracted from \.{DVI} and \.{VF} files consist of an area -part and a name proper; these are stored as packets consisting of the -length of the area part followed by the area and the name proper. -When we print an external font name we simple print the area and the name -contained in the `file name packet' without delimiter between them. -This may need to be modified for some systems. -@^system dependencies@> - -@<Basic printing...@>= -procedure print_font(@!f:font_number); -var p:pckt_pointer; {the font name packet} -@!k:byte_pointer; {index into |byte_mem|} -@!m:int_31; {font magnification} -begin print(' = '); p:=font_name(f); -for k:=pckt_start[p]+1 to pckt_start[p+1]-1 do - print(xchr[bo(byte_mem[k])]); -m:=round((font_scaled(f)/font_design(f))*out_mag); -if m<>1000 then print(' scaled ',m:1); -end; - -@ Before a font file can be opened for input we must build a string -with its external name. - -@<Glob...@>= -@!cur_name:packed array[1..name_length] of char; {external name, - with no lower case letters} -@!l_cur_name:int_15; {this many characters are actually relevant in - |cur_name|} - -@ For \.{TFM} and \.{VF} files we just append the appropriate extension -to the file name packet; in addition a system dependent area part -(usually different for \.{TFM} and \.{VF} files) is prepended if -the file name packet contains no area part. -@^system dependencies@> - -@d append_to_name(#)== - if l_cur_name<name_length then - begin incr(l_cur_name); cur_name[l_cur_name]:=#; - end - else overflow(str_name_length,name_length) -@d make_font_name_end(#)== - append_to_name(#[l]); make_name -@d make_font_name(#)== - l_cur_name:=0; for l:=1 to # do make_font_name_end - -@ For files with character raster data (e.g., \.{GF} or \.{PK} files) the -extension and\slash or area part will in most cases depend on the -resolution of the output device (corrected for font magnification). -If the special character |res_char| occurs in the extension and\slash or -default area, a character string representing the device resolution will -be substituted. -@^system dependencies@> - -@d res_char=='?' {character to be replaced by font resolution} -@d res_ASCII="?" {|xord[res_char]|} -@# -@d append_res_to_name(#)== - begin c:=#; - @!device if c=res_char then - for ll:=n_res_digits downto 1 do append_to_name(res_digits[ll]) - else ecived@;@/ - append_to_name(c); - end -@d make_font_res_end(#)== - append_res_to_name(#[l]); make_name -@d make_font_res(#)== - make_res; l_cur_name:=0; for l:=1 to # do make_font_res_end - -@ @<Glob...@>= -@!device -@!f_res:int_16u; {font resolution} -@!res_digits:array [1..5] of char; -@!n_res_digits:int_7; {number of significant characters in |res_digits|} -ecived - -@ The |make_res| procedure creates a sequence of characters representing -to the font resolution |f_res|. - -@p @!device procedure make_res; -var r:int_16u; -begin n_res_digits:=0; r:=f_res; -repeat incr(n_res_digits); - res_digits[n_res_digits]:=xchr["0"+(r mod 10)]; r:=r div 10; -until r=0; -end; -ecived - -@ The |make_name| procedure used to build the external file name. The -global variable |l_cur_name| contains the length of a default area -which has been copied to |cur_name| before |make_name| is called. -@^system dependencies@> - -@p procedure make_name(@!e:pckt_pointer); -var b:eight_bits; {a byte extracted from |byte_mem|} -@!n:pckt_pointer; {file name packet} -@!cur_loc,@!cur_limit:byte_pointer; {indices into |byte_mem|} -@!device -@!ll:int_15; {loop index} -ecived@;@/ -@!c:char; {a character to be appended to |cur_name|} -begin n:=font_name(cur_fnt); -cur_loc:=pckt_start[n]; cur_limit:=pckt_start[n+1]; -pckt_extract(b); {length of area part} -if b>0 then l_cur_name:=0; -while cur_loc<cur_limit do - begin pckt_extract(b); - if (b>="a")and(b<="z") then Decr(b)(("a"-"A")); {convert to upper case} - append_to_name(xchr[b]); - end; -cur_loc:=pckt_start[e]; cur_limit:=pckt_start[e+1]; -while cur_loc<cur_limit do - begin pckt_extract(b); append_res_to_name(xchr[b]); - end; -while l_cur_name<name_length do - begin incr(l_cur_name); cur_name[l_cur_name]:=' '; - end; -end; - -@* Font data. -\.{DVI} file format does not include information about character widths, since -that would tend to make the files a lot longer. But a program that reads -a \.{DVI} file is supposed to know the widths of the characters that appear -in \\{set\_char} commands. Therefore \.{\title} looks at the font metric -(\.{TFM}) files for the fonts that are involved. -@.TFM {\rm files}@> - -The character-width data appears also in other files (e.g., in \.{VF} files -or in \.{GF} and \.{PK} files that specify bit patterns for digitized -characters); thus, it is usually possible for \.{DVI} reading programs -to get by with accessing only one file per font. For \.{VF} reading -programs there is, however, a problem: (1)~when reading the character -packets from a \.{VF} file the \.{TFM} width for its local fonts should -be known in order to analyze and optimize the packets (e.g., determine -if a packet must indeed be enclosed with |push| and |pop| as implied by -the \.{VF} format); and (2)~ in order to avoid infinite recursion such -programs must not try to read a \.{VF} file for a font before a -character from that font is actually used. Thus \.{\title} reads the -\.{TFM} file whenever a new font is encountered and delays the decision -whether this is a virtual font or not. - -@ First of all we need to know for each font~|f| such things as its -external name, design and scaled size, and the approximate size of -inter-word spaces. In addition we need to know the range |bc..ec| of -valid characters for this font, and for each character~|c| in~|f| we -need to know if this character exists and if so what is the width of~|c|. -Depending on the font type of~|f| we may want to know a few other things -about character~|c| in~|f| such as the character packet from a \.{VF} -file or the raster data from a \.{PK} file. -@^font types@> - -In \.{\title} we want to be able to handle the full range -|@t$-2^{31}$@><=c<@t$2^{31}$@>| of character codes; each character code -is decomposed into a character residue |0<=res<256| and character -extension |@t$-2^{23}$@><=ext<@t$2^{23}$@>| such that |c=256*ext+res|. -At present \.{VFtoVP}, \.{VPtoVF}, and the standard version of \TeX\ use -only characters in the range |0<=c<256| (i.e., |ext=0|), there are, -however, extensions of \TeX\ which use characters with |ext<>0|. -In any case characters with |ext<>0| will be used rather infrequently -and we want to handle this possibility without too much overhead. - -Some of the data for each character~|c| depend only on its residue: -first of all its width and escapement; others, such as \.{VF} packets or -raster data will also depend on its extension. The later will be stored -as packets in |byte_mem|, and the packets for characters with the same -residue but different extension will be chained. - -Thus we have to maintain several variables for each character -residue~|bc<=res<=ec| from each font~|f|; we store each type of variable -in a large array such that the array index |font_chars(f)+res| points to -the value for characters with residue |res| from font~|f|. - -@ Quite often a particular width value is shared by several characters in -a font or even by characters from different fonts; the later will -probably occur in particular for virtual fonts and the local fonts used -by them. Thus the array |widths| is used to store all different \.{TFM} -width values of all legal characters in all fonts; a variable of type -|width_pointer| is an index into |widths| or is zero if a characters does -not exist. - -In order to locate a given width value we use again a hash -table with simple chaining; this time the heads of the individual lists -appear in the |w_hash| array and the lists proceed through |w_link| -pointers. - -@<Types...@>= -@!width_pointer=0..max_widths; {an index into |widths|} - -@ @<Glob...@>= -@!widths:array[width_pointer] of int_32; {the different width values} -@!w_link:array[width_pointer] of width_pointer; {hash table} -@!w_hash:array[hash_code] of width_pointer; -@!n_widths:width_pointer; {first unoccupied position in |widths|} - -@ Initially the |widths| array and all the hash lists are empty, except -for one entry: the width value zero; in addition we set |widths[0]:=0|. - -@d invalid_width=0 {width pointer for invalid characters} -@d zero_width=1 {a width pointer to the value zero} - -@<Set init...@>= -w_hash[0]:=1; w_link[1]:=0; widths[0]:=0; widths[1]:=0; n_widths:=2; -for h:=1 to hash_size-1 do w_hash[h]:=0; - -@ The |make_width| function returns an index into |widths| and, if -necessary, adds a new width value; thus two characters will have the -same |width_pointer| if and only if their widths agree. - -@p function make_width(@!w:int_32):width_pointer; -label found; -var h:hash_code; {hash code} -@!p:width_pointer; {where the identifier is being sought} -@!x:int_16; {intermediate value} -begin widths[n_widths]:=w; -@<Compute the width hash code |h|@>; -@<Compute the width location |p|, |goto| found unless the value is new@>; -if n_widths=max_widths then overflow(str_widths,max_widths); -incr(n_widths); -found:make_width:=p; -end; - -@ A simple hash code is used: If the width value consists of the four -bytes $b_0b_1b_2b_3$, its hash value will be -$$(8*b_0+4*b_1+2*b_2+b_3)\,\bmod\,|hash_size|.$$ - -@<Compute the width hash...@>= -if w>=0 then x:=w div @"1000000 -else begin w:=w+@"40000000; w:=w+@"40000000; x:=(w div @"1000000)+@"80; - end; -w:=w mod @"1000000; x:=x+x+(w div @"10000); -w:=w mod @"10000; x:=x+x+(w div @"100); -h:=(x+x+(w mod @"100)) mod hash_size - -@ If the width is new, it has been placed into position |p=n_widths|, -otherwise |p| will point to its existing location. - -@<Compute the width location...@>= -p:=w_hash[h]; -while p<>0 do - begin if widths[p]=widths[n_widths] then goto found; - p:=w_link[p]; - end; -p:=n_widths; {the current width is new} -w_link[p]:=w_hash[h]; w_hash[h]:=p {insert |p| at beginning of hash list} - -@ The |char_widths| array is used to store the |width_pointer|s for all -different characters among all fonts. The |char_packets| array is used -to store the |pckt_pointer|s for all different characters among all -fonts; they can point to character packets from \.{VF} files or, e.g., -raster packets from \.{PK} files. - -@<Types...@>= -@!char_offset=-255..max_chars; {|char_pointer| offset for a font} -@!char_pointer=0..max_chars; {index into |char_widths| or similar arrays} - -@ @<Glob...@>= -@!char_widths:array[char_pointer] of width_pointer; {width pointers} -@!char_packets:array[char_pointer] of pckt_pointer; {packet pointers} -@!n_chars:char_pointer; {first unused position in |char_widths|} - -@ @<Set init...@>= -n_chars:=0; - -@ The current number of known fonts is |nf|; each known font has an -internal number |f|, where |0<=f<nf|. For the moment we need for each -known font: |font_check|, |font_scaled|, |font_design|, |font_name|, -|font_bc|, |font_ec|, |font_chars|, and |font_type|. Here |font_scaled| -and |font_design| are measured in \.{DVI} units and |font_chars| is of -type |char_offset|: the width pointer for character~|c| of the font is -stored in |char_widths[char_offset+c]| (for |font_bc<=c<=font_ec|). -Later on we will need additional information depending on the font type: -\.{VF} or real (\.{GF}, \.{PK}, or \.{PXL}). - -@<Types...@>= -@!f_type=defined_font..max_font_type; {type of a font} -@!font_number=0..max_fonts; - -@ @<Glob...@>= -@!nf:font_number; - -@ These data are stored in several arrays and we use \.{WEB} macros -to access the various fields. Thus it would be simple to store the -data in an array of record structures and adapt the \.{WEB} macros -accordingly. - -We will say, e.g., |font_name(f)| for the name field of font~|f|, and -|font_width(f)(c)| for the width pointer of character~|c| in font~|f| -and |font_packet(f)(c)| for its character packet (this character -exists provided |font_bc(f)<=c<=font_ec(f)| and -|font_width(f)(c)<>invalid_width|). The actual width of character~|c| in -font~|f| is stored in |widths[font_width(f)(c)]|. - -@d font_check(#)==fnt_check[#] {checksum} -@d font_scaled(#)==fnt_scaled[#] {scaled or `at' size} -@d font_design(#)==fnt_design[#] {design size} -@d font_name(#)==fnt_name[#] {area plus name packet} -@d font_bc(#)==fnt_bc[#] {first character} -@d font_ec(#)==fnt_ec[#] {last character} -@d font_chars(#)==fnt_chars[#] {character info offset} -@d font_type(#)==fnt_type[#] {type of this font} -@d font_font(#)==fnt_font[#] {use depends on |font_type|} -@# -@d font_width_end(#)==#] -@d font_width(#)==char_widths[font_chars(#)+font_width_end -@d font_packet(#)==char_packets[font_chars(#)+font_width_end - -@<Glob...@>= -@!fnt_check:array [font_number] of int_32; {checksum} -@!fnt_scaled:array [font_number] of int_31; {scaled size} -@!fnt_design:array [font_number] of int_31; {design size} -@!device @<Declare device dependent font data arrays@>@; @+ ecived @; @/ -@!fnt_name:array [font_number] of pckt_pointer; {pointer to area plus - name packet} -@!fnt_bc:array [font_number] of eight_bits; {first character} -@!fnt_ec:array [font_number] of eight_bits; {last character} -@!fnt_chars:array [font_number] of char_offset; {character info offset} -@!fnt_type:array [font_number] of f_type; {type of font} -@!fnt_font:array [font_number] of font_number; {use depends on |font_type|} - -@ @d invalid_font==max_fonts {used when there is no valid font} - -@<Set init...@>= -@!device @<Initialize device dependent font data@>@; @+ ecived @;@/ -nf:=0; - -@ A \.{VF}, or \.{GF}, or \.{PK} file may contain information for -several characters with the same residue but with different extension; -all except the first of the corresponding packets in |byte_mem| will -contain a pointer to the previous one and |font_packet(f)(res)| -identifies the last such packet. - -A character packet in |byte_mem| starts with a flag byte -$$\hbox{|flag=@"40*ext_flag+@"20*chain_flag+type_flag|}$$ -with |0<=ext_flag<=3|, |0<=chain_flag<=1|, |0<=type_flag<=@"1F|, -followed by |ext_flag| bytes with the character extension for this -packet and, if |chain_flag=1|, by a two byte packet pointer to the -previous packet for the same font and character residue. The actual -character packet follows after these header bytes and the -interpretation of the |type_flag| depends on whether this is a \.{VF} -packet or a packet for raster data. - -The empty packet is interpreted as a special case of a packet with -|flag=0|. - -@d ext_flag=@"40 -@d chain_flag=@"20 - -@<Types...@>= -@!type_flag=0..chain_flag-1; {the range of values for the |type_flag|} - -@ The global variable |cur_fnt| is the internal font number of the -currently selected font, or equals |invalid_font| if no font has -been selected; |cur_res| and |cur_ext| are the residue and extension -part of the current character code. The type of a character packet -located by the |find_packet| function defined below is |cur_type|. -While building a character packet for a character, |pckt_ext| and -|pckt_res| are the extension and residue of this character; |pckt_dup| -indicates whether a packet for this extension exists already. - -@<Glob...@>= -@!cur_fnt:font_number; {the currently selected font} -@!cur_ext:int_24; {the current character extension} -@!cur_res:int_8u; {the current character residue} -@!cur_type:type_flag; {type of the current character packet} -@!pckt_ext:int_24; {character extension for the current character packet} -@!pckt_res:int_8u; {character residue for the current character packet} -@!pckt_dup:boolean; {is there a previous packet for the same extension?} -@!pckt_prev:pckt_pointer; {a previous packet for the same extension} -@!pckt_m_msg,@!pckt_s_msg,@!pckt_d_msg:int_7; {counts for various character - packet error messages} - -@ @<Set init...@>= -cur_fnt:=invalid_font; pckt_m_msg:=0; pckt_s_msg:=0; pckt_d_msg:=0; - -@ The |find_packet| functions is used to locate the character packet for -the character with residue~|cur_res| and extension~|cur_ext| from -font~|cur_fnt| and returns |false| if no packet exists for any extension; -otherwise the result is |true| and the global variables |cur_packet|, -|cur_type|, |cur_loc|, and |cur_limit| are initialized. In case none of -the character packets has the correct extension, the last one in the -chain (the one defined first) is used instead and |cur_ext| is changed -accordingly. - -@p function find_packet:boolean; -label found,exit; -var p,@!q:pckt_pointer; {current and next packet} -@!f:eight_bits; {a flag byte} -@!e:int_24; {extension for a packet} -begin q:=font_packet(cur_fnt)(cur_res); -if q=invalid_packet then - begin if pckt_m_msg<10 then {stop telling after first 10 times} - begin print_ln('---missing character packet for character ',cur_res:1, -@.missing character packet...@> - ' font ',cur_fnt:1); - incr(pckt_m_msg); mark_error; - if pckt_m_msg=10 then print_ln('---further messages suppressed.'); - end; - find_packet:=false; return; - end; -@<Locate a character packet and |goto found| if found@>; -if pckt_s_msg<10 then {stop telling after first 10 times} - begin print_ln('---substituted character packet with extension ', -@.substituted character packet...@> - e:1,' instead of ',cur_ext:1,' for character ',cur_res:1, - ' font ',cur_fnt:1); - incr(pckt_s_msg); mark_error; - if pckt_s_msg=10 then print_ln('---further messages suppressed.'); - end; -cur_ext:=e; -found: cur_pckt:=p; cur_type:=f; find_packet:=true; -exit: end; - -@ @<Locate a character packet and |goto found| if found@>= -repeat p:=q; q:=invalid_packet; - cur_loc:=pckt_start[p]; cur_limit:=pckt_start[p+1]; - if p=empty_packet then - begin e:=0; f:=0; - end - else begin pckt_extract(f); - case (f div ext_flag) of - 0: e:=0; - 1: e:=pckt_ubyte; - 2: e:=pckt_upair; - othercases e:=pckt_strio; {|f div ext_flag = 3|} - endcases; - if (f mod ext_flag)>=chain_flag then q:=pckt_upair; - f:=f mod chain_flag; - end; - if e=cur_ext then goto found; -until q=invalid_packet - -@ The |start_packet| procedure is used to create the header bytes of a -character packet for the character with residue~|cur_res| and -extension~|cur_ext| from font~|cur_fnt|; if a previous such packet -exists, we try to build an exact duplicate, i.e., use the chain field of -that previous packet. - -@p procedure start_packet(@!t:type_flag); -label found,not_found; -var p,@!q:pckt_pointer; {current and next packet} -@!f:int_8u; {a flag byte} -@!e:int_32; {extension for a packet} -@!cur_loc: byte_pointer; {current location in a packet} -@!cur_limit: byte_pointer; {start of next packet} -begin q:=font_packet(cur_fnt)(cur_res); -if q<>invalid_packet then @<Locate a character packet...@>; -q:=font_packet(cur_fnt)(cur_res); pckt_dup:=false; goto not_found; -found: pckt_dup:=true; pckt_prev:=p; -not_found: pckt_ext:=cur_ext; pckt_res:=cur_res; pckt_room(6); -@!debug if byte_ptr<>pckt_start[pckt_ptr] then confusion(str_packets); -gubed @;@/ -if q=invalid_packet then f:=t @+ else f:=t+chain_flag; -e:=cur_ext; -if e<0 then Incr(e)(@"1000000); -if e=0 then append_byte(f) @+ else @; - begin if e<@"100 then append_byte(f+ext_flag) @+ else @; - begin if e<@"10000 then append_byte(f+ext_flag+ext_flag) @+ else @; - begin append_byte(f+ext_flag+ext_flag+ext_flag); - append_byte(e div @"10000); e:=e mod @"10000; - end; - append_byte(e div @"100); e:=e mod @"100; - end; - append_byte(e); - end; -if q<>invalid_packet then - begin append_byte(q div @"100); append_byte(q mod @"100); - end; -end; - -@ The |build_packet| procedure is used to finish a character packet. -If a previous packet for the same character extension exists, the new -one is discarded; if the two packets are identical, as it occasionally -occurs for raster files, this is done without an error message. - -@p procedure build_packet; -var k,@!l:byte_pointer; {indices into |byte_mem|} -begin if pckt_dup then - begin k:=pckt_start[pckt_prev+1]; l:=pckt_start[pckt_ptr]; - if (byte_ptr-l)<>(k-pckt_start[pckt_prev]) then pckt_dup:=false; - while pckt_dup and(byte_ptr>l) do - begin flush_byte; decr(k); - if byte_mem[byte_ptr]<>byte_mem[k] then pckt_dup:=false; - end; - if (not pckt_dup)and(pckt_d_msg<10) then {stop telling after first 10 times} - begin print('---duplicate packet for character ',pckt_res:1); -@.duplicate packet for character...@> - if pckt_ext<>0 then print('.',pckt_ext:1); - print_ln(' font ',cur_fnt:1); - incr(pckt_d_msg); mark_error; - if pckt_d_msg=10 then print_ln('---further messages suppressed.'); - end; - byte_ptr:=l; - end -else font_packet(cur_fnt)(pckt_res):=make_packet; -end; - -@* Defining fonts. -A detailed description of the \.{TFM} file format can be found in the -documentation of \TeX, \MF, or \.{TFtoPL}. In order to read \.{TFM} -files the program uses the binary file variable |tfm_file|. - -@<Glob...@>= -@!tfm_file:byte_file; {a \.{TFM} file} -@!tfm_ext:pckt_pointer; {extension for \.{TFM} files} - -@ @<Initialize predefined strings@>= -id4(".")("T")("F")("M")(tfm_ext); {file name extension for \.{TFM} files} - -@ If no font directory has been specified, \.{\title} is supposed to use -the default \.{TFM} directory, which is a system-dependent place where -the \.{TFM} files for standard fonts are kept. -The string variable |TFM_default_area| contains the name of this area. -@^system dependencies@> - -@d TFM_default_area_name=='TeXfonts:' {change this to the correct name} -@d TFM_default_area_name_length=9 {change this to the correct length} - -@<Glob...@>= -@!TFM_default_area:packed array[1..TFM_default_area_name_length] of char; - -@ @<Set init...@>= -TFM_default_area:=TFM_default_area_name; - -@ If a \.{TFM} file is badly malformed, we say |bad_font|; for a \.{TFM} -file the |bad_tfm| procedure is used to give an error message which -refers the user to \.{TFtoPL} and \.{PLtoTF}, and terminates \.{\title}. - -@<Error handling...@>= -procedure bad_tfm; -begin print('Bad TFM file'); print_font(cur_fnt); print_ln('!'); -@.Bad TFM file@> -abort('Use TFtoPL/PLtoTF to diagnose and correct the problem'); -@.Use TFtoPL/PLtoTF@> -end; -@# -procedure bad_font; -begin new_line; -case font_type(cur_fnt) of - defined_font: confusion(str_fonts); - loaded_font: bad_tfm; - @<Cases for |bad_font|@>@;@/ - othercases abort('internal error'); - endcases; -end; - -@ To prepare |tfm_file| for input we |reset| it. - -@<TFM: Open |tfm_file|@>= -make_font_name(TFM_default_area_name_length)(TFM_default_area)(tfm_ext); -reset(tfm_file,cur_name); -if eof(tfm_file) then -@^system dependencies@> - abort('---not loaded, TFM file can''t be opened!') -@.TFM file can\'t be opened@> - -@ It turns out to be convenient to read four bytes at a time, when we -are inputting from \.{TFM} files. The input goes into global variables -|tfm_b0|, |tfm_b1|, |tfm_b2|, and |tfm_b3|, with |tfm_b0| getting the -first byte and |tfm_b3| the fourth. - -@<Glob...@>= -@!tfm_b0,@!tfm_b1,@!tfm_b2,@!tfm_b3: eight_bits; {four bytes input at once} - -@ Reading a \.{TFM} file should be done as efficient as possible for a -particular system; on many systems this means that a large number of -bytes from |tfm_file| is read into a buffer and will then be extracted -from that buffer. In order to simplify such system dependent changes -we use the \.{WEB} macro |tfm_byte| to extract the next \.{TFM} byte; -this macro and |eof(tfm_file)| are used only in the |read_tfm_word| -procedure which sets |tfm_b0| through |tfm_b3| to the next four bytes -in the current \.{TFM} file. Here we give simple minded definitions in -terms of standard \PASCAL. -@^system dependencies@> -@^optimization@> - -@d tfm_byte(#)==read(tfm_file,#) {read next \.{TFM} byte} - -@p procedure read_tfm_word; -begin tfm_byte(tfm_b0); tfm_byte(tfm_b1); -tfm_byte(tfm_b2); tfm_byte(tfm_b3); -if eof(tfm_file) then bad_font; -end; - -@ Here are three procedures used to check the consistency of font files: -First, the |check_check_sum| procedure compares two check sum values: a -warning is given if they differ and are both non-zero; if the second -value is not zero it may replace the first one. -Next, the |check_design_size| procedure compares two design size -values: a warning is given if they differ by more than a small amount. -Finally, the |check_width| function compares the character width value -for character |cur_res| read from a \.{VF} or raster file for font -|cur_fnt| with the value previously read from the \.{TFM} file and -returns the width pointer for that value; a warning is given if the two -values differ. - -@p procedure check_check_sum(@!c:int_32;@!u:boolean); - {compare |font_check(cur_fnt)| with |c|} -begin if (c<>font_check(cur_fnt))and(c<>0) then - begin - if font_check(cur_fnt)<>0 then - begin new_line; print_ln('---beware: check sums do not agree! (', -@.beware: check sums do not agree@> -@.check sums do not agree@> - c:1,' vs. ',font_check(cur_fnt):1,')'); - mark_harmless; - end; - if u then font_check(cur_fnt):=c; - end; -end; -@# -procedure check_design_size(@!d:int_32); - {compare |font_design(cur_fnt)| with |d|} -begin if abs(d-font_design(cur_fnt))>2 then - begin new_line; print_ln('---beware: design sizes do not agree! (', -@.beware: design sizes do not agree@> -@.design sizes do not agree@> - d:1,' vs. ',font_design(cur_fnt):1,')'); - mark_error; - end; -end; -@# -function check_width(w:int_32):width_pointer; - {compare |widths[font_width(cur_fnt)(cur_res)]| with |w|} -var wp:width_pointer; {pointer to \.{TFM} width value} -begin if (cur_res>=font_bc(cur_fnt))and(cur_res<=font_ec(cur_fnt)) then - wp:=font_width(cur_fnt)(cur_res) -else wp:=invalid_width; -if wp=invalid_width then - begin print_nl('Bad char ',cur_res:1); -@.Bad char c@> - if cur_ext<>0 then print('.',cur_ext:1); - print(' font ',cur_fnt:1); print_font(cur_fnt); - abort(' (compare TFM file)'); - end; -if w<>widths[wp] then - begin new_line; print_ln('---beware: char widths do not agree! (', -@.beware: char widths do not agree@> -@.char widths do not agree@> - w:1,' vs. ',widths[wp]:1,')'); - mark_error; - end; -check_width:=wp; -end; - -@ The |load_font| procedure reads the \.{TFM} file for a font and puts -the data extracted into position |cur_fnt| of the font data arrays. - -@p procedure load_font; {reads a \.{TFM} file} -var l:int_16; {loop index} -@!p:char_pointer; {index into |char_widths|} -@!q:width_pointer; {index into |widths|} -@!bc,@!ec:int_15; {first and last character in this font} -@!lh:int_15; {length of header in four byte words} -@!nw:int_15; {number of words in width table} -@!w:int_32; {a four byte integer} -@<Variables for scaling computation@>@; -begin print('TFM: font ',cur_fnt:1); print_font(cur_fnt); -font_type(cur_fnt):=loaded_font; -@<TFM: Open |tfm_file|@>; -@<TFM: Read past the header data@>; -@<TFM: Store character-width indices@>; -@<TFM: Read and convert the width values@>; -@<TFM: Convert character-width indices to character-width pointers@>; -close_in(tfm_file); -@!device @<Initialize device dependent data for a font@>@; @+ ecived @; @/ -d_print(' loaded at ',font_scaled(cur_fnt):1,' DVI units'); -print_ln('.'); -end; - -@ @<Glob...@>= -@!tfm_conv:real; {\.{DVI} units per absolute \.{TFM} unit} - -@ We will use the following \.{WEB} macros to construct integers from -two or four of the four bytes read by |read_tfm_word|. -@^system dependencies@> - -@d tfm_b01(#)== {|tfm_b0..tfm_b1| as non-negative integer} -if tfm_b0>127 then bad_font -else #:=tfm_b0*256+tfm_b1 -@d tfm_b23(#)== {|tfm_b2..tfm_b3| as non-negative integer} -if tfm_b2>127 then bad_font -else #:=tfm_b2*256+tfm_b3 -@d tfm_squad(#)== {|tfm_b0..tfm_b3| as signed integer} -if tfm_b0<128 then #:=((tfm_b0*256+tfm_b1)*256+tfm_b2)*256+tfm_b3 -else #:=(((tfm_b0-256)*256+tfm_b1)*256+tfm_b2)*256+tfm_b3 -@d tfm_uquad== {|tfm_b0..tfm_b3| as unsigned integer} -(((tfm_b0*256+tfm_b1)*256+tfm_b2)*256+tfm_b3) - -@<TFM: Read past the header data@>= -read_tfm_word; tfm_b23(lh); -read_tfm_word; tfm_b01(bc); tfm_b23(ec); -if ec<bc then - begin bc:=1; ec:=0; - end -else if ec>255 then bad_font; -read_tfm_word; tfm_b01(nw); -if (nw=0)or(nw>256) then bad_font; -for l:=-2 to lh do - begin read_tfm_word; - if l=1 then - begin tfm_squad(w); check_check_sum(w,true); - end - else if l=2 then - begin if tfm_b0>127 then bad_font; - check_design_size(round(tfm_conv*tfm_uquad)); - end; - end - -@ The width indices for the characters are stored in positions |n_chars| -through |n_chars-bc+ec| of the |char_widths| array; if characters on -either end of the range |bc..ec| do not exist, they are ignored and the -range is adjusted accordingly. - -@<TFM: Store character-width indices@>= -read_tfm_word; -while (tfm_b0=0)and(bc<=ec) do - begin incr(bc); read_tfm_word; - end; -font_bc(cur_fnt):=bc; font_chars(cur_fnt):=n_chars-bc; -if ec>=max_chars-font_chars(cur_fnt) then overflow(str_chars,max_chars); -for l:=bc to ec do - begin char_widths[n_chars]:=tfm_b0; incr(n_chars); read_tfm_word; - end; -while (char_widths[n_chars-1]=0)and(ec>=bc) do - begin decr(n_chars); decr(ec); - end; -font_ec(cur_fnt):=ec - -@ The most important part of |load_font| is the width computation, which -involves multiplying the relative widths in the \.{TFM} file by the -scaling factor in the \.{DVI} file. A similar computation is used for -dimensions read from \.{VF} files. This fixed-point multiplication must -be done with precisely the same accuracy by all \.{DVI}-reading programs, -in order to validate the assumptions made by \.{DVI}-writing programs -like \TeX82. - -Let us therefore summarize what needs to be done. Each width in a \.{TFM} -file appears as a four-byte quantity called a |fix_word|. A |fix_word| -whose respective bytes are $(a,b,c,d)$ represents the number -$$x=\left\{\vcenter{\halign{$#$,\hfil\qquad&if $#$\hfil\cr -b\cdot2^{-4}+c\cdot2^{-12}+d\cdot2^{-20}&a=0;\cr --16+b\cdot2^{-4}+c\cdot2^{-12}+d\cdot2^{-20}&a=255.\cr}}\right.$$ -(No other choices of $a$ are allowed, since the magnitude of a \.{TFM} -dimension must be less than 16.) We want to multiply this quantity by the -integer~|z|, which is known to be less than $2^{27}$. -If $|z|<2^{23}$, the individual multiplications $b\cdot z$, $c\cdot z$, -$d\cdot z$ cannot overflow; otherwise we will divide |z| by 2, 4, 8, or -16, to obtain a multiplier less than $2^{23}$, and we can compensate for -this later. If |z| has thereby been replaced by $|z|^\prime=|z|/2^e$, let -$\beta=2^{4-e}$; we shall compute -$$\lfloor(b+c\cdot2^{-8}+d\cdot2^{-16})\,z^\prime/\beta\rfloor$$ if $a=0$, -or the same quantity minus $\alpha=2^{4+e}z^\prime$ if $a=255$. -This calculation must be done exactly, for the reasons stated above; the -following program does the job in a system-independent way, assuming -that arithmetic is exact on numbers less than $2^{31}$ in magnitude. We -use \.{WEB} macros for various versions of this computation. -@^system dependencies@> -@^optimization@> - -@d tfm_fix3u== {convert |tfm_b1..tfm_b3| to an unsigned scaled dimension} -(((((tfm_b3*z)div@'400)+(tfm_b2*z))div@'400)+(tfm_b1*z))div beta -@# -@d tfm_fix4(#)== {convert |tfm_b0..tfm_b3| to a scaled dimension} - #:=tfm_fix3u; - if tfm_b0>0 then if tfm_b0=255 then Decr(#)(alpha) else bad_font -@d tfm_fix3(#)== {convert |tfm_b1..tfm_b3| to a scaled dimension} - #:=tfm_fix3u; @+ if tfm_b1>127 then Decr(#)(alpha) -@d tfm_fix2== {convert |tfm_b2..tfm_b3| to a scaled dimension} - if tfm_b2>127 then tfm_b1:=255 else tfm_b1:=0; - tfm_fix3 -@d tfm_fix1== {convert |tfm_b3| to a scaled dimension} - if tfm_b3>127 then tfm_b1:=255 else tfm_b1:=0; - tfm_b2:=tfm_b1; tfm_fix3 - -@<Variables for scaling computation@>= -@!z:int_32; {multiplier} -@!alpha:int_32; {correction for negative values} -@!beta:int_15; {divisor} - -@ @<Replace |z| by $|z|^\prime$ and compute $\alpha,\beta$@>= -alpha:=16; -while z>=@'40000000 do - begin z:=z div 2; alpha:=alpha+alpha; - end; -beta:=256 div alpha; alpha:=alpha*z - -@ The first width value, which indicates that a character does not exist -and which must vanish, is converted to |invalid_width|; the other width -values are scaled by |font_scaled(cur_fnt)| and converted to width -pointers by |make_width|. The resulting width pointers are stored -temporarily in the |char_widths| array, following the with indices. - -@<TFM: Read and convert the width values@>= -if nw-1>max_chars-n_chars then overflow(str_chars,max_chars); -if (tfm_b0<>0)or(tfm_b1<>0)or(tfm_b2<>0)or(tfm_b3<>0) then bad_font - else char_widths[n_chars]:=invalid_width; -z:=font_scaled(cur_fnt); -@<Replace |z|...@>; -for p:=n_chars+1 to n_chars+nw-1 do - begin read_tfm_word; tfm_fix4(w); - char_widths[p]:=make_width(w); - end - -@ We simply translate the width indices into width pointers. In addition -we initialize the character packets with the invalid packet. - -@<TFM: Convert character-width indices to character-width pointers@>= -for p:=font_chars(cur_fnt)+bc to n_chars-1 do - begin q:=char_widths[n_chars+char_widths[p]]; char_widths[p]:=q; - char_packets[p]:=invalid_packet; - end - -@ When processing a font definition we put the data extracted from the -\.{DVI} or \.{VF} file into position |nf| of the font data arrays and -call |define_font| to obtain the internal font number for this font. -The parameter |load| is true if the \.{TFM} file should be loaded. - -@p function define_font(@!load:boolean):font_number; -var save_fnt:font_number; {used to save |cur_fnt|} -begin save_fnt:=cur_fnt; {save} -cur_fnt:=0; -while (font_name(cur_fnt)<>font_name(nf))or@| - (font_scaled(cur_fnt)<>font_scaled(nf)) do incr(cur_fnt); -d_print(' => ',cur_fnt:1); print_font(cur_fnt); -if cur_fnt<nf then - begin check_check_sum(font_check(nf),true); - check_design_size(font_design(nf)); - @!debug if font_type(cur_fnt)=defined_font then print(' defined') - else print(' loaded'); - print(' previously'); - gubed@; - end -else begin if nf=max_fonts then overflow(str_fonts,max_fonts); - incr(nf); font_font(cur_fnt):=invalid_font; - font_type(cur_fnt):=defined_font; - d_print(' defined'); - end; -print_ln('.'); -if load and(font_type(cur_fnt)=defined_font) then load_font; -define_font:=cur_fnt; -cur_fnt:=save_fnt; {restore} -end; - -@* Low-level DVI input routines. -The program uses the binary file variable |dvi_file| for its main input -file; |dvi_loc| is the number of the byte about to be read next from -|dvi_file|. - -@<Glob...@>= -@!dvi_file:byte_file; {the stuff we are \.{\title}ing} -@!dvi_loc:int_32; {where we are about to look, in |dvi_file|} - -@ If the \.{DVI} file is badly malformed, we say |bad_dvi|; this -procedure gives an error message which refers the user to \.{DVItype}, -and terminates \.{\title}. - -@<Error handling...@>= -procedure bad_dvi; -begin new_line; print_ln('Bad DVI file: loc=',dvi_loc:1,'!'); -@.Bad DVI file@> -print(' Use DVItype with output level'); -@.Use DVItype@> -if random_reading then print('=4') @+ else print('<4'); -abort('to diagnose the problem'); -end; - -@ To prepare |dvi_file| for input, we |reset| it. - -@<Open input file(s)@>= -reset(dvi_file); {prepares to read packed bytes from |dvi_file|} -dvi_loc:=0; - -@ Reading the \.{DVI} file should be done as efficient as possible for a -particular system; on many systems this means that a large number of -bytes from |dvi_file| is read into a buffer and will then be extracted -from that buffer. In order to simplify such system dependent changes -we use a pair of \.{WEB} macros: |dvi_byte| extracts the next \.{DVI} -byte and |dvi_eof| is |true| if we have reached the end of the \.{DVI} -file. Here we give simple minded definitions for these macros in terms -of standard \PASCAL. -@^system dependencies@> -@^optimization@> - -@d dvi_eof == eof(dvi_file) {has the \.{DVI} file been exhausted?} -@d dvi_byte(#) == - if dvi_eof then bad_dvi - else read(dvi_file,#) {obtain next \.{DVI} byte} - -@ Next we come to the routines that are used only if |random_reading| is -|true|. The driver program below needs two such routines: |dvi_length| should -compute the total number of bytes in |dvi_file|, possibly also -causing |eof(dvi_file)| to be true; and |dvi_move(n)| should position -|dvi_file| so that the next |dvi_byte| will read byte |n|, starting with -|n=0| for the first byte in the file. -@^system dependencies@> - -Such routines are, of course, highly system dependent. They are implemented -here in terms of two assumed system routines called |set_pos| and |cur_pos|. -The call |set_pos(f,n)| moves to item |n| in file |f|, unless |n| is -negative or larger than the total number of items in |f|; in the latter -case, |set_pos(f,n)| moves to the end of file |f|. -The call |cur_pos(f)| gives the total number of items in |f|, if -|eof(f)| is true; we use |cur_pos| only in such a situation. - -@p function dvi_length:int_32; -begin set_pos(dvi_file,-1); dvi_length:=cur_pos(dvi_file); -end; -@# -procedure dvi_move(@!n:int_32); -begin set_pos(dvi_file,n); dvi_loc:=n; -end; - -@ We need seven simple functions to read the next byte or bytes -from |dvi_file|. - -@p function dvi_sbyte:int_8; {returns the next byte, signed} -@!begin_byte(dvi_byte); incr(dvi_loc); comp_sbyte(dvi_sbyte); -end; -@# -function dvi_ubyte:int_8u; {returns the next byte, unsigned} -@!begin_byte(dvi_byte); incr(dvi_loc); comp_ubyte(dvi_ubyte); -end; -@# -function dvi_spair:int_16; {returns the next two bytes, signed} -@!begin_pair(dvi_byte); Incr(dvi_loc)(2); comp_spair(dvi_spair); -end; -@# -function dvi_upair:int_16u; {returns the next two bytes, unsigned} -@!begin_pair(dvi_byte); Incr(dvi_loc)(2); comp_upair(dvi_upair); -end; -@# -function dvi_strio:int_24; {returns the next three bytes, signed} -@!begin_trio(dvi_byte); Incr(dvi_loc)(3); comp_strio(dvi_strio); -end; -@# -function dvi_utrio:int_24u; {returns the next three bytes, unsigned} -@!begin_trio(dvi_byte); Incr(dvi_loc)(3); comp_utrio(dvi_utrio); -end; -@# -function dvi_squad:int_32; {returns the next four bytes, signed} -@!begin_quad(dvi_byte); Incr(dvi_loc)(4); comp_squad(dvi_squad); -end; - -@ Three other functions are used in cases where a four byte integer -(which is always signed) must have a non-negative value, a positive -value, or is a pointer which must be either positive or |=-1|. - -@p function dvi_uquad:int_31; {result must be non-negative} -var x:int_32; -begin x:=dvi_squad; if x<0 then bad_dvi -else dvi_uquad:=x; -end; -@# -function dvi_pquad:int_31; {result must be positive} -var x:int_32; -begin x:=dvi_squad; if x<=0 then bad_dvi -else dvi_pquad:=x; -end; -@# -function dvi_pointer:int_32; {result must be positive or |=-1|} -var x:int_32; -begin x:=dvi_squad; if (x<=0)and(x<>-1) then bad_dvi -else dvi_pointer:=x; -end; - -@ Given the structure of the \.{DVI} commands it is fairly obvious -that their interpretation consists of two steps: First zero to four -bytes are read in order to obtain the value of the first parameter -(e.g., zero bytes for |set_char_0|, four bytes for |set4|); then, -depending on the command class, a specific action is performed (e.g., -typeset a character but don't move the reference point for |put1..put4|). - -The \.{DVItype} program uses large case statements for both steps; -unfortunately some \PASCAL\ compilers fail to implement large case -statements efficiently -- in particular those as the one used in the -|first_par| function of \.{DVItype}. Here we use a pair of look up tables: -|dvi_par| determines how to obtain the value of the first parameter, and -|dvi_cl| determines the command class. - -A slight complication arises from the fact that we want to decompose the -character code of each character to be typeset into a residue -|0<=char_res<256| and extension: |char_code=char_res+256*char_ext|; -the \.{TFM} widths as well as the pixel widths for a given resolution -are the same for all characters in a font with the same residue. - -@d two_cases(#)==#,#+1 -@d three_cases(#)==#,#+1,#+2 -@d five_cases(#)==#,#+1,#+2,#+3,#+4 - -@ First we define the values used as array elements of |dvi_par|; we -distinguish between pure numbers and dimensions because dimensions read -from a \.{VF} file must be scaled. - -@d char_par=0 {character for \\{set} and |put|} -@d no_par=1 {no parameter} -@d dim1_par=2 {one-byte signed dimension} -@d num1_par=3 {one-byte unsigned number} -@d dim2_par=4 {two-byte signed dimension} -@d num2_par=5 {two-byte unsigned number} -@d dim3_par=6 {three-byte signed dimension} -@d num3_par=7 {three-byte unsigned number} -@d dim4_par=8 {four-byte signed dimension} -@d num4_par=9 {four-byte signed number} -@d numu_par=10 {four-byte non-negative number} -@d rule_par=11 {dimensions for |set_rule| and |put_rule|} -@d fnt_par=12 {font for |fnt_num| commands} -@d max_par=12 {largest possible value} - -@<Types...@>= -@!cmd_par=char_par..max_par; - -@ Here we declare the array |dvi_par|. - -@<Globals...@>= -@!dvi_par:packed array [eight_bits] of cmd_par; - -@ And here we initialize it. - -@<Set init...@>= -for i:=0 to put1+3 do dvi_par[i]:=char_par;@/ -for i:=nop to 255 do dvi_par[i]:=no_par;@/ -dvi_par[set_rule]:=rule_par; dvi_par[put_rule]:=rule_par;@/ -dvi_par[right1]:=dim1_par; dvi_par[right1+1]:=dim2_par; -dvi_par[right1+2]:=dim3_par; dvi_par[right1+3]:=dim4_par;@/ -for i:=fnt_num_0 to fnt_num_0+63 do dvi_par[i]:=fnt_par;@/ -dvi_par[fnt1]:=num1_par; dvi_par[fnt1+1]:=num2_par; -dvi_par[fnt1+2]:=num3_par; dvi_par[fnt1+3]:=num4_par;@/ -dvi_par[xxx1]:=num1_par; dvi_par[xxx1+1]:=num2_par; -dvi_par[xxx1+2]:=num3_par; dvi_par[xxx1+3]:=numu_par;@/ -for i:=0 to 3 do - begin dvi_par[i+w1]:=dvi_par[i+right1]; - dvi_par[i+x1]:=dvi_par[i+right1]; - dvi_par[i+down1]:=dvi_par[i+right1]; - dvi_par[i+y1]:=dvi_par[i+right1]; - dvi_par[i+z1]:=dvi_par[i+right1]; - dvi_par[i+fnt_def1]:=dvi_par[i+fnt1]; - end; - -@ Next we define the values used as array elements of |dvi_cl|; -several \.{DVI} commands (e.g., |nop|, |bop|, |eop|, |pre|, |post|) will -always be treated separately and are therefore assigned to the invalid -class here. - -@d char_cl=0 -@d rule_cl=char_cl+1 -@d xxx_cl=char_cl+2 -@d push_cl=3 -@d pop_cl=4 -@d w0_cl=5 -@d x0_cl=w0_cl+1 -@d right_cl=w0_cl+2 -@d w_cl=w0_cl+3 -@d x_cl=w0_cl+4 -@d y0_cl=10 -@d z0_cl=y0_cl+1 -@d down_cl=y0_cl+2 -@d y_cl=y0_cl+3 -@d z_cl=y0_cl+4 -@d fnt_cl=15 -@d fnt_def_cl=16 -@d invalid_cl=17 -@d max_cl=invalid_cl {largest possible value} - -@<Types...@>= -@!cmd_cl=char_cl..max_cl; - -@ Here we declare the array |dvi_cl|. - -@<Globals...@>= -@!dvi_cl:packed array [eight_bits] of cmd_cl; - -@ And here we initialize it. - -@<Set init...@>= -for i:=set_char_0 to put1+3 do dvi_cl[i]:=char_cl; -dvi_cl[set_rule]:=rule_cl; dvi_cl[put_rule]:=rule_cl;@/ -dvi_cl[nop]:=invalid_cl; -dvi_cl[bop]:=invalid_cl; dvi_cl[eop]:=invalid_cl;@/ -dvi_cl[push]:=push_cl; dvi_cl[pop]:=pop_cl;@/ -dvi_cl[w0]:=w0_cl; dvi_cl[x0]:=x0_cl;@/ -dvi_cl[y0]:=y0_cl; dvi_cl[z0]:=z0_cl;@/ -for i:=0 to 3 do - begin dvi_cl[i+right1]:=right_cl; - dvi_cl[i+w1]:=w_cl; - dvi_cl[i+x1]:=x_cl;@/ - dvi_cl[i+down1]:=down_cl; - dvi_cl[i+y1]:=y_cl; - dvi_cl[i+z1]:=z_cl;@/ - dvi_cl[i+xxx1]:=xxx_cl; - dvi_cl[i+fnt_def1]:=fnt_def_cl; - end; -for i:=fnt_num_0 to fnt1+3 do dvi_cl[i]:=fnt_cl; -for i:=pre to 255 do dvi_cl[i]:=invalid_cl; - -@ A few small arrays are used to generate \.{DVI} commands. - -@<Glob...@>= -@!dvi_char_cmd:array[boolean] of eight_bits; {|put1| and |set1|} -@!dvi_rule_cmd:array[boolean] of eight_bits; {|put_rule| and |set_rule|} -@!dvi_right_cmd:array[right_cl..x_cl] of eight_bits; {|right1|, |w1|, and |x1|} -@!dvi_down_cmd:array[down_cl..z_cl] of eight_bits; {|down1|, |y1|, and |z1|} - -@ @<Set init...@>= -dvi_char_cmd[false]:=put1; -dvi_char_cmd[true]:=set1;@/ -dvi_rule_cmd[false]:=put_rule; -dvi_rule_cmd[true]:=set_rule;@/ -dvi_right_cmd[right_cl]:=right1; -dvi_right_cmd[w_cl]:=w1; -dvi_right_cmd[x_cl]:=x1;@/ -dvi_down_cmd[down_cl]:=down1; -dvi_down_cmd[y_cl]:=y1; -dvi_down_cmd[z_cl]:=z1; - -@ The global variables |cur_cmd|, |cur_parm|, and |cur_class| are used -for the current \.{DVI} command, its first parameter (if any), and its -command class respectively. - -@<Glob...@>= -@!cur_cmd:eight_bits; {current \.{DVI} command byte} -@!cur_parm:int_32; {its first parameter (if any)} -@!cur_class:cmd_cl; {its class} - -@ When typesetting a character or rule, the boolean variable |cur_upd| -is |true| for \\{set} commands, |false| for |put| commands. - -@<Glob...@>= -@!cur_cp:char_pointer; {|char_widths| index for the current character} -@!cur_wp:width_pointer; {width pointer of the current character} -@!cur_upd:boolean; {is this a \\{set} or |set_rule| command ?} -@!cur_v_dimen:int_32; {a vertical dimension} -@!cur_h_dimen:int_32; {a horizontal dimension} - -@ @<Set init...@>= -cur_cp:=0; cur_wp:=invalid_width; {so they can be saved and restored!} - -@ The |dvi_first_par| procedure first reads \.{DVI} command bytes into -|cur_cmd| until |cur_cmd<>nop|; then |cur_parm| is set to the value of -the first parameter (if any) and |cur_class| to the command class. - -@d set_cur_char(#)== {set up |cur_res|, |cur_ext|, and |cur_upd|} -begin cur_ext:=0; -if cur_cmd<set1 then - begin cur_res:=cur_cmd; cur_upd:=true - end -else begin cur_res:=#; cur_upd:=(cur_cmd<put1); - Decr(cur_cmd)(dvi_char_cmd[cur_upd]); - while cur_cmd>0 do - begin if cur_cmd=3 then if cur_res>127 then cur_ext:=-1; - cur_ext:=cur_ext*256+cur_res; cur_res:=#; decr(cur_cmd); - end; - end; -end - -@p procedure dvi_first_par; -begin repeat cur_cmd:=dvi_ubyte; -until cur_cmd<>nop; {skip over |nop|s} -case dvi_par[cur_cmd] of -char_par: set_cur_char(dvi_ubyte); -no_par: do_nothing; -dim1_par: cur_parm:=dvi_sbyte; -num1_par: cur_parm:=dvi_ubyte; -dim2_par: cur_parm:=dvi_spair; -num2_par: cur_parm:=dvi_upair; -dim3_par: cur_parm:=dvi_strio; -num3_par: cur_parm:=dvi_utrio; -two_cases(dim4_par): cur_parm:=dvi_squad; {|dim4_par| and |num4_par|} -numu_par: cur_parm:=dvi_uquad; -rule_par: - begin cur_v_dimen:=dvi_squad; cur_h_dimen:=dvi_squad; - cur_upd:=(cur_cmd=set_rule); - end; -fnt_par:cur_parm:=cur_cmd-fnt_num_0; -othercases abort('internal error'); -endcases; -cur_class:=dvi_cl[cur_cmd]; -end; - -@ The global variable |dvi_nf| is used for the number of different -\.{DVI} fonts defined so far; their external font numbers (as extracted -from the \.{DVI} file) are stored in the array |dvi_e_fnts|, the -corresponding internal font numbers used internally by \.{\title} are -stored in the array |dvi_i_fnts|. - -@<Glob...@>= -@!dvi_e_fnts:array[font_number] of int_32; {external font numbers} -@!dvi_i_fnts:array[font_number] of font_number; {corresponding - internal font numbers} -@!dvi_nf:font_number; {number of \.{DVI} fonts defined so far} - -@ @<Set ini...@>= -dvi_nf:=0; - -@ The |dvi_font| procedure sets |cur_fnt| to the internal font number -corresponding to the external font number |cur_parm| (or aborts the -program if such a font was never defined). - -@p procedure dvi_font; {computes |cur_fnt| corresponding to |cur_parm|} -var f:font_number; {where the font is sought} -begin @<DVI: Locate font |cur_parm|@>; -if f=dvi_nf then bad_dvi; -cur_fnt:=dvi_i_fnts[f]; -if font_type(cur_fnt)=defined_font then load_font; -end; - -@ @<DVI: Locate font |cur_parm|@>= -f:=0; dvi_e_fnts[dvi_nf]:=cur_parm; -while cur_parm<>dvi_e_fnts[f] do incr(f) - -@ Finally the |dvi_do_font| procedure is called when one of the commands -|fnt_def1..fnt_def4| and its first parameter have been read from the -\.{DVI} file; the argument indicates whether this should be the second -definition of the font (|true|) or not (|false|). - -@p procedure dvi_do_font(@!second:boolean); -var f:font_number; {where the font is sought} -@!k:int_15; {general purpose variable} -begin print('DVI: font ',cur_parm:1); -@<DVI: Locate font |cur_parm|@>; -if (f=dvi_nf)=second then bad_dvi; -font_check(nf):=dvi_squad; -font_scaled(nf):=dvi_pquad; -font_design(nf):=dvi_pquad; -k:=dvi_ubyte; pckt_room(1); append_byte(k); -Incr(k)(dvi_ubyte); pckt_room(k); -while k>0 do begin append_byte(dvi_ubyte); decr(k); - end; -font_name(nf):=make_packet; {the font area plus name} -dvi_i_fnts[dvi_nf]:=define_font(false); -if not second then - begin if dvi_nf=max_fonts then overflow(str_fonts,max_fonts); - incr(dvi_nf); - end -else if dvi_i_fnts[f]<>dvi_i_fnts[dvi_nf] then bad_dvi; -end; - -@* Low-level VF input routines. -A detailed description of the \.{VF} file format can be found in the -documentation of \.{VFtoVP}; here we just define symbolic names for -some of the \.{VF} command bytes. - -@d long_char=242 {\.{VF} command for general character packet} -@# -@d vf_id=202 {identifies \.{VF} files} - -@ The program uses the binary file variable |vf_file| for input from -\.{VF} files; |vf_loc| is the number of the byte about to be read next -from |vf_file|. - -@<Glob...@>= -@!vf_file:byte_file; {a \.{VF} file} -@!vf_loc:int_32; {where we are about to look, in |vf_file|} -@!vf_limit:int_32; {value of |vf_loc| at end of a character packet} -@!vf_ext:pckt_pointer; {extension for \.{VF} files} -@!vf_cur_fnt:font_number; {current font number in a \.{VF} file} - -@ @<Initialize predefined strings@>= -id3(".")("V")("F")(vf_ext); {file name extension for \.{VF} files} - -@ If a \.{VF} file is badly malformed, we say |bad_font|; this procedure -gives an error message which refers the user to \.{VFtoVP} and \.{VPtoVF}, -and terminates \.{\title}. - -@<Cases for |bad_font|@>= -vf_font_type: begin print('Bad VF file'); print_font(cur_fnt); -@.Bad VF file@> - print_ln(' loc=',vf_loc:1); - abort('Use VFtoVP/VPtoVF to diagnose and correct the problem'); -@.Use VFtoVP/VPtoVF@> - end; - -@ If no font directory has been specified, \.{\title} is supposed to use -the default \.{VF} directory, which is a system-dependent place where -the \.{VF} files for standard fonts are kept. -The string variable |VF_default_area| contains the name of this area. -@^system dependencies@> - -@d VF_default_area_name=='TeXvfonts:' {change this to the correct name} -@d VF_default_area_name_length=10 {change this to the correct length} - -@<Glob...@>= -@!VF_default_area:packed array[1..VF_default_area_name_length] of char; - -@ @<Set init...@>= -VF_default_area:=VF_default_area_name; - -@ To prepare |vf_file| for input we |reset| it. - -@<VF: Open |vf_file| or |goto not_found|@>= -make_font_name(VF_default_area_name_length)(VF_default_area)(vf_ext); -reset(vf_file,cur_name); -if eof(vf_file) then -@^system dependencies@> - goto not_found; -vf_loc:=0 - -@ Reading a \.{VF} file should be done as efficient as possible for a -particular system; on many systems this means that a large number of -bytes from |vf_file| is read into a buffer and will then be extracted -from that buffer. In order to simplify such system dependent changes -we use a pair of \.{WEB} macros: |vf_byte| extracts the next \.{VF} -byte and |vf_eof| is |true| if we have reached the end of the \.{VF} -file. Here we give simple minded definitions for these macros in terms -of standard \PASCAL. -@^system dependencies@> -@^optimization@> - -@d vf_eof == eof(vf_file) {has the \.{VF} file been exhausted?} -@d vf_byte(#) == - if vf_eof then bad_font - else read(vf_file,#) {obtain next \.{VF} byte} - -@ We need several simple functions to read the next byte or bytes -from |vf_file|. - -@p function vf_ubyte:int_8u; {returns the next byte, unsigned} -@!begin_byte(vf_byte); incr(vf_loc); comp_ubyte(vf_ubyte); -end; -@# -function vf_upair:int_16u; {returns the next two bytes, unsigned} -@!begin_pair(vf_byte); Incr(vf_loc)(2); comp_upair(vf_upair); -end; -@# -function vf_strio:int_24; {returns the next three bytes, signed} -@!begin_trio(vf_byte); Incr(vf_loc)(3); comp_strio(vf_strio); -end; -@# -function vf_utrio:int_24u; {returns the next three bytes, unsigned} -@!begin_trio(vf_byte); Incr(vf_loc)(3); comp_utrio(vf_utrio); -end; -@# -function vf_squad:int_32; {returns the next four bytes, signed} -@!begin_quad(vf_byte); Incr(vf_loc)(4); comp_squad(vf_squad); -end; - -@ All dimensions in a \.{VF} file, except the design sizes of a virtual -font and its local fonts, are |fix_word|s that must be scaled in exactly -the same way as the character widths from a \.{TFM} file; we can use the -same code, but this time |z|, |alpha|, and |beta| are global variables. - -@<Glob...@>= -@<Variables for scaling computation@>@; - -@ We need five functions to read the next byte or bytes and convert a -|fix_word| to a scaled dimension. - -@p function vf_fix1:int_32; {returns the next byte as scaled value} -var x:int_32; {accumulator} -begin vf_byte(tfm_b3); incr(vf_loc); -tfm_fix1(x); vf_fix1:=x; -end; -@# -function vf_fix2:int_32; {returns the next two bytes as scaled value} -var x:int_32; {accumulator} -begin vf_byte(tfm_b2); vf_byte(tfm_b3); Incr(vf_loc)(2); -tfm_fix2(x); vf_fix2:=x; -end; -@# -function vf_fix3:int_32; {returns the next three bytes as scaled value} -var x:int_32; {accumulator} -begin vf_byte(tfm_b1); vf_byte(tfm_b2); vf_byte(tfm_b3); -Incr(vf_loc)(3);@/ -tfm_fix3(x); vf_fix3:=x; -end; -@# -function vf_fix3u:int_32; {returns the next three bytes as scaled value} -begin vf_byte(tfm_b1); vf_byte(tfm_b2); vf_byte(tfm_b3); -Incr(vf_loc)(3);@/ -vf_fix3u:=tfm_fix3u; -end; -@# -function vf_fix4:int_32; {returns the next four bytes as scaled value} -var x:int_32; {accumulator} -begin vf_byte(tfm_b0); vf_byte(tfm_b1); vf_byte(tfm_b2); vf_byte(tfm_b3); -Incr(vf_loc)(4);@/ -tfm_fix4(x); vf_fix4:=x; -end; - -@ Three other functions are used in cases where the result must have a -non-negative value or a positive value. - -@p function vf_uquad:int_31; {result must be non-negative} -var x:int_32; -begin x:=vf_squad; if x<0 then bad_font @+ else vf_uquad:=x; -end; -@# -function vf_pquad:int_31; {result must be positive} -var x:int_32; -begin x:=vf_squad; if x<=0 then bad_font @+ else vf_pquad:=x; -end; -@# -function vf_fixp:int_31; {result must be positive} -begin vf_byte(tfm_b0); vf_byte(tfm_b1); vf_byte(tfm_b2); vf_byte(tfm_b3); -Incr(vf_loc)(4);@/ -if tfm_b0>0 then bad_font; -vf_fixp:=tfm_fix3u; -end; - -@ The |vf_first_par| procedure first reads a \.{VF} command byte into -|cur_cmd|; then |cur_parm| is set to the value of the first parameter -(if any) and |cur_class| to the command class. - -@d set_cur_wp_end(#)== if cur_wp=invalid_width then # -@d set_cur_wp(#)== {set |cur_wp| to the char's width pointer} -cur_wp:=invalid_width; -if #<>invalid_font then - if (cur_res>=font_bc(#))and(cur_res<=font_ec(#)) then - begin cur_cp:=font_chars(#)+cur_res; cur_wp:=char_widths[cur_cp]; - end; -set_cur_wp_end - -@p procedure vf_first_par; -begin cur_cmd:=vf_ubyte; -case dvi_par[cur_cmd] of -char_par: - begin set_cur_char(vf_ubyte); set_cur_wp(vf_cur_fnt)(bad_font); - end; -no_par: do_nothing; -dim1_par: cur_parm:=vf_fix1; -num1_par: cur_parm:=vf_ubyte; -dim2_par: cur_parm:=vf_fix2; -num2_par: cur_parm:=vf_upair; -dim3_par: cur_parm:=vf_fix3; -num3_par: cur_parm:=vf_utrio; -dim4_par: cur_parm:=vf_fix4; -num4_par: cur_parm:=vf_squad; -numu_par: cur_parm:=vf_uquad; -rule_par: - begin cur_v_dimen:=vf_fix4; cur_h_dimen:=vf_fix4; - cur_upd:=(cur_cmd=set_rule); - end; -fnt_par:cur_parm:=cur_cmd-fnt_num_0; -othercases abort('internal error'); -endcases; -cur_class:=dvi_cl[cur_cmd]; -end; - -@ For a virtual font we set |font_type(f):=vf_font_type|; in this case -|font_font(f)| is the default font for character packets from virtual -font~|f|. -@^font types@> - -The global variable |vf_nf| is used for the number of different local -fonts defined in a \.{VF} file so far; their external font numbers (as -extracted from the \.{VF} file) are stored in the array |vf_e_fnts|, the -corresponding internal font numbers used internally by \.{\title} are -stored in the array |vf_i_fnts|. - -@<Glob...@>= -@!vf_e_fnts:array[font_number] of int_32; {external font numbers} -@!vf_i_fnts:array[font_number] of font_number; {corresponding - internal font numbers} -@!vf_nf:font_number; {number of local fonts defined so far} -@!lcl_nf:font_number; {largest |vf_nf| value for any \.{VF} file} - -@ @<Set init...@>= -lcl_nf:=0; - -@ The |vf_font| procedure sets |vf_cur_fnt| to the internal font number -corresponding to the external font number |cur_parm| (or aborts the -program if such a font was never defined). - -@p procedure vf_font; {computes |vf_cur_fnt| corresponding to |cur_parm|} -var f:font_number; {where the font is sought} -begin @<VF: Locate font |cur_parm|@>; -if f=vf_nf then bad_font; -vf_cur_fnt:=vf_i_fnts[f]; -end; - -@ @<VF: Locate font |cur_parm|@>= -f:=0; vf_e_fnts[vf_nf]:=cur_parm; -while cur_parm<>vf_e_fnts[f] do incr(f) - -@ Finally the |vf_do_font| procedure is called when one of the commands -|fnt_def1..fnt_def4| and its first parameter have been read from the -\.{VF} file. - -@p procedure vf_do_font; -var f:font_number; {where the font is sought} -@!k:int_15; {general purpose variable} -begin print('VF: font ',cur_parm:1);@/ -@<VF: Locate font |cur_parm|@>; -if f<>vf_nf then bad_font; -font_check(nf):=vf_squad; -font_scaled(nf):=vf_fixp; -font_design(nf):=round(tfm_conv*vf_pquad); -k:=vf_ubyte; pckt_room(1); append_byte(k); -Incr(k)(vf_ubyte); pckt_room(k); -while k>0 do begin append_byte(vf_ubyte); decr(k); - end; -font_name(nf):=make_packet; {the font area plus name} -vf_i_fnts[vf_nf]:=define_font(true); -if vf_nf=lcl_nf then - if lcl_nf=max_fonts then overflow(str_fonts,max_fonts) - else incr(lcl_nf); -incr(vf_nf); -end; - -@* Reading VF files. -The |do_vf| function attempts to read the \.{VF} file for a font and -returns |false| if the \.{VF} file could not be found; otherwise the -font type is changed to |vf_font_type|. - -@p function do_vf:boolean; {read a \.{VF} file} -label reswitch,done,not_found,exit; -var temp_byte:int_8u; {byte for temporary variables} -@!k:byte_pointer; {index into |byte_mem|} -@!l:int_15; {general purpose variable} -@!save_ext:int_24; {used to save |cur_ext|} -@!save_res:int_8u; {used to save |cur_res|} -@!save_cp:width_pointer; {used to save |cur_cp|} -@!save_wp:width_pointer; {used to save |cur_wp|} -@!save_upd:boolean; {used to save |cur_upd|} -@!vf_wp:width_pointer; {width pointer for the current character packet} -@!vf_fnt:font_number; {current font in the current character packet} -@!move_zero:boolean; {|true| if rule 1 is used} -@!last_pop:boolean; {|true| if final |pop| has been manufactured} -begin @<VF: Open |vf_file| or |goto not_found|@>; -save_ext:=cur_ext; save_res:=cur_res; save_cp:=cur_cp; save_wp:=cur_wp; -save_upd:=cur_upd; {save} -font_type(cur_fnt):=vf_font_type;@/ -@<VF: Process the preamble@>;@/ -@<VF: Process the font definitions@>;@/ -while cur_cmd<=long_char do @<VF: Build a character packet@>; -if cur_cmd<>post then bad_font; -@!debug print('VF file for font ',cur_fnt:1); print_font(cur_fnt); -print_ln(' loaded.'); -gubed @;@/ -close_in(vf_file); -cur_ext:=save_ext; cur_res:=save_res; cur_cp:=save_cp; cur_wp:=save_wp; -cur_upd:=save_upd; {restore} -do_vf:=true; return; -not_found:do_vf:=false; -exit:end; - -@ @<VF: Process the preamble@>= -if vf_ubyte<>pre then bad_font; -if vf_ubyte<>vf_id then bad_font; -temp_byte:=vf_ubyte; pckt_room(temp_byte); -for l:=1 to temp_byte do append_byte(vf_ubyte); -print('VF file: '''); print_packet(new_packet); print(''','); -flush_packet;@/ -check_check_sum(vf_squad,false); -check_design_size(round(tfm_conv*vf_pquad));@/ -z:=font_scaled(cur_fnt); -@<Replace |z|...@>;@/ -print_nl(' for font ',cur_fnt:1); print_font(cur_fnt); print_ln('.') - -@ @<VF: Process the font definitions@>= -vf_i_fnts[0]:=invalid_font; vf_nf:=0;@/ -cur_cmd:=vf_ubyte; -while (cur_cmd>=fnt_def1)and(cur_cmd<=fnt_def1+3) do - begin case cur_cmd-fnt_def1 of - 0: cur_parm:=vf_ubyte; - 1: cur_parm:=vf_upair; - 2: cur_parm:=vf_utrio; - 3: cur_parm:=vf_squad; - end; {there are no other cases} - vf_do_font; - cur_cmd:=vf_ubyte; - end; -font_font(cur_fnt):=vf_i_fnts[0] - -@ The \.{VF} format specifies that the interpretation of each packet -begins with |w=x=y=z=0|; any |w0|, |x0|, |y0|, or |z0| command using -these initial values will be ignored. - -@<Types...@>= -@!vf_state=array[0..1,0..1] of boolean; {state of |w|, |x|, |y|, and |z|} - -@ As implied by the \.{VF} format the \.{DVI} commands read from the \.{VF} -file are enclosed by |push| and |pop|; as we read \.{DVI} -commands and append them to |byte_mem|, we perform a set of -transformations in order to simplify the resulting packet: Let |zero| be -any of the commands |put|, |put_rule|, |fnt_num|, |fnt|, or |xxx| which -all leave the current position on the page unchanged, let |move| be any -of the horizontal or vertical movement commands |right1..z4|, and let -|any| be any sequence of commands containing |push| and |pop| in -properly nested pairs; whenever possible we apply one of the following -transformation rules: $$\def\n#1:{\hbox to 3cm{\hfil#1:}} -\leqalignno{ -\hbox{|push| |zero|}&\RA\hbox{|zero| |push|}&\n1:\cr -\hbox{|move| |pop|}&\RA\hbox{|pop|}&\n2:\cr -\hbox{|push| |pop|}&\RA{}&\n3:\cr -\hbox{|push| |set_char| |pop|}&\RA\hbox{|put|}&\n4a:\cr -\hbox{|push| \\{set} |pop|}&\RA\hbox{|put|}&\n4b:\cr -\hbox{|push| |set_rule| |pop|}&\RA\hbox{|put_rule|}&\n4c:\cr -\hbox{|push| |push| |any| |pop|}&\RA\hbox{|push| |any| |pop| |push|}&\n5:\cr -\hbox{|push| |any| |pop| |pop|}&\RA\hbox{|any| |pop|}&\n6:\cr -}$$ - -@ In order to perform these transformations we need a stack which is -indexed by |vf_ptr|, the number of |push| commands without corresponding -|pop| in the packet we are building; the |vf_push_loc| array contains -the locations in |byte_mem| following such |push| commands. -In view of rule~5 consecutive |push| commands are never stored, the -|vf_push_num| array is used to count them. -The |vf_last| array indicates the type of the last non-discardable item: -a character, a rule, or a group enclosed by |push| and |pop|; -the |vf_last_end| array points to the ending locations and, if -|vf_last<>vf_other|, the |vf_last_loc| array points to the starting -locations of these items. - -@d vf_set=0 {|vf_set=char_cl|, last item is a |set_char| or \\{set}} -@d vf_rule=1 {|vf_rule=rule_cl|, last item is a |set_rule|} -@d vf_group=2 {last item is a group enclosed by |push| and |pop|} -@d vf_put=3 {last item is a |put|} -@d vf_other=4 {last item (if any) is none of the above} - -@<Types...@>= -@!vf_type=vf_set..vf_other; - -@ @<Glob...@>= -@!vf_move: array[stack_pointer] of vf_state; {state of |w|, |x|, |y|, and |z|} -@!vf_push_loc: array[stack_pointer] of byte_pointer; {end of a |push|} -@!vf_last_loc: array[stack_pointer] of byte_pointer; {start of an item} -@!vf_last_end: array[stack_pointer] of byte_pointer; {end of an item} -@!vf_push_num: array[stack_pointer] of eight_bits; {|push| count} -@!vf_last: array[stack_pointer] of vf_type; {type of last item} -@!vf_ptr:stack_pointer; {current number of unfinished groups} -@!stack_used:stack_pointer; {largest |vf_ptr| or |stack_ptr| value} - -@ We use two small arrays to determine the item type of a character or a -rule. - -@<Glob...@>= -@!vf_char_type:array[boolean] of vf_type; -@!vf_rule_type:array[boolean] of vf_type; - -@ @<Set init...@>= -vf_move[0][0][0]:=false; vf_move[0][0][1]:=false; -vf_move[0][1][0]:=false; vf_move[0][1][1]:=false;@/ -stack_used:=0;@/ -vf_char_type[false]:=vf_put; vf_char_type[true]:=vf_set;@/ -vf_rule_type[false]:=vf_other; vf_rule_type[true]:=vf_rule; - -@ Here we read the first bytes of a character packet from the \.{VF} -file and initialize the packet being built in |byte_mem|; the start of -the whole packet is stored in |vf_push_loc[0]|. When the character -packet is finished, a type is assigned to it: |vf_simple| if the -packet ends with a character of the correct width, or |vf_complex| -otherwise. Moreover, if such a packet for a character with -extension zero consists of just one character with extension zero and -the same residue, and if there is no previous packet, the whole packet -is replaced by the empty packet. - -@d vf_simple=0 {the packet ends with a character of the correct width} -@d vf_complex=vf_simple+1 {otherwise} - -@<VF: Build a character packet@>= -begin if cur_cmd<long_char then - begin vf_limit:=cur_cmd; - cur_ext:=0; cur_res:=vf_ubyte; vf_wp:=check_width(vf_fix3u); - end -else begin vf_limit:=vf_uquad; - cur_ext:=vf_strio; cur_res:=vf_ubyte; vf_wp:=check_width(vf_fix4); - end; -Incr(vf_limit)(vf_loc); -vf_push_loc[0]:=byte_ptr; vf_last_end[0]:=byte_ptr; -vf_last[0]:=vf_other; vf_ptr:=0;@/ -start_packet(vf_complex); -@<VF: Append \.{DVI} commands to the character packet@>;@/ -k:=pckt_start[pckt_ptr]; -if vf_last[0]=vf_put then if cur_wp=vf_wp then - begin decr(byte_mem[k]); {change |vf_complex| into |vf_simple|} - if (byte_mem[k]=bi(0))and@|(vf_push_loc[0]=vf_last_loc[0])and@| - (cur_ext=0)and@|(cur_res=pckt_res) then byte_ptr:=k; - end; -build_packet; -cur_cmd:=vf_ubyte; -end - -@ For every \.{DVI} command read from the \.{VF} file some action is -performed; in addition the initial |push| and the final |pop| are -manufactured here. - -@<VF: Append \.{DVI} commands to the character packet@>= -vf_cur_fnt:=font_font(cur_fnt); vf_fnt:=vf_cur_fnt;@/ -last_pop:=false; cur_class:=push_cl; {initial |push|} -loop begin -reswitch:case cur_class of - three_cases(char_cl): @<VF: Do a |char|, |rule|, or |xxx|@>; - push_cl: @<VF: Do a |push|@>; - pop_cl: @<VF: Do a |pop|@>; - two_cases(w0_cl): - if vf_move[vf_ptr][0][cur_class-w0_cl] then append_one(cur_cmd); - three_cases(right_cl): - begin pckt_signed(dvi_right_cmd[cur_class],cur_parm); - if cur_class>=w_cl then vf_move[vf_ptr][0][cur_class-w_cl]:=true; - end; - two_cases(y0_cl): - if vf_move[vf_ptr][1][cur_class-y0_cl] then append_one(cur_cmd); - three_cases(down_cl): - begin pckt_signed(dvi_down_cmd[cur_class],cur_parm); - if cur_class>=y_cl then vf_move[vf_ptr][1][cur_class-y_cl]:=true; - end; - fnt_cl: vf_font; - fnt_def_cl: bad_font; - invalid_cl: if cur_cmd<>nop then bad_font; - othercases abort('internal error'); - endcases; - if vf_loc<vf_limit then vf_first_par - else if last_pop then goto done - else begin cur_class:=pop_cl; last_pop:=true; {final |pop|} - end; - end; -done:if (vf_ptr<>0)or(vf_loc<>vf_limit) then bad_font - -@ For a |push| we either increase |vf_push_num| or start a new level and -append a |push|. - -@d incr_stack(#)== -if #=stack_used then - if stack_used=stack_size then overflow(str_stack,stack_size) - else incr(stack_used); -incr(#) - -@<VF: Do a |push|@>= -if (vf_ptr>0)and(vf_push_loc[vf_ptr]=byte_ptr) then - begin if vf_push_num[vf_ptr]=255 then overflow(str_stack,255); - incr(vf_push_num[vf_ptr]); - end -else begin incr_stack(vf_ptr); - @<VF: Start a new level@>; - vf_push_num[vf_ptr]:=0; - end - -@ @<VF: Start a new level@>= -append_one(push); -vf_move[vf_ptr]:=vf_move[vf_ptr-1]; -vf_push_loc[vf_ptr]:=byte_ptr; -vf_last_end[vf_ptr]:=byte_ptr; -vf_last[vf_ptr]:=vf_other - -@ When a character, a rule, or an |xxx| is appended, transformation -rule~1 might be applicable. - -@<VF: Do a |char|, |rule|, or |xxx|@>= -begin if (vf_ptr=0)or(byte_ptr>vf_push_loc[vf_ptr]) then move_zero:=false -else case cur_class of -char_cl: move_zero:=(not cur_upd)or(vf_cur_fnt<>vf_fnt); -rule_cl: move_zero:=not cur_upd; -xxx_cl: move_zero:=true; -othercases abort('internal error'); -endcases; -if move_zero then - begin decr(byte_ptr); decr(vf_ptr); - end; -case cur_class of -char_cl: @<VF: Do a |fnt|, a |char|, or both@>; -rule_cl: @<VF: Do a |rule|@>; -xxx_cl: @<VF: Do an |xxx|@>; -end; {there are no other cases} -vf_last_end[vf_ptr]:=byte_ptr; -if move_zero then - begin incr(vf_ptr); append_one(push); vf_push_loc[vf_ptr]:=byte_ptr; - vf_last_end[vf_ptr]:=byte_ptr; - if cur_class=char_cl then if cur_upd then goto reswitch; - end; -end - -@ A special situation arises if transformation rule~1 is applied to a -|fnt_num| of |fnt| command, but not to the |set_char| or \\{set} command -following it; in this case |cur_upd| and |move_zero| are both |true| and -the |set_char| or \\{set} command will be appended later. - -@<VF: Do a |fnt|, a |char|, or both@>= -begin if vf_cur_fnt<>vf_fnt then - begin vf_last[vf_ptr]:=vf_other; - pckt_unsigned(fnt1,vf_cur_fnt); vf_fnt:=vf_cur_fnt; - end; -if (not move_zero)or(not cur_upd) then - begin vf_last[vf_ptr]:=vf_char_type[cur_upd]; - vf_last_loc[vf_ptr]:=byte_ptr; - pckt_char(cur_upd,cur_ext,cur_res); - end; -end - -@ @<VF: Do a |rule|@>= -begin vf_last[vf_ptr]:=vf_rule_type[cur_upd]; -vf_last_loc[vf_ptr]:=byte_ptr; -append_one(dvi_rule_cmd[cur_upd]); -pckt_four(cur_v_dimen); pckt_four(cur_h_dimen); -end - -@ @<VF: Do an |xxx|@>= -begin vf_last[vf_ptr]:=vf_other; -pckt_unsigned(xxx1,cur_parm); pckt_room(cur_parm); -while cur_parm>0 do - begin append_byte(vf_ubyte); decr(cur_parm); - end; -end - -@ Transformation rules 2--6 are triggered by a |pop|, either read from -the \.{VF} file or manufactured at the end of the packet. - -@<VF: Do a |pop|@>= -begin if vf_ptr<1 then bad_font; -byte_ptr:=vf_last_end[vf_ptr]; {this is rule 2} -if vf_last[vf_ptr]<=vf_rule then - if vf_last_loc[vf_ptr]=vf_push_loc[vf_ptr] then - @<VF: Prepare for rule 4@>; -if byte_ptr=vf_push_loc[vf_ptr] then @<VF: Apply rule 3 or 4@> -else begin if vf_last[vf_ptr]=vf_group then @<VF: Apply rule 6@>; - append_one(pop); decr(vf_ptr); vf_last[vf_ptr]:=vf_group; - vf_last_loc[vf_ptr]:=vf_push_loc[vf_ptr+1]-1; - vf_last_end[vf_ptr]:=byte_ptr; - if vf_push_num[vf_ptr+1]>0 then @<VF: Apply rule 5@>; - end; -end - -@ In order to implement transformation rule~4, we cancel the |set_char|, -\\{set}, or |set_rule|, append a |pop|, and insert a |put| or |put_rule| -with the old parameters. - -@<VF: Prepare for rule 4@>= -begin cur_class:=vf_last[vf_ptr]; cur_upd:=false; -byte_ptr:=vf_push_loc[vf_ptr]; -end - -@ @<VF: Apply rule 3 or 4@>= -begin if vf_push_num[vf_ptr]>0 then - begin decr(vf_push_num[vf_ptr]); - vf_move[vf_ptr]:=vf_move[vf_ptr-1]; - end -else begin decr(byte_ptr); decr(vf_ptr); - end; -if cur_class<>pop_cl then goto reswitch; {this is rule 4} -end - -@ @<VF: Apply rule 6@>= -begin Decr(byte_ptr)(2); -for k:=vf_last_loc[vf_ptr]+1 to byte_ptr do byte_mem[k-1]:=byte_mem[k]; -vf_last[vf_ptr]:=vf_other; vf_last_end[vf_ptr]:=byte_ptr; -end - -@ @<VF: Apply rule 5@>= -begin incr(vf_ptr); -@<VF: Start a new level@>; -decr(vf_push_num[vf_ptr]); -end - -@ The \.{VF} format specifies that after a character packet invoked by a -|set_char| or \\{set} command, ``|h|~is increased by the \.{TFM} width -(properly scaled)---just as if a simple character had been typeset''; -for |vf_simple| packets this is achieved by changing the final |put| -command into |set_char| or \\{set}, but for |vf_complex| packets an -explicit movement must be done. This poses a problem for programs, -such as \.{DVIcopy}, which write a new \.{DVI} file with all references -to characters from virtual fonts replaced by their character packets: -The \.{DVItype} program specifies that the horizontal movements after a -|set_char| or \\{set} command, after a |set_rule| command, and after one -of the commands |right1..x4|, are all treated differently when \.{DVI} -units are converted to pixels. - -Thus we introduce a slight extension of \.{DVItype}'s pixel rounding -algorithm and hope that this extension will become part of the standard -\.{DVItype} program in the near future: If a \.{DVI} file contains a -|set_rule| command for a rule with the negative height |width_dimen|, -then this rule shall be treated in exactly the same way as a fictitious -character whose width is the width of that rule; as value of |width_dimen| -we choose $-2^{31}$, the smallest signed 32-bit integer. - -@<Glob...@>= -@!width_dimen:int_32; {vertical dimension of special rules} - -@ When initializing |width_dimen| we are careful to avoid arithmetic -overflow. - -@<Set init...@>= -width_dimen:=-@"40000000; Decr(width_dimen)(@"40000000); - -@* Terminal communication. -When \.{\title} begins, it engages the user in a brief dialog so that -various options may be specified. This part of \.{\title} requires -nonstandard \PASCAL\ constructions to handle the online interaction; so -it may be preferable in some cases to omit the dialog and simply to -stick to the default options. On other hand, the system-dependent -routines that are needed are not complicated, so it will not be terribly -difficult to introduce them; furthermore they are similar to those in -\.{DVItype}. - -It may be desirable to (optionally) specify all the options in the -command line and skip the dialog with the user, provided the operating -system permits this. Here we just define the system-independent part of the -code required for this possibility. Since a complete option (a keyword -possibly followed by one or several parameters) may have embedded blanks -it might be necessary to replace these blanks by some other separator, -e.g., by a '/'. Using, e.g., \.{UNIX} style options one might then say -$$\.{\title\space-mag/2000 -sel/17.3/5 -sel/47 ...}$$ -to override the magnification factor that is stated in the \.{DVI} file, -and to select five pages starting with the page numbered~17.3 as well as -all remaining pages starting with the one numbered~47; alternatively one -might simply say -$$\.{\title\space- ...}$$ -to skip the dialog and use the default options. - -The system-dependent initialization code should set the |n_opt| variable -to the number of options found in the command line. If |n_opt=0| the -|input_ln| procedure defined below will prompt the user for options. If -|n_opt>0| the |k_opt| variable will be incremented and another piece of -system-dependent code is invoked instead of the dialog; that code should -place the value of command line option number |k_opt| as temporary -string into the |byte-mem| array. This process will be repeated until -|k_opt=n_opt|, indicating that all command line options have been -processed. -@^system dependencies@> - -@d opt_separator="/" {acts as blank when scanning (command line) options} - -@<Set init...@>= -n_opt:=0; {change this to indicate the presence of command line options} -k_opt:=0; {just in case} - -@ The |input_ln| routine waits for the user to type a line at his or her -terminal; then it puts ASCII-code equivalents for the characters on that -line into the |byte_mem| array as a temporary string. \PASCAL's -standard |input| file is used for terminal input, as |output| is used -for terminal output. - -Since the terminal is being used for both input and output, some systems -need a special routine to make sure that the user can see a prompt message -before waiting for input based on that message. (Otherwise the message -may just be sitting in a hidden buffer somewhere, and the user will have -no idea what the program is waiting for.) We shall invoke a system-dependent -subroutine |update_terminal| in order to avoid this problem. -@^system dependencies@> - -@d update_terminal == break(output) {empty the terminal output buffer} -@# -@d scan_blank(#)== {tests for `blank' when scanning (command line) options} - ((byte_mem[#]=bi(" "))or(byte_mem[#]=bi(opt_separator))) -@d scan_skip== {skip `blanks'} - while scan_blank(scan_ptr)and(scan_ptr<byte_ptr) do incr(scan_ptr) -@d scan_init== {initialize |scan_ptr|} - byte_mem[byte_ptr]:=bi(" "); scan_ptr:=pckt_start[pckt_ptr-1]; scan_skip - -@<Action procedures for |dialog|@>= -procedure input_ln; {inputs a line from the terminal} -var k:0..terminal_line_length; -begin if n_opt=0 then - begin print('Enter option: '); update_terminal; reset(input); - if eoln(input) then read_ln(input); - k:=0; pckt_room(terminal_line_length); - while (k<terminal_line_length)and not eoln(input) do - begin append_byte(xord[input^]); incr(k); get(input); - end; - end -else if k_opt<n_opt then - begin incr(k_opt); - {Copy command line option number |k_opt| into |byte_mem| array!} - end; -end; - -@ The global variable |scan_ptr| is used while scanning the temporary -packet; it points to the next byte in |byte_mem| to be examined. - -@<Glob...@>= -@!n_opt:int_16; {number of options found in command line} -@!k_opt:int_16; {number of command line options processed} -@!scan_ptr:byte_pointer; {pointer to next byte to be examined} -@!sep_char:text_char; {|' '| or |xchr[opt_separator]|} - -@ The |scan_keyword| function is used to test for keywords in a character -string stored as temporary packet in |byte_mem|; the result is |true| -(and |scan_ptr| is updated) if the characters starting at position -|scan_ptr| are an abbreviation of a given keyword followed by at least -one blank. - -@<Action procedures for |dialog|@>= -function scan_keyword(@!p:pckt_pointer;@!l:int_7):boolean; -var i,@!j,@!k:byte_pointer; {indices into |byte_mem|} -begin i:=pckt_start[p]; j:=pckt_start[p+1]; k:=scan_ptr; -while (i<j)and((byte_mem[k]=byte_mem[i])or(byte_mem[k]=byte_mem[i]-"a"+"A")) do - begin incr(i); incr(k); - end; -if scan_blank(k)and(i-pckt_start[p]>=l) then - begin scan_ptr:=k; scan_skip; scan_keyword:=true; - end -else scan_keyword:=false; -end; - -@ Here is a routine that scans a (possibly signed) integer and computes -the decimal value. If no decimal integer starts at |scan_ptr|, the -value~0 is returned. The integer should be less than $2^{31}$ in -absolute value. - -@<Action procedures for |dialog|@>= -function scan_int:int_32; -var x:int_32; {accumulates the value} -@!negative:boolean; {should the value be negated?} -begin if byte_mem[scan_ptr]="-" then - begin negative:=true; incr(scan_ptr); - end -else negative:=false; -x:=0; -while (byte_mem[scan_ptr]>="0")and(byte_mem[scan_ptr]<="9") do - begin x:=10*x+byte_mem[scan_ptr]-"0"; incr(scan_ptr); - end; -scan_skip; -if negative then scan_int:=-x @+ else scan_int:=x; -end; - -@ The selected options are put into global variables by the |dialog| -procedure, which is called just as \.{\title} begins. -@^system dependencies@> - -@p @<Action procedures for |dialog|@>@; -procedure dialog; -label exit; -var p:pckt_pointer; {packet being created} -begin @<Initialize options@>@; -loop begin input_ln; p:=new_packet; scan_init; - if scan_ptr=byte_ptr then - begin flush_packet; return; - end@;@/ - @<Cases for options@>@;@/ - else begin if n_opt=0 then sep_char:=' ' - else sep_char:=xchr[opt_separator]; - print_options; - if n_opt>0 then - begin print('Bad command line option: '); - print_packet(p); abort('---run terminated'); - end; - end; - flush_packet; - end; -exit:end; - -@ The |print_options| procedure might be used in a `Usage message' -displaying the command line syntax. - -@<Basic printing...@>= -procedure print_options; -begin print_ln('Valid options are:'); -@<Print valid options@>@; -end; - -@* Subroutines for typesetting commands. -This is the central part of the whole \.{\title} program: -When a typesetting command from the \.{DVI} file or from a \.{VF} packet -has been decoded, one of the typesetting routines defined below is -invoked to execute the command; apart from the necessary book keeping, -these routines invoke device dependent code defined later. - -@p @<Declare typesetting procedures@> - -@ These typesetting routines communicate with the rest of the program -through global variables. - -@<Glob...@>= -@!type_setting:boolean; {|true| while typesetting a page} - -@ @<Set init...@>= -type_setting:=false; - -@ The user may select up to |max_select| ranges of consecutive pages to -be processed. Each starting page specification is recorded in two global -arrays called |start_count| and |start_there|. For example, `\.{1.*.-5}' -is represented by |start_there[0]=true|, |start_count[0]=1|, -|start_there[1]=false|, |start_there[2]=true|, |start_count[2]=-5|. We -also set |start_vals=2|, to indicate that count 2 was the last one -mentioned. The other values of |start_count| and |start_there| are not -important, in this example. The number of pages is recorded in -|max_pages|; a non positive value indicates that there is no limit. - -@d start_count==select_count[cur_select] {count values to select - starting page} -@d start_there==select_there[cur_select] {is the |start_count| value - relevant?} -@d start_vals==select_vals[cur_select] {the last count considered - significant} -@d max_pages==select_max[cur_select] {at most this many |bop..eop| pages - will be printed} - -@<Glob...@>= -@!select_count:array[0..max_select-1,0..9] of int_32; -@!select_there:array[0..max_select-1,0..9] of boolean; -@!select_vals:array[0..max_select-1] of 0..9; -@!select_max:array[0..max_select-1] of int_32; -@!out_mag:int_32; {output magnification} -@!count:array[0..9] of int_32; {the count values on the current page} -@!num_select:0..max_select; {number of page selection ranges specified} -@!cur_select:0..max_select; {current page selection range} -@!selected:boolean; {has starting page been found?} -@!all_done:boolean; {have all selected pages been processed?} -@!str_mag,@!str_select:pckt_pointer; - -@ Here is a simple subroutine that tests if the current page might be the -starting page. - -@p function start_match:boolean; {does |count| match the starting spec?} -var k:0..9; {loop index} -@!match:boolean; {does everything match so far?} -begin match:=true; -for k:=0 to start_vals do - if start_there[k]and(start_count[k]<>count[k]) then match:=false; -start_match:=match; -end; - -@ @<Initialize options@>= -out_mag:=0; cur_select:=0; max_pages:=0; selected:=true; - -@ @<Print valid options@>= -print_ln(' mag',sep_char,'<new_mag>'); -print_ln(' select',sep_char,'<start_count>',sep_char, - '[<max_pages>] (up to ',max_select:1,' ranges)'); - -@ @<Action procedures for |dialog|@>= -procedure scan_count; {scan a |start_count| value} -begin if byte_mem[scan_ptr]=bi("*") then - begin start_there[start_vals]:=false; incr(scan_ptr); scan_skip; - end -else begin start_there[start_vals]:=true; - start_count[start_vals]:=scan_int; - if cur_select=0 then selected:=false; {don't start at first page} - end; -end; - -@ @<Cases for options@>= -else if scan_keyword(str_mag,3) then out_mag:=scan_int -else if scan_keyword(str_select,3) then - if cur_select=max_select then print_ln('Too many page selections') - else begin start_vals:=0; scan_count; - while (start_vals<9)and(byte_mem[scan_ptr]=bi(".")) do - begin incr(start_vals); incr(scan_ptr); scan_count; - end; - max_pages:=scan_int; incr(cur_select); - end - -@ @<Initialize predefined strings@>= -id3("m")("a")("g")(str_mag); -id6("s")("e")("l")("e")("c")("t")(str_select); - -@ A stack is used to keep track of the current horizontal and vertical -position, |h| and |v|, and the four registers |w|, |x|, |y|, and |z|; -the register pairs |(w,x)| and |(y,z)| are maintained as arrays. - -@<Types...@>= -@!device @<Declare device dependent types@>@; @+ ecived @; @/ -@!stack_pointer=0..stack_size;@/ -@!stack_index=1..stack_size;@/ -@!pair_32=array[0..1] of int_32; {a pair of |int_32| variables} -@!stack_record=record@;@/ - @!h_field:int_32; {horizontal position |h|} - @!v_field:int_32; {vertical position |v|} - @!w_x_field:pair_32; {|w| and |x| register for horizontal movements} - @!y_z_field:pair_32; {|y| and |z| register for vertical movements} - @!device @<Device dependent stack record fields@>@; @+ ecived @; @/ - end; - -@ The current values are kept in |cur_stack|; they are pushed onto and -popped from |stack|. We use \.{WEB} macros to access the current values. - -@d cur_h==cur_stack.h_field {the current |@!h| value} -@d cur_v==cur_stack.v_field {the current |@!v| value} -@d cur_w_x==cur_stack.w_x_field {the current |@!w| and |@!x| value} -@d cur_y_z==cur_stack.y_z_field {the current |@!y| and |@!z| value} - -@<Glob...@>= -@!stack:array[stack_index] of stack_record; {the pushed values} -@!cur_stack:stack_record; {the current values} -@!zero_stack:stack_record; {initial values} -@!stack_ptr:stack_pointer; {last used position in |stack|} - -@ @<Set init...@>= -zero_stack.h_field:=0; zero_stack.v_field:=0; -for i:=0 to 1 do - begin zero_stack.w_x_field[i]:=0; zero_stack.y_z_field[i]:=0; - end; -@!device @<Initialize device dependent stack record fields@>@; @+ ecived @; @/ - -@ When typesetting for a real device we must convert the current -position from \.{DVI} units to pixels, i.e., |cur_h| and |cur_v| into -|cur_hh| and |cur_vv|. This might be a good place to collect everything -related to the conversion from \.{DVI} units to pixels and in particular -all the pixel rounding algorithms. - -@d font_space(#)==fnt_space[#] {boundary between ``small'' and ``large'' - spaces} - -@<Declare device dependent font data arrays@>= -@!fnt_space:array [font_number] of int_32; {boundary between ``small'' - and ``large'' spaces} - -@ @<Initialize device dependent font data@>= -font_space(invalid_font):=0; - -@ @<Initialize device dependent data for a font@>= -font_space(cur_fnt):=font_scaled(cur_fnt) div 6; - {this is a 3-unit ``thin space''} - -@ The |char_pixels| array is used to store the horizontal character -escapements: for \.{PK} or \.{GF} files we use the values given there, -otherwise we must convert the character widths to (horizontal) pixels. -The horizontal escapement of character~|c| in font~|f| is given by -|font_pixel(f)(c)|. - -@d font_pixel(#)==char_pixels[font_chars(#)+font_width_end -@# -@d max_pix_value==@"7FFF {largest allowed pixel value; this range may not - suffice for high resolution output devices} - -@<Declare device dependent types@>= -@!pix_value=-max_pix_value..max_pix_value; {a pixel coordinate or displacement} - -@ @<Glob...@>= -@!device -@!char_pixels:array[char_pointer] of pix_value; {character escapements} -@!h_pixels:pix_value; {a horizontal dimension in pixels} -@!v_pixels:pix_value; {a vertical dimension in pixels} -@!temp_pix:pix_value; {temporary value for pixel rounding} -ecived - -@ @d cur_hh==cur_stack.hh_field {the current |@!hh| value} -@d cur_vv==cur_stack.vv_field {the current |@!vv| value} - -@<Device dependent stack record fields@>= -@!hh_field:pix_value; {horizontal pixel position |hh|} -@!vv_field:pix_value; {vertical pixel position |vv|} - -@ @<Initialize device dependent stack record fields@>= -zero_stack.hh_field:=0; zero_stack.vv_field:=0; - -@ For small movements we round the increment in position, for large -movements we round the incremented position. The same applies to rule -dimensions with the only difference that they will always be rounded -towards larger values. For characters we increment the horizontal -position by the escapement values obtained, e.g., from a \.{PK} file or -by the \.{TFM} width converted to pixels. - -@d h_pixel_round(#)==round(h_conv*(#)) -@d v_pixel_round(#)==round(v_conv*(#)) -@^system dependencies@> -@# -@d large_h_space(#)==(#>=font_space(cur_fnt))or(#<=-4*font_space(cur_fnt)) - {is this a ``large'' horizontal distance?} -@d large_v_space(#)==(abs(#)>=5*font_space(cur_fnt)) - {is this a ``large'' vertical distance?} -@# -@d h_rule_pixels== {converts the rule width |cur_h_dimen| to pixels} -@!device if large_h_space(cur_h_dimen) then - begin h_pixels:=h_pixel_round(cur_h+cur_h_dimen)-cur_hh; - if h_pixels<=0 then if cur_h_dimen>0 then h_pixels:=1; - end -else begin h_pixels:=trunc(h_conv*cur_h_dimen); - if h_pixels<h_conv*cur_h_dimen then incr(h_pixels); - end; -ecived -@# -@d v_rule_pixels== {converts the rule height |cur_v_dimen| to pixels} -@!device if large_v_space(cur_v_dimen) then - begin v_pixels:=cur_vv-v_pixel_round(cur_v-cur_v_dimen); - if v_pixels<=0 then v_pixels:=1; {used only for |cur_v_dimen>0|} - end -else begin v_pixels:=trunc(v_conv*cur_v_dimen); - if v_pixels<v_conv*cur_v_dimen then incr(v_pixels); - end; -ecived - -@ A sequence of consecutive rules, or consecutive characters in a -fixed-width font whose width is not an integer number of pixels, can -cause |hh| to drift far away from a correctly rounded value. \.{\title} -ensures that the amount of drift will never exceed |max_h_drift| pixels; -similarly |vv| shall never drift away from the correctly rounded value -by more than |max_v_drift| pixels. - -@d h_upd_end(#)== {check for proper horizontal pixel rounding} -begin Incr(cur_hh)(#); temp_pix:=h_pixel_round(cur_h); -if abs(temp_pix-cur_hh)>max_h_drift then - if temp_pix>cur_hh then cur_hh:=temp_pix-max_h_drift - else cur_hh:=temp_pix+max_h_drift; -end @+ ecived -@d h_upd_char(#)==Incr(cur_h)(#)@; - @!device; h_upd_end -@d h_upd_move(#)==Incr(cur_h)(#)@; - @!device; if large_h_space(#) then cur_hh:=h_pixel_round(cur_h) - else h_upd_end -@# -@d v_upd_end(#)== {check for proper vertical pixel rounding} -begin Incr(cur_vv)(#); temp_pix:=v_pixel_round(cur_v); -if abs(temp_pix-cur_vv)>max_v_drift then - if temp_pix>cur_vv then cur_vv:=temp_pix-max_v_drift - else cur_vv:=temp_pix+max_v_drift; -end @+ ecived -@d v_upd_move(#)==Incr(cur_v)(#)@; - @!device; if large_v_space(#) then cur_vv:=v_pixel_round(cur_v) - else v_upd_end - -@ The routines defined below use sections named `Declare local variables -(if any) for \dots' or `Declare additional local variables for \dots'; -the former may declare variables (including the keyword \&{var}), whereas -the later must at least contain the keyword \&{var}. In general, both may -start with the declaration of labels, constants, and\slash or types. - -Let us start with the simple cases: -The |do_pre| procedure is called when the preamble has been read from -the \.{DVI} file; the preamble comment has just been converted into a -temporary packet with the |new_packet| procedure. - -@p procedure do_pre;@/ -@<OUT: Declare local variables (if any) for |do_pre|@>@; -begin all_done:=false; num_select:=cur_select; cur_select:=0; -if num_select=0 then max_pages:=0; -@!device -h_conv:=(dvi_num/254000.0)*(h_resolution/dvi_den)*(out_mag/1000.0); -v_conv:=(dvi_num/254000.0)*(v_resolution/dvi_den)*(out_mag/1000.0); -ecived @; @/ -@<OUT: Process the |pre|@>@;@/ -end; - -@ The |do_bop| procedure is called when a |bop| has been read. This -routine determines whether a page shall be processed or skipped and sets -the variable |type_setting| accordingly. - -@p procedure do_bop;@/ -@<OUT: Declare additional local variables |do_bop|@>@; -@!i,@!j:0..9; {indices into |count|} -begin @<Determine whether this page should be processed or skipped@>; -print('DVI: '); -if type_setting then print('process') @+ else print('skipp'); -print('ing page ',count[0]:1); j:=9; -while (j>0)and(count[j]=0) do decr(j); -for i:=1 to j do print('.',count[i]:1); -d_print(' at ',dvi_loc-45:1); -print_ln('.'); -if type_setting then - begin stack_ptr:=0; cur_stack:=zero_stack; cur_fnt:=invalid_font;@/ - @<OUT: Process a |bop|@>@;@/ - end; -end; - -@ Note that the device dependent code `OUT: Process a |bop|' may choose -to set |type_setting| to false even if |selected| is true. - -@<Determine whether this page...@>= -if not selected then selected:=start_match; -type_setting:=selected - -@ The |do_eop| procedure is called in order to process an |eop|; the -stack should be empty. - -@p procedure do_eop;@/ -@<OUT: Declare local variables (if any) for |do_eop|@>@; -begin if stack_ptr<>0 then bad_dvi; -@<OUT: Process an |eop|@>@; -if max_pages>0 then - begin decr(max_pages); - if max_pages=0 then - begin selected:=false; incr(cur_select); - if cur_select=num_select then all_done:=true; - end; - end; -type_setting:=false; -end; - -@ The procedures |do_push| and |do_pop| are called in order to process -|push| and |pop| commands; |do_push| must check for stack overflow, -|do_pop| should never be called when the stack is empty. - -@p procedure do_push; {push onto stack} -@<OUT: Declare local variables (if any) for |do_push|@>@; -begin incr_stack(stack_ptr); stack[stack_ptr]:=cur_stack;@/ -@<OUT: Process a |push|@>@; -end; -@# -procedure do_pop; {pop from stack} -@<OUT: Declare local variables (if any) for |do_pop|@>@; -begin if stack_ptr=0 then bad_dvi; -cur_stack:=stack[stack_ptr]; decr(stack_ptr); -@<OUT: Process a |pop|@>@;@/ -end; - -@ The |do_xxx| procedure is called in order to process a special command. -The bytes of the special string have been put into |byte_mem| as the -current string. They are converted to a temporary packet and discarded -again. - -@p procedure do_xxx;@/ -@<OUT: Declare additional local variables for |do_xxx|@>@; -@!p:pckt_pointer; {temporary packet} -begin p:=new_packet;@/ -@<OUT: Process an |xxx|@>@;@/ -flush_packet; -end; - -@ Next are the movement commands: -The |do_right| procedure is called in order to process the horizontal -movement commands |right|, |w|, and |x|. - - -@p procedure do_right;@/ -@<OUT: Declare local variables (if any) for |do_right|@>@; -begin if cur_class>=w_cl then cur_w_x[cur_class-w_cl]:=cur_parm -else if cur_class<right_cl then cur_parm:=cur_w_x[cur_class-w0_cl]; -@<OUT: Process a |right| or |w| or |x|@>@;@/ -h_upd_move(cur_parm)(h_pixel_round(cur_parm)); -@<OUT: Move right@>@; -end; - -@ The |do_down| procedure is called in order to process the vertical -movement commands |down|, |y|, and |z|. - -@p procedure do_down;@/ -@<OUT: Declare local variables (if any) for |do_down|@>@; -begin if cur_class>=y_cl then cur_y_z[cur_class-y_cl]:=cur_parm -else if cur_class<down_cl then cur_parm:=cur_y_z[cur_class-y0_cl]; -@<OUT: Process a |down| or |y| or |z|@>@;@/ -v_upd_move(cur_parm)(v_pixel_round(cur_parm)); -@<OUT: Move down@>@; -end; - -@ The |do_width| procedure, or actually the |do_a_width| macro, is -called in order to increase the current horizontal position |cur_h| by -|cur_h_dimen| in exactly the same way as if a character of width -|cur_h_dimen| had been typeset. - -@d do_a_width(#)== - begin @!device h_pixels:=#; @+ ecived @; @+ do_width; - end - -@p procedure do_width;@/ -@<OUT: Declare local variables (if any) for |do_width|@>@; -begin @<OUT: Typeset a |width|@>@;@/ -h_upd_char(cur_h_dimen)(h_pixels); -@<OUT: Move right@>@; -end; - -@ Finally we have the commands for the typesetting of rules and characters; -the global variable |cur_upd| is |true| if the horizontal position shall -be updated (\\{set} commands). - -The |do_rule| procedure is called in order to typeset a rule. - -@p procedure do_rule;@/ -@<OUT: Declare additional local variables |do_rule|@>@; -@!visible:boolean; -begin h_rule_pixels@; -if (cur_h_dimen>0)and(cur_v_dimen>0) then - begin visible:=true; v_rule_pixels@; - @<OUT: Typeset a visible |rule|@>@; - end -else begin visible:=false; - @<OUT: Typeset an invisible |rule|@>@; - end; -if cur_upd then - begin h_upd_move(cur_h_dimen)(h_pixels); - @<OUT: Move right@>@; - end; -end; - -@ Last not least the |do_char| procedure is called in order to typeset -character~|cur_res| with extension~|cur_ext| from the real font~|cur_fnt|. - -@p procedure do_char;@/ -@<OUT: Declare local variables (if any) for |do_char|@>@; -begin @<OUT: Typeset a |char|@>@; -if cur_upd then - begin h_upd_char(widths[cur_wp])(char_pixels[cur_cp]); - @<OUT: Move right@>@; - end; -end; - -@ If the program terminates abnormally, the following code may be -invoked in the middle of a page. - -@<Finish output file(s)@>= -begin if type_setting then @<OUT: Finish incomplete page@>; -@<OUT: Finish output file(s)@>@; -end - -@ When the first character of font~|cur_fnt| is about to be typeset, the -|do_font| procedure is called in order to decide whether this is a -virtual font or a real font. - -One step in this decision is the attempt to find and read the \.{VF} -file for this font; other attempts to locate a font file may be -performed before and after that, depending on the nature of the output -device and on the structure of the file system at a particular -installation. For a real device we convert the character widths to -(horizontal) pixels. - -In any case |do_font| must change |font_type(cur_fnt)| to a value -|>defined_font|; as a last resort one might use the \.{TFM} width data -and draw boxes or leave blank spaces in the output. - -@p procedure do_font;@/ -label done;@/ -@<OUT: Declare additional local variables for |do_font|@>@; -@!p:char_pointer; {index into |char_widths| and |char_pixels|} -begin @!debug if font_type(cur_fnt)=defined_font then confusion(str_fonts); -gubed@; -p:=0; {such that |p| is used} -@!device for p:=font_chars(cur_fnt)+font_bc(cur_fnt) - to font_chars(cur_fnt)+font_ec(cur_fnt) do - char_pixels[p]:=h_pixel_round(widths[char_widths[p]]); -ecived@; -@<OUT: Look for a font file before trying to read the \.{VF} file; - if found |goto done|@>@;@/ -if do_vf then goto done; {try to read the \.{VF} file} -@<OUT: Look for a font file after trying to read the \.{VF} file@>@;@/ -done: -@!debug if font_type(cur_fnt)<=loaded_font then confusion(str_fonts); -gubed@; -end; - -@ Before a character of font~|cur_fnt| is typeset the following piece of -code ensures that the font is ready to be used. - -@<Prepare to use font |cur_fnt|@>= -@<OUT: Prepare to use font |cur_fnt|@>@; -if font_type(cur_fnt)<=loaded_font then do_font {|cur_fnt| was not yet used} - -@* Interpreting VF packets. -The |pckt_first_par| procedure first reads a \.{DVI} command byte from -the packet into |cur_cmd|; then |cur_parm| is set to the value of the -first parameter (if any) and |cur_class| to the command class. - -@p procedure pckt_first_par; -begin cur_cmd:=pckt_ubyte; -case dvi_par[cur_cmd] of -char_par: set_cur_char(pckt_ubyte); -no_par: do_nothing; -dim1_par: cur_parm:=pckt_sbyte; -num1_par: cur_parm:=pckt_ubyte; -dim2_par: cur_parm:=pckt_spair; -num2_par: cur_parm:=pckt_upair; -dim3_par: cur_parm:=pckt_strio; -num3_par: cur_parm:=pckt_utrio; -three_cases(dim4_par): cur_parm:=pckt_squad; {|dim4|, |num4|, or |numu|} -rule_par: - begin cur_v_dimen:=pckt_squad; cur_h_dimen:=pckt_squad; - cur_upd:=(cur_cmd=set_rule); - end; -fnt_par:cur_parm:=cur_cmd-fnt_num_0; -othercases abort('internal error'); -endcases; -cur_class:=dvi_cl[cur_cmd]; -end; - -@ The |do_vf_packet| procedure is called in order to interpret the -character packet for a virtual character. Such a packet may contain the -instruction to typeset a character from the same or an other virtual -font; in such cases |do_vf_packet| calls itself recursively. The -recursion level, i.e., the number of times this has happened, is kept -in the global variable |n_recur| and should not exceed |max_recursion|. -@^recursion@> - -@<Types...@>= -@!recur_pointer=0..max_recursion; - -@ The \.{\title} processor should detect an infinite recursion caused by -bad \.{VF} files; thus a new recursion level is entered even in cases -where this could be avoided without difficulty. - -If the recursion level exceeds the allowed maximum, we want to give -a traceback how this has happened; thus some of the global variables -used in different invocations of |do_vf_packet| are saved in a stack, -others are saved as local variables of |do_vf_packet|. - -@<Glob...@>= -@!recur_fnt:array[recur_pointer] of font_number; {this packet's font} -@!recur_ext:array[recur_pointer] of int_24; {this packet's extension} -@!recur_res:array[recur_pointer] of eight_bits; {this packet's residue} -@!recur_pckt:array[recur_pointer] of pckt_pointer; {the packet} -@!recur_loc:array[recur_pointer] of byte_pointer; {next byte of packet} -@!n_recur:recur_pointer; {current recursion level} -@!recur_used:recur_pointer; {highest recursion level used so far} - -@ @<Set init...@>= -n_recur:=0; recur_used:=0; - -@ Here now is the |do_vf_packet| procedure. - -@p procedure do_vf_packet; -label continue,found,done; -var k:recur_pointer; {loop index} -@!f:int_8u; {packet type flag} -@!save_upd:boolean; {used to save |cur_upd|} -@!save_cp:width_pointer; {used to save |cur_cp|} -@!save_wp:width_pointer; {used to save |cur_wp|} -@!save_limit:byte_pointer; {used to save |cur_limit|} -begin @<VF: Save values on entry to |do_vf_packet|@>;@/ -@<VF: Interpret the \.{DVI} commands in the packet@>@;@/ -if save_upd then - begin cur_h_dimen:=widths[save_wp]; do_a_width(char_pixels[save_cp]); - end; -@<VF: Restore values on exit from |do_vf_packet|@>;@/ -end; - -@ On entry to |do_vf_packet| several values must be saved. - -@<VF: Save values on entry to |do_vf_packet|@>= -save_upd:=cur_upd; save_cp:=cur_cp; save_wp:=cur_wp;@/ -recur_fnt[n_recur]:=cur_fnt; -recur_ext[n_recur]:=cur_ext; -recur_res[n_recur]:=cur_res - -@ Some of these values must be restored on exit from |do_vf_packet|. - -@<VF: Restore values on exit from |do_vf_packet|@>= -cur_fnt:=recur_fnt[n_recur] - -@ If |cur_pckt| is the empty packet, we manufacture a |put| command; -otherwise we read and interpret \.{DVI} commands from the packet. - -@<VF: Interpret the \.{DVI} commands in the packet@>= -if find_packet then f:=cur_type @+ else goto done; -recur_pckt[n_recur]:=cur_pckt; -save_limit:=cur_limit; -cur_fnt:=font_font(cur_fnt); -if cur_pckt=empty_packet then - begin cur_class:=char_cl; goto found; - end; -if cur_loc>=cur_limit then goto done; -continue: pckt_first_par; -found: case cur_class of -char_cl: @<VF: Typeset a |char|@>; -rule_cl: do_rule; -xxx_cl: - begin pckt_room(cur_parm); - while cur_parm>0 do - begin append_byte(pckt_ubyte); decr(cur_parm); - end; - do_xxx; - end; -push_cl: do_push; -pop_cl: do_pop; -five_cases(w0_cl): do_right; {|right|, |w|, or |x|} -five_cases(y0_cl): do_down; {|down|, |y|, or |z|} -fnt_cl: cur_fnt:=cur_parm; -othercases confusion(str_packets); {font definition or invalid} -endcases; -if cur_loc<cur_limit then goto continue; -done: - -@ The final |put| of a simple packet may be changed into |set_char| or -\\{set}. - -@<VF: Typeset a |char|@>= -begin @<Prepare to use font |cur_fnt|@>; -cur_cp:=font_chars(cur_fnt)+cur_res; cur_wp:=char_widths[cur_cp]; -if (cur_loc=cur_limit)and(f=vf_simple) and save_upd then - begin save_upd:=false; cur_upd:=true; - end; -if font_type(cur_fnt)=vf_font_type then - @<VF: Enter a new recursion level@> -else do_char; -end - -@ Before entering a new recursion level we must test for overflow; in -addition a few variables must be saved and restored. -A |set_char| or \\{set} followed by |pop| is changed into |put|. - -@<VF: Enter a new recursion level@>= -begin recur_loc[n_recur]:=cur_loc; {save} -if cur_loc<cur_limit then - if byte_mem[cur_loc]=bi(pop) then cur_upd:=false; -if n_recur=recur_used then - if recur_used=max_recursion then - @<VF: Display the recursion traceback and terminate@> - else incr(recur_used);@/ -incr(n_recur); do_vf_packet; decr(n_recur); {recurse} -cur_loc:=recur_loc[n_recur]; cur_limit:=save_limit; {restore} -end - -@ @<VF: Display the recursion traceback and terminate@>= -begin print_ln(' !Infinite VF recursion?'); -@.Infinite VF recursion?@> -for k:=max_recursion downto 0 do - begin print('level=',k:1,' font'); - d_print('=',recur_fnt[k]:1); - print_font(recur_fnt[k]); - print(' char=',recur_res[k]:1); - if recur_ext[k]<>0 then print('.',recur_ext[k]:1); - new_line; - @!debug hex_packet(recur_pckt[k]); print_ln('loc=',recur_loc[k]:1); - gubed@; - end; -overflow(str_recursion,max_recursion); -end - -@* Interpreting the DVI file. -The |do_dvi| procedure reads the entire \.{DVI} file and initiates -whatever actions may be necessary. - -@p procedure do_dvi; -label done,exit; -var temp_byte:int_8u; {byte for temporary variables} -@!temp_int:int_32; {integer for temporary variables} -@!dvi_start:int_32; {starting location} -@!dvi_bop_post:int_32; {location of |bop| or |post|} -@!dvi_back:int_32; {a back pointer} -@!k:int_15; {general purpose variable} -begin @<DVI: Process the preamble@>; -if random_reading then @<DVI: Process the postamble@>; -repeat dvi_first_par; - while cur_class=fnt_def_cl do - begin dvi_do_font(random_reading); dvi_first_par; - end; - if cur_cmd=bop then @<DVI: Process one page@>; -until cur_cmd<>eop; -if cur_cmd<>post then bad_dvi; -exit:end; - -@ @<DVI: Process the preamble@>= -if dvi_ubyte<>pre then bad_dvi; -if dvi_ubyte<>dvi_id then bad_dvi; -dvi_num:=dvi_pquad; dvi_den:=dvi_pquad; dvi_mag:=dvi_pquad; -tfm_conv:=(25400000.0/dvi_num)*(dvi_den/473628672)/16.0; -temp_byte:=dvi_ubyte; pckt_room(temp_byte); -for k:=1 to temp_byte do append_byte(dvi_ubyte); -print('DVI file: '''); print_packet(new_packet); print_ln(''','); -print(' num=',dvi_num:1,', den=',dvi_den:1,', mag=',dvi_mag:1); -if out_mag<=0 then out_mag:=dvi_mag @+ else print(' => ',out_mag:1); -print_ln('.'); -do_pre; flush_packet - -@ @<Glob...@>= -@!dvi_num:int_31; {numerator} -@!dvi_den:int_31; {denominator} -@!dvi_mag:int_31; {magnification} - -@ @<DVI: Process the postamble@>= -begin dvi_start:=dvi_loc; {remember start of first page} -@<DVI: Find the postamble@>; -d_print_ln('DVI: postamble at ',dvi_bop_post:1); -dvi_back:=dvi_pointer; -if dvi_num<>dvi_pquad then bad_dvi; -if dvi_den<>dvi_pquad then bad_dvi; -if dvi_mag<>dvi_pquad then bad_dvi; -temp_int:=dvi_squad; temp_int:=dvi_squad; -if stack_size<dvi_upair then overflow(str_stack,stack_size); -temp_int:=dvi_upair; -dvi_first_par; -while cur_class=fnt_def_cl do - begin dvi_do_font(false); dvi_first_par; - end; -if cur_cmd<>post_post then bad_dvi; -if not selected then @<DVI: Find the starting page@>; -dvi_move(dvi_start); {go to first or starting page} -end - -@ @<DVI: Find the postamble@>= -temp_int:=dvi_length-5; -repeat if temp_int<49 then bad_dvi; -dvi_move(temp_int); temp_byte:=dvi_ubyte; decr(temp_int); -until temp_byte<>dvi_pad; -if temp_byte<>dvi_id then bad_dvi; -dvi_move(temp_int-4); if dvi_ubyte<>post_post then bad_dvi; -dvi_bop_post:=dvi_pointer; -if (dvi_bop_post<15)or(dvi_bop_post>dvi_loc-34) then bad_dvi; -dvi_move(dvi_bop_post); if dvi_ubyte<>post then bad_dvi - -@ @<DVI: Find the starting page@>= -begin dvi_start:=dvi_bop_post; {just in case} -while dvi_back<>-1 do - begin if (dvi_back<15)or(dvi_back>dvi_bop_post-46) then bad_dvi; - dvi_bop_post:=dvi_back; dvi_move(dvi_back); - if dvi_ubyte<>bop then bad_dvi; - for k:=0 to 9 do count[k]:=dvi_squad; - if start_match then dvi_start:=dvi_bop_post; - dvi_back:=dvi_pointer; - end; -end - -@ When a |bop| has been read, the \.{DVI} commands for one page are -interpreted until an |eop| is found. - -@<DVI: Process one page@>= -begin for k:=0 to 9 do count[k]:=dvi_squad; -temp_int:=dvi_pointer; do_bop; -dvi_first_par; -if type_setting then @<DVI: Process a page; then |goto done|@> -else @<DVI: Skip a page; then |goto done|@>; -done:if cur_cmd<>eop then bad_dvi; -if selected then - begin do_eop; - if all_done then return; - end; -end - -@ All \.{DVI} commands are processed, as long as |cur_class<>invalid_cl|; -then we should have found an |eop|. - -@<DVI: Process a page; then |goto done|@>= -loop begin - case cur_class of - char_cl: @<DVI: Typeset a |char|@>; - rule_cl: - if cur_upd and(cur_v_dimen=width_dimen) then - do_a_width(h_pixel_round(cur_h_dimen)) - else do_rule; - xxx_cl: - begin pckt_room(cur_parm); - while cur_parm>0 do - begin append_byte(dvi_ubyte); decr(cur_parm); - end; - do_xxx; - end; - push_cl: do_push; - pop_cl: do_pop; - five_cases(w0_cl): do_right; {|right|, |w|, or |x|} - five_cases(y0_cl): do_down; {|down|, |y|, or |z|} - fnt_cl: dvi_font; - fnt_def_cl: dvi_do_font(random_reading); - invalid_cl: goto done; - othercases abort('internal error'); - endcases; -dvi_first_par; {get the next command} -end - -@ While skipping a page all commands other than font definitions are -ignored. - -@<DVI: Skip a page; then |goto done|@>= -loop begin - case cur_class of - xxx_cl: while cur_parm>0 do - begin temp_byte:=dvi_ubyte; decr(cur_parm); - end; - fnt_def_cl: dvi_do_font(random_reading); - invalid_cl: goto done; - othercases do_nothing; - endcases; -dvi_first_par; {get the next command} -end - -@ @<DVI: Typeset a |char|@>= -begin @<Prepare to use font |cur_fnt|@>; -set_cur_wp(cur_fnt)(bad_dvi); -if font_type(cur_fnt)=vf_font_type then do_vf_packet @+ else do_char; -end - -@* The main program. -The code for real devices is still rather incomplete. -Moreover several branches of the program have not been tested because -they are never used with \.{DVI} files made by \TeX\ and \.{VF} files -made by \.{VPtoVF}. - -@ At the end of the program the output file(s) have to be finished and -on some systems it may be necessary to close input and\slash or output -files. -@^system dependencies@> - -@p procedure close_files_and_terminate; -var k:@!int_15; {general purpose index} -begin close_in(dvi_file); -if history<fatal_message then @<Finish output file(s)@>; -stat @<Print memory usage statistics@>;@+tats@;@/ -@<Close output file(s)@>@; -@<Print the job |history|@>; -end; - -@ Now we are ready to put it all together. -Here is where \.{\title} starts, and where it ends. -@^system dependencies@> - -@p begin initialize; {get all variables initialized} -@<Initialize predefined strings@>@; -dialog; {get options} -@<Open input file(s)@>@; -@<Open output file(s)@>@; -do_dvi; {process the entire \.{DVI} file} -close_files_and_terminate; -final_end:end. - -@ @<Print memory usage statistics@>= -print_ln('Memory usage statistics:'); -print(dvi_nf:1,' dvi, ',lcl_nf:1,' local, '); -@<Print more font usage statistics@>@;@/ -print_ln('and ',nf:1,' internal fonts of ',max_fonts:1); -print_ln(n_widths:1,' widths of ',max_widths:1,' for ', - n_chars:1,' characters of ',max_chars:1); -print_ln(pckt_ptr:1,' byte packets of ',max_packets:1,' with ', - byte_ptr:1,' bytes of ',max_bytes:1); -@<Print more memory usage statistics@>@;@/ -print_ln(stack_used:1,' of ',stack_size:1,' stack and ', - recur_used:1,' of ',max_recursion:1,' recursion levels.') - -@ Some implementations may wish to pass the |history| value to the -operating system so that it can be used to govern whether or not other -programs are started. Here we simply report the history to the user. -@^system dependencies@> - -@<Print the job |history|@>= -case history of -spotless: print_ln('(No errors were found.)'); -harmless_message: print_ln('(Did you see the warning message above?)'); -error_message: print_ln('(Pardon me, but I think I spotted something wrong.)'); -fatal_message: print_ln('(That was a fatal error, my friend.)'); -end {there are no other cases} - -@* Low-level output routines. -The program uses the binary file variable |out_file| for its main output -file; |out_loc| is the number of the byte about to be written next on -|out_file|. - -@<Glob...@>= -@!out_file:byte_file; {the \.{DVI} file we are writing} -@!out_loc:int_32; {where we are about to write, in |out_file|} -@!out_back:int_32; {a back pointer} -@!out_max_v:int_31; {maximum |v| value so far} -@!out_max_h:int_31; {maximum |h| value so far} -@!out_stack:int_16u; {maximum stack depth} -@!out_pages:int_16u; {total number of pages} - -@ @<Set ini...@>= -out_loc:=0; out_back:=-1; -out_max_v:=0; out_max_h:=0; -out_stack:=0; out_pages:=0; - -@ To prepare |out_file| for output, we |rewrite| it. - -@<Open output file(s)@>= -rewrite(out_file); {prepares to write packed bytes to |out_file|} - -@ For some operating systems it may be necessary to close |out_file|. - -@<Close output file(s)@>= - -@ Writing the |out_file| should be done as efficient as possible for a -particular system; on many systems this means that a large number of -bytes will be accumulated in a buffer and is then written from that -buffer to |out_file|. In order to simplify such system dependent changes -we use the \.{WEB} macro |out_byte| to write the next \.{DVI} byte. Here -we give a simple minded definition for this macro in terms of standard -\PASCAL. -@^system dependencies@> -@^optimization@> - -@d out_byte(#) == write(out_file,#) {write next \.{DVI} byte} - -@ The \.{WEB} macro |out_one| is used to write one byte and to update -|out_loc|. - -@d out_one(#) == begin out_byte(#); incr(out_loc); @+ end - -@ First the |out_packet| procedure copies a packet to |out_file|. - -@<Declare typesetting procedures@>= -procedure out_packet(@!p:pckt_pointer); -var k:byte_pointer; {index into |byte_mem|} -begin Incr(out_loc)(pckt_length(p)); -for k:=pckt_start[p] to pckt_start[p+1]-1 do out_byte(bo(byte_mem[k])); -end; - -@ Next are the procedures used to write integer numbers or even complete -\.{DVI} commands to |out_file|; they all keep |out_loc| up to date. - -The |out_four| procedure outputs four bytes in two's complement notation, -without risking arithmetic overflow. - -@<Declare typesetting procedures@>= -procedure out_four(@!x:int_32); {output four bytes} -@!begin_four; comp_four(out_byte); Incr(out_loc)(4); -end; - -@ The |out_char| procedure outputs a |set_char| or \\{set} command or, if -|upd=false|, a |put| command. - -@<Declare typesetting procedures@>= -procedure out_char(@!upd:boolean;@!ext:int_32;@!res:eight_bits); - {output \\{set} or |put|} -@!begin_char; comp_char(out_one); -end; - -@ The |out_unsigned| procedure outputs a |fnt|, |xxx|, or |fnt_def| -command with its first parameter (normally unsigned); a |fnt| command -is converted into |fnt_num| whenever this is possible. - -@<Declare typesetting procedures@>= -procedure out_unsigned(@!o:eight_bits;@!x:int_32); - {output |fnt_num|, |fnt|, |xxx|, or |fnt_def|} -@!begin_unsigned; comp_unsigned(out_one); -end; - -@ The |out_signed| procedure outputs a movement (|right|, |w|, -|x|, |down|, |y|, or |z|) command with its (signed) parameter. - -@<Declare typesetting procedures@>= -procedure out_signed(@!o:eight_bits;@!x:int_32); - {output |right|, |w|, |x|, |down|, |y|, or |z|} -@!begin_signed; comp_signed(out_one); -end; - -@ For an output font we set |font_type(f):=out_font_type|; in this case -|font_font(f)| is the font number used for font~|f| in |out_file|. -@^font types@> - -The global variable |out_nf| is the number of fonts already used in -|out_file| and the array |out_fnts| contains their internal font numbers; -the current font in |out_file| is called |out_fnt|. - -@<Glob...@>= -@!out_fnts:array[font_number] of font_number; {internal font numbers} -@!out_nf:font_number; {number of fonts used in |out_file|} -@!out_fnt:font_number; {internal font number of current output font} - -@ @<Set init...@>= -out_nf:=0; - -@ @<Print more font usage statistics@>= -print(out_nf:1,' out, '); - -@ The |out_fnt_def| procedure outputs a complete font definition -command. - -@<Declare typesetting procedures@>= -procedure out_fnt_def(@!f:font_number); -var p:pckt_pointer; {the font name packet} -@!k,@!l:byte_pointer; {indices into |byte_mem|} -@!a:eight_bits; {length of area part} -begin out_unsigned(fnt_def1,font_font(f)); out_four(font_check(f)); -out_four(font_scaled(f)); out_four(font_design(f));@/ -p:=font_name(f); k:=pckt_start[p]; l:=pckt_start[p+1]-1; -a:=bo(byte_mem[k]);@/ -Incr(out_loc)(l-k+2); out_byte(a); out_byte(l-k-a); -while k<l do - begin incr(k); out_byte(bo(byte_mem[k])); - end; -end; - -@* Writing the output file. -Here we define the device dependent parts of the typesetting routines -described earlier in this program. - -First we define a few quantities required by the device dependent code -for a real output device in order to demonstrate how they might be -defined and in order to be able to compile \.{DVIcopy} with the device -dependent code included. - -@d h_resolution==300 {horizontal resolution in pixels per inch (dpi)} -@d v_resolution==300 {vertical resolution in pixels per inch (dpi)} - -@d max_h_drift==2 {we insist that |abs(hh-h_pixel_round(h))<=max_h_drift|} -@d max_v_drift==2 {we insist that |abs(vv-v_pixel_round(v))<=max_v_drift|} - -@<Glob...@>= -@!device -@!h_conv:real; {converts \.{DVI} units to horizontal pixels} -@!v_conv:real; {converts \.{DVI} units to vertical pixels} -ecived - -@ These are the local variables (if any) needed for |do_pre|. - -@<OUT: Declare local variables (if any) for |do_pre|@>= -var k:int_15; {general purpose variable} -@!p,@!q,@!r:byte_pointer; {indices into |byte_mem|} -@!comment:packed array[1..comm_length] of char; {preamble comment prefix} - -@ And here is the device dependent code for |do_pre|; the \.{DVI} preamble -comment written to |out_file| is similar to the one produced by \.{GFtoPK}, -but we want to apply our preamble comment prefix only once. - -@<OUT: Process the |pre|@>= -out_one(pre); out_one(dvi_id); -out_four(dvi_num); out_four(dvi_den); out_four(out_mag);@/ -p:=pckt_start[pckt_ptr-1]; q:=byte_ptr; {location of old \.{DVI} comment} -comment:=preamble_comment; pckt_room(comm_length); -for k:=1 to comm_length do append_byte(xord[comment[k]]); -while byte_mem[p]=bi(" ") do incr(p); {remove leading blanks} -if p=q then Decr(byte_ptr)(from_length) -else begin k:=0; - while (k<comm_length)and(byte_mem[p+k]=byte_mem[q+k]) do incr(k); - if k=comm_length then Incr(p)(comm_length); - end; -k:=byte_ptr-p; {total length} -if k>255 then - begin k:=255; q:=p+255-comm_length; {at most 255 bytes} - end; -out_one(k); out_packet(new_packet); flush_packet; -for r:=p to q-1 do out_one(bo(byte_mem[r])); - -@ These are the additional local variables (if any) needed for |do_bop|; -the variables |@!i| and |@!j| are already declared. - -@<OUT: Declare additional local variables |do_bop|@>= -var - -@ And here is the device dependent code for |do_bop|. - -@<OUT: Process a |bop|@>= -out_one(bop); incr(out_pages); -for i:=0 to 9 do out_four(count[i]); -out_four(out_back); out_back:=out_loc-45; -out_fnt:=invalid_font; - -@ These are the local variables (if any) needed for |do_eop|. - -@<OUT: Declare local variables (if any) for |do_eop|@>= - -@ And here is the device dependent code for |do_eop|. - -@<OUT: Process an |eop|@>= -out_one(eop); - -@ These are the local variables (if any) needed for |do_push|. - -@<OUT: Declare local variables (if any) for |do_push|@>= - -@ And here is the device dependent code for |do_push|. - -@<OUT: Process a |push|@>= -if stack_ptr>out_stack then out_stack:=stack_ptr; -out_one(push); - -@ These are the local variables (if any) needed for |do_pop|. - -@<OUT: Declare local variables (if any) for |do_pop|@>= - -@ And here is the device dependent code for |do_pop|. - -@<OUT: Process a |pop|@>= -out_one(pop); - -@ These are the additional local variables (if any) needed for |do_xxx|; -the variable |@!p|, the pointer to the packet containing the special -string, is already declared. - -@<OUT: Declare additional local variables for |do_xxx|@>= -var - -@ And here is the device dependent code for |do_xxx|. - -@<OUT: Process an |xxx|@>= -out_unsigned(xxx1,pckt_length(p)); out_packet(p); - -@ These are the local variables (if any) needed for |do_right|. - -@<OUT: Declare local variables (if any) for |do_right|@>= - -@ And here is the device dependent code for |do_right|. - -@<OUT: Process a |right| or |w| or |x|@>= -if cur_class<right_cl then out_one(cur_cmd) {|w0| or |x0|} -else out_signed(dvi_right_cmd[cur_class],cur_parm); {|right|, |w|, or |x|} - -@ Here we update the |out_max_h| value. - -@<OUT: Move right@>= -if abs(cur_h)>out_max_h then out_max_h:=abs(cur_h); - -@ These are the local variables (if any) needed for |do_down|. - -@<OUT: Declare local variables (if any) for |do_down|@>= - -@ And here is the device dependent code for |do_down|. - -@<OUT: Process a |down| or |y| or |z|@>= -if cur_class<down_cl then out_one(cur_cmd) {|y0| or |z0|} -else out_signed(dvi_down_cmd[cur_class],cur_parm); {|down|, |y|, or |z|} - -@ Here we update the |out_max_v| value. - -@<OUT: Move down@>= -if abs(cur_v)>out_max_v then out_max_v:=abs(cur_v); - -@ These are the local variables (if any) needed for |do_width|. - -@<OUT: Declare local variables (if any) for |do_width|@>= - -@ And here is the device dependent code for |do_width|. - -@<OUT: Typeset a |width|@>= -out_one(set_rule); -out_four(width_dimen); out_four(cur_h_dimen); - -@ These are the additional local variables (if any) needed for |do_rule|; -the variable |@!visible| is already declared. - -@<OUT: Declare additional local variables |do_rule|@>= -var - -@ And here is the device dependent code for |do_rule|. - -@<OUT: Typeset a visible |rule|@>= -out_one(dvi_rule_cmd[cur_upd]); -out_four(cur_v_dimen); out_four(cur_h_dimen); - -@ @<OUT: Typeset an invisible |rule|@>= -@<OUT: Typeset a visible |rule|@> - -@ These are the additional local variables (if any) needed for |do_font|; -the variable |@!p| is already declared. - -@<OUT: Declare additional local variables for |do_font|@>= -var - -@ And here is the device dependent code for |do_font|; if the \.{VF} file -for a font could not be found, we simply assume this must be a real font. - -@<OUT: Look for a font file before trying to read the \.{VF} file; - if found |goto done|@>= - -@ @<OUT: Look for a font file after trying to read the \.{VF} file@>= -if(out_nf>=max_fonts) then overflow(str_fonts,max_fonts); -print('OUT: font ',cur_fnt:1); d_print(' => ',out_nf:1); -print_font(cur_fnt); -d_print(' at ',font_scaled(cur_fnt):1,' DVI units'); print_ln('.'); -font_type(cur_fnt):=out_font_type; font_font(cur_fnt):=out_nf; -out_fnts[out_nf]:=cur_fnt; incr(out_nf); -out_fnt_def(cur_fnt); - -@ And here is some device dependent code used before each character. - -@<OUT: Prepare to use font |cur_fnt|@>= - -@ These are the local variables (if any) needed for |do_char|. - -@<OUT: Declare local variables (if any) for |do_char|@>= - -@ And here is the device dependent code for |do_char|. - -@<OUT: Typeset a |char|@>= -@!debug if font_type(cur_fnt)<>out_font_type then confusion(str_fonts); -gubed @; -if cur_fnt<>out_fnt then - begin out_unsigned(fnt1,font_font(cur_fnt)); out_fnt:=cur_fnt; - end; -out_char(cur_upd,cur_ext,cur_res); - -@ If the program terminates in the middle of a page, we write as many -|pop|s as necessary and one |eop|. - -@<OUT: Finish incomplete page@>= -begin while stack_ptr>0 do - begin out_one(pop); decr(stack_ptr); - end; - out_one(eop); -end - -@ If the output file has been started, we write the postamble; in -addition we print the number of bytes and pages written to |out_file|. - -@<OUT: Finish output file(s)@>= -if out_loc>0 then - begin @<OUT: Write the postamble@>; - k:=7-((out_loc-1) mod 4); {the number of |dvi_pad| bytes} - while k>0 do - begin out_one(dvi_pad); decr(k); - end; - print('OUT file: ',out_loc:1,' bytes, ',out_pages:1,' page'); - if out_pages<>1 then print('s'); - end -else print('OUT file: no output'); -print_ln(' written.'); -if out_pages=0 then mark_harmless; - -@ Here we simply write the values accumulated during the \.{DVI} output. - -@<OUT: Write the postamble@>= -out_one(post); out_four(out_back); out_back:=out_loc-5;@/ -out_four(dvi_num); out_four(dvi_den); out_four(out_mag);@/ -out_four(out_max_v); out_four(out_max_h);@/ -out_one(out_stack div @"100); out_one(out_stack mod @"100);@/ -out_one(out_pages div @"100); out_one(out_pages mod @"100);@/ -k:=out_nf; -while k>0 do - begin decr(k); out_fnt_def(out_fnts[k]); - end; -out_one(post_post); out_four(out_back);@/ -out_one(dvi_id) - -@ Here we could print more memory usage statistics; this possibility is, -however, not used for \.{DVIcopy}. - -@<Print more memory usage statistics@>= - -@* System-dependent changes. -This section should be replaced, if necessary, by changes to the program -that are necessary to make \.{DVIcopy} work at a particular installation. -It is usually best to design your change file so that all changes to -previous sections preserve the section numbering; then everybody's version -will be consistent with the printed program. More extensive changes, -which introduce new sections, can be inserted here; then only the index -itself will get a new section number. -@^system dependencies@> - -@* Index. -Pointers to error messages appear here together with the section numbers -where each ident\-i\-fier is used. |