1
% Copyright (C) 1990,95 Peter Breitenlohner (peb@@mppmu.mpg.de)
3
% This program is free software; you can redistribute it and/or modify
4
% it under the terms of the GNU General Public License as published by
5
% the Free Software Foundation; either version 1, or (at your option)
8
% You should have received a copy of the GNU General Public License
9
% along with this program; if not, write to the Free Software
10
% Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
12
% Version 0.9 was finished May 21, 1990.
13
% Version 1.0 pixel rounding for real devices (August 6, 1990).
14
% Version 1.1 major rearrangements for DVIprint (October 7, 1990).
15
% Version 1.2 fixed some bugs, page selection (February 13, 1991).
16
% Version 1.3 several more changes, command line options,
17
% don't load fonts that are never used (August 25, 1992).
18
% Version 1.4 fixed a typo (March 28, 1995).
19
% Version 1.5 avoided cur_name_length identifier conflict (October 15, 1995).
21
% Here is TeX material that gets inserted after \input webmac
22
\def\hang{\hangindent 3em\indent\ignorespaces}
24
\let\mc=\ninerm % medium caps for names like SAIL
26
\font\logo=manfnt % font used for the METAFONT logo
27
\def\MF{{\logo META}\-{\logo FONT}}
28
\mathchardef\RA="3221 % right arrow
30
\def\(#1){} % this is used to make section names sort themselves better
31
\def\9#1{} % this is used for sort keys in the index
33
\def\title{DVI\lowercase{copy}} % don't change this line!
34
\def\contentspagenumber{1}
35
\def\topofcontents{\null
36
\def\titlepage{F} % include headline on the contents page
37
\def\rheader{\mainfont\hfil \contentspagenumber}
39
\centerline{\titlefont The {\ttitlefont DVIcopy} processor}
41
\centerline{Copyright (C) 1990,95 Peter Breitenlohner}
42
\centerline{Distributed under terms of GNU General Public License}
44
\centerline{(Version 1.5, October 1995)}
46
\def\botofcontents{\vfill
47
\centerline{\hsize 5in\baselineskip9pt
48
\vbox{\ninerm\noindent
49
This program was developed at the Max-Planck-Institut f\"ur Physik
50
(Werner-Heisenberg-Institut), Munich, Germany.
51
`\TeX' is a trademark of the American Mathematical Society.
52
`{\logo hijklmnj}\kern1pt' is a trademark of Addison-Wesley
53
Publishing Company.}}}
54
\pageno=\contentspagenumber \advance\pageno by 1
57
The \.{DVIcopy} utility program copies (selected pages of) binary
58
device-independent (``\.{DVI}'') files that are produced by document
59
compilers such as \TeX, and replaces all references to characters from
60
virtual fonts by the typesetting instructions specified for them in
61
binary virtual-font (``\.{VF}'') files.
62
This program has two chief purposes: (1)~It can be used as preprocessor
63
for existing \.{DVI}-related software in cases where this software is
64
unable to handle virtual fonts or (given suitable \.{VF} files) where
65
this software cannot handle fonts with more than 128~characters;
66
and (2)~it serves as an example of a program that reads \.{DVI} and
67
\.{VF} files correctly, for system programmers who are developing
68
\.{DVI}-related software.
70
Goal number (1) is important since quite a few existing programs have
71
to be adapted to the extened capabilities of Version~3 of \TeX\ which
72
will require some time. Moreover some existing programs are `as is' and
73
the source code is, unfortunately, not available.
74
Goal number (2) needs perhaps a bit more explanation. Programs for
75
typesetting need to be especially careful about how they do arithmetic; if
76
rounding errors accumulate, margins won't be straight, vertical rules
77
won't line up, and so on (see the documentaion of \.{DVItype} for more
78
details). This program is written as if it were a \.{DVI}-driver for a
79
hypothetical typesetting device |out_file|, the output file receiving
80
the copy of the input |dvi_file|. In addition all code related to
81
|out_file| is concentrated in two chapters at the end of this program
82
and quite independent of the rest of the code concerned with the
83
decoding of \.{DVI} and \.{VF} files and with font substitutions. Thus
84
it should be relatively easy to replace the device dependent code of
85
this program by the corresponding code required for a real typesetting
86
device. Having this in mind \.{DVItype}'s pixel rounding algorithms are
87
included as conditional code not used by \.{DVIcopy}.
89
The |banner| and |preamble_comment| strings defined here should be
90
changed whenever \.{DVIcopy} gets modified.
92
@d banner=='This is DVIcopy, Version 1.5' {printed when the program starts}
93
@d title=='DVIcopy' {the name of this program, used in some messages}
94
@d copyright=='Copyright (C) 1990,95 Peter Breitenlohner'
96
@d preamble_comment=='DVIcopy 1.5 output from '
97
@d comm_length=24 {length of |preamble_comment|}
98
@d from_length=6 {length of its |' from '| part}
100
@ This program is written in standard \PASCAL, except where it is necessary
101
to use extensions; for example, \.{DVIcopy} must read files whose names
102
are dynamically specified, and that would be impossible in pure \PASCAL.
103
All places where nonstandard constructions are used have been listed in
104
the index under ``system dependencies.''
105
@!@^system dependencies@>
107
One of the extensions to standard \PASCAL\ that we shall deal with is the
108
ability to move to a random place in a binary file; another is to
109
determine the length of a binary file. Such extensions are not necessary
110
for reading \.{DVI} files; since \.{DVIcopy} is (a model for) a
111
production program it should, however, be made as efficient as possible
112
for a particular system. If \.{DVIcopy} is being used with
113
\PASCAL s for which random file positioning is not efficiently available,
114
the following definition should be changed from |true| to |false|; in such
115
cases, \.{DVIcopy} will not include the optional feature that reads the
118
@d random_reading==true {should we skip around in the file?}
120
@ The program begins with a fairly normal header, made up of pieces that
121
@^system dependencies@>
122
will mostly be filled in later. The \.{DVI} input comes from file
123
|dvi_file|, the \.{DVI} output goes to file |out_file|, and messages
124
go to \PASCAL's standard |output| file.
125
The \.{TFM} and \.{VF} files are defined later since their external
126
names are determined dynamically.
128
If it is necessary to abort the job because of a fatal error, the program
129
calls the `|jump_out|' procedure, which goes to the label |final_end|.
131
@d final_end = 9999 {go here to wrap it up}
133
@p @t\4@>@<Compiler directives@>@/
134
program DVI_copy(@!dvi_file,@!out_file,@!output);
136
const @<Constants in the outer block@>@/
137
type @<Types in the outer block@>@/
138
var @<Globals in the outer block@>@/
139
@<Error handling procedures@>@/
140
procedure initialize; {this procedure gets things started properly}
141
var @<Local variables for initialization@>@/
142
begin print_ln(banner);@/
144
print_ln('Distributed under terms of GNU General Public License');@/
145
@<Set initial values@>@/
148
@ The definition of |max_font_type| should be adapted to the number of
149
font types used by the program; the first three values have a fixed
150
meaning: |defined_font=0| indicates that a font has been defined,
151
|loaded_font=1| indicates that the \.{TFM} file has been loaded but the
152
font has not yet been used, and |vf_font_type=2| indicates a virtual
153
font. Font type values |>=real_font=3| indicate real fonts and
154
different font types are used to distinguish various kinds of font files
155
(\.{GF} or \.{PK} or \.{PXL}). \.{DVIcopy} uses |out_font_type=3| for
156
fonts that appear in the output \.{DVI} file.
159
@d defined_font=0 {this font has been defined}
160
@d loaded_font=1 {this font has been defined and loaded}
161
@d vf_font_type=2 {this font is a virtual font}
162
@d real_font=3 {smallest font type for real fonts}
164
@d out_font_type=3 {this font appears in the output file}
167
@ The following parameters can be changed at compile time to extend or
168
reduce \.{DVIcopy}'s capacity.
170
@d max_select=10 {maximum number of page selection ranges}
173
@!max_fonts=100; {maximum number of distinct fonts}
174
@!max_chars=10000; {maximum number of different characters among all fonts}
175
@!max_widths=3000; {maximum number of different characters widths}
176
@!max_packets=5000; {maximum number of different characters packets;
177
must be less than 65536}
178
@!max_bytes=30000; {maximum number of bytes for characters packets}
179
@!max_recursion=10; {\.{VF} files shouldn't recurse beyond this level}
180
@!stack_size=100; {\.{DVI} files shouldn't |push| beyond this depth}
181
@!terminal_line_length=150; {maximum number of characters input in a single
182
line of input from the terminal}
183
@!name_length=50; {a file name shouldn't be longer than this}
185
@ As mentioned above, \.{DVIcopy} has two chief purposes: (1)~It produces
186
a copy of the input \.{DVI} file with all references to characters from
187
virtual fonts replaced by their expansion as specified in the character
188
packets of \.{VF} files; and (2)~it serves as an example of a program
189
that reads \.{DVI} and \.{VF} files correctly, for system programmers
190
who are developing \.{DVI}-related software.
192
In fact, a very large section of code (starting with the second chapter
193
`Introduction (continued)' and ending with the fifteenth chapter
194
`The main program') is used in identical form in \.{DVIcopy} and in
195
\.{DVIprint}, a prototype \.{DVI}-driver. This has been made possible
196
mostly by using several \.{WEB} coding tricks, such as not to make the
197
resulting \PASCAL\ program inefficient in any way.
199
Parts of the program that are needed in \.{DVIprint} but not in
200
\.{DVIcopy} are delimited by the codewords `$|device|\ldots|ecived|$';
201
these are mostly the pixel rounding algorithms used to convert the
202
\.{DVI} units of a \.{DVI} file to the raster units of a real output
203
device and have been copied more or less verbatim from \.{DVItype}.
205
@d device==@{ {change this to `$\\{device}\equiv\null$' when output
206
for a real device is produced}
207
@d ecived==@t@>@} {change this to `$\\{ecived}\equiv\null$' when output
208
for a real device is produced}
212
@* Introduction (continued).
213
On some systems it is necessary to use various integer subrange types
214
in order to make \.{\title} efficient; this is true in particular for
215
frequently used variables such as loop indices. Consider an integer
216
variable |x| with values in the range |0..255|: on most small systems
217
|x| should be a one or two byte integer whereas on most large systems
218
|x| should be a four byte integer.
219
Clearly the author of a program knows best which range of values is
220
required for each variable; thus \.{\title} never uses \PASCAL's |integer|
221
type. All integer variables are declared as one of the integer subrange
222
types defined below as \.{WEB} macros or \PASCAL\ types; these definitions
223
can be used without system-dependent changes, provided the signed 32~bit
224
integers are a subset of the standard type |integer|, and the compiler
225
automatically uses the optimal representation for integer subranges
226
(both conditions need not be satisfied for a particular system).
227
@^system dependencies@>
229
The complementary problem of storing large arrays of integer type
230
variables as compactly as possible is addressed differently; here
231
\.{\title} uses a \PASCAL\ |type|~declaration for each kind of array
234
Note that the primary purpose of these definitions is optimizations, not
235
range checking. All places where optimization for a particular system is
236
highly desirable have been listed in the index under ``optimization.''
239
@d int_32 == integer {signed 32~bit integers}
242
@!int_31 = 0..@"7FFFFFFF; {unsigned 31~bit integer}
243
@!int_24u = 0..@"FFFFFF; {unsigned 24~bit integer}
244
@!int_24 = -@"800000..@"7FFFFF; {signed 24~bit integer}
245
@!int_23 = 0..@"7FFFFF; {unsigned 23~bit integer}
246
@!int_16u = 0..@"FFFF; {unsigned 16~bit integer}
247
@!int_16 = -@"8000..@"7FFF; {signed 16~bit integer}
248
@!int_15 = 0..@"7FFF; {unsigned 15~bit integer}
249
@!int_8u = 0..@"FF; {unsigned 8~bit integer}
250
@!int_8 = -@"80..@"7F; {signed 8~bit integer}
251
@!int_7 = 0..@"7F; {unsigned 7~bit integer}
253
@ Some of this code is optional for use when debugging only;
254
such material is enclosed between the delimiters |debug| and $|gubed|$.
255
Other parts, delimited by |stat| and $|tats|$, are optionally included
256
if statistics about \.{\title}'s memory usage are desired.
258
@d debug==@{ {change this to `$\\{debug}\equiv\null$' when debugging}
259
@d gubed==@t@>@} {change this to `$\\{gubed}\equiv\null$' when debugging}
263
@d stat==@{ {change this to `$\\{stat}\equiv\null$'
264
when gathering usage statistics}
265
@d tats==@t@>@} {change this to `$\\{tats}\equiv\null$'
266
when gathering usage statistics}
270
@ The \PASCAL\ compiler used to develop this program has ``compiler
271
directives'' that can appear in comments whose first character is a dollar sign.
272
In production versions of \.{\title} these directives tell the compiler that
273
@^system dependencies@>
274
it is safe to avoid range checks and to leave out the extra code it inserts
275
for the \PASCAL\ debugger's benefit, although interrupts will occur if
276
there is arithmetic overflow.
278
@<Compiler directives@>=
279
@{@&$C-,A+,D-@} {no range check, catch arithmetic overflow, no debug overhead}
280
@!debug @{@&$C+,D+@}@+ gubed {but turn everything on when debugging}
282
@ Labels are given symbolic names by the following definitions. We insert
283
the label `|exit|:' just before the `\ignorespaces|end|\unskip' of a
284
procedure in which we have used the `|return|' statement defined below;
285
the label `|restart|' is occasionally used at the very beginning of a
286
procedure; and the label `|reswitch|' is occasionally used just prior to
287
a \&{case} statement in which some cases change the conditions and we wish to
288
branch to the newly applicable case.
289
Loops that are set up with the \&{loop} construction defined below are
290
commonly exited by going to `|done|' or to `|found|' or to `|not_found|',
291
and they are sometimes repeated by going to `|continue|'.
293
@d exit=10 {go here to leave a procedure}
294
@d restart=20 {go here to start a procedure again}
295
@d reswitch=21 {go here to start a case statement again}
296
@d continue=22 {go here to resume a loop}
297
@d done=30 {go here to exit a loop}
298
@d found=31 {go here when you've found it}
299
@d not_found=32 {go here when you've found something else}
301
@ The term |print| is used instead of |write| when this program writes on
302
|output|, so that all such output could easily be redirected if desired;
303
the term |d_print| is used for conditional output if we are debugging.
305
@d print(#)==write(output,#)
306
@d print_ln(#)==write_ln(output,#)
307
@d new_line==write_ln(output) {start new line}
308
@d print_nl(#)== {print information starting on a new line}
309
begin new_line; print(#);
312
@d d_print(#)==@!debug print(#) @; @+ gubed
313
@d d_print_ln(#)==@! debug print_ln(#) @; @+ gubed
315
@ Here are some macros for common programming idioms.
317
@d incr(#) == #:=#+1 {increase a variable by unity}
318
@d decr(#) == #:=#-1 {decrease a variable by unity}
320
@d Incr_Decr_end(#)==#
321
@d Incr(#)==#:=#+Incr_Decr_end {we use |Incr(a)(b)| to increase \dots}
322
@d Decr(#)==#:=#-Incr_Decr_end {\dots\ and |Decr(a)(b)| to decrease
323
variable |a| by |b|; this can be optimized for some compilers}
325
@d loop == @+ while true do@+ {repeat over and over until a |goto| happens}
326
@d do_nothing == {empty statement}
327
@d return == goto exit {terminate a procedure call}
331
@ We assume that |case| statements may include a default case that applies
332
if no matching label is found. Thus, we shall use constructions like
333
@^system dependencies@>
334
$$\vbox{\halign{#\hfil\cr
336
1: $\langle\,$code for $x=1\,\rangle$;\cr
337
3: $\langle\,$code for $x=3\,\rangle$;\cr
338
|othercases| $\langle\,$code for |x<>1| and |x<>3|$\,\rangle$\cr
340
since most \PASCAL\ compilers have plugged this hole in the language by
341
incorporating some sort of default mechanism. For example, the compiler
342
used to develop \.{WEB} and \TeX\ allows `|others|:' as a default label,
343
and other \PASCAL s allow syntaxes like `\ignorespaces|else|\unskip' or
344
`\&{otherwise}' or `\\{otherwise}:', etc. The definitions of |othercases|
345
and |endcases| should be changed to agree with local conventions. (Of
346
course, if no default mechanism is available, the |case| statements of
347
this program must be extended by listing all remaining cases.
348
Donald~E. Knuth, the author of the \.{WEB} system program \.{TANGLE},
349
@^Knuth, Donald Ervin@>
350
would have taken the trouble to modify \.{TANGLE} so that such extensions
351
were done automatically, if he had not wanted to encourage \PASCAL\
352
compiler writers to make this important change in \PASCAL, where it belongs.)
354
@d othercases == others: {default for cases not listed explicitly}
355
@d endcases == @+end {follows the default case in an extended |case| statement}
356
@f othercases == else
359
@* The character set.
360
Like all programs written with the \.{WEB} system, \.{\title} can be
361
used with any character set. But it uses ASCII code internally, because
362
the programming for portable input-output is easier when a fixed internal
363
code is used, and because \.{DVI} and \.{VF} files use ASCII code for
364
file names and certain other strings.
366
The next few sections of \.{\title} have therefore been copied from the
367
analogous ones in the \.{WEB} system routines. They have been considerably
368
simplified, since \.{\title} need not deal with the controversial
369
ASCII codes less than @'40 or greater than @'176.
370
If such codes appear in the \.{DVI} file,
371
they will be printed as question marks.
374
@!ASCII_code=" ".."~"; {a subrange of the integers}
376
@ The original \PASCAL\ compiler was designed in the late 60s, when six-bit
377
character sets were common, so it did not make provision for lower case
378
letters. Nowadays, of course, we need to deal with both upper and lower case
379
alphabets in a convenient way, especially in a program like \.{\title}.
380
So we shall assume that the \PASCAL\ system being used for \.{\title}
381
has a character set containing at least the standard visible characters
382
of ASCII code (|"!"| through |"~"|).
384
Some \PASCAL\ compilers use the original name |char| for the data type
385
associated with the characters in text files, while other \PASCAL s
386
consider |char| to be a 64-element subrange of a larger data type that has
387
some other name. In order to accommodate this difference, we shall use
388
the name |text_char| to stand for the data type of the characters in the
389
output file. We shall also assume that |text_char| consists of
390
the elements |chr(first_text_char)| through |chr(last_text_char)|,
391
inclusive. The following definitions should be adjusted if necessary.
392
@^system dependencies@>
394
@d text_char == char {the data type of characters in text files}
395
@d first_text_char=0 {ordinal number of the smallest element of |text_char|}
396
@d last_text_char=127 {ordinal number of the largest element of |text_char|}
399
@!text_file=packed file of text_char;
401
@ @<Local variables for init...@>=
402
@!i:int_16; {loop index for initializations}
404
@ The \.{\title} processor converts between ASCII code and
405
the user's external character set by means of arrays |xord| and |xchr|
406
that are analogous to \PASCAL's |ord| and |chr| functions.
409
@!xord: array [text_char] of ASCII_code;
410
{specifies conversion of input characters}
411
@!xchr: array [0..255] of text_char;
412
{specifies conversion of output characters}
414
@ Under our assumption that the visible characters of standard ASCII are
415
all present, the following assignment statements initialize the
416
|xchr| array properly, without needing any system-dependent changes.
419
for i:=0 to @'37 do xchr[i]:='?';
515
for i:=@'177 to 255 do xchr[i]:='?';
517
@ The following system-independent code makes the |xord| array contain a
518
suitable inverse to the information in |xchr|.
521
for i:=first_text_char to last_text_char do xord[chr(i)]:=@'40;
522
for i:=" " to "~" do xord[xchr[i]]:=i;
524
@* Reporting errors to the user.
525
The \.{\title} processor does not verify that every single bit read from
526
one of its binary input files is meaningful and consistent; there are
527
other programs, e.g., \.{DVItype}, \.{TFtoPL}, and \.{VFtoPL}, specially
528
designed for that purpose.
530
On the other hand, \.{\title} is designed to avoid unpredictable results
531
due to undetected arithmetic overflow, or due to violation of integer
532
subranges or array bounds under {\it all\/} circumstances. Thus a fair
533
amount of checking is done when reading and analyzing the input data,
534
even in cases where such checking reduces the efficiency of the program
537
@ A global variable called |history| will contain one of four values
538
at the end of every run: |spotless| means that no unusual messages were
539
printed; |harmless_message| means that a message of possible interest
540
was printed but no serious errors were detected; |error_message| means that
541
at least one error was found; |fatal_message| means that the program
542
terminated abnormally. The value of |history| does not influence the
543
behavior of the program; it is simply computed for the convenience
544
of systems that might want to use such information.
546
@d spotless=0 {|history| value for normal jobs}
547
@d harmless_message=1 {|history| value when non-serious info was printed}
548
@d error_message=2 {|history| value when an error was noted}
549
@d fatal_message=3 {|history| value when we had to stop prematurely}
551
@d mark_harmless==@t@>@+if history=spotless then history:=harmless_message
552
@d mark_error==history:=error_message
553
@d mark_fatal==history:=fatal_message
555
@<Glob...@>=@!history:spotless..fatal_message; {how bad was this run?}
557
@ @<Set init...@>=history:=spotless;
559
@ If an input (\.{DVI}, \.{TFM}, \.{VF}, or other) file is badly malformed,
560
the whole process must be aborted; \.{\title} will give up, after issuing
561
an error message about what caused the error. These messages will, however,
562
in most cases just indicate which input file caused the error. One of the
563
programs \.{DVItype}, \.{TFtoPL} or \.{VFtoVP} should then be used to
564
diagnose the error in full detail.
566
Such errors might be discovered inside of subroutines inside of subroutines,
567
so a procedure called |jump_out| has been introduced. This procedure, which
568
transfers control to the label |final_end| at the end of the program,
569
contains the only non-local |@!goto| statement in \.{\title}.
570
@^system dependencies@>
571
Some \PASCAL\ compilers do not implement non-local |goto| statements. In
572
such cases the |goto final_end| in |jump_out| should simply be replaced
573
by a call on some system procedure that quietly terminates the program.
574
@^system dependencies@>
576
@d abort(#)==begin print_ln(' ',#,'.'); jump_out;
579
@<Error handling...@>=
580
@<Basic printing procedures@>@;
581
procedure close_files_and_terminate; forward;
584
begin mark_fatal; close_files_and_terminate;
588
@ Sometimes the program's behavior is far different from what it should
589
be, and \.{\title} prints an error message that is really for the
590
\.{\title} maintenance person, not the user. In such cases the program
591
says |confusion(|indication of where we are|)|.
593
@<Error handling...@>=
594
procedure confusion(@!p:pckt_pointer);
595
begin print(' !This can''t happen ('); print_packet(p); print_ln(').');
596
@.This can't happen@>
600
@ An overflow stop occurs if \.{\title}'s tables aren't large enough.
602
@<Error handling...@>=
603
procedure overflow(@!p:pckt_pointer;@!n:int_16u);
604
begin print(' !Sorry, ',title,' capacity exceeded ['); print_packet(p);
605
@.Sorry, {\title} capacity exceeded@>
606
print_ln('=',n:1,'].');
610
@* Binary data and binary files.
611
A detailed description of the \.{DVI} file format can be found in the
612
documentation of \TeX, \.{DVItype}, or \.{GFtoDVI}; here we just define
613
symbolic names for some of the \.{DVI} command bytes.
615
@d set_char_0=0 {typeset character 0 and move right}
616
@d set1=128 {typeset a character and move right}
617
@d set_rule=132 {typeset a rule and move right}
618
@d put1=133 {typeset a character}
619
@d put_rule=137 {typeset a rule}
620
@d nop=138 {no operation}
621
@d bop=139 {beginning of page}
622
@d eop=140 {ending of page}
623
@d push=141 {save the current positions}
624
@d pop=142 {restore previous positions}
625
@d right1=143 {move right}
626
@d w0=147 {move right by |w|}
627
@d w1=148 {move right and set |w|}
628
@d x0=152 {move right by |x|}
629
@d x1=153 {move right and set |x|}
630
@d down1=157 {move down}
631
@d y0=161 {move down by |y|}
632
@d y1=162 {move down and set |y|}
633
@d z0=166 {move down by |z|}
634
@d z1=167 {move down and set |z|}
635
@d fnt_num_0=171 {set current font to 0}
636
@d fnt1=235 {set current font}
637
@d xxx1=239 {extension to \.{DVI} primitives}
638
@d xxx4=242 {potentially long extension to \.{DVI} primitives}
639
@d fnt_def1=243 {define the meaning of a font number}
640
@d pre=247 {preamble}
641
@d post=248 {postamble beginning}
642
@d post_post=249 {postamble ending}
644
@d dvi_id=2 {identifies \.{DVI} files}
645
@d dvi_pad=223 {pad bytes at end of \.{DVI} file}
647
@ A \.{DVI}, \.{VF}, or \.{TFM} file is a sequence of 8-bit bytes.
648
The bytes appear physically in what is called a `|packed file of 0..255|'
649
in \PASCAL\ lingo. One, two, three, or four consecutive bytes are often
650
interpreted as (signed or unsigned) integers.
651
We might as well define the corresponding data types.
652
@!@^system dependencies@>
655
@!signed_byte=-@"80..@"7F; {signed one-byte quantity}
656
@!eight_bits=0..@"FF; {unsigned one-byte quantity}
657
@!signed_pair=-@"8000..@"7FFF; {signed two-byte quantity}
658
@!sixteen_bits=0..@"FFFF; {unsigned two-byte quantity}
659
@!signed_trio=-@"800000..@"7FFFFF; {signed three-byte quantity}
660
@!twentyfour_bits=0..@"FFFFFF; {unsigned three-byte quantity}
661
@!signed_quad=int_32; {signed four-byte quantity}
663
@ Packing is system dependent, and many \PASCAL\ systems fail to implement
664
such files in a sensible way (at least, from the viewpoint of producing
665
good production software). For example, some systems treat all
666
byte-oriented files as text, looking for end-of-line marks and such
667
things. Therefore some system-dependent code is often needed to deal with
668
binary files, even though most of the program in this section of
669
\.{\title} is written in standard \PASCAL.
670
@^system dependencies@>
672
One common way to solve the problem is to consider files of |integer|
673
numbers, and to convert an integer in the range $-2^{31}\L x<2^{31}$ to
674
a sequence of four bytes $(a,b,c,d)$ using the following code, which
675
avoids the controversial integer division of negative numbers:
676
$$\vbox{\halign{#\hfil\cr
677
|if x>=0 then a:=x div @'100000000|\cr
678
|else begin x:=(x+@'10000000000)+@'10000000000; a:=x div @'100000000+128;|\cr
680
|x:=x mod @'100000000;|\cr
681
|b:=x div @'200000; x:=x mod @'200000;|\cr
682
|c:=x div @'400; d:=x mod @'400;|\cr}}$$
683
The four bytes are then kept in a buffer and output one by one. (On 36-bit
684
computers, an additional division by 16 is necessary at the beginning.
685
Another way to separate an integer into four bytes is to use/abuse
686
\PASCAL's variant records, storing an integer and retrieving bytes that are
687
packed in the same place; {\sl caveat implementor!\/}) It is also desirable
688
in some cases to read a hundred or so integers at a time, maintaining a
691
@ We shall stick to simple \PASCAL\ in the standard version of this program,
692
for reasons of clarity, even if such simplicity is sometimes unrealistic.
695
@!byte_file=packed file of eight_bits; {files that contain binary data}
697
@ For some operating systems it may be convenient or even necessary to
698
close the input files.
700
@d close_in(#)==do_nothing {close an input file}
702
@ Character packets extracted from \.{VF} files will be stored in a large
703
array |byte_mem|. Other packets of bytes, e.g., character packets
704
extracted from a \.{GF} or \.{PK} or \.{PXL} file could be stored in the
705
same way. A `|pckt_pointer|' variable, which signifies a packet,
706
is an index into another array |pckt_start|. The actual sequence of bytes
707
in the packet pointed to by |p| appears in positions |pckt_start[p]| to
708
|pckt_start[p+1]-1|, inclusive, in |byte_mem|.
710
Packets will also be used to store sequences of |ASCII_code|s; in this
711
respect the |byte_mem| array is very similar to \TeX's string pool and
712
part of the following code has, in fact, been copied more or less
715
In other respects the packets resemble the identifiers used by
716
\.{TANGLE} and \.{WEAVE} (also stored in an array called |byte_mem|)
717
since there is, in general, at most one packet with a given contents;
718
thus part of the code below has been adapted from the corresponding code
721
Some \PASCAL\ compilers won't pack integers into a single byte unless the
722
integers lie in the range |-128..127|. To accommodate such systems we
723
access the array |byte_mem| only via macros that can easily be redefined.
724
@^system dependencies@>
726
@d bi(#) == # {convert from |eight_bits| to |packed_byte|}
727
@d bo(#) == # {convert from |packed_byte| to |eight_bits|}
730
@!packed_byte = eight_bits; {elements of |byte_mem| array}
731
@!byte_pointer = 0..max_bytes; {an index into |byte_mem|}
732
@!pckt_pointer = 0..max_packets; {an index into |pckt_start|}
734
@ The global variable |byte_ptr| points to the first unused location in
735
|byte_mem| and |pckt_ptr| points to the first unused location in
739
@!byte_mem: packed array [byte_pointer] of packed_byte; {bytes of packets}
740
@!pckt_start: array [pckt_pointer] of byte_pointer;
741
{directory into |byte_mem|}
742
@!byte_ptr: byte_pointer;
743
@!pckt_ptr: pckt_pointer;
745
@ Several of the elementary operations with packets are performed using
746
\.{WEB} macros instead of \PASCAL\ procedures, because many of the
747
operations are done quite frequently and we want to avoid the
748
overhead of procedure calls. For example, here is
749
a simple macro that computes the length of a packet.
752
@d pckt_length(#)==(pckt_start[#+1]-pckt_start[#]) {the number of bytes
755
@ Packets are created by appending bytes to |byte_mem|.
756
The |append_byte| macro, defined here, does not check to see if the
757
value of |byte_ptr| has gotten too high; this test is supposed to be
758
made before |append_byte| is used. There is also a |flush_byte|
759
macro, which erases the last byte appended.
761
To test if there is room to append |l| more bytes to |byte_mem|,
762
we shall write |pckt_room(l)|, which aborts \.{\title} and gives an
763
apologetic error message if there isn't enough room.
765
@d append_byte(#) == {put byte \# at the end of |byte_mem|}
766
begin byte_mem[byte_ptr]:=bi(#); incr(byte_ptr);
768
@d flush_byte == decr(byte_ptr) {forget the last byte in |byte_mem|}
769
@d pckt_room(#) == {make sure that |byte_mem| hasn't overflowed}
770
if max_bytes-byte_ptr<# then overflow(str_bytes,max_bytes)
773
begin pckt_room(1); append_byte(#);
776
@ The length of the current packet is called |cur_pckt_length|:
778
@d cur_pckt_length == (byte_ptr - pckt_start[pckt_ptr])
780
@ Once a sequence of bytes has been appended to |byte_mem|, it
781
officially becomes a packet when the |make_packet| function is called.
782
This function returns as its value the identification number of either
783
an existing packet with the same contents or, if no such packet exists,
784
of the new packet. Thus two packets have the same contents if and only
785
if they have the same identification number. In order to locate the
786
packet with a given contents, or to find out that no such packet exists,
787
we need a hash table. The hash table is kept by the method of simple
788
chaining, where the heads of the individual lists appear in the |p_hash|
789
array. If |h| is a hash code, the hash table list starts at |p_hash[h]|
790
and proceeds through |p_link| pointers.
792
@d hash_size=353 {should be prime, must be |>256|}
795
@!hash_code=0..hash_size;
798
@!p_link:array[pckt_pointer] of pckt_pointer; {hash table}
799
@!p_hash:array[hash_code] of pckt_pointer;
801
@ Initially |byte_mem| and all the hash lists are empty; |empty_packet|
804
@d empty_packet=0 {the empty packet}
805
@d invalid_packet==max_packets {used when there is no packet}
808
pckt_ptr:=1; byte_ptr:=1;
809
pckt_start[0]:=1; pckt_start[1]:=1;
810
for h:=0 to hash_size-1 do p_hash[h]:=0;
812
@ @<Local variables for init...@>=
813
@!h:hash_code; {index into hash-head arrays}
815
@ Here now is the |make_packet| function used to create packets (and
818
@p function make_packet:pckt_pointer;
820
var i,@!k:byte_pointer; {indices into |byte_mem|}
821
@!h:hash_code; {hash code}
822
@!s,@!l:byte_pointer; {start and length of the given packet}
823
@!p:pckt_pointer; {where the packet is being sought}
824
begin s:=pckt_start[pckt_ptr]; l:=byte_ptr-s; {compute start and length}
825
if l=0 then p:=empty_packet
826
else begin @<Compute the packet hash code |h|@>;
827
@<Compute the packet location |p|@>;
828
if pckt_ptr=max_packets then overflow(str_packets,max_packets);
829
incr(pckt_ptr); pckt_start[pckt_ptr]:=byte_ptr;
831
found:make_packet:=p;
834
@ A simple hash code is used: If the sequence of bytes is
835
$b_1b_2\ldots b_n$, its hash value will be
836
$$(2^{n-1}b_1+2^{n-2}b_2+\cdots+b_n)\,\bmod\,|hash_size|.$$
838
@<Compute the packet hash...@>=
839
h:=bo(byte_mem[s]); i:=s+1;
841
begin h:=(h+h+bo(byte_mem[i])) mod hash_size; incr(i);
844
@ If the packet is new, it will be placed in position |p=pckt_ptr|,
845
otherwise |p| will point to its existing location.
847
@<Compute the packet location...@>=
850
begin if pckt_length(p)=l then
851
@<Compare packet |p| with current packet, |goto found| if equal@>;
854
p:=pckt_ptr; {the current packet is new}
855
p_link[p]:=p_hash[h]; p_hash[h]:=p {insert |p| at beginning of hash list}
857
@ @<Compare packet |p|...@>=
858
begin i:=s; k:=pckt_start[p];
859
while (i<byte_ptr)and(byte_mem[i]=byte_mem[k]) do
860
begin incr(i); incr(k);
862
if i=byte_ptr then {all bytes agree}
863
begin byte_ptr:=pckt_start[pckt_ptr]; goto found;
867
@ Some packets are initialized with predefined strings of |ASCII_code|s;
868
a few macros permit us to do the initialization with a compact program.
869
Since this initialization is done when |byte_mem| is still empty, and
870
since |byte_mem| is supposed to be large enough for all the predefined
871
strings, |pckt_room| is used only if we are debugging.
873
@d pid0(#)==#:=make_packet
874
@d pid1(#)==byte_mem[byte_ptr-1]:=bi(#); pid0
875
@d pid2(#)==byte_mem[byte_ptr-2]:=bi(#); pid1
876
@d pid3(#)==byte_mem[byte_ptr-3]:=bi(#); pid2
877
@d pid4(#)==byte_mem[byte_ptr-4]:=bi(#); pid3
878
@d pid5(#)==byte_mem[byte_ptr-5]:=bi(#); pid4
879
@d pid6(#)==byte_mem[byte_ptr-6]:=bi(#); pid5
880
@d pid7(#)==byte_mem[byte_ptr-7]:=bi(#); pid6
881
@d pid8(#)==byte_mem[byte_ptr-8]:=bi(#); pid7
882
@d pid9(#)==byte_mem[byte_ptr-9]:=bi(#); pid8
883
@d pid10(#)==byte_mem[byte_ptr-10]:=bi(#); pid9
886
@!debug pckt_room(#); @+ gubed @;
889
@d id1==pid_init(1); pid1
890
@d id2==pid_init(2); pid2
891
@d id3==pid_init(3); pid3
892
@d id4==pid_init(4); pid4
893
@d id5==pid_init(5); pid5
894
@d id6==pid_init(6); pid6
895
@d id7==pid_init(7); pid7
896
@d id8==pid_init(8); pid8
897
@d id9==pid_init(9); pid9
898
@d id10==pid_init(10); pid10
900
@ Here we initialize some strings used as argument of the |overflow| and
901
|confusion| procedures.
903
@<Initialize predefined strings@>=
904
id5("f")("o")("n")("t")("s")(str_fonts);
905
id5("c")("h")("a")("r")("s")(str_chars);
906
id6("w")("i")("d")("t")("h")("s")(str_widths);
907
id7("p")("a")("c")("k")("e")("t")("s")(str_packets);
908
id5("b")("y")("t")("e")("s")(str_bytes);
909
id9("r")("e")("c")("u")("r")("s")("i")("o")("n")(str_recursion);
910
id5("s")("t")("a")("c")("k")(str_stack);
911
id10("n")("a")("m")("e")("l")("e")("n")("g")("t")("h")(str_name_length);
914
@!str_fonts,@!str_chars,@!str_widths,@!str_packets,@!str_bytes,
915
@!str_recursion,@!str_stack,@!str_name_length:pckt_pointer;
917
@ Some packets, e.g., the preamble comments of \.{DVI} and \.{VF} files,
918
are needed only temporarily. In such cases |new_packet| is used to
919
create a packet (which might duplicate an existing packet) and
920
|flush_packet| is used to discard it; the calls to |new_packet| and
921
|flush_packet| must occur in balanced pairs, without any intervening
922
calls to |make_packet|.
924
@p function new_packet: pckt_pointer;
925
begin if pckt_ptr=max_packets then overflow(str_packets,max_packets);
926
new_packet:=pckt_ptr; incr(pckt_ptr); pckt_start[pckt_ptr]:=byte_ptr;
929
procedure flush_packet;
930
begin decr(pckt_ptr); byte_ptr:=pckt_start[pckt_ptr];
933
@ The |print_packet| procedure prints the contents of a packet; such a
934
packets should, of course, consists of a sequence of |ASCII_code|s.
936
@<Basic printing...@>=
937
procedure print_packet(p:pckt_pointer);
939
begin for k:=pckt_start[p] to pckt_start[p+1]-1 do
940
print(xchr[bo(byte_mem[k])]);
943
@ When we interpret a packet we will use two (global or local) variables:
944
|cur_loc| will point to the byte to be used next, and |cur_limit| will
945
point to the start of the next packet. The macro |pckt_extract| will be
946
used to extract one byte; it should, however, never be used with
947
|cur_loc>=cur_limit|.
949
@d pckt_extract(#) ==
950
@!debug if cur_loc>=cur_limit then confusion(str_packets) @+ else @/
952
begin #:=bo(byte_mem[cur_loc]); incr(cur_loc); @+ end
955
@!cur_pckt: pckt_pointer; {the current packet}
956
@!cur_loc: byte_pointer; {current location in a packet}
957
@!cur_limit: byte_pointer; {start of next packet}
959
@ We will need routines to extract one, two, three, or four bytes from
960
|byte_mem|, from the \.{DVI} file, or from a \.{VF} file and assemble
961
them into (signed or unsigned) integers and these routines should be
962
optimized for efficiency. Here we define \.{WEB} macros to be used for
963
the body of these routines; thus the changes for system dependent
964
optimization have to be applied only once.
965
@^system dependencies@>
968
In addition we demonstrates how these macros can be used to define
969
functions that extract one, two, three, or four bytes from a character
970
packet and assemble them into signed or unsigned integers (assuming that
971
|cur_loc| and |cur_limit| are initialized suitably).
976
@d comp_sbyte(#) == if a<128 then #:=a @+ else #:=a-256
977
@d comp_ubyte(#) == #:=a
978
@f begin_byte == begin
980
@p function pckt_sbyte:int_8; {returns the next byte, signed}
981
@!begin_byte(pckt_extract); comp_sbyte(pckt_sbyte);
984
function pckt_ubyte:int_8u; {returns the next byte, unsigned}
985
@!begin_byte(pckt_extract); comp_ubyte(pckt_ubyte);
988
@ @d begin_pair(#) ==
989
var a,@!b:eight_bits;
991
@d comp_spair(#) == if a<128 then #:=a*256+b @+ else #:=(a-256)*256+b
992
@d comp_upair(#) == #:=a*256+b
993
@f begin_pair == begin
995
@p function pckt_spair:int_16; {returns the next two bytes, signed}
996
@!begin_pair(pckt_extract); comp_spair(pckt_spair);
999
function pckt_upair:int_16u; {returns the next two bytes, unsigned}
1000
@!begin_pair(pckt_extract); comp_upair(pckt_upair);
1003
@ @d begin_trio(#) ==
1004
var a,@!b,@!c:eight_bits;
1005
begin #(a); #(b); #(c)
1007
if a<128 then #:=(a*256+b)*256+c @+ else #:=((a-256)*256+b)*256+c
1008
@d comp_utrio(#) == #:=(a*256+b)*256+c
1009
@f begin_trio == begin
1011
@p function pckt_strio:int_24; {returns the next three bytes, signed}
1012
@!begin_trio(pckt_extract); comp_strio(pckt_strio);
1015
function pckt_utrio:int_24u; {returns the next three bytes, unsigned}
1016
@!begin_trio(pckt_extract); comp_utrio(pckt_utrio);
1019
@ @d begin_quad(#) ==
1020
var a,@!b,@!c,@!d:eight_bits;
1021
begin #(a); #(b); #(c); #(d)
1023
if a<128 then #:=((a*256+b)*256+c)*256+d
1024
else #:=(((a-256)*256+b)*256+c)*256+d
1025
@f begin_quad == begin
1027
@p function pckt_squad:int_32; {returns the next four bytes, signed}
1028
@!begin_quad(pckt_extract); comp_squad(pckt_squad);
1031
@ A similar set of routines is needed for the inverse task of
1032
decomposing a \.{DVI} command into a sequence of bytes to be appended
1033
to |byte_mem| or, in the case of \.{DVIcopy}, to be written to the
1034
output file. Again we define \.{WEB} macros to be used for the body
1035
of these routines; thus the changes for system dependent optimization
1036
have to be applied only once.
1037
@^system dependencies@>
1040
First, the |pckt_one| outputs one byte, negative values are represented
1041
in two's complement notation.
1043
@d begin_one == begin
1045
if x<0 then Incr(x)(256);
1047
@f begin_one == begin
1050
procedure pckt_one(@!x:int_32); {output one byte}
1051
@!begin_one; pckt_room(1); comp_one(append_byte);
1055
@ The |pckt_two| outputs two bytes, negative values are represented in
1056
two's complement notation.
1058
@d begin_two == begin
1060
if x<0 then Incr(x)(@"10000);
1061
#(x div @"100); #(x mod @"100)
1062
@f begin_two == begin
1065
procedure pckt_two(@!x:int_32); {output two byte}
1066
@!begin_two; pckt_room(2); comp_two(append_byte);
1070
@ The |pckt_four| procedure outputs four bytes in two's complement
1071
notation, without risking arithmetic overflow.
1073
@d begin_four == begin
1075
if x>=0 then #(x div @"1000000)
1076
else begin Incr(x)(@"40000000); Incr(x)(@"40000000);
1077
#((x div @"1000000) + 128);
1079
x:=x mod @"1000000; #(x div @"10000);
1080
x:=x mod @"10000; #(x div @"100);
1082
@f begin_four == begin
1084
@p procedure pckt_four(@!x:int_32); {output four bytes}
1085
@!begin_four; pckt_room(4); comp_four(append_byte);
1088
@ Next, the |pckt_char| procedure outputs a |set_char| or \\{set} command
1089
or, if |upd=false|, a |put| command.
1092
var o:eight_bits; {|set1| or |put1|}
1095
if (not upd)or(res>127)or(ext<>0) then
1096
begin o:=dvi_char_cmd[upd]; {|set1| or |put1|}
1097
if ext<0 then Incr(ext)(@"1000000);
1098
if ext=0 then #(o) @+ else @;
1099
begin if ext<@"100 then #(o+1) @+ else @;
1100
begin if ext<@"10000 then #(o+2) @+ else @;
1101
begin #(o+3); #(ext div @"10000); ext:=ext mod @"10000;
1103
#(ext div @"100); ext:=ext mod @"100;
1109
@f begin_char == begin
1111
@p procedure pckt_char(@!upd:boolean;@!ext:int_32;@!res:eight_bits);
1112
{output \\{set} or |put|}
1113
@!begin_char; pckt_room(5); comp_char(append_byte);
1116
@ Then, the |pckt_unsigned| procedure outputs a |fnt| or |xxx|
1117
command with its first parameter (normally unsigned); a |fnt| command
1118
is converted into |fnt_num| whenever this is possible.
1120
@d begin_unsigned == begin
1121
@d comp_unsigned(#) ==
1122
if (x<@"100)and(x>=0) then
1123
if (o=fnt1)and(x<64) then Incr(x)(fnt_num_0) @+ else #(o)
1125
begin if (x<@"10000)and(x>=0) then #(o+1) @+ else @;
1126
begin if (x<@"1000000)and(x>=0) then #(o+2) @+ else @;
1128
if x>=0 then #(x div @"1000000)
1129
else begin Incr(x)(@"40000000); Incr(x)(@"40000000);
1130
#((x div @"1000000) + 128);
1134
#(x div @"10000); x:=x mod @"10000;
1136
#(x div @"100); x:=x mod @"100;
1139
@f begin_unsigned == begin
1141
@p procedure pckt_unsigned(@!o:eight_bits;@!x:int_32);
1142
{output |fnt_num|, |fnt|, or |xxx|}
1143
@!begin_unsigned; pckt_room(5); comp_unsigned(append_byte);
1146
@ Finally, the |pckt_signed| procedure outputs a movement (|right|, |w|,
1147
|x|, |down|, |y|, or |z|) command with its (signed) parameter.
1150
var xx:int_31; {`absolute value' of |x|}
1152
@d comp_signed(#) ==
1153
if x>=0 then xx:=x @+ else xx:=-(x+1);
1155
begin #(o); @+ if x<0 then Incr(x)(@"100); @+ end
1156
else begin if xx<@"8000 then
1157
begin #(o+1); @+ if x<0 then Incr(x)(@"10000); @+ end
1158
else begin if xx<@"800000 then
1159
begin #(o+2); @+ if x<0 then Incr(x)(@"1000000); @+ end
1161
if x>=0 then #(x div @"1000000)
1162
else begin x:=@"7FFFFFFF-xx; #((x div @"1000000) + 128); @+ end;
1165
#(x div @"10000); x:=x mod @"10000;
1167
#(x div @"100); x:=x mod @"100;
1170
@f begin_signed == begin
1172
@p procedure pckt_signed(@!o:eight_bits;@!x:int_32);
1173
{output |right|, |w|, |x|, |down|, |y|, or |z|}
1174
@!begin_signed; pckt_room(5); comp_signed(append_byte);
1177
@ The |hex_packet| procedure prints the contents of a packet in
1180
@<Basic printing...@>=
1181
@!debug procedure hex_packet(@!p:pckt_pointer); {prints a packet in hex}
1182
var j,@!k,@!l:byte_pointer; {indices into |byte_mem|}
1184
begin j:=pckt_start[p]-1; k:=pckt_start[p+1]-1;
1185
print_ln(' packet=',p:1,' start=',j+1:1,' length=',k-j:1);
1187
begin d:=(bo(byte_mem[l])) div 16;
1188
if d<10 then print(xchr[d+"0"]) @+ else print(xchr[d-10+"A"]);
1189
d:=(bo(byte_mem[l])) mod 16;
1190
if d<10 then print(xchr[d+"0"]) @+ else print(xchr[d-10+"A"]);
1191
if (l=k)or(((l-j) mod 16)=0) then new_line
1192
else if ((l-j) mod 4)=0 then print(' ')
1199
The structure of file names is different for different systems; therefore
1200
this part of the program will, in most cases, require system dependent
1201
modifications. Here we assume that a file name consists of three parts:
1202
an area or directory specifying where the file can be found, a name
1203
proper and an extension; \.{\title} assumes that these three parts appear
1204
in order stated above but this need not be true in all cases.
1206
The font names extracted from \.{DVI} and \.{VF} files consist of an area
1207
part and a name proper; these are stored as packets consisting of the
1208
length of the area part followed by the area and the name proper.
1209
When we print an external font name we simple print the area and the name
1210
contained in the `file name packet' without delimiter between them.
1211
This may need to be modified for some systems.
1212
@^system dependencies@>
1214
@<Basic printing...@>=
1215
procedure print_font(@!f:font_number);
1216
var p:pckt_pointer; {the font name packet}
1217
@!k:byte_pointer; {index into |byte_mem|}
1218
@!m:int_31; {font magnification}
1219
begin print(' = '); p:=font_name(f);
1220
for k:=pckt_start[p]+1 to pckt_start[p+1]-1 do
1221
print(xchr[bo(byte_mem[k])]);
1222
m:=round((font_scaled(f)/font_design(f))*out_mag);
1223
if m<>1000 then print(' scaled ',m:1);
1226
@ Before a font file can be opened for input we must build a string
1227
with its external name.
1230
@!cur_name:packed array[1..name_length] of char; {external name,
1231
with no lower case letters}
1232
@!l_cur_name:int_15; {this many characters are actually relevant in
1235
@ For \.{TFM} and \.{VF} files we just append the apropriate extension
1236
to the file name packet; in addition a system dependent area part
1237
(usually different for \.{TFM} and \.{VF} files) is prepended if
1238
the file name packet contains no area part.
1239
@^system dependencies@>
1241
@d append_to_name(#)==
1242
if l_cur_name<name_length then
1243
begin incr(l_cur_name); cur_name[l_cur_name]:=#;
1245
else overflow(str_name_length,name_length)
1246
@d make_font_name_end(#)==
1247
append_to_name(#[l]); make_name
1248
@d make_font_name(#)==
1249
l_cur_name:=0; for l:=1 to # do make_font_name_end
1251
@ For files with character raster data (e.g., \.{GF} or \.{PK} files) the
1252
the extension and\slash or area part will in most cases depend on the
1253
resolution of the output device (corrected for font magnification).
1254
If the special character |res_char| occurs in the extension and\slash or
1255
default area, a character string representing the device resolution will
1257
@^system dependencies@>
1259
@d res_char=='?' {character to be replaced by font resolution}
1260
@d res_ASCII="?" {|xord[res_char]|}
1262
@d append_res_to_name(#)==
1264
@!device if c=res_char then
1265
for ll:=n_res_digits downto 1 do append_to_name(res_digits[ll])
1269
@d make_font_res_end(#)==
1270
append_res_to_name(#[l]); make_name
1271
@d make_font_res(#)==
1272
make_res; l_cur_name:=0; for l:=1 to # do make_font_res_end
1276
@!f_res:int_16u; {font resolution}
1277
@!res_digits:array [1..5] of char;
1278
@!n_res_digits:int_7; {number of significant characters in |res_digits|}
1281
@ The |make_res| procedure creates a sequence of characters representing
1282
to the font resolution |f_res|.
1284
@p @!device procedure make_res;
1286
begin n_res_digits:=0; r:=f_res;
1287
repeat incr(n_res_digits);
1288
res_digits[n_res_digits]:=xchr["0"+(r mod 10)]; r:=r div 10;
1293
@ The |make_name| procedure used to build the external file name. The
1294
global variable |l_cur_name| contains the length of a default area
1295
which has been copied to |cur_name| before |make_name| is called.
1296
@^system dependencies@>
1298
@p procedure make_name(@!e:pckt_pointer);
1299
var b:eight_bits; {a byte extracted from |byte_mem|}
1300
@!n:pckt_pointer; {file name packet}
1301
@!cur_loc,@!cur_limit:byte_pointer; {indices into |byte_mem|}
1303
@!ll:int_15; {loop index}
1305
@!c:char; {a character to be appended to |cur_name|}
1306
begin n:=font_name(cur_fnt);
1307
cur_loc:=pckt_start[n]; cur_limit:=pckt_start[n+1];
1308
pckt_extract(b); {length of area part}
1309
if b>0 then l_cur_name:=0;
1310
while cur_loc<cur_limit do
1311
begin pckt_extract(b);
1312
if (b>="a")and(b<="z") then Decr(b)("a"-"A"); {convert to upper case}
1313
append_to_name(xchr[b]);
1315
cur_loc:=pckt_start[e]; cur_limit:=pckt_start[e+1];
1316
while cur_loc<cur_limit do
1317
begin pckt_extract(b); append_res_to_name(xchr[b]);
1319
while l_cur_name<name_length do
1320
begin incr(l_cur_name); cur_name[l_cur_name]:=' ';
1325
\.{DVI} file format does not include information about character widths, since
1326
that would tend to make the files a lot longer. But a program that reads
1327
a \.{DVI} file is supposed to know the widths of the characters that appear
1328
in \\{set\_char} commands. Therefore \.{\title} looks at the font metric
1329
(\.{TFM}) files for the fonts that are involved.
1332
The character-width data appears also in other files (e.g., in \.{VF} files
1333
or in \.{GF} and \.{PK} files that specify bit patterns for digitized
1334
characters); thus, it is usually possible for \.{DVI} reading programs
1335
to get by with accessing only one file per font. For \.{VF} reading
1336
programs there is, however, a problem: (1)~when reading the character
1337
packets from a \.{VF} file the \.{TFM} width for its local fonts should
1338
be known in order to analyze and optimize the packets (e.g., determine
1339
if a packet must indeed be enclosed with |push| and |pop| as implied by
1340
the \.{VF} format); and (2)~ in order to avoid infinite recursion such
1341
programs must not try to read a \.{VF} file for a font before a
1342
character from that font is actually used. Thus \.{\title} reads the
1343
\.{TFM} file whenever a new font is encountered and delays the decision
1344
whether this is a virtual font or not.
1346
@ First of all we need to know for each font~|f| such things as its
1347
external name, design and scaled size, and the approximate size of
1348
inter-word spaces. In addition we need to know the range |bc..ec| of
1349
valid characters for this font, and for each character~|c| in~|f| we
1350
need to know if this character exists and if so what is the width of~|c|.
1351
Depending on the font type of~|f| we may want to know a few other things
1352
about character~|c| in~|f| such as the character packet from a \.{VF}
1353
file or the raster data from a \.{PK} file.
1356
In \.{\title} we want to be able to handle the full range
1357
|@t$-2^{31}$@><=c<@t$2^{31}$@>| of character codes; each character code
1358
is decomposed into a character residue |0<=res<256| and character
1359
extension |@t$-2^{23}$@><=ext<@t$2^{23}$@>| such that |c=256*ext+res|.
1360
At present \.{VFtoVP}, \.{VPtoVF}, and the standard version of \TeX\ use
1361
only characters in the range |0<=c<256| (i.e., |ext=0|), there are,
1362
however, extensions of \TeX\ which use characters with |ext<>0|.
1363
In any case characters with |ext<>0| will be used rather infrequently
1364
and we want to handle this possibility without too much overhead.
1366
Some of the data for each character~|c| depend only on its residue:
1367
first of all its width and escapement; others, such as \.{VF} packets or
1368
raster data will also depend on its extension. The later will be stored
1369
as packets in |byte_mem|, and the packets for characters with the same
1370
residue but different extension will be chained.
1372
Thus we have to maintain several variables for each character
1373
residue~|bc<=res<=ec| from each font~|f|; we store each type of variable
1374
in a large array such that the array index |font_chars(f)+res| points to
1375
the value for characters with residue |res| from font~|f|.
1377
@ Quite often a particular width value is shared by several characters in
1378
a font or even by characters from different fonts; the later will
1379
probably occur in particular for virtual fonts and the local fonts used
1380
by them. Thus the array |widths| is used to store all different \.{TFM}
1381
width values of all legal characters in all fonts; a variable of type
1382
|width_pointer| is an index into |widths| or is zero if a characters does
1385
In order to locate a given width value we use again a hash
1386
table with simple chaining; this time the heads of the individual lists
1387
appear in the |w_hash| array and the lists proceed through |w_link|
1391
@!width_pointer=0..max_widths; {an index into |widths|}
1394
@!widths:array[width_pointer] of int_32; {the different width values}
1395
@!w_link:array[width_pointer] of width_pointer; {hash table}
1396
@!w_hash:array[hash_code] of width_pointer;
1397
@!n_widths:width_pointer; {first unoccupied position in |widths|}
1399
@ Initially the |widths| array and all the hash lists are empty, except
1400
for one entry: the width value zero; in addition we set |widths[0]:=0|.
1402
@d invalid_width=0 {width pointer for invalid characters}
1403
@d zero_width=1 {a width pointer to the value zero}
1406
w_hash[0]:=1; w_link[1]:=0; widths[0]:=0; widths[1]:=0; n_widths:=2;
1407
for h:=1 to hash_size-1 do w_hash[h]:=0;
1409
@ The |make_width| function returns an index into |widths| and, if
1410
necessary, adds a new width value; thus two characters will have the
1411
same |width_pointer| if and only if their widths agree.
1413
@p function make_width(@!w:int_32):width_pointer;
1415
var h:hash_code; {hash code}
1416
@!p:width_pointer; {where the identifier is being sought}
1417
@!x:int_16; {intermediate value}
1418
begin widths[n_widths]:=w;
1419
@<Compute the width hash code |h|@>;
1420
@<Compute the width location |p|, |goto| found unless the value is new@>;
1421
if n_widths=max_widths then overflow(str_widths,max_widths);
1423
found:make_width:=p;
1426
@ A simple hash code is used: If the width value consists of the four
1427
bytes $b_0b_1b_2b_3$, its hash value will be
1428
$$(8*b_0+4*b_1+2*b_2+b_3)\,\bmod\,|hash_size|.$$
1430
@<Compute the width hash...@>=
1431
if w>=0 then x:=w div @"1000000
1432
else begin w:=w+@"40000000; w:=w+@"40000000; x:=(w div @"1000000)+@"80;
1434
w:=w mod @"1000000; x:=x+x+(w div @"10000);
1435
w:=w mod @"10000; x:=x+x+(w div @"100);
1436
h:=(x+x+(w mod @"100)) mod hash_size
1438
@ If the width is new, it has been placed into position |p=n_widths|,
1439
otherwise |p| will point to its existing location.
1441
@<Compute the width location...@>=
1444
begin if widths[p]=widths[n_widths] then goto found;
1447
p:=n_widths; {the current width is new}
1448
w_link[p]:=w_hash[h]; w_hash[h]:=p {insert |p| at beginning of hash list}
1450
@ The |char_widths| array is used to store the |width_pointer|s for all
1451
different characters among all fonts. The |char_packets| array is used
1452
to store the |pckt_pointer|s for all different characters among all
1453
fonts; they can point to character packets from \.{VF} files or, e.g.,
1454
raster packets from \.{PK} files.
1457
@!char_offset=-255..max_chars; {|char_pointer| offset for a font}
1458
@!char_pointer=0..max_chars; {index into |char_widths| or similar arrays}
1461
@!char_widths:array[char_pointer] of width_pointer; {width pointers}
1462
@!char_packets:array[char_pointer] of pckt_pointer; {packet pointers}
1463
@!n_chars:char_pointer; {first unused position in |char_widths|}
1468
@ The current number of known fonts is |nf|; each known font has an
1469
internal number |f|, where |0<=f<nf|. For the moment we need for each
1470
known font: |font_check|, |font_scaled|, |font_design|, |font_name|,
1471
|font_bc|, |font_ec|, |font_chars|, and |font_type|. Here |font_scaled|
1472
and |font_design| are measured in \.{DVI} units and |font_chars| is of
1473
type |char_offset|: the width pointer for character~|c| of the font is
1474
stored in |char_widths[char_offset+c]| (for |font_bc<=c<=font_ec|).
1475
Lateron we will need additional information depending on the font type:
1476
\.{VF} or real (\.{GF}, \.{PK}, or \.{PXL}).
1479
@!f_type=defined_font..max_font_type; {type of a font}
1480
@!font_number=0..max_fonts;
1485
@ These data are stored in several arrays and we use \.{WEB} macros
1486
to access the various fields. Thus it would be simple to store the
1487
data in an array of record structures and adapt the \.{WEB} macros
1490
We will say, e.g., |font_name(f)| for the name field of font~|f|, and
1491
|font_width(f)(c)| for the width pointer of character~|c| in font~|f|
1492
and |font_packet(f)(c)| for its character packet (this character
1493
exists provided |font_bc(f)<=c<=font_ec(f)| and
1494
|font_width(f)(c)<>invalid_width|). The actual width of character~|c| in
1495
font~|f| is stored in |widths[font_width(f)(c)]|.
1497
@d font_check(#)==fnt_check[#] {checksum}
1498
@d font_scaled(#)==fnt_scaled[#] {scaled or `at' size}
1499
@d font_design(#)==fnt_design[#] {design size}
1500
@d font_name(#)==fnt_name[#] {area plus name packet}
1501
@d font_bc(#)==fnt_bc[#] {first character}
1502
@d font_ec(#)==fnt_ec[#] {last character}
1503
@d font_chars(#)==fnt_chars[#] {character info offset}
1504
@d font_type(#)==fnt_type[#] {type of this font}
1505
@d font_font(#)==fnt_font[#] {use depends on |font_type|}
1507
@d font_width_end(#)==#]
1508
@d font_width(#)==char_widths[font_chars(#)+font_width_end
1509
@d font_packet(#)==char_packets[font_chars(#)+font_width_end
1512
@!fnt_check:array [font_number] of int_32; {checksum}
1513
@!fnt_scaled:array [font_number] of int_31; {scaled size}
1514
@!fnt_design:array [font_number] of int_31; {design size}
1515
@!device @<Declare device dependent font data arrays@>@; @+ ecived @; @/
1516
@!fnt_name:array [font_number] of pckt_pointer; {pointer to area plus
1518
@!fnt_bc:array [font_number] of eight_bits; {first character}
1519
@!fnt_ec:array [font_number] of eight_bits; {last character}
1520
@!fnt_chars:array [font_number] of char_offset; {character info offset}
1521
@!fnt_type:array [font_number] of f_type; {type of font}
1522
@!fnt_font:array [font_number] of font_number; {use depends on |font_type|}
1524
@ @d invalid_font==max_fonts {used when there is no valid font}
1527
@!device @<Initialize device dependent font data@>@; @+ ecived @;@/
1530
@ A \.{VF}, or \.{GF}, or \.{PK} file may contain information for
1531
several characters with the same residue but with different extension;
1532
all except the first of the corresponding packets in |byte_mem| will
1533
contain a pointer to the previous one and |font_packet(f)(res)|
1534
identifies the last such packet.
1536
A character packet in |byte_mem| starts with a flag byte
1537
$$\hbox{|flag=@"40*ext_flag+@"20*chain_flag+type_flag|}$$
1538
with |0<=ext_flag<=3|, |0<=chain_flag<=1|, |0<=type_flag<=@"1F|,
1539
followed by |ext_flag| bytes with the character extension for this
1540
packet and, if |chain_flag=1|, by a two byte packet pointer to the
1541
previous packet for the same font and character residue. The actual
1542
character packet follows after these header bytes and the
1543
interpretation of the |type_flag| depends on whether this is a \.{VF}
1544
packet or a packet for raster data.
1546
The empty packet is interpreted as a special case of a packet with
1553
@!type_flag=0..chain_flag-1; {the range of values for the |type_flag|}
1555
@ The global variable |cur_fnt| is the internal font number of the
1556
currently selected font, or equals |invalid_font| if no font has
1557
been selected; |cur_res| and |cur_ext| are the residue and extension
1558
part of the current character code. The type of a character packet
1559
located by the |find_packet| function defined below is |cur_type|.
1560
While building a character packet for a character, |pckt_ext| and
1561
|pckt_res| are the extension and residue of this character; |pckt_dup|
1562
indicates whether a packet for this extension exists already.
1565
@!cur_fnt:font_number; {the currently selected font}
1566
@!cur_ext:int_24; {the current character extension}
1567
@!cur_res:int_8u; {the current character residue}
1568
@!cur_type:type_flag; {type of the current character packet}
1569
@!pckt_ext:int_24; {character extension for the current character packet}
1570
@!pckt_res:int_8u; {character residue for the current character packet}
1571
@!pckt_dup:boolean; {is there a previous packet for the same extension?}
1572
@!pckt_prev:pckt_pointer; {a previous packet for the same extension}
1573
@!pckt_m_msg,@!pckt_s_msg,@!pckt_d_msg:int_7; {counts for various character
1574
packet error messages}
1577
cur_fnt:=invalid_font; pckt_m_msg:=0; pckt_s_msg:=0; pckt_d_msg:=0;
1579
@ The |find_packet| functions is used to locate the character packet for
1580
the character with residue~|cur_res| and extension~|cur_ext| from
1581
font~|cur_fnt| and returns |false| if no packet exists for any extension;
1582
otherwise the result is |true| and the global variables |cur_packet|,
1583
|cur_type|, |cur_loc|, and |cur_limit| are initialized. In case none of
1584
the character packets has the correct extension, the last one in the
1585
chain (the one defined first) is used instead and |cur_ext| is changed
1588
@p function find_packet:boolean;
1590
var p,@!q:pckt_pointer; {current and next packet}
1591
@!f:eight_bits; {a flag byte}
1592
@!e:int_24; {extension for a packet}
1593
begin @<Locate a character packet and |goto found| if found@>;
1594
if font_packet(cur_fnt)(cur_res)=invalid_packet then
1595
begin if pckt_m_msg<10 then {stop telling after first 10 times}
1596
begin print_ln('---missing character packet for character ',cur_res:1,
1597
@.missing character packet...@>
1598
' font ',cur_fnt:1);
1599
incr(pckt_m_msg); mark_error;
1600
if pckt_m_msg=10 then print_ln('---further messages suppressed.');
1602
find_packet:=false; return;
1604
if pckt_s_msg<10 then {stop telling after first 10 times}
1605
begin print_ln('---substituted character packet with extension ',
1606
@.substituted character packet...@>
1607
e:1,' instead of ',cur_ext:1,' for character ',cur_res:1,
1608
' font ',cur_fnt:1);
1609
incr(pckt_s_msg); mark_error;
1610
if pckt_s_msg=10 then print_ln('---further messages suppressed.');
1613
found: cur_pckt:=p; cur_type:=f; find_packet:=true;
1616
@ @<Locate a character packet and |goto found| if found@>=
1617
q:=font_packet(cur_fnt)(cur_res);
1618
while q<>invalid_packet do
1619
begin p:=q; q:=invalid_packet;
1620
cur_loc:=pckt_start[p]; cur_limit:=pckt_start[p+1];
1621
if p=empty_packet then
1624
else begin pckt_extract(f);
1625
case (f div ext_flag) of
1630
end; {there are no other cases}
1631
if (f mod ext_flag)>=chain_flag then q:=pckt_upair;
1632
f:=f mod chain_flag;
1634
if e=cur_ext then goto found;
1637
@ The |start_packet| procedure is used to create the header bytes of a
1638
character packet for the character with residue~|cur_res| and
1639
extension~|cur_ext| from font~|cur_fnt|; if a previous such a packet
1640
exists, we try to build an exact duplicate, i.e., use the chain field of
1641
that previous packet.
1643
@p procedure start_packet(@!t:type_flag);
1644
label found,not_found;
1645
var p,@!q:pckt_pointer; {current and next packet}
1646
@!f:int_8u; {a flag byte}
1647
@!e:int_32; {extension for a packet}
1648
@!cur_loc: byte_pointer; {current location in a packet}
1649
@!cur_limit: byte_pointer; {start of next packet}
1650
begin @<Locate a character packet and |goto found| if found@>;
1651
q:=font_packet(cur_fnt)(cur_res); pckt_dup:=false; goto not_found;
1652
found: pckt_dup:=true; pckt_prev:=p;
1653
not_found: pckt_ext:=cur_ext; pckt_res:=cur_res; pckt_room(6);
1654
@!debug if byte_ptr<>pckt_start[pckt_ptr] then confusion(str_packets);
1656
if q=invalid_packet then f:=t @+ else f:=t+chain_flag;
1658
if e<0 then Incr(e)(@"1000000);
1659
if e=0 then append_byte(f) @+ else @;
1660
begin if e<@"100 then append_byte(f+ext_flag) @+ else @;
1661
begin if e<@"10000 then append_byte(f+ext_flag+ext_flag) @+ else @;
1662
begin append_byte(f+ext_flag+ext_flag+ext_flag);
1663
append_byte(e div @"10000); e:=e mod @"10000;
1665
append_byte(e div @"100); e:=e mod @"100;
1669
if q<>invalid_packet then
1670
begin append_byte(q div @"100); append_byte(q mod @"100);
1674
@ The |build_packet| procedure is used to finish a character packet.
1675
If a previous packet for the same character extension exists, the new
1676
one is discarded; if the two packets are identical, as it occasionally
1677
occurs for raster files, this is done without an error message.
1679
@p procedure build_packet;
1680
var k,@!l:byte_pointer; {indices into |byte_mem|}
1681
begin if pckt_dup then
1682
begin k:=pckt_start[pckt_prev+1]; l:=pckt_start[pckt_ptr];
1683
if (byte_ptr-l)<>(k-pckt_start[pckt_prev]) then pckt_dup:=false;
1684
while pckt_dup and(byte_ptr>l) do
1685
begin flush_byte; decr(k);
1686
if byte_mem[byte_ptr]<>byte_mem[k] then pckt_dup:=false;
1688
if (not pckt_dup)and(pckt_d_msg<10) then {stop telling after first 10 times}
1689
begin print('---duplicate packet for character ',pckt_res:1);
1690
@.duplicate packet for character...@>
1691
if pckt_ext<>0 then print('.',pckt_ext:1);
1692
print_ln(' font ',cur_fnt:1);
1693
incr(pckt_d_msg); mark_error;
1694
if pckt_d_msg=10 then print_ln('---further messages suppressed.');
1698
else font_packet(cur_fnt)(pckt_res):=make_packet;
1702
A detailed description of the \.{TFM} file format can be found in the
1703
documentation of \TeX, \MF, or \.{TFtoPL}. In order to read \.{TFM}
1704
files the program uses the binary file variable |tfm_file|.
1707
@!tfm_file:byte_file; {a \.{TFM} file}
1708
@!tfm_ext:pckt_pointer; {extension for \.{TFM} files}
1710
@ @<Initialize predefined strings@>=
1711
id4(".")("T")("F")("M")(tfm_ext); {file name extension for \.{TFM} files}
1713
@ If no font directory has been specified, \.{\title} is supposed to use
1714
the default \.{TFM} directory, which is a system-dependent place where
1715
the \.{TFM} files for standard fonts are kept.
1716
The string variable |TFM_default_area| contains the name of this area.
1717
@^system dependencies@>
1719
@d TFM_default_area_name=='TeXfonts:' {change this to the correct name}
1720
@d TFM_default_area_name_length=9 {change this to the correct length}
1723
@!TFM_default_area:packed array[1..TFM_default_area_name_length] of char;
1726
TFM_default_area:=TFM_default_area_name;
1728
@ If a \.{TFM} file is badly malformed, we say |bad_font|; for a \.{TFM}
1729
file the |bad_tfm| procedure is used to give an error message which
1730
refers the user to \.{TFtoPL} and \.{PLtoTF}, and terminates \.{\title}.
1732
@<Error handling...@>=
1734
begin print('Bad TFM file'); print_font(cur_fnt); print_ln('!');
1736
abort('Use TFtoPL/PLtoTF to diagnose and correct the problem');
1737
@.Use TFtoPL/PLtoTF@>
1742
case font_type(cur_fnt) of
1743
defined_font: confusion(str_fonts);
1744
loaded_font: bad_tfm;
1745
@<Cases for |bad_font|@>@;@/
1746
end; {there are no other cases}
1749
@ To prepare |tfm_file| for input we |reset| it.
1751
@<TFM: Open |tfm_file|@>=
1752
make_font_name(TFM_default_area_name_length)(TFM_default_area)(tfm_ext);
1753
reset(tfm_file,cur_name);
1754
if eof(tfm_file) then
1755
@^system dependencies@>
1756
abort('---not loaded, TFM file can''t be opened!')
1757
@.TFM file can\'t be opened@>
1759
@ It turns out to be convenient to read four bytes at a time, when we
1760
are inputting from \.{TFM} files. The input goes into global variables
1761
|tfm_b0|, |tfm_b1|, |tfm_b2|, and |tfm_b3|, with |tfm_b0| getting the
1762
first byte and |tfm_b3| the fourth.
1765
@!tfm_b0,@!tfm_b1,@!tfm_b2,@!tfm_b3: eight_bits; {four bytes input at once}
1767
@ Reading a \.{TFM} file should be done as efficient as possible for a
1768
particular system; on many systems this means that a large number of
1769
bytes from |tfm_file| is read into a buffer and will then be extracted
1770
from that buffer. In order to simplify such system dependent changes
1771
we use the \.{WEB} macro |tfm_byte| to extract the next \.{TFM} byte;
1772
this macro and |eof(tfm_file)| are used only in the |read_tfm_word|
1773
procedure which sets |tfm_b0| through |tfm_b3| to the next four bytes
1774
in the current \.{TFM} file. Here we give simple minded definitions in
1775
terms of standard \PASCAL.
1776
@^system dependencies@>
1779
@d tfm_byte(#)==read(tfm_file,#) {read next \.{TFM} byte}
1781
@p procedure read_tfm_word;
1782
begin tfm_byte(tfm_b0); tfm_byte(tfm_b1);
1783
tfm_byte(tfm_b2); tfm_byte(tfm_b3);
1784
if eof(tfm_file) then bad_font;
1787
@ Here are three procedures used to check the consistency of font files:
1788
First, the |check_check_sum| procedure compares two check sum values: a
1789
warning is given if they differ and are both non-zero; if the second
1790
value is not zero it may replace the first one.
1791
Next, the |check_design_size| procedure compares two design size
1792
values: a warning is given if they differ by more than a small amount.
1793
Finally, the |check_width| function compares the character width value
1794
for character |cur_res| read from a \.{VF} or raster file for font
1795
|cur_fnt| with the value previously read from the \.{TFM} file and
1796
returns the width pointer for that value; a warning is given if the two
1799
@p procedure check_check_sum(@!c:int_32;@!u:boolean);
1800
{compare |font_check(cur_fnt)| with |c|}
1801
begin if (c<>font_check(cur_fnt))and(c<>0) then
1803
if font_check(cur_fnt)<>0 then
1804
begin new_line; print_ln('---beware: check sums do not agree! (',
1805
@.beware: check sums do not agree@>
1806
@.check sums do not agree@>
1807
c:1,' vs. ',font_check(cur_fnt):1,')');
1810
if u then font_check(cur_fnt):=c;
1814
procedure check_design_size(@!d:int_32);
1815
{compare |font_design(cur_fnt)| with |d|}
1816
begin if abs(d-font_design(cur_fnt))>2 then
1817
begin new_line; print_ln('---beware: design sizes do not agree! (',
1818
@.beware: design sizes do not agree@>
1819
@.design sizes do not agree@>
1820
d:1,' vs. ',font_design(cur_fnt):1,')');
1825
function check_width(w:int_32):width_pointer;
1826
{compare |widths[font_width(cur_fnt)(cur_res)]| with |w|}
1827
var wp:width_pointer; {pointer to \.{TFM} width value}
1828
begin if (cur_res>=font_bc(cur_fnt))and(cur_res<=font_ec(cur_fnt)) then
1829
wp:=font_width(cur_fnt)(cur_res)
1830
else wp:=invalid_width;
1831
if wp=invalid_width then
1832
begin print_nl('Bad char ',cur_res:1);
1834
if cur_ext<>0 then print('.',cur_ext:1);
1835
print(' font ',cur_fnt:1); print_font(cur_fnt);
1836
abort(' (compare TFM file)');
1838
if w<>widths[wp] then
1839
begin new_line; print_ln('---beware: char widths do not agree! (',
1840
@.beware: char widths do not agree@>
1841
@.char widths do not agree@>
1842
w:1,' vs. ',widths[wp]:1,')');
1848
@ The |load_font| procedure reads the \.{TFM} file for a font and puts
1849
the data extracted into position |cur_fnt| of the font data arrays.
1851
@p procedure load_font; {reads a \.{TFM} file}
1852
var l:int_16; {loop index}
1853
@!p:char_pointer; {index into |char_widths|}
1854
@!q:width_pointer; {index into |widths|}
1855
@!bc,@!ec:int_15; {first and last character in this font}
1856
@!lh:int_15; {length of header in four byte words}
1857
@!nw:int_15; {number of words in width table}
1858
@!w:int_32; {a four byte integer}
1859
@<Variables for scaling computation@>@;
1860
begin print('TFM: font ',cur_fnt:1); print_font(cur_fnt);
1861
font_type(cur_fnt):=loaded_font;
1862
@<TFM: Open |tfm_file|@>;
1863
@<TFM: Read past the header data@>;
1864
@<TFM: Store character-width indices@>;
1865
@<TFM: Read and convert the width values@>;
1866
@<TFM: Convert character-width indices to character-width pointers@>;
1868
@!device @<Initialize device dependent data for a font@>@; @+ ecived @; @/
1869
d_print(' loaded at ',font_scaled(cur_fnt):1,' DVI units');
1874
@!tfm_conv:real; {\.{DVI} units per absolute \.{TFM} unit}
1876
@ We will use the following \.{WEB} macros to construct integers from
1877
two or four of the four bytes read by |read_tfm_word|.
1878
@^system dependencies@>
1880
@d tfm_b01(#)== {|tfm_b0..tfm_b1| as non-negative integer}
1881
if tfm_b0>127 then bad_font
1882
else #:=tfm_b0*256+tfm_b1
1883
@d tfm_b23(#)== {|tfm_b2..tfm_b3| as non-negative integer}
1884
if tfm_b2>127 then bad_font
1885
else #:=tfm_b2*256+tfm_b3
1886
@d tfm_squad(#)== {|tfm_b0..tfm_b3| as signed integer}
1887
if tfm_b0<128 then #:=((tfm_b0*256+tfm_b1)*256+tfm_b2)*256+tfm_b3
1888
else #:=(((tfm_b0-256)*256+tfm_b1)*256+tfm_b2)*256+tfm_b3
1889
@d tfm_uquad== {|tfm_b0..tfm_b3| as unsigned integer}
1890
(((tfm_b0*256+tfm_b1)*256+tfm_b2)*256+tfm_b3)
1892
@<TFM: Read past the header data@>=
1893
read_tfm_word; tfm_b23(lh);
1894
read_tfm_word; tfm_b01(bc); tfm_b23(ec);
1898
else if ec>255 then bad_font;
1899
read_tfm_word; tfm_b01(nw);
1900
if (nw=0)or(nw>256) then bad_font;
1902
begin read_tfm_word;
1904
begin tfm_squad(w); check_check_sum(w,true);
1907
begin if tfm_b0>127 then bad_font;
1908
check_design_size(round(tfm_conv*tfm_uquad));
1912
@ The width indices for the characters are stored in positions |n_chars|
1913
through |n_chars-bc+ec| of the |char_widths| array; if characters on
1914
either end of the range |bc..ec| do not exist, they are ignored and the
1915
range is adjusted accordingly.
1917
@<TFM: Store character-width indices@>=
1919
while (tfm_b0=0)and(bc<=ec) do
1920
begin incr(bc); read_tfm_word;
1922
font_bc(cur_fnt):=bc; font_chars(cur_fnt):=n_chars-bc;
1923
if ec>=max_chars-font_chars(cur_fnt) then overflow(str_chars,max_chars);
1925
begin char_widths[n_chars]:=tfm_b0; incr(n_chars); read_tfm_word;
1927
while (char_widths[n_chars-1]=0)and(ec>=bc) do
1928
begin decr(n_chars); decr(ec);
1930
font_ec(cur_fnt):=ec
1932
@ The most important part of |load_font| is the width computation, which
1933
involves multiplying the relative widths in the \.{TFM} file by the
1934
scaling factor in the \.{DVI} file. A similar computation is used for
1935
dimensions read from \.{VF} files. This fixed-point multiplication must
1936
be done with precisely the same accuracy by all \.{DVI}-reading programs,
1937
in order to validate the assumptions made by \.{DVI}-writing programs
1940
Let us therefore summarize what needs to be done. Each width in a \.{TFM}
1941
file appears as a four-byte quantity called a |fix_word|. A |fix_word|
1942
whose respective bytes are $(a,b,c,d)$ represents the number
1943
$$x=\left\{\vcenter{\halign{$#$,\hfil\qquad&if $#$\hfil\cr
1944
b\cdot2^{-4}+c\cdot2^{-12}+d\cdot2^{-20}&a=0;\cr
1945
-16+b\cdot2^{-4}+c\cdot2^{-12}+d\cdot2^{-20}&a=255.\cr}}\right.$$
1946
(No other choices of $a$ are allowed, since the magnitude of a \.{TFM}
1947
dimension must be less than 16.) We want to multiply this quantity by the
1948
integer~|z|, which is known to be less than $2^{27}$.
1949
If $|z|<2^{23}$, the individual multiplications $b\cdot z$, $c\cdot z$,
1950
$d\cdot z$ cannot overflow; otherwise we will divide |z| by 2, 4, 8, or
1951
16, to obtain a multiplier less than $2^{23}$, and we can compensate for
1952
this later. If |z| has thereby been replaced by $|z|^\prime=|z|/2^e$, let
1953
$\beta=2^{4-e}$; we shall compute
1954
$$\lfloor(b+c\cdot2^{-8}+d\cdot2^{-16})\,z^\prime/\beta\rfloor$$ if $a=0$,
1955
or the same quantity minus $\alpha=2^{4+e}z^\prime$ if $a=255$.
1956
This calculation must be done exactly, for the reasons stated above; the
1957
following program does the job in a system-independent way, assuming
1958
that arithmetic is exact on numbers less than $2^{31}$ in magnitude. We
1959
use \.{WEB} macros for various versions of this computation.
1960
@^system dependencies@>
1963
@d tfm_fix3u== {convert |tfm_b1..tfm_b3| to an unsigned scaled dimension}
1964
(((((tfm_b3*z)div@'400)+(tfm_b2*z))div@'400)+(tfm_b1*z))div beta
1966
@d tfm_fix4(#)== {convert |tfm_b0..tfm_b3| to a scaled dimension}
1968
if tfm_b0>0 then if tfm_b0=255 then Decr(#)(alpha) else bad_font
1969
@d tfm_fix3(#)== {convert |tfm_b1..tfm_b3| to a scaled dimension}
1970
#:=tfm_fix3u; @+ if tfm_b1>127 then Decr(#)(alpha)
1971
@d tfm_fix2== {convert |tfm_b2..tfm_b3| to a scaled dimension}
1972
if tfm_b2>127 then tfm_b1:=255 else tfm_b1:=0;
1974
@d tfm_fix1== {convert |tfm_b3| to a scaled dimension}
1975
if tfm_b3>127 then tfm_b1:=255 else tfm_b1:=0;
1976
tfm_b2:=tfm_b1; tfm_fix3
1978
@<Variables for scaling computation@>=
1979
@!z:int_32; {multiplier}
1980
@!alpha:int_32; {correction for negative values}
1981
@!beta:int_15; {divisor}
1983
@ @<Replace |z| by $|z|^\prime$ and compute $\alpha,\beta$@>=
1985
while z>=@'40000000 do
1986
begin z:=z div 2; alpha:=alpha+alpha;
1988
beta:=256 div alpha; alpha:=alpha*z
1990
@ The first width value, which indicates that a character does not exist
1991
and which must vanish, is converted to |invalid_width|; the other width
1992
values are scaled by |font_scaled(cur_fnt)| and converted to width
1993
pointers by |make_width|. The resulting width pointers are stored
1994
temporarily in the |char_widths| array, following the with indices.
1996
@<TFM: Read and convert the width values@>=
1997
if nw-1>max_chars-n_chars then overflow(str_chars,max_chars);
1998
if (tfm_b0<>0)or(tfm_b1<>0)or(tfm_b2<>0)or(tfm_b3<>0) then bad_font
1999
else char_widths[n_chars]:=invalid_width;
2000
z:=font_scaled(cur_fnt);
2002
for p:=n_chars+1 to n_chars+nw-1 do
2003
begin read_tfm_word; tfm_fix4(w);
2004
char_widths[p]:=make_width(w);
2007
@ We simply translate the width indices into width pointers. In addition
2008
we initialize the character packets with the invalid packet.
2010
@<TFM: Convert character-width indices to character-width pointers@>=
2011
for p:=font_chars(cur_fnt)+bc to n_chars-1 do
2012
begin q:=char_widths[n_chars+char_widths[p]]; char_widths[p]:=q;
2013
char_packets[p]:=invalid_packet;
2016
@ When processing a font definition we put the data extracted from the
2017
\.{DVI} or \.{VF} file into position |nf| of the font data arrays and
2018
call |define_font| to obtain the internal font number for this font.
2019
The parameter |load| is true if the \.{TFM} file should be loaded.
2021
@p function define_font(@!load:boolean):font_number;
2022
var save_fnt:font_number; {used to save |cur_fnt|}
2023
begin save_fnt:=cur_fnt; {save}
2025
while (font_name(cur_fnt)<>font_name(nf))or@|
2026
(font_scaled(cur_fnt)<>font_scaled(nf)) do incr(cur_fnt);
2027
d_print(' => ',cur_fnt:1); print_font(cur_fnt);
2029
begin check_check_sum(font_check(nf),true);
2030
check_design_size(font_design(nf));
2031
@!debug if font_type(cur_fnt)=defined_font then print(' defined')
2032
else print(' loaded');
2033
print(' previously');
2036
else begin if nf=max_fonts then overflow(str_fonts,max_fonts);
2037
incr(nf); font_font(cur_fnt):=invalid_font;
2038
font_type(cur_fnt):=defined_font;
2039
d_print(' defined');
2042
if load and(font_type(cur_fnt)=defined_font) then load_font;
2043
define_font:=cur_fnt;
2044
cur_fnt:=save_fnt; {restore}
2047
@* Low-level DVI input routines.
2048
The program uses the binary file variable |dvi_file| for its main input
2049
file; |dvi_loc| is the number of the byte about to be read next from
2053
@!dvi_file:byte_file; {the stuff we are \.{\title}ing}
2054
@!dvi_loc:int_32; {where we are about to look, in |dvi_file|}
2056
@ If the \.{DVI} file is badly malformed, we say |bad_dvi|; this
2057
procedure gives an error message which refers the user to \.{DVItype},
2058
and terminates \.{\title}.
2060
@<Error handling...@>=
2062
begin new_line; print_ln('Bad DVI file: loc=',dvi_loc:1,'!');
2064
print(' Use DVItype with output level');
2066
if random_reading then print('=4') @+ else print('<4');
2067
abort('to diagnose the problem');
2070
@ To prepare |dvi_file| for input, we |reset| it.
2072
@<Open input file(s)@>=
2073
reset(dvi_file); {prepares to read packed bytes from |dvi_file|}
2076
@ Reading the \.{DVI} file should be done as efficient as possible for a
2077
particular system; on many systems this means that a large number of
2078
bytes from |dvi_file| is read into a buffer and will then be extracted
2079
from that buffer. In order to simplify such system dependent changes
2080
we use a pair of \.{WEB} macros: |dvi_byte| extracts the next \.{DVI}
2081
byte and |dvi_eof| is |true| if we have reached the end of the \.{DVI}
2082
file. Here we give simple minded definitions for these macros in terms
2083
of standard \PASCAL.
2084
@^system dependencies@>
2087
@d dvi_eof == eof(dvi_file) {has the \.{DVI} file been exhausted?}
2089
if dvi_eof then bad_dvi
2090
else read(dvi_file,#) {obtain next \.{DVI} byte}
2092
@ Next we come to the routines that are used only if |random_reading| is
2093
|true|. The driver program below needs two such routines: |dvi_length| should
2094
compute the total number of bytes in |dvi_file|, possibly also
2095
causing |eof(dvi_file)| to be true; and |dvi_move(n)| should position
2096
|dvi_file| so that the next |dvi_byte| will read byte |n|, starting with
2097
|n=0| for the first byte in the file.
2098
@^system dependencies@>
2100
Such routines are, of course, highly system dependent. They are implemented
2101
here in terms of two assumed system routines called |set_pos| and |cur_pos|.
2102
The call |set_pos(f,n)| moves to item |n| in file |f|, unless |n| is
2103
negative or larger than the total number of items in |f|; in the latter
2104
case, |set_pos(f,n)| moves to the end of file |f|.
2105
The call |cur_pos(f)| gives the total number of items in |f|, if
2106
|eof(f)| is true; we use |cur_pos| only in such a situation.
2108
@p function dvi_length:int_32;
2109
begin set_pos(dvi_file,-1); dvi_length:=cur_pos(dvi_file);
2112
procedure dvi_move(@!n:int_32);
2113
begin set_pos(dvi_file,n); dvi_loc:=n;
2116
@ We need seven simple functions to read the next byte or bytes
2119
@p function dvi_sbyte:int_8; {returns the next byte, signed}
2120
@!begin_byte(dvi_byte); incr(dvi_loc); comp_sbyte(dvi_sbyte);
2123
function dvi_ubyte:int_8u; {returns the next byte, unsigned}
2124
@!begin_byte(dvi_byte); incr(dvi_loc); comp_ubyte(dvi_ubyte);
2127
function dvi_spair:int_16; {returns the next two bytes, signed}
2128
@!begin_pair(dvi_byte); Incr(dvi_loc)(2); comp_spair(dvi_spair);
2131
function dvi_upair:int_16u; {returns the next two bytes, unsigned}
2132
@!begin_pair(dvi_byte); Incr(dvi_loc)(2); comp_upair(dvi_upair);
2135
function dvi_strio:int_24; {returns the next three bytes, signed}
2136
@!begin_trio(dvi_byte); Incr(dvi_loc)(3); comp_strio(dvi_strio);
2139
function dvi_utrio:int_24u; {returns the next three bytes, unsigned}
2140
@!begin_trio(dvi_byte); Incr(dvi_loc)(3); comp_utrio(dvi_utrio);
2143
function dvi_squad:int_32; {returns the next four bytes, signed}
2144
@!begin_quad(dvi_byte); Incr(dvi_loc)(4); comp_squad(dvi_squad);
2147
@ Three other functions are used in cases where a four byte integer
2148
(which is always signed) must have a non-negative value, a positive
2149
value, or is a pointer which must be either positive or |=-1|.
2151
@p function dvi_uquad:int_31; {result must be non-negative}
2153
begin x:=dvi_squad; if x<0 then bad_dvi
2157
function dvi_pquad:int_31; {result must be positive}
2159
begin x:=dvi_squad; if x<=0 then bad_dvi
2163
function dvi_pointer:int_32; {result must be positive or |=-1|}
2165
begin x:=dvi_squad; if (x<=0)and(x<>-1) then bad_dvi
2166
else dvi_pointer:=x;
2169
@ Given the structure of the \.{DVI} commands it is fairly obvious
2170
that their interpretation consists of two steps: First zero to four
2171
bytes are read in order to obtain the value of the first parameter
2172
(e.g., zero bytes for |set_char_0|, four bytes for |set4|); then,
2173
depending on the command class, a specific action is performed (e.g.,
2174
typeset a character but don't move the reference point for |put1..put4|).
2176
The \.{DVItype} program uses large case statements for both steps;
2177
unfortunately some \PASCAL\ compilers fail to implement large case
2178
statements efficiently -- in particular those as the one used in the
2179
|first_par| function of \.{DVItype}. Here we use a pair of look up tables:
2180
|dvi_par| determines how to obtain the value of the first parameter, and
2181
|dvi_cl| determines the command class.
2183
A slight complication arises from the fact that we want to decompose the
2184
character code of each character to be typset into a residue
2185
|0<=char_res<256| and extension: |char_code=char_res+256*char_ext|;
2186
the \.{TFM} widths as well as the pixel widths for a given resolution
2187
are the same for all characters in a font with the same residue.
2189
@d two_cases(#)==#,#+1
2190
@d three_cases(#)==#,#+1,#+2
2191
@d five_cases(#)==#,#+1,#+2,#+3,#+4
2193
@ First we define the values used as array elements of |dvi_par|; we
2194
distinguish between pure numbers and dimensions because dimensions read
2195
from a \.{VF} file must be scaled.
2197
@d char_par=0 {character for \\{set} and |put|}
2198
@d no_par=1 {no parameter}
2199
@d dim1_par=2 {one-byte signed dimension}
2200
@d num1_par=3 {one-byte unsigned number}
2201
@d dim2_par=4 {two-byte signed dimension}
2202
@d num2_par=5 {two-byte unsigned number}
2203
@d dim3_par=6 {three-byte signed dimension}
2204
@d num3_par=7 {three-byte unsigned number}
2205
@d dim4_par=8 {four-byte signed dimension}
2206
@d num4_par=9 {four-byte signed number}
2207
@d numu_par=10 {four-byte non-negative number}
2208
@d rule_par=11 {dimensions for |set_rule| and |put_rule|}
2209
@d fnt_par=12 {font for |fnt_num| commands}
2210
@d max_par=12 {largest possible value}
2213
@!cmd_par=char_par..max_par;
2215
@ Here we declare the array |dvi_par|.
2218
@!dvi_par:packed array [eight_bits] of cmd_par;
2220
@ And here we initialize it.
2223
for i:=0 to put1+3 do dvi_par[i]:=char_par;@/
2224
for i:=nop to 255 do dvi_par[i]:=no_par;@/
2225
dvi_par[set_rule]:=rule_par; dvi_par[put_rule]:=rule_par;@/
2226
dvi_par[right1]:=dim1_par; dvi_par[right1+1]:=dim2_par;
2227
dvi_par[right1+2]:=dim3_par; dvi_par[right1+3]:=dim4_par;@/
2228
for i:=fnt_num_0 to fnt_num_0+63 do dvi_par[i]:=fnt_par;@/
2229
dvi_par[fnt1]:=num1_par; dvi_par[fnt1+1]:=num2_par;
2230
dvi_par[fnt1+2]:=num3_par; dvi_par[fnt1+3]:=num4_par;@/
2231
dvi_par[xxx1]:=num1_par; dvi_par[xxx1+1]:=num2_par;
2232
dvi_par[xxx1+2]:=num3_par; dvi_par[xxx1+3]:=numu_par;@/
2234
begin dvi_par[i+w1]:=dvi_par[i+right1];
2235
dvi_par[i+x1]:=dvi_par[i+right1];
2236
dvi_par[i+down1]:=dvi_par[i+right1];
2237
dvi_par[i+y1]:=dvi_par[i+right1];
2238
dvi_par[i+z1]:=dvi_par[i+right1];
2239
dvi_par[i+fnt_def1]:=dvi_par[i+fnt1];
2242
@ Next we define the values used as array elements of |dvi_cl|;
2243
several \.{DVI} commands (e.g., |nop|, |bop|, |eop|, |pre|, |post|) will
2244
always be treated separately and are therfore assigned to the invalid
2248
@d rule_cl=char_cl+1
2265
@d max_cl=invalid_cl {largest possible value}
2268
@!cmd_cl=char_cl..max_cl;
2270
@ Here we declare the array |dvi_cl|.
2273
@!dvi_cl:packed array [eight_bits] of cmd_cl;
2275
@ And here we initialize it.
2278
for i:=set_char_0 to put1+3 do dvi_cl[i]:=char_cl;
2279
dvi_cl[set_rule]:=rule_cl; dvi_cl[put_rule]:=rule_cl;@/
2280
dvi_cl[nop]:=invalid_cl;
2281
dvi_cl[bop]:=invalid_cl; dvi_cl[eop]:=invalid_cl;@/
2282
dvi_cl[push]:=push_cl; dvi_cl[pop]:=pop_cl;@/
2283
dvi_cl[w0]:=w0_cl; dvi_cl[x0]:=x0_cl;@/
2284
dvi_cl[y0]:=y0_cl; dvi_cl[z0]:=z0_cl;@/
2286
begin dvi_cl[i+right1]:=right_cl;
2288
dvi_cl[i+x1]:=x_cl;@/
2289
dvi_cl[i+down1]:=down_cl;
2291
dvi_cl[i+z1]:=z_cl;@/
2292
dvi_cl[i+xxx1]:=xxx_cl;
2293
dvi_cl[i+fnt_def1]:=fnt_def_cl;
2295
for i:=fnt_num_0 to fnt1+3 do dvi_cl[i]:=fnt_cl;
2296
for i:=pre to 255 do dvi_cl[i]:=invalid_cl;
2298
@ A few small arrays are used to generate \.{DVI} commands.
2301
@!dvi_char_cmd:array[boolean] of eight_bits; {|put1| and |set1|}
2302
@!dvi_rule_cmd:array[boolean] of eight_bits; {|put_rule| and |set_rule|}
2303
@!dvi_right_cmd:array[right_cl..x_cl] of eight_bits; {|right1|, |w1|, and |x1|}
2304
@!dvi_down_cmd:array[down_cl..z_cl] of eight_bits; {|down1|, |y1|, and |z1|}
2307
dvi_char_cmd[false]:=put1;
2308
dvi_char_cmd[true]:=set1;@/
2309
dvi_rule_cmd[false]:=put_rule;
2310
dvi_rule_cmd[true]:=set_rule;@/
2311
dvi_right_cmd[right_cl]:=right1;
2312
dvi_right_cmd[w_cl]:=w1;
2313
dvi_right_cmd[x_cl]:=x1;@/
2314
dvi_down_cmd[down_cl]:=down1;
2315
dvi_down_cmd[y_cl]:=y1;
2316
dvi_down_cmd[z_cl]:=z1;
2318
@ The global variables |cur_cmd|, |cur_parm| and |cur_class| are used
2319
for the current \.{DVI} command, its first parameter (if any), and its
2320
command class respectively.
2323
@!cur_cmd:eight_bits; {current \.{DVI} command byte}
2324
@!cur_parm:int_32; {its first parameter (if any)}
2325
@!cur_class:cmd_cl; {its class}
2327
@ When typesetting a character or rule, the boolean variable |cur_upd|
2328
is |true| for \\{set} commands, |false| for |put| commands.
2331
@!cur_cp:char_pointer; {|char_widths| index for the current character}
2332
@!cur_wp:width_pointer; {width pointer of the current character}
2333
@!cur_upd:boolean; {is this a \\{set} or |set_rule| command ?}
2334
@!cur_v_dimen:int_32; {a vertical dimension}
2335
@!cur_h_dimen:int_32; {a horizontal dimension}
2338
cur_cp:=0; cur_wp:=invalid_width; {so they can be saved and restored!}
2340
@ The |dvi_first_par| procedure first reads \.{DVI} command bytes into
2341
|cur_cmd| until |cur_cmd<>nop|; then |cur_parm| is set to the value of
2342
the first parameter (if any) and |cur_class| to the command class.
2344
@d set_cur_char(#)== {set up |cur_res|, |cur_ext|, and |cur_upd|}
2346
if cur_cmd<set1 then
2347
begin cur_res:=cur_cmd; cur_upd:=true
2349
else begin cur_res:=#; cur_upd:=(cur_cmd<put1);
2350
Decr(cur_cmd)(dvi_char_cmd[cur_upd]);
2352
begin if cur_cmd=3 then if cur_res>127 then cur_ext:=-1;
2353
cur_ext:=cur_ext*256+cur_res; cur_res:=#; decr(cur_cmd);
2358
@p procedure dvi_first_par;
2359
begin repeat cur_cmd:=dvi_ubyte;
2360
until cur_cmd<>nop; {skip over |nop|s}
2361
case dvi_par[cur_cmd] of
2362
char_par: set_cur_char(dvi_ubyte);
2364
dim1_par: cur_parm:=dvi_sbyte;
2365
num1_par: cur_parm:=dvi_ubyte;
2366
dim2_par: cur_parm:=dvi_spair;
2367
num2_par: cur_parm:=dvi_upair;
2368
dim3_par: cur_parm:=dvi_strio;
2369
num3_par: cur_parm:=dvi_utrio;
2370
two_cases(dim4_par): cur_parm:=dvi_squad; {|dim4_par| and |num4_par|}
2371
numu_par: cur_parm:=dvi_uquad;
2373
begin cur_v_dimen:=dvi_squad; cur_h_dimen:=dvi_squad;
2374
cur_upd:=(cur_cmd=set_rule);
2376
fnt_par:cur_parm:=cur_cmd-fnt_num_0;
2377
end; {there are no other cases}
2378
cur_class:=dvi_cl[cur_cmd];
2381
@ The global variable |dvi_nf| is used for the number of different
2382
\.{DVI} fonts defined so far; their external font numbers (as extracted
2383
from the \.{DVI} file) are stored in the array |dvi_e_fnts|, the
2384
corresponding internal font numbers used internally by \.{\title} are
2385
stored in the array |dvi_i_fnts|.
2388
@!dvi_e_fnts:array[font_number] of int_32; {external font numbers}
2389
@!dvi_i_fnts:array[font_number] of font_number; {corresponding
2390
internal font numbers}
2391
@!dvi_nf:font_number; {number of \.{DVI} fonts defined so far}
2396
@ The |dvi_font| procedure sets |cur_fnt| to the internal font number
2397
corresponding to the external font number |cur_parm| (or aborts the
2398
program if such a font was never defined).
2400
@p procedure dvi_font; {computes |cur_fnt| corresponding to |cur_parm|}
2401
var f:font_number; {where the font is sought}
2402
begin @<DVI: Locate font |cur_parm|@>;
2403
if f=dvi_nf then bad_dvi;
2404
cur_fnt:=dvi_i_fnts[f];
2405
if font_type(cur_fnt)=defined_font then load_font;
2408
@ @<DVI: Locate font |cur_parm|@>=
2409
f:=0; dvi_e_fnts[dvi_nf]:=cur_parm;
2410
while cur_parm<>dvi_e_fnts[f] do incr(f)
2412
@ Finally the |dvi_do_font| procedure is called when one of the command
2413
|fnt_def1..fnt_def4| and its first parameter have been read from the
2414
\.{DVI} file; the argument indicates whether this should be the second
2415
definition of the font (|true|) or not (|false|).
2417
@p procedure dvi_do_font(@!second:boolean);
2418
var f:font_number; {where the font is sought}
2419
@!k:int_15; {general purpose variable}
2420
begin print('DVI: font ',cur_parm:1);
2421
@<DVI: Locate font |cur_parm|@>;
2422
if (f=dvi_nf)=second then bad_dvi;
2423
font_check(nf):=dvi_squad;
2424
font_scaled(nf):=dvi_pquad;
2425
font_design(nf):=dvi_pquad;
2426
k:=dvi_ubyte; pckt_room(1); append_byte(k);
2427
Incr(k)(dvi_ubyte); pckt_room(k);
2428
while k>0 do begin append_byte(dvi_ubyte); decr(k);
2430
font_name(nf):=make_packet; {the font area plus name}
2431
dvi_i_fnts[dvi_nf]:=define_font(false);
2433
begin if dvi_nf=max_fonts then overflow(str_fonts,max_fonts);
2436
else if dvi_i_fnts[f]<>dvi_i_fnts[dvi_nf] then bad_dvi;
2439
@* Low-level VF input routines.
2440
A detailed description of the \.{VF} file format can be found in the
2441
documentation of \.{VFtoVP}; here we just define symbolic names for
2442
some of the \.{VF} command bytes.
2444
@d long_char=242 {\.{VF} command for general character packet}
2446
@d vf_id=202 {identifies \.{VF} files}
2448
@ The program uses the binary file variable |vf_file| for input from
2449
\.{VF} files; |vf_loc| is the number of the byte about to be read next
2453
@!vf_file:byte_file; {a \.{VF} file}
2454
@!vf_loc:int_32; {where we are about to look, in |vf_file|}
2455
@!vf_limit:int_32; {value of |vf_loc| at end of a character packet}
2456
@!vf_ext:pckt_pointer; {extension for \.{VF} files}
2457
@!vf_cur_fnt:font_number; {current font number in a \.{VF} file}
2459
@ @<Initialize predefined strings@>=
2460
id3(".")("V")("F")(vf_ext); {file name extension for \.{VF} files}
2462
@ If a \.{VF} file is badly malformed, we say |bad_font|; this procedure
2463
gives an error message which refers the user to \.{VFtoVP} and \.{VPtoVF},
2464
and terminates \.{\title}.
2466
@<Cases for |bad_font|@>=
2467
vf_font_type: begin print('Bad VF file'); print_font(cur_fnt);
2469
print_ln(' loc=',vf_loc:1);
2470
abort('Use VFtoVP/VPtoVF to diagnose and correct the problem');
2471
@.Use VFtoVP/VPtoVF@>
2474
@ If no font directory has been specified, \.{\title} is supposed to use
2475
the default \.{VF} directory, which is a system-dependent place where
2476
the \.{VF} files for standard fonts are kept.
2477
The string variable |VF_default_area| contains the name of this area.
2478
@^system dependencies@>
2480
@d VF_default_area_name=='TeXvfonts:' {change this to the correct name}
2481
@d VF_default_area_name_length=10 {change this to the correct length}
2484
@!VF_default_area:packed array[1..VF_default_area_name_length] of char;
2487
VF_default_area:=VF_default_area_name;
2489
@ To prepare |vf_file| for input we |reset| it.
2491
@<VF: Open |vf_file| or |goto not_found|@>=
2492
make_font_name(VF_default_area_name_length)(VF_default_area)(vf_ext);
2493
reset(vf_file,cur_name);
2494
if eof(vf_file) then
2495
@^system dependencies@>
2499
@ Reading a \.{VF} file should be done as efficient as possible for a
2500
particular system; on many systems this means that a large number of
2501
bytes from |vf_file| is read into a buffer and will then be extracted
2502
from that buffer. In order to simplify such system dependent changes
2503
we use a pair of \.{WEB} macros: |vf_byte| extracts the next \.{VF}
2504
byte and |vf_eof| is |true| if we have reached the end of the \.{VF}
2505
file. Here we give simple minded definitions for these macros in terms
2506
of standard \PASCAL.
2507
@^system dependencies@>
2510
@d vf_eof == eof(vf_file) {has the \.{VF} file been exhausted?}
2512
if vf_eof then bad_font
2513
else read(vf_file,#) {obtain next \.{VF} byte}
2515
@ We need several simple functions to read the next byte or bytes
2518
@p function vf_ubyte:int_8u; {returns the next byte, unsigned}
2519
@!begin_byte(vf_byte); incr(vf_loc); comp_ubyte(vf_ubyte);
2522
function vf_upair:int_16u; {returns the next two bytes, unsigned}
2523
@!begin_pair(vf_byte); Incr(vf_loc)(2); comp_upair(vf_upair);
2526
function vf_strio:int_24; {returns the next three bytes, signed}
2527
@!begin_trio(vf_byte); Incr(vf_loc)(3); comp_strio(vf_strio);
2530
function vf_utrio:int_24u; {returns the next three bytes, unsigned}
2531
@!begin_trio(vf_byte); Incr(vf_loc)(3); comp_utrio(vf_utrio);
2534
function vf_squad:int_32; {returns the next four bytes, signed}
2535
@!begin_quad(vf_byte); Incr(vf_loc)(4); comp_squad(vf_squad);
2538
@ All dimensions in a \.{VF} file, except the design sizes of a virtual
2539
font and its local fonts, are |fix_word|s that must be scaled in exactly
2540
the same way as the character widths from a \.{TFM} file; we can use the
2541
same code, but this time |z|, |alpha|, and |beta| are global variables.
2544
@<Variables for scaling computation@>@;
2546
@ We need five functions to read the next byte or bytes and convert a
2547
|fix_word| to a scaled dimension.
2549
@p function vf_fix1:int_32; {returns the next byte as scaled value}
2550
var x:int_32; {accumulator}
2551
begin vf_byte(tfm_b3); incr(vf_loc);
2552
tfm_fix1(x); vf_fix1:=x;
2555
function vf_fix2:int_32; {returns the next two bytes as scaled value}
2556
var x:int_32; {accumulator}
2557
begin vf_byte(tfm_b2); vf_byte(tfm_b3); Incr(vf_loc)(2);
2558
tfm_fix2(x); vf_fix2:=x;
2561
function vf_fix3:int_32; {returns the next three bytes as scaled value}
2562
var x:int_32; {accumulator}
2563
begin vf_byte(tfm_b1); vf_byte(tfm_b2); vf_byte(tfm_b3);
2565
tfm_fix3(x); vf_fix3:=x;
2568
function vf_fix3u:int_32; {returns the next three bytes as scaled value}
2569
begin vf_byte(tfm_b1); vf_byte(tfm_b2); vf_byte(tfm_b3);
2571
vf_fix3u:=tfm_fix3u;
2574
function vf_fix4:int_32; {returns the next four bytes as scaled value}
2575
var x:int_32; {accumulator}
2576
begin vf_byte(tfm_b0); vf_byte(tfm_b1); vf_byte(tfm_b2); vf_byte(tfm_b3);
2578
tfm_fix4(x); vf_fix4:=x;
2581
@ Three other functions are used in cases where the result must have a
2582
non-negative value or a positive value.
2584
@p function vf_uquad:int_31; {result must be non-negative}
2586
begin x:=vf_squad; if x<0 then bad_font @+ else vf_uquad:=x;
2589
function vf_pquad:int_31; {result must be positive}
2591
begin x:=vf_squad; if x<=0 then bad_font @+ else vf_pquad:=x;
2594
function vf_fixp:int_31; {result must be positive}
2595
var x:int_32; {accumulator}
2596
begin vf_byte(tfm_b0); vf_byte(tfm_b1); vf_byte(tfm_b2); vf_byte(tfm_b3);
2598
if tfm_b0>0 then bad_font;
2602
@ The |vf_first_par| procedure first reads a \.{VF} command byte into
2603
|cur_cmd|; then |cur_parm| is set to the value of the first parameter
2604
(if any) and |cur_class| to the command class.
2606
@d set_cur_wp_end(#)== if cur_wp=invalid_width then #
2607
@d set_cur_wp(#)== {set |cur_wp| to the char's width pointer}
2608
cur_wp:=invalid_width;
2609
if #<>invalid_font then
2610
if (cur_res>=font_bc(#))and(cur_res<=font_ec(#)) then
2611
begin cur_cp:=font_chars(#)+cur_res; cur_wp:=char_widths[cur_cp];
2615
@p procedure vf_first_par;
2616
begin cur_cmd:=vf_ubyte;
2617
case dvi_par[cur_cmd] of
2619
begin set_cur_char(vf_ubyte); set_cur_wp(vf_cur_fnt)(bad_font);
2622
dim1_par: cur_parm:=vf_fix1;
2623
num1_par: cur_parm:=vf_ubyte;
2624
dim2_par: cur_parm:=vf_fix2;
2625
num2_par: cur_parm:=vf_upair;
2626
dim3_par: cur_parm:=vf_fix3;
2627
num3_par: cur_parm:=vf_utrio;
2628
dim4_par: cur_parm:=vf_fix4;
2629
num4_par: cur_parm:=vf_squad;
2630
numu_par: cur_parm:=vf_uquad;
2632
begin cur_v_dimen:=vf_fix4; cur_h_dimen:=vf_fix4;
2633
cur_upd:=(cur_cmd=set_rule);
2635
fnt_par:cur_parm:=cur_cmd-fnt_num_0;
2636
end; {there are no other cases}
2637
cur_class:=dvi_cl[cur_cmd];
2640
@ For a virtual font we set |font_type(f):=vf_font_type|; in this case
2641
|font_font(f)| is the default font for character packets from virtual
2645
The global variable |vf_nf| is used for the number of different local
2646
fonts defined in a \.{VF} file so far; their external font numbers (as
2647
extracted from the \.{VF} file) are stored in the array |vf_e_fnts|, the
2648
corresponding internal font numbers used internally by \.{\title} are
2649
stored in the array |vf_i_fnts|.
2652
@!vf_e_fnts:array[font_number] of int_32; {external font numbers}
2653
@!vf_i_fnts:array[font_number] of font_number; {corresponding
2654
internal font numbers}
2655
@!vf_nf:font_number; {number of local fonts defined so far}
2656
@!lcl_nf:font_number; {largest |vf_nf| value for any \.{VF} file}
2661
@ The |vf_font| procedure sets |vf_cur_fnt| to the internal font number
2662
corresponding to the external font number |cur_parm| (or aborts the
2663
program if such a font was never defined).
2665
@p procedure vf_font; {computes |vf_cur_fnt| corresponding to |cur_parm|}
2666
var f:font_number; {where the font is sought}
2667
begin @<VF: Locate font |cur_parm|@>;
2668
if f=vf_nf then bad_font;
2669
vf_cur_fnt:=vf_i_fnts[f];
2672
@ @<VF: Locate font |cur_parm|@>=
2673
f:=0; vf_e_fnts[vf_nf]:=cur_parm;
2674
while cur_parm<>vf_e_fnts[f] do incr(f)
2676
@ Finally the |vf_do_font| procedure is called when one of the command
2677
|fnt_def1..fnt_def4| and its first parameter have been read from the
2680
@p procedure vf_do_font;
2681
var f:font_number; {where the font is sought}
2682
@!k:int_15; {general purpose variable}
2683
begin print('VF: font ',cur_parm:1);@/
2684
@<VF: Locate font |cur_parm|@>;
2685
if f<>vf_nf then bad_font;
2686
font_check(nf):=vf_squad;
2687
font_scaled(nf):=vf_fixp;
2688
font_design(nf):=round(tfm_conv*vf_pquad);
2689
k:=vf_ubyte; pckt_room(1); append_byte(k);
2690
Incr(k)(vf_ubyte); pckt_room(k);
2691
while k>0 do begin append_byte(vf_ubyte); decr(k);
2693
font_name(nf):=make_packet; {the font area plus name}
2694
vf_i_fnts[vf_nf]:=define_font(true);
2695
if vf_nf=lcl_nf then
2696
if lcl_nf=max_fonts then overflow(str_fonts,max_fonts)
2701
@* Reading VF files.
2702
The |do_vf| function attempts to read the \.{VF} file for a font and
2703
returns |false| if the \.{VF} file could not be found; otherwise the
2704
font type is changed to |vf_font_type|.
2706
@p function do_vf:boolean; {read a \.{VF} file}
2707
label reswitch,done,not_found,exit;
2708
var temp_int:int_32; {integer for temporary variables}
2709
@!temp_byte:int_8u; {byte for temporary variables}
2710
@!k:byte_pointer; {index into |byte_mem|}
2711
@!l:int_15; {general purpose variable}
2712
@!save_ext:int_24; {used to save |cur_ext|}
2713
@!save_res:int_8u; {used to save |cur_res|}
2714
@!save_cp:width_pointer; {used to save |cur_cp|}
2715
@!save_wp:width_pointer; {used to save |cur_wp|}
2716
@!save_upd:boolean; {used to save |cur_upd|}
2717
@!vf_wp:width_pointer; {width pointer for the current character packet}
2718
@!vf_fnt:font_number; {current font in the current character packet}
2719
@!move_zero:boolean; {|true| if rule 1 is used}
2720
@!last_pop:boolean; {|true| if final |pop| has been manufactured}
2721
begin @<VF: Open |vf_file| or |goto not_found|@>;
2722
save_ext:=cur_ext; save_res:=cur_res; save_cp:=cur_cp; save_wp:=cur_wp;
2723
save_upd:=cur_upd; {save}
2724
font_type(cur_fnt):=vf_font_type;@/
2725
@<VF: Process the preamble@>;@/
2726
@<VF: Process the font definitions@>;@/
2727
while cur_cmd<=long_char do @<VF: Build a character packet@>;
2728
if cur_cmd<>post then bad_font;
2729
@!debug print('VF file for font ',cur_fnt:1); print_font(cur_fnt);
2730
print_ln(' loaded.');
2733
cur_ext:=save_ext; cur_res:=save_res; cur_cp:=save_cp; cur_wp:=save_wp;
2734
cur_upd:=save_upd; {restore}
2735
do_vf:=true; return;
2736
not_found:do_vf:=false;
2739
@ @<VF: Process the preamble@>=
2740
if vf_ubyte<>pre then bad_font;
2741
if vf_ubyte<>vf_id then bad_font;
2742
temp_byte:=vf_ubyte; pckt_room(temp_byte);
2743
for l:=1 to temp_byte do append_byte(vf_ubyte);
2744
print('VF file: '''); print_packet(new_packet); print(''',');
2746
check_check_sum(vf_squad,false);
2747
check_design_size(round(tfm_conv*vf_pquad));@/
2748
z:=font_scaled(cur_fnt);
2749
@<Replace |z|...@>;@/
2750
print_nl(' for font ',cur_fnt:1); print_font(cur_fnt); print_ln('.')
2752
@ @<VF: Process the font definitions@>=
2753
vf_i_fnts[0]:=invalid_font; vf_nf:=0;@/
2755
while (cur_cmd>=fnt_def1)and(cur_cmd<=fnt_def1+3) do
2756
begin case cur_cmd-fnt_def1 of
2757
0: cur_parm:=vf_ubyte;
2758
1: cur_parm:=vf_upair;
2759
2: cur_parm:=vf_utrio;
2760
3: cur_parm:=vf_squad;
2761
end; {there are no other cases}
2765
font_font(cur_fnt):=vf_i_fnts[0]
2767
@ The \.{VF} format specifies that the interpretation of each packet
2768
begins with |w=x=y=z=0|; any |w0|, |x0|, |y0|, or |z0| command using
2769
these initial values will be ignored.
2772
@!vf_state=array[0..1,0..1] of boolean; {state of |w|, |x|, |y|, and |z|}
2774
@ As implied by the \.{VF} format the \.{DVI} commands read from the
2775
\.{VF} file are enclosed by |push| and |pop|; as we read \.{DVI}
2776
commands and append them to |byte_mem|, we perform a set of
2777
transformations in order to simplify the resulting packet: Let |zero| be
2778
any of the commands |put|, |put_rule|, |fnt_num|, |fnt|, or |xxx| which
2779
all leave the current position on the page unchanged, let |move| be any
2780
of the horizontal or vertical movement commands |right1..z4|, and let
2781
|any| be any sequence of commands containing |push| and |pop| in
2782
properly nested pairs; whenever possible we apply one of the following
2783
transformation rules: $$\def\n#1:{\hbox to 3cm{\hfil#1:}}
2785
\hbox{|push| |zero|}&\RA\hbox{|zero| |push|}&\n1:\cr
2786
\hbox{|move| |pop|}&\RA\hbox{|pop|}&\n2:\cr
2787
\hbox{|push| |pop|}&\RA{}&\n3:\cr
2788
\hbox{|push| |set_char| |pop|}&\RA\hbox{|put|}&\n4a:\cr
2789
\hbox{|push| \\{set} |pop|}&\RA\hbox{|put|}&\n4b:\cr
2790
\hbox{|push| |set_rule| |pop|}&\RA\hbox{|put_rule|}&\n4c:\cr
2791
\hbox{|push| |push| |any| |pop|}&\RA\hbox{|push| |any| |pop| |push|}&\n5:\cr
2792
\hbox{|push| |any| |pop| |pop|}&\RA\hbox{|any| |pop|}&\n6:\cr
2795
@ In order to perform these transformations we need a stack which is
2796
indexed by |vf_ptr|, the number of |push| commands without corresponding
2797
|pop| in the packet we are building; the |vf_push_loc| array contains
2798
the locations in |byte_mem| following such |push| commands.
2799
In view of rule~5 consecutive |push| commands are never stored, the
2800
|vf_push_num| array is used to count them.
2801
The |vf_last| array indicates the type of the last non-discardable item:
2802
a character, a rule, or a group enclosed by |push| and |pop|;
2803
the |vf_last_end| array points to the ending locations and, if
2804
|vf_last<>vf_other|, the |vf_last_loc| array points to the starting
2805
locations of these items.
2807
@d vf_set=0 {|vf_set=char_cl|, last item is a |set_char| or \\{set}}
2808
@d vf_rule=1 {|vf_rule=rule_cl|, last item is a |set_rule|}
2809
@d vf_group=2 {last item is a group enclosed by |push| and |pop|}
2810
@d vf_put=3 {last item is a |put|}
2811
@d vf_other=4 {last item (if any) is none of the above}
2814
@!vf_type=vf_set..vf_other;
2817
@!vf_move: array[stack_pointer] of vf_state; {state of |w|, |x|, |y|, and |z|}
2818
@!vf_push_loc: array[stack_pointer] of byte_pointer; {end of a |push|}
2819
@!vf_last_loc: array[stack_pointer] of byte_pointer; {start of an item}
2820
@!vf_last_end: array[stack_pointer] of byte_pointer; {end of an item}
2821
@!vf_push_num: array[stack_pointer] of eight_bits; {|push| count}
2822
@!vf_last: array[stack_pointer] of vf_type; {type of last item}
2823
@!vf_ptr:stack_pointer; {current number of unfinished groups}
2824
@!stack_used:stack_pointer; {largest |vf_ptr| or |stack_ptr| value}
2826
@ We use two small arrays to determine the item type of a character or a
2830
@!vf_char_type:array[boolean] of vf_type;
2831
@!vf_rule_type:array[boolean] of vf_type;
2834
vf_move[0][0][0]:=false; vf_move[0][0][1]:=false;
2835
vf_move[0][1][0]:=false; vf_move[0][1][1]:=false;@/
2837
vf_char_type[false]:=vf_put; vf_char_type[true]:=vf_set;@/
2838
vf_rule_type[false]:=vf_other; vf_rule_type[true]:=vf_rule;
2840
@ Here we read the first bytes of a character packet from the \.{VF}
2841
file and initialize the packet being built in |byte_mem|; the start of
2842
the whole packet is stored in |vf_push_loc[0]|. When the character
2843
packet is finished, a type is be assigned to it: |vf_simple| if the
2844
packet ends with a character of the correct width, or |vf_complex|
2845
otherwise. Moreover, if such a packet for a character with
2846
extension zero consists of just one character with extension zero and
2847
the same residue, and if there is no previous packet, the whole packet
2848
is replaced by the empty packet.
2850
@d vf_simple=0 {the packet ends with a character of the correct width}
2851
@d vf_complex=vf_simple+1 {otherwise}
2853
@<VF: Build a character packet@>=
2854
begin if cur_cmd<long_char then
2855
begin vf_limit:=cur_cmd;
2856
cur_ext:=0; cur_res:=vf_ubyte; vf_wp:=check_width(vf_fix3u);
2858
else begin vf_limit:=vf_uquad;
2859
cur_ext:=vf_strio; cur_res:=vf_ubyte; vf_wp:=check_width(vf_fix4);
2861
Incr(vf_limit)(vf_loc);
2862
vf_push_loc[0]:=byte_ptr; vf_last_end[0]:=byte_ptr;
2863
vf_last[0]:=vf_other; vf_ptr:=0;@/
2864
start_packet(vf_complex);
2865
@<VF: Append \.{DVI} commands to the character packet@>;@/
2866
k:=pckt_start[pckt_ptr];
2867
if vf_last[0]=vf_put then if cur_wp=vf_wp then
2868
begin decr(byte_mem[k]); {change |vf_complex| into |vf_simple|}
2869
if (byte_mem[k]=bi(0))and@|(vf_push_loc[0]=vf_last_loc[0])and@|
2870
(cur_ext=0)and@|(cur_res=pckt_res) then byte_ptr:=k;
2876
@ For every \.{DVI} command read from the \.{VF} file some action is
2877
performed; in addition the initial |push| and the final |pop| are
2880
@<VF: Append \.{DVI} commands to the character packet@>=
2881
vf_cur_fnt:=font_font(cur_fnt); vf_fnt:=vf_cur_fnt;@/
2882
last_pop:=false; cur_class:=push_cl; {initial |push|}
2884
reswitch:case cur_class of
2885
three_cases(char_cl): @<VF: Do a |char|, |rule|, or |xxx|@>;
2886
push_cl: @<VF: Do a |push|@>;
2887
pop_cl: @<VF: Do a |pop|@>;
2889
if vf_move[vf_ptr][0][cur_class-w0_cl] then append_one(cur_cmd);
2890
three_cases(right_cl):
2891
begin pckt_signed(dvi_right_cmd[cur_class],cur_parm);
2892
if cur_class>=w_cl then vf_move[vf_ptr][0][cur_class-w_cl]:=true;
2895
if vf_move[vf_ptr][1][cur_class-y0_cl] then append_one(cur_cmd);
2896
three_cases(down_cl):
2897
begin pckt_signed(dvi_down_cmd[cur_class],cur_parm);
2898
if cur_class>=y_cl then vf_move[vf_ptr][1][cur_class-y_cl]:=true;
2901
fnt_def_cl: bad_font;
2902
invalid_cl: if cur_cmd<>nop then bad_font;
2903
end; {there are no other cases}
2904
if vf_loc<vf_limit then vf_first_par
2905
else if last_pop then goto done
2906
else begin cur_class:=pop_cl; last_pop:=true; {final |pop|}
2909
done:if (vf_ptr<>0)or(vf_loc<>vf_limit) then bad_font
2911
@ For a |push| we either increase |vf_push_num| or start a new level and
2915
if #=stack_used then
2916
if stack_used=stack_size then overflow(str_stack,stack_size)
2917
else incr(stack_used);
2920
@<VF: Do a |push|@>=
2921
if (vf_ptr>0)and(vf_push_loc[vf_ptr]=byte_ptr) then
2922
begin if vf_push_num[vf_ptr]=255 then overflow(str_stack,255);
2923
incr(vf_push_num[vf_ptr]);
2925
else begin incr_stack(vf_ptr);
2926
@<VF: Start a new level@>;
2927
vf_push_num[vf_ptr]:=0;
2930
@ @<VF: Start a new level@>=
2932
vf_move[vf_ptr]:=vf_move[vf_ptr-1];
2933
vf_push_loc[vf_ptr]:=byte_ptr;
2934
vf_last_end[vf_ptr]:=byte_ptr;
2935
vf_last[vf_ptr]:=vf_other
2937
@ When a character, a rule, or an |xxx| is appended, transformation
2938
rule~1 might be applicable.
2940
@<VF: Do a |char|, |rule|, or |xxx|@>=
2941
begin if (vf_ptr=0)or(byte_ptr>vf_push_loc[vf_ptr]) then move_zero:=false
2942
else case cur_class of
2943
char_cl: move_zero:=(not cur_upd)or(vf_cur_fnt<>vf_fnt);
2944
rule_cl: move_zero:=not cur_upd;
2945
xxx_cl: move_zero:=true;
2946
end; {there are no other cases}
2948
begin decr(byte_ptr); decr(vf_ptr);
2951
char_cl: @<VF: Do a |fnt|, a |char|, or both@>;
2952
rule_cl: @<VF: Do a |rule|@>;
2953
xxx_cl: @<VF: Do an |xxx|@>;
2954
end; {there are no other cases}
2955
vf_last_end[vf_ptr]:=byte_ptr;
2957
begin incr(vf_ptr); append_one(push); vf_push_loc[vf_ptr]:=byte_ptr;
2958
vf_last_end[vf_ptr]:=byte_ptr;
2959
if cur_class=char_cl then if cur_upd then goto reswitch;
2963
@ A special situation arises if transformation rule~1 is applied to a
2964
|fnt_num| of |fnt| command, but not to the |set_char| or \\{set} command
2965
following it; in this case |cur_upd| and |move_zero| are both |true| and
2966
the |set_char| or \\{set} command will be appended later.
2968
@<VF: Do a |fnt|, a |char|, or both@>=
2969
begin if vf_cur_fnt<>vf_fnt then
2970
begin vf_last[vf_ptr]:=vf_other;
2971
pckt_unsigned(fnt1,vf_cur_fnt); vf_fnt:=vf_cur_fnt;
2973
if (not move_zero)or(not cur_upd) then
2974
begin vf_last[vf_ptr]:=vf_char_type[cur_upd];
2975
vf_last_loc[vf_ptr]:=byte_ptr;
2976
pckt_char(cur_upd,cur_ext,cur_res);
2980
@ @<VF: Do a |rule|@>=
2981
begin vf_last[vf_ptr]:=vf_rule_type[cur_upd];
2982
vf_last_loc[vf_ptr]:=byte_ptr;
2983
append_one(dvi_rule_cmd[cur_upd]);
2984
pckt_four(cur_v_dimen); pckt_four(cur_h_dimen);
2987
@ @<VF: Do an |xxx|@>=
2988
begin vf_last[vf_ptr]:=vf_other;
2989
pckt_unsigned(xxx1,cur_parm); pckt_room(cur_parm);
2991
begin append_byte(vf_ubyte); decr(cur_parm);
2995
@ Transformation rules 2--6 are triggered by a |pop|, either read from
2996
the \.{VF} file or manufactured at the end of the packet.
2999
begin if vf_ptr<1 then bad_font;
3000
byte_ptr:=vf_last_end[vf_ptr]; {this is rule 2}
3001
if vf_last[vf_ptr]<=vf_rule then
3002
if vf_last_loc[vf_ptr]=vf_push_loc[vf_ptr] then
3003
@<VF: Prepare for rule 4@>;
3004
if byte_ptr=vf_push_loc[vf_ptr] then @<VF: Apply rule 3 or 4@>
3005
else begin if vf_last[vf_ptr]=vf_group then @<VF: Apply rule 6@>;
3006
append_one(pop); decr(vf_ptr); vf_last[vf_ptr]:=vf_group;
3007
vf_last_loc[vf_ptr]:=vf_push_loc[vf_ptr+1]-1;
3008
vf_last_end[vf_ptr]:=byte_ptr;
3009
if vf_push_num[vf_ptr+1]>0 then @<VF: Apply rule 5@>;
3013
@ In order to implement transformation rule~4, we cancel the |set_char|,
3014
\\{set}, or |set_rule|, append a |pop|, and insert a |put| or |put_rule|
3015
with the old parameters.
3017
@<VF: Prepare for rule 4@>=
3018
begin cur_class:=vf_last[vf_ptr]; cur_upd:=false;
3019
byte_ptr:=vf_push_loc[vf_ptr];
3022
@ @<VF: Apply rule 3 or 4@>=
3023
begin if vf_push_num[vf_ptr]>0 then
3024
begin decr(vf_push_num[vf_ptr]);
3025
vf_move[vf_ptr]:=vf_move[vf_ptr-1];
3027
else begin decr(byte_ptr); decr(vf_ptr);
3029
if cur_class<>pop_cl then goto reswitch; {this is rule 4}
3032
@ @<VF: Apply rule 6@>=
3033
begin Decr(byte_ptr)(2);
3034
for k:=vf_last_loc[vf_ptr]+1 to byte_ptr do byte_mem[k-1]:=byte_mem[k];
3035
vf_last[vf_ptr]:=vf_other; vf_last_end[vf_ptr]:=byte_ptr;
3038
@ @<VF: Apply rule 5@>=
3040
@<VF: Start a new level@>;
3041
decr(vf_push_num[vf_ptr]);
3044
@ The \.{VF} format specifies that after a character packet invoked by a
3045
|set_char| or \\{set} command, ``|h|~is increased by the \.{TFM} width
3046
(properly scaled)---just as if a simple character had been typeset'';
3047
for |vf_simple| packets this is achieved by changing the final |put|
3048
command into |set_char| or \\{set}, but for |vf_complex| packets an
3049
explicit movement must be done. This poses a problem for programs,
3050
such as \.{DVIcopy}, which write a new \.{DVI} file with all references
3051
to characters from virtual fonts replaced by their character packets:
3052
The \.{DVItype} program specifies that the horizontal movements after a
3053
|set_char| or \\{set} command, after a |set_rule| command, and after one
3054
of the commands |right1..x4|, are all treated differently when \.{DVI}
3055
units are converted to pixels.
3057
Thus we introduce a slight extension of \.{DVItype}'s pixel rounding
3058
algorithm and hope that this extension will become part of the standard
3059
\.{DVItype} program in the near future: If a \.{DVI} file contains a
3060
|set_rule| command for a rule with the negative height |width_dimen|,
3061
then this rule shall be treated in exactly the same way as a ficticious
3062
character whose width is the width of that rule; as value of |width_dimen|
3063
we choose $-2^{31}$, the smallest signed 32-bit integer.
3066
@!width_dimen:int_32; {vertical dimension of special rules}
3068
@ When initializing |width_dimen| we are careful to avoid arithmetic
3072
width_dimen:=-@"40000000; Decr(width_dimen)(@"40000000);
3074
@* Terminal communication.
3075
When \.{\title} begins, it engages the user in a brief dialog so that
3076
various options may be specified. This part of \.{\title} requires
3077
nonstandard \PASCAL\ constructions to handle the online interaction; so
3078
it may be preferable in some cases to omit the dialog and simply to
3079
stick to the default options. On other hand, the system-dependent
3080
routines that are needed are not complicated, so it will not be terribly
3081
difficult to introduce them; furthermore they are similar to those in
3084
It may be desirable to (optionally) specify all the options in the
3085
command line and skip the dialog with the user, provided the operating
3086
system permits this. Here we just define the system-indepent part of the
3087
code required for this possibility. Since a complete option (a keyword
3088
possibly followed by one or several parameters) may have embedded blanks
3089
it might be necessary to replace these blanks by some other separator,
3090
e.g., by a '/'. Using, e.g., \.{UNIX} style options one might then say
3091
$$\.{\title\space-mag/2000 -sel/17.3/5 -sel/47 ...}$$
3092
to override the magnification factor that is stated in the \.{DVI} file,
3093
and to select five pages starting with the page numbered~17.3 as well as
3094
all remaining pages starting with the one numbered~47; alternatively one
3096
$$\.{\title\space- ...}$$
3097
to skip the dialog and use the default options.
3099
The system-dependent initialization code should set the |n_opt| variable
3100
to the number of options found in the command line. If |n_opt=0| the
3101
|input_ln| procedure defined below will promt the user for options. If
3102
|n_opt>0| the |k_opt| variable will be incremented and another piece of
3103
system-dependent code is invoked instead of the dialog; that code should
3104
place the value of command line option number |k_opt| as temporary
3105
string into the |byte-mem| array. This process will be repeated until
3106
|k_opt=n_opt|, indicating that all command line options have been
3108
@^system dependencies@>
3110
@d opt_separator="/" {acts as blank when scanning (command line) options}
3113
n_opt:=0; {change this to indicate the presence of command line options}
3114
k_opt:=0; {just in case}
3116
@ The |input_ln| routine waits for the user to type a line at his or her
3117
terminal; then it puts ASCII-code equivalents for the characters on that
3118
line into the |byte_mem| array as a temporary string. \PASCAL's
3119
standard |input| file is used for terminal input, as |output| is used
3120
for terminal output.
3122
Since the terminal is being used for both input and output, some systems
3123
need a special routine to make sure that the user can see a prompt message
3124
before waiting for input based on that message. (Otherwise the message
3125
may just be sitting in a hidden buffer somewhere, and the user will have
3126
no idea what the program is waiting for.) We shall invoke a system-dependent
3127
subroutine |update_terminal| in order to avoid this problem.
3128
@^system dependencies@>
3130
@d update_terminal == break(output) {empty the terminal output buffer}
3132
@d scan_blank(#)== {tests for `blank' when scanning (command line) options}
3133
((byte_mem[#]=bi(" "))or(byte_mem[#]=bi(opt_separator)))
3134
@d scan_skip== {skip `blanks'}
3135
while scan_blank(scan_ptr)and(scan_ptr<byte_ptr) do incr(scan_ptr)
3136
@d scan_init== {initialize |scan_ptr|}
3137
byte_mem[byte_ptr]:=bi(" "); scan_ptr:=pckt_start[pckt_ptr-1]; scan_skip
3139
@<Action procedures for |dialog|@>=
3140
procedure input_ln; {inputs a line from the terminal}
3141
var k:0..terminal_line_length;
3142
begin if n_opt=0 then
3143
begin print('Enter option: '); update_terminal; reset(input);
3144
if eoln(input) then read_ln(input);
3145
k:=0; pckt_room(terminal_line_length);
3146
while (k<terminal_line_length)and not eoln(input) do
3147
begin append_byte(xord[input^]); incr(k); get(input);
3150
else if k_opt<n_opt then
3152
{Copy command line option number |k_opt| into |byte_mem| array!}
3156
@ The global variable |scan_ptr| is used while scanning the temporary
3157
packet; it points to the next byte in |byte_mem| to be examined.
3160
@!n_opt:int_16; {number of options found in command line}
3161
@!k_opt:int_16; {number of command line options processed}
3162
@!scan_ptr:byte_pointer; {pointer to next byte to be examined}
3163
@!sep_char:text_char; {|' '| or |xchr[opt_separator]|}
3165
@ The |scan_keyword| function is used to test for keywords in a character
3166
string stored as temporary packet in |byte_mem|; the result is |true|
3167
(and |scan_ptr| is updated) if the characters starting at position
3168
|scan_ptr| are an abbreviation of a given keyword followed by at least
3171
@<Action procedures for |dialog|@>=
3172
function scan_keyword(@!p:pckt_pointer;@!l:int_7):boolean;
3173
var i,@!j,@!k:byte_pointer; {indices into |byte_mem|}
3174
begin i:=pckt_start[p]; j:=pckt_start[p+1]; k:=scan_ptr;
3175
while (i<j)and((byte_mem[k]=byte_mem[i])or(byte_mem[k]=byte_mem[i]-"a"+"A")) do
3176
begin incr(i); incr(k);
3178
if scan_blank(k)and(i-pckt_start[p]>=l) then
3179
begin scan_ptr:=k; scan_skip; scan_keyword:=true;
3181
else scan_keyword:=false;
3184
@ Here is a routine that scans a (possibly signed) integer and computes
3185
the decimal value. If no decimal integer starts at |scan_ptr|, the
3186
value~0 is returned. The integer should be less than $2^{31}$ in
3189
@<Action procedures for |dialog|@>=
3190
function scan_int:int_32;
3191
var x:int_32; {accumulates the value}
3192
@!negative:boolean; {should the value be negated?}
3193
begin if byte_mem[scan_ptr]="-" then
3194
begin negative:=true; incr(scan_ptr);
3196
else negative:=false;
3198
while (byte_mem[scan_ptr]>="0")and(byte_mem[scan_ptr]<="9") do
3199
begin x:=10*x+byte_mem[scan_ptr]-"0"; incr(scan_ptr);
3202
if negative then scan_int:=-x @+ else scan_int:=x;
3205
@ The selected options are put into global variables by the |dialog|
3206
procedure, which is called just as \.{\title} begins.
3207
@^system dependencies@>
3209
@p @<Action procedures for |dialog|@>@;
3212
var p:pckt_pointer; {packet being created}
3213
begin @<Initialize options@>@;
3214
loop begin input_ln; p:=new_packet; scan_init;
3215
if scan_ptr=byte_ptr then
3216
begin flush_packet; return;
3218
@<Cases for options@>@;@/
3219
else begin if n_opt=0 then sep_char:=' '
3220
else sep_char:=xchr[opt_separator];
3223
begin print('Bad command line option: ');
3224
print_packet(p); abort('---run terminated');
3231
@ The |print_options| procedure might be used in a `Usage message'
3232
displaying the command line syntax.
3234
@<Basic printing...@>=
3235
procedure print_options;
3236
begin print_ln('Valid options are:');
3237
@<Print valid options@>@;
3240
@* Subroutines for typesetting commands.
3241
This is the central part of the whole \.{\title} program:
3242
When a typesetting command from the \.{DVI} file or from a \.{VF} packet
3243
has been decoded, one of the typesetting routines defined below is
3244
invoked to execute the command; apart from the necessary book keeping,
3245
these routines invoke device dependent code defined later.
3247
@p @<Declare typesetting procedures@>
3249
@ These typesetting routines communicate with the rest of the program
3250
through global variables.
3253
@!type_setting:boolean; {|true| while typesetting a page}
3256
type_setting:=false;
3258
@ The user may select up to |max_select| ranges of consecutive pages to
3259
be processed. Each starting page specification is recorded in two global
3260
arrays called |start_count| and |start_there|. For example, `\.{1.*.-5}'
3261
is represented by |start_there[0]=true|, |start_count[0]=1|,
3262
|start_there[1]=false|, |start_there[2]=true|, |start_count[2]=-5|. We
3263
also set |start_vals=2|, to indicate that count 2 was the last one
3264
mentioned. The other values of |start_count| and |start_there| are not
3265
important, in this example. The number of pages is recorded in
3266
|max_pages|; a non positive value indicates that there is no limit.
3268
@d start_count==select_count[cur_select] {count values to select
3270
@d start_there==select_there[cur_select] {is the |start_count| value
3272
@d start_vals==select_vals[cur_select] {the last count considered
3274
@d max_pages==select_max[cur_select] {at most this many |bop..eop| pages
3278
@!select_count:array[0..max_select-1,0..9] of int_32;
3279
@!select_there:array[0..max_select-1,0..9] of boolean;
3280
@!select_vals:array[0..max_select-1] of 0..9;
3281
@!select_max:array[0..max_select-1] of int_32;
3282
@!out_mag:int_32; {output maginfication}
3283
@!count:array[0..9] of int_32; {the count values on the current page}
3284
@!num_select:0..max_select; {number of page selection ranges specified}
3285
@!cur_select:0..max_select; {current page selection range}
3286
@!selected:boolean; {has starting page been found?}
3287
@!all_done:boolean; {have all selected pages been processed?}
3288
@!str_mag,@!str_select:pckt_pointer;
3290
@ Here is a simple subroutine that tests if the current page might be the
3293
@p function start_match:boolean; {does |count| match the starting spec?}
3294
var k:0..9; {loop index}
3295
@!match:boolean; {does everything match so far?}
3297
for k:=0 to start_vals do
3298
if start_there[k]and(start_count[k]<>count[k]) then match:=false;
3302
@ @<Initialize options@>=
3303
out_mag:=0; cur_select:=0; max_pages:=0; selected:=true;
3305
@ @<Print valid options@>=
3306
print_ln(' mag',sep_char,'<new_mag>');
3307
print_ln(' select',sep_char,'<start_count>',sep_char,
3308
'[<max_pages>] (up to ',max_select:1,' ranges)');
3310
@ @<Action procedures for |dialog|@>=
3311
procedure scan_count; {scan a |start_count| value}
3312
begin if byte_mem[scan_ptr]=bi("*") then
3313
begin start_there[start_vals]:=false; incr(scan_ptr); scan_skip;
3315
else begin start_there[start_vals]:=true;
3316
start_count[start_vals]:=scan_int;
3317
if cur_select=0 then selected:=false; {don't start at first page}
3321
@ @<Cases for options@>=
3322
else if scan_keyword(str_mag,3) then out_mag:=scan_int
3323
else if scan_keyword(str_select,3) then
3324
if cur_select=max_select then print_ln('Too many page selections')
3325
else begin start_vals:=0; scan_count;
3326
while (start_vals<9)and(byte_mem[scan_ptr]=bi(".")) do
3327
begin incr(start_vals); incr(scan_ptr); scan_count;
3329
max_pages:=scan_int; incr(cur_select);
3332
@ @<Initialize predefined strings@>=
3333
id3("m")("a")("g")(str_mag);
3334
id6("s")("e")("l")("e")("c")("t")(str_select);
3336
@ A stack is used to keep track of the current horizonal and vertical
3337
position, |h| and |v|, and the four registers |w|, |x|, |y|, and |z|;
3338
the register pairs |(w,x)| and |(y,z)| are maintained as arrays.
3341
@!device @<Declare device dependend types@>@; @+ ecived @; @/
3342
@!stack_pointer=0..stack_size;@/
3343
@!stack_index=1..stack_size;@/
3344
@!pair_32=array[0..1] of int_32; {a pair of |int_32| variables}
3345
@!stack_record=record@;@/
3346
@!h_field:int_32; {horizontal position |h|}
3347
@!v_field:int_32; {vertical position |v|}
3348
@!w_x_field:pair_32; {|w| and |x| register for horizontal movements}
3349
@!y_z_field:pair_32; {|y| and |z| register for vertical movements}
3350
@!device @<Device dependent stack record fields@>@; @+ ecived @; @/
3353
@ The current values are kept in |cur_stack|; they are pushed onto and
3354
popped from |stack|. We use \.{WEB} macros to access the current values.
3356
@d cur_h==cur_stack.h_field {the current |@!h| value}
3357
@d cur_v==cur_stack.v_field {the current |@!v| value}
3358
@d cur_w_x==cur_stack.w_x_field {the current |@!w| and |@!x| value}
3359
@d cur_y_z==cur_stack.y_z_field {the current |@!y| and |@!z| value}
3362
@!stack:array[stack_index] of stack_record; {the pushed values}
3363
@!cur_stack:stack_record; {the current values}
3364
@!zero_stack:stack_record; {initial values}
3365
@!stack_ptr:stack_pointer; {last used position in |stack|}
3368
zero_stack.h_field:=0; zero_stack.v_field:=0;
3370
begin zero_stack.w_x_field[i]:=0; zero_stack.y_z_field[i]:=0;
3372
@!device @<Initialize device dependent stack record fields@>@; @+ ecived @; @/
3374
@ When typesetting for a real device we must convert the current
3375
position from \.{DVI} units to pixels, i.e., |cur_h| and |cur_v| into
3376
|cur_hh| and |cur_vv|. This might be a good place to collect everything
3377
related to the conversion from \.{DVI} units to pixels and in particular
3378
all the pixel rounding algorithms.
3380
@d font_space(#)==fnt_space[#] {boundary between ``small'' and ``large''
3383
@<Declare device dependent font data arrays@>=
3384
@!fnt_space:array [font_number] of int_32; {boundary between ``small''
3385
and ``large'' spaces}
3387
@ @<Initialize device dependent font data@>=
3388
font_space(invalid_font):=0;
3390
@ @<Initialize device dependent data for a font@>=
3391
font_space(cur_fnt):=font_scaled(cur_fnt) div 6;
3392
{this is a 3-unit ``thin space''}
3394
@ The |char_pixels| array is used to store the horizontal character
3395
escapements: for \.{PK} or \.{GF} files we use the values given there,
3396
otherwise we must convert the character widths to (horizontal) pixels.
3397
The horizontal escapement of character~|c| in font~|f| is given by
3400
@d font_pixel(#)==char_pixels[font_chars(#)+font_width_end
3402
@d max_pix_value==@"7FFF {largest allowed pixel value; this range may not
3403
suffice for high resolution output devices}
3405
@<Declare device dependend types@>=
3406
@!pix_value=-max_pix_value..max_pix_value; {a pixel coordinate or displacement}
3410
@!char_pixels:array[char_pointer] of pix_value; {character escapements}
3411
@!h_pixels:pix_value; {a horizontal dimension in pixels}
3412
@!v_pixels:pix_value; {a vertical dimension in pixels}
3413
@!temp_pix:pix_value; {temporary value for pixel rounding}
3416
@ @d cur_hh==cur_stack.hh_field {the current |@!hh| value}
3417
@d cur_vv==cur_stack.vv_field {the current |@!vv| value}
3419
@<Device dependent stack record fields@>=
3420
@!hh_field:pix_value; {horizontal pixel position |hh|}
3421
@!vv_field:pix_value; {vertical pixel position |vv|}
3423
@ @<Initialize device dependent stack record fields@>=
3424
zero_stack.hh_field:=0; zero_stack.vv_field:=0;
3426
@ For small movements we round the increment in position, for large
3427
movements we round the incremented position. The same applies to rule
3428
dimensions with the only difference that they will always be rounded
3429
towards larger values. For characters we increment the horizontal
3430
position by the escapement values obtained, e.g., from a \.{PK} file or
3431
by the \.{TFM} width converted to pixels.
3433
@d h_pixel_round(#)==round(h_conv*(#))
3434
@d v_pixel_round(#)==round(v_conv*(#))
3435
@^system dependencies@>
3437
@d large_h_space(#)==(#>=font_space(cur_fnt))or(#<=-4*font_space(cur_fnt))
3438
{is this a ``large'' horizontal distance?}
3439
@d large_v_space(#)==(abs(#)>=5*font_space(cur_fnt))
3440
{is this a ``large'' vertical distance?}
3442
@d h_rule_pixels== {converts the rule width |cur_h_dimen| to pixels}
3443
@!device if large_h_space(cur_h_dimen) then
3444
begin h_pixels:=h_pixel_round(cur_h+cur_h_dimen)-cur_hh;
3445
if h_pixels<=0 then if cur_h_dimen>0 then h_pixels:=1;
3447
else begin h_pixels:=trunc(h_conv*cur_h_dimen);
3448
if h_pixels<h_conv*cur_h_dimen then incr(h_pixels);
3452
@d v_rule_pixels== {converts the rule height |cur_v_dimen| to pixels}
3453
@!device if large_v_space(cur_v_dimen) then
3454
begin v_pixels:=cur_vv-v_pixel_round(cur_v-cur_v_dimen);
3455
if v_pixels<=0 then v_pixels:=1; {used only for |cur_v_dimen>0|}
3457
else begin v_pixels:=trunc(v_conv*cur_v_dimen);
3458
if v_pixels<v_conv*cur_v_dimen then incr(v_pixels);
3462
@ A sequence of consecutive rules, or consecutive characters in a
3463
fixed-width font whose width is not an integer number of pixels, can
3464
cause |hh| to drift far away from a correctly rounded value. \.{\title}
3465
ensures that the amount of drift will never exceed |max_h_drift| pixels;
3466
similarly |vv| shall never drift away from the correctly rounded value
3467
by more than |max_v_drift| pixels.
3469
@d h_upd_end(#)== {check for proper horizontal pixel rounding}
3470
begin Incr(cur_hh)(#); temp_pix:=h_pixel_round(cur_h);
3471
if abs(temp_pix-cur_hh)>max_h_drift then
3472
if temp_pix>cur_hh then cur_hh:=temp_pix-max_h_drift
3473
else cur_hh:=temp_pix+max_h_drift;
3475
@d h_upd_char(#)==Incr(cur_h)(#)@;
3477
@d h_upd_move(#)==Incr(cur_h)(#)@;
3478
@!device; if large_h_space(#) then cur_hh:=h_pixel_round(cur_h)
3481
@d v_upd_end(#)== {check for proper vertical pixel rounding}
3482
begin Incr(cur_vv)(#); temp_pix:=v_pixel_round(cur_v);
3483
if abs(temp_pix-cur_vv)>max_v_drift then
3484
if temp_pix>cur_vv then cur_vv:=temp_pix-max_v_drift
3485
else cur_vv:=temp_pix+max_v_drift;
3487
@d v_upd_move(#)==Incr(cur_v)(#)@;
3488
@!device; if large_v_space(#) then cur_vv:=v_pixel_round(cur_v)
3491
@ The routines defined below use sections named `Declare local variables
3492
(if any) for \dots' or `Declare additional local variables for \dots';
3493
the former may declare variables (including the keyword \&{var}), whereas
3494
the later must at least contain the keyword \&{var}. In general, both may
3495
start with the declaration of labels, constants, and\slash or types.
3497
Let us start with the simple cases:
3498
The |do_pre| procedure is called when the preamble has been read from
3499
the \.{DVI} file; the preamble comment has just been converted into a
3500
temporary packet with the |new_packet| procedure.
3502
@p procedure do_pre;@/
3503
@<OUT: Declare local variables (if any) for |do_pre|@>@;
3504
begin all_done:=false; num_select:=cur_select; cur_select:=0;
3505
if num_select=0 then max_pages:=0;
3507
h_conv:=(dvi_num/254000.0)*(h_resolution/dvi_den)*(out_mag/1000.0);
3508
v_conv:=(dvi_num/254000.0)*(v_resolution/dvi_den)*(out_mag/1000.0);
3510
@<OUT: Process the |pre|@>@;@/
3513
@ The |do_bop| procedure is called when a |bop| has been read. This
3514
routine determines whether a page shall be processed or skipped and sets
3515
the variable |type_setting| accordingly.
3517
@p procedure do_bop;@/
3518
@<OUT: Declare additional local variables |do_bop|@>@;
3519
@!i,@!j:0..9; {indices into |count|}
3520
begin @<Determine whether this page should be processed or skipped@>;
3522
if type_setting then print('process') @+ else print('skipp');
3523
print('ing page ',count[0]:1); j:=9;
3524
while (j>0)and(count[j]=0) do decr(j);
3525
for i:=1 to j do print('.',count[i]:1);
3526
d_print(' at ',dvi_loc-45:1);
3528
if type_setting then
3529
begin stack_ptr:=0; cur_stack:=zero_stack; cur_fnt:=invalid_font;@/
3530
@<OUT: Process a |bop|@>@;@/
3534
@ Note that the device dependent code `OUT: Process a |bop|' may choose
3535
to set |type_setting| to false even if |selected| is true.
3537
@<Determine whether this page...@>=
3538
if not selected then selected:=start_match;
3539
type_setting:=selected
3541
@ The |do_eop| procedure is called in order to process an |eop|; the
3542
stack should be empty.
3544
@p procedure do_eop;@/
3545
@<OUT: Declare local variables (if any) for |do_eop|@>@;
3546
begin if stack_ptr<>0 then bad_dvi;
3547
@<OUT: Process an |eop|@>@;
3549
begin decr(max_pages);
3551
begin selected:=false; incr(cur_select);
3552
if cur_select=num_select then all_done:=true;
3555
type_setting:=false;
3558
@ The procedures |do_push| and |do_pop| are called in order to process
3559
|push| and |pop| commands; |do_push| must check for stack overflow,
3560
|do_pop| should never be called when the stack is empty.
3562
@p procedure do_push; {push onto stack}
3563
@<OUT: Declare local variables (if any) for |do_push|@>@;
3564
begin incr_stack(stack_ptr); stack[stack_ptr]:=cur_stack;@/
3565
@<OUT: Process a |push|@>@;
3568
procedure do_pop; {pop from stack}
3569
@<OUT: Declare local variables (if any) for |do_pop|@>@;
3570
begin if stack_ptr=0 then bad_dvi;
3571
cur_stack:=stack[stack_ptr]; decr(stack_ptr);
3572
@<OUT: Process a |pop|@>@;@/
3575
@ The |do_xxx| procedure is called in order to process a special command.
3576
The bytes of the special string have been put into |byte_mem| as the
3577
current string. They are converted to a temporary packet and discarded
3580
@p procedure do_xxx;@/
3581
@<OUT: Declare additional local variables for |do_xxx|@>@;
3582
@!p:pckt_pointer; {temporary packet}
3583
begin p:=new_packet;@/
3584
@<OUT: Process an |xxx|@>@;@/
3588
@ Next are the movement commands:
3589
The |do_right| procedure is called in order to process the horizontal
3590
movement commands |right|, |w|, and |x|.
3593
@p procedure do_right;@/
3594
@<OUT: Declare local variables (if any) for |do_right|@>@;
3595
begin if cur_class>=w_cl then cur_w_x[cur_class-w_cl]:=cur_parm
3596
else if cur_class<right_cl then cur_parm:=cur_w_x[cur_class-w0_cl];
3597
@<OUT: Process a |right| or |w| or |x|@>@;@/
3598
h_upd_move(cur_parm)(h_pixel_round(cur_parm));
3599
@<OUT: Move right@>@;
3602
@ The |do_down| procedure is called in order to process the vertical
3603
movement commands |down|, |y|, and |z|.
3605
@p procedure do_down;@/
3606
@<OUT: Declare local variables (if any) for |do_down|@>@;
3607
begin if cur_class>=y_cl then cur_y_z[cur_class-y_cl]:=cur_parm
3608
else if cur_class<down_cl then cur_parm:=cur_y_z[cur_class-y0_cl];
3609
@<OUT: Process a |down| or |y| or |z|@>@;@/
3610
v_upd_move(cur_parm)(v_pixel_round(cur_parm));
3611
@<OUT: Move down@>@;
3614
@ The |do_width| procedure, or actually the |do_a_width| macro, is
3615
called in order to increase the current horizontal position |cur_h| by
3616
|cur_h_dimen| in exactly the same way as if a character of width
3617
|cur_h_dimen| had been typeset.
3620
begin @!device h_pixels:=#; @+ ecived @; @+ do_width;
3623
@p procedure do_width;@/
3624
@<OUT: Declare local variables (if any) for |do_width|@>@;
3625
begin @<OUT: Typeset a |width|@>@;@/
3626
h_upd_char(cur_h_dimen)(h_pixels);
3627
@<OUT: Move right@>@;
3630
@ Finally we have the commands for the typesetting of rules and characters;
3631
the global variable |cur_upd| is |true| if the horizontal position shall
3632
be updated (\\{set} commands).
3634
The |do_rule| procedure is called in order to typeset a rule.
3636
@p procedure do_rule;@/
3637
@<OUT: Declare additional local variables |do_rule|@>@;
3639
begin h_rule_pixels@;
3640
if (cur_h_dimen>0)and(cur_v_dimen>0) then
3641
begin visible:=true; v_rule_pixels@;
3642
@<OUT: Typeset a visible |rule|@>@;
3644
else begin visible:=false;
3645
@<OUT: Typeset an invisible |rule|@>@;
3648
begin h_upd_move(cur_h_dimen)(h_pixels);
3649
@<OUT: Move right@>@;
3653
@ Last not least the |do_char| procedure is called in order to typeset
3654
character~|cur_res| with extension~|cur_ext| from the real font~|cur_fnt|.
3656
@p procedure do_char;@/
3657
@<OUT: Declare local variables (if any) for |do_char|@>@;
3658
begin @<OUT: Typeset a |char|@>@;
3660
begin h_upd_char(widths[cur_wp])(char_pixels[cur_cp]);
3661
@<OUT: Move right@>@;
3665
@ If the program terminates abnormally, the following code may be
3666
invoked in the middle of a page.
3668
@<Finish output file(s)@>=
3669
begin if type_setting then @<OUT: Finish incomplete page@>;
3670
@<OUT: Finish output file(s)@>@;
3673
@ When the first character of font~|cur_fnt| is about to be typeset, the
3674
|do_font| procedure is called in order to decide whether this is a
3675
virtual font or a real font.
3677
One step in this decision is the attempt to find and read the \.{VF}
3678
file for this font; other attempts to locate a font file may be
3679
performed before and after that, depending on the nature of the output
3680
device and on the structure of the file system at a particular
3681
installation. For a real device we convert the character widths to
3682
(horizontal) pixels.
3684
In any case |do_font| must change |font_type(cur_fnt)| to a value
3685
|>defined_font|; as a last resort one might use the \.{TFM} width data
3686
and draw boxes or leave blank spaces in the output.
3688
@p procedure do_font;@/
3690
@<OUT: Declare additional local variables for |do_font|@>@;
3691
@!p:char_pointer; {index into |char_widths| and |char_pixels|}
3692
begin @!debug if font_type(cur_fnt)=defined_font then confusion(str_fonts);
3694
@!device for p:=font_chars(cur_fnt)+font_bc(cur_fnt)
3695
to font_chars(cur_fnt)+font_ec(cur_fnt) do
3696
char_pixels[p]:=h_pixel_round(widths[char_widths[p]]);
3698
@<OUT: Look for a font file before trying to read the \.{VF} file;
3699
if found |goto done|@>@;@/
3700
if do_vf then goto done; {try to read the \.{VF} file}
3701
@<OUT: Look for a font file after trying to read the \.{VF} file@>@;@/
3703
@!debug if font_type(cur_fnt)<=loaded_font then confusion(str_fonts);
3707
@ Before a character of font~|cur_fnt| is typeset the following piece of
3708
code ensures that the font is ready to be used.
3710
@<Prepare to use font |cur_fnt|@>=
3711
@<OUT: Prepare to use font |cur_fnt|@>@;
3712
if font_type(cur_fnt)<=loaded_font then do_font {|cur_fnt| was not yet used}
3714
@* Interpreting VF packets.
3715
The |pckt_first_par| procedure first reads a \.{DVI} command byte from
3716
the packet into |cur_cmd|; then |cur_parm| is set to the value of the
3717
first parameter (if any) and |cur_class| to the command class.
3719
@p procedure pckt_first_par;
3720
begin cur_cmd:=pckt_ubyte;
3721
case dvi_par[cur_cmd] of
3722
char_par: set_cur_char(pckt_ubyte);
3724
dim1_par: cur_parm:=pckt_sbyte;
3725
num1_par: cur_parm:=pckt_ubyte;
3726
dim2_par: cur_parm:=pckt_spair;
3727
num2_par: cur_parm:=pckt_upair;
3728
dim3_par: cur_parm:=pckt_strio;
3729
num3_par: cur_parm:=pckt_utrio;
3730
three_cases(dim4_par): cur_parm:=pckt_squad; {|dim4|, |num4|, or |numu|}
3732
begin cur_v_dimen:=pckt_squad; cur_h_dimen:=pckt_squad;
3733
cur_upd:=(cur_cmd=set_rule);
3735
fnt_par:cur_parm:=cur_cmd-fnt_num_0;
3736
end; {there are no other cases}
3737
cur_class:=dvi_cl[cur_cmd];
3740
@ The |do_vf_packet| procedure is called in order to interpret the
3741
character packet for a virtual character. Such a packet may contain the
3742
instruction to typeset a character from the same or an other virtual
3743
font; in such cases |do_vf_packet| calls itself recursively. The
3744
recursion level, i.e., the number of times this has happened, is kept
3745
in the global variable |n_recur| and should not exceed |max_recursion|.
3749
@!recur_pointer=0..max_recursion;
3751
@ The \.{\title} processor should detect an infinite recursion caused by
3752
bad \.{VF} files; thus a new recursion level is entered even in cases
3753
where this could be avoided without difficulty.
3755
If the recursion level exceeds the allowed maximum, we want to give
3756
a traceback how this has happened; thus some of the global variables
3757
used in different invocations of |do_vf_packet| are saved in a stack,
3758
others are saved as local variables of |do_vf_packet|.
3761
@!recur_fnt:array[recur_pointer] of font_number; {this packet's font}
3762
@!recur_ext:array[recur_pointer] of int_24; {this packet's extension}
3763
@!recur_res:array[recur_pointer] of eight_bits; {this packet's residue}
3764
@!recur_pckt:array[recur_pointer] of pckt_pointer; {the packet}
3765
@!recur_loc:array[recur_pointer] of byte_pointer; {next byte of packet}
3766
@!n_recur:recur_pointer; {current recursion level}
3767
@!recur_used:recur_pointer; {highest recursion level used so far}
3770
n_recur:=0; recur_used:=0;
3772
@ Here now is the |do_vf_packet| procedure.
3774
@p procedure do_vf_packet;
3775
label continue,found,done;
3776
var k:recur_pointer; {loop index}
3777
@!f:int_8u; {packet type flag}
3778
@!save_upd:boolean; {used to save |cur_upd|}
3779
@!save_cp:width_pointer; {used to save |cur_cp|}
3780
@!save_wp:width_pointer; {used to save |cur_wp|}
3781
@!save_limit:byte_pointer; {used to save |cur_limit|}
3782
begin @<VF: Save values on entry to |do_vf_packet|@>;@/
3783
@<VF: Interpret the \.{DVI} commands in the packet@>@;@/
3785
begin cur_h_dimen:=widths[save_wp]; do_a_width(char_pixels[save_cp]);
3787
@<VF: Restore values on exit from |do_vf_packet|@>;@/
3790
@ On entry to |do_vf_packet| several values must be saved.
3792
@<VF: Save values on entry to |do_vf_packet|@>=
3793
save_upd:=cur_upd; save_cp:=cur_cp; save_wp:=cur_wp;@/
3794
recur_fnt[n_recur]:=cur_fnt;
3795
recur_ext[n_recur]:=cur_ext;
3796
recur_res[n_recur]:=cur_res
3798
@ Some of these values must be restored on exit from |do_vf_packet|.
3800
@<VF: Restore values on exit from |do_vf_packet|@>=
3801
cur_fnt:=recur_fnt[n_recur]
3803
@ If |cur_pckt| is the empty packet, we manufacture a |put| command;
3804
otherwise we read and interpret \.{DVI} commands from the packet.
3806
@<VF: Interpret the \.{DVI} commands in the packet@>=
3807
if find_packet then f:=cur_type @+ else goto done;
3808
recur_pckt[n_recur]:=cur_pckt;
3809
save_limit:=cur_limit;
3810
cur_fnt:=font_font(cur_fnt);
3811
if cur_pckt=empty_packet then
3812
begin cur_class:=char_cl; goto found;
3814
if cur_loc>=cur_limit then goto done;
3815
continue: pckt_first_par;
3816
found: case cur_class of
3817
char_cl: @<VF: Typeset a |char|@>;
3820
begin pckt_room(cur_parm);
3822
begin append_byte(pckt_ubyte); decr(cur_parm);
3828
five_cases(w0_cl): do_right; {|right|, |w|, or |x|}
3829
five_cases(y0_cl): do_down; {|down|, |y|, or |z|}
3830
fnt_cl: cur_fnt:=cur_parm;
3831
othercases confusion(str_packets); {font definition or invalid}
3833
if cur_loc<cur_limit then goto continue;
3836
@ The final |put| of a simple packet may be changed into |set_char| or
3839
@<VF: Typeset a |char|@>=
3840
begin @<Prepare to use font |cur_fnt|@>;
3841
cur_cp:=font_chars(cur_fnt)+cur_res; cur_wp:=char_widths[cur_cp];
3842
if (cur_loc=cur_limit)and(f=vf_simple) and save_upd then
3843
begin save_upd:=false; cur_upd:=true;
3845
if font_type(cur_fnt)=vf_font_type then
3846
@<VF: Enter a new recursion level@>
3850
@ Before entering a new recursion level we must test for overflow; in
3851
addition a few variables must be saved and restored.
3852
A |set_char| or \\{set} followed by |pop| is changed into |put|.
3854
@<VF: Enter a new recursion level@>=
3855
begin recur_loc[n_recur]:=cur_loc; {save}
3856
if cur_loc<cur_limit then
3857
if byte_mem[cur_loc]=bi(pop) then cur_upd:=false;
3858
if n_recur=recur_used then
3859
if recur_used=max_recursion then
3860
@<VF: Display the recursion traceback and terminate@>
3861
else incr(recur_used);@/
3862
incr(n_recur); do_vf_packet; decr(n_recur); {recurse}
3863
cur_loc:=recur_loc[n_recur]; cur_limit:=save_limit; {restore}
3866
@ @<VF: Display the recursion traceback and terminate@>=
3867
begin print_ln(' !Infinite VF recursion?');
3868
@.Infinite VF recursion?@>
3869
for k:=max_recursion downto 0 do
3870
begin print('level=',k:1,' font');
3871
d_print('=',recur_fnt[k]:1);
3872
print_font(recur_fnt[k]);
3873
print(' char=',recur_res[k]:1);
3874
if recur_ext[k]<>0 then print('.',recur_ext[k]:1);
3876
@!debug hex_packet(recur_pckt[k]); print_ln('loc=',recur_loc[k]:1);
3879
overflow(str_recursion,max_recursion);
3882
@* Interpreting the DVI file.
3883
The |do_dvi| procedure reads the entire \.{DVI} file and initiates
3884
whatever actions may be necessary.
3886
@p procedure do_dvi;
3888
var temp_byte:int_8u; {byte for temporary variables}
3889
@!temp_int:int_32; {integer for temporary variables}
3890
@!dvi_start:int_32; {starting location}
3891
@!dvi_bop_post:int_32; {location of |bop| or |post|}
3892
@!dvi_back:int_32; {a back pointer}
3893
@!k:int_15; {general purpose variable}
3894
begin @<DVI: Process the preamble@>;
3895
if random_reading then @<DVI: Process the postamble@>;
3896
repeat dvi_first_par;
3897
while cur_class=fnt_def_cl do
3898
begin dvi_do_font(random_reading); dvi_first_par;
3900
if cur_cmd=bop then @<DVI: Process one page@>;
3902
if cur_cmd<>post then bad_dvi;
3905
@ @<DVI: Process the preamble@>=
3906
if dvi_ubyte<>pre then bad_dvi;
3907
if dvi_ubyte<>dvi_id then bad_dvi;
3908
dvi_num:=dvi_pquad; dvi_den:=dvi_pquad; dvi_mag:=dvi_pquad;
3909
tfm_conv:=(25400000.0/dvi_num)*(dvi_den/473628672)/16.0;
3910
temp_byte:=dvi_ubyte; pckt_room(temp_byte);
3911
for k:=1 to temp_byte do append_byte(dvi_ubyte);
3912
print('DVI file: '''); print_packet(new_packet); print_ln(''',');
3913
print(' num=',dvi_num:1,', den=',dvi_den:1,', mag=',dvi_mag:1);
3914
if out_mag<=0 then out_mag:=dvi_mag @+ else print(' => ',out_mag:1);
3916
do_pre; flush_packet
3919
@!dvi_num:int_31; {numerator}
3920
@!dvi_den:int_31; {denominator}
3921
@!dvi_mag:int_31; {magnification}
3923
@ @<DVI: Process the postamble@>=
3924
begin dvi_start:=dvi_loc; {remember start of first page}
3925
@<DVI: Find the postamble@>;
3926
d_print_ln('DVI: postamble at ',dvi_bop_post:1);
3927
dvi_back:=dvi_pointer;
3928
if dvi_num<>dvi_pquad then bad_dvi;
3929
if dvi_den<>dvi_pquad then bad_dvi;
3930
if dvi_mag<>dvi_pquad then bad_dvi;
3931
temp_int:=dvi_squad; temp_int:=dvi_squad;
3932
if stack_size<dvi_upair then overflow(str_stack,stack_size);
3933
temp_int:=dvi_upair;
3935
while cur_class=fnt_def_cl do
3936
begin dvi_do_font(false); dvi_first_par;
3938
if cur_cmd<>post_post then bad_dvi;
3939
if not selected then @<DVI: Find the starting page@>;
3940
dvi_move(dvi_start); {go to first or starting page}
3943
@ @<DVI: Find the postamble@>=
3944
temp_int:=dvi_length-5;
3945
repeat if temp_int<49 then bad_dvi;
3946
dvi_move(temp_int); temp_byte:=dvi_ubyte; decr(temp_int);
3947
until temp_byte<>dvi_pad;
3948
if temp_byte<>dvi_id then bad_dvi;
3949
dvi_move(temp_int-4); if dvi_ubyte<>post_post then bad_dvi;
3950
dvi_bop_post:=dvi_pointer;
3951
if (dvi_bop_post<15)or(dvi_bop_post>dvi_loc-34) then bad_dvi;
3952
dvi_move(dvi_bop_post); if dvi_ubyte<>post then bad_dvi
3954
@ @<DVI: Find the starting page@>=
3955
begin dvi_start:=dvi_bop_post; {just in case}
3956
while dvi_back<>-1 do
3957
begin if (dvi_back<15)or(dvi_back>dvi_bop_post-46) then bad_dvi;
3958
dvi_bop_post:=dvi_back; dvi_move(dvi_back);
3959
if dvi_ubyte<>bop then bad_dvi;
3960
for k:=0 to 9 do count[k]:=dvi_squad;
3961
if start_match then dvi_start:=dvi_bop_post;
3962
dvi_back:=dvi_pointer;
3966
@ When a |bop| has been read, the \.{DVI} commands for one page are
3967
interpreted until an |eop| is found.
3969
@<DVI: Process one page@>=
3970
begin for k:=0 to 9 do count[k]:=dvi_squad;
3971
temp_int:=dvi_pointer; do_bop;
3973
if type_setting then @<DVI: Process a page; then |goto done|@>
3974
else @<DVI: Skip a page; then |goto done|@>;
3975
done:if cur_cmd<>eop then bad_dvi;
3978
if all_done then return;
3982
@ All \.{DVI} commands are processed, as long as |cur_class<>invalid_cl|;
3983
then we should have found an |eop|.
3985
@<DVI: Process a page; then |goto done|@>=
3988
char_cl: @<DVI: Typeset a |char|@>;
3990
if cur_upd and(cur_v_dimen=width_dimen) then
3991
do_a_width(h_pixel_round(cur_h_dimen))
3994
begin pckt_room(cur_parm);
3996
begin append_byte(dvi_ubyte); decr(cur_parm);
4002
five_cases(w0_cl): do_right; {|right|, |w|, or |x|}
4003
five_cases(y0_cl): do_down; {|down|, |y|, or |z|}
4005
fnt_def_cl: dvi_do_font(random_reading);
4006
invalid_cl: goto done;
4007
end; {there are no other cases}
4008
dvi_first_par; {get the next command}
4011
@ While skipping a page all commands other than font definitions are
4014
@<DVI: Skip a page; then |goto done|@>=
4017
xxx_cl: while cur_parm>0 do
4018
begin temp_byte:=dvi_ubyte; decr(cur_parm);
4020
fnt_def_cl: dvi_do_font(random_reading);
4021
invalid_cl: goto done;
4022
othercases do_nothing;
4024
dvi_first_par; {get the next command}
4027
@ @<DVI: Typeset a |char|@>=
4028
begin @<Prepare to use font |cur_fnt|@>;
4029
set_cur_wp(cur_fnt)(bad_dvi);
4030
if font_type(cur_fnt)=vf_font_type then do_vf_packet @+ else do_char;
4033
@* The main program.
4034
The code for real devices is still rather incomplete.
4035
Moreover several branches of the program have not been tested because
4036
they are never used with \.{DVI} files made by \TeX\ and \.{VF} files
4039
@ At the end of the program the output file(s) have to be finished and
4040
on some systems it may be necessary to close input and\slash or output
4042
@^system dependencies@>
4044
@p procedure close_files_and_terminate;
4045
var k:@!int_15; {general purpose index}
4046
begin close_in(dvi_file);
4047
if history<fatal_message then @<Finish output file(s)@>;
4048
stat @<Print memory usage statistics@>;@+tats@;@/
4049
@<Close output file(s)@>@;
4050
@<Print the job |history|@>;
4053
@ Now we are ready to put it all together.
4054
Here is where \.{\title} starts, and where it ends.
4055
@^system dependencies@>
4057
@p begin initialize; {get all variables initialized}
4058
@<Initialize predefined strings@>@;
4059
dialog; {get options}
4060
@<Open input file(s)@>@;
4061
@<Open output file(s)@>@;
4062
do_dvi; {process the entire \.{DVI} file}
4063
close_files_and_terminate;
4066
@ @<Print memory usage statistics@>=
4067
print_ln('Memory usage statistics:');
4068
print(dvi_nf:1,' dvi, ',lcl_nf:1,' local, ');
4069
@<Print more font usage statistics@>@;@/
4070
print_ln('and ',nf:1,' internal fonts of ',max_fonts:1);
4071
print_ln(n_widths:1,' widths of ',max_widths:1,' for ',
4072
n_chars:1,' characters of ',max_chars:1);
4073
print_ln(pckt_ptr:1,' byte packets of ',max_packets:1,' with ',
4074
byte_ptr:1,' bytes of ',max_bytes:1);
4075
@<Print more memory usage statistics@>@;@/
4076
print_ln(stack_used:1,' of ',stack_size:1,' stack and ',
4077
recur_used:1,' of ',max_recursion:1,' recursion levels.')
4079
@ Some implementations may wish to pass the |history| value to the
4080
operating system so that it can be used to govern whether or not other
4081
programs are started. Here we simply report the history to the user.
4082
@^system dependencies@>
4084
@<Print the job |history|@>=
4086
spotless: print_ln('(No errors were found.)');
4087
harmless_message: print_ln('(Did you see the warning message above?)');
4088
error_message: print_ln('(Pardon me, but I think I spotted something wrong.)');
4089
fatal_message: print_ln('(That was a fatal error, my friend.)');
4090
end {there are no other cases}
4092
@* Low-level output routines.
4093
The program uses the binary file variable |out_file| for its main output
4094
file; |out_loc| is the number of the byte about to be written next on
4098
@!out_file:byte_file; {the \.{DVI} file we are writing}
4099
@!out_loc:int_32; {where we are about to write, in |out_file|}
4100
@!out_back:int_32; {a back pointer}
4101
@!out_max_v:int_31; {maximum |v| value so far}
4102
@!out_max_h:int_31; {maximum |h| value so far}
4103
@!out_stack:int_16u; {maximum stack depth}
4104
@!out_pages:int_16u; {total number of pages}
4107
out_loc:=0; out_back:=-1;
4108
out_max_v:=0; out_max_h:=0;
4109
out_stack:=0; out_pages:=0;
4111
@ To prepare |out_file| for output, we |rewrite| it.
4113
@<Open output file(s)@>=
4114
rewrite(out_file); {prepares to write packed bytes to |out_file|}
4116
@ For some operating systems it may be necessary to close |out_file|.
4118
@<Close output file(s)@>=
4120
@ Writing the |out_file| should be done as efficient as possible for a
4121
particular system; on many systems this means that a large number of
4122
bytes will be accumulated in a buffer and is then written from that
4123
buffer to |out_file|. In order to simplify such system dependent changes
4124
we use the \.{WEB} macro |out_byte| to write the next \.{DVI} byte. Here
4125
we give a simple minded definition for this macro in terms of standard
4127
@^system dependencies@>
4130
@d out_byte(#) == write(out_file,#) {write next \.{DVI} byte}
4132
@ The \.{WEB} macro |out_one| is used to write one byte and to update
4135
@d out_one(#) == begin out_byte(#); incr(out_loc); @+ end
4137
@ First the |out_packet| procedure copies a packet to |out_file|.
4139
@<Declare typesetting procedures@>=
4140
procedure out_packet(@!p:pckt_pointer);
4141
var k:byte_pointer; {index into |byte_mem|}
4142
begin Incr(out_loc)(pckt_length(p));
4143
for k:=pckt_start[p] to pckt_start[p+1]-1 do out_byte(bo(byte_mem[k]));
4146
@ Next are the procedures used to write integer numbers or even complete
4147
\.{DVI} commands to |out_file|; they all keep |out_loc| up to date.
4149
The |out_four| procedure outputs four bytes in two's complement notation,
4150
without risking arithmetic overflow.
4152
@<Declare typesetting procedures@>=
4153
procedure out_four(@!x:int_32); {output four bytes}
4154
@!begin_four; comp_four(out_byte); Incr(out_loc)(4);
4157
@ The |out_char| procedure outputs a |set_char| or \\{set} command or, if
4158
|upd=false|, a |put| command.
4160
@<Declare typesetting procedures@>=
4161
procedure out_char(@!upd:boolean;@!ext:int_32;@!res:eight_bits);
4162
{output \\{set} or |put|}
4163
@!begin_char; comp_char(out_one);
4166
@ The |out_unsigned| procedure outputs a |fnt|, |xxx|, or |fnt_def|
4167
command with its first parameter (normally unsigned); a |fnt| command
4168
is converted into |fnt_num| whenever this is possible.
4170
@<Declare typesetting procedures@>=
4171
procedure out_unsigned(@!o:eight_bits;@!x:int_32);
4172
{output |fnt_num|, |fnt|, |xxx|, or |fnt_def|}
4173
@!begin_unsigned; comp_unsigned(out_one);
4176
@ The |out_signed| procedure outputs a movement (|right|, |w|,
4177
|x|, |down|, |y|, or |z|) command with its (signed) parameter.
4179
@<Declare typesetting procedures@>=
4180
procedure out_signed(@!o:eight_bits;@!x:int_32);
4181
{output |right|, |w|, |x|, |down|, |y|, or |z|}
4182
@!begin_signed; comp_signed(out_one);
4185
@ For an output font we set |font_type(f):=out_font_type|; in this case
4186
|font_font(f)| is the font number used for font~|f| in |out_file|.
4189
The global variable |out_nf| is the number of fonts already used in
4190
|out_file| and the array |out_fnts| contains their internal font numbers;
4191
the current font in |out_file| is called |out_fnt|.
4194
@!out_fnts:array[font_number] of font_number; {internal font numbers}
4195
@!out_nf:font_number; {number of fonts used in |out_file|}
4196
@!out_fnt:font_number; {internal font number of current output font}
4201
@ @<Print more font usage statistics@>=
4202
print(out_nf:1,' out, ');
4204
@ The |out_fnt_def| procedure outputs a complete font definition
4207
@<Declare typesetting procedures@>=
4208
procedure out_fnt_def(@!f:font_number);
4209
var p:pckt_pointer; {the font name packet}
4210
@!k,@!l:byte_pointer; {indices into |byte_mem|}
4211
@!a:eight_bits; {length of area part}
4212
begin out_unsigned(fnt_def1,font_font(f)); out_four(font_check(f));
4213
out_four(font_scaled(f)); out_four(font_design(f));@/
4214
p:=font_name(f); k:=pckt_start[p]; l:=pckt_start[p+1]-1;
4215
a:=bo(byte_mem[k]);@/
4216
Incr(out_loc)(l-k+2); out_byte(a); out_byte(l-k-a);
4218
begin incr(k); out_byte(bo(byte_mem[k]));
4222
@* Writing the output file.
4223
Here we define the device dependent parts of the typesetting routines
4224
described earlier in this program.
4226
First we define a few quantities required by the device dependent code
4227
for a real output device in order to demonstrate how they might be
4228
defined and in order to be able to compile \.{DVIcopy} with the device
4229
dependent code included.
4231
@d h_resolution==300 {horizontal resolution in pixels per inch (dpi)}
4232
@d v_resolution==300 {vertical resolution in pixels per inch (dpi)}
4234
@d max_h_drift==2 {we insist that |abs(hh-h_pixel_round(h))<=max_h_drift|}
4235
@d max_v_drift==2 {we insist that |abs(vv-v_pixel_round(v))<=max_v_drift|}
4239
@!h_conv:real; {converts \.{DVI} units to horizontal pixels}
4240
@!v_conv:real; {converts \.{DVI} units to vertical pixels}
4243
@ These are the local variables (if any) needed for |do_pre|.
4245
@<OUT: Declare local variables (if any) for |do_pre|@>=
4246
var k:int_15; {general purpose variable}
4247
@!p,@!q,@!r:byte_pointer; {indices into |byte_mem|}
4248
@!comment:packed array[1..comm_length] of char; {preamble comment prefix}
4250
@ And here is the device dependent code for |do_pre|; the \.{DVI} preamble
4251
comment written to |out_file| is similar to the one produced by \.{GFtoPK},
4252
but we want to apply our preamble comment prefix only once.
4254
@<OUT: Process the |pre|@>=
4255
out_one(pre); out_one(dvi_id);
4256
out_four(dvi_num); out_four(dvi_den); out_four(out_mag);@/
4257
p:=pckt_start[pckt_ptr-1]; q:=byte_ptr; {location of old \.{DVI} comment}
4258
comment:=preamble_comment; pckt_room(comm_length);
4259
for k:=1 to comm_length do append_byte(xord[comment[k]]);
4260
while byte_mem[p]=bi(" ") do incr(p); {remove leading blanks}
4261
if p=q then Decr(byte_ptr)(from_length)
4263
while (k<comm_length)and(byte_mem[p+k]=byte_mem[q+k]) do incr(k);
4264
if k=comm_length then Incr(p)(comm_length);
4266
k:=byte_ptr-p; {total length}
4268
begin k:=255; q:=p+255-comm_length; {at most 255 bytes}
4270
out_one(k); out_packet(new_packet); flush_packet;
4271
for r:=p to q-1 do out_one(bo(byte_mem[r]));
4273
@ These are the additional local variables (if any) needed for |do_bop|;
4274
the variables |@!i| and |@!j| are already declared.
4276
@<OUT: Declare additional local variables |do_bop|@>=
4279
@ And here is the device dependent code for |do_bop|.
4281
@<OUT: Process a |bop|@>=
4282
out_one(bop); incr(out_pages);
4283
for i:=0 to 9 do out_four(count[i]);
4284
out_four(out_back); out_back:=out_loc-45;
4285
out_fnt:=invalid_font;
4287
@ These are the local variables (if any) needed for |do_eop|.
4289
@<OUT: Declare local variables (if any) for |do_eop|@>=
4291
@ And here is the device dependent code for |do_eop|.
4293
@<OUT: Process an |eop|@>=
4296
@ These are the local variables (if any) needed for |do_push|.
4298
@<OUT: Declare local variables (if any) for |do_push|@>=
4300
@ And here is the device dependent code for |do_push|.
4302
@<OUT: Process a |push|@>=
4303
if stack_ptr>out_stack then out_stack:=stack_ptr;
4306
@ These are the local variables (if any) needed for |do_pop|.
4308
@<OUT: Declare local variables (if any) for |do_pop|@>=
4310
@ And here is the device dependent code for |do_pop|.
4312
@<OUT: Process a |pop|@>=
4315
@ These are the additional local variables (if any) needed for |do_xxx|;
4316
the variable |@!p|, the pointer to the packet containing the special
4317
string, is already declared.
4319
@<OUT: Declare additional local variables for |do_xxx|@>=
4322
@ And here is the device dependent code for |do_xxx|.
4324
@<OUT: Process an |xxx|@>=
4325
out_unsigned(xxx1,pckt_length(p)); out_packet(p);
4327
@ These are the local variables (if any) needed for |do_right|.
4329
@<OUT: Declare local variables (if any) for |do_right|@>=
4331
@ And here is the device dependent code for |do_right|.
4333
@<OUT: Process a |right| or |w| or |x|@>=
4334
if cur_class<right_cl then out_one(cur_cmd) {|w0| or |x0|}
4335
else out_signed(dvi_right_cmd[cur_class],cur_parm); {|right|, |w|, or |x|}
4337
@ Here we update the |out_max_h| value.
4339
@<OUT: Move right@>=
4340
if abs(cur_h)>out_max_h then out_max_h:=abs(cur_h);
4342
@ These are the local variables (if any) needed for |do_down|.
4344
@<OUT: Declare local variables (if any) for |do_down|@>=
4346
@ And here is the device dependent code for |do_down|.
4348
@<OUT: Process a |down| or |y| or |z|@>=
4349
if cur_class<down_cl then out_one(cur_cmd) {|y0| or |z0|}
4350
else out_signed(dvi_down_cmd[cur_class],cur_parm); {|down|, |y|, or |z|}
4352
@ Here we update the |out_max_v| value.
4355
if abs(cur_v)>out_max_v then out_max_v:=abs(cur_v);
4357
@ These are the local variables (if any) needed for |do_width|.
4359
@<OUT: Declare local variables (if any) for |do_width|@>=
4361
@ And here is the device dependent code for |do_width|.
4363
@<OUT: Typeset a |width|@>=
4365
out_four(width_dimen); out_four(cur_h_dimen);
4367
@ These are the additional local variables (if any) needed for |do_rule|;
4368
the variable |@!visible| is already declared.
4370
@<OUT: Declare additional local variables |do_rule|@>=
4373
@ And here is the device dependent code for |do_rule|.
4375
@<OUT: Typeset a visible |rule|@>=
4376
out_one(dvi_rule_cmd[cur_upd]);
4377
out_four(cur_v_dimen); out_four(cur_h_dimen);
4379
@ @<OUT: Typeset an invisible |rule|@>=
4380
@<OUT: Typeset a visible |rule|@>
4382
@ These are the additional local variables (if any) needed for |do_font|;
4383
the variable |@!p| is already declared.
4385
@<OUT: Declare additional local variables for |do_font|@>=
4388
@ And here is the device dependent code for |do_font|; if the \.{VF} file
4389
for a font could not be found, we simply assume this must be a real font.
4391
@<OUT: Look for a font file before trying to read the \.{VF} file;
4392
if found |goto done|@>=
4394
@ @<OUT: Look for a font file after trying to read the \.{VF} file@>=
4395
if(out_nf>=max_fonts) then overflow(str_fonts,max_fonts);
4396
print('OUT: font ',cur_fnt:1); d_print(' => ',out_nf:1);
4397
print_font(cur_fnt);
4398
d_print(' at ',font_scaled(cur_fnt):1,' DVI units'); print_ln('.');
4399
font_type(cur_fnt):=out_font_type; font_font(cur_fnt):=out_nf;
4400
out_fnts[out_nf]:=cur_fnt; incr(out_nf);
4401
out_fnt_def(cur_fnt);
4403
@ And here is some device dependent code used before each character.
4405
@<OUT: Prepare to use font |cur_fnt|@>=
4407
@ These are the local variables (if any) needed for |do_char|.
4409
@<OUT: Declare local variables (if any) for |do_char|@>=
4411
@ And here is the device dependent code for |do_char|.
4413
@<OUT: Typeset a |char|@>=
4414
@!debug if font_type(cur_fnt)<>out_font_type then confusion(str_fonts);
4416
if cur_fnt<>out_fnt then
4417
begin out_unsigned(fnt1,font_font(cur_fnt)); out_fnt:=cur_fnt;
4419
out_char(cur_upd,cur_ext,cur_res);
4421
@ If the program terminates in the middle of a page, we write as many
4422
|pop|s as necessary and one |eop|.
4424
@<OUT: Finish incomplete page@>=
4425
begin while stack_ptr>0 do
4426
begin out_one(pop); decr(stack_ptr);
4431
@ If the output file has been started, we write the postamble; in
4432
addition we print the number of bytes and pages written to |out_file|.
4434
@<OUT: Finish output file(s)@>=
4436
begin @<OUT: Write the postamble@>;
4437
k:=7-((out_loc-1) mod 4); {the number of |dvi_pad| bytes}
4439
begin out_one(dvi_pad); decr(k);
4441
print('OUT file: ',out_loc:1,' bytes, ',out_pages:1,' page');
4442
if out_pages<>1 then print('s');
4444
else print('OUT file: no output');
4445
print_ln(' written.');
4446
if out_pages=0 then mark_harmless;
4448
@ Here we simply write the values accumulated during the \.{DVI} output.
4450
@<OUT: Write the postamble@>=
4451
out_one(post); out_four(out_back); out_back:=out_loc-5;@/
4452
out_four(dvi_num); out_four(dvi_den); out_four(out_mag);@/
4453
out_four(out_max_v); out_four(out_max_h);@/
4454
out_one(out_stack div @"100); out_one(out_stack mod @"100);@/
4455
out_one(out_pages div @"100); out_one(out_pages mod @"100);@/
4458
begin decr(k); out_fnt_def(out_fnts[k]);
4460
out_one(post_post); out_four(out_back);@/
4463
@ Here we could print more memory usage statistics; this possibility is,
4464
however, not used for \.{DVIcopy}.
4466
@<Print more memory usage statistics@>=
4468
@* System-dependent changes.
4469
This section should be replaced, if necessary, by changes to the program
4470
that are necessary to make \.{DVIcopy} work at a particular installation.
4471
It is usually best to design your change file so that all changes to
4472
previous sections preserve the section numbering; then everybody's version
4473
will be consistent with the printed program. More extensive changes,
4474
which introduce new sections, can be inserted here; then only the index
4475
itself will get a new section number.
4476
@^system dependencies@>
4479
Pointers to error messages appear here together with the section numbers
4480
where each ident\-i\-fier is used.
added
removed
build/TeX/texk/web2c/dvicopy.web
