summaryrefslogtreecommitdiff
path: root/Build/source/texk/web2c/omegaware
diff options
context:
space:
mode:
authorPeter Breitenlohner <peb@mppmu.mpg.de>2009-05-26 12:53:54 +0000
committerPeter Breitenlohner <peb@mppmu.mpg.de>2009-05-26 12:53:54 +0000
commit0f26e1a8f3c5c5bcb5031bec4eccedaf313ca534 (patch)
treeb097c422b3d1f50c51f5028efcbe9ae2bd13196f /Build/source/texk/web2c/omegaware
parent7bb4da4874329b18005da3776ac861b406092782 (diff)
remove obsolete Web2C versions of ofm2opl, opl2ofm, ovf2ovp, and ovp2ovf
since quite some time replaced by symlinks to omfonts git-svn-id: svn://tug.org/texlive/trunk@13481 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Build/source/texk/web2c/omegaware')
-rw-r--r--Build/source/texk/web2c/omegaware/ChangeLog6
-rw-r--r--Build/source/texk/web2c/omegaware/am/omegaware.am53
-rw-r--r--Build/source/texk/web2c/omegaware/ofm2opl.ch461
-rw-r--r--Build/source/texk/web2c/omegaware/ofm2opl.web2322
-rw-r--r--Build/source/texk/web2c/omegaware/opl2ofm.ch337
-rw-r--r--Build/source/texk/web2c/omegaware/opl2ofm.web4363
-rw-r--r--Build/source/texk/web2c/omegaware/ovf2ovp.ch610
-rw-r--r--Build/source/texk/web2c/omegaware/ovf2ovp.web3138
-rw-r--r--Build/source/texk/web2c/omegaware/ovp2ovf.ch320
-rw-r--r--Build/source/texk/web2c/omegaware/ovp2ovf.web5071
10 files changed, 8 insertions, 16673 deletions
diff --git a/Build/source/texk/web2c/omegaware/ChangeLog b/Build/source/texk/web2c/omegaware/ChangeLog
index 17f28a7a438..3641928bb4e 100644
--- a/Build/source/texk/web2c/omegaware/ChangeLog
+++ b/Build/source/texk/web2c/omegaware/ChangeLog
@@ -1,3 +1,9 @@
+2009-05-26 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * {ofm2opl,opl2ofm,ovf2ovp,ovp2ovf}.{ch,web} (removed):
+ these Pascal Web versions are obsolete, replaced by symlinks
+ to omfonts (from ../omegafonts/).
+
2009-03-03 Peter Breitenlohner <peb@mppmu.mpg.de>
* otangle.ch: use kpse_open_file to locate input files,
diff --git a/Build/source/texk/web2c/omegaware/am/omegaware.am b/Build/source/texk/web2c/omegaware/am/omegaware.am
index 8cae810b4ee..4351dc680d7 100644
--- a/Build/source/texk/web2c/omegaware/am/omegaware.am
+++ b/Build/source/texk/web2c/omegaware/am/omegaware.am
@@ -3,15 +3,10 @@
## Copyright (C) 2009 Peter Breitenlohner <tex-live@tug.org>
## You may freely use, modify and/or distribute this file.
-omegaware_tools = odvicopy odvitype otangle
-omegaware_font_tools = ofm2opl opl2ofm ovf2ovp ovp2ovf
-omegaware_programs = $(omegaware_tools) $(omegaware_font_tools)
+omegaware_programs = odvicopy odvitype otangle
if OTANGLE
-bin_PROGRAMS += $(omegaware_tools)
-if !OMFONTS
-bin_PROGRAMS += $(omegaware_font_tools)
-endif !OMFONTS
+bin_PROGRAMS += $(omegaware_programs)
endif OTANGLE
EXTRA_PROGRAMS += $(omegaware_programs)
@@ -43,28 +38,6 @@ odvitype_sources = omegaware/odvitype.web omegaware/odvitype.ch
odvitype.p: tangle$(EXEEXT) $(odvitype_sources)
$(ow_tangle) odvitype odvitype
-nodist_ofm2opl_SOURCES = ofm2opl.c ofm2opl.h
-ofm2opl.c ofm2opl.h: ofm2opl-web2c
-ofm2opl-web2c: $(web2c_depend) ofm2opl.p
- $(web2c) ofm2opl
- echo timestamp >$@
- touch ofm2opl.c ofm2opl.h
-EXTRA_DIST += $(ofm2opl_sources)
-ofm2opl_sources = omegaware/ofm2opl.web omegaware/ofm2opl.ch
-ofm2opl.p: tangle$(EXEEXT) $(ofm2opl_sources)
- $(ow_tangle) ofm2opl ofm2opl
-
-nodist_opl2ofm_SOURCES = opl2ofm.c opl2ofm.h
-opl2ofm.c opl2ofm.h: opl2ofm-web2c
-opl2ofm-web2c: $(web2c_depend) opl2ofm.p
- $(web2c) opl2ofm
- echo timestamp >$@
- touch opl2ofm.c opl2ofm.h
-EXTRA_DIST += $(opl2ofm_sources)
-opl2ofm_sources = omegaware/opl2ofm.web omegaware/opl2ofm.ch
-opl2ofm.p: tangle$(EXEEXT) $(opl2ofm_sources)
- $(ow_tangle) opl2ofm opl2ofm
-
nodist_otangle_SOURCES = otangle.c otangle.h
otangle.c otangle.h: otangle-web2c
otangle-web2c: $(web2c_depend) otangle.p
@@ -76,28 +49,6 @@ otangle_sources = omegaware/otangle.web omegaware/otangle.ch
otangle.p: tangle$(EXEEXT) $(otangle_sources)
$(ow_tangle) otangle otangle
-nodist_ovf2ovp_SOURCES = ovf2ovp.c ovf2ovp.h
-ovf2ovp.c ovf2ovp.h: ovf2ovp-web2c
-ovf2ovp-web2c: $(web2c_depend) ovf2ovp.p
- $(web2c) ovf2ovp
- echo timestamp >$@
- touch ovf2ovp.c ovf2ovp.h
-EXTRA_DIST += $(ovf2ovp_sources)
-ovf2ovp_sources = omegaware/ovf2ovp.web omegaware/ovf2ovp.ch
-ovf2ovp.p: tangle$(EXEEXT) $(ovf2ovp_sources)
- $(ow_tangle) ovf2ovp ovf2ovp
-
-nodist_ovp2ovf_SOURCES = ovp2ovf.c ovp2ovf.h
-ovp2ovf.c ovp2ovf.h: ovp2ovf-web2c
-ovp2ovf-web2c: $(web2c_depend) ovp2ovf.p
- $(web2c) ovp2ovf
- echo timestamp >$@
- touch ovp2ovf.c ovp2ovf.h
-EXTRA_DIST += $(ovp2ovf_sources)
-ovp2ovf_sources = omegaware/ovp2ovf.web omegaware/ovp2ovf.ch
-ovp2ovf.p: tangle$(EXEEXT) $(ovp2ovf_sources)
- $(ow_tangle) ovp2ovf ovp2ovf
-
## Tests
##
EXTRA_DIST += omegaware/otangle.test
diff --git a/Build/source/texk/web2c/omegaware/ofm2opl.ch b/Build/source/texk/web2c/omegaware/ofm2opl.ch
deleted file mode 100644
index 4b99c98d152..00000000000
--- a/Build/source/texk/web2c/omegaware/ofm2opl.ch
+++ /dev/null
@@ -1,461 +0,0 @@
-%
-% This file is part of the Omega project, which
-% is based in the web2c distribution of TeX.
-%
-% Copyright (c) 1994--1998 John Plaice and Yannis Haralambous
-% applies only to the changes to the original tftopl.ch.
-%
-% tftopl.ch for C compilation with web2c.
-%
-% 04/04/83 (PC) Original version, made to work with version 1.0 of TFtoPL,
-% released with version 0.96 of TeX in February, 1983.
-% 04/16/83 (PC) Brought up to version 1.0 released with version 0.97 of TeX
-% in April, 1983.
-% 06/30/83 (HWT) Revised changefile format, for use with version 1.7 Tangle.
-% 07/28/83 (HWT) Brought up to version 2
-% 11/21/83 (HWT) Brought up to version 2.1
-% 03/24/84 (HWT) Brought up to version 2.2
-% 07/12/84 (HWT) Brought up to version 2.3
-% 07/05/87 (ETM) Brought up to version 2.5
-% 03/22/88 (ETM) Converted for use with WEB to C.
-% 11/30/89 (KB) Version 3.
-% 01/16/90 (SR) Version 3.1.
-% (more recent changes in the ChangeLog)
-
-@x [0] WEAVE: print changes only.
-\pageno=\contentspagenumber \advance\pageno by 1
-@y
-\pageno=\contentspagenumber \advance\pageno by 1
-%\let\maybe=\iffalse
-%\def\title{TF\lowercase{to}PL changes for C}
-@z
-
-% [2] Fix files in program statement. We need to tell web2c about one
-% special variable. Perhaps it would be better to allow @define's
-% anywhere in a source file, but that seemed just as painful as this.
-@x
-@p program OFM2OPL(@!tfm_file,@!pl_file,@!output);
-@y
-@p
-{Tangle doesn't recognize @@ when it's right after the \.=.}
-@\@= @@define var tfm;@>@\
-program OFM2OPL(@!tfm_file,@!pl_file,@!output);
-@z
-
-@x [still 2] Don't print banner until later (and unless verbose).
-procedure initialize; {this procedure gets things started properly}
- begin print_ln(banner);@/
-@y
-@<Define |parse_arguments|@>
-procedure initialize; {this procedure gets things started properly}
- begin
- kpse_set_progname (argv[0]);
- kpse_init_prog ('OFM2OPL', 0, nil, nil);
- {We |xrealloc| when we know how big the file is. The 1000 comes
- from the negative lower bound.}
- tfm_file_array := cast_to_byte_pointer (xmalloc (2000000));
- parse_arguments;
-@z
-
-%@x [5] Increase sizes to match vptovf.
-%@!tfm_size=30000; {maximum length of |tfm| data, in bytes}
-%@!lig_size=5000; {maximum length of |lig_kern| program, in words}
-%@!hash_size=5003; {preferably a prime number, a bit larger than the number
-% of character pairs in lig/kern steps}
-%@y
-%@!tfm_size=40000; {maximum length of |tfm| data, in bytes}
-%@!lig_size=8000; {maximum length of |lig_kern| program, in words ($<2^{15}$)}
-%@!hash_size=8009; {preferably a prime number, a bit larger than the number
-% of character pairs in lig/kern steps}
-%@z
-
-@x [7] Open the TFM file.
-@ On some systems you may have to do something special to read a
-packed file of bytes. For example, the following code didn't work
-when it was first tried at Stanford, because packed files have to be
-opened with a special switch setting on the \PASCAL\ that was used.
-@^system dependencies@>
-
-@<Set init...@>=
-reset(tfm_file);
-@y
-@ On some systems you may have to do something special to read a
-packed file of bytes. With C under Unix, we just open the file by name
-and read characters from it.
-
-@<Set init...@>=
-tfm_file := kpse_open_file (tfm_name, kpse_ofm_format);
-if verbose then begin
- print (banner);
- print_ln (version_string);
-end;
-@z
-
-@x [17] Open the PL file.
-@!pl_file:text;
-
-@ @<Set init...@>=
-rewrite(pl_file);
-@y
-@!pl_file:text;
-
-@ If an explicit filename isn't given, we write to |stdout|.
-
-@<Set init...@>=
-if optind + 1 = argc then begin
- pl_file := stdout;
-end else begin
- pl_name := extend_filename (cmdline (optind + 1), 'opl');
- rewrite (pl_file, pl_name);
-end;
-@z
-
-@x [18,19] Make |tfm| be dynamically allocated, and rename `index'.
-@<Types...@>=
-@!byte=0..255; {unsigned eight-bit quantity}
-@!index=-1000..tfm_size; {address of a byte in |tfm|}
-@!char_type=0..65535;
-@!xchar_type=0..65536;
-@!xxchar_type=0..65537;
-@!xxxchar_type=0..65538;
-
-@
-@<Glob...@>=
-@!tfm:array [-1000..tfm_size] of byte; {the input data all goes here}
-@y
-@d index == index_type
-
-@<Types...@>=
-@!byte=0..255; {unsigned eight-bit quantity}
-@!index=integer; {address of a byte in |tfm|}
-@!char_type=0..65535;
-@!xchar_type=0..65536;
-@!xxchar_type=0..65537;
-@!xxxchar_type=0..65538;
-
-@ CHECK OUT tfm array ranges.
-@<Glob...@>=
-{Kludge here to define |tfm| as a macro which takes care of the negative
- lower bound. We've defined |tfm| for the benefit of web2c above.}
-@=#define tfm (tfmfilearray + 1001);@>@\
-@!tfm_file_array: pointer_to_byte; {the input data all goes here}
-@z
-
-@x [20] Send error output to stderr.
-@d abort(#)==begin print_ln(#);
- print_ln('Sorry, but I can''t go on; are you sure this is a OFM?');
-@y
-@d abort(#)==begin write_ln(stderr, #);
- write_ln(stderr, 'Sorry, but I can''t go on; are you sure this is a OFM?');
-@z
-
-@x [20] Allow arbitrarily large input files.
-if 4*lf-1>tfm_size then abort('The file is bigger than I can handle!');
-@.The file is bigger...@>
-@y
-{|tfm_file_array
- := cast_to_byte_pointer (xrealloc (tfm_file_array, 4 * lf - 1 + 1108));|}
-@z
-
-% [27, 28] Change strings to C char pointers. The Pascal strings are
-% indexed starting at 1, so we pad with a blank.
-@x
-@!ASCII_04,@!ASCII_10,@!ASCII_14,HEX: packed array [1..32] of char;
- {strings for output in the user's external character set}
-@!MBL_string,@!RI_string,@!RCE_string:packed array [1..3] of char;
- {handy string constants for |face| codes}
-@y
-@!ASCII_04,@!ASCII_10,@!ASCII_14,HEX: c_string;
- {strings for output in the user's external character set}
-@!ASCII_all: packed array[0..256] of char;
-@!MBL_string,@!RI_string,@!RCE_string: c_string;
- {handy string constants for |face| codes}
-@z
-
-@x
-ASCII_04:=' !"#$%&''()*+,-./0123456789:;<=>?';@/
-ASCII_10:='@@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_';@/
-ASCII_14:='`abcdefghijklmnopqrstuvwxyz{|}~ ';@/
-HEX:='0123456789ABCDEF';@/
-MBL_string:='MBL'; RI_string:='RI '; RCE_string:='RCE';
-@y
-ASCII_04:=' !"#$%&''()*+,-./0123456789:;<=>?';@/
-ASCII_10:=' @@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_';@/
-ASCII_14:=' `abcdefghijklmnopqrstuvwxyz{|}~ ';@/
-HEX:=' 0123456789ABCDEF';@/
-strcpy (ASCII_all, ASCII_04);
-strcat (ASCII_all, '@@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_');
-strcat (ASCII_all, '`abcdefghijklmnopqrstuvwxyz{|}~');@/
-MBL_string:=' MBL'; RI_string:=' RI '; RCE_string:=' RCE';
-@z
-
-% [38] How we output the character code depends on |charcode_format|.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-@x
-begin if font_type>vanilla then
- out_hex_char(c)
-else if (c>="0")and(c<="9") then
- out(' C ',c-"0":1)
-else if (c>="A")and(c<="Z") then
- out(' C ',ASCII_10[c-"A"+2])
-else if (c>="a")and(c<="z") then
- out(' C ',ASCII_14[c-"a"+2])
-else out_hex_char(c);
-@y
-begin if (font_type > vanilla) or (charcode_format = charcode_hex) then
- out_hex_char(c)
-else if (charcode_format = charcode_ascii) and (c > " ") and (c <= "~")
- and (c <> "(") and (c <> ")") then
- out(' C ', ASCII_all[c - " " + 1])
-{default case, use hex}
-else out_hex_char(c);
-@z
-
-% [39] Don't output the face code as an integer.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-@x
- out(MBL_string[1+(b mod 3)]);
- out(RI_string[1+s]);
- out(RCE_string[1+(b div 3)]);
-@y
- put_byte(MBL_string[1+(b mod 3)], pl_file);
- put_byte(RI_string[1+s], pl_file);
- put_byte(RCE_string[1+(b div 3)], pl_file);
-@z
-
-@x [40] Force 32-bit constant arithmetic for 16-bit machines.
-f:=((tfm[k+1] mod 16)*@'400+tfm[k+2])*@'400+tfm[k+3];
-@y
-f:=((tfm[k+1] mod 16)*intcast(@'400)+tfm[k+2])*@'400+tfm[k+3];
-@z
-
-% [78] No progress reports unless verbose.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-@x
- incr(chars_on_line);
- end;
- if no_repeats(c)>0 then begin
- print_hex(c); print('-'); print_hex(c+no_repeats(c));
- left; out('CHARREPEAT'); out_char(c); out_char(no_repeats(c)); out_ln;
- end
- else begin
- print_hex(c); {progress report}
- left; out('CHARACTER'); out_char(c); out_ln;
- end;
-@y
- if verbose then incr(chars_on_line);
- end;
- if no_repeats(c)>0 then begin
- if verbose then begin
- print_hex(c); print('-'); print_hex(c+no_repeats(c));
- end;
- left; out('CHARREPEAT'); out_char(c); out_char(no_repeats(c)); out_ln;
- end
- else begin
- if verbose then print_hex(c); {progress report}
- left; out('CHARACTER'); out_char(c); out_ln;
- end;
-@z
-
-% [89] Change the name of the variable `class', since AIX 3.1's <math.h>
-% defines a function by that name.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-@x
-@d pending=4 {$f(x,y)$ is being evaluated}
-@y
-@d pending=4 {$f(x,y)$ is being evaluated}
-
-@d class == class_var
-@z
-
-% [90] Change name of the function `f'.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-@x
- r:=f(r,(hash[r]-1)div xmax_char,(hash[r]-1)mod xmax_char);
-@y
- r:=f_fn(r,(hash[r]-1)div xmax_char,(hash[r]-1)mod xmax_char);
-@z
-
-% [94] web2c can't handle these mutually recursive procedures.
-% But let's do a fake definition of f here, so that it gets into web2c's
-% symbol table. We also have to change the name, because there is also a
-% variable named `f', and some C compilers can't deal with that.
-@x
-@p function f(@!h,@!x,@!y:index):index; forward;@t\2@>
- {compute $f$ for arguments known to be in |hash[h]|}
-@y
-@p
-ifdef('notdef')
-function f_fn(@!h,@!x,@!y:index):index; begin end;@t\2@>
- {compute $f$ for arguments known to be in |hash[h]|}
-endif('notdef')
-@z
-@x
-else eval:=f(h,x,y);
-@y
-else eval:=f_fn(h,x,y);
-@z
-
-% [95] The real definition of f.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-@x
-@p function f;
-@y
-@p function f_fn(@!h,@!x,@!y:index):index;
-@z
-@x
-f:=lig_z[h];
-@y
-f_fn:=lig_z[h];
-@z
-
-% [99] No final newline unless verbose.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-@x
-do_characters; print_ln('.');@/
-@y
-do_characters; if verbose then print_ln('.');@/
-@z
-
-@x [100] System-dependent changes.
-This section should be replaced, if necessary, by changes to the program
-that are necessary to make \.{TFtoPL} work at a particular installation.
-It is usually best to design your change file so that all changes to
-previous sections preserve the section numbering; then everybody's version
-will be consistent with the printed program. More extensive changes,
-which introduce new sections, can be inserted here; then only the index
-itself will get a new section number.
-@^system dependencies@>
-@y
-Parse a Unix-style command line.
-
-@d argument_is (#) == (strcmp (long_options[option_index].name, #) = 0)
-
-@<Define |parse_arguments|@> =
-procedure parse_arguments;
-const n_options = 4; {Pascal won't count array lengths for us.}
-var @!long_options: array[0..n_options] of getopt_struct;
- @!getopt_return_val: integer;
- @!option_index: c_int_type;
- @!current_option: 0..n_options;
-begin
- @<Initialize the option variables@>;
- @<Define the option table@>;
- repeat
- getopt_return_val := getopt_long_only (argc, argv, '', long_options,
- address_of (option_index));
- if getopt_return_val = -1 then begin
- {End of arguments; we exit the loop below.} ;
-
- end else if getopt_return_val = "?" then begin
- usage ('ofm2opl');
-
- end else if argument_is ('help') then begin
- usage_help (OFM2OPL_HELP, nil);
-
- end else if argument_is ('version') then begin
- print_version_and_exit
- (banner, nil, 'J. Plaice, Y. Haralambous, D.E. Knuth', nil);
-
- end else if argument_is ('charcode-format') then begin
- if strcmp (optarg, 'ascii') = 0 then
- charcode_format := charcode_ascii
- else if strcmp (optarg, 'hex') = 0 then
- charcode_format := charcode_hex
- else
- write_ln (stderr, 'Bad character code format', optarg, '.');
-
- end; {Else it was a flag; |getopt| has already done the assignment.}
- until getopt_return_val = -1;
-
- {Now |optind| is the index of first non-option on the command line.}
- if (optind + 1 <> argc) and (optind + 2 <> argc) then begin
- write_ln (stderr, 'ofm2opl: Need one or two file arguments.');
- usage ('ofm2opl');
- end;
-
- tfm_name := cmdline (optind);
-end;
-
-@ Here are the options we allow. The first is one of the standard GNU options.
-@.-help@>
-
-@<Define the option...@> =
-current_option := 0;
-long_options[current_option].name := 'help';
-long_options[current_option].has_arg := 0;
-long_options[current_option].flag := 0;
-long_options[current_option].val := 0;
-incr (current_option);
-
-@ Another of the standard options.
-@.-version@>
-
-@<Define the option...@> =
-long_options[current_option].name := 'version';
-long_options[current_option].has_arg := 0;
-long_options[current_option].flag := 0;
-long_options[current_option].val := 0;
-incr (current_option);
-
-@ Print progress information?
-@.-verbose@>
-
-@<Define the option...@> =
-long_options[current_option].name := 'verbose';
-long_options[current_option].has_arg := 0;
-long_options[current_option].flag := address_of (verbose);
-long_options[current_option].val := 1;
-incr (current_option);
-
-@
-@<Glob...@> =
-@!verbose: c_int_type;
-
-@
-@<Initialize the option...@> =
-verbose := false;
-
-@ This option changes how we output character codes.
-@.-charcode-format@>
-
-@<Define the option...@> =
-long_options[current_option].name := 'charcode-format';
-long_options[current_option].has_arg := 1;
-long_options[current_option].flag := 0;
-long_options[current_option].val := 0;
-incr (current_option);
-
-@ We use an ``enumerated'' type to store the information.
-
-@<Type...@> =
-@!charcode_format_type = charcode_ascii..charcode_default;
-
-@
-@<Const...@> =
-@!charcode_ascii = 0;
-@!charcode_hex = 1;
-@!charcode_default = 2;
-
-@
-@<Global...@> =
-@!charcode_format: charcode_format_type;
-
-@ It starts off as the default, which is hex for OFM2OPL.
-
-@<Initialize the option...@> =
-charcode_format := charcode_default;
-
-@ An element with all zeros always ends the list.
-
-@<Define the option...@> =
-long_options[current_option].name := 0;
-long_options[current_option].has_arg := 0;
-long_options[current_option].flag := 0;
-long_options[current_option].val := 0;
-
-@ Global filenames.
-
-@<Global...@> =
-@!tfm_name, @!pl_name:c_string;
-@z
diff --git a/Build/source/texk/web2c/omegaware/ofm2opl.web b/Build/source/texk/web2c/omegaware/ofm2opl.web
deleted file mode 100644
index d18931fd3a9..00000000000
--- a/Build/source/texk/web2c/omegaware/ofm2opl.web
+++ /dev/null
@@ -1,2322 +0,0 @@
-%
-% This file is part of the Omega project, which
-% is based in the web2c distribution of TeX.
-%
-% Copyright (c) 1994--2000 John Plaice and Yannis Haralambous
-% applies only to the changes to the original tftopl.web.
-%
-% This program by D. E. Knuth is not copyrighted and can be used freely.
-% Version 0 was implemented in January 1982.
-% In February 1982 a new restriction on ligature steps was added.
-% In June 1982 the routines were divided into smaller pieces for IBM people,
-% and the result was designated "Version 1" in September 1982.
-% Slight changes were made in October, 1982, for version 0.6 of TeX.
-% Version 2 (July 1983) was released with TeX version 0.999.
-% Version 2.1 (September 1983) changed TEXINFO to FONTDIMEN.
-% Version 2.2 (February 1984) simplified decimal fraction output.
-% Version 2.3 (May 1984) fixed a bug when lh=17.
-% Version 2.4 (July 1984) fixed a bug involving unused ligature code.
-% Version 2.5 (September 1985) updated the standard codingscheme names.
-% Version 3 (October 1989) introduced new ligature capabilities.
-% Version 3.1 (November 1989) renamed z[] to lig_z[] for better portability.
-
-% Version 1.0 of OFM2OPL (December 1995) allows one to read OFM files.
-
-% Here is TeX material that gets inserted after \input webmac
-\def\hang{\hangindent 3em\indent\ignorespaces}
-\font\ninerm=cmr9
-\let\mc=\ninerm % medium caps for names like SAIL
-\def\PASCAL{Pascal}
-
-\def\(#1){} % this is used to make section names sort themselves better
-\def\9#1{} % this is used for sort keys in the index
-
-\def\title{OFM2OPL}
-\def\contentspagenumber{201}
-\def\topofcontents{\null
- \def\titlepage{F} % include headline on the contents page
- \def\rheader{\mainfont\hfil \contentspagenumber}
- \vfill
- \centerline{\titlefont The {\ttitlefont OFM2OPL} processor}
- \vskip 15pt
- \centerline{(Version 1.11, February 2000)}
- \vfill}
-\def\botofcontents{\vfill
- \centerline{\hsize 5in\baselineskip9pt
- \vbox{\ninerm\noindent
- The preparation of the original report
- by D. E. Knuth
- was supported in part by the National Science
- Foundation under grants IST-8201926 and MCS-8300984,
- and by the System Development Foundation. `\TeX' is a
- trademark of the American Mathematical Society.}}}
-\pageno=\contentspagenumber \advance\pageno by 1
-
-@* Introduction.
-The \.{OFM2OPL} utility program converts $\Omega$ and \TeX\ font
-metric (``\.{TFM}'' and ``\.{OFM}'') files into equivalent
-property-list (``\.{PL}'' and ``\.{OPL}'') files. It also
-makes a thorough check of the given \.{TFM} or \.{OFM} file,
-using essentially the same algorithm as \TeX\ or $\Omega$. Thus
-if \TeX\ or $\Omega$ complains that a \.{TFM} or an \.{OFM}
-file is ``bad,'' this program will pinpoint the source or sources of
-badness. A \.{PL} or \.{OPL} file output by this program can be edited
-with a normal text editor, and the result can be converted back to \.{TFM}
-or \.{OFM} format using the companion program \.{OPLtoOFM}.
-
-The first \.{TFtoPL} program was designed by Leo Guibas in the summer of
-1978. Contributions by Frank Liang, Doug Wyatt, and Lyle Ramshaw
-also had a significant effect on the evolution of the present code.
-
-Extensions for an enhanced ligature mechanism were added by
-D. E. Knuth in 1989.
-
-Extensions to handle extended font metric files (``\.{OFM}'') were
-added by John Plaice in December 1995 and January 1996, resulting in
-the new program \.{OFM2OPL}. In the following documentation, all
-unchanged references to the \.{TFtoPL} program and to \.{TFM} and
-\.{PL} files also apply to the \.{OFM2OPL} program and to \.{OFM}
-and \.{OPL} files.
-
-The |banner| string defined here should be changed whenever \.{OFM2OPL}
-gets modified.
-
-@d banner=='This is OFM2OPL, Version 1.11'
-
-@ This program is written entirely in standard \PASCAL, except that
-it occasionally has lower case letters in strings that are output.
-Such letters can be converted to upper case if necessary. The input is read
-from |tfm_file|, and the output is written on |pl_file|; error messages and
-other remarks are written on the |output| file, which the user may
-choose to assign to the terminal if the system permits it.
-@^system dependencies@>
-
-The term |print| is used instead of |write| when this program writes on
-the |output| file, so that all such output can be easily deflected.
-
-@d print(#)==write(#)
-@d print_ln(#)==write_ln(#)
-
-@p program OFM2OPL(@!tfm_file,@!pl_file,@!output);
-label @<Labels in the outer block@>@/
-const @<Constants in the outer block@>@/
-type @<Types in the outer block@>@/
-var @<Globals in the outer block@>@/
-procedure initialize; {this procedure gets things started properly}
- begin print_ln(banner);@/
- @<Set initial values@>@/
- end;
-
-@ If the program has to stop prematurely, it goes to the
-`|final_end|'.
-
-@d final_end=9999 {label for the end of it all}
-
-@<Labels...@>=final_end;
-
-@ The following parameters can be changed at compile time to extend or
-reduce \.{TFtoPL}'s capacity.
-
-@<Constants...@>=
-@!tfm_size=2000000; {maximum length of |tfm| data, in bytes}
-@!lig_size=800000; {maximum length of |lig_kern| program, in words}
-@!hash_size=130003; {preferably a prime number, a bit larger than the number
- of character pairs in lig/kern steps}
-@!hash_mult=16007; {another prime}
-@!max_char=65535; {the largest character number in a font}
-@!xmax_char=65536; {|max_char|+1}
-@!xxmax_char=65537;{|max_char|+2}
-@!xmax_label=80001;{must be greater than |max_lig_steps|}
-@!mem_size=262152; {|max_char|*4+8}
-
-@ Here are some macros for common programming idioms.
-
-@d incr(#) == #:=#+1 {increase a variable by unity}
-@d decr(#) == #:=#-1 {decrease a variable by unity}
-@d do_nothing == {empty statement}
-
-@* Font metric data.
-The following description of \.{TFM} files is not sufficient for
-\.{OFM} files. The additional documentation necessary for the
-\.{OFM} files can be found in another file, such as the $\Omega$
-change files.
-
-The idea behind \.{TFM} files is that typesetting routines like \TeX\
-need a compact way to store the relevant information about several
-dozen fonts, and computer centers need a compact way to store the
-relevant information about several hundred fonts. \.{TFM} files are
-compact, and most of the information they contain is highly relevant,
-so they provide a solution to the problem.
-
-The information in a \.{TFM} file appears in a sequence of 8-bit bytes.
-Since the number of bytes is always a multiple of 4, we could
-also regard the file as a sequence of 32-bit words; but \TeX\ uses the
-byte interpretation, and so does \.{TFtoPL}. Note that the bytes
-are considered to be unsigned numbers.
-
-@<Glob...@>=
-@!tfm_file:packed file of 0..255;
-
-@ On some systems you may have to do something special to read a
-packed file of bytes. For example, the following code didn't work
-when it was first tried at Stanford, because packed files have to be
-opened with a special switch setting on the \PASCAL\ that was used.
-@^system dependencies@>
-
-@<Set init...@>=
-reset(tfm_file);
-
-@ The first 24 bytes (6 words) of a \.{TFM} file contain twelve 16-bit
-integers that give the lengths of the various subsequent portions
-of the file. These twelve integers are, in order:
-$$\vbox{\halign{\hfil#&$\null=\null$#\hfil\cr
-|@!lf|&length of the entire file, in words;\cr
-|@!lh|&length of the header data, in words;\cr
-|@!bc|&smallest character code in the font;\cr
-|@!ec|&largest character code in the font;\cr
-|@!nw|&number of words in the width table;\cr
-|@!nh|&number of words in the height table;\cr
-|@!nd|&number of words in the depth table;\cr
-|@!ni|&number of words in the italic correction table;\cr
-|@!nl|&number of words in the lig/kern table;\cr
-|@!nk|&number of words in the kern table;\cr
-|@!ne|&number of words in the extensible character table;\cr
-|@!np|&number of font parameter words.\cr}}$$
-They are all nonnegative and less than $2^{15}$. We must have |bc-1<=ec<=255|,
-|ne<=256|, and
-$$\hbox{|lf=6+lh+(ec-bc+1)+nw+nh+nd+ni+nl+nk+ne+np|.}$$
-Note that a font may contain as many as 256 characters (if |bc=0| and |ec=255|),
-and as few as 0 characters (if |bc=ec+1|).
-
-Incidentally, when two or more 8-bit bytes are combined to form an integer of
-16 or more bits, the most significant bytes appear first in the file.
-This is called BigEndian order.
-
-@<Glob...@>=
-@!ofm_level,
-@!nco,@!ncw,@!npc,@!nki,@!nwi,@!nkf,@!nwf,@!nkr,@!nwr,@!nkg,@!nwg,@!nkp,@!nwp,
-@!nkm,@!nwm,@!real_lf,
-@!lf,@!lh,@!bc,@!ec,@!nw,@!nh,@!nd,@!ni,@!nl,@!nk,@!ne,@!np,@!font_dir:integer;
- {subfile sizes}
-@!ofm_on:boolean;
-
-@ @<Set init...@>=
-ofm_on:=false; ofm_level:=-1; lf:=0; lh:=0;
-nco:=0; ncw:=0; npc:=0; bc:=0; ec:=0; nw:=0; nh:=0; nd:=0; ni:=0;
-nl:=0; nk:=0; ne:=0; np:=0;
-nki:=0; nwi:=0; nkf:=0; nwf:=0;
-nkm:=0; nwm:=0; real_lf:=0;
-nkr:=0; nwr:=0; nkg:=0; nwg:=0;
-nkp:=0; nwp:=0; font_dir:=0;
-
-@ The rest of the \.{TFM} file may be regarded as a sequence of ten data
-arrays having the informal specification
-$$\def\arr$[#1]#2${\&{array} $[#1]$ \&{of} #2}
-\vbox{\halign{\hfil\\{#}&$\,:\,$\arr#\hfil\cr
-header&|[0..lh-1]stuff|\cr
-char\_info&|[bc..ec]char_info_word|\cr
-width&|[0..nw-1]fix_word|\cr
-height&|[0..nh-1]fix_word|\cr
-depth&|[0..nd-1]fix_word|\cr
-italic&|[0..ni-1]fix_word|\cr
-lig\_kern&|[0..nl-1]lig_kern_command|\cr
-kern&|[0..nk-1]fix_word|\cr
-exten&|[0..ne-1]extensible_recipe|\cr
-param&|[1..np]fix_word|\cr}}$$
-The most important data type used here is a |@!fix_word|, which is
-a 32-bit representation of a binary fraction. A |fix_word| is a signed
-quantity, with the two's complement of the entire word used to represent
-negation. Of the 32 bits in a |fix_word|, exactly 12 are to the left of the
-binary point; thus, the largest |fix_word| value is $2048-2^{-20}$, and
-the smallest is $-2048$. We will see below, however, that all but one of
-the |fix_word| values will lie between $-16$ and $+16$.
-
-@ The first data array is a block of header information, which contains
-general facts about the font. The header must contain at least two words,
-and for \.{TFM} files to be used with Xerox printing software it must
-contain at least 18 words, allocated as described below. When different
-kinds of devices need to be interfaced, it may be necessary to add further
-words to the header block.
-
-\yskip\hang|header[0]| is a 32-bit check sum that \TeX\ will copy into the
-\.{DVI} output file whenever it uses the font. Later on when the \.{DVI}
-file is printed, possibly on another computer, the actual font that gets
-used is supposed to have a check sum that agrees with the one in the
-\.{TFM} file used by \TeX. In this way, users will be warned about
-potential incompatibilities. (However, if the check sum is zero in either
-the font file or the \.{TFM} file, no check is made.) The actual relation
-between this check sum and the rest of the \.{TFM} file is not important;
-the check sum is simply an identification number with the property that
-incompatible fonts almost always have distinct check sums.
-@^check sum@>
-
-\yskip\hang|header[1]| is a |fix_word| containing the design size of the
-font, in units of \TeX\ points (7227 \TeX\ points = 254 cm). This number
-must be at least 1.0; it is fairly arbitrary, but usually the design size
-is 10.0 for a ``10 point'' font, i.e., a font that was designed to look
-best at a 10-point size, whatever that really means. When a \TeX\ user
-asks for a font `\.{at} $\delta$ \.{pt}', the effect is to override the
-design size and replace it by $\delta$, and to multiply the $x$ and~$y$
-coordinates of the points in the font image by a factor of $\delta$
-divided by the design size. {\sl All other dimensions in the\/\ \.{TFM}
-file are |fix_word|\kern-1pt\ numbers in design-size units.} Thus, for example,
-the value of |param[6]|, one \.{em} or \.{\\quad}, is often the |fix_word|
-value $2^{20}=1.0$, since many fonts have a design size equal to one em.
-The other dimensions must be less than 16 design-size units in absolute
-value; thus, |header[1]| and |param[1]| are the only |fix_word| entries in
-the whole \.{TFM} file whose first byte might be something besides 0 or
-255. @^design size@>
-
-\yskip\hang|header[2..11]|, if present, contains 40 bytes that identify
-the character coding scheme. The first byte, which must be between 0 and
-39, is the number of subsequent ASCII bytes actually relevant in this
-string, which is intended to specify what character-code-to-symbol
-convention is present in the font. Examples are \.{ASCII} for standard
-ASCII, \.{TeX text} for fonts like \.{cmr10} and \.{cmti9}, \.{TeX math
-extension} for \.{cmex10}, \.{XEROX text} for Xerox fonts, \.{GRAPHIC} for
-special-purpose non-alphabetic fonts, \.{UNSPECIFIED} for the default case
-when there is no information. Parentheses should not appear in this name.
-(Such a string is said to be in {\mc BCPL} format.)
-@^coding scheme@>
-
-\yskip\hang|header[12..16]|, if present, contains 20 bytes that name the
-font family (e.g., \.{CMR} or \.{HELVETICA}), in {\mc BCPL} format.
-This field is also known as the ``font identifier.''
-@^family name@>
-@^font identifier@>
-
-\yskip\hang|header[17]|, if present, contains a first byte called the
-|seven_bit_safe_flag|, then two bytes that are ignored, and a fourth byte
-called the |face|. If the value of the fourth byte is less than 18, it has
-the following interpretation as a ``weight, slope, and expansion'': Add 0
-or 2 or 4 (for medium or bold or light) to 0 or 1 (for roman or italic) to
-0 or 6 or 12 (for regular or condensed or extended). For example, 13 is
-0+1+12, so it represents medium italic extended. A three-letter code
-(e.g., \.{MIE}) can be used for such |face| data.
-
-\yskip\hang|header[18..@twhatever@>]| might also be present; the individual
-words are simply called |header[18]|, |header[19]|, etc., at the moment.
-
-@ Next comes the |char_info| array, which contains one |char_info_word|
-per character. Each |char_info_word| contains six fields packed into
-four bytes as follows.
-
-\yskip\hang first byte: |width_index| (8 bits)\par
-\hang second byte: |height_index| (4 bits) times 16, plus |depth_index|
- (4~bits)\par
-\hang third byte: |italic_index| (6 bits) times 4, plus |tag|
- (2~bits)\par
-\hang fourth byte: |remainder| (8 bits)\par
-\yskip\noindent
-The actual width of a character is |width[width_index]|, in design-size
-units; this is a device for compressing information, since many characters
-have the same width. Since it is quite common for many characters
-to have the same height, depth, or italic correction, the \.{TFM} format
-imposes a limit of 16 different heights, 16 different depths, and
-64 different italic corrections.
-
-Incidentally, the relation |width[0]=height[0]=depth[0]=italic[0]=0|
-should always hold, so that an index of zero implies a value of zero.
-The |width_index| should never be zero unless the character does
-not exist in the font, since a character is valid if and only if it lies
-between |bc| and |ec| and has a nonzero |width_index|.
-
-@ The |tag| field in a |char_info_word| has four values that explain how to
-interpret the |remainder| field.
-
-\yskip\hang|tag=0| (|no_tag|) means that |remainder| is unused.\par
-\hang|tag=1| (|lig_tag|) means that this character has a ligature/kerning
-program starting at |lig_kern[remainder]|.\par
-\hang|tag=2| (|list_tag|) means that this character is part of a chain of
-characters of ascending sizes, and not the largest in the chain. The
-|remainder| field gives the character code of the next larger character.\par
-\hang|tag=3| (|ext_tag|) means that this character code represents an
-extensible character, i.e., a character that is built up of smaller pieces
-so that it can be made arbitrarily large. The pieces are specified in
-|exten[remainder]|.\par
-
-@d no_tag=0 {vanilla character}
-@d lig_tag=1 {character has a ligature/kerning program}
-@d list_tag=2 {character has a successor in a charlist}
-@d ext_tag=3 {character is extensible}
-
-@ The |lig_kern| array contains instructions in a simple programming language
-that explains what to do for special letter pairs. Each word is a
-|lig_kern_command| of four bytes.
-
-\yskip\hang first byte: |skip_byte|, indicates that this is the final program
- step if the byte is 128 or more, otherwise the next step is obtained by
- skipping this number of intervening steps.\par
-\hang second byte: |next_char|, ``if |next_char| follows the current character,
- then perform the operation and stop, otherwise continue.''\par
-\hang third byte: |op_byte|, indicates a ligature step if less than~128,
- a kern step otherwise.\par
-\hang fourth byte: |remainder|.\par
-\yskip\noindent
-In a kern step, an
-additional space equal to |kern[256*(op_byte-128)+remainder]| is inserted
-between the current character and |next_char|. This amount is
-often negative, so that the characters are brought closer together
-by kerning; but it might be positive.
-
-There are eight kinds of ligature steps, having |op_byte| codes $4a+2b+c$ where
-$0\le a\le b+c$ and $0\le b,c\le1$. The character whose code is
-|remainder| is inserted between the current character and |next_char|;
-then the current character is deleted if $b=0$, and |next_char| is
-deleted if $c=0$; then we pass over $a$~characters to reach the next
-current character (which may have a ligature/kerning program of its own).
-
-Notice that if $a=0$ and $b=1$, the current character is unchanged; if
-$a=b$ and $c=1$, the current character is changed but the next character is
-unchanged. \.{TFtoPL} will check to see that infinite loops are avoided.
-
-If the very first instruction of the |lig_kern| array has |skip_byte=255|,
-the |next_char| byte is the so-called right boundary character of this font;
-the value of |next_char| need not lie between |bc| and~|ec|.
-If the very last instruction of the |lig_kern| array has |skip_byte=255|,
-there is a special ligature/kerning program for a left boundary character,
-beginning at location |256*op_byte+remainder|.
-The interpretation is that \TeX\ puts implicit boundary characters
-before and after each consecutive string of characters from the same font.
-These implicit characters do not appear in the output, but they can affect
-ligatures and kerning.
-
-If the very first instruction of a character's |lig_kern| program has
-|skip_byte>128|, the program actually begins in location
-|256*op_byte+remainder|. This feature allows access to large |lig_kern|
-arrays, because the first instruction must otherwise
-appear in a location |<=255|.
-
-Any instruction with |skip_byte>128| in the |lig_kern| array must have
-|256*op_byte+remainder<nl|. If such an instruction is encountered during
-normal program execution, it denotes an unconditional halt; no ligature
-command is performed.
-
-@d stop_flag=128 {value indicating `\.{STOP}' in a lig/kern program}
-@d kern_flag=128 {op code for a kern step}
-
-@ Extensible characters are specified by an |extensible_recipe|,
-which consists of four bytes called |top|, |mid|,
-|bot|, and |rep| (in this order). These bytes are the character codes
-of individual pieces used to build up a large symbol.
-If |top|, |mid|, or |bot| are zero,
-they are not present in the built-up result. For example, an extensible
-vertical line is like an extensible bracket, except that the top and
-bottom pieces are missing.
-
-
-@ The final portion of a \.{TFM} file is the |param| array, which is another
-sequence of |fix_word| values.
-
-\yskip\hang|param[1]=@!slant| is the amount of italic slant, which is used
-to help position accents. For example, |slant=.25| means that when you go
-up one unit, you also go .25 units to the right. The |slant| is a pure
-number; it's the only |fix_word| other than the design size itself that is
-not scaled by the design size.
-
-\hang|param[2]=space| is the normal spacing between words in text.
-Note that character |" "| in the font need not have anything to do with
-blank spaces.
-
-\hang|param[3]=space_stretch| is the amount of glue stretching between words.
-
-\hang|param[4]=space_shrink| is the amount of glue shrinking between words.
-
-\hang|param[5]=x_height| is the height of letters for which accents don't
-have to be raised or lowered.
-
-\hang|param[6]=quad| is the size of one em in the font.
-
-\hang|param[7]=extra_space| is the amount added to |param[2]| at the
-ends of sentences.
-
-When the character coding scheme is \.{TeX math symbols}, the font is
-supposed to have 15 additional parameters called |num1|, |num2|, |num3|,
-|denom1|, |denom2|, |sup1|, |sup2|, |sup3|, |sub1|, |sub2|, |supdrop|,
-|subdrop|, |delim1|, |delim2|, and |axis_height|, respectively. When the
-character coding scheme is \.{TeX math extension}, the font is supposed to
-have six additional parameters called |default_rule_thickness| and
-|big_op_spacing1| through |big_op_spacing5|.
-
-@ So that is what \.{TFM} files hold. The next question is, ``What about
-\.{PL} files?'' A complete answer to that question appears in the
-documentation of the companion program, \.{PLtoTF}, so it will not
-be repeated here. Suffice it to say that a \.{PL} file is an ordinary
-\PASCAL\ text file, and that the output of \.{TFtoPL} uses only a
-subset of the possible constructions that might appear in a \.{PL} file.
-Furthermore, hardly anybody really wants to look at the formal
-definition of \.{PL} format, because it is almost self-explanatory when
-you see an example or two.
-
-@<Glob...@>=
-@!pl_file:text;
-
-@ @<Set init...@>=
-rewrite(pl_file);
-
-@* Unpacked representation.
-The first thing \.{TFtoPL} does is read the entire |tfm_file| into an array of
-bytes, |tfm[0..(4*lf-1)]|.
-
-@<Types...@>=
-@!byte=0..255; {unsigned eight-bit quantity}
-@!index=-1000..tfm_size; {address of a byte in |tfm|}
-@!char_type=0..65535;
-@!xchar_type=0..65536;
-@!xxchar_type=0..65537;
-@!xxxchar_type=0..65538;
-
-@
-@<Glob...@>=
-@!tfm:array [-1000..tfm_size] of byte; {the input data all goes here}
- {the negative addresses avoid range checks for invalid characters}
-@!top_char,@!top_width,@!top_height,@!top_depth,@!top_italic:integer;
-@!start_ptr,@!check_sum,@!design_size,@!scheme,@!family,@!random_word:integer;
-@!header_length,@!char_ptr,@!copies,@!j:integer;
-
-@ The input may, of course, be all screwed up and not a \.{TFM} file
-at all. So we begin cautiously.
-
-@d abort(#)==begin print_ln(#);
- print_ln('Sorry, but I can''t go on; are you sure this is a OFM?');
- goto final_end;
- end
-
-@<Read the whole input file@>=
-read(tfm_file,tfm[0]);
-if tfm[0]>127 then abort('The first byte of the input file exceeds 127!');
-@.The first byte...@>
-if eof(tfm_file) then abort('The input file is only one byte long!');
-@.The input...one byte long@>
-read(tfm_file,tfm[1]); lf:=tfm[0]*@'400+tfm[1];
-if lf=0 then begin
- for i:=2 to 7 do
- begin
- if eof(tfm_file)
- then abort('The input file is too short to designate its length!');
- read(tfm_file, tfm[i]);
- end;
- ofm_on := true; ofm_level := tfm[2]*@"100+tfm[3];
- if tfm[4]>127 then abort('The fifth byte of the input file exceeds 127!');
- lf := tfm[4]*@"1000000 + tfm[5]*@"10000 + tfm[6]*@"100 + tfm[7];
-end
-else
-begin
- ofm_on := false;
-end;
-case ofm_level of
--1: begin start_ptr:=2; check_sum:=24; end;
- 0: begin start_ptr:=8; check_sum:=56; end;
- 1: begin start_ptr:=8; check_sum:=116; end;
-end;
-design_size:=check_sum+4;
-scheme:=design_size+4;
-family:=scheme+40;
-random_word:=family+20;
-if lf=0 then
- abort('The file claims to have length zero, but that''s impossible!');
-@.The file claims...@>
-if 4*lf-1>tfm_size then abort('The file is bigger than I can handle!');
-@.The file is bigger...@>
-for tfm_ptr:=start_ptr to 4*lf-1 do
- begin if eof(tfm_file) then
- abort('The file has fewer bytes than it claims!');
-@.The file has fewer bytes...@>
- read(tfm_file,tfm[tfm_ptr]);
- end;
-if not eof(tfm_file) then
- begin print_ln('There''s some extra junk at the end of the OFM file,');
-@.There's some extra junk...@>
- print_ln('but I''ll proceed as if it weren''t there.');
- end
-
-@ After the file has been read successfully, we look at the subfile sizes
-to see if they check out.
-
-@d eval_two_bytes(#)==begin if tfm[tfm_ptr]>127 then
- abort('One of the subfile sizes is negative!');
-@.One of the subfile sizes...@>
- #:=tfm[tfm_ptr]*@'400+tfm[tfm_ptr+1];
- tfm_ptr:=tfm_ptr+2;
- end
-@d eval_four_bytes(#)==begin if tfm[tfm_ptr]>127 then
- abort('One of the subfile sizes is negative!');
-@.One of the subfile sizes...@>
- #:=tfm[tfm_ptr]*@"1000000+tfm[tfm_ptr+1]*@"10000+
- tfm[tfm_ptr+2]*@"100+tfm[tfm_ptr+3];
- tfm_ptr:=tfm_ptr+4;
- end
-
-@<Set subfile sizes |lh|, |bc|, \dots, |np|@>=
-begin
-if not ofm_on then begin
- tfm_ptr:=2;
- eval_two_bytes(lh);
- eval_two_bytes(bc);
- eval_two_bytes(ec);
- eval_two_bytes(nw);
- eval_two_bytes(nh);
- eval_two_bytes(nd);
- eval_two_bytes(ni);
- eval_two_bytes(nl);
- eval_two_bytes(nk);
- eval_two_bytes(ne);
- eval_two_bytes(np);
- ncw:=(ec-bc+1);
- header_length:=6;
- top_char:=255;
- top_width:=255;
- top_height:=15;
- top_depth:=15;
- top_italic:=63;
- end
-else begin
- tfm_ptr:=8;
- eval_four_bytes(lh);
- eval_four_bytes(bc);
- eval_four_bytes(ec);
- eval_four_bytes(nw);
- eval_four_bytes(nh);
- eval_four_bytes(nd);
- eval_four_bytes(ni);
- eval_four_bytes(nl);
- eval_four_bytes(nk);
- eval_four_bytes(ne);
- eval_four_bytes(np);
- eval_four_bytes(font_dir);
- top_char:=65535;
- top_width:=65535;
- top_height:=255;
- top_depth:=255;
- top_italic:=255;
- if ofm_level=0 then begin
- header_length:=14;
- ncw:=2*(ec-bc+1);
- end
- else begin
- header_length:=29;
- eval_four_bytes(nco);
- eval_four_bytes(ncw);
- eval_four_bytes(npc);
- eval_four_bytes(nki); {Kinds of font ivalues}
- eval_four_bytes(nwi); {Words of font ivalues}
- eval_four_bytes(nkf); {Kinds of font fvalues}
- eval_four_bytes(nwf); {Words of font fvalues}
- eval_four_bytes(nkm); {Kinds of font mvalues}
- eval_four_bytes(nwm); {Words of font mvalues}
- eval_four_bytes(nkr); {Kinds of font rules}
- eval_four_bytes(nwr); {Words of font rules}
- eval_four_bytes(nkg); {Kinds of font glues}
- eval_four_bytes(nwg); {Words of font glues}
- eval_four_bytes(nkp); {Kinds of font penalties}
- eval_four_bytes(nwp); {Words of font penalties}
- end;
- end;
-if lf<>(header_length+lh+ncw+nw+nh+nd+ni+2*nl+nk+2*ne+np+
- nki+nwi+nkf+nwf+nkm+nwm+nkr+nwr+nkg+nwg+nkp+nwp) then
- abort('Subfile sizes don''t add up to the stated total!');
-@.Subfile sizes don't add up...@>
-if lh<2 then abort('The header length is only ',lh:1,'!');
-@.The header length...@>
-if (2*nl)>(4*lig_size) then
- abort('The lig/kern program is longer than I can handle!');
-@.The lig/kern program...@>
-if (bc>ec+1)or(ec>top_char) then abort('The character code range ',
-@.The character code range...@>
- bc:1,'..',ec:1,'is illegal!');
-if ec>max_char then
- abort('Character ',ec:1,'is too large. Ask a wizard to enlarge me.');
-if (nw=0)or(nh=0)or(nd=0)or(ni=0) then
- abort('Incomplete subfiles for character dimensions!');
-@.Incomplete subfiles...@>
-if ne>(top_char+1) then abort('There are ',ne:1,' extensible recipes!');
-@.There are ... recipes@>
-end
-
-@ Once the input data successfully passes these basic checks,
-\.{TFtoPL} believes that it is a \.{TFM} file, and the conversion
-to \.{PL} format will take place. Access to the various subfiles
-is facilitated by computing the following base addresses. For example,
-the |char_info| for character |c| in a \.{TFM} file will start in location
-|4*(char_base+c)| of the |tfm| array.
-
-@<Globals...@>=
-@!ivalues_start,@!fvalues_start,@!mvalues_start,
-@!rules_start,@!glues_start,@!penalties_start:
-integer;
-@!ivalues_base,@!fvalues_base,@!mvalues_base,
-@!rules_base,@!glues_base,@!penalties_base:
-integer;
-@!char_base,@!width_base,@!height_base,@!depth_base,@!italic_base: integer;
-@!lig_kern_base,@!kern_base,@!exten_base,@!param_base:integer;
- {base addresses for the subfiles}
-@!char_start:array [0..max_char] of integer;
-@!bytes_per_entry:integer;
-
-@ @<Compute the base addresses@>=
-begin
-ivalues_start:=header_length+lh;
-fvalues_start:=ivalues_start+nki;
-mvalues_start:=fvalues_start+nkf;
-rules_start:=mvalues_start+nkm;
-glues_start:=rules_start+nkr;
-penalties_start:=glues_start+nkg;
-ivalues_base:=penalties_start+nkp;
-fvalues_base:=ivalues_base+nwi;
-mvalues_base:=fvalues_base+nwf;
-rules_base:=mvalues_base+nwm;
-glues_base:=rules_base+nwr;
-penalties_base:=glues_base+nwg;
-char_base:=penalties_base+nwp;
-bytes_per_entry:=(12 + 2*npc) div 4 * 4;
-if not ofm_on then begin
- for i:=bc to ec do begin
- char_start[i]:=4*char_base+4*(i-bc);
- end;
- end
-else if ofm_level=0 then begin
- for i:=bc to ec do begin
- char_start[i]:=4*char_base+8*(i-bc);
- end;
- end
-else begin
- char_ptr:=4*char_base;
- i:=bc;
- while i<=ec do begin
- copies:=1+256*tfm[char_ptr+8]+tfm[char_ptr+9];
- for j:=1 to copies do begin
- char_start[i]:=char_ptr;
- i:=i+1;
- end;
- char_ptr:=char_ptr + bytes_per_entry;
- end;
- if char_ptr<>(4*(char_base+ncw)) then
- abort('Length of char info table does not correspond to specification');
- end;
-width_base:=char_base+ncw;
-height_base:=width_base+nw;
-depth_base:=height_base+nh;
-italic_base:=depth_base+nd;
-lig_kern_base:=italic_base+ni;
-kern_base:=lig_kern_base+2*nl;
-exten_base:=kern_base+nk;
-param_base:=exten_base+2*ne-1;
-end
-
-@ Of course we want to define macros that suppress the detail of how the
-font information is actually encoded. Each word will be referred to by
-the |tfm| index of its first byte. For example, if |c| is a character
-code between |bc| and |ec|, then |tfm[char_info(c)]| will be the
-first byte of its |char_info|, i.e., the |width_index|; furthermore
-|width(c)| will point to the |fix_word| for |c|'s width.
-
-@d char_info(#)==char_start[#]
-@d nonexistent(#)==((#<bc)or(#>ec)or(width_index(#)=0))
-@d width(#)==4*(width_base+width_index(#))
-@d height(#)==4*(height_base+height_index(#))
-@d depth(#)==4*(depth_base+depth_index(#))
-@d italic(#)==4*(italic_base+italic_index(#))
-@d kern(#)==4*(kern_base+#) {here \#\ is an index, not a character}
-@d param(#)==4*(param_base+#) {likewise}
-
-@p function width_index(c:char_type):integer;
-begin if not ofm_on then
- width_index:=tfm[char_info(c)]
-else
- width_index:=256*tfm[char_info(c)]+tfm[char_info(c)+1];
-end;
-
-function height_index(c:char_type):integer;
-begin if not ofm_on then
- height_index:=tfm[char_info(c)+1] div 16
-else
- height_index:=tfm[char_info(c)+2];
-end;
-
-function depth_index(c:char_type):integer;
-begin if not ofm_on then
- depth_index:=tfm[char_info(c)+1] mod 16
-else
- depth_index:=tfm[char_info(c)+3];
-end;
-
-function italic_index(c:char_type):integer;
-begin if not ofm_on then
- italic_index:=tfm[char_info(c)+2] div 4
-else if ofm_level=0 then
- italic_index:=tfm[char_info(c)+4]*64 + tfm[char_info(c)+5] div 4
-else
- italic_index:=tfm[char_info(c)+4];
-end;
-
-function tag(c:char_type):integer;
-begin if not ofm_on then
- tag:=tfm[char_info(c)+2] mod 4
-else
- tag:=tfm[char_info(c)+5] mod 4;
-end;
-
-procedure set_no_tag(c:char_type);
-begin if not ofm_on then
- tfm[char_info(c)+2] := (tfm[char_info(c)+2] div 64)*64 + no_tag
-else
- tfm[char_info(c)+5] := (tfm[char_info(c)+5] div 64)*64 + no_tag;
-end;
-
-function ctag(c:char_type):boolean;
-begin if not (ofm_level=1) then
- ctag:=false
-else
- ctag:=tfm[char_info(c)+5] div 4 mod 2;
-end;
-
-procedure set_no_ctag(c:char_type);
-begin if not (ofm_level=1) then
- tfm[char_info(c)+5] :=
- tfm[char_info(c)+5] div 8 * 8 + tfm[char_info(c)+5] mod 4;
-end;
-
-function no_repeats(c:char_type):integer;
-begin if ofm_level<=0 then
- no_repeats:=0
-else
- no_repeats:=256*tfm[char_info(c)+8]+tfm[char_info(c)+9];
-end;
-
-function char_param(c:char_type; i:integer):integer;
-begin
- char_param:=256*tfm[char_info(c)+2*i+10]+tfm[char_info(c)+2*i+11];
-end;
-
-function rremainder(c:char_type):integer;
-begin if not ofm_on then
- rremainder:=tfm[char_info(c)+3]
-else
- rremainder:=256*tfm[char_info(c)+6]+tfm[char_info(c)+7];
-end;
-
-function lig_step(c:char_type):integer;
-begin if not ofm_on then
- lig_step:=4*(lig_kern_base+c)
-else
- lig_step:=4*(lig_kern_base+2*c);
-end;
-
-function exten(c:char_type):integer;
-begin if not ofm_on then
- exten:=4*(exten_base+rremainder(c))
-else
- exten:=4*(exten_base+2*rremainder(c));
-end;
-
-function l_skip_byte(c:integer):integer;
-begin if not ofm_on then
- l_skip_byte:=tfm[c]
-else
- l_skip_byte:=256*tfm[c]+tfm[c+1];
-end;
-
-procedure set_l_skip_byte(c:integer; newc:integer);
-begin if not ofm_on then
- tfm[c]:=newc
-else begin
- tfm[c]:=newc div 256;
- tfm[c+1]:=newc mod 256
- end
-end;
-
-function l_next_char(c:integer):integer;
-begin if not ofm_on then
- l_next_char:=tfm[c+1]
-else
- l_next_char:=256*tfm[c+2]+tfm[c+3];
-end;
-
-procedure set_l_next_char(c:integer; newc:char_type);
-begin if not ofm_on then
- tfm[c+1]:=newc
-else begin
- tfm[c+2]:=newc div 256;
- tfm[c+3]:=newc mod 256
- end
-end;
-
-function l_op_byte(c:integer):integer;
-begin if not ofm_on then
- l_op_byte:=tfm[c+2]
-else
- l_op_byte:=256*tfm[c+4]+tfm[c+5];
-end;
-
-procedure set_l_op_byte(c:integer; newc:integer);
-begin if not ofm_on then
- tfm[c+2]:=newc
-else begin
- tfm[c+2]:=newc div 256;
- tfm[c+3]:=newc mod 256
- end
-end;
-
-function l_remainder(c:integer):integer;
-begin if not ofm_on then
- l_remainder:=tfm[c+3]
-else
- l_remainder:=256*tfm[c+6]+tfm[c+7];
-end;
-
-procedure set_l_remainder(c:integer; newc:char_type);
-begin if not ofm_on then
- tfm[c+3]:=newc
-else begin
- tfm[c+6]:=newc div 256;
- tfm[c+7]:=newc mod 256
- end
-end;
-
-@ One of the things we would like to do is take cognizance of fonts whose
-character coding scheme is \.{TeX math symbols} or \.{TeX math extension};
-we will set the |font_type| variable to one of the three choices
-|vanilla|, |mathsy|, or |mathex|.
-
-@d vanilla=0 {not a special scheme}
-@d mathsy=1 {\.{TeX math symbols} scheme}
-@d mathex=2 {\.{TeX math extension} scheme}
-
-@<Glob...@>=
-@!font_type:vanilla..mathex; {is this font special?}
-
-@* Basic output subroutines.
-Let us now define some procedures that will reduce the rest of \.{TFtoPL}'s
-work to a triviality.
-
-First of all, it is convenient to have an abbreviation for output to the
-\.{PL} file:
-
-@d out(#)==write(pl_file,#)
-
-@ In order to stick to standard \PASCAL, we use three strings called
-|ASCII_04|, |ASCII_10|, and |ASCII_14|, in terms of which we can do the
-appropriate conversion of ASCII codes. Three other little strings are
-used to produce |face| codes like \.{MIE}.
-
-@<Glob...@>=
-@!ASCII_04,@!ASCII_10,@!ASCII_14,HEX: packed array [1..32] of char;
- {strings for output in the user's external character set}
-@!MBL_string,@!RI_string,@!RCE_string:packed array [1..3] of char;
- {handy string constants for |face| codes}
-
-@ @<Set init...@>=
-ASCII_04:=' !"#$%&''()*+,-./0123456789:;<=>?';@/
-ASCII_10:='@@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_';@/
-ASCII_14:='`abcdefghijklmnopqrstuvwxyz{|}~ ';@/
-HEX:='0123456789ABCDEF';@/
-MBL_string:='MBL'; RI_string:='RI '; RCE_string:='RCE';
-
-@ The array |dig| will hold a sequence of digits to be output.
-
-@<Glob...@>=
-@!dig:array[0..32] of integer;
-
-@ Here, in fact, are two procedures that output
-|dig[j-1]|$\,\ldots\,$|dig[0]|, given $j>0$.
-
-@p procedure out_digs(j:integer); {outputs |j| digits}
-begin repeat decr(j); out(HEX[1+dig[j]]);
- until j=0;
-end;
-@#
-procedure print_digs(j:integer); {prints |j| digits}
-begin repeat decr(j); print(HEX[1+dig[j]]);
- until j=0;
-end;
-
-@ The |print_number| procedure indicates how |print_digs| can be used.
-This procedure can print in octal, decimal or hex notation.
-
-@d print_hex(#)==print_number(#,16)
-@d print_octal(#)==print_number(#,8)
-@d print_decimal(#)==print_number(#,10)
-
-@p procedure print_number(c:integer; form:integer); {prints value of |c|}
-var j:0..32; {index into |dig|}
-begin
-j:=0;
-if (c<0) then begin
- print_ln('Internal error: print_number (negative value)');
- c:=0;
- end;
-if form=8 then
- print('''') {an apostrophe indicates the octal notation}
-else if form=16 then
- print('"') { a double apostrophe indicates the hexadecimal notation}
-else if form<>10 then begin
- print_ln('Internal error: print_number (form)');
- form:=16;
- end;
-while (c>0) or (j=0) do begin
- dig[j]:=c mod form; c:=c div form;
- j:=j+1;
- end;
-print_digs(j);
-end;
-
-@ A \.{PL} file has nested parentheses, and we want to format the output
-so that its structure is clear. The |level| variable keeps track of the
-depth of nesting.
-
-@<Glob...@>=
-@!level:0..5;
-
-@ @<Set init...@>=
-level:=0;
-
-@ Three simple procedures suffice to produce the desired structure in the
-output.
-
-@p procedure out_ln; {finishes one line, indents the next}
-var l:0..5;
-begin write_ln(pl_file);
-for l:=1 to level do out(' ');
-end;
-@#
-procedure left; {outputs a left parenthesis}
-begin incr(level); out('(');
-end;
-@#
-procedure right; {outputs a right parenthesis and finishes a line}
-begin decr(level); out(')'); out_ln;
-end;
-
-@ The value associated with a property can be output in a variety of
-ways. For example, we might want to output a {\mc BCPL} string that
-begins in |tfm[k]|:
-
-@p procedure out_BCPL(@!k:index); {outputs a string, preceded by a blank space}
-var l:0..39; {the number of bytes remaining}
-begin out(' '); l:=tfm[k];
-while l>0 do
- begin incr(k); decr(l);
- case tfm[k] div @'40 of
- 1: out(ASCII_04[1+(tfm[k] mod @'40)]);
- 2: out(ASCII_10[1+(tfm[k] mod @'40)]);
- 3: out(ASCII_14[1+(tfm[k] mod @'40)]);
- end;
- end;
-end;
-
-@ The property value might also be a sequence of |l| bytes, beginning
-in |tfm[k]|, that we would like to output in hex notation.
-The following procedure assumes that |l<=4|, but larger values of |l|
-could be handled easily by enlarging the |dig| array and increasing
-the upper bounds on |b| and |j|.
-
-@d out_octal_number(#)==out_number(#,8)
-@d out_decimal_number(#)==out_number(#,10)
-@d out_hex_number(#)==out_number(#,16)
-@d out_dec(#)==out_decimal_number(#)
-@d out_hex_char(#)==out_hex_number(#)
-
-@p procedure out_number(c:integer; form:integer); {outputs value of |c|}
-var j:0..32; {index into |dig|}
-begin
-j:=0;
-if (c<0) then begin
- print_ln('Internal error: print_number (negative value)');
- c:=0;
- end;
-if form=8 then
- out(' O ')
-else if form=10 then
- out(' D ')
-else if form=16 then
- out(' H ')
-else begin
- print_ln('Internal error: print_number (form)');
- form:=16;
- out(' H ')
- end;
-while (c>0) or (j=0) do begin
- dig[j]:=c mod form; c:=c div form;
- j:=j+1;
- end;
-out_digs(j);
-end;
-@#
-procedure out_hex(@!k,@!l:index);
- {outputs |l| bytes in hex}
-var a:0..@"7FFFFFFF; {accumulator for bits not yet output}
-@!b:0..32; {the number of significant bits in |a|}
-@!j:0..11; {the number of digits of output}
-begin
-out(' H ');
-a:=0; b:=0; j:=0;
-while l>0 do @<Reduce \(1)|l| by one, preserving the invariants@>;
-while (a>0)or(j=0) do begin
- dig[j]:=a mod 16; a:=a div 16; incr(j);
- end;
-out_digs(j);
-end;
-
-@ @<Reduce \(1)|l|...@>=
-begin decr(l);
-if tfm[k+l]<>0 then begin
- while b>3 do begin
- dig[j]:=a mod 16; a:=a div 16; b:=b-4; incr(j);
- end;
- case b of
- 0: a:=tfm[k+l];
- 1:a:=a+2*tfm[k+l];
- 2:a:=a+4*tfm[k+l];
- 3:a:=a+8*tfm[k+l];
- end;
- end;
-b:=b+8;
-end
-
-@ The property value may be a character, which is output in hex
-unless it is a letter or a digit. This procedure is the only place
-where a lowercase letter will be output to the \.{PL} file.
-@^system dependencies@>
-
-@p procedure out_char(@!c:integer); {outputs a character}
-begin if font_type>vanilla then
- out_hex_char(c)
-else if (c>="0")and(c<="9") then
- out(' C ',c-"0":1)
-else if (c>="A")and(c<="Z") then
- out(' C ',ASCII_10[c-"A"+2])
-else if (c>="a")and(c<="z") then
- out(' C ',ASCII_14[c-"a"+2])
-else out_hex_char(c);
-end;
-
-@ The property value might be a ``face'' byte, which is output in the
-curious code mentioned earlier, provided that it is less than 18.
-
-@p procedure out_face(@!k:index); {outputs a |face|}
-var s:0..1; {the slope}
-@!b:0..8; {the weight and expansion}
-begin if tfm[k]>=18 then out_hex(k,1)
-else begin out(' F '); {specify face-code format}
- s:=tfm[k] mod 2; b:=tfm[k] div 2;
- out(MBL_string[1+(b mod 3)]);
- out(RI_string[1+s]);
- out(RCE_string[1+(b div 3)]);
- end;
-end;
-
-@ And finally, the value might be a |fix_word|, which is output in
-decimal notation with just enough decimal places for \.{PLtoTF}
-to recover every bit of the given |fix_word|.
-
-All of the numbers involved in the intermediate calculations of
-this procedure will be nonnegative and less than $10\cdot2^{24}$.
-
-@p procedure out_fix(@!k:index); {outputs a |fix_word|}
-var a:0..@'7777; {accumulator for the integer part}
-@!f:integer; {accumulator for the fraction part}
-@!j:0..12; {index into |dig|}
-@!delta:integer; {amount if allowable inaccuracy}
-begin out(' R '); {specify real format}
-a:=(tfm[k]*16)+(tfm[k+1] div 16);
-f:=((tfm[k+1] mod 16)*@'400+tfm[k+2])*@'400+tfm[k+3];
-if a>@'3777 then @<Reduce \(2)negative to positive@>;
-@<Output the integer part, |a|, in decimal notation@>;
-@<Output the fraction part, $|f|/2^{20}$, in decimal notation@>;
-end;
-
-@ The following code outputs at least one digit even if |a=0|.
-
-@<Output the integer...@>=
-begin j:=0;
-repeat dig[j]:=a mod 10; a:=a div 10; incr(j);
-until a=0;
-out_digs(j);
-end
-
-@ And the following code outputs at least one digit to the right
-of the decimal point.
-
-@<Output the fraction...@>=
-begin out('.'); f:=10*f+5; delta:=10;
-repeat if delta>@'4000000 then f:=f+@'2000000-(delta div 2);
-out(f div @'4000000:1); f:=10*(f mod @'4000000); delta:=delta*10;
-until f<=delta;
-end;
-
-@ @<Reduce \(2)negative to positive@>=
-begin out('-'); a:=@'10000-a;
-if f>0 then begin
- f:=@'4000000-f; decr(a);
- end;
-end
-
-@* Doing it.
-\TeX\ checks the information of a \.{TFM} file for validity as the
-file is being read in, so that no further checks will be needed when
-typesetting is going on. And when it finds something wrong, it justs
-calls the file ``bad,'' without identifying the nature of the problem,
-since \.{TFM} files are supposed to be good almost all of the time.
-
-Of course, a bad file shows up every now and again, and that's where
-\.{TFtoPL} comes in. This program wants to catch at least as many errors as
-\TeX\ does, and to give informative error messages besides.
-All of the errors are corrected, so that the \.{PL} output will
-be correct (unless, of course, the \.{TFM} file was so loused up
-that no attempt is being made to fathom it).
-
-@ Just before each character is processed, its code is printed in hex
-notation. Up to eight such codes appear on a line; so we have a variable
-to keep track of how many are currently there. We also keep track of
-whether or not any errors have had to be corrected.
-
-@<Glob...@>=
-@!chars_on_line:0..8; {the number of characters printed on the current line}
-@!perfect:boolean; {was the file free of errors?}
-
-@ @<Set init...@>=
-chars_on_line:=0;@/
-perfect:=true; {innocent until proved guilty}
-
-@ Error messages are given with the help of the |bad| and |range_error|
-and |bad_char| macros:
-
-@d bad(#)==begin perfect:=false; if chars_on_line>0 then print_ln(' ');
- chars_on_line:=0; print_ln('Bad OFM file: ',#);
- end
-@.Bad OFM file@>
-@d range_error(#)==begin perfect:=false; print_ln(' ');
- print(#,' index for character ');
- print_hex(c); print_ln(' is too large;');
- print_ln('so I reset it to zero.');
- end
-@d bad_char_tail(#)==print_hex(#); print_ln('.');
- end
-@d bad_char(#)==begin perfect:=false; if chars_on_line>0 then print_ln(' ');
- chars_on_line:=0; print('Bad OFM file: ',#,' nonexistent character ');
- bad_char_tail
-@d correct_bad_char_tail(#)==#(k,0)
- end
-@d correct_bad_char_middle(#)==print_hex(#(k)); print_ln('.');
- correct_bad_char_tail
-@d correct_bad_char(#)== begin perfect:=false;
- if chars_on_line>0 then print_ln(' ');
- chars_on_line:=0; print('Bad OFM file: ',#,' nonexistent character ');
- correct_bad_char_middle
-
-@<Glob...@>=
-@!i:integer; {an index to words of a subfile}
-@!c:xchar_type; {a random character}
-@!d:0..3; {byte number in a word}
-@!k:index; {a random index}
-@!r:0..65535; {a random two-byte value}
-@!count:0..127; {for when we need to enumerate a small set}
-
-@ There are a lot of simple things to do, and they have to be done one
-at a time, so we might as well get down to business. The first things
-that \.{TFtoPL} will put into the \.{PL} file appear in the header part.
-
-@<Do the header@>=
-begin
-case ofm_level of
-0: begin out('(OFMLEVEL H 0)'); out_ln; end;
-1: begin out('(OFMLEVEL H 1)'); out_ln; end;
-end;
-if ofm_on then begin
- left;
- if font_dir<=7 then out('FONTDIR')
- else out('NFONTDIR');
- case font_dir mod 8 of
- 0: out(' TL');
- 1: out(' LT');
- 2: out(' TR');
- 3: out(' LB');
- 4: out(' BL');
- 5: out(' RT');
- 6: out(' BR');
- 7: out(' RB');
- end;
- right
- end;
-font_type:=vanilla;
-if lh>=12 then begin
- @<Set the true |font_type|@>;
- if lh>=17 then begin
- @<Output the family name@>;
- if lh>=18 then @<Output the rest of the header@>;
- end;
- @<Output the character coding scheme@>;
- end;
-@<Output the design size@>;
-@<Output the check sum@>;
-@<Output the |seven_bit_safe_flag|@>;
-end
-
-@ @<Output the check sum@>=
-left; out('CHECKSUM'); out_hex(check_sum,4);
-right
-
-@ Incorrect design sizes are changed to 10 points.
-
-@d bad_design(#)==begin bad('Design size ',#,'!');
-@.Design size wrong@>
- print_ln('I''ve set it to 10 points.');
- out(' D 10');
- end
-
-@ @<Output the design size@>=
-left; out('DESIGNSIZE');
-if tfm[design_size]>127 then bad_design('negative')
-else if (tfm[design_size]=0)and(tfm[design_size+1]<16) then
- bad_design('too small')
-else out_fix(design_size);
-right;
-out('(COMMENT DESIGNSIZE IS IN POINTS)'); out_ln;
-out('(COMMENT OTHER SIZES ARE MULTIPLES OF DESIGNSIZE)'); out_ln
-@.DESIGNSIZE IS IN POINTS@>
-
-@ Since we have to check two different {\mc BCPL} strings for validity,
-we might as well write a subroutine to make the check.
-
-@p procedure check_BCPL(@!k,@!l:index); {checks a string of length |<l|}
-var j:index; {runs through the string}
-@!c:integer; {character being checked}
-begin if tfm[k]>=l then
- begin bad('String is too long; I''ve shortened it drastically.');
-@.String is too long...@>
- tfm[k]:=1;
- end;
-for j:=k+1 to k+tfm[k] do
- begin c:=tfm[j];
- if (c="(")or(c=")") then
- begin bad('Parenthesis in string has been changed to slash.');
-@.Parenthesis...changed to slash@>
- tfm[j]:="/";
- end
- else if (c<" ")or(c>"~") then
- begin bad('Nonstandard ASCII code has been blotted out.');
-@.Nonstandard ASCII code...@>
- tfm[j]:="?";
- end
- else if (c>="a")and(c<="z") then tfm[j]:=c+"A"-"a"; {upper-casify letters}
- end;
-end;
-
-@ The |font_type| starts out |vanilla|; possibly we need to reset it.
-
-@<Set the true |font_type|@>=
-begin check_BCPL(scheme,40);
-if (tfm[scheme]>=11)and@|(tfm[scheme+1]="T")and@|
- (tfm[scheme+2]="E")and@|(tfm[scheme+3]="X")and@|
- (tfm[scheme+4]=" ")and@|(tfm[scheme+5]="M")and@|
- (tfm[scheme+6]="A")and@|(tfm[scheme+7]="T")and@|
- (tfm[scheme+8]="H")and@|(tfm[scheme+9]=" ") then
- begin if (tfm[scheme+10]="S")and(tfm[scheme+11]="Y") then font_type:=mathsy
- else if (tfm[scheme+10]="E")and(tfm[scheme+11]="X") then font_type:=mathex;
- end;
-end
-
-@ @<Output the character coding scheme@>=
-left; out('CODINGSCHEME');
-out_BCPL(scheme);
-right
-
-@ @<Output the family name@>=
-left; out('FAMILY');
-check_BCPL(family,20);
-out_BCPL(family);
-right
-
-@ @<Output the rest of the header@>=
-begin left; out('FACE'); out_face(random_word+3); right;
-for i:=18 to lh-1 do begin
- left; out('HEADER D ',i:1);
- out_hex(check_sum+4*i,@,4); right;
- end;
-end
-
-@ This program does not check to see if the |seven_bit_safe_flag| has the
-correct setting, i.e., if it really reflects the seven-bit-safety of
-the \.{TFM} file; the stated value is merely put into the \.{PL} file.
-The \.{PLtoTF} program will store a correct value and give a warning
-message if a file falsely claims to be safe.
-
-@<Output the |seven_bit_safe_flag|@>=
-begin left; out('SEVENBITSAFEFLAG FALSE'); right;
-end
-
-@ The next thing to take care of is the list of parameters.
-
-@<Do the parameters@>=
-if np>0 then begin
- left; out('FONTDIMEN'); out_ln;
- for i:=1 to np do @<Check and output the $i$th parameter@>;
- right;
- end;
-@<Check to see if |np| is complete for this font type@>;
-
-@ @<Check to see if |np|...@>=
-if (font_type=mathsy)and(np<>22) then
- print_ln('Unusual number of fontdimen parameters for a math symbols font (',
-@.Unusual number of fontdimen...@>
- np:1,' not 22).')
-else if (font_type=mathex)and(np<>13) then
- print_ln('Unusual number of fontdimen parameters for an extension font (',
- np:1,' not 13).')
-
-@ All |fix_word| values except the design size and the first parameter
-will be checked to make sure that they are less than 16.0 in magnitude,
-using the |check_fix| macro:
-
-@d check_fix_tail(#)==bad(#,' ',i:1,' is too big;');
- print_ln('I have set it to zero.');
- end
-@d check_fix(#)==if (tfm[#]>0)and(tfm[#]<255) then
- begin tfm[#]:=0; tfm[(#)+1]:=0; tfm[(#)+2]:=0; tfm[(#)+3]:=0;
- check_fix_tail
-
-@<Check and output the $i$th parameter@>=
-begin left;
-if i=1 then out('SLANT') {this parameter is not checked}
-else begin check_fix(param(i))('Parameter');@/
-@.Parameter n is too big@>
- @<Output the name of parameter $i$@>;
- end;
-out_fix(param(i)); right;
-end
-
-@ @<Output the name...@>=
-if i<=7 then case i of
- 2:out('SPACE');@+3:out('STRETCH');@+4:out('SHRINK');
- 5:out('XHEIGHT');@+6:out('QUAD');@+7:out('EXTRASPACE')@+end
-else if (i<=22)and(font_type=mathsy) then case i of
- 8:out('NUM1');@+9:out('NUM2');@+10:out('NUM3');
- 11:out('DENOM1');@+12:out('DENOM2');
- 13:out('SUP1');@+14:out('SUP2');@+15:out('SUP3');
- 16:out('SUB1');@+17:out('SUB2');
- 18:out('SUPDROP');@+19:out('SUBDROP');
- 20:out('DELIM1');@+21:out('DELIM2');
- 22:out('AXISHEIGHT')@+end
-else if (i<=13)and(font_type=mathex) then
- if i=8 then out('DEFAULTRULETHICKNESS')
- else out('BIGOPSPACING',i-8:1)
-else out('PARAMETER D ',i:1)
-
-@ @<Glob...@>=
-@!start_counter,@!base_counter,@!number_entries:integer;
-@!value:integer;
-
-@ @<Do the ivalue parameters@>=
-if nki>0 then begin
- start_counter:=ivalues_start*4;
- base_counter:=ivalues_base*4;
- for i:=0 to nki-1 do @<Check and output the $i$th ivalue table@>;
- end;
-
-@ @<Check and output the $i$th ivalue table@>=
-begin
-left; out('FONTIVALUE'); out_hex_number(i); out_ln;
-number_entries:=256*tfm[start_counter+2]+tfm[start_counter+3];
-for j:=0 to number_entries-1 do begin
- left; out('IVALUE'); out_hex_number(j); out_ln;
- value:=256*tfm[base_counter+2]+tfm[base_counter+3];
- left; out('IVALUEVAL'); out_hex_number(value); right;
- right;
- base_counter:=base_counter+4;
- end;
-right;
-start_counter:=start_counter+4;;
-end;
-
-@ @<Do the fvalue parameters@>=
-if nkf>0 then begin
- start_counter:=fvalues_start*4;
- base_counter:=fvalues_base*4;
- for i:=0 to nkf-1 do @<Check and output the $i$th fvalue table@>;
- end;
-
-@ @<Check and output the $i$th fvalue table@>=
-begin
-left; out('FONTFVALUE'); out_hex_number(i); out_ln;
-number_entries:=256*tfm[start_counter+2]+tfm[start_counter+3];
-for j:=0 to number_entries-1 do begin
- left; out('FVALUE'); out_hex_number(j); out_ln;
- left; out('FVALUEVAL'); out_fix(base_counter); right;
- right;
- base_counter:=base_counter+4;
- end;
-right;
-start_counter:=start_counter+4;
-end;
-
-@ @<Do the mvalue parameters@>=
-if nkm>0 then begin
- start_counter:=mvalues_start*4;
- base_counter:=mvalues_base*4;
- for i:=0 to nkm-1 do @<Check and output the $i$th mvalue table@>;
- end;
-
-@ @<Check and output the $i$th mvalue table@>=
-begin
-left; out('FONTMVALUE'); out_hex_number(i); out_ln;
-number_entries:=256*tfm[start_counter+2]+tfm[start_counter+3];
-for j:=0 to number_entries-1 do begin
- left; out('MVALUE'); out_hex_number(j); out_ln;
- left; out('MVALUEVAL'); out_fix(base_counter); right;
- right;
- base_counter:=base_counter+4;
- end;
-right;
-start_counter:=start_counter+4;
-end;
-
-@ @<Do the rule parameters@>=
-if nkr>0 then
- begin
- start_counter:=rules_start*4;
- base_counter:=rules_base*4;
- for i:=0 to nkr-1 do @<Check and output the $i$th rule table@>;
- end;
-
-@ @<Check and output the $i$th rule table@>=
-begin
-left; out('FONTRULE'); out_hex_number(i); out_ln;
-number_entries:=256*tfm[start_counter+2]+tfm[start_counter+3];
-for j:=0 to number_entries-1 do begin
- left; out('RULE'); out_hex_number(j); out_ln;
- left; out('RULEWD'); out_fix(base_counter); right;
- left; out('RULEHT'); out_fix(base_counter+4); right;
- left; out('RULEDP'); out_fix(base_counter+8); right;
- right;
- base_counter:=base_counter+12;
- end;
-right;
-start_counter:=start_counter+4;
-end;
-
-@ @<Do the glue parameters@>=
-if nkg>0 then begin
- start_counter:=glues_start*4;
- base_counter:=glues_base*4;
- for i:=0 to nkg-1 do @<Check and output the $i$th glue table@>;
- end;
-
-@ @<Glob...@>=
-@!glue_subtype,@!glue_argument_kind,@!glue_stretch_order,
-@!glue_shrink_order,@!glue_argument:integer;
-
-@ @<Check and output the $i$th glue table@>=
-begin
-left; out('FONTGLUE'); out_hex_number(i); out_ln;
-number_entries:=256*tfm[start_counter+2]+tfm[start_counter+3];
-for j:=0 to number_entries-1 do begin
- left; out('GLUE'); out_hex_number(j); out_ln;
- glue_subtype:=tfm[base_counter] div 16;
- glue_argument_kind:=tfm[base_counter] mod 16;
- glue_stretch_order:=tfm[base_counter+1] div 16;
- glue_shrink_order:=tfm[base_counter+1] mod 16;
- glue_argument:=tfm[base_counter+2]*256+tfm[base_counter+3];
- left;
- out('GLUETYPE');
- case glue_subtype of
- 0: out(' H 0');
- 1: out(' H 1');
- 2: out(' H 2');
- 3: out(' H 3');
- end;
- right;
- case glue_argument_kind of
- 1: begin
- left; out('GLUERULE'); out_hex_number(glue_argument); right;
- end;
- 2: begin
- left; out('GLUECHAR'); out_hex_number(glue_argument); right;
- end;
- end;
- left;
- out('GLUESTRETCHORDER');
- case glue_stretch_order of
- 0: out(' H 0');
- 1: out(' H 1');
- 2: out(' H 2');
- 3: out(' H 3');
- 4: out(' H 4');
- end;
- right;
- left;
- out('GLUESHRINKORDER');
- case glue_shrink_order of
- 0: out(' H 0');
- 1: out(' H 1');
- 2: out(' H 2');
- 3: out(' H 3');
- 4: out(' H 4');
- end;
- right;
- left; out('GLUEWD'); out_fix(base_counter+4); right;
- left; out('GLUESTRETCH'); out_fix(base_counter+8); right;
- left; out('GLUESHRINK'); out_fix(base_counter+12); right;
- right;
- base_counter:=base_counter+16;
- end;
-right;
-start_counter:=start_counter+4;
-end;
-
-@ @<Do the penalty parameters@>=
-if nkp>0 then begin
- start_counter:=penalties_start*4;
- base_counter:=penalties_base*4;
- for i:=0 to nkp-1 do @<Check and output the $i$th penalty table@>;
- end;
-
-@ @<Check and output the $i$th penalty table@>=
-begin
-left; out('FONTPENALTY'); out_hex_number(i); out_ln;
-number_entries:=256*tfm[start_counter+2]+tfm[start_counter+3];
-for j:=0 to number_entries-1 do begin
- left; out('PENALTY'); out_hex_number(j); out_ln;
- value:=256*tfm[base_counter+2]+tfm[base_counter+3];
- left; out('PENALTYVAL'); out_hex_number(value); right;
- right;
- base_counter:=base_counter+4;
- end;
-right;
-start_counter:=start_counter+4;
-end;
-
-@ We need to check the range of all the remaining |fix_word| values,
-and to make sure that |width[0]=0|, etc.
-
-@d nonzero_fix(#)==(tfm[#]>0)or(tfm[#+1]>0)or(tfm[#+2]>0)or(tfm[#+3]>0)
-
-@<Check the |fix_word| entries@>=
-if nonzero_fix(4*width_base) then bad('width[0] should be zero.');
-@.should be zero@>
-if nonzero_fix(4*height_base) then bad('height[0] should be zero.');
-if nonzero_fix(4*depth_base) then bad('depth[0] should be zero.');
-if nonzero_fix(4*italic_base) then bad('italic[0] should be zero.');
-for i:=0 to nw-1 do check_fix(4*(width_base+i))('Width');
-@.Width n is too big@>
-for i:=0 to nh-1 do check_fix(4*(height_base+i))('Height');
-@.Height n is too big@>
-for i:=0 to nd-1 do check_fix(4*(depth_base+i))('Depth');
-@.Depth n is too big@>
-for i:=0 to ni-1 do check_fix(4*(italic_base+i))('Italic correction');
-@.Italic correction n is too big@>
-if nk>0 then for i:=0 to nk-1 do check_fix(kern(i))('Kern');
-@.Kern n is too big@>
-
-@ The ligature/kerning program comes next. Before we can put it out in
-\.{PL} format, we need to make a table of ``labels'' that will be inserted
-into the program. For each character |c| whose |tag| is |lig_tag| and
-whose starting address is |r|, we will store the pair |(c,r)| in the
-|label_table| array. If there's a boundary-char program starting at~|r|,
-we also store the pair |(256,r)|.
-This array is sorted by its second components, using the
-simple method of straight insertion.
-
-@<Glob...@>=
-@!label_table:array[xxxchar_type] of record
-@!cc:xchar_type;@!rr:0..lig_size;ischar:boolean;end;
-@!label_ptr:xxchar_type; {the largest entry in |label_table|}
-@!sort_ptr:xxchar_type; {index into |label_table|}
-@!boundary_char:xchar_type; {boundary character, or |xmax_char| if none}
-@!bchar_label:0..xmax_label; {beginning of boundary character program}
-
-@ @<Set init...@>=
-boundary_char:=xmax_char; bchar_label:=xmax_label;@/
-label_ptr:=0; label_table[0].rr:=0; {a sentinel appears at the bottom}
-
-@ We'll also identify and remove inaccessible program steps, using the
-|activity| array.
-
-@d unreachable=0 {a program step not known to be reachable}
-@d pass_through=1 {a program step passed through on initialization}
-@d accessible=2 {a program step that can be relevant}
-
-@<Glob...@>=
-@!activity:array[0..lig_size] of unreachable..accessible;
-@!ai,@!acti:0..lig_size; {indices into |activity|}
-
-@ @<Do the ligatures and kerns@>=
-if nl>0 then
- begin for ai:=0 to (nl-1) do activity[ai]:=unreachable;
- @<Check for a boundary char@>;
- end;
-@<Build the label table@>;
-if nl>0 then
- begin left; out('LIGTABLE'); out_ln;@/
- @<Compute the |activity| array@>;
- @<Output and correct the ligature/kern program@>;
- right;
- @<Check for ligature cycles@>;
- end
-
-@ We build the label table even when |nl=0|, because this catches errors
-that would not otherwise be detected.
-
-@<Build...@>=
-for c:=bc to ec do
-if (tag(c)=lig_tag) or (ctag(c)) then begin
- r:=rremainder(c);
- if (l_skip_byte(lig_step(r)) div 256)=0 then begin
- if r<nl then begin
- if l_skip_byte(lig_step(r))>stop_flag then begin
- r:=256*l_op_byte(lig_step(r))+l_remainder(lig_step(r));
- if r<nl then
- if activity[rremainder(c)]=unreachable then
- activity[rremainder(c)]:=pass_through;
- end;
- end;
- end;
- if r>=nl then begin
- perfect:=false; print_ln(' ');
- print('Ligature/kern starting index for character '); print_hex(c);
- print_ln(' is too large;'); print_ln('so I removed it.'); set_no_tag(c);
- set_no_ctag(c);
-@.Ligature/kern starting index...@>
- end
- else @<Insert |(c,r)| into |label_table|@>;
- end;
-label_table[label_ptr+1].rr:=lig_size; {put ``infinite'' sentinel at the end}
-
-@ @<Insert |(c,r)|...@>=
-begin sort_ptr:=label_ptr; {there's a hole at position |sort_ptr+1|}
-while label_table[sort_ptr].rr>r do begin
- label_table[sort_ptr+1]:=label_table[sort_ptr];
- decr(sort_ptr); {move the hole}
- end;
-label_table[sort_ptr+1].ischar:=not ctag(c);
-if ctag(c) then
- label_table[sort_ptr+1].cc:=char_param(c,0)
-else
- label_table[sort_ptr+1].cc:=c;
-label_table[sort_ptr+1].rr:=r; {fill the hole}
-incr(label_ptr); activity[r]:=accessible;
-end
-
-@ @<Check for a bound...@>=
-if l_skip_byte(lig_step(0))=255 then begin
- left; out('BOUNDARYCHAR');
- boundary_char:=l_next_char(lig_step(0)); out_char(boundary_char); right;
- activity[0]:=pass_through;
- end;
-if l_skip_byte(lig_step(nl-1))=255 then begin
- r:=256*l_op_byte(lig_step(nl-1))+l_remainder(lig_step(nl-1));
- if r>=nl then begin
- perfect:=false; print_ln(' ');
- print('Ligature/kern starting index for boundarychar is too large;');
- print_ln('so I removed it.');
-@.Ligature/kern starting index...@>
- end
- else begin label_ptr:=1; label_table[1].cc:=xmax_char;
- label_table[1].rr:=r;
- bchar_label:=r; activity[r]:=accessible;
- end;
- activity[nl-1]:=pass_through;
- end
-
-@ @<Compute the |activity| array@>=
-for ai:=0 to (nl-1) do
-if (l_skip_byte(lig_step(ai)) div 256)=1 then
- activity[ai]:=accessible
-else if activity[ai]=accessible then begin
- r:=l_skip_byte(lig_step(ai));
- if r<stop_flag then begin
- r:=r+ai+1;
- if r>=nl then begin
- bad('Ligature/kern step ',ai:1,' skips too far;');
-@.Lig...skips too far@>
- print_ln('I made it stop.'); set_l_skip_byte(lig_step(ai),stop_flag);
- end
- else activity[r]:=accessible;
- end;
- end
-
-@ We ignore |pass_through| items, which don't need to be mentioned in
-the \.{PL} file.
-
-@<Output and correct the ligature...@>=
-sort_ptr:=1; {point to the next label that will be needed}
-for acti:=0 to nl-1 do if activity[acti]<>pass_through then
- begin i:=acti; @<Take care of commenting out unreachable steps@>;
- @<Output any labels for step $i$@>;
- @<Output step $i$ of the ligature/kern program@>;
- end;
-if level=2 then right {the final step was unreachable}
-
-@ @<Globals...@>=
-@!output_clabels:array[0..256] of boolean;
-@!clabel_runner:integer;
-
-@ @<Set init...@>=
-for clabel_runner:=0 to 256 do
- output_clabels[clabel_runner]:=false;
-
-@ @<Output any labels...@>=
-while i=label_table[sort_ptr].rr do begin
- if not label_table[sort_ptr].ischar then begin
- if not output_clabels[label_table[sort_ptr].cc] then begin
- output_clabels[label_table[sort_ptr].cc]:=true;
- left;
- out('CLABEL');
- out_char(label_table[sort_ptr].cc);
- right;
- end
- end
- else begin
- left;
- out('LABEL');
- if label_table[sort_ptr].cc=xmax_char then out(' BOUNDARYCHAR')
- else out_char(label_table[sort_ptr].cc);
- right;
- end;
- incr(sort_ptr);
- end
-
-@ @<Take care of commenting out...@>=
-if activity[i]=unreachable then begin
- if level=1 then begin
- left; out('COMMENT THIS PART OF THE PROGRAM IS NEVER USED!'); out_ln;
- end
- end
-else if level=2 then right
-
-@ @<Output step $i$...@>=
-begin k:=lig_step(i);
-if (l_skip_byte(k) div 256)=1 then begin
- case l_op_byte(k) of
- 17: begin
- left; out('CPEN');
- out_hex_number(l_next_char(k));
- out_hex_number(l_remainder(k));
- right;
- end;
- 18: begin
- left; out('CGLUE');
- out_hex_number(l_next_char(k));
- out_hex_number(l_remainder(k));
- right;
- end;
- 19: begin
- left; out('CPENGLUE');
- out_hex_number(l_next_char(k));
- out_hex_number(l_remainder(k) div 256);
- out_hex_number(l_remainder(k) mod 256);
- right;
- end;
- 20: begin
- left; out('CKRN');
- out_hex_number(l_next_char(k));
- r:=l_remainder(k);
- if r>=nk then begin
- bad('Kern index too large.');
-@.Kern index too large@>
- out(' R 0.0');
- end
- else out_fix(kern(r));
- right;
- end;
- end;
- end
-else if l_skip_byte(k)>stop_flag then begin
- if (256*l_op_byte(k)+l_remainder(k))>=nl then
- bad('Ligature unconditional stop command address is too big.');
-@.Ligature unconditional stop...@>
- end
-else if l_op_byte(k)>=kern_flag then @<Output a kern step@>
-else @<Output a ligature step@>;
-if (l_skip_byte(k) mod 256)>0 then
- if level=1 then @<Output either \.{SKIP} or \.{STOP}@>;
-end
-
-@ The \.{SKIP} command is a bit tricky, because we will be omitting all
-inaccessible commands.
-
-@<Output either...@>=
-begin
-if (l_skip_byte(k) mod 256)>=stop_flag then out('(STOP)')
-else begin
- count:=0;
- for ai:=(i+1) to (i+(l_skip_byte(k) mod 256)) do
- if activity[ai]=accessible then incr(count);
- out('(SKIP D ',count:1,')'); {possibly $count=0$, so who cares}
- end;
-out_ln;
-end
-
-@ @<Output a kern step@>=
-begin if nonexistent(l_next_char(k)) then
- if l_next_char(k)<>boundary_char then
- correct_bad_char('Kern step for')(l_next_char)(set_l_next_char);
-@.Kern step for nonexistent...@>
-left; out('KRN'); out_char(l_next_char(k));
-r:=256*(l_op_byte(k)-kern_flag)+l_remainder(k);
-if r>=nk then
- begin bad('Kern index too large.');
-@.Kern index too large@>
- out(' R 0.0');
- end
-else out_fix(kern(r));
-right;
-end
-
-@ @<Output a ligature step@>=
-begin
-if nonexistent(l_next_char(k)) then
- if l_next_char(k)<>boundary_char then
- correct_bad_char('Ligature step for')(l_next_char)(set_l_next_char);
-@.Ligature step for nonexistent...@>
-if nonexistent(l_remainder(k)) then
- correct_bad_char('Ligature step produces the')(l_remainder)(set_l_remainder);
-@.Ligature step produces...@>
-left; r:=l_op_byte(k);
-if (r=4)or((r>7)and(r<>11)) then begin
- print_ln('Ligature step with nonstandard code changed to LIG');
- r:=0; set_l_op_byte(k,0);
- end;
-if r mod 4>1 then out('/');
-out('LIG');
-if odd(r) then out('/');
-while r>3 do begin
- out('>'); r:=r-4;
- end;
-out_char(l_next_char(k)); out_char(l_remainder(k)); right;
-end
-
-@ The last thing on \.{TFtoPL}'s agenda is to go through the
-list of |char_info| and spew out the information about each individual
-character.
-
-@<Do the characters@>=
-sort_ptr:=0; {this will suppress `\.{STOP}' lines in ligature comments}
-c:=bc;
-while (c<=ec) do
-begin
-if width_index(c)>0 then begin
- if chars_on_line=8 then begin
- print_ln(' '); chars_on_line:=1;
- end
- else begin
- if chars_on_line>0 then print(' ');
- incr(chars_on_line);
- end;
- if no_repeats(c)>0 then begin
- print_hex(c); print('-'); print_hex(c+no_repeats(c));
- left; out('CHARREPEAT'); out_char(c); out_char(no_repeats(c)); out_ln;
- end
- else begin
- print_hex(c); {progress report}
- left; out('CHARACTER'); out_char(c); out_ln;
- end;
- @<Output the character's width@>;
- if height_index(c)>0 then @<Output the character's height@>;
- if depth_index(c)>0 then @<Output the character's depth@>;
- if italic_index(c)>0 then @<Output the italic correction@>;
- case tag(c) of
- no_tag: do_nothing;
- lig_tag: @<Output the applicable part of the ligature/kern
- program as a comment@>;
- list_tag: @<Output the character link unless there is a problem@>;
- ext_tag: @<Output an extensible character recipe@>;
- end; {there are no other cases}
- for i:=0 to npc-1 do begin
- if char_param(c,i)<>0 then begin
- left;
- if i<nki then begin
- out('CHARIVALUE'); out_hex_number(i);
- end
- else if i<(nki+nkf) then begin
- out('CHARFVALUE'); out_hex_number(i-nki);
- end
- else if i<(nki+nkf+nkr) then begin
- out('CHARRULE'); out_hex_number(i-nki-nkf);
- end
- else if i<(nki+nkf+nkr+nkg) then begin
- out('CHARGLUE'); out_hex_number(i-nki-nkf-nkr);
- end
- else if i<(nki+nkf+nkr+nkg+nkp) then begin
- out('CHARPENALTY'); out_hex_number(i-nki-nkf-nkr-nkg);
- end;
- out_hex_number(char_param(c,i));
- right;
- end;
- end;
- right;
- end;
-c:=c+1+no_repeats(c);
-end
-
-@ @<Output the character's width@>=
-if width_index(c)>=nw then range_error('Width')
-@.Width index for char...@>
-else begin left; out('CHARWD'); out_fix(width(c)); right;
- end
-
-@ @<Output the character's height@>=
-if height_index(c)>=nh then range_error('Height')
-@.Height index for char...@>
-else begin left; out('CHARHT'); out_fix(height(c)); right;
- end
-
-@ @<Output the character's depth@>=
-if depth_index(c)>=nd then range_error('Depth')
-@.Depth index for char@>
-else begin left; out('CHARDP'); out_fix(depth(c)); right;
- end
-
-@ @<Output the italic correction@>=
-if italic_index(c)>=ni then range_error('Italic correction')
-@.Italic correction index for char...@>
-else begin left; out('CHARIC'); out_fix(italic(c)); right;
- end
-
-@ @<Output the applicable part of the ligature...@>=
-begin left; out('COMMENT'); out_ln;@/
-i:=rremainder(c); r:=lig_step(i);
-if (l_skip_byte(r) mod 256)>stop_flag
-then i:=256*l_op_byte(r)+l_remainder(r);
-repeat @<Output step...@>;
-if (l_skip_byte(k) mod 256)>=stop_flag then i:=nl
-else i:=i+1+(l_skip_byte(k) mod 256);
-until i>=nl;
-right;
-end
-
-@ We want to make sure that there is no cycle of characters linked together
-by |list_tag| entries, since such a cycle would get \TeX\ into an endless
-loop. If such a cycle exists, the routine here detects it when processing
-the largest character code in the cycle.
-
-@<Output the character link unless there is a problem@>=
-begin r:=rremainder(c);
-if nonexistent(r) then
- begin bad_char('Character list link to')(r); set_no_tag(c);
-@.Character list link...@>
- end
-else begin while (r<c)and(tag(r)=list_tag) do r:=rremainder(r);
- if r=c then
- begin bad('Cycle in a character list!');
-@.Cycle in a character list@>
- print('Character '); print_hex(c);
- print_ln(' now ends the list.');
- set_no_tag(c);
- end
- else begin left; out('NEXTLARGER'); out_char(rremainder(c));
- right;
- end;
- end;
-end
-
-@ @<Output an extensible character recipe@>=
-if rremainder(c)>=ne then
- begin range_error('Extensible'); set_no_tag(c);
-@.Extensible index for char@>
- end
-else begin left; out('VARCHAR'); out_ln;
- @<Output the extensible pieces that exist@>;
- right;
- end
-
-@ @<Glob...@>=
-@!exten_char:integer;
-
-@ @<Output the extensible pieces that...@>=
-for d:=0 to 3 do begin
- if not ofm_on then begin
- k:=exten(c)+d;
- exten_char:=tfm[k];
- end
- else begin
- k:=exten(c)+2*d;
- exten_char:=256*tfm[k]+tfm[k+1];
- end;
- if (d=3)or(exten_char>0) then begin
- left;
- case d of
- 0:out('TOP');@+1:out('MID');@+2:out('BOT');@+3:out('REP')@+end;
- if nonexistent(exten_char) then out_char(c)
- else out_char(exten_char);
- right;
- end
- end
-
-@ Some of the extensible recipes may not actually be used, but \TeX\ will
-complain about them anyway if they refer to nonexistent characters.
-Therefore \.{TFtoPL} must check them too.
-
-@<Check the extensible recipes@>=
-if ne>0 then
- for c:=0 to ne-1 do
- for d:=0 to 3 do begin
- if not ofm_on then begin
- k:=4*(exten_base+c)+d;
- exten_char:=tfm[k];
- end
- else begin
- k:=4*(exten_base+c)+2*d;
- exten_char:=256*tfm[k]+tfm[k+1];
- end;
- if (exten_char>0)or(d=3) then begin
- if nonexistent(exten_char) then begin
- bad_char('Extensible recipe involves the')(exten_char);
-@.Extensible recipe involves...@>
- if d<3 then begin
- if not ofm_on then begin
- tfm[k]:=0;
- end
- else begin
- tfm[k]:=0;
- tfm[k+1]:=0;
- end;
- end;
- end;
- end;
- end
-
-@* Checking for ligature loops.
-We have programmed almost everything but the most interesting calculation of
-all, which has been saved for last as a special treat. \TeX's extended
-ligature mechanism allows unwary users to specify sequences of ligature
-replacements that never terminate. For example, the pair of commands
-$$\.{(/LIG $x$ $y$) (/LIG $y$ $x$)}$$
-alternately replaces character $x$ by character $y$ and vice versa. A similar
-loop occurs if \.{(LIG/ $z$ $y$)} occurs in the program for $x$ and
- \.{(LIG/ $z$ $x$)} occurs in the program for $y$.
-
-More complicated loops are also possible. For example, suppose the ligature
-programs for $x$ and $y$ are
-$$\vcenter{\halign{#\hfil\cr
-\.{(LABEL $x$)(/LIG/ $z$ $w$)(/LIG/> $w$ $y$)} \dots,\cr
-\.{(LABEL $y$)(LIG $w$ $x$)} \dots;\cr}}$$
-then the adjacent characters $xz$ change to $xwz$, $xywz$, $xxz$, $xxwz$,
-\dots, ad infinitum.
-
-@ To detect such loops, \.{TFtoPL} attempts to evaluate the function
-$f(x,y)$ for all character pairs $x$ and~$y$, where $f$ is defined as
-follows: If the current character is $x$ and the next character is
-$y$, we say the ``cursor'' is between $x$ and $y$; when the cursor
-first moves past $y$, the character immediately to its left is
-$f(x,y)$. This function is defined if and only if no infinite loop is
-generated when the cursor is between $x$ and~$y$.
-
-The function $f(x,y)$ can be defined recursively. It turns out that all pairs
-$(x,y)$ belong to one of five classes. The simplest class has $f(x,y)=y$;
-this happens if there's no ligature between $x$ and $y$, or in the cases
-\.{LIG/>} and \.{/LIG/>>}. Another simple class arises when there's a
-\.{LIG} or \.{/LIG>} between $x$ and~$y$, generating the character~$z$;
-then $f(x,y)=z$. Otherwise we always have $f(x,y)$ equal to
-either $f(x,z)$ or $f(z,y)$ or $f(f(x,z),y)$, where $z$ is the inserted
-ligature character.
-
-The first two of these classes can be merged; we can also consider
-$(x,y)$ to belong to the simple class when $f(x,y)$ has been evaluated.
-For technical reasons we allow $x$ to be 256 (for the boundary character
-at the left) or 257 (in cases when an error has been detected).
-
-For each pair $(x,y)$ having a ligature program step, we store
-$(x,y)$ in a hash table from which the values $z$ and $class$ can be read.
-
-@d simple=0 {$f(x,y)=z$}
-@d left_z=1 {$f(x,y)=f(z,y)$}
-@d right_z=2 {$f(x,y)=f(x,z)$}
-@d both_z=3 {$f(x,y)=f(f(x,z),y)$}
-@d pending=4 {$f(x,y)$ is being evaluated}
-
-@<Glob...@>=
-@!hash:array[0..hash_size] of integer;
-@!class:array[0..hash_size] of simple..pending;
-@!lig_z:array[0..hash_size] of xxchar_type;
-@!hash_ptr:0..hash_size; {the number of nonzero entries in |hash|}
-@!hash_list:array[0..hash_size] of 0..hash_size;
- {list of those nonzero entries}
-@!h,@!hh:0..hash_size; {indices into the hash table}
-@!x_lig_cycle,@!y_lig_cycle:integer; {problematic ligature pair}
-
-@ @<Check for ligature cycles@>=
-hash_ptr:=0; y_lig_cycle:=xmax_char;
-for hh:=0 to hash_size do hash[hh]:=0; {clear the hash table}
-for c:=bc to ec do if tag(c)=lig_tag then
- begin i:=rremainder(c);
- if (l_skip_byte(lig_step(i)) mod 256)>stop_flag then
- i:=256*l_op_byte(lig_step(i))+l_remainder(lig_step(i));
- @<Enter data for character $c$ starting at location |i| in the hash table@>;
- end;
-if bchar_label<nl then
- begin c:=xmax_char; i:=bchar_label;
- @<Enter data for character $c$ starting at location |i| in the hash table@>;
- end;
-if hash_ptr=hash_size then
- begin print_ln('Sorry, I haven''t room for so many ligature/kern pairs!');
-@.Sorry, I haven't room...@>
- goto final_end;
- end;
-for hh:=1 to hash_ptr do
- begin r:=hash_list[hh];
- if class[r]>simple then {make sure $f$ is defined}
- r:=f(r,(hash[r]-1)div xmax_char,(hash[r]-1)mod xmax_char);
- end;
-if y_lig_cycle<xmax_char then
- begin print('Infinite ligature loop starting with ');
-@.Infinite ligature loop...@>
- if x_lig_cycle=xmax_char
- then print('boundary')@+else print_hex(x_lig_cycle);
- print(' and '); print_hex(y_lig_cycle); print_ln('!');
- out('(INFINITE LIGATURE LOOP MUST BE BROKEN!)'); goto final_end;
- end
-
-@ @<Enter data for character $c$...@>=
-repeat hash_input; k:=l_skip_byte(lig_step(i));
-if k>=stop_flag then i:=nl
-else i:=i+1+k;
-until i>=nl
-
-@ We use an ``ordered hash table'' with linear probing, because such a table
-is efficient when the lookup of a random key tends to be unsuccessful.
-
-@p procedure hash_input; {enter data for character |c| and command |i|}
-label 30; {go here for a quick exit}
-var @!cc:simple..both_z; {class of data being entered}
-@!zz:char_type; {function value or ligature character being entered}
-@!y:char_type; {the character after the cursor}
-@!key:integer; {value to be stored in |hash|}
-@!t:integer; {temporary register for swapping}
-begin if hash_ptr=hash_size then goto 30;
-@<Compute the command parameters |y|, |cc|, and |zz|@>;
-key:=xmax_char*c+y+1; h:=(hash_mult*(key mod hash_size)) mod hash_size;
-while hash[h]>0 do
- begin if hash[h]<=key then
- begin if hash[h]=key then goto 30; {unused ligature command}
- t:=hash[h]; hash[h]:=key; key:=t; {do ordered-hash-table insertion}
- t:=class[h]; class[h]:=cc; cc:=t; {namely, do a swap}
- t:=lig_z[h]; lig_z[h]:=zz; zz:=t;
- end;
- if h>0 then decr(h)@+else h:=hash_size;
- end;
-hash[h]:=key; class[h]:=cc; lig_z[h]:=zz;
-incr(hash_ptr); hash_list[hash_ptr]:=h;
-30:end;
-
-@ We must store kern commands as well as ligature commands, because
-the former might make the latter inapplicable.
-
-@<Compute the command param...@>=
-k:=lig_step(i); y:=l_next_char(k); t:=l_op_byte(k);
-cc:=simple; zz:=l_remainder(k);
-if t>=kern_flag then zz:=y
-else begin case t of
- 0,6:do_nothing; {\.{LIG},\.{/LIG>}}
- 5,11:zz:=y; {\.{LIG/>}, \.{/LIG/>>}}
- 1,7:cc:=left_z; {\.{LIG/}, \.{/LIG/>}}
- 2:cc:=right_z; {\.{/LIG}}
- 3:cc:=both_z; {\.{/LIG/}}
- end; {there are no other cases}
- end
-
-@ Evaluation of $f(x,y)$ is handled by two mutually recursive procedures.
-Kind of a neat algorithm, generalizing a depth-first search.
-
-@p function f(@!h,@!x,@!y:index):index; forward;@t\2@>
- {compute $f$ for arguments known to be in |hash[h]|}
-function eval(@!x,@!y:index):index; {compute $f(x,y)$ with hashtable lookup}
-var @!key:integer; {value sought in hash table}
-begin key:=xmax_char*x+y+1; h:=(hash_mult*key) mod hash_size;
-while hash[h]>key do
- if h>0 then decr(h)@+else h:=hash_size;
-if hash[h]<key then eval:=y {not in ordered hash table}
-else eval:=f(h,x,y);
-end;
-
-@ Pascal's beastly convention for |forward| declarations prevents us from
-saying |function f(h,x,y:index):index| here.
-
-@p function f;
-begin case class[h] of
-simple: do_nothing;
-left_z: begin class[h]:=pending; lig_z[h]:=eval(lig_z[h],y); class[h]:=simple;
- end;
-right_z: begin class[h]:=pending; lig_z[h]:=eval(x,lig_z[h]); class[h]:=simple;
- end;
-both_z: begin class[h]:=pending; lig_z[h]:=eval(eval(x,lig_z[h]),y);
- class[h]:=simple;
- end;
-pending: begin x_lig_cycle:=x; y_lig_cycle:=y;
- lig_z[h]:=xxmax_char; class[h]:=simple;
- end; {the value |xxmax_char| will break all cycles,
- since it's not in |hash|}
-end; {there are no other cases}
-f:=lig_z[h];
-end;
-
-@* The main program.
-The routines sketched out so far need to be packaged into separate procedures,
-on some systems, since some \PASCAL\ compilers place a strict limit on the
-size of a routine. The packaging is done here in an attempt to avoid some
-system-dependent changes.
-
-First comes the |organize| procedure, which reads the input data and
-gets ready for subsequent events. If something goes wrong, the routine
-returns |false|.
-
-@p function organize:boolean;
-label final_end, 30;
-var tfm_ptr:index; {an index into |tfm|}
-begin @<Read the whole input file@>;@/
-@<Set subfile sizes |lh|, |bc|, \dots, |np|@>;@/
-@<Compute the base addresses@>;@/
-organize:=true; goto 30;
-final_end: organize:=false;
-30: end;
-
-@ Next we do the simple things.
-
-@p procedure do_simple_things;
-var i:integer; {an index to words of a subfile}
-begin @<Do the header@>;@/
-@<Do the parameters@>;@/
-@<Do the ivalue parameters@>;@/
-@<Do the fvalue parameters@>;@/
-@<Do the mvalue parameters@>;@/
-@<Do the rule parameters@>;@/
-@<Do the glue parameters@>;@/
-@<Do the penalty parameters@>;@/
-@<Check the |fix_word| entries@>@/
-end;
-
-@ And then there's a routine for individual characters.
-
-@p procedure do_characters;
-var @!c:integer; {character being done}
-@!k:index; {a random index}
-@!ai:0..lig_size; {index into |activity|}
-begin @<Do the characters@>;@/
-end;
-
-@ Here is where \.{TFtoPL} begins and ends.
-@p begin initialize;@/
-if not organize then goto final_end;
-do_simple_things;@/
-@<Do the ligatures and kerns@>;
-@<Check the extensible recipes@>;
-do_characters; print_ln('.');@/
-if level<>0 then print_ln('This program isn''t working!');
-@.This program isn't working@>
-if not perfect then
- out('(COMMENT THE OFM FILE WAS BAD, SO THE DATA HAS BEEN CHANGED!)');
-@.THE OFM FILE WAS BAD...@>
-final_end:end.
-
-@* System-dependent changes.
-This section should be replaced, if necessary, by changes to the program
-that are necessary to make \.{TFtoPL} work at a particular installation.
-It is usually best to design your change file so that all changes to
-previous sections preserve the section numbering; then everybody's version
-will be consistent with the printed program. More extensive changes,
-which introduce new sections, can be inserted here; then only the index
-itself will get a new section number.
-@^system dependencies@>
-
-@* Index.
-Pointers to error messages appear here together with the section numbers
-where each ident\-i\-fier is used.
diff --git a/Build/source/texk/web2c/omegaware/opl2ofm.ch b/Build/source/texk/web2c/omegaware/opl2ofm.ch
deleted file mode 100644
index d4b4b372b14..00000000000
--- a/Build/source/texk/web2c/omegaware/opl2ofm.ch
+++ /dev/null
@@ -1,337 +0,0 @@
-%
-% This file is part of the Omega project, which
-% is based in the web2c distribution of TeX.
-%
-% Copyright (c) 1994--1998 John Plaice and Yannis Haralambous
-% applies only to the changes to the original pltotf.ch.
-%
-% pltotf.ch for C compilation with web2c.
-%
-% 04/04/83 (PC) Original version, made to work with version 1.2 of PLtoTF.
-% 04/16/83 (PC) Brought up to version 1.3 of PLtoTF.
-% 06/30/83 (HWT) Revised changefile format for version 1.7 Tangle
-% 07/28/83 (HWT) Brought up to version 2
-% 12/19/86 (ETM) Brought up to version 2.1
-% 07/05/87 (ETM) Brought up to version 2.3
-% 03/22/88 (ETM) Converted for use with WEB to C
-% 11/29/89 (KB) Version 3.
-% 01/16/90 (SR) Version 3.2.
-% (more recent changes in the ChangeLog)
-
-@x [0] WEAVE: print changes only.
-\pageno=\contentspagenumber \advance\pageno by 1
-@y
-\pageno=\contentspagenumber \advance\pageno by 1
-%\let\maybe=\iffalse
-%\def\title{OPL2OFM changes for C}
-@z
-
-@x [still 2] No banner unless verbose.
-procedure initialize; {this procedure gets things started properly}
- var @<Local variables for initialization@>@/
- begin print_ln(banner);@/
-@y
-@<Define |parse_arguments|@>
-procedure initialize; {this procedure gets things started properly}
- var @<Local variables for initialization@>@/
-begin
- kpse_set_progname (argv[0]);
- parse_arguments;
-@z
-
-@x [3] Larger constants.
-@!buf_size=60; {length of lines displayed in error messages}
-@y
-@!buf_size=3000; {max input line length, output error line length}
-@z
-%@x
-%@!max_lig_steps=5000;
-% {maximum length of ligature program, must be at most $32767-257=32510$}
-%@!max_kerns=500; {the maximum number of distinct kern values}
-%@!hash_size=5003; {preferably a prime number, a bit larger than the number
-% of character pairs in lig/kern steps}
-%@y
-%@!max_lig_steps=32500;
-% {maximum length of ligature program, must be at most $32767-257=32510$}
-%@!max_kerns=15000; {the maximum number of distinct kern values}
-%@!hash_size=15077; {preferably a prime number, a bit larger than the number
-% of character pairs in lig/kern steps}
-%@z
-
-@x [6] Open PL file.
-reset(pl_file);
-@y
-reset (pl_file, pl_name);
-if verbose then begin
- print (banner);
- print_ln (version_string);
-end;
-@z
-
-@x [16] Open TFM file.
-@ On some systems you may have to do something special to write a
-packed file of bytes. For example, the following code didn't work
-when it was first tried at Stanford, because packed files have to be
-opened with a special switch setting on the \PASCAL\ that was used.
-@^system dependencies@>
-
-@<Set init...@>=
-rewrite(tfm_file);
-@y
-@ On some systems you may have to do something special to write a
-packed file of bytes. It's no problem in C.
-@^system dependencies@>
-
-@<Set init...@>=
-rewritebin (tfm_file, tfm_name);
-@z
-
-@x [79] `index' might be a library routine.
-|k|th element of its list.
-@y
-|k|th element of its list.
-@d index == index_var
-@z
-
-@x [103] No output (except errors) unless verbose.
-@<Print |c| in hex notation@>;
-@y
-if verbose then @<Print |c| in hex notation@>;
-@z
-
-% [27, 28] Change strings to C char pointers. The Pascal strings are
-% indexed starting at 1, so we pad with a blank.
-@x
-@!ASCII_04,@!ASCII_10,@!ASCII_14,HEX: packed array [1..32] of char;
- {strings for output in the user's external character set}
-@!MBL_string,@!RI_string,@!RCE_string:packed array [1..3] of char;
- {handy string constants for |face| codes}
-@y
-@!ASCII_04,@!ASCII_10,@!ASCII_14,HEX: c_string;
- {strings for output in the user's external character set}
-@!ASCII_all: packed array[0..256] of char;
-@!MBL_string,@!RI_string,@!RCE_string: c_string;
- {handy string constants for |face| codes}
-@z
-
-@x
-ASCII_04:=' !"#$%&''()*+,-./0123456789:;<=>?';@/
-ASCII_10:='@@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_';@/
-ASCII_14:='`abcdefghijklmnopqrstuvwxyz{|}~ ';@/
-HEX:='0123456789ABCDEF';@/
-MBL_string:='MBL'; RI_string:='RI '; RCE_string:='RCE';
-@y
-ASCII_04:=' !"#$%&''()*+,-./0123456789:;<=>?';@/
-ASCII_10:=' @@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_';@/
-ASCII_14:=' `abcdefghijklmnopqrstuvwxyz{|}~ ';@/
-HEX:=' 0123456789ABCDEF';@/
-strcpy (ASCII_all, ASCII_04);
-strcat (ASCII_all, '@@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_');
-strcat (ASCII_all, '`abcdefghijklmnopqrstuvwxyz{|}~');@/
-MBL_string:=' MBL'; RI_string:=' RI '; RCE_string:=' RCE';
-@z
-
-@x [115] Output of reals.
-@ @d round_message(#)==if delta>0 then print_ln('I had to round some ',
-@.I had to round...@>
- #,'s by ',(((delta+1) div 2)/@'4000000):1:7,' units.')
-@y
-@ @d round_message(#)==if delta>0 then begin print('I had to round some ',
-@.I had to round...@>
- #,'s by '); print_real((((delta+1) div 2)/@'4000000),1,7);
- print_ln(' units.'); end
-@z
-
-% [118] Change the name of the variable `class', since AIX 3.1's <math.h>
-% defines a function by that name.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-@x
-@d pending=4 {$f(x,y)$ is being evaluated}
-@y
-@d pending=4 {$f(x,y)$ is being evaluated}
-@d class == class_var {Avoid problems with AIX \.{<math.h>}}
-@z
-
-% [123] web2c can't handle these mutually recursive procedures.
-% But let's do a fake definition of f here, so that it gets into web2c's
-% symbol table...
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-@x
-@p function f(@!h,@!x,@!y:indx):indx; forward;@t\2@>
- {compute $f$ for arguments known to be in |hash[h]|}
-@y
-@p
-ifdef('notdef')
-function f(@!h,@!x,@!y:indx):indx; begin end;@t\2@>
- {compute $f$ for arguments known to be in |hash[h]|}
-endif('notdef')
-@z
-
-% [124] ... and then really define it now.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-@x
-@p function f;
-@y
-@p function f(@!h,@!x,@!y:indx):indx;
-@z
-
-@x [127] Fix up output of bytes.
-@d out(#)==write(tfm_file,#)
-@y
-@d out(#)==putbyte(#,tfm_file)
-@z
-
-@x [136] Fix output of reals.
-@p procedure out_scaled(x:fix_word); {outputs a scaled |fix_word|}
-var @!n:byte; {the first byte after the sign}
-@!m:0..65535; {the two least significant bytes}
-begin if abs(x/design_units)>=16.0 then begin
- print_ln('The relative dimension ',x/@'4000000:1:3,
- ' is too large.');
-@.The relative dimension...@>
- print(' (Must be less than 16*designsize');
- if design_units<>unity then print(' =',design_units/@'200000:1:3,
- ' designunits');
-@y
-@p procedure out_scaled(x:fix_word); {outputs a scaled |fix_word|}
-var @!n:byte; {the first byte after the sign}
-@!m:0..65535; {the two least significant bytes}
-begin if fabs(x/design_units)>=16.0 then begin
- print('The relative dimension ');
- print_real(x/@'4000000,1,3);
- print_ln(' is too large.');
-@.The relative dimension...@>
- print(' (Must be less than 16*designsize');
- if design_units<>unity then begin print(' =');
- print_real(design_units/@'200000,1,3);
- print(' designunits');
- end;
-@z
-
-% [141] char_remainder[c] is unsigned, and label_table[sort_ptr].rr
-% might be -1, and if -1 is coerced to being unsigned, it will be bigger
-% than anything else.
-@x
- while label_table[sort_ptr].rr>char_remainder[c] do begin
-@y
- while label_table[sort_ptr].rr>intcast(char_remainder[c]) do begin
-@z
-
-@x [147] Be quiet unless verbose.
-read_input; print('.');@/
-@y
-read_input;
-if verbose then print_ln('.');
-@z
-
-@x [148] System-dependent changes.
-This section should be replaced, if necessary, by changes to the program
-that are necessary to make \.{PLtoTF} work at a particular installation.
-It is usually best to design your change file so that all changes to
-previous sections preserve the section numbering; then everybody's version
-will be consistent with the printed program. More extensive changes,
-which introduce new sections, can be inserted here; then only the index
-itself will get a new section number.
-@^system dependencies@>
-@y
-Parse a Unix-style command line.
-
-@d argument_is (#) == (strcmp (long_options[option_index].name, #) = 0)
-
-@<Define |parse_arguments|@> =
-procedure parse_arguments;
-const n_options = 3; {Pascal won't count array lengths for us.}
-var @!long_options: array[0..n_options] of getopt_struct;
- @!getopt_return_val: integer;
- @!option_index: c_int_type;
- @!current_option: 0..n_options;
-begin
- @<Initialize the option variables@>;
- @<Define the option table@>;
- repeat
- getopt_return_val := getopt_long_only (argc, argv, '', long_options,
- address_of (option_index));
- if getopt_return_val = -1 then begin
- {End of arguments; we exit the loop below.} ;
-
- end else if getopt_return_val = "?" then begin
- usage ('opl2ofm');
-
- end else if argument_is ('help') then begin
- usage_help (OPL2OFM_HELP, nil);
-
- end else if argument_is ('version') then begin
- print_version_and_exit
- (banner, nil, 'J. Plaice, Y. Haralambous, D.E. Knuth', nil);
-
- end; {Else it was a flag; |getopt| has already done the assignment.}
- until getopt_return_val = -1;
-
- {Now |optind| is the index of first non-option on the command line.
- We must have one or two remaining arguments.}
- if (optind + 1 <> argc) and (optind + 2 <> argc) then begin
- write_ln (stderr, 'opl2ofm: Need one or two file arguments.');
- usage ('opl2ofm');
- end;
-
- pl_name := extend_filename (cmdline (optind), 'opl');
-
- {If an explicit output filename isn't given, construct it from |pl_name|.}
- if optind + 2 = argc then begin
- tfm_name := extend_filename (cmdline (optind + 1), 'ofm');
- end else begin
- tfm_name := basename_change_suffix (pl_name, '.opl', '.ofm');
- end;
-end;
-
-@ Here are the options we allow. The first is one of the standard GNU options.
-@.-help@>
-
-@<Define the option...@> =
-current_option := 0;
-long_options[current_option].name := 'help';
-long_options[current_option].has_arg := 0;
-long_options[current_option].flag := 0;
-long_options[current_option].val := 0;
-incr (current_option);
-
-@ Another of the standard options.
-@.-version@>
-
-@<Define the option...@> =
-long_options[current_option].name := 'version';
-long_options[current_option].has_arg := 0;
-long_options[current_option].flag := 0;
-long_options[current_option].val := 0;
-incr (current_option);
-
-@ Print progress information?
-
-@<Define the option...@> =
-long_options[current_option].name := 'verbose';
-long_options[current_option].has_arg := 0;
-long_options[current_option].flag := address_of (verbose);
-long_options[current_option].val := 1;
-incr (current_option);
-
-@
-@<Glob...@> =
-@!verbose: c_int_type;
-
-@
-@<Initialize the option...@> =
-verbose := false;
-
-@ An element with all zeros always ends the list.
-
-@<Define the option...@> =
-long_options[current_option].name := 0;
-long_options[current_option].has_arg := 0;
-long_options[current_option].flag := 0;
-long_options[current_option].val := 0;
-
-@ Global filenames.
-
-@<Global...@> =
-@!tfm_name,@!pl_name:c_string;
-@z
diff --git a/Build/source/texk/web2c/omegaware/opl2ofm.web b/Build/source/texk/web2c/omegaware/opl2ofm.web
deleted file mode 100644
index df91a25dfee..00000000000
--- a/Build/source/texk/web2c/omegaware/opl2ofm.web
+++ /dev/null
@@ -1,4363 +0,0 @@
-%
-% This file is part of the Omega project, which
-% is based in the web2c distribution of TeX.
-%
-% Copyright (c) 1994--2000 John Plaice and Yannis Haralambous
-% applies only to the changes to the original pltotf.web
-%
-% This program by D. E. Knuth is not copyrighted and can be used freely.
-% Version 0 was implemented in January 1982.
-% In February 1982 a new restriction on ligature steps was added.
-% In June 1982 the routines were divided into smaller pieces for IBM people.
-% Hex was added in September 1982, and the result became "Version 1".
-% Version 1.1 fixed a bug in section 28 (since eoln is undefined after eof).
-% Slight changes were made in October, 1982, for version 0.6 of TeX.
-% Version 1.2 fixed a bug in section 115 (TOP, MID, and BOT can be zero)
-% Version 1.3 (April 1983) blanked out unused BCPL header bytes
-% Version 2 (July 1983) was released with TeX version 0.999.
-% Version 2.1 (September 1983) changed TEXINFO to FONTDIMEN.
-% Version 2.2 (May 1985) added checksum computation to match METAFONT.
-% Version 2.3 (August 1985) introduced `backup' to fix a minor bug.
-% Version 3 (October 1989) introduced extended ligature features.
-% Version 3.1 (November 1989) fixed two bugs (notably min_nl:=0).
-% Version 3.2 (December 1989) improved `shorten', increased max_letters.
-% Version 3.3 (September 1990) fixed `nonexistent char 0' (John Gourlay).
-% Version 3.4 (March 1991) has more robust `out_scaled' (Wayne Sullivan).
-% Version 3.5 (March 1995) initialized lk_step_ended (Armin K\"ollner).
-
-% Version 1.0 of OPL2OFM (March 1997) allows one to read OPL files
-% and generate OFM files.
-
-% Here is TeX material that gets inserted after \input webmac
-\def\hang{\hangindent 3em\indent\ignorespaces}
-\font\ninerm=cmr9
-\let\mc=\ninerm % medium caps for names like SAIL
-\def\PASCAL{Pascal}
-\font\logo=logo10 % for the METAFONT logo
-\def\MF{{\logo METAFONT}}
-
-\def\(#1){} % this is used to make section names sort themselves better
-\def\9#1{} % this is used for sort keys in the index
-
-\def\title{OPL2OFM}
-\def\contentspagenumber{301}
-\def\topofcontents{\null
- \def\titlepage{F} % include headline on the contents page
- \def\rheader{\mainfont\hfil \contentspagenumber}
- \vfill
- \centerline{\titlefont The {\ttitlefont OPL2OFM} processor}
- \vskip 15pt
- \centerline{(Version 1.11, February 2000)}
- \vfill}
-\def\botofcontents{\vfill
- \centerline{\hsize 5in\baselineskip9pt
- \vbox{\ninerm\noindent
- The preparation of the original report
- was supported in part by the National Science
- Foundation under grants IST-8201926 and MCS-8300984,
- and by the System Development Foundation. `\TeX' is a
- trademark of the American Mathematical Society.}}}
-\pageno=\contentspagenumber \advance\pageno by 1
-
-@* Introduction.
-The \.{OPL2OFM} utility program converts property-list (``\.{PL}''
-and (``\.{OPL}'') files into equivalent \TeX\ and $\Omega$ font metric
-(``\.{TFM}'' and ``\.{OFM}) files. It also makes a thorough check of
-the given \.{PL} or \.{OPL} file, so that the \.{TFM} or \.{OFM} file
-should be acceptable to \TeX\ or $\Omega$.
-
-The first \.{PLtoTF} program was designed by Leo Guibas in the summer of
-1978. Contributions by Frank Liang, Doug Wyatt, and Lyle Ramshaw
-also had a significant effect on the evolution of the present code.
-
-Extensions for an enhanced ligature mechanism were added by D. E. Knuth
-in 1989.
-
-Extensions to handle extended font metric files (``\.{OFM}'') were
-added by John Plaice in December 1995 and January 1996, resulting in the
-new program \.{OPLtoOFM}. In the following documentation, all unchanged
-references to the \.{PLtoTF} program and to \.{TFM} and \.{PL} files also
-apply to the \.{OPLtoOFM} program and to \.{OFM} and \.{OPL} files.
-
-The |banner| string defined here should be changed whenever \.{OPLtoOFM}
-gets modified.
-
-@d banner=='This is OPL2OFM, Version 1.11'
-
-@ This program is written entirely in standard \PASCAL, except that
-it has to do some slightly system-dependent character code conversion
-on input. Furthermore, lower case letters are used in error messages;
-they could be converted to upper case if necessary. The input is read
-from |pl_file|, and the output is written on |tfm_file|; error messages and
-other remarks are written on the |output| file, which the user may
-choose to assign to the terminal if the system permits it.
-@^system dependencies@>
-
-The term |print| is used instead of |write| when this program writes on
-the |output| file, so that all such output can be easily deflected.
-
-@d print(#)==write(#)
-@d print_ln(#)==write_ln(#)
-
-@p program OPL2OFM(@!pl_file,@!tfm_file,@!output);
-const @<Constants in the outer block@>@/
-type @<Types in the outer block@>@/
-var @<Globals in the outer block@>@/
-procedure initialize; {this procedure gets things started properly}
- var @<Local variables for initialization@>@/
- begin print_ln(banner);@/
- @<Set initial values@>@/
- end;
-
-@ The following parameters can be changed at compile time to extend or
-reduce \.{PLtoTF}'s capacity.
-
-@<Constants...@>=
-@!buf_size=60; {length of lines displayed in error messages}
-@!max_header_bytes=100; {four times the maximum number of words allowed in
- the \.{TFM} file header block, must be 1024 or less}
-@!max_param_words=100; {the maximum number of \.{fontdimen} parameters allowed}
-@!max_lig_steps=800000;
- {maximum length of ligature program, must be at most $32767-257=32510$}
-@!xmax_label=800001;
-@!max_kerns=50000; {the maximum number of distinct kern values}
-@!hash_size=130003; {preferably a prime number, a bit larger than the number
- of character pairs in lig/kern steps}
-@!hash_mult=16007; {another prime}
-@!tfm_size=2000000; {maximum length of |tfm| data, in bytes}
-@!lig_size=800000; {maximum length of |lig_kern| program, in words}
-@!max_char=65535; {the largest character number in a font}
-@!xmax_char=65536; {|max_char|+1}
-@!xxmax_char=65537;{|max_char|+2}
-@!xxxmax_char=65538;{|max_char|+3}
-@!mem_size=262144; {|max_char|*4+8}
-@!max_width=65535; {the largest character width number}
-@!max_height=255; {the largest character height number}
-@!max_depth=255; {the largest character depth number}
-@!max_italic=255; {the largest character italic correction number}
-
-@ Here are some macros for common programming idioms.
-
-@d incr(#) == #:=#+1 {increase a variable by unity}
-@d decr(#) == #:=#-1 {decrease a variable by unity}
-@d do_nothing == {empty statement}
-
-@* Property list description of font metric data.
-The idea behind \.{PL} files is that precise details about fonts, i.e., the
-facts that are needed by typesetting routines like \TeX, sometimes have to
-be supplied by hand. The nested property-list format provides a reasonably
-convenient way to do this.
-
-A good deal of computation is necessary to parse and process a
-\.{PL} file, so it would be inappropriate for \TeX\ itself to do this
-every time it loads a font. \TeX\ deals only with the compact descriptions
-of font metric data that appear in \.{TFM} files. Such data is so compact,
-however, it is almost impossible for anybody but a computer to read it.
-The purpose of \.{PLtoTF} is to convert from a human-oriented file of text
-to a computer-oriented file of binary numbers.
-
-@<Glob...@>=
-@!pl_file:text;
-
-@ @<Set init...@>=
-reset(pl_file);
-
-@ A \.{PL} file is a list of entries of the form
-$$\.{(PROPERTYNAME VALUE)}$$
-where the property name is one of a finite set of names understood by
-this program, and the value may itself in turn be a property list.
-The idea is best understood by looking at an example, so let's consider
-a fragment of the \.{PL} file for a hypothetical font.
-$$\vbox{\halign{\.{#}\hfil\cr
-(FAMILY NOVA)\cr
-(FACE F MIE)\cr
-(CODINGSCHEME ASCII)\cr
-(DESIGNSIZE D 10)\cr
-(DESIGNUNITS D 18)\cr
-(COMMENT A COMMENT IS IGNORED)\cr
-(COMMENT (EXCEPT THIS ONE ISN'T))\cr
-(COMMENT (ACTUALLY IT IS, EVEN THOUGH\cr
-\qquad\qquad IT SAYS IT ISN'T))\cr
-(FONTDIMEN\cr
-\qquad (SLANT R -.25)\cr
-\qquad (SPACE D 6)\cr
-\qquad (SHRINK D 2)\cr
-\qquad (STRETCH D 3)\cr
-\qquad (XHEIGHT R 10.55)\cr
-\qquad (QUAD D 18)\cr
-\qquad )\cr
-(LIGTABLE\cr
-\qquad (LABEL C f)\cr
-\qquad (LIG C f O 200)\cr
-\qquad (SKIP D 1)\cr
-\qquad (LABEL O 200)\cr
-\qquad (LIG C i O 201)\cr
-\qquad (KRN O 51 R 1.5)\cr
-\qquad (/LIG C ? C f)\cr
-\qquad (STOP)\cr
-\qquad )\cr
-(CHARACTER C f\cr
-\qquad (CHARWD D 6)\cr
-\qquad (CHARHT R 13.5)\cr
-\qquad (CHARIC R 1.5)\cr
-\qquad )\cr}}$$
-This example says that the font whose metric information is being described
-belongs to the hypothetical
-\.{NOVA} family; its face code is medium italic extended;
-and the characters appear in ASCII code positions. The design size is 10 points,
-and all other sizes in this \.{PL} file are given in units such that 18 units
-equals the design size. The font is slanted with a slope of $-.25$ (hence the
-letters actually slant backward---perhaps that is why the family name is
-\.{NOVA}). The normal space between words is 6 units (i.e., one third of
-the 18-unit design size), with glue that shrinks by 2 units or stretches by 3.
-The letters for which accents don't need to be raised or lowered are 10.55
-units high, and one em equals 18 units.
-
-The example ligature table is a bit trickier. It specifies that the
-letter \.f followed by another \.f is changed to code @'200, while
-code @'200 followed by \.i is changed to @'201; presumably codes @'200
-and @'201 represent the ligatures `ff' and `ffi'. Moreover, in both cases
-\.f and @'200, if the following character is the code @'51 (which is a
-right parenthesis), an additional 1.5 units of space should be inserted
-before the @'51. (The `\.{SKIP}~\.D~\.1' skips over one \.{LIG} or
-\.{KRN} command, which in this case is the second \.{LIG}; in this way
-two different ligature/kern programs can come together.)
-Finally, if either \.f or @'200 is followed by a question mark,
-the question mark is replaced by \.f and the ligature program is
-started over. (Thus, the character pair `\.{f?}' would actually become
-the ligature `ff', and `\.{ff?}' or `\.{f?f}' would become `fff'. To
-avoid this restart procedure, the \.{/LIG} command could be replaced
-by \.{/LIG>}; then `\.{f?} would become `f\kern0ptf' and `\.{f?f}'
-would become `f\kern0ptff'.)
-
-Character \.f itself is 6 units wide and 13.5 units tall, in this example.
-Its depth is zero (since \.{CHARDP} is not given), and its italic correction
-is 1.5 units.
-
-@ The example above illustrates most of the features found in \.{PL} files.
-Note that some property names, like \.{FAMILY} or \.{COMMENT}, take a
-string as their value; this string continues until the first unmatched
-right parenthesis. But most property names, like \.{DESIGNSIZE} and \.{SLANT}
-and \.{LABEL}, take a number as their value. This number can be expressed in
-a variety of ways, indicated by a prefixed code; \.D stands for decimal,
-\.H for hexadecimal, \.O for octal, \.R for real, \.C for character, and
-\.F for ``face.'' Other property names, like \.{LIG}, take two numbers as
-their value. And still other names, like \.{FONTDIMEN} and \.{LIGTABLE} and
-\.{CHARACTER}, have more complicated values that involve property lists.
-
-A property name is supposed to be used only in an appropriate property
-list. For example, \.{CHARWD} shouldn't occur on the outer level or
-within \.{FONTDIMEN}.
-
-The individual property-and-value pairs in a property list can appear in
-any order. For instance, `\.{SHRINK}' precedes `\.{STRETCH}' in the above
-example, although the \.{TFM} file always puts the stretch parameter first.
-One could even give the information about characters like `\.f' before
-specifying the number of units in the design size, or before specifying the
-ligature and kerning table. However, the \.{LIGTABLE} itself is an exception
-to this rule; the individual elements of the \.{LIGTABLE} property list
-can be reordered only to a certain extent without changing the meaning
-of that table.
-
-If property-and-value pairs are omitted, a default value is used. For example,
-we have already noted that the default for \.{CHARDP} is zero. The default
-for {\sl every\/} numeric value is, in fact, zero, unless otherwise stated
-below.
-
-If the same property name is used more than once, \.{PLtoTF} will not notice
-the discrepancy; it simply uses the final value given. Once again, however, the
-\.{LIGTABLE} is an exception to this rule; \.{PLtoTF} will complain if there
-is more than one label for some character. And of course many of the
-entries in the \.{LIGTABLE} property list have the same property name.
-
-From these rules, you can guess (correctly) that \.{PLtoTF} operates in four
-main steps. First it assigns the default values to all properties; then it scans
-through the \.{PL} file, changing property values as new ones are seen; then
-it checks the information and corrects any problems; and finally it outputs
-the \.{TFM} file.
-
-@ Instead of relying on a hypothetical example, let's consider a complete
-grammar for \.{PL} files. At the outer level, the following property names
-are valid:
-
-\yskip\hang\.{CHECKSUM} (four-byte value). The value, which should be a
-nonnegative integer less than $2^{32}$, is used to identify a particular
-version of a font; it should match the check sum value stored with the font
-itself. An explicit check sum of zero is used to bypass
-check sum testing. If no checksum is specified in the \.{PL} file,
-\.{PLtoTF} will compute the checksum that \MF\ would compute from the
-same data.
-
-\yskip\hang\.{DESIGNSIZE} (numeric value, default is 10). The value, which
-should be a real number in the range |1.0<=x<2048|, represents the default
-amount by which all quantities will be scaled if the font is not loaded
-with an `\.{at}' specification. For example, if one says
-`\.{\\font\\A=cmr10 at 15pt}' in \TeX\ language, the design size in the \.{TFM}
-file is ignored and effectively replaced by 15 points; but if one simply
-says `\.{\\font\\A=cmr10}' the stated design size is used. This quantity is
-always in units of printer's points.
-
-\yskip\hang\.{DESIGNUNITS} (numeric value, default is 1). The value
-should be a positive real number; it says how many units equals the design
-size (or the eventual `\.{at}' size, if the font is being scaled). For
-example, suppose you have a font that has been digitized with 600 pixels per
-em, and the design size is one em; then you could say `\.{(DESIGNUNITS R 600)}'
-if you wanted to give all of your measurements in units of pixels.
-
-\yskip\hang\.{CODINGSCHEME} (string value, default is `\.{UNSPECIFIED}').
-The string should not contain parentheses, and its length must be less than 40.
-It identifies the correspondence between the numeric codes and font characters.
-(\TeX\ ignores this information, but other software programs make use of it.)
-
-\yskip\hang\.{FAMILY} (string value, default is `\.{UNSPECIFIED}').
-The string should not contain parentheses, and its length must be less than 20.
-It identifies the name of the family to which this font belongs, e.g.,
-`\.{HELVETICA}'. (\TeX\ ignores this information; but it is needed, for
-example, when converting \.{DVI} files to \.{PRESS} files for Xerox
-equipment.)
-
-\yskip\hang\.{FACE} (one-byte value). This number, which must lie between
-0 and 255 inclusive, is a subsidiary ident\-ifi\-ca\-tion of the font within its
-family. For example, bold italic condensed fonts might have the same family name
-as light roman extended fonts, differing only in their face byte. (\TeX\
-ignores this information; but it is needed, for example, when converting
-\.{DVI} files to \.{PRESS} files for Xerox equipment.)
-
-\yskip\hang\.{SEVENBITSAFEFLAG} (string value, default is `\.{FALSE}'). The
-value should start with either `\.T' (true) or `\.F' (false). If true, character
-codes less than 128 cannot lead to codes of 128 or more via ligatures or
-charlists or extensible characters. (\TeX82 ignores this flag, but older
-versions of \TeX\ would only accept \.{TFM} files that were seven-bit safe.)
-\.{PLtoTF} computes the correct value of this flag and gives an error message
-only if a claimed ``true'' value is incorrect.
-
-\yskip\hang\.{HEADER} (a one-byte value followed by a four-byte value).
-The one-byte value should be between 18 and a maximum limit that can be
-raised or lowered depending on the compile-time setting of |max_header_bytes|.
-The four-byte value goes into the header word whose index is the one-byte
-value; for example, to set |header[18]:=1|, one may write
-`\.{(HEADER D 18 O 1)}'. This notation is used for header information that
-is presently unnamed. (\TeX\ ignores it.)
-
-\yskip\hang\.{FONTDIMEN} (property list value). See below for the names
-allowed in this property list.
-
-\yskip\hang\.{LIGTABLE} (property list value). See below for the rules
-about this special kind of property list.
-
-\yskip\hang\.{BOUNDARYCHAR} (integer value). If this character appears in
-a \.{LIGTABLE} command, it matches ``end of word'' as well as itself.
-If no boundary character is given and no \.{LABEL} \.{BOUNDARYCHAR} occurs
-within \.{LIGTABLE}, word boundaries will not affect ligatures or kerning.
-
-\yskip\hang\.{CHARACTER}. The value is an integer followed by
-a property list. The integer represents the number of a character that is
-present in the font; the property list of a character is defined below.
-The default is an empty property list.
-
-@ Numeric property list values can be given in various forms identified by
-a prefixed letter.
-
-\yskip\hang\.C denotes an ASCII character, which should be a standard visible
-character that is not a parenthesis. The numeric value will therefore be
-between @'41 and @'176 but not @'50 or @'51.
-
-\yskip\hang\.D denotes a decimal integer, which must be nonnegative and
-less than 256. (Use \.R for larger values or for negative values.)
-
-\yskip\hang\.F denotes a three-letter Xerox face code; the admissible codes
-are \.{MRR}, \.{MIR}, \.{BRR}, \.{BIR}, \.{LRR}, \.{LIR}, \.{MRC}, \.{MIC},
-\.{BRC}, \.{BIC}, \.{LRC}, \.{LIC}, \.{MRE}, \.{MIE}, \.{BRE}, \.{BIE},
-\.{LRE}, and \.{LIE}, denoting the integers 0 to 17, respectively.
-
-\yskip\hang\.O denotes an unsigned octal integer, which must be less than
-$2^{32}$, i.e., at most `\.{O 37777777777}'.
-
-\yskip\hang\.H denotes an unsigned hexadecimal integer, which must be less than
-$2^{32}$, i.e., at most `\.{H FFFFFFFF}'.
-
-\yskip\hang\.R denotes a real number in decimal notation, optionally preceded
-by a `\.+' or `\.-' sign, and optionally including a decimal point. The
-absolute value must be less than 2048.
-
-@ The property names allowed in a \.{FONTDIMEN} property list correspond to
-various \TeX\ parameters, each of which has a (real) numeric value. All
-of the parameters except \.{SLANT} are in design units. The admissible
-names are \.{SLANT}, \.{SPACE}, \.{STRETCH}, \.{SHRINK}, \.{XHEIGHT},
-\.{QUAD}, \.{EXTRASPACE}, \.{NUM1}, \.{NUM2}, \.{NUM3}, \.{DENOM1},
-\.{DENOM2}, \.{SUP1}, \.{SUP2}, \.{SUP3}, \.{SUB1}, \.{SUB2}, \.{SUPDROP},
-\.{SUBDROP}, \.{DELIM1}, \.{DELIM2}, and \.{AXISHEIGHT}, for parameters
-1~to~22. The alternate names \.{DEFAULTRULETHICKNESS},
-\.{BIGOPSPACING1}, \.{BIGOPSPACING2}, \.{BIGOPSPACING3},
-\.{BIGOPSPACING4}, and \.{BIGOPSPACING5}, may also be used for parameters
-8 to 13.
-
-The notation `\.{PARAMETER} $n$' provides another way to specify the
-$n$th parameter; for example, `\.{(PARAMETER} \.{D 1 R -.25)}' is another way
-to specify that the \.{SLANT} is $-0.25$. The value of $n$ must be positive
-and less than |max_param_words|.
-
-@ The elements of a \.{CHARACTER} property list can be of six different types.
-
-\yskip\hang\.{CHARWD} (real value) denotes the character's width in
-design units.
-
-\yskip\hang\.{CHARHT} (real value) denotes the character's height in
-design units.
-
-\yskip\hang\.{CHARDP} (real value) denotes the character's depth in
-design units.
-
-\yskip\hang\.{CHARIC} (real value) denotes the character's italic correction in
-design units.
-
-\yskip\hang\.{NEXTLARGER} (integer value), specifies the character that
-follows the present one in a ``charlist.'' The value must be the number of a
-character in the font, and there must be no infinite cycles of supposedly
-larger and larger characters.
-
-\yskip\hang\.{VARCHAR} (property list value), specifies an extensible character.
-This option and \.{NEXTLARGER} are mutually exclusive; i.e., they cannot
-both be used within the same \.{CHARACTER} list.
-
-\yskip\noindent
-The elements of a \.{VARCHAR} property list are either \.{TOP}, \.{MID},
-\.{BOT} or \.{REP}; the values are integers, which must be zero or the number
-of a character in the font. A zero value for \.{TOP}, \.{MID}, or \.{BOT} means
-that the corresponding piece of the extensible character is absent. A nonzero
-value, or a \.{REP} value of zero, denotes the character code used to make
-up the top, middle, bottom, or replicated piece of an extensible character.
-
-@ A \.{LIGTABLE} property list contains elements of four kinds, specifying a
-program in a simple command language that \TeX\ uses for ligatures and kerns.
-If several \.{LIGTABLE} lists appear, they are effectively concatenated into
-a single list.
-
-\yskip\hang\.{LABEL} (integer value) means that the program for the
-stated character value starts here. The integer must be the number of a
-character in the font; its \.{CHARACTER} property list must not have a
-\.{NEXTLARGER} or \.{VARCHAR} field. At least one \.{LIG} or \.{KRN} step
-must follow.
-
-\yskip\hang\.{LABEL} \.{BOUNDARYCHAR} means that the program for
-beginning-of-word ligatures starts here.
-
-\yskip\hang\.{LIG} (two integer values). The instruction `\.{(LIG} $c$ $r$\.)'
-means, ``If the next character is $c$, then insert character~$r$ and
-possibly delete the current character and/or~$c$;
-otherwise go on to the next instruction.''
-Characters $r$ and $c$ must be present in the font. \.{LIG} may be immediately
-preceded or followed by a slash, and then immediately followed by \.>
-characters not exceeding the number of slashes. Thus there are eight
-possible forms:
-$$\hbox to .8\hsize{\.{LIG}\hfil\.{/LIG}\hfil\.{/LIG>}\hfil
-\.{LIG/}\hfil\.{LIG/>}\hfil\.{/LIG/}\hfil\.{/LIG/>}\hfil\.{/LIG/>>}}$$
-The slashes specify retention of the left or right original character; the
-\.> signs specify passing over the result without further ligature processing.
-
-\yskip\hang\.{KRN} (an integer value and a real value). The instruction
-`\.{(KRN} $c$ $r$\.)' means, ``If the next character is $c$, then insert
-a blank space of width $r$ between the current character character and $c$;
-otherwise go on to the next intruction.'' The value of $r$, which is in
-units of the design size, is often negative. Character code $c$ must exist
-in the font.
-
-\yskip\hang\.{STOP} (no value). This instruction ends a ligature/kern program.
-It must follow either a \.{LIG} or \.{KRN} instruction, not a \.{LABEL}
-or \.{STOP} or \.{SKIP}.
-
-\yskip\hang\.{SKIP} (value in the range |0..127|). This instruction specifies
-continuation of a ligature/kern program after the specified number of \.{LIG}
-or \.{KRN} has been skipped over. The number of subsequent \.{LIG} and \.{KRN}
-instructions must therefore exceed this specified amount.
-
-@ In addition to all these possibilities, the property name \.{COMMENT} is
-allowed in any property list. Such comments are ignored.
-
-@ So that is what \.{PL} files hold. The next question is, ``What about
-\.{TFM} files?'' A complete answer to that question appears in the
-documentation of the companion program, \.{TFtoPL}, so it will not
-be repeated here. Suffice it to say that a \.{TFM} file stores all of the
-relevant font information in a sequence of 8-bit bytes. The number of
-bytes is always a multiple of 4, so we could regard the \.{TFM} file
-as a sequence of 32-bit words; but \TeX\ uses the byte interpretation,
-and so does \.{PLtoTF}. Note that the bytes are considered to be unsigned
-numbers.
-
-@<Glob...@>=
-@!tfm_file:packed file of 0..255;
-
-@ On some systems you may have to do something special to write a
-packed file of bytes. For example, the following code didn't work
-when it was first tried at Stanford, because packed files have to be
-opened with a special switch setting on the \PASCAL\ that was used.
-@^system dependencies@>
-
-@<Set init...@>=
-rewrite(tfm_file);
-
-@* Basic input routines.
-For the purposes of this program, a |byte| is an unsigned 16-bit quantity,
-and an |ASCII_code| is an integer between @'40 and @'177. Such ASCII codes
-correspond to one-character constants like \.{"A"} in \.{WEB} language.
-
-@<Types...@>=
-@!byte=0..65535; {unsigned sixteen-bit quantity}
-@!ASCII_code=@'40..@'177; {standard ASCII code numbers}
-
-@ One of the things \.{PLtoTF} has to do is convert characters of strings
-to ASCII form, since that is the code used for the family name and the
-coding scheme in a \.{TFM} file. An array |xord| is used to do the
-conversion from |char|; the method below should work with little or no change
-on most \PASCAL\ systems.
-@^system dependencies@>
-
-@d first_ord=0 {ordinal number of the smallest element of |char|}
-@d last_ord=127 {ordinal number of the largest element of |char|}
-
-@<Global...@>=
-@!xord:array[char] of ASCII_code; {conversion table}
-
-@ @<Local variables for init...@>=
-@!k:integer; {all-purpose initialization index}
-
-@ Characters that should not appear in \.{PL} files (except in comments)
-are mapped into @'177.
-
-@d invalid_code=@'177 {code deserving an error message}
-
-@<Set init...@>=
-for k:=first_ord to last_ord do xord[chr(k)]:=invalid_code;
-xord[' ']:=" "; xord['!']:="!"; xord['"']:=""""; xord['#']:="#";
-xord['$']:="$"; xord['%']:="%"; xord['&']:="&"; xord['''']:="'";
-xord['(']:="("; xord[')']:=")"; xord['*']:="*"; xord['+']:="+"; xord[',']:=",";
-xord['-']:="-"; xord['.']:="."; xord['/']:="/"; xord['0']:="0"; xord['1']:="1";
-xord['2']:="2"; xord['3']:="3"; xord['4']:="4"; xord['5']:="5"; xord['6']:="6";
-xord['7']:="7"; xord['8']:="8"; xord['9']:="9"; xord[':']:=":"; xord[';']:=";";
-xord['<']:="<"; xord['=']:="="; xord['>']:=">"; xord['?']:="?";
-xord['@@']:="@@"; xord['A']:="A"; xord['B']:="B"; xord['C']:="C";
-xord['D']:="D"; xord['E']:="E"; xord['F']:="F"; xord['G']:="G"; xord['H']:="H";
-xord['I']:="I"; xord['J']:="J"; xord['K']:="K"; xord['L']:="L"; xord['M']:="M";
-xord['N']:="N"; xord['O']:="O"; xord['P']:="P"; xord['Q']:="Q"; xord['R']:="R";
-xord['S']:="S"; xord['T']:="T"; xord['U']:="U"; xord['V']:="V"; xord['W']:="W";
-xord['X']:="X"; xord['Y']:="Y"; xord['Z']:="Z"; xord['[']:="["; xord['\']:="\";
-xord[']']:="]"; xord['^']:="^"; xord['_']:="_"; xord['`']:="`"; xord['a']:="a";
-xord['b']:="b"; xord['c']:="c"; xord['d']:="d"; xord['e']:="e"; xord['f']:="f";
-xord['g']:="g"; xord['h']:="h"; xord['i']:="i"; xord['j']:="j"; xord['k']:="k";
-xord['l']:="l"; xord['m']:="m"; xord['n']:="n"; xord['o']:="o"; xord['p']:="p";
-xord['q']:="q"; xord['r']:="r"; xord['s']:="s"; xord['t']:="t"; xord['u']:="u";
-xord['v']:="v"; xord['w']:="w"; xord['x']:="x"; xord['y']:="y"; xord['z']:="z";
-xord['{']:="{"; xord['|']:="|"; xord['}']:="}"; xord['~']:="~";
-
-@ In order to help catch errors of badly nested parentheses, \.{PLtoTF}
-assumes that the user will begin each line with a number of blank spaces equal
-to some constant times the number of open parentheses at the beginning of
-that line. However, the program doesn't know in advance what the constant
-is, nor does it want to print an error message on every line for a user
-who has followed no consistent pattern of indentation.
-
-Therefore the following strategy is adopted: If the user has been consistent
-with indentation for ten or more lines, an indentation error will be
-reported. The constant of indentation is reset on every line that should
-have nonzero indentation.
-
-@<Glob...@>=
-@!line:integer; {the number of the current line}
-@!good_indent:integer; {the number of lines since the last bad indentation}
-@!indent: integer; {the number of spaces per open parenthesis, zero if unknown}
-@!level: integer; {the current number of open parentheses}
-
-@ @<Set init...@>=
-line:=0; good_indent:=0; indent:=0; level:=0;
-
-@ The input need not really be broken into lines of any maximum length, and
-we could read it character by character without any buffering. But we shall
-place it into a small buffer so that offending lines can be displayed in error
-messages.
-
-@<Glob...@>=
-@!left_ln,@!right_ln:boolean; {are the left and right ends of the buffer
- at end-of-line marks?}
-@!limit:0..buf_size; {position of the last character present in the buffer}
-@!loc:0..buf_size; {position of the last character read in the buffer}
-@!buffer:array[1..buf_size] of char;
-@!input_has_ended:boolean; {there is no more input to read}
-
-@ @<Set init...@>=
-limit:=0; loc:=0; left_ln:=true; right_ln:=true; input_has_ended:=false;
-
-@ Just before each \.{CHARACTER} property list is evaluated, the character
-code is printed in octal notation. Up to eight such codes appear on a line;
-so we have a variable to keep track of how many are currently there.
-
-@<Glob...@>=
-@!chars_on_line:0..8; {the number of characters printed on the current line}
-
-@ @<Set init...@>=
-chars_on_line:=0;
-
-@ The following routine prints an error message and an indication of
-where the error was detected. The error message should not include any
-final punctuation, since this procedure supplies its own.
-
-@d err_print(#)==begin if chars_on_line>0 then print_ln(' ');
- print(#); show_error_context;
- end
-
-@p procedure show_error_context; {prints the current scanner location}
-var k:0..buf_size; {an index into |buffer|}
-begin print_ln(' (line ',line:1,').');
-if not left_ln then print('...');
-for k:=1 to loc do print(buffer[k]); {print the characters already scanned}
-print_ln(' ');
-if not left_ln then print(' ');
-for k:=1 to loc do print(' '); {space out the second line}
-for k:=loc+1 to limit do print(buffer[k]); {print the characters yet unseen}
-if right_ln then print_ln(' ')@+else print_ln('...');
-chars_on_line:=0;
-end;
-
-@ Here is a procedure that does the right thing when we are done
-reading the present contents of the buffer. It keeps |buffer[buf_size]|
-empty, in order to avoid range errors on certain \PASCAL\ compilers.
-
-An infinite sequence of right parentheses is placed at the end of the
-file, so that the program is sure to get out of whatever level of nesting
-it is in.
-
-On some systems it is desirable to modify this code so that tab marks
-in the buffer are replaced by blank spaces. (Simply setting
-|xord[chr(@'11)]:=" "| would not work; for example, two-line
-error messages would not come out properly aligned.)
-@^system dependencies@>
-
-@p procedure fill_buffer;
-begin left_ln:=right_ln; limit:=0; loc:=0;
-if left_ln then begin
- if line>0 then read_ln(pl_file);
- incr(line);
- end;
-if eof(pl_file) then begin
- limit:=1; buffer[1]:=')'; right_ln:=false; input_has_ended:=true;
- end
-else begin
- while (limit<buf_size-1)and(not eoln(pl_file)) do begin
- incr(limit); read(pl_file,buffer[limit]);
- end;
- buffer[limit+1]:=' '; right_ln:=eoln(pl_file);
- if left_ln then @<Set |loc| to the number of leading blanks in
- the buffer, and check the indentation@>;
- end;
-end;
-
-@ The interesting part about |fill_buffer| is the part that learns what
-indentation conventions the user is following, if any.
-
-@d bad_indent(#)==begin if good_indent>=10 then err_print(#);
- good_indent:=0; indent:=0;
- end
-
-@<Set |loc|...@>=
-begin while (loc<limit)and(buffer[loc+1]=' ') do incr(loc);
-if loc<limit then begin
- if level=0 then
- if loc=0 then incr(good_indent)
- else bad_indent('Warning: Indented line occurred at level zero')
-@.Warning: Indented line...@>
- else if indent=0 then
- if loc mod level=0 then begin
- indent:=loc div level; good_indent:=1;
- end
- else good_indent:=0
- else if indent*level=loc then incr(good_indent)
- else bad_indent('Warning: Inconsistent indentation; ',
-@.Warning: Inconsistent indentation...@>
- 'you are at parenthesis level ',level:1);
- end;
-end
-
-@* Basic scanning routines.
-The global variable |cur_char| holds the ASCII code corresponding to the
-character most recently read from the input buffer, or to a character that
-has been substituted for the real one.
-
-@<Global...@>=
-@!cur_char:ASCII_code; {we have just read this}
-
-@ Here is a procedure that sets |cur_char| to an ASCII code for the
-next character of input, if that character is a letter or digit or slash
-or \.>. Otherwise
-it sets |cur_char:=" "|, and the input system will be poised to reread the
-character that was rejected, whether or not it was a space.
-Lower case letters are converted to upper case.
-
-@p procedure get_keyword_char;
-begin while (loc=limit)and(not right_ln) do fill_buffer;
-if loc=limit then cur_char:=" " {end-of-line counts as a delimiter}
-else begin
- cur_char:=xord[buffer[loc+1]];
- if cur_char>="a" then cur_char:=cur_char-@'40;
- if ((cur_char>="0")and(cur_char<="9")) then incr(loc)
- else if ((cur_char>="A")and(cur_char<="Z")) then incr(loc)
- else if cur_char="/" then incr(loc)
- else if cur_char=">" then incr(loc)
- else cur_char:=" ";
- end;
-end;
-
-@ The following procedure sets |cur_char| to the next character code,
-and converts lower case to upper case. If the character is a left or
-right parenthesis, it will not be ``digested''; the character will
-be read again and again, until the calling routine does something
-like `|incr(loc)|' to get past it. Such special treatment of parentheses
-insures that the structural information they contain won't be lost in
-the midst of other error recovery operations.
-
-@d backup==begin if (cur_char>")")or(cur_char<"(") then decr(loc);
- end {undoes the effect of |get_next|}
-
-@p procedure get_next; {sets |cur_char| to next, balks at parentheses}
-begin while loc=limit do fill_buffer;
-incr(loc); cur_char:=xord[buffer[loc]];
-if cur_char>="a" then
- if cur_char<="z" then cur_char:=cur_char-@'40 {uppercasify}
- else begin
- if cur_char=invalid_code then begin
- err_print('Illegal character in the file');
-@.Illegal character...@>
- cur_char:="?";
- end;
- end
-else if (cur_char<=")")and(cur_char>="(") then decr(loc);
-end;
-
-@ The next procedure is used to ignore the text of a comment, or to pass over
-erroneous material. As such, it has the privilege of passing parentheses.
-It stops after the first right parenthesis that drops the level below
-the level in force when the procedure was called.
-
-@p procedure skip_to_end_of_item;
-var l:integer; {initial value of |level|}
-begin l:=level;
-while level>=l do begin
- while loc=limit do fill_buffer;
- incr(loc);
- if buffer[loc]=')' then decr(level)
- else if buffer[loc]='(' then incr(level);
- end;
-if input_has_ended then err_print('File ended unexpectedly: No closing ")"');
-@.File ended unexpectedly...@>
-cur_char:=" "; {now the right parenthesis has been read and digested}
-end;
-
-@ Sometimes we merely want to skip past characters in the input until we
-reach a left or a right parenthesis. For example, we do this whenever we
-have finished scanning a property value and we hope that a right parenthesis
-is next (except for possible blank spaces).
-
-@d skip_to_paren==repeat get_next@;@+ until (cur_char="(")or(cur_char=")")
-@d skip_error(#)==begin err_print(#); skip_to_paren;
- end {this gets to the right parenthesis if something goes wrong}
-@d flush_error(#)==begin err_print(#); skip_to_end_of_item;
- end {this gets past the right parenthesis if something goes wrong}
-
-@ After a property value has been scanned, we want to move just past the
-right parenthesis that should come next in the input (except for possible
-blank spaces).
-
-@p procedure finish_the_property; {do this when the value has been scanned}
-begin while cur_char=" " do get_next;
-if cur_char<>")" then err_print('Junk after property value will be ignored');
-@.Junk after property value...@>
-skip_to_end_of_item;
-end;
-
-@* Scanning property names.
-We have to figure out the meaning of names that appear in the \.{PL} file,
-by looking them up in a dictionary of known keywords. Keyword number $n$
-appears in locations |start[n]| through |start[n+1]-1| of an array called
-|dictionary|.
-
-@d max_name_index=300 {upper bound on the number of keywords}
-@d max_letters=3000 {upper bound on the total length of all keywords}
-
-@<Global...@>=
-@!start:array[1..max_name_index] of 0..max_letters;
-@!dictionary:array[0..max_letters] of ASCII_code;
-@!start_ptr:0..max_name_index; {the first available place in |start|}
-@!dict_ptr:0..max_letters; {the first available place in |dictionary|}
-
-@ @<Set init...@>=
-start_ptr:=1; start[1]:=0; dict_ptr:=0;
-
-@ When we are looking for a name, we put it into the |cur_name| array.
-When we have found it, the corresponding |start| index will go into
-the global variable |name_ptr|.
-
-@d longest_name=20 {length of \.{DEFAULTRULETHICKNESS}}
-
-@<Glob...@>=
-@!cur_name:array[1..longest_name] of ASCII_code; {a name to look up}
-@!name_length:0..longest_name; {its length}
-@!name_ptr:0..max_name_index; {its ordinal number in the dictionary}
-
-@ A conventional hash table with linear probing (cf.\ Algorithm 6.4L
-in {\sl The Art of Computer Pro\-gram\-ming\/}) is used for the dictionary
-operations. If |nhash[h]=0|, the table position is empty, otherwise |nhash[h]|
-points into the |start| array.
-
-@d hash_prime=307 {size of the hash table}
-
-@<Glob...@>=
-@!nhash:array[0..hash_prime-1] of 0..max_name_index;
-@!cur_hash:0..hash_prime-1; {current position in the hash table}
-
-@ @<Local...@>=
-@!h:0..hash_prime-1; {runs through the hash table}
-
-@ @<Set init...@>=
-for h:=0 to hash_prime-1 do nhash[h]:=0;
-
-@ Since there is no chance of the hash table overflowing, the procedure
-is very simple. After |lookup| has done its work, |cur_hash| will point
-to the place where the given name was found, or where it should be inserted.
-
-@p procedure lookup; {finds |cur_name| in the dictionary}
-var k:0..longest_name; {index into |cur_name|}
-@!j:0..max_letters; {index into |dictionary|}
-@!not_found:boolean; {clumsy thing necessary to avoid |goto| statement}
-@!cur_hash_reset:boolean;
-begin @<Compute the hash code, |cur_hash|, for |cur_name|@>;
-not_found:=true;
-cur_hash_reset:=false;
-while not_found do begin
- if (cur_hash=0) and (cur_hash_reset) then
- not_found:=false
- else begin
- if cur_hash=0 then begin
- cur_hash:=hash_prime-1;
- cur_hash_reset:=true
- end
- else decr(cur_hash);
- if nhash[cur_hash]=0 then not_found:=false
- else begin
- j:=start[nhash[cur_hash]];
- if start[nhash[cur_hash]+1]=j+name_length then begin
- not_found:=false;
- for k:=1 to name_length do
- if dictionary[j+k-1]<>cur_name[k] then not_found:=true;
- end
- end
- end
- end;
-name_ptr:=nhash[cur_hash];
-end;
-
-@ @<Compute the hash...@>=
-cur_hash:=cur_name[1];
-for k:=2 to name_length do
- cur_hash:=(cur_hash+cur_hash+cur_name[k]) mod hash_prime
-
-@ The ``meaning'' of the keyword that begins at |start[k]| in the
-dictionary is kept in |equiv[k]|. The numeric |equiv| codes are given
-symbolic meanings by the following definitions.
-
-@d comment_code=0
-@d check_sum_code=1
-@d design_size_code=2
-@d design_units_code=3
-@d coding_scheme_code=4
-@d family_code=5
-@d face_code=6
-@d seven_bit_safe_flag_code=7
-@d header_code= 8
-@d font_dimen_code=9
-@d lig_table_code=10
-@d boundary_char_code=11
-@d font_dir_code=14
-@d n_font_dir_code=15
-@d character_code=16
-@d parameter_code=30
-@d char_info_code=70
-@d width=1
-@d height=2
-@d depth=3
-@d italic=4
-@d sec_width=5
-@d sec_height=6
-@d sec_depth=7
-@d sec_italic=8
-@d accent=9
-@d prim_top_axis=10
-@d prim_top_axis_bis=11
-@d prim_bot_axis=12
-@d prim_bot_axis_bis=13
-@d prim_mid_hor=14
-@d prim_mid_vert=15
-@d prim_base_slant=16
-@d sec_top_axis=17
-@d sec_top_axis_bis=18
-@d sec_bot_axis=19
-@d sec_bot_axis_bis=20
-@d sec_mid_hor=21
-@d sec_mid_vert=22
-@d sec_base_slant=23
-@d char_wd_code=char_info_code+width
-@d char_ht_code=char_info_code+height
-@d char_dp_code=char_info_code+depth
-@d char_ic_code=char_info_code+italic
-@d sec_width_code=char_info_code+sec_width
-@d sec_height_code=char_info_code+sec_height
-@d sec_depth_code=char_info_code+sec_depth
-@d sec_italic_code=char_info_code+sec_italic
-@d accent_code=char_info_code+accent
-@d prim_top_axis_code=char_info_code+prim_top_axis
-@d prim_top_axis_bis_code=char_info_code+prim_top_axis_bis
-@d prim_bot_axis_code=char_info_code+prim_bot_axis
-@d prim_bot_axis_bis_code=char_info_code+prim_bot_axis_bis
-@d prim_mid_hor_code=char_info_code+prim_mid_hor
-@d prim_mid_vert_code=char_info_code+prim_mid_vert
-@d prim_base_slant_code=char_info_code+prim_base_slant
-@d sec_top_axis_code=char_info_code+sec_top_axis
-@d sec_top_axis_bis_code=char_info_code+sec_top_axis_bis
-@d sec_bot_axis_code=char_info_code+sec_bot_axis
-@d sec_bot_axis_bis_code=char_info_code+sec_bot_axis_bis
-@d sec_mid_hor_code=char_info_code+sec_mid_hor
-@d sec_mid_vert_code=char_info_code+sec_mid_vert
-@d sec_base_slant_code=char_info_code+sec_base_slant
-@d next_larger_code=100
-@d var_char_code=102
-@d label_code=130
-@d stop_code=131
-@d skip_code=132
-@d krn_code=133
-@d lig_code=134
-@d ofm_level_code=140
-@d char_repeat_code=150
-@d char_ivalue_code=151
-@d char_fvalue_code=152
-@d char_mvalue_code=153
-@d char_rule_code=154
-@d char_glue_code=155
-@d char_penalty_code=156
-@d font_rule_code=160
-@d rule_code=161
-@d rule_width_code=162
-@d rule_height_code=163
-@d rule_depth_code=164
-@d font_glue_code=170
-@d glue_code=171
-@d glue_type_code=172
-@d glue_stretch_order_code=173
-@d glue_shrink_order_code=174
-@d glue_width_code=175
-@d glue_stretch_code=176
-@d glue_shrink_code=177
-@d glue_char_code=178
-@d glue_rule_code=179
-@d order_unit_code=181
-@d order_fi_code=182
-@d order_fil_code=183
-@d order_fill_code=184
-@d order_filll_code=185
-@d type_normal_code=186
-@d type_aleaders_code=187
-@d type_cleaders_code=188
-@d type_xleaders_code=189
-@d font_penalty_code=190
-@d penalty_code=191
-@d penalty_val_code=192
-@d font_mvalue_code=200
-@d mvalue_code=201
-@d mvalue_val_code=202
-@d font_fvalue_code=210
-@d fvalue_code=211
-@d fvalue_val_code=212
-@d font_ivalue_code=220
-@d ivalue_code=221
-@d ivalue_val_code=222
-@d clabel_code=231
-@d cpen_code=232
-@d cglue_code=233
-@d cpenglue_code=234
-@d ckrn_code=235
-@d TL_dir_code=240
-@d LT_dir_code=241
-@d TR_dir_code=242
-@d LB_dir_code=243
-@d BL_dir_code=244
-@d RT_dir_code=245
-@d BR_dir_code=246
-@d RB_dir_code=247
-
-
-@<Glo...@>=
-@!equiv:array[0..max_name_index] of byte;
-@!cur_code:byte; {equivalent most recently found in |equiv|}
-
-@ We have to get the keywords into the hash table and into the dictionary in
-the first place (sigh). The procedure that does this has the desired
-|equiv| code as a parameter. In order to facilitate \.{WEB} macro writing
-for the initialization, the keyword being initialized is placed into the
-last positions of |cur_name|, instead of the first positions.
-
-@p procedure enter_name(v:byte); {|cur_name| goes into the dictionary}
-var k:0..longest_name;
-begin for k:=1 to name_length do
- cur_name[k]:=cur_name[k+longest_name-name_length];
-{now the name has been shifted into the correct position}
-lookup; {this sets |cur_hash| to the proper insertion place}
-nhash[cur_hash]:=start_ptr; equiv[start_ptr]:=v;
-for k:=1 to name_length do
- begin dictionary[dict_ptr]:=cur_name[k]; incr(dict_ptr);
- end;
-incr(start_ptr); start[start_ptr]:=dict_ptr;
-end;
-
-@ Here are the macros to load a name of up to 20 letters into the
-dictionary. For example, the macro |load5| is used for five-letter keywords.
-
-@d tail(#)==enter_name(#)
-@d t20(#)==cur_name[20]:=#;tail
-@d t19(#)==cur_name[19]:=#;t20
-@d t18(#)==cur_name[18]:=#;t19
-@d t17(#)==cur_name[17]:=#;t18
-@d t16(#)==cur_name[16]:=#;t17
-@d t15(#)==cur_name[15]:=#;t16
-@d t14(#)==cur_name[14]:=#;t15
-@d t13(#)==cur_name[13]:=#;t14
-@d t12(#)==cur_name[12]:=#;t13
-@d t11(#)==cur_name[11]:=#;t12
-@d t10(#)==cur_name[10]:=#;t11
-@d t9(#)==cur_name[9]:=#;t10
-@d t8(#)==cur_name[8]:=#;t9
-@d t7(#)==cur_name[7]:=#;t8
-@d t6(#)==cur_name[6]:=#;t7
-@d t5(#)==cur_name[5]:=#;t6
-@d t4(#)==cur_name[4]:=#;t5
-@d t3(#)==cur_name[3]:=#;t4
-@d t2(#)==cur_name[2]:=#;t3
-@d t1(#)==cur_name[1]:=#;t2
-@d load2==name_length:=2;t19
-@d load3==name_length:=3;t18
-@d load4==name_length:=4;t17
-@d load5==name_length:=5;t16
-@d load6==name_length:=6;t15
-@d load7==name_length:=7;t14
-@d load8==name_length:=8;t13
-@d load9==name_length:=9;t12
-@d load10==name_length:=10;t11
-@d load11==name_length:=11;t10
-@d load12==name_length:=12;t9
-@d load13==name_length:=13;t8
-@d load14==name_length:=14;t7
-@d load15==name_length:=15;t6
-@d load16==name_length:=16;t5
-@d load17==name_length:=17;t4
-@d load18==name_length:=18;t3
-@d load19==name_length:=19;t2
-@d load20==name_length:=20;t1
-
-@ (Thank goodness for keyboard macros in the text editor used to create this
-\.{WEB} file.)
-
-@<Enter all of the names and their equivalents, except the parameter names@>=
-equiv[0]:=comment_code; {this is used after unknown keywords}
-load8("C")("H")("E")("C")("K")("S")("U")("M")(check_sum_code);@/
-load10("D")("E")("S")("I")("G")("N")("S")("I")("Z")("E")(design_size_code);@/
-load11("D")("E")("S")("I")("G")("N")
- ("U")("N")("I")("T")("S")(design_units_code);@/
-load12("C")("O")("D")("I")("N")("G")
- ("S")("C")("H")("E")("M")("E")(coding_scheme_code);@/
-load6("F")("A")("M")("I")("L")("Y")(family_code);@/
-load4("F")("A")("C")("E")(face_code);@/
-load16("S")("E")("V")("E")("N")("B")("I")("T")@/@t\hskip2em@>
- ("S")("A")("F")("E")("F")("L")("A")("G")(seven_bit_safe_flag_code);@/
-load6("H")("E")("A")("D")("E")("R")(header_code);@/
-load9("F")("O")("N")("T")("D")("I")("M")("E")("N")(font_dimen_code);@/
-load8("L")("I")("G")("T")("A")("B")("L")("E")(lig_table_code);@/
-load12("B")("O")("U")("N")("D")("A")("R")("Y")("C")("H")("A")("R")
- (boundary_char_code);@/
-load9("C")("H")("A")("R")("A")("C")("T")("E")("R")(character_code);@/
-load9("P")("A")("R")("A")("M")("E")("T")("E")("R")(parameter_code);@/
-load6("C")("H")("A")("R")("W")("D")(char_wd_code);@/
-load6("C")("H")("A")("R")("H")("T")(char_ht_code);@/
-load6("C")("H")("A")("R")("D")("P")(char_dp_code);@/
-load6("C")("H")("A")("R")("I")("C")(char_ic_code);@/
-load5("S")("E")("C")("W")("D")(sec_width_code);@/
-load5("S")("E")("C")("H")("T")(sec_height_code);@/
-load5("S")("E")("C")("D")("P")(sec_depth_code);@/
-load5("S")("E")("C")("I")("C")(sec_italic_code);@/
-load6("A")("C")("C")("E")("N")("T")(accent_code);@/
-load11("P")("R")("I")("M")("T")("O")("P")("A")("X")("I")("S")(prim_top_axis_code);@/
-load14("P")("R")("I")("M")("T")("O")("P")("A")("X")("I")("S")("B")("I")("S")(prim_top_axis_bis_code);@/
-load11("P")("R")("I")("M")("B")("O")("T")("A")("X")("I")("S")(prim_bot_axis_code);@/
-load14("P")("R")("I")("M")("B")("O")("T")("A")("X")("I")("S")("B")("I")("S")(prim_bot_axis_bis_code);@/
-load10("P")("R")("I")("M")("M")("I")("D")("H")("O")("R")(prim_mid_hor_code);@/
-load10("P")("R")("I")("M")("M")("I")("D")("V")("E")("R")(prim_mid_vert_code);@/
-load13("P")("R")("I")("M")("B")("A")("S")("E")("S")("L")("A")("N")("T")(prim_base_slant_code);@/
-load10("S")("E")("C")("T")("O")("P")("A")("X")("I")("S")(sec_top_axis_code);@/
-load13("S")("E")("C")("T")("O")("P")("A")("X")("I")("S")("B")("I")("S")(sec_top_axis_bis_code);@/
-load10("S")("E")("C")("B")("O")("T")("A")("X")("I")("S")(sec_bot_axis_code);@/
-load13("S")("E")("C")("B")("O")("T")("A")("X")("I")("S")("B")("I")("S")(sec_bot_axis_bis_code);@/
-load9("S")("E")("C")("M")("I")("D")("H")("O")("R")(sec_mid_hor_code);@/
-load9("S")("E")("C")("M")("I")("D")("V")("E")("R")(sec_mid_vert_code);@/
-load12("S")("E")("C")("B")("A")("S")("E")("S")("L")("A")("N")("T")(sec_base_slant_code);@/
-load10("N")("E")("X")("T")("L")("A")("R")("G")("E")("R")(next_larger_code);@/
-load7("V")("A")("R")("C")("H")("A")("R")(var_char_code);@/
-load3("T")("O")("P")(var_char_code+1);@/
-load3("M")("I")("D")(var_char_code+2);@/
-load3("B")("O")("T")(var_char_code+3);@/
-load3("R")("E")("P")(var_char_code+4);@/
-load3("E")("X")("T")(var_char_code+4); {compatibility with older \.{PL} format}
-load7("C")("O")("M")("M")("E")("N")("T")(comment_code);@/
-load5("L")("A")("B")("E")("L")(label_code);@/
-load4("S")("T")("O")("P")(stop_code);@/
-load4("S")("K")("I")("P")(skip_code);@/
-load3("K")("R")("N")(krn_code);@/
-load3("L")("I")("G")(lig_code);@/
-load4("/")("L")("I")("G")(lig_code+2);@/
-load5("/")("L")("I")("G")(">")(lig_code+6);@/
-load4("L")("I")("G")("/")(lig_code+1);@/
-load5("L")("I")("G")("/")(">")(lig_code+5);@/
-load5("/")("L")("I")("G")("/")(lig_code+3);@/
-load6("/")("L")("I")("G")("/")(">")(lig_code+7);@/
-load7("/")("L")("I")("G")("/")(">")(">")(lig_code+11);@/
-load6("C")("L")("A")("B")("E")("L")(clabel_code);@/
-load4("C")("P")("E")("N")(cpen_code);@/
-load5("C")("G")("L")("U")("E")(cglue_code);@/
-load8("C")("P")("E")("N")("G")("L")("U")("E")(cpenglue_code);@/
-load4("C")("K")("R")("N")(ckrn_code);@/
-load8("O")("F")("M")("L")("E")("V")("E")("L")(ofm_level_code);@/
-load7("F")("O")("N")("T")("D")("I")("R")(font_dir_code);@/
-load8("N")("F")("O")("N")("T")("D")("I")("R")(n_font_dir_code);@/
-load10("C")("H")("A")("R")("R")("E")("P")("E")("A")("T")(char_repeat_code);@/
-load10("C")("H")("A")("R")("I")("V")("A")("L")("U")("E")(char_ivalue_code);@/
-load10("C")("H")("A")("R")("F")("V")("A")("L")("U")("E")(char_fvalue_code);@/
-load10("C")("H")("A")("R")("M")("V")("A")("L")("U")("E")(char_mvalue_code);@/
-load8("C")("H")("A")("R")("R")("U")("L")("E")(char_rule_code);@/
-load8("C")("H")("A")("R")("G")("L")("U")("E")(char_glue_code);@/
-load11("C")("H")("A")("R")("P")("E")("N")("A")("L")("T")("Y")(char_penalty_code);@/
-load8("F")("O")("N")("T")("R")("U")("L")("E")(font_rule_code);@/
-load4("R")("U")("L")("E")(rule_code);@/
-load6("R")("U")("L")("E")("W")("D")(rule_width_code);@/
-load6("R")("U")("L")("E")("H")("T")(rule_height_code);@/
-load6("R")("U")("L")("E")("D")("P")(rule_depth_code);@/
-load8("F")("O")("N")("T")("G")("L")("U")("E")(font_glue_code);@/
-load4("G")("L")("U")("E")(glue_code);@/
-load8("G")("L")("U")("E")("T")("Y")("P")("E")(glue_type_code);@/
-load16("G")("L")("U")("E")("S")("T")("R")("E")("T")("C")("H")("O")("R")("D")("E")("R")(glue_stretch_order_code);@/
-load15("G")("L")("U")("E")("S")("H")("R")("I")("N")("K")("O")("R")("D")("E")("R")(glue_shrink_order_code);@/
-load8("G")("L")("U")("E")("R")("U")("L")("E")(glue_rule_code);@/
-load8("G")("L")("U")("E")("C")("H")("A")("R")(glue_char_code);@/
-load6("G")("L")("U")("E")("W")("D")(glue_width_code);@/
-load11("G")("L")("U")("E")("S")("T")("R")("E")("T")("C")("H")(glue_stretch_code);@/
-load10("G")("L")("U")("E")("S")("H")("R")("I")("N")("K")(glue_shrink_code);@/
-load4("U")("N")("I")("T")(order_unit_code);@/
-load2("F")("I")(order_fi_code);@/
-load3("F")("I")("L")(order_fil_code);@/
-load4("F")("I")("L")("L")(order_fill_code);@/
-load5("F")("I")("L")("L")("L")(order_filll_code);@/
-load6("N")("O")("R")("M")("A")("L")(type_normal_code);@/
-load8("A")("L")("E")("A")("D")("E")("R")("S")(type_aleaders_code);@/
-load8("C")("L")("E")("A")("D")("E")("R")("S")(type_cleaders_code);@/
-load8("X")("L")("E")("A")("D")("E")("R")("S")(type_xleaders_code);@/
-load11("F")("O")("N")("T")("P")("E")("N")("A")("L")("T")("Y")(font_penalty_code);@/
-load7("P")("E")("N")("A")("L")("T")("Y")(penalty_code);@/
-load10("P")("E")("N")("A")("L")("T")("Y")("V")("A")("L")(penalty_val_code);@/
-load10("F")("O")("N")("T")("M")("V")("A")("L")("U")("E")(font_mvalue_code);@/
-load6("M")("V")("A")("L")("U")("E")(mvalue_code);@/
-load9("M")("V")("A")("L")("U")("E")("V")("A")("L")(mvalue_val_code);@/
-load10("F")("O")("N")("T")("F")("V")("A")("L")("U")("E")(font_fvalue_code);@/
-load6("F")("V")("A")("L")("U")("E")(fvalue_code);@/
-load9("F")("V")("A")("L")("U")("E")("V")("A")("L")(fvalue_val_code);@/
-load10("F")("O")("N")("T")("I")("V")("A")("L")("U")("E")(font_ivalue_code);@/
-load6("I")("V")("A")("L")("U")("E")(ivalue_code);@/
-load9("I")("V")("A")("L")("U")("E")("V")("A")("L")(ivalue_val_code);@/
-load2("T")("L")(TL_dir_code);
-load2("L")("T")(LT_dir_code);
-load2("T")("R")(TR_dir_code);
-load2("L")("B")(LB_dir_code);
-load2("B")("L")(BL_dir_code);
-load2("R")("T")(RT_dir_code);
-load2("B")("R")(BR_dir_code);
-load2("R")("B")(RB_dir_code);
-
-@ @<Enter the parameter names@>=
-load5("S")("L")("A")("N")("T")(parameter_code+1);@/
-load5("S")("P")("A")("C")("E")(parameter_code+2);@/
-load7("S")("T")("R")("E")("T")("C")("H")(parameter_code+3);@/
-load6("S")("H")("R")("I")("N")("K")(parameter_code+4);@/
-load7("X")("H")("E")("I")("G")("H")("T")(parameter_code+5);@/
-load4("Q")("U")("A")("D")(parameter_code+6);@/
-load10("E")("X")("T")("R")("A")("S")("P")("A")("C")("E")(parameter_code+7);@/
-load4("N")("U")("M")("1")(parameter_code+8);@/
-load4("N")("U")("M")("2")(parameter_code+9);@/
-load4("N")("U")("M")("3")(parameter_code+10);@/
-load6("D")("E")("N")("O")("M")("1")(parameter_code+11);@/
-load6("D")("E")("N")("O")("M")("2")(parameter_code+12);@/
-load4("S")("U")("P")("1")(parameter_code+13);@/
-load4("S")("U")("P")("2")(parameter_code+14);@/
-load4("S")("U")("P")("3")(parameter_code+15);@/
-load4("S")("U")("B")("1")(parameter_code+16);@/
-load4("S")("U")("B")("2")(parameter_code+17);@/
-load7("S")("U")("P")("D")("R")("O")("P")(parameter_code+18);@/
-load7("S")("U")("B")("D")("R")("O")("P")(parameter_code+19);@/
-load6("D")("E")("L")("I")("M")("1")(parameter_code+20);@/
-load6("D")("E")("L")("I")("M")("2")(parameter_code+21);@/
-load10("A")("X")("I")("S")("H")("E")("I")("G")("H")("T")(parameter_code+22);@/
-load20("D")("E")("F")("A")("U")("L")("T")("R")("U")("L")("E")@/@t\hskip2em@>
- ("T")("H")("I")("C")("K")("N")("E")("S")("S")(parameter_code+8);@/
-load13("B")("I")("G")("O")("P")
- ("S")("P")("A")("C")("I")("N")("G")("1")(parameter_code+9);@/
-load13("B")("I")("G")("O")("P")
- ("S")("P")("A")("C")("I")("N")("G")("2")(parameter_code+10);@/
-load13("B")("I")("G")("O")("P")
- ("S")("P")("A")("C")("I")("N")("G")("3")(parameter_code+11);@/
-load13("B")("I")("G")("O")("P")
- ("S")("P")("A")("C")("I")("N")("G")("4")(parameter_code+12);@/
-load13("B")("I")("G")("O")("P")
- ("S")("P")("A")("C")("I")("N")("G")("5")(parameter_code+13);@/
-
-@ When a left parenthesis has been scanned, the following routine
-is used to interpret the keyword that follows, and to store the
-equivalent value in |cur_code|.
-
-@p procedure get_name;
-begin incr(loc); incr(level); {pass the left parenthesis}
-cur_char:=" ";
-while cur_char=" " do get_next;
-if (cur_char>")")or(cur_char<"(") then decr(loc); {back up one character}
-name_length:=0; get_keyword_char; {prepare to scan the name}
-while cur_char<>" " do begin
- if name_length=longest_name then cur_name[1]:="X" {force error}
- else incr(name_length);
- cur_name[name_length]:=cur_char;
- get_keyword_char;
- end;
-lookup;
-if name_ptr=0 then err_print('Sorry, I don''t know that property name');
-@.Sorry, I don't know...@>
-cur_code:=equiv[name_ptr];
-end;
-
-@* Scanning numeric data.
-The next thing we need is a trio of subroutines to read the one-byte,
-four-byte, and real numbers that may appear as property values.
-These subroutines are careful to stick to numbers between $-2^{31}$
-and $2^{31}-1$, inclusive, so that a computer with two's complement
-32-bit arithmetic will not be interrupted by overflow.
-
-@ The first number scanner, which returns a one-byte value, surely has
-no problems of arithmetic overflow.
-
-@p function get_byte:byte; {scans a one-byte property value}
-var acc:integer; {an accumulator}
-@!t:ASCII_code; {the type of value to be scanned}
-begin repeat get_next;
-until cur_char<>" "; {skip the blanks before the type code}
-t:=cur_char; acc:=0;
-repeat get_next;
-until cur_char<>" "; {skip the blanks after the type code}
-if t="C" then @<Scan an ASCII character code@>
-else if t="D" then @<Scan a small decimal number@>
-else if t="O" then @<Scan a small octal number@>
-else if t="H" then @<Scan a small hexadecimal number@>
-else if t="F" then @<Scan a face code@>
-else skip_error('You need "C" or "D" or "O" or "H" or "F" here');
-@.You need "C" or "D" ...here@>
-cur_char:=" "; get_byte:=acc;
-end;
-
-@ The |get_next| routine converts lower case to upper case, but it leaves
-the character in the buffer, so we can unconvert it.
-
-@<Scan an ASCII...@>=
-if (cur_char>=@'41)and(cur_char<=@'176)and
- ((cur_char<"(")or(cur_char>")")) then
- acc:=xord[buffer[loc]]
-else skip_error('"C" value must be standard ASCII and not a paren')
-@:C value}\.{"C" value must be...@>
-
-@ @<Scan a small dec...@>=
-begin while (cur_char>="0")and(cur_char<="9") do begin
- acc:=acc*10+cur_char-"0";
- if acc>65535 then begin
- skip_error('This value shouldn''t exceed 65535');
-@.This value shouldn't...@>
- acc:=0; cur_char:=" ";
- end
- else get_next;
- end;
-backup;
-end
-
-@ @<Scan a small oct...@>=
-begin while (cur_char>="0")and(cur_char<="7") do
- begin acc:=acc*8+cur_char-"0";
- if acc>65535 then begin
- skip_error('This value shouldn''t exceed ''177777');
-@.This value shouldn't...@>
- acc:=0; cur_char:=" ";
- end
- else get_next;
- end;
-backup;
-end
-
-@ @<Scan a small hex...@>=
-begin while ((cur_char>="0")and(cur_char<="9"))or
- ((cur_char>="A")and(cur_char<="F")) do begin
- if cur_char>="A" then cur_char:=cur_char+"0"+10-"A";
- acc:=acc*16+cur_char-"0";
- if acc>65535 then begin
- skip_error('This value shouldn''t exceed "FFFF');
-@.This value shouldn't...@>
- acc:=0; cur_char:=" ";
- end
- else get_next;
- end;
-backup;
-end
-
-@ @<Scan a face...@>=
-begin if cur_char="B" then acc:=2
-else if cur_char="L" then acc:=4
-else if cur_char<>"M" then acc:=18;
-get_next;
-if cur_char="I" then incr(acc)
-else if cur_char<>"R" then acc:=18;
-get_next;
-if cur_char="C" then acc:=acc+6
-else if cur_char="E" then acc:=acc+12
-else if cur_char<>"R" then acc:=18;
-if acc>=18 then begin
- skip_error('Illegal face code, I changed it to MRR');
-@.Illegal face code...@>
- acc:=0;
- end;
-end
-
-@ The routine that scans a four-byte value puts its output into |cur_bytes|,
-which is a record containing (yes, you guessed it) four bytes.
-
-@<Types...@>=
-@!four_bytes=record @!b0:byte;@+@!b1:byte;@+@!b2:byte;@+@!b3:byte;@+end;
-
-@ @d c0==cur_bytes.b0
-@d c1==cur_bytes.b1
-@d c2==cur_bytes.b2
-@d c3==cur_bytes.b3
-
-@<Glob...@>=
-@!cur_bytes:four_bytes; {a four-byte accumulator}
-@!zero_bytes:four_bytes; {four bytes all zero}
-
-@ @<Set init...@>=
-zero_bytes.b0:=0; zero_bytes.b1:=0; zero_bytes.b2:=0; zero_bytes.b3:=0;
-
-@ Since the |get_four_bytes| routine is used very infrequently, no attempt
-has been made to make it fast; we only want it to work.
-This is no longer the case, but we hope that it is not too slow.
-
-@p procedure get_four_bytes; {scans an unsigned constant and sets |four_bytes|}
-var c:integer; {leading byte}
-@!r:integer; {radix}
-begin repeat get_next;
-until cur_char<>" "; {skip the blanks before the type code}
-r:=0; cur_bytes:=zero_bytes; {start with the accumulator zero}
-if cur_char="H" then r:=16
-else if cur_char="O" then r:=8
-else if cur_char="D" then r:=10
-else skip_error('Decimal ("D"), octal ("O") or hex ("H") value is needed here');
-@.Decimal ("D"), octal ("O") or hex ("H")...@>
-if r>0 then begin
- repeat get_next;
- until cur_char<>" "; {skip the blanks after the type code}
- while ((cur_char>="0")and(cur_char<="9"))or@|
- ((cur_char>="A")and(cur_char<="F")) do
- @<Multiply by |r|, add |cur_char-"0"|, and |get_next|@>;
- end;
-end;
-
-function get_integer:integer; {scans an integer property value}
-begin get_four_bytes;
-get_integer:=(c0*@"1000000)+(c1*@"10000)+(c2*@"100)+c3;
-end;
-
-@ @<Multiply by |r|...@>=
-begin if cur_char>="A" then cur_char:=cur_char+"0"+10-"A";
-if cur_char>="0"+r then skip_error('Illegal digit')
-@.Illegal digit@>
-else begin
- c:=c3*r+cur_char-"0"; c3:=c mod 256;@/
- c:=c2*r+c div 256; c2:=c mod 256;@/
- c:=c1*r+c div 256; c1:=c mod 256;@/
- c:=c0*r+c div 256;
- if c<256 then c0:=c
- else begin
- cur_bytes:=zero_bytes;
- if r=8 then
- skip_error('Sorry, the maximum octal value is O 37777777777')
-@.Sorry, the maximum...@>
- else if r=10 then
- skip_error('Sorry, the maximum decimal value is D 4294967295')
- else skip_error('Sorry, the maximum hex value is H FFFFFFFF');
- end;
- get_next;
- end;
-end
-
-@ The remaining scanning routine is the most interesting. It scans a real
-constant and returns the nearest |fix_word| approximation to that constant.
-A |fix_word| is a 32-bit integer that represents a real value that
-has been multiplied by $2^{20}$. Since \.{PLtoTF} restricts the magnitude
-of reals to 2048, the |fix_word| will have a magnitude less than $2^{31}$.
-
-@d unity==@'4000000 {$2^{20}$, the |fix_word| 1.0}
-
-@<Types...@>=
-@!fix_word=integer; {a scaled real value with 20 bits of fraction}
-@!unsigned_integer=integer;
-
-@ When a real value is desired, we might as well treat `\.D' and `\.R'
-formats as if they were identical.
-
-@p function get_fix:fix_word; {scans a real property value}
-var negative:boolean; {was there a minus sign?}
-@!acc:integer; {an accumulator}
-@!int_part:integer; {the integer part}
-@!j:0..7; {the number of decimal places stored}
-begin repeat get_next;
-until cur_char<>" "; {skip the blanks before the type code}
-negative:=false; acc:=0; {start with the accumulators zero}
-if (cur_char<>"R")and(cur_char<>"D") then
- skip_error('An "R" or "D" value is needed here')
-@.An "R" or "D" ... needed here@>
-else begin
- @<Scan the blanks and/or signs after the type code@>;
- while (cur_char>="0") and (cur_char<="9") do
- @<Multiply by 10, add |cur_char-"0"|, and |get_next|@>;
- int_part:=acc; acc:=0;
- if cur_char="." then @<Scan the fraction part and put it in |acc|@>;
- if (acc>=unity)and(int_part=2047) then
- skip_error('Real constants must be less than 2048')
-@.Real constants must be...@>
- else acc:=int_part*unity+acc;
- end;
-if negative then get_fix:=-acc@+else get_fix:=acc;
-end;
-
-@ @<Scan the blanks...@>=
-repeat get_next;
-if cur_char="-" then begin
- cur_char:=" "; negative:=true;
- end
-else if cur_char="+" then cur_char:=" ";
-until cur_char<>" "
-
-@ @<Multiply by 10...@>=
-begin acc:=acc*10+cur_char-"0";
-if acc>=2048 then begin
- skip_error('Real constants must be less than 2048');
-@.Real constants must be...@>
- acc:=0; cur_char:=" ";
- end
-else get_next;
-end
-
-@ To scan the fraction $.d_1d_2\ldots\,$, we keep track of up to seven
-of the digits $d_j$. A correct result is obtained if we first compute
-$f^\prime=\lfloor 2^{21}(d_1\ldots d_j)/10^j\rfloor$, after which
-$f=\lfloor(f^\prime+1)/2\rfloor$. It is possible to have $f=1.0$.
-
-@<Glob...@>=
-@!fraction_digits:array[1..7] of integer; {$2^{21}$ times $d_j$}
-
-@ @<Scan the frac...@>=
-begin j:=0; get_next;
-while (cur_char>="0")and(cur_char<="9") do begin
- if j<7 then begin
- incr(j); fraction_digits[j]:=@'10000000*(cur_char-"0");
- end;
- get_next;
- end;
-acc:=0;
-while j>0 do begin
- acc:=fraction_digits[j]+(acc div 10); decr(j);
- end;
-acc:=(acc+10) div 20;
-end
-
-@* Storing the property values.
-When property values have been found, they are squirreled away in a bunch
-of arrays. The header information is unpacked into bytes in an array
-called |header_bytes|. The ligature/kerning program is stored in an array
-of type |four_bytes|.
-Another |four_bytes| array holds the specifications of extensible characters.
-The kerns and parameters are stored in separate arrays of |fix_word| values.
-
-Instead of storing the design size in the header array, we will keep it
-in a |fix_word| variable until the last minute. The number of units in the
-design size is also kept in a |fix_word|.
-
-@<Glob...@>=
-@!header_bytes:array[header_index] of byte; {the header block}
-@!header_ptr:header_index; {the number of header bytes in use}
-@!design_size:fix_word; {the design size}
-@!design_units:fix_word; {reciprocal of the scaling factor}
-@!seven_bit_safe_flag:boolean; {does the file claim to be seven-bit-safe?}
-@!lig_kern:array[0..max_lig_steps] of four_bytes; {the ligature program}
-@!nl:unsigned_integer; {the number of ligature/kern instructions so far}
-@!min_nl:unsigned_integer; {the final value of |nl| must be at least this}
-@!kern:array[0..max_kerns] of fix_word; {the distinct kerning amounts}
-@!nk:0..max_kerns; {the number of entries of |kern|}
-@!exten:array[char_type] of four_bytes; {extensible character specs}
-@!ne:xchar_type; {the number of extensible characters}
-@!param:array[1..max_param_words] of fix_word; {\.{FONTDIMEN} parameters}
-@!np:0..max_param_words; {the largest parameter set nonzero}
-@!check_sum_specified:boolean; {did the user name the check sum?}
-@!bchar:xchar_type; {the right boundary character, or 256 if unspecified}
-@!font_dir:integer; {font direction}
-
-@ @<Types...@>=
-@!char_type=0..max_char;
-@!xchar_type=0..xmax_char;
-@!xxchar_type=0..xxmax_char;
-@!xxxchar_type=0..xxxmax_char;
-@!header_index=0..max_header_bytes;
-@!indx=xxchar_type;
-
-@ @<Local...@>=
-@!d:header_index; {an index into |header_bytes|}
-
-@ We start by setting up the default values.
-
-@d check_sum_loc=0
-@d design_size_loc=4
-@d coding_scheme_loc=8
-@d family_loc=coding_scheme_loc+40
-@d seven_flag_loc=family_loc+20
-@d face_loc=seven_flag_loc+3
-
-@<Set init...@>=
-for d:=0 to 18*4-1 do header_bytes[d]:=0;
-header_bytes[8]:=11; header_bytes[9]:="U";
-header_bytes[10]:="N";
-header_bytes[11]:="S";
-header_bytes[12]:="P";
-header_bytes[13]:="E";
-header_bytes[14]:="C";
-header_bytes[15]:="I";
-header_bytes[16]:="F";
-header_bytes[17]:="I";
-header_bytes[18]:="E";
-header_bytes[19]:="D";
-@.UNSPECIFIED@>
-for d:=family_loc to family_loc+11 do header_bytes[d]:=header_bytes[d-40];
-design_size:=10*unity; design_units:=unity; seven_bit_safe_flag:=false;@/
-header_ptr:=18*4; nl:=0; min_nl:=0; nk:=0; ne:=0; np:=0;@/
-check_sum_specified:=false; bchar:=xmax_char;
-font_dir:=0;
-
-@ Most of the dimensions, however, go into the |memory| array. There are
-at most |max_char+2| widths, |max_char+2| heights, |max_char+2| depths,
-and |max_char+2| italic corrections, since the value 0 is required but
-it need not be used. So |memory| has room for |4*max_char+8| entries,
-each of which is a |fix_word|. An auxiliary table called |link| is
-used to link these words together in linear lists, so that sorting and
-other operations can be done conveniently.
-
-We also add four ``list head'' words to the |memory| and |link| arrays;
-these are in locations |width| through |italic|, i.e., 1 through 4.
-For example, |link[height]| points to the smallest element in
-the sorted list of distinct heights that have appeared so far, and
-|memory[height]| is the number of distinct heights.
-
-@<Types...@>=
-@!pointer=0..mem_size; {an index into memory}
-
-@ The arrays |char_wd|, |char_ht|, |char_dp|, and |char_ic| contain
-pointers to the |memory| array entries where the corresponding dimensions
-appear. Two other arrays, |char_tag| and |char_remainder|, hold
-the other information that \.{TFM} files pack into a |char_info_word|.
-
-@d no_tag=0 {vanilla character}
-@d lig_tag=1 {character has a ligature/kerning program}
-@d list_tag=2 {character has a successor in a charlist}
-@d ext_tag=3 {character is extensible}
-@d bchar_label==char_remainder[xmax_char]
- {beginning of ligature program for left boundary}
-
-@<Glob...@>=
-@!memory:array[pointer] of fix_word; {character dimensions and kerns}
-@!mem_ptr:pointer; {largest |memory| word in use}
-@!link:array[pointer] of pointer; {to make lists of |memory| items}
-@!char_wd:array[char_type] of pointer; {pointers to the widths}
-@!char_ht:array[char_type] of pointer; {pointers to the heights}
-@!char_dp:array[char_type] of pointer; {pointers to the depths}
-@!char_ic:array[char_type] of pointer; {pointers to italic corrections}
-@!char_tag:array[char_type] of no_tag..ext_tag; {character tags}
-@!char_remainder:array[xchar_type] of xchar_type;
- {pointers to ligature labels,
- next larger characters, or extensible characters}
-@!top_width,@!top_height,@!top_depth,@!top_italic:integer;
-
-@ @<Local...@>=
-@!c:integer; {runs through all character codes}
-
-@ @<Set init...@>=
-bchar_label:=xmax_label;
-for c:=0 to max_char do begin
- char_wd[c]:=0; char_ht[c]:=0; char_dp[c]:=0; char_ic[c]:=0;@/
- char_tag[c]:=no_tag; char_remainder[c]:=0;
- end;
-memory[0]:=@'17777777777; {an ``infinite'' element at the end of the lists}
-memory[width]:=0; link[width]:=0; {width list is empty}
-memory[height]:=0; link[height]:=0; {height list is empty}
-memory[depth]:=0; link[depth]:=0; {depth list is empty}
-memory[italic]:=0; link[italic]:=0; {italic list is empty}
-mem_ptr:=italic;
-
-@ As an example of these data structures, let us consider the simple
-routine that inserts a potentially new element into one of the dimension
-lists. The first parameter indicates the list head (i.e., |h=width| for
-the width list, etc.); the second parameter is the value that is to be
-inserted into the list if it is not already present. The procedure
-returns the value of the location where the dimension appears in |memory|.
-The fact that |memory[0]| is larger than any legal dimension makes the
-algorithm particularly short.
-
-We do have to handle two somewhat subtle situations. A width of zero must be
-put into the list, so that a zero-width character in the font will not appear
-to be nonexistent (i.e., so that its |char_wd| index will not be zero), but
-this does not need to be done for heights, depths, or italic corrections.
-Furthermore, it is necessary to test for memory overflow even though we
-have provided room for the maximum number of different dimensions in any
-legal font, since the \.{PL} file might foolishly give any number of
-different sizes to the same character.
-
-@p function sort_in(@!h:pointer;@!d:fix_word):pointer; {inserts into list}
-var p:pointer; {the current node of interest}
-begin if (d=0)and(h<>width) then sort_in:=0
-else begin
- p:=h;
- while d>=memory[link[p]] do p:=link[p];
- if (d=memory[p])and(p<>h) then sort_in:=p
- else if mem_ptr=mem_size then
- begin err_print('Memory overflow: too many widths, etc');
-@.Memory overflow...@>
- print_ln('Congratulations! It''s hard to make this error.');
- sort_in:=p;
- end
- else begin
- incr(mem_ptr); memory[mem_ptr]:=d;
- link[mem_ptr]:=link[p]; link[p]:=mem_ptr; incr(memory[h]);
- sort_in:=mem_ptr;
- end;
- end;
-end;
-
-@ When these lists of dimensions are eventually written to the \.{OFM}
-file, we may have to do some rounding of values, because the \.{OFM} file
-allows at most 65536 widths, 256 heights, 256 depths, and 256 italic
-corrections. The following procedure takes a given list head |h| and a
-given dimension |d|, and returns the minimum $m$ such that the elements
-of the list can be covered by $m$ intervals of width $d$. It also sets
-|next_d| to the smallest value $d^\prime>d$ such that the covering found
-by this procedure would be different. In particular, if $d=0$ it computes
-the number of elements of the list, and sets |next_d| to the smallest
-distance between two list elements. (The covering by intervals of width
-|next_d| is not guaranteed to have fewer than $m$ elements, but in
-practice this seems to happen most of the time.)
-
-@<Glob...@>=
-@!next_d:fix_word; {the next larger interval that is worth trying}
-
-@ Once again we can make good use of the fact that |memory[0]| is ``infinite.''
-
-@p function min_cover(@!h:pointer;@!d:fix_word):integer;
-var p:pointer; {the current node of interest}
-@!l:fix_word; {the least element covered by the current interval}
-@!m:integer; {the current size of the cover being generated}
-begin m:=0; p:=link[h]; next_d:=memory[0];
-while p<>0 do begin
- incr(m); l:=memory[p];
- while memory[link[p]]<=l+d do p:=link[p];
- p:=link[p];
- if memory[p]-l<next_d then next_d:=memory[p]-l;
- end;
-min_cover:=m;
-end;
-
-@ The following procedure uses |min_cover| to determine the smallest $d$
-such that a given list can be covered with at most a given number of
-intervals.
-
-@p function shorten(@!h:pointer;m:integer):fix_word; {finds best way to round}
-var d:fix_word; {the current trial interval length}
-@!k:integer; {the size of a minimum cover}
-begin if memory[h]>m then begin
- excess:=memory[h]-m;
- k:=min_cover(h,0); d:=next_d; {now the answer is at least |d|}
- repeat d:=d+d; k:=min_cover(h,d);
- until k<=m; {first we ascend rapidly until finding the range}
- d:=d div 2; k:=min_cover(h,d); {now we run through the feasible steps}
- while k>m do begin
- d:=next_d; k:=min_cover(h,d);
- end;
- shorten:=d;
- end
-else shorten:=0;
-end;
-
-@ When we are nearly ready to output the \.{TFM} file, we will set
-|index[p]:=k| if the dimension in |memory[p]| is being rounded to the
-|k|th element of its list.
-
-@<Glob...@>=
-@!index:array[pointer] of byte;
-@!excess:byte; {number of words to remove, if list is being shortened}
-
-@ Here is the procedure that sets the |index| values. It also shortens
-the list so that there is only one element per covering interval;
-the remaining elements are the midpoints of their clusters.
-
-@p procedure set_indices(@!h:pointer;@!d:fix_word);
- {reduces and indexes a list}
-var p:pointer; {the current node of interest}
-@!q:pointer; {trails one step behind |p|}
-@!m:byte; {index number of nodes in the current interval}
-@!l:fix_word; {least value in the current interval}
-begin q:=h; p:=link[q]; m:=0;
-while p<>0 do begin
- incr(m); l:=memory[p]; index[p]:=m;
- while memory[link[p]]<=l+d do begin
- p:=link[p]; index[p]:=m; decr(excess);
- if excess=0 then d:=0;
- end;
- link[q]:=p; memory[p]:=l+(memory[p]-l) div 2; q:=p; p:=link[p];
- end;
-memory[h]:=m;
-end;
-
-@* The input phase.
-We're ready now to read and parse the \.{PL} file, storing property
-values as we go.
-
-@<Glob...@>=
-@!c:integer; {the current character or byte being processed}
-@!cprime:char_type; {Processing for several characters together}
-@!crange:char_type; {ditto}
-
-@ @<Read all the input@>=
-cur_char:=" ";
-repeat while cur_char=" " do get_next;
-if cur_char="(" then @<Read a font property value@>
-else if (cur_char=")")and not input_has_ended then begin
- err_print('Extra right parenthesis');
- incr(loc); cur_char:=" ";
- end
-@.Extra right parenthesis@>
-else if not input_has_ended then junk_error;
-until input_has_ended
-
-@ The |junk_error| routine just referred to is called when something
-appears in the forbidden area between properties of a property list.
-
-@p procedure junk_error; {gets past no man's land}
-begin err_print('There''s junk here that is not in parentheses');
-@.There's junk here...@>
-skip_to_paren;
-end;
-
-@ For each font property, we are supposed to read the data from the
-left parenthesis that is the current value of |cur_char| to the right
-parenthesis that matches it in the input. The main complication is
-to recover with reasonable grace from various error conditions that
-might arise.
-
-@<Read a font property value@>=
-begin get_name;
-if cur_code=comment_code then skip_to_end_of_item
-else if (cur_code<110) and (cur_code>character_code) then
- flush_error('This property name doesn''t belong on the outer level')
-else if (cur_code>=110) and ((cur_code mod 10)<>0) then
- flush_error('This property name doesn''t belong on the outer level')
-@.This property name doesn't belong...@>
-else begin @<Read the font property value specified by |cur_code|@>;
- finish_the_property;
- end;
-end
-
-@ @<Read the font property value spec...@>=
-case cur_code of
- check_sum_code: begin
- check_sum_specified:=true;
- read_four_bytes(check_sum_loc);
- end;
- design_size_code: @<Read the design size@>;
- design_units_code: @<Read the design units@>;
- coding_scheme_code: read_BCPL(coding_scheme_loc,40);
- family_code: read_BCPL(family_loc,20);
- face_code: begin
- c:=get_byte; if c>255 then
- begin err_print('FACE clipped to 255'); c:=255 end;
- header_bytes[face_loc]:=c
- end;
- seven_bit_safe_flag_code: @<Read the seven-bit-safe flag@>;
- header_code: @<Read an indexed header word@>;
- font_dimen_code: @<Read font parameter list@>;
- lig_table_code: read_lig_kern;
- boundary_char_code: bchar:=get_byte;
- character_code: read_char_info;
- ofm_level_code: @<Read OFM level code@>;
- font_dir_code: @<Read font direction code@>;
- n_font_dir_code: @<Read natural font direction code@>;
- char_repeat_code: read_repeated_character_info;
- font_rule_code: read_font_rule_list;
- font_glue_code: read_font_glue_list;
- font_penalty_code: read_font_penalty_list;
- font_mvalue_code: read_font_mvalue_list;
- font_fvalue_code: read_font_fvalue_list;
- font_ivalue_code: read_font_ivalue_list;
- end
-
-@ The |case| statement just given makes use of two subroutines that we
-haven't defined yet. The first of these puts a 32-bit octal quantity
-into four specified bytes of the header block.
-
-@p procedure read_four_bytes(l:header_index);
-begin get_four_bytes;
-header_bytes[l]:=c0;
-header_bytes[l+1]:=c1;
-header_bytes[l+2]:=c2;
-header_bytes[l+3]:=c3;
-end;
-
-@ The second little procedure is used to scan a string and to store it in
-the ``{\mc BCPL} format'' required by \.{TFM} files. The string is supposed
-to contain at most |n| bytes, including the first byte (which holds the
-length of the rest of the string).
-
-@p procedure read_BCPL(l:header_index;n:byte);
-var k:header_index;
-begin k:=l;
-while cur_char=" " do get_next;
-while (cur_char<>"(")and(cur_char<>")") do begin
- if k<l+n then incr(k);
- if k<l+n then header_bytes[k]:=cur_char;
- get_next;
- end;
-if k=l+n then begin
- err_print('String is too long; its first ',n-1:1,
-@.String is too long...@>
- ' characters will be kept'); decr(k);
- end;
-header_bytes[l]:=k-l;
-while k<l+n-1 do begin {tidy up the remaining bytes by setting them to nulls}
- incr(k); header_bytes[k]:=0;
- end;
-end;
-
-@ @<Read the design size@>=
-begin next_d:=get_fix;
-if next_d<unity then
- err_print('The design size must be at least 1')
-@.The design size must...@>
-else design_size:=next_d;
-end
-
-@ @<Read the design units@>=
-begin next_d:=get_fix;
-if next_d<=0 then
- err_print('The number of units per design size must be positive')
-@.The number of units...@>
-else design_units:=next_d;
-end
-
-@ @<Read the seven-bit-safe...@>=
-begin while cur_char=" " do get_next;
-if cur_char="T" then seven_bit_safe_flag:=true
-else if cur_char="F" then seven_bit_safe_flag:=false
-else err_print('The flag value should be "TRUE" or "FALSE"');
-@.The flag value should be...@>
-skip_to_paren;
-end
-
-@ @<Read an indexed header word@>=
-begin c:=get_byte;
-if c<18 then skip_error('HEADER indices should be 18 or more')
-@.HEADER indices...@>
-else if 4*c+4>max_header_bytes then
- skip_error('This HEADER index is too big for my present table size')
-@.This HEADER index is too big...@>
-else begin
- while header_ptr<4*c+4 do begin
- header_bytes[header_ptr]:=0; incr(header_ptr);
- end;
- read_four_bytes(4*c);
- end;
-end
-
-@ The remaining kinds of font property values that need to be read are
-those that involve property lists on higher levels. Each of these has a
-loop similar to the one that was used at level zero. Then we put the
-right parenthesis back so that `|finish_the_property|' will be happy;
-there is probably a more elegant way to do this.
-
-@d finish_inner_property_list==begin decr(loc); incr(level); cur_char:=")";
- end
-
-@<Read font parameter list@>=
-begin while level=1 do begin
- while cur_char=" " do get_next;
- if cur_char="(" then @<Read a parameter value@>
- else if cur_char=")" then skip_to_end_of_item
- else junk_error;
- end;
-finish_inner_property_list;
-end
-
-@ @<Read a parameter value@>=
-begin get_name;
-if cur_code=comment_code then skip_to_end_of_item
-else if (cur_code<parameter_code)or(cur_code>=char_wd_code) then
- flush_error('This property name doesn''t belong in a FONTDIMEN list')
-@.This property name doesn't belong...@>
-else begin
- if cur_code=parameter_code then c:=get_integer
- else c:=cur_code-parameter_code;
- if c=0 then flush_error('PARAMETER index must not be zero')
-@.PARAMETER index must not...@>
- else if c>max_param_words then
- flush_error('This PARAMETER index is too big for my present table size')
-@.This PARAMETER index is too big...@>
- else begin
- while np<c do begin
- incr(np); param[np]:=0;
- end;
- param[c]:=get_fix;
- finish_the_property;
- end;
- end;
-end
-
-@ @<Read ligature/kern list@>=
-begin lk_step_ended:=false;
-while level=1 do begin
- while cur_char=" " do get_next;
- if cur_char="(" then read_lig_kern_command
- else if cur_char=")" then skip_to_end_of_item
- else junk_error;
- end;
-finish_inner_property_list;
-end
-
-@ @<Read a ligature/kern command@>=
-begin get_name;
-if cur_code=comment_code then skip_to_end_of_item
-else if (cur_code>=label_code) and (cur_code<=(lig_code+11)) then begin
- case cur_code of
- label_code:@<Read a label step@>;
- stop_code:@<Read a stop step@>;
- skip_code:@<Read a skip step@>;
- krn_code:@<Read a kerning step@>;
- lig_code,lig_code+1,lig_code+2,lig_code+3,lig_code+5,
- lig_code+6,lig_code+7,lig_code+11:@<Read a ligature step@>;
- end; {there are no other cases |>=label_code|}
- finish_the_property;
-end
-else if (cur_code>=clabel_code) and (cur_code<=cpenglue_code) then begin
- case cur_code of
- clabel_code:@<Read an extended label step@>;
- cpen_code:@<Read an extended penalty step@>;
- cglue_code:@<Read an extended glue step@>;
- cpenglue_code:@<Read an extended penalty/glue step@>;
- ckrn_code:@<Read an extended kern step@>;
- end; {there are no other cases |>=label_code|}
- finish_the_property;
-end
-else flush_error('This property name doesn''t belong in a LIGTABLE list');
-@.This property name doesn't belong...@>
-end
-
-@ When a character is about to be tagged, we call the following
-procedure so that an error message is given in case of multiple tags.
-
-@p procedure check_tag(c:integer); {print error if |c| already tagged}
-begin case char_tag[c] of
- no_tag: do_nothing;
- lig_tag: err_print('This character already appeared in a LIGTABLE LABEL');
-@.This character already...@>
- list_tag: err_print('This character already has a NEXTLARGER spec');
- ext_tag: err_print('This character already has a VARCHAR spec');
- end;
-end;
-
-@ @<Read a label step@>=
-begin while cur_char=" " do get_next;
-if cur_char="B" then begin
- bchar_label:=nl; skip_to_paren; {\.{LABEL BOUNDARYCHAR}}
- end
-else begin
- backup; c:=get_byte;
- check_tag(c); char_tag[c]:=lig_tag; char_remainder[c]:=nl;
- end;
-if min_nl<=nl then min_nl:=nl+1;
-lk_step_ended:=false;
-end
-
-@ @d stop_flag=128 {value indicating `\.{STOP}' in a lig/kern program}
-@d kern_flag=128 {op code for a kern step}
-
-@<Globals...@>=
-@!lk_step_ended:boolean;
- {was the last \.{LIGTABLE} property \.{LIG} or \.{KRN}?}
-@!krn_ptr:0..max_kerns; {an index into |kern|}
-
-@ @<Read a stop step@>=
-if not lk_step_ended then
- err_print('STOP must follow LIG or KRN')
-@.STOP must follow LIG or KRN@>
-else begin
- lig_kern[nl-1].b0:=lig_kern[nl-1].b0 div 256 * 256 + stop_flag;
- lk_step_ended:=false;
- end
-
-@ @<Read a skip step@>=
-if not lk_step_ended then
- err_print('SKIP must follow LIG or KRN')
-@.SKIP must follow LIG or KRN@>
-else begin
- c:=get_byte;
- if c>=128 then err_print('Maximum SKIP amount is 127')
-@.Maximum SKIP amount...@>
- else if nl+c>=max_lig_steps then
- err_print('Sorry, LIGTABLE too long for me to handle')
-@.Sorry, LIGTABLE too long...@>
- else begin
- lig_kern[nl-1].b0:=c;
- if min_nl<=nl+c then min_nl:=nl+c+1;
- end;
- lk_step_ended:=false;
- end
-
-@ @<Read a ligature step@>=
-begin lig_kern[nl].b0:=0;
-lig_kern[nl].b2:=cur_code-lig_code;
-lig_kern[nl].b1:=get_byte;
-lig_kern[nl].b3:=get_byte;
-if nl>=max_lig_steps-1 then
- err_print('Sorry, LIGTABLE too long for me to handle')
-@.Sorry, LIGTABLE too long...@>
-else incr(nl);
-lk_step_ended:=true;
-end
-
-@ @<Read a kerning step@>=
-begin lig_kern[nl].b0:=0; lig_kern[nl].b1:=get_byte;
-kern[nk]:=get_fix; krn_ptr:=0;
-while kern[krn_ptr]<>kern[nk] do incr(krn_ptr);
-if krn_ptr=nk then begin
- if nk<max_kerns then incr(nk)
- else begin
- err_print('Sorry, too many different kerns for me to handle');
-@.Sorry, too many different kerns...@>
- decr(krn_ptr);
- end;
- end;
-if ofm_level=-1 then begin
- lig_kern[nl].b2:=kern_flag+(krn_ptr div 256);
- lig_kern[nl].b3:=krn_ptr mod 256;
- end
-else begin
- lig_kern[nl].b2:=kern_flag+(krn_ptr div 65536);
- lig_kern[nl].b3:=krn_ptr mod 65536;
- end;
-if nl>=max_lig_steps-1 then
- err_print('Sorry, LIGTABLE too long for me to handle')
-@.Sorry, LIGTABLE too long...@>
-else incr(nl);
-lk_step_ended:=true;
-end
-
-@ @<Global...@>=
-@!category_remainders:array[0..256] of integer;
-@!ivalue_category,@!max_ivalue_category:integer;
-@!glue_category,@!max_glue_category:integer;
-@!penalty_category,@!max_penalty_category:integer;
-
-@ @<Set init...@>=
-for ivalue_category:=0 to 256 do begin
- category_remainders[ivalue_category]:=-1;
- end;
-max_ivalue_category:=-1;
-max_glue_category:=-1;
-max_penalty_category:=-1;
-
-@ @<Read an extended label step@>=
-begin
-c:=get_byte;
-category_remainders[c]:=nl;
-if max_ivalue_category<c then max_ivalue_category:=c;
-if min_nl<=nl then min_nl:=nl+1;
-lk_step_ended:=false;
-end
-
-@ @<Read an extended penalty step@>=
-begin lig_kern[nl].b0:=256; lig_kern[nl].b1:=get_byte;
-lig_kern[nl].b2:=17;
-penalty_category:=get_byte;
-if max_penalty_category<penalty_category then
- max_penalty_category:=penalty_category;
-lig_kern[nl].b3:=penalty_category;
-if nl>=max_lig_steps-1 then
- err_print('Sorry, LIGTABLE too long for me to handle')
-@.Sorry, LIGTABLE too long...@>
-else incr(nl);
-lk_step_ended:=true;
-end
-
-@ @<Read an extended glue step@>=
-begin lig_kern[nl].b0:=256; lig_kern[nl].b1:=get_byte;
-lig_kern[nl].b2:=18;
-glue_category:=get_byte;
-if max_glue_category<glue_category then
- max_glue_category:=glue_category;
-lig_kern[nl].b3:=glue_category;
-if nl>=max_lig_steps-1 then
- err_print('Sorry, LIGTABLE too long for me to handle')
-@.Sorry, LIGTABLE too long...@>
-else incr(nl);
-lk_step_ended:=true;
-end
-
-@ @<Read an extended penalty/glue step@>=
-begin lig_kern[nl].b0:=256; lig_kern[nl].b1:=get_byte;
-lig_kern[nl].b2:=19;
-penalty_category:=get_byte;
-if max_penalty_category<penalty_category then
- max_penalty_category:=penalty_category;
-glue_category:=get_byte;
-if max_glue_category<glue_category then
- max_glue_category:=glue_category;
-lig_kern[nl].b3:=penalty_category*256+glue_category;
-if nl>=max_lig_steps-1 then
- err_print('Sorry, LIGTABLE too long for me to handle')
-@.Sorry, LIGTABLE too long...@>
-else incr(nl);
-lk_step_ended:=true;
-end
-
-@ @<Read an extended kern step@>=
-begin lig_kern[nl].b0:=256; lig_kern[nl].b1:=get_byte;
-lig_kern[nl].b2:=20;
-kern[nk]:=get_fix; krn_ptr:=0;
-while kern[krn_ptr]<>kern[nk] do incr(krn_ptr);
-if krn_ptr=nk then begin
- if nk<max_kerns then incr(nk)
- else begin
- err_print('Sorry, too many different kerns for me to handle');
-@.Sorry, too many different kerns...@>
- decr(krn_ptr);
- end;
- end;
-if krn_ptr>65535 then
- err_print('Sorry, too many different kerns for me to handle');
-lig_kern[nl].b3:=krn_ptr;
-if nl>=max_lig_steps-1 then
- err_print('Sorry, LIGTABLE too long for me to handle')
-@.Sorry, LIGTABLE too long...@>
-else incr(nl);
-lk_step_ended:=true;
-end
-
-@ @<Globals...@>=
-@!char_extended_tag:array [char_type] of boolean;
-
-@ @<Set init...@>=
-for c:=0 to max_char do
- char_extended_tag[c]:=false;
-
-@ @<Finish up the extended font stuff@>=
-begin
-if max_penalty_category>0 then begin
- if nkp=0 then
- err_print('No PENALTY table')
- else if npp[0]<max_penalty_category then
- err_print('Not enough PENALTY entries');
- end;
-if max_glue_category>0 then begin
- if nkg=0 then
- err_print('No GLUE table')
- else if npg[0]<max_glue_category then
- err_print('Not enough GLUE entries');
- end;
-if max_ivalue_category>0 then begin
- if nki=0 then
- err_print('No IVALUE table')
- else if npi[0]<max_ivalue_category then
- err_print('Not enough IVALUE entries')
- else begin
- for c:=0 to max_char do begin
- if (char_wd[c]<>0) then begin
- for j:=0 to max_ivalue_category do
- if char_table[c,0]=j then begin
- if category_remainders[j]<>-1 then begin
- if char_tag[c]<>0 then
- err_print('Character already has a tag')
- else begin
- char_extended_tag[c]:=true;
- char_remainder[c]:=category_remainders[j];
- end;
- end;
- end;
- end;
- end;
- end;
- end;
-end
-
-@ @<Global...@>=
-tables_read:boolean;
-
-@ @<Set init...@>=
-tables_read:=false;
-
-@ Finally we come to the part of \.{PLtoTF}'s input mechanism
-that is used most, the processing of individual character data.
-
-@<Read character info list@>=
-begin
-if not tables_read then begin
- compute_new_header_ofm;
- tables_read:=true;
- end;
-c:=get_byte; {read the character code that is being specified}
-@<Print |c| in hex notation@>;
-while level=1 do begin
- while cur_char=" " do get_next;
- if cur_char="(" then read_character_property
- else if cur_char=")" then skip_to_end_of_item
- else junk_error;
- end;
-if char_wd[c]=0 then char_wd[c]:=sort_in(width,0); {legitimatize |c|}
-finish_inner_property_list;
-end
-
-@ @<Globals...@>=
-@!char_original:array [0..max_char] of integer;
-@!char_repeats:array [0..max_char] of integer;
-@!diff:boolean;
-@!needed_space,@!extra_bytes:integer;
-
-@ @<Set init...@>=
-for ch_entry:=0 to max_char do begin
- char_original[ch_entry]:=ch_entry;
- char_repeats[ch_entry]:=0;
- end;
-
-@ @<Read repeated character info@>=
-begin
-if not tables_read then begin
- @<Compute the new header information for OFM files@>;
- tables_read:=true;
- end;
-c:=get_byte; {read the character code that is being specified}
-@<Print |c| in hex notation@>;
-crange:=get_byte; {read how many characters are being defined}
-if (crange<0) then begin
- err_print('Character ranges must be positive');
- crange:=0;
- end;
-if ((c+crange)>max_char) then begin
- err_print('Character range too large');
- crange:=0;
- end;
-print('-'); print_hex(c+crange);
-while level=1 do begin
- while cur_char=" " do get_next;
- if cur_char="(" then read_character_property
- else if cur_char=")" then skip_to_end_of_item
- else junk_error;
- end;
-if char_wd[c]=0 then char_wd[c]:=sort_in(width,0); {legitimatize |c|}
-finish_inner_property_list;
-cprime:=c;
-for c:=(cprime+1) to (cprime+crange) do begin
- char_wd[c]:=char_wd[cprime];
- char_ht[c]:=char_ht[cprime];
- char_dp[c]:=char_dp[cprime];
- char_ic[c]:=char_ic[cprime];
- for tab:=0 to (nki+nkf+nkr+nkg+nkp-1) do begin
- char_table[c,tab]:= char_table[cprime,tab];
- end;
- end;
-end
-
-@ Tables for character parameters
-
-@d char_param_tables==8
-
-@<Globals...@>=
-@!char_table:array [0..max_char,0..char_param_tables] of integer;
-@!ch_table,@!ch_entry:integer;
-@!temp_value:integer;
-
-@ @<Set init...@>=
-for c:=0 to max_char do
- for ch_table:=0 to char_param_tables do
- char_table[c,ch_table]:=0;
-
-@ @<Read a character property@>=
-begin get_name;
-if cur_code=comment_code then skip_to_end_of_item
-else if (cur_code<char_wd_code)or
- ((cur_code>var_char_code)and
- ((cur_code<char_ivalue_code)or(cur_code>char_penalty_code)))
-then
- flush_error('This property name doesn''t belong in a CHARACTER list')
-@.This property name doesn't belong...@>
-else begin
- case cur_code of
- char_wd_code:char_wd[c]:=sort_in(width,get_fix);
- char_ht_code:char_ht[c]:=sort_in(height,get_fix);
- char_dp_code:char_dp[c]:=sort_in(depth,get_fix);
- char_ic_code:char_ic[c]:=sort_in(italic,get_fix);
- sec_width_code:temp_value:=get_fix;
- sec_height_code:temp_value:=get_fix;
- sec_depth_code:temp_value:=get_fix;
- sec_italic_code:temp_value:=get_fix;
- accent_code:temp_value:=get_fix;
- prim_top_axis_code:temp_value:=get_fix;
- prim_top_axis_bis_code:temp_value:=get_fix;
- prim_bot_axis_code:temp_value:=get_fix;
- prim_bot_axis_bis_code:temp_value:=get_fix;
- prim_mid_hor_code:temp_value:=get_fix;
- prim_mid_vert_code:temp_value:=get_fix;
- prim_base_slant_code:temp_value:=get_fix;
- sec_top_axis_code:temp_value:=get_fix;
- sec_top_axis_bis_code:temp_value:=get_fix;
- sec_bot_axis_code:temp_value:=get_fix;
- sec_bot_axis_bis_code:temp_value:=get_fix;
- sec_mid_hor_code:temp_value:=get_fix;
- sec_mid_vert_code:temp_value:=get_fix;
- sec_base_slant_code:temp_value:=get_fix;
- next_larger_code:begin check_tag(c); char_tag[c]:=list_tag;
- char_remainder[c]:=get_byte;
- end;
- var_char_code:@<Read an extensible recipe for |c|@>;
- char_ivalue_code: begin
- ch_table:=get_integer;
- ch_entry:=get_integer;
- char_table[c,ch_table]:=ch_entry;
- if ch_table>nkci then nkci:=ch_table;
- end;
- char_fvalue_code: begin
- ch_table:=get_integer+nki;
- ch_entry:=get_integer;
- char_table[c,ch_table]:=ch_entry;
- if ch_table>nkcf then nkcf:=ch_table;
- end;
- char_mvalue_code: begin
- ch_table:=get_integer+nki+nkf;
- ch_entry:=get_integer;
- char_table[c,ch_table]:=ch_entry;
- if ch_table>nkcm then nkcm:=ch_table;
- end;
- char_rule_code: begin
- ch_table:=get_integer+nki+nkf+nkm;
- ch_entry:=get_integer;
- char_table[c,ch_table]:=ch_entry;
- if ch_table>nkcr then nkcr:=ch_table;
- end;
- char_glue_code: begin
- ch_table:=get_integer+nki+nkf+nkm+nkr;
- ch_entry:=get_integer;
- char_table[c,ch_table]:=ch_entry;
- if ch_table>nkcg then nkcg:=ch_table;
- end;
- char_penalty_code: begin
- ch_table:=get_integer+nki+nkf+nkm+nkr+nkg;
- ch_entry:=get_integer;
- char_table[c,ch_table]:=ch_entry;
- if ch_table>nkcp then nkcp:=ch_table;
- end;
- end;@/
- finish_the_property;
- end;
-end
-
-@ @<Read an extensible r...@>=
-begin if ne=xmax_char then
- err_print('Sorry, too many VARCHAR specs')
-@.Sorry, too many VARCHAR specs@>
-else begin
- check_tag(c); char_tag[c]:=ext_tag; char_remainder[c]:=ne;@/
- exten[ne]:=zero_bytes;
- while level=2 do begin
- while cur_char=" " do get_next;
- if cur_char="(" then @<Read an extensible piece@>
- else if cur_char=")" then skip_to_end_of_item
- else junk_error;
- end;
- incr(ne);
- finish_inner_property_list;
- end;
-end
-
-@ @<Read an extensible p...@>=
-begin get_name;
-if cur_code=comment_code then skip_to_end_of_item
-else if (cur_code<var_char_code+1)or(cur_code>var_char_code+4) then
- flush_error('This property name doesn''t belong in a VARCHAR list')
-@.This property name doesn't belong...@>
-else begin
- case cur_code-(var_char_code+1) of
- 0:exten[ne].b0:=get_byte;
- 1:exten[ne].b1:=get_byte;
- 2:exten[ne].b2:=get_byte;
- 3:exten[ne].b3:=get_byte;
- end;@/
- finish_the_property;
- end;
-end
-
-@ The input routine is now complete except for the following code,
-which prints a progress report as the file is being read.
-@<Glob...@>=
-@!ASCII_04,@!ASCII_10,@!ASCII_14,HEX: packed array [1..32] of char;
- {strings for output in the user's external character set}
-@!MBL_string,@!RI_string,@!RCE_string:packed array [1..3] of char;
- {handy string constants for |face| codes}
-
-@ @<Set init...@>=
-ASCII_04:=' !"#$%&''()*+,-./0123456789:;<=>?';@/
-ASCII_10:='@@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_';@/
-ASCII_14:='`abcdefghijklmnopqrstuvwxyz{|}~ ';@/
-HEX:='0123456789ABCDEF';@/
-MBL_string:='MBL'; RI_string:='RI '; RCE_string:='RCE';
-
-@ The array |dig| will hold a sequence of digits to be output.
-
-@<Glob...@>=
-@!dig:array[0..32] of integer;
-
-@ Here, in fact, are two procedures that output
-|dig[j-1]|$\,\ldots\,$|dig[0]|, given $j>0$.
-
-@p procedure out_digs(j:integer); {outputs |j| digits}
-begin repeat decr(j); out(HEX[1+dig[j]]);
-until j=0;
-end;
-@#
-procedure print_digs(j:integer); {prints |j| digits}
-begin repeat decr(j); print(HEX[1+dig[j]]);
-until j=0;
-end;
-
-
-@ The |print_number| procedure indicates how |print_digs| can be used.
-This procedure can print in octal, decimal or hex notation.
-
-@d print_hex(#)==print_number(#,16)
-@d print_octal(#)==print_number(#,8)
-@d print_decimal(#)==print_number(#,10)
-
-@p procedure print_number(c:integer; form:integer); {prints value of |c|}
-var j:0..32; {index into |dig|}
-begin
-j:=0;
-if (c<0) then begin
- print_ln('Internal error: print_number (negative value)');
- c:=0
- end;
-if form=8 then
- print('''') {an apostrophe indicates the octal notation}
-else if form=16 then
- print('"') { a double apostrophe indicates the hexadecimal notation}
-else if form<>10 then begin
- print_ln('Internal error: print_number');
- form:=10
- end;
-while (c>0) or (j=0) do begin
- dig[j]:=c mod form; c:=c div form;
- j:=j+1;
- end;
-print_digs(j);
-end;
-
-
-@ @<Print |c| in hex...@>=
-begin if chars_on_line=8 then begin
- print_ln(' '); chars_on_line:=1;
- end
-else begin
- if chars_on_line>0 then print(' ');
- incr(chars_on_line);
- end;
-print_hex(c); {progress report}
-end
-
-@* The checking and massaging phase.
-Once the whole \.{PL} file has been read in, we must check it for consistency
-and correct any errors. This process consists mainly of running through
-the characters that exist and seeing if they refer to characters that
-don't exist. We also compute the true value of |seven_unsafe|; we make sure
-that the charlists and ligature programs contain no loops; and we
-shorten the lists of widths, heights, depths, and italic corrections,
-if necessary, to keep from exceeding the required maximum sizes.
-
-@<Glob...@>=
-@!seven_unsafe:boolean; {do seven-bit characters generate eight-bit ones?}
-
-@ @<Correct and check the information@>=
-if nl>0 then @<Make sure the ligature/kerning program ends appropriately@>;
-seven_unsafe:=false;
-for c:=0 to max_char do if char_wd[c]<>0 then
- @<For all characters |g| generated by |c|,
- make sure that |char_wd[g]| is nonzero, and
- set |seven_unsafe| if |c<128<=g|@>;
-if bchar_label<xmax_label then begin
- c:=xmax_char; @<Check ligature program of |c|@>;
- end;
-if seven_bit_safe_flag and seven_unsafe then
- print_ln('The font is not really seven-bit-safe!');
-@.The font is not...safe@>
-@<Check for infinite ligature loops@>;
-@<Doublecheck the lig/kern commands and the extensible recipes@>;
-finish_extended_font;
-for c:=0 to max_char do
- @<Make sure that |c| is not the largest element of a charlist cycle@>;
-@<Put the width, height, depth, and italic lists into final form@>
-
-@ The checking that we need in several places is accomplished by three
-macros that are only slightly tricky.
-
-@d existence_tail(#)==begin char_wd[g]:=sort_in(width,0);
- print(#,' '); print_hex(c);
- print_ln(' had no CHARACTER spec.');
- end;
- end
-@d check_existence_and_safety(#)==begin g:=#;
- if (g>=128)and(c<128) then seven_unsafe:=true;
- if char_wd[g]=0 then existence_tail
-@d check_existence(#)==begin g:=#;
- if char_wd[g]=0 then existence_tail
-
-@<For all characters |g| generated by |c|...@>=
-case char_tag[c] of
- no_tag: do_nothing;
- lig_tag: @<Check ligature program of |c|@>;
- list_tag: check_existence_and_safety(char_remainder[c])
- ('The character NEXTLARGER than');
-@.The character NEXTLARGER...@>
- ext_tag:@<Check the pieces of |exten[c]|@>;
- end
-
-@ @<Check the pieces...@>=
-begin if exten[char_remainder[c]].b0>0 then
- check_existence_and_safety(exten[char_remainder[c]].b0)
- ('TOP piece of character');
-@.TOP piece of character...@>
-if exten[char_remainder[c]].b1>0 then
- check_existence_and_safety(exten[char_remainder[c]].b1)
- ('MID piece of character');
-@.MID piece of character...@>
-if exten[char_remainder[c]].b2>0 then
- check_existence_and_safety(exten[char_remainder[c]].b2)
- ('BOT piece of character');
-@.BOT piece of character...@>
-check_existence_and_safety(exten[char_remainder[c]].b3)
- ('REP piece of character');
-@.REP piece of character...@>
-end
-
-@ @<Make sure that |c| is not the largest element of a charlist cycle@>=
-if char_tag[c]=list_tag then begin
- g:=char_remainder[c];
- while (g<c)and(char_tag[g]=list_tag) do g:=char_remainder[g];
- if g=c then begin
- char_tag[c]:=no_tag;
- print('A cycle of NEXTLARGER characters has been broken at ');
-@.A cycle of NEXTLARGER...@>
- print_hex(c); print_ln('.');
- end;
- end
-
-@ @<Global...@>=
-@!delta:fix_word; {size of the intervals needed for rounding}
-
-@ @d round_message(#)==if delta>0 then print_ln('I had to round some ',
-@.I had to round...@>
- #,'s by ',(((delta+1) div 2)/@'4000000):1:7,' units.')
-
-@<Put the width, height, depth, and italic lists into final form@>=
-case ofm_level of
- -1: begin
- top_width:=255; top_depth:=15; top_height:=15; top_italic:=63;
- end;
- 0: begin
- top_width:=65535; top_depth:=255; top_height:=255; top_italic:=255;
- end;
- 1: begin
- top_width:=65535; top_depth:=255; top_height:=255; top_italic:=255;
- end;
- end;
-delta:=shorten(width,top_width); set_indices(width,delta);
- round_message('width');@/
-delta:=shorten(height,top_height); set_indices(height,delta);
- round_message('height');@/
-delta:=shorten(depth,top_depth); set_indices(depth,delta);
- round_message('depth');@/
-delta:=shorten(italic,top_italic); set_indices(italic,delta);
- round_message('italic correction');
-
-@ @d clear_lig_kern_entry== {make an unconditional \.{STOP}}
- lig_kern[nl].b0:=255; lig_kern[nl].b1:=0;
- lig_kern[nl].b2:=0; lig_kern[nl].b3:=0
-
-@<Make sure the ligature/kerning program ends...@>=
-begin if bchar_label<xmax_label then {make room for it} begin
- clear_lig_kern_entry; incr(nl);
- end; {|bchar_label| will be stored later}
-while min_nl>nl do begin
- clear_lig_kern_entry; incr(nl);
- end;
-if (lig_kern[nl-1].b0 mod 256)=0 then
- lig_kern[nl-1].b0:=lig_kern[nl-1].b0 div 256 * 256 + stop_flag;
-end
-
-@ It's not trivial to check for infinite loops generated by repeated
-insertion of ligature characters. But fortunately there is a nice
-algorithm for such testing, copied here from the program \.{TFtoPL}
-where it is explained further.
-
-@d simple=0 {$f(x,y)=z$}
-@d left_z=1 {$f(x,y)=f(z,y)$}
-@d right_z=2 {$f(x,y)=f(x,z)$}
-@d both_z=3 {$f(x,y)=f(f(x,z),y)$}
-@d pending=4 {$f(x,y)$ is being evaluated}
-
-
-@ @<Glo...@>=
-@!lig_ptr:0..max_lig_steps; {an index into |lig_kern|}
-@!hash:array[0..hash_size] of integer;
-@!class:array[0..hash_size] of simple..pending;
-@!lig_z:array[0..hash_size] of xxchar_type;
-@!hash_ptr:0..hash_size; {the number of nonzero entries in |hash|}
-@!hash_list:array[0..hash_size] of 0..hash_size; {list of those nonzero entries}
-@!h,@!hh:0..hash_size; {indices into the hash table}
-@!tt:indx; {temporary register}
-@!x_lig_cycle,@!y_lig_cycle:xchar_type; {problematic ligature pair}
-
-@ @<Set init...@>=
-hash_ptr:=0; y_lig_cycle:=xmax_char;
-for k:=0 to hash_size do hash[k]:=0;
-
-@ @d lig_exam==lig_kern[lig_ptr].b1
-@d lig_gen==lig_kern[lig_ptr].b3
-
-@<Check lig...@>=
-begin lig_ptr:=char_remainder[c];
-if (lig_kern[lig_ptr].b0 div 256)=0 then
-begin
-repeat if hash_input(lig_ptr,c) then begin
- if lig_kern[lig_ptr].b2<kern_flag then begin
- if lig_exam<>bchar then
- check_existence(lig_exam)('LIG character examined by');
-@.LIG character examined...@>
- check_existence(lig_gen)('LIG character generated by');
-@.LIG character generated...@>
- if lig_gen>=128 then if(c<128)or(c=bchar) then
- if(lig_exam<128)or(lig_exam=bchar) then seven_unsafe:=true;
- end
- else if lig_exam<>bchar then
- check_existence(lig_exam)('KRN character examined by');
-@.KRN character examined...@>
- end;
-if (lig_kern[lig_ptr].b0 mod 256)>=stop_flag then lig_ptr:=nl
-else lig_ptr:=lig_ptr+1+lig_kern[lig_ptr].b0;
-until lig_ptr>=nl;
-end;
-end
-
-@ The |hash_input| procedure is copied from \.{TFtoPL}, but it is made
-into a boolean function that returns |false| if the ligature command
-was masked by a previous one.
-
-@p function hash_input(@!p,@!c:indx):boolean;
- {enter data for character |c| and command in location |p|, unless it isn't new}
-label 30; {go here for a quick exit}
-var @!cc:simple..both_z; {class of data being entered}
-@!zz:char_type; {function value or ligature character being entered}
-@!y:char_type; {the character after the cursor}
-@!key:integer; {value to be stored in |hash|}
-@!t:integer; {temporary register for swapping}
-begin if hash_ptr=hash_size then
- begin hash_input:=false; goto 30;@+end;
-@<Compute the command parameters |y|, |cc|, and |zz|@>;
-key:=xmax_char*c+y+1; h:=(hash_mult*(key mod hash_size)) mod hash_size;
-while hash[h]>0 do begin
- if hash[h]<=key then begin
- if hash[h]=key then begin
- hash_input:=false; goto 30; {unused ligature command}
- end;
- t:=hash[h]; hash[h]:=key; key:=t; {do ordered-hash-table insertion}
- t:=class[h]; class[h]:=cc; cc:=t; {namely, do a swap}
- t:=lig_z[h]; lig_z[h]:=zz; zz:=t;
- end;
- if h>0 then decr(h)@+else h:=hash_size;
- end;
-hash[h]:=key; class[h]:=cc; lig_z[h]:=zz;
-incr(hash_ptr); hash_list[hash_ptr]:=h;
-hash_input:=true;
-30:end;
-
-@ @<Compute the command param...@>=
-y:=lig_kern[p].b1; t:=lig_kern[p].b2; cc:=simple;
-zz:=lig_kern[p].b3;
-if t>=kern_flag then zz:=y
-else begin
- case t of
- 0,6:do_nothing; {\.{LIG},\.{/LIG>}}
- 5,11:zz:=y; {\.{LIG/>}, \.{/LIG/>>}}
- 1,7:cc:=left_z; {\.{LIG/}, \.{/LIG/>}}
- 2:cc:=right_z; {\.{/LIG}}
- 3:cc:=both_z; {\.{/LIG/}}
- end; {there are no other cases}
- end
-
-@ (More good stuff from \.{TFtoPL}.)
-
-@p function f(@!h,@!x,@!y:indx):indx; forward;@t\2@>
- {compute $f$ for arguments known to be in |hash[h]|}
-function eval(@!x,@!y:indx):indx; {compute $f(x,y)$ with hashtable lookup}
-var @!key:integer; {value sought in hash table}
-begin key:=xmax_char*x+y+1; h:=(hash_mult*key) mod hash_size;
-while hash[h]>key do
- if h>0 then decr(h)@+else h:=hash_size;
-if hash[h]<key then eval:=y {not in ordered hash table}
-else eval:=f(h,x,y);
-end;
-
-@ Pascal's beastly convention for |forward| declarations prevents us from
-saying |function f(h,x,y:indx):indx| here.
-
-@p function f;
-begin
-case class[h] of
- simple: do_nothing;
- left_z: begin class[h]:=pending; lig_z[h]:=eval(lig_z[h],y); class[h]:=simple;
- end;
- right_z: begin class[h]:=pending; lig_z[h]:=eval(x,lig_z[h]); class[h]:=simple;
- end;
- both_z: begin class[h]:=pending; lig_z[h]:=eval(eval(x,lig_z[h]),y);
- class[h]:=simple;
- end;
- pending: begin x_lig_cycle:=x; y_lig_cycle:=y;
- lig_z[h]:=xxmax_char; class[h]:=simple;
- end; {the value |xxmax_char| will break all cycles,
- since it's not in |hash|}
- end; {there are no other cases}
-f:=lig_z[h];
-end;
-
-@ @<Check for infinite...@>=
-if hash_ptr<hash_size then for hh:=1 to hash_ptr do begin
- tt:=hash_list[hh];
- if class[tt]>simple then {make sure $f$ is well defined}
- tt:=f(tt,(hash[tt]-1)div xmax_char,(hash[tt]-1)mod xmax_char);
- end;
-if(hash_ptr=hash_size)or(y_lig_cycle<xmax_char) then begin
- if hash_ptr<hash_size then begin
- print('Infinite ligature loop starting with ');
-@.Infinite ligature loop...@>
- if x_lig_cycle=xmax_char
- then print('boundary')@+else print_hex(x_lig_cycle);
- print(' and '); print_hex(y_lig_cycle); print_ln('!');
- end
- else print_ln('Sorry, I haven''t room for so many ligature/kern pairs!');
-@.Sorry, I haven't room...@>
- print_ln('All ligatures will be cleared.');
- for c:=0 to max_char do if char_tag[c]=lig_tag then begin
- char_tag[c]:=no_tag; char_remainder[c]:=0;
- end;
- nl:=0; bchar:=xmax_char; bchar_label:=xmax_label;
- end
-
-@ The lig/kern program may still contain references to nonexistent characters,
-if parts of that program are never used. Similarly, there may be extensible
-characters that are never used, because they were overridden by
-\.{NEXTLARGER}, say. This would produce an invalid \.{TFM} file; so we
-must fix such errors.
-
-@d double_check_tail(#)==@t\1@>if char_wd[0]=0
- then char_wd[0]:=sort_in(width,0);
- print('Unused ',#,' refers to nonexistent character ');
- print_hex(c); print_ln('!');
- end;
- end
-@d double_check_lig(#)==begin c:=lig_kern[lig_ptr].#;
- if char_wd[c]=0 then if c<>bchar then
- begin lig_kern[lig_ptr].#:=0; double_check_tail
-@d double_check_ext(#)==begin c:=exten[g].#;
- if c>0 then if char_wd[c]=0 then
- begin exten[g].#:=0; double_check_tail
-@d double_check_rep(#)==begin c:=exten[g].#;
- if char_wd[c]=0 then
- begin exten[g].#:=0; double_check_tail
-
-@<Doublecheck...@>=
-if nl>0 then for lig_ptr:=0 to nl-1 do
- if (lig_kern[lig_ptr].b0 div 256)=0 then begin
- if lig_kern[lig_ptr].b2<kern_flag then begin
- if lig_kern[lig_ptr].b0<255 then begin
- double_check_lig(b1)('LIG step'); double_check_lig(b3)('LIG step');
- end;
- end
- else double_check_lig(b1)('KRN step');
- end;
-@.Unused LIG step...@>
-@.Unused KRN step...@>
-if ne>0 then for g:=0 to ne-1 do begin
- double_check_ext(b0)('VARCHAR TOP');
- double_check_ext(b1)('VARCHAR MID');
- double_check_ext(b2)('VARCHAR BOT');
- double_check_rep(b3)('VARCHAR REP');
-@.Unused VARCHAR...@>
- end
-
-@* The output phase.
-Now that we know how to get all of the font data correctly stored in
-\.{PLtoTF}'s memory, it only remains to write the answers out.
-
-First of all, it is convenient to have an abbreviation for output to the
-\.{TFM} file:
-
-@d out(#)==write(tfm_file,#)
-
-@ The general plan for producing \.{TFM} files is long but simple:
-
-@<Do the font metric output@>=
-compute_subfile_sizes;
-output_subfile_sizes;
-@<Output the header block@>;
-output_new_information_ofm;
-output_character_info;
-@<Output the dimensions themselves@>;
-@<Output the ligature/kern program@>;
-@<Output the extensible character recipes@>;
-@<Output the parameters@>;
-
-@ A \.{TFM} file begins with 12 numbers that tell how big its subfiles are.
-We already know most of these numbers; for example, the number of distinct
-widths is |memory[width]+1|, where the $+1$ accounts for the zero width that
-is always supposed to be present. But we still should compute the beginning
-and ending character codes (|bc| and |ec|), the number of header words (|lh|),
-and the total number of words in the \.{TFM} file (|lf|).
-
-@<Gl...@>=
-@!bc:byte; {the smallest character code in the font}
-@!ec:byte; {the largest character code in the font}
-@!lh:byte; {the number of words in the header block}
-@!lf:unsigned_integer; {the number of words in the entire \.{TFM} file}
-@!not_found:boolean; {has a font character been found?}
-@!temp_width:fix_word; {width being used to compute a check sum}
-@!ncw,@!nco,@!npc:integer;
-
-@ It might turn out that no characters exist at all. But \.{PLtoTF} keeps
-going and writes the \.{TFM} anyway. In this case |ec| will be~0 and |bc|
-will be~1.
-
-@<Compute the subfile sizes@>=
-case ofm_level of
- -1: begin
- lh:=header_ptr div 4;@/
- not_found:=true; bc:=0;
- while not_found do
- if (char_wd[bc]>0)or(bc=255) then not_found:=false
- else incr(bc);
- not_found:=true; ec:=255;
- while not_found do
- if (char_wd[ec]>0)or(ec=0) then not_found:=false
- else decr(ec);
- if bc>ec then bc:=1;
- incr(memory[width]); incr(memory[height]); incr(memory[depth]);
- incr(memory[italic]);@/
- @<Compute the ligature/kern program offset@>;
- lf:=6+lh+(ec-bc+1)+memory[width]+memory[height]+memory[depth]+
- memory[italic]+nl+lk_offset+nk+ne+np;
- end;
- 0: begin
- lh:=header_ptr div 4;@/
- not_found:=true; bc:=0;
- while not_found do
- if (char_wd[bc]>0)or(bc=max_char) then not_found:=false
- else incr(bc);
- not_found:=true; ec:=max_char;
- while not_found do
- if (char_wd[ec]>0)or(ec=0) then not_found:=false
- else decr(ec);
- if bc>ec then bc:=1;
- incr(memory[width]); incr(memory[height]); incr(memory[depth]);
- incr(memory[italic]);@/
- @<Compute the ligature/kern program offset@>;
- lf:=14+lh+2*(ec-bc+1)+memory[width]+memory[height]+memory[depth]+
- memory[italic]+2*nl+lk_offset+nk+2*ne+np;
- end;
- 1: begin
- lh:=header_ptr div 4;@/
- not_found:=true; bc:=0;
- while not_found do
- if (char_wd[bc]>0)or(bc=max_char) then not_found:=false
- else incr(bc);
- not_found:=true; ec:=max_char;
- while not_found do
- if (char_wd[ec]>0)or(ec=0) then not_found:=false
- else decr(ec);
- if bc>ec then bc:=1;
- incr(memory[width]); incr(memory[height]); incr(memory[depth]);
- incr(memory[italic]);@/
- @<Compute the ligature/kern program offset@>;
- @<Compute the character info size@>;
- lf:=29+lh+ncw+memory[width]+memory[height]+memory[depth]+
- memory[italic]+2*(nl+lk_offset)+nk+2*ne+np+
- nki+nwi+nkf+nwf+nkm+nwm++nkr+nwr+nkg+nwg+nkp+nwp;
- nco:=29+lh+nki+nwi+nkf+nwf+nkm+nwm++nkr+nwr+nkg+nwg+nkp+nwp;
- end;
- end;
-
-@ @d out_size(#)==out((#) div 256); out((#) mod 256)
- @d out_integer(#)==out((#) div @"1000000);
- out(((#) mod @"1000000) div @"10000);
- out(((#) mod @"10000) div @"100);
- out((#) mod @"100)
-
-@<Output the subfile sizes@>=
-case ofm_level of
- -1: begin
- out_size(lf); out_size(lh); out_size(bc); out_size(ec);
- out_size(memory[width]); out_size(memory[height]);
- out_size(memory[depth]); out_size(memory[italic]);
- out_size(nl+lk_offset); out_size(nk); out_size(ne); out_size(np);
- end;
- 0: begin
- out_integer(0);
- out_integer(lf); out_integer(lh); out_integer(bc); out_integer(ec);
- out_integer(memory[width]); out_integer(memory[height]);
- out_integer(memory[depth]); out_integer(memory[italic]);
- out_integer(nl+lk_offset); out_integer(nk);
- out_integer(ne); out_integer(np); out_integer(font_dir);
- end;
- 1: begin
- out_integer(1);
- out_integer(lf); out_integer(lh);
- out_integer(bc); out_integer(ec);
- out_integer(memory[width]); out_integer(memory[height]);
- out_integer(memory[depth]); out_integer(memory[italic]);
- out_integer(nl+lk_offset); out_integer(nk);
- out_integer(ne); out_integer(np); out_integer(font_dir);
- out_integer(nco); out_integer(ncw); out_integer(npc);
- out_integer(nki); out_integer(nwi); out_integer(nkf); out_integer(nwf);
- out_integer(nkm); out_integer(nwm); out_integer(nkr); out_integer(nwr);
- out_integer(nkg); out_integer(nwg); out_integer(nkp); out_integer(nwp);
- end;
- end;
-
-@ The routines that follow need a few temporary variables of different types.
-
-@<Gl...@>=
-@!j:0..max_header_bytes; {index into |header_bytes|}
-@!p:pointer; {index into |memory|}
-@!q:width..italic; {runs through the list heads for dimensions}
-@!par_ptr:0..max_param_words; {runs through the parameters}
-
-@ The header block follows the subfile sizes. The necessary information all
-appears in |header_bytes|, except that the design size and the seven-bit-safe
-flag must still be set.
-
-@<Output the header block@>=
-if not check_sum_specified then @<Compute the check sum@>;
-header_bytes[design_size_loc]:=design_size div @'100000000;
- {this works since |design_size>0|}
-header_bytes[design_size_loc+1]:=(design_size div @'200000) mod 256;
-header_bytes[design_size_loc+2]:=(design_size div 256) mod 256;
-header_bytes[design_size_loc+3]:=design_size mod 256;
-if not seven_unsafe then header_bytes[seven_flag_loc]:=128;
-for j:=0 to header_ptr-1 do out(header_bytes[j]);
-
-@ @<Compute the check sum@>=
-begin c0:=bc; c1:=ec; c2:=bc; c3:=ec;
-for c:=bc to ec do if char_wd[c]>0 then begin
- temp_width:=memory[char_wd[c]];
- if design_units<>unity then
- temp_width:=round((temp_width/design_units)*1048576.0);
- temp_width:=temp_width + (c+4)*@'20000000; {this should be positive}
- c0:=(c0+c0+temp_width) mod 255;
- c1:=(c1+c1+temp_width) mod 253;
- c2:=(c2+c2+temp_width) mod 251;
- c3:=(c3+c3+temp_width) mod 247;
- end;
-header_bytes[check_sum_loc]:=c0;
-header_bytes[check_sum_loc+1]:=c1;
-header_bytes[check_sum_loc+2]:=c2;
-header_bytes[check_sum_loc+3]:=c3;
-end
-
-@ @<Global...@>=
-@!tab:integer;
-
-@
-@<Compute the character info size@>=
-if ofm_level=1 then begin
- ncw:=0;
- if nkcp>-1 then
- npc:=nki+nkf+nkr+nkg+nkcp+1
- else if nkcg>-1 then
- npc:=nki+nkf+nkr+nkcg+1
- else if nkcr>-1 then
- npc:=nki+nkf+nkcr+1
- else if nkcf>-1 then
- npc:=nki+nkcf+1
- else if nkci>-1 then
- npc:=nkci+1
- else
- npc:=0;
- needed_space:=(12+npc*2) div 4;
- extra_bytes:=(needed_space*4) - (10+npc*2);
- for c:=bc to ec do begin
- if char_original[c]=c then begin
- cprime:=c+1;
- diff:=false;
- while (not diff) and (cprime<=ec) do begin
- if index[char_wd[c]]<>index[char_wd[cprime]] then diff:=true;
- if index[char_ht[c]]<>index[char_ht[cprime]] then diff:=true;
- if index[char_dp[c]]<>index[char_dp[cprime]] then diff:=true;
- if index[char_ic[c]]<>index[char_ic[cprime]] then diff:=true;
- if char_remainder[c]<>char_remainder[cprime] then diff:=true;
- for tab:=0 to npc-1 do begin
- if char_table[c,tab]<>char_table[cprime,tab] then diff:=true;
- end;
- if not diff then begin
- char_original[cprime]:=c;
- cprime:=cprime+1;
- end;
- end;
- if cprime>(c+1) then begin
- char_repeats[c]:=cprime-c-1;
- end;
- ncw:=ncw+needed_space;
- end;
- end;
- end;
-
-@ The next block contains packed |char_info|.
-
-@<Output the character info@>=
-index[0]:=0;
-for c:=bc to ec do
-case ofm_level of
- -1: begin
- out(index[char_wd[c]]);
- out(index[char_ht[c]]*16+index[char_dp[c]]);
- out(index[char_ic[c]]*4+char_tag[c]);
- out(char_remainder[c]);
- end;
- 0: begin
- out(index[char_wd[c]] div 256); out(index[char_wd[c]] mod 256);
- out(index[char_ht[c]]); out(index[char_dp[c]]);
- out(index[char_ic[c]] div 64);out((index[char_ic[c]] mod 64)*4+char_tag[c]);
- out(char_remainder[c] div 256); out(char_remainder[c] mod 256);
- end;
- 1: begin
- if c=char_original[c] then begin
- out(index[char_wd[c]] div 256); out(index[char_wd[c]] mod 256);
- out(index[char_ht[c]]); out(index[char_dp[c]]);
- out(index[char_ic[c]]);
- tab:=char_tag[c];
- if char_extended_tag[c] then begin
- tab:=5;
- end;
- out(tab);
- out(char_remainder[c] div 256); out(char_remainder[c] mod 256);
- out_size(char_repeats[c]);
- for tab:=0 to npc-1 do begin
- out(char_table[c,tab] div 256); out(char_table[c,tab] mod 256);
- end;
- for tab:=1 to extra_bytes do begin
- out(0);
- end;
- end;
- end;
- end;
-
-
-@ When a scaled quantity is output, we may need to divide it by |design_units|.
-The following subroutine takes care of this, using floating point arithmetic
-only if |design_units<>1.0|.
-
-@p procedure out_scaled(x:fix_word); {outputs a scaled |fix_word|}
-var @!n:byte; {the first byte after the sign}
-@!m:0..65535; {the two least significant bytes}
-begin if abs(x/design_units)>=16.0 then begin
- print_ln('The relative dimension ',x/@'4000000:1:3,
- ' is too large.');
-@.The relative dimension...@>
- print(' (Must be less than 16*designsize');
- if design_units<>unity then print(' =',design_units/@'200000:1:3,
- ' designunits');
- print_ln(')'); x:=0;
- end;
-if design_units<>unity then x:=round((x/design_units)*1048576.0);
-if x<0 then begin
- out(255); x:=x+@'100000000;
- if x<=0 then x:=1;
- end
-else begin out(0);
- if x>=@'100000000 then x:=@'77777777;
- end;
-n:=x div @'200000; m:=x mod @'200000;
-out(n); out(m div 256); out(m mod 256);
-end;
-
-@ We have output the packed indices for individual characters.
-The scaled widths, heights, depths, and italic corrections are next.
-
-@<Output the dimensions themselves@>=
-for q:=width to italic do begin
- out(0); out(0); out(0); out(0); {output the zero word}
- p:=link[q]; {head of list}
- while p>0 do begin
- out_scaled(memory[p]);
- p:=link[p];
- end;
- end;
-
-@ One embarrassing problem remains: The ligature/kern program might be very
-long, but the starting addresses in |char_remainder| can be at most~255.
-Therefore we need to output some indirect address information; we want to
-compute |lk_offset| so that addition of |lk_offset| to all remainders makes
-all but |lk_offset| distinct remainders less than~256.
-
-For this we need a sorted table of all relevant remainders.
-
-@<Glob...@>=
-@!label_table:array[xchar_type] of record
- @!rr: -1..xmax_label; {sorted label values}
- @!cc: integer; {associated characters}
- end;
-@!label_ptr:xchar_type; {index of highest entry in |label_table|}
-@!sort_ptr:xchar_type; {index into |label_table|}
-@!lk_offset:xchar_type; {smallest offset value that might work}
-@!t:0..xmax_label; {label value that is being redirected}
-@!extra_loc_needed:boolean; {do we need a special word for |bchar|?}
-
-@ @<Compute the ligature/kern program offset@>=
-@<Insert all labels into |label_table|@>;
-if bchar<xmax_char then begin
- extra_loc_needed:=true; lk_offset:=1;
- end
-else begin
- extra_loc_needed:=false; lk_offset:=0;
- end;
-@<Find the minimum |lk_offset| and adjust all remainders@>;
-if bchar_label<xmax_label then begin
- if ofm_level=-1 then begin
- lig_kern[nl-1].b2:=(bchar_label+lk_offset)div 256;
- lig_kern[nl-1].b3:=(bchar_label+lk_offset)mod 256;
- end
- else begin
- lig_kern[nl-1].b2:=(bchar_label+lk_offset)div 65536;
- lig_kern[nl-1].b3:=(bchar_label+lk_offset)mod 65536;
- end
- end
-
-@ @<Insert all labels...@>=
-label_ptr:=0; label_table[0].rr:=-1; {sentinel}
-for c:=bc to ec do if char_tag[c]=lig_tag then begin
- sort_ptr:=label_ptr; {there's a hole at position |sort_ptr+1|}
- while label_table[sort_ptr].rr>char_remainder[c] do begin
- label_table[sort_ptr+1]:=label_table[sort_ptr];
- decr(sort_ptr); {move the hole}
- end;
- label_table[sort_ptr+1].cc:=c;
- label_table[sort_ptr+1].rr:=char_remainder[c];
- incr(label_ptr);
- end
-
-@ @<Find the minimum |lk_offset| and adjust all remainders@>=
-begin sort_ptr:=label_ptr; {the largest unallocated label}
-if ofm_level=-1 then begin
- if label_table[sort_ptr].rr+lk_offset > 255 then begin
- lk_offset:=0; extra_loc_needed:=false; {location 0 can do double duty}
- repeat char_remainder[label_table[sort_ptr].cc]:=lk_offset;
- while label_table[sort_ptr-1].rr=label_table[sort_ptr].rr do begin
- decr(sort_ptr); char_remainder[label_table[sort_ptr].cc]:=lk_offset;
- end;
- incr(lk_offset); decr(sort_ptr);
- until lk_offset+label_table[sort_ptr].rr<256;
- {N.B.: |lk_offset=256| satisfies this when |sort_ptr=0|}
- end;
- end
-else begin
- if label_table[sort_ptr].rr+lk_offset > 65535 then begin
- lk_offset:=0; extra_loc_needed:=false; {location 0 can do double duty}
- repeat char_remainder[label_table[sort_ptr].cc]:=lk_offset;
- while label_table[sort_ptr-1].rr=label_table[sort_ptr].rr do begin
- decr(sort_ptr); char_remainder[label_table[sort_ptr].cc]:=lk_offset;
- end;
- incr(lk_offset); decr(sort_ptr);
- until lk_offset+label_table[sort_ptr].rr<65536;
- {N.B.: |lk_offset=65536| satisfies this when |sort_ptr=0|}
- end;
- end;
-if lk_offset>0 then while sort_ptr>0 do begin
- char_remainder[label_table[sort_ptr].cc]:=
- char_remainder[label_table[sort_ptr].cc]+lk_offset;
- decr(sort_ptr);
- end;
-end
-
-@ @<Output the ligature/kern program@>=
-if ofm_level=-1 then begin
- if extra_loc_needed then begin {|lk_offset=1|}
- out(255); out(bchar); out(0); out(0);
- end
- else for sort_ptr:=1 to lk_offset do begin {output the redirection specs}
- t:=label_table[label_ptr].rr;
- if bchar<256 then begin
- out(255); out(bchar);
- end
- else begin
- out(254); out(0);
- end;
- out_size(t+lk_offset);
- repeat decr(label_ptr); until label_table[label_ptr].rr<t;
- end;
- if nl>0 then for lig_ptr:=0 to nl-1 do begin
- out(lig_kern[lig_ptr].b0);
- out(lig_kern[lig_ptr].b1);
- out(lig_kern[lig_ptr].b2);
- out(lig_kern[lig_ptr].b3);
- end;
- if nk>0 then for krn_ptr:=0 to nk-1 do out_scaled(kern[krn_ptr])
- end
-else begin
- if extra_loc_needed then {|lk_offset=1|} begin
- out_size(255); out_size(bchar); out_size(0); out_size(0);
- end
- else
- for sort_ptr:=1 to lk_offset do {output the redirection specs} begin
- t:=label_table[label_ptr].rr;
- if bchar<xmax_char then begin
- out_size(255); out_size(bchar);
- end
- else begin
- out_size(254); out_size(0);
- end;
- out_size((t+lk_offset) div 256);
- out_size((t+lk_offset) mod 256);
- repeat decr(label_ptr); until label_table[label_ptr].rr<t;
- end;
- if nl>0 then for lig_ptr:=0 to nl-1 do begin
- out_size(lig_kern[lig_ptr].b0);
- out_size(lig_kern[lig_ptr].b1);
- out_size(lig_kern[lig_ptr].b2);
- out_size(lig_kern[lig_ptr].b3);
- end;
- if nk>0 then for krn_ptr:=0 to nk-1 do out_scaled(kern[krn_ptr])
- end
-
-@ @<Output the extensible character recipes@>=
-if ofm_level=-1 then begin
- if ne>0 then for c:=0 to ne-1 do begin
- out(exten[c].b0);
- out(exten[c].b1);
- out(exten[c].b2);
- out(exten[c].b3);
- end;
- end
-else begin
- if ne>0 then for c:=0 to ne-1 do begin
- out_size(exten[c].b0);
- out_size(exten[c].b1);
- out_size(exten[c].b2);
- out_size(exten[c].b3);
- end;
- end;
-
-@ For our grand finale, we wind everything up by outputting the parameters.
-
-@<Output the parameters@>=
-for par_ptr:=1 to np do begin
- if par_ptr=1 then
- @<Output the slant (|param[1]|) without scaling@>
- else out_scaled(param[par_ptr]);
- end
-
-@ @<Output the slant...@>=
-begin if param[1]<0 then begin
- param[1]:=param[1]+@'10000000000;
- out((param[1] div @'100000000)+256-64);
- end
-else out(param[1] div @'100000000);
-out((param[1] div @'200000) mod 256);
-out((param[1] div 256) mod 256);
-out(param[1] mod 256);
-end
-
-@* The main program.
-The routines sketched out so far need to be packaged into separate procedures,
-on some systems, since some \PASCAL\ compilers place a strict limit on the
-size of a routine. The packaging is done here in an attempt to avoid some
-system-dependent changes.
-
-@p procedure param_enter;
-begin @<Enter the parameter names@>;
-end;
-@#
-procedure name_enter; {enter all names and their equivalents}
-begin @<Enter all of the names...@>;
-param_enter;
-end;
-@#
-procedure read_lig_kern;
-var @!krn_ptr:0..max_kerns; {an index into |kern|}
-@!c:integer; {runs through all character codes}
-begin @<Read ligature/kern list@>;
-end;
-@#
-procedure output_new_information_ofm;
-begin @<Output the new information for OFM files@>;
-end;
-@#
-procedure compute_new_header_ofm;
-begin @<Compute the new header information for OFM files@>;
-end;
-@#
-procedure finish_extended_font;
-begin @<Finish up the extended font stuff@>;
-end;
-@#
-procedure output_subfile_sizes;
-begin @<Output the subfile sizes@>;
-end;
-@#
-procedure compute_subfile_sizes;
-begin @<Compute the subfile sizes@>;
-end;
-@#
-procedure output_character_info;
-begin @<Output the character info@>;
-end;
-@#
-procedure read_font_rule_list;
-begin @<Read font rule list@>;
-end;
-@#
-procedure read_font_glue_list;
-begin @<Read font glue list@>;
-end;
-@#
-procedure read_font_penalty_list;
-begin @<Read font penalty list@>;
-end;
-@#
-procedure read_font_mvalue_list;
-begin @<Read font mvalue list@>;
-end;
-@#
-procedure read_font_fvalue_list;
-begin @<Read font fvalue list@>;
-end;
-@#
-procedure read_font_ivalue_list;
-begin @<Read font ivalue list@>;
-end;
-@#
-procedure read_repeated_character_info;
-begin @<Read repeated character info@>;
-end;
-@#
-procedure read_lig_kern_command;
-begin @<Read a ligature/kern command@>;
-end;
-@#
-procedure read_character_property;
-begin @<Read a character property@>;
-end;
-@#
-procedure read_char_info;
-begin @<Read character info list@>;
-end;
-@#
-procedure read_input;
-var @!c:integer; {header or parameter index}
-begin @<Read all the input@>;
-end;
-@#
-procedure corr_and_check;
-var @!c:integer; {runs through all character codes}
-@!hh:0..hash_size; {an index into |hash_list|}
-@!lig_ptr:0..max_lig_steps; {an index into |lig_kern|}
-@!g:byte; {a character generated by the current character |c|}
-begin @<Correct and check the information@>
-end;
-
-@ Here is where \.{PLtoTF} begins and ends.
-
-@p begin initialize;@/
-name_enter;@/
-read_input; print('.');@/
-corr_and_check;@/
-@<Do the font metric output@>;
-end.
-
-@ @<Global...@>=
-@!ofm_level:integer;
-
-@ @<Set init...@>=
-ofm_level:=-1; {Suppose that it is a TFM file}
-
-@ @<Read OFM level code@>=
-begin
-ofm_level:=get_integer;
-if (ofm_level<0) or (ofm_level>1) then begin
- flush_error('OFMLEVEL must be 0 or 1 -- 1 assumed');
- ofm_level:=1;
- end;
-end
-
-@ @<Read font direction code@>=
-begin
-font_dir:=-1;
-repeat get_next;
-until cur_char<>" ";
-case cur_char of
- "T": begin get_next;
- if cur_char="L" then font_dir:=0
- else if cur_char="R" then font_dir:=2;
- end;
- "B": begin get_next;
- if cur_char="L" then font_dir:=4
- else if cur_char="R" then font_dir:=6;
- end;
- "R": begin get_next;
- if cur_char="T" then font_dir:=5
- else if cur_char="B" then font_dir:=7;
- end;
- "L": begin get_next;
- if cur_char="T" then font_dir:=1
- else if cur_char="B" then font_dir:=3;
- end;
- end;
-while cur_char<>")" do get_next;
-if font_dir = -1 then begin
- flush_error('FONTDIR must be valid direction, -- TR assumed');
- font_dir:=0;
- end;
-end
-
-@ @<Read natural font direction code@>=
-begin
-font_dir:=-1;
-repeat get_next;
-until cur_char<>" ";
-case cur_char of
- "T": begin get_next;
- if cur_char="L" then font_dir:=8
- else if cur_char="R" then font_dir:=10;
- end;
- "B": begin get_next;
- if cur_char="L" then font_dir:=12
- else if cur_char="R" then font_dir:=14;
- end;
- "R": begin get_next;
- if cur_char="T" then font_dir:=13
- else if cur_char="B" then font_dir:=15;
- end;
- "L": begin get_next;
- if cur_char="T" then font_dir:=9
- else if cur_char="B" then font_dir:=11;
- end;
- end;
-while cur_char<>")" do get_next;
-if font_dir = -1 then begin
- flush_error('NFONTDIR must be valid direction, -- TR assumed');
- font_dir:=8;
- end;
-end
-
-@
-Here are some general values for the various entries.
-They can all be changed.
-
-@d arrays_per_kind==20
-@d entries_per_array==200
-
-@ @<Constants...@>=
-@!rule_arrays=arrays_per_kind;
-@!rule_entries=entries_per_array;
-
-@ @<Types...@>=
-rule_array_type=0..rule_arrays;
-rule_entry_type=0..rule_entries;
-rule_node=
-record
- rn_width: fix_word;
- rn_height: fix_word;
- rn_depth: fix_word;
-end;
-
-@ @<Global...@>=
-@!rules:array[rule_array_type,rule_entry_type] of rule_node;
-@!npr:array[rule_array_type] of integer;
-@!nkr:integer;
-@!nkcr:integer;
-@!nwr:integer;
-@!r_array:integer;
-@!r_number:integer;
-
-@ @<Set init...@>=
-for r_array := 0 to rule_arrays do begin
- npr[r_array]:=0;
- @<Null out the rule@>;
- end;
-nkr:=-1;
-nkcr:=-1;
-
-@ @<Read font rule list@>=
-begin
-if tables_read then
- flush_error('All parameter tables must appear before character info');
-r_array:=get_integer;
-if r_array>rule_arrays then
- flush_error('This FONTRULE table index is too big for my present size')
-else if r_array<0 then
- flush_error('This FONTRULE index is negative')
-else begin
- if r_array>nkr then nkr:=r_array;
- while level=1 do begin
- while cur_char=" " do get_next;
- if cur_char="(" then @<Read a rule@>
- else if cur_char=")" then skip_to_end_of_item
- else junk_error;
- end;
- finish_inner_property_list;
- end;
-end
-
-@ @<Read a rule@>=
-begin
-get_name;
-if cur_code=comment_code then skip_to_end_of_item
-else if cur_code<>rule_code then
- flush_error('This property name doesn''t belong in a RULE list')
-else begin
- r_number:=get_integer;
- if r_number>rule_entries then
- flush_error('This RULE index is too big for my present table size')
- else if r_number<0 then
- flush_error('This RULE index is negative')
- else begin
- while npr[r_array]<r_number do begin
- incr(npr[r_array]); @<Null out the rule@>;
- end;
- @<Read all of a rule's values@>;
- finish_the_property;
- end;
- end;
-end
-
-@ @<Null out the rule@>=
-begin
-rules[r_array,npr[r_array]].rn_width:=0;
-rules[r_array,npr[r_array]].rn_depth:=0;
-rules[r_array,npr[r_array]].rn_height:=0;
-end
-
-@ @<Read all of a rule's values@>=
-begin
-while level=2 do begin
- while cur_char=" " do get_next;
- if cur_char="(" then @<Read a single rule value@>
- else if cur_char=")" then skip_to_end_of_item
- else junk_error;
- end;
-finish_inner_property_list;
-end
-
-@ @<Read a single rule value@>=
-begin
-get_name;
-case cur_code of
- rule_width_code:
- rules[r_array,r_number].rn_width:=get_fix;
- rule_height_code:
- rules[r_array,r_number].rn_height:=get_fix;
- rule_depth_code:
- rules[r_array,r_number].rn_depth:=get_fix;
- end;
-finish_the_property;
-end
-
-@ @<Header information for rules@>=
-begin
-nwr:=0;
-for r_array := 0 to nkr do begin
- incr(npr[r_array]);
- nwr := nwr + 3*npr[r_array];
- end;
-incr(nkr);
-end
-
-@ @<Output the rules@>=
-begin
-for r_array:= 0 to nkr-1 do
- for r_number:=0 to npr[r_array]-1 do begin
- out_scaled(rules[r_array,r_number].rn_width);
- out_scaled(rules[r_array,r_number].rn_height);
- out_scaled(rules[r_array,r_number].rn_depth);
- end;
-end
-
-@ @<Output the rule headers@>=
-begin
-for r_array:= 0 to nkr-1 do begin
- out_integer(npr[r_array]);
- end;
-end
-
-@ @<Constants...@>=
-@!glue_arrays=arrays_per_kind;
-@!glue_entries=entries_per_array;
-
-@
-@d t_normal==0
-@d t_aleaders==1
-@d t_cleaders==2
-@d t_xleaders==3
-
-@d o_unit==0
-@d o_fi==1
-@d o_fil==2
-@d o_fill==3
-@d o_filll==4
-
-@d g_space==0
-@d g_rule==1
-@d g_char==2
-
-@<Types...@>=
-glue_array_type=0..glue_arrays;
-glue_entry_type=0..glue_entries;
-glue_node=
-record
- gn_width: fix_word;
- gn_stretch: fix_word;
- gn_shrink: fix_word;
- gn_type: integer;
- gn_arg_type: g_space..g_char;
- gn_stretch_order: integer;
- gn_shrink_order: integer;
- gn_argument: integer;
-end;
-
-@ @<Global...@>=
-@!glues:array[glue_array_type,glue_entry_type] of glue_node;
-@!npg:array[glue_array_type] of integer;
-@!nkg:integer;
-@!nkcg:integer;
-@!nwg:integer;
-@!g_array:integer;
-@!g_byte:integer;
-@!g_number:integer;
-
-@ @<Set init...@>=
-for g_array := 0 to glue_arrays do
-begin
- npg[g_array]:=0;
- @<Null out the glue@>;
-end;
-nkg:=-1;
-nkcg:=-1;
-
-@ @<Read font glue list@>=
-begin
-if tables_read then
- flush_error('All parameter tables must appear before character info');
-g_array:=get_integer;
-if g_array>glue_arrays then
- flush_error('This FONTGLUE table index is too big for my present size')
-else if g_array<0 then
- flush_error('This FONTGLUE index is negative')
-else begin
- if g_array>nkg then nkg:=g_array;
- while level=1 do begin
- while cur_char=" " do get_next;
- if cur_char="(" then @<Read a glue@>
- else if cur_char=")" then skip_to_end_of_item
- else junk_error;
- end;
- finish_inner_property_list;
- end;
-end
-
-@ @<Read a glue@>=
-begin
-get_name;
-if cur_code=comment_code then skip_to_end_of_item
-else if cur_code<>glue_code then
- flush_error('This property name doesn''t belong in a GLUE list')
-else begin
- g_number:=get_integer;
- if g_number>glue_entries then
- flush_error('This GLUE index is too big for my present table size')
- else if g_number<0 then
- flush_error('This GLUE index is negative')
- else begin
- while npg[g_array]<g_number do begin
- incr(npg[g_array]); @<Null out the glue@>;
- end;
- @<Read all of a glue's values@>;
- finish_the_property;
- end;
- end;
-end
-
-@ @<Null out the glue@>=
-begin
-glues[g_array,npg[g_array]].gn_width:=0;
-glues[g_array,npg[g_array]].gn_stretch:=0;
-glues[g_array,npg[g_array]].gn_shrink:=0;
-glues[g_array,npg[g_array]].gn_type:=0;
-glues[g_array,npg[g_array]].gn_arg_type:=0;
-glues[g_array,npg[g_array]].gn_stretch_order:=0;
-glues[g_array,npg[g_array]].gn_shrink_order:=0;
-glues[g_array,npg[g_array]].gn_argument:=0;
-end
-
-@ @<Read all of a glue's values@>=
-begin
-while level=2 do begin
- while cur_char=" " do get_next;
- if cur_char="(" then @<Read a single glue value@>
- else if cur_char=")" then skip_to_end_of_item
- else junk_error;
- end;
-finish_inner_property_list;
-end
-
-@ @<Read a single glue value@>=
-begin
-get_name;
-case cur_code of
- glue_width_code:
- glues[g_array,g_number].gn_width:=get_fix;
- glue_stretch_code:
- glues[g_array,g_number].gn_stretch:=get_fix;
- glue_shrink_code:
- glues[g_array,g_number].gn_shrink:=get_fix;
- glue_type_code: begin
- g_byte:=get_integer;
- if (g_byte<0) or (g_byte>3) then begin
- g_byte:=0;
- end;
- glues[g_array,g_number].gn_type:=g_byte;
- end;
- glue_stretch_order_code: begin
- g_byte:=get_integer;
- if (g_byte<0) or (g_byte>4) then begin
- g_byte:=0;
- end;
- glues[g_array,g_number].gn_stretch_order:=g_byte;
- end;
- glue_shrink_order_code: begin
- g_byte:=get_integer;
- if (g_byte<0) or (g_byte>4) then begin
- g_byte:=0;
- end;
- glues[g_array,g_number].gn_shrink_order:=g_byte;
- end;
- glue_char_code: begin
- glues[g_array,g_number].gn_argument:=get_integer;
- glues[g_array,g_number].gn_arg_type:=g_char;
- end;
- glue_rule_code: begin
- glues[g_array,g_number].gn_argument:=get_integer;
- glues[g_array,g_number].gn_arg_type:=g_rule;
- end;
- end;
-finish_the_property;
-end
-
-@ @<Header information for glues@>=
-begin
-nwg:=0;
-for g_array := 0 to nkg do begin
- incr(npg[g_array]);
- nwg := nwg + 4*npg[g_array];
- end;
-incr(nkg);
-end
-
-@ @<Output the glues@>=
-begin
-for g_array:= 0 to nkg-1 do
- for g_number:=0 to npg[g_array]-1 do begin
- g_byte:=glues[g_array,g_number].gn_type*16+
- glues[g_array,g_number].gn_arg_type;
- out(g_byte);
- g_byte:=glues[g_array,g_number].gn_stretch_order*16+
- glues[g_array,g_number].gn_shrink_order;
- out(g_byte);
- g_byte:=glues[g_array,g_number].gn_argument div 256;
- out(g_byte);
- g_byte:=glues[g_array,g_number].gn_argument mod 256;
- out(g_byte);
- out_scaled(glues[g_array,g_number].gn_width);
- out_scaled(glues[g_array,g_number].gn_stretch);
- out_scaled(glues[g_array,g_number].gn_shrink);
- end;
-end
-
-@ @<Output the glue headers@>=
-begin
-for g_array:= 0 to nkg-1 do begin
- out_integer(npg[g_array]);
- end;
-end
-
-@ @<Constants...@>=
-@!penalty_arrays=arrays_per_kind;
-@!penalty_entries=entries_per_array;
-
-@ @<Types...@>=
-penalty_array_type=0..penalty_arrays;
-penalty_entry_type=0..penalty_entries;
-penalty_node=
-record
- pn_val: integer;
-end;
-
-@ @<Global...@>=
-@!penalties:array[penalty_array_type,penalty_entry_type] of penalty_node;
-@!npp:array[penalty_array_type] of integer;
-@!nkp:integer;
-@!nkcp:integer;
-@!nwp:integer;
-@!p_array:integer;
-@!p_number:integer;
-
-@ @<Set init...@>=
-for p_array := 0 to penalty_arrays do begin
- npp[p_array]:=0;
- @<Null out the penalty@>;
- end;
-nkp:=-1;
-nkcp:=-1;
-
-@ @<Read font penalty list@>=
-begin
-if tables_read then
- flush_error('All parameter tables must appear before character info');
-p_array:=get_integer;
-if p_array>penalty_arrays then
- flush_error('This FONTPENALTY table index is too big for my present size')
-else if p_array<0 then
- flush_error('This FONTPENALTY index is negative')
-else begin
- if p_array>nkp then nkp:=p_array;
- while level=1 do begin
- while cur_char=" " do get_next;
- if cur_char="(" then @<Read a penalty@>
- else if cur_char=")" then skip_to_end_of_item
- else junk_error;
- end;
- finish_inner_property_list;
- end;
-end
-
-@ @<Read a penalty@>=
-begin
-get_name;
-if cur_code=comment_code then skip_to_end_of_item
-else if cur_code<>penalty_code then
- flush_error('This property name doesn''t belong in a PENALTY list')
-else begin
- p_number:=get_integer;
- if p_number>penalty_entries then
- flush_error('This PENALTY index is too big for my present table size')
- else if p_number<0 then
- flush_error('This PENALTY index is negative')
- else begin
- while npp[p_array]<p_number do begin
- incr(npp[p_array]); @<Null out the penalty@>;
- end;
- @<Read all of a penalty's values@>;
- finish_the_property;
- end;
- end;
-end
-
-@ @<Null out the penalty@>=
-begin
-penalties[p_array,npp[p_array]].pn_val:=0;
-end
-
-@ @<Read all of a penalty's values@>=
-begin
-while level=2 do begin
- while cur_char=" " do get_next;
- if cur_char="(" then @<Read a single penalty value@>
- else if cur_char=")" then skip_to_end_of_item
- else junk_error;
- end;
-finish_inner_property_list;
-end
-
-@ @<Read a single penalty value@>=
-begin
-get_name;
-case cur_code of
- penalty_val_code:
- penalties[p_array,p_number].pn_val:=get_integer;
- end;
-finish_the_property;
-end
-
-@ @<Header information for penalties@>=
-begin
-nwp:=0;
-for p_array := 0 to nkp do begin
- incr(npp[p_array]);
- nwp := nwp + npp[p_array];
- end;
-incr(nkp);
-end
-
-@ @<Output the penalties@>=
-begin
-for p_array:= 0 to nkp-1 do
- for p_number:=0 to npp[p_array]-1 do begin
- out_integer(penalties[p_array,p_number].pn_val);
- end;
-end
-
-@ @<Output the penalty headers@>=
-begin
-for p_array:= 0 to nkp-1 do begin
- out_integer(npp[p_array]);
- end;
-end
-
-@ @<Constants...@>=
-@!mvalue_arrays=arrays_per_kind;
-@!mvalue_entries=entries_per_array;
-
-@ @<Types...@>=
-mvalue_array_type=0..mvalue_arrays;
-mvalue_entry_type=0..mvalue_entries;
-mvalue_node=
-record
- fn_val: fix_word;
-end;
-
-@ @<Global...@>=
-@!mvalues:array[mvalue_array_type,mvalue_entry_type] of mvalue_node;
-@!npm:array[mvalue_array_type] of integer;
-@!nkm:integer;
-@!nkcm:integer;
-@!nwm:integer;
-@!m_array:integer;
-@!m_number:integer;
-
-@ @<Set init...@>=
-for m_array := 0 to mvalue_arrays do begin
- npm[m_array]:=0;
- @<Null out the mvalue@>;
- end;
-nkm:=-1;
-nkcm:=-1;
-
-@ @<Read font mvalue list@>=
-begin
-if tables_read then
- flush_error('All parameter tables must appear before character info');
-m_array:=get_integer;
-if m_array>mvalue_arrays then
- flush_error('This FONTMVALUE table index is too big for my present size')
-else if m_array<0 then
- flush_error('This FONTMVALUE index is negative')
-else begin
- if m_array>nkm then nkm:=m_array;
- while level=1 do begin
- while cur_char=" " do get_next;
- if cur_char="(" then @<Read an mvalue@>
- else if cur_char=")" then skip_to_end_of_item
- else junk_error;
- end;
- finish_inner_property_list;
- end;
-end
-
-@ @<Read an mvalue@>=
-begin
-get_name;
-if cur_code=comment_code then skip_to_end_of_item
-else if cur_code<>mvalue_code then
- flush_error('This property name doesn''t belong in an MVALUE list')
-else begin
- m_number:=get_integer;
- if m_number>mvalue_entries then
- flush_error('This MVALUE index is too big for my present table size')
- else if m_number<0 then
- flush_error('This MVALUE index is negative')
- else begin
- while npm[m_array]<m_number do begin
- incr(npm[m_array]); @<Null out the mvalue@>;
- end;
- @<Read all of an mvalue's values@>;
- finish_the_property;
- end;
- end;
-end
-
-@ @<Null out the mvalue@>=
-begin
-mvalues[m_array,npm[m_array]].fn_val:=0;
-end
-
-@ @<Read all of an mvalue's values@>=
-begin
-while level=2 do begin
- while cur_char=" " do get_next;
- if cur_char="(" then @<Read a single mvalue value@>
- else if cur_char=")" then skip_to_end_of_item
- else junk_error;
- end;
-finish_inner_property_list;
-end
-
-@ @<Read a single mvalue value@>=
-begin
-get_name;
-case cur_code of
- mvalue_val_code:
- mvalues[m_array,m_number].fn_val:=get_fix;
- end;
-finish_the_property;
-end
-
-@ @<Header information for mvalues@>=
-begin
-nwm:=0;
-for m_array := 0 to nkm do begin
- incr(npm[m_array]);
- nwm := nwm + npm[m_array];
- end;
-incr(nkm);
-end
-
-@ @<Output the mvalues@>=
-begin
-for m_array:= 0 to nkm-1 do
- for m_number:=0 to npm[m_array]-1 do begin
- out_scaled(mvalues[m_array,m_number].fn_val);
- end;
-end
-
-@ @<Output the mvalue headers@>=
-begin
-for m_array:= 0 to nkm-1 do begin
- out_integer(npm[m_array]);
- end;
-end
-
-@ @<Constants...@>=
-@!fvalue_arrays=arrays_per_kind;
-@!fvalue_entries=entries_per_array;
-
-@ @<Types...@>=
-fvalue_array_type=0..fvalue_arrays;
-fvalue_entry_type=0..fvalue_entries;
-fvalue_node=
-record
- fn_val: fix_word;
-end;
-
-@ @<Global...@>=
-@!fvalues:array[fvalue_array_type,fvalue_entry_type] of fvalue_node;
-@!npf:array[fvalue_array_type] of integer;
-@!nkf:integer;
-@!nkcf:integer;
-@!nwf:integer;
-@!f_array:integer;
-@!f_number:integer;
-
-@ @<Set init...@>=
-for f_array := 0 to fvalue_arrays do begin
- npf[f_array]:=0;
- @<Null out the fvalue@>;
- end;
-nkf:=-1;
-nkcf:=-1;
-
-@ @<Read font fvalue list@>=
-begin
-if tables_read then
- flush_error('All parameter tables must appear before character info');
-f_array:=get_integer;
-if f_array>fvalue_arrays then
- flush_error('This FONTFVALUE table index is too big for my present size')
-else if f_array<0 then
- flush_error('This FONTFVALUE index is negative')
-else begin
- if f_array>nkf then nkf:=f_array;
- while level=1 do begin
- while cur_char=" " do get_next;
- if cur_char="(" then @<Read an fvalue@>
- else if cur_char=")" then skip_to_end_of_item
- else junk_error;
- end;
- finish_inner_property_list;
- end;
-end
-
-@ @<Read an fvalue@>=
-begin
-get_name;
-if cur_code=comment_code then skip_to_end_of_item
-else if cur_code<>fvalue_code then
- flush_error('This property name doesn''t belong in an FVALUE list')
-else begin
- f_number:=get_integer;
- if f_number>fvalue_entries then
- flush_error('This FVALUE index is too big for my present table size')
- else if f_number<0 then
- flush_error('This FVALUE index is negative')
- else begin
- while npf[f_array]<f_number do begin
- incr(npf[f_array]); @<Null out the fvalue@>;
- end;
- @<Read all of an fvalue's values@>;
- finish_the_property;
- end;
- end;
-end
-
-@ @<Null out the fvalue@>=
-begin
-fvalues[f_array,npf[f_array]].fn_val:=0;
-end
-
-@ @<Read all of an fvalue's values@>=
-begin
-while level=2 do begin
- while cur_char=" " do get_next;
- if cur_char="(" then @<Read a single fvalue value@>
- else if cur_char=")" then skip_to_end_of_item
- else junk_error;
- end;
-finish_inner_property_list;
-end
-
-@ @<Read a single fvalue value@>=
-begin
-get_name;
-case cur_code of
- fvalue_val_code:
- fvalues[f_array,f_number].fn_val:=get_fix;
- end;
-finish_the_property;
-end
-
-@ @<Header information for fvalues@>=
-begin
-nwf:=0;
-for f_array := 0 to nkf do begin
- incr(npf[f_array]);
- nwf := nwf + npf[f_array];
- end;
-incr(nkf);
-end
-
-@ @<Output the fvalues@>=
-begin
-for f_array:= 0 to nkf-1 do
- for f_number:=0 to npf[f_array]-1 do begin
- out_scaled(fvalues[f_array,f_number].fn_val);
- end;
-end
-
-@ @<Output the fvalue headers@>=
-begin
-for f_array:= 0 to nkf-1 do begin
- out_integer(npf[f_array]);
- end;
-end
-
-@ @<Constants...@>=
-@!ivalue_arrays=arrays_per_kind;
-@!ivalue_entries=entries_per_array;
-
-@ @<Types...@>=
-ivalue_array_type=0..ivalue_arrays;
-ivalue_entry_type=0..ivalue_entries;
-ivalue_node=
-record
- in_val: integer;
-end;
-
-@ @<Global...@>=
-@!ivalues:array[ivalue_array_type,ivalue_entry_type] of ivalue_node;
-@!npi:array[ivalue_array_type] of integer;
-@!font_i_array:boolean;
-@!nki:integer;
-@!nkci:integer;
-@!nwi:integer;
-@!i_array:integer;
-@!i_number:integer;
-
-@ @<Set init...@>=
-for i_array := 0 to ivalue_arrays do begin
- npi[i_array]:=0;
- @<Null out the ivalue@>;
- end;
-nki:=-1;
-nkci:=-1;
-
-@ @<Read font ivalue list@>=
-begin
-if tables_read then
- flush_error('All parameter tables must appear before character info');
-i_array:=get_integer;
-if i_array>ivalue_arrays then
- flush_error('This FONTIVALUE table index is too big for my present size')
-else if i_array<0 then
- flush_error('This FONTIVALUE index is negative')
-else begin
- if i_array>nki then nki:=i_array;
- while level=1 do begin
- while cur_char=" " do get_next;
- if cur_char="(" then @<Read an ivalue@>
- else if cur_char=")" then skip_to_end_of_item
- else junk_error;
- end;
- finish_inner_property_list;
- end;
-end
-
-@ @<Read an ivalue@>=
-begin
-get_name;
-if cur_code=comment_code then skip_to_end_of_item
-else if cur_code<>ivalue_code then
- flush_error('This property name doesn''t belong in an IVALUE list')
-else begin
- i_number:=get_integer;
- if i_number>ivalue_entries then
- flush_error('This IVALUE index is too big for my present table size')
- else if i_number<0 then
- flush_error('This IVALUE index is negative')
- else begin
- while npi[i_array]<i_number do begin
- incr(npi[i_array]); @<Null out the ivalue@>;
- end;
- @<Read all of an ivalue's values@>;
- finish_the_property;
- end;
- end;
-end
-
-@ @<Null out the ivalue@>=
-begin
-ivalues[i_array,npi[i_array]].in_val:=0;
-end
-
-@ @<Read all of an ivalue's values@>=
-begin
-while level=2 do begin
- while cur_char=" " do get_next;
- if cur_char="(" then @<Read a single ivalue value@>
- else if cur_char=")" then skip_to_end_of_item
- else junk_error;
- end;
-finish_inner_property_list;
-end
-
-@ @<Read a single ivalue value@>=
-begin
-get_name;
-case cur_code of
- ivalue_val_code:
- ivalues[i_array,i_number].in_val:=get_integer;
- end;
-finish_the_property;
-end
-
-@ @<Header information for ivalues@>=
-begin
-nwi:=0;
-for i_array := 0 to nki do begin
- incr(npi[i_array]);
- nwi := nwi + npi[i_array];
- end;
-incr(nki);
-end
-
-@ @<Output the ivalues@>=
-begin
-for i_array:= 0 to nki-1 do
- for i_number:=0 to npi[i_array]-1 do begin
- out_integer(ivalues[i_array,i_number].in_val);
- end;
-end
-
-@ @<Output the ivalue headers@>=
-begin
-for i_array:= 0 to nki-1 do begin
- out_integer(npi[i_array]);
- end;
-end
-
-@ @<Compute the new header information for OFM files@>=
-begin
-@<Header information for ivalues@>;
-@<Header information for fvalues@>;
-@<Header information for mvalues@>;
-@<Header information for rules@>;
-@<Header information for glues@>;
-@<Header information for penalties@>;
-end
-
-@ @<Output the new information for OFM files@>=
-begin
-@<Output the ivalue headers@>;
-@<Output the fvalue headers@>;
-@<Output the mvalue headers@>;
-@<Output the rule headers@>;
-@<Output the glue headers@>;
-@<Output the penalty headers@>;
-@<Output the ivalues@>;
-@<Output the fvalues@>;
-@<Output the rules@>;
-@<Output the glues@>;
-@<Output the penalties@>;
-end
-
-@* System-dependent changes.
-This section should be replaced, if necessary, by changes to the program
-that are necessary to make \.{PLtoTF} work at a particular installation.
-It is usually best to design your change file so that all changes to
-previous sections preserve the section numbering; then everybody's version
-will be consistent with the printed program. More extensive changes,
-which introduce new sections, can be inserted here; then only the index
-itself will get a new section number.
-@^system dependencies@>
-
-@* Index.
-Pointers to error messages appear here together with the section numbers
-where each ident\-i\-fier is used.
diff --git a/Build/source/texk/web2c/omegaware/ovf2ovp.ch b/Build/source/texk/web2c/omegaware/ovf2ovp.ch
deleted file mode 100644
index 167509717ac..00000000000
--- a/Build/source/texk/web2c/omegaware/ovf2ovp.ch
+++ /dev/null
@@ -1,610 +0,0 @@
-%
-% This file is part of the Omega project, which
-% is based in the web2c distribution of TeX.
-%
-% Copyright (c) 1994--1998 John Plaice and Yannis Haralambous
-% applies only to the changes to the original vftovp.ch.
-%
-% vftovp.ch for C compilation with web2c.
-% Written by kb@cs.umb.edu.
-% This file is in the public domain.
-
-@x [0] WEAVE: print changes only.
-\pageno=\contentspagenumber \advance\pageno by 1
-@y
-\pageno=\contentspagenumber \advance\pageno by 1
-%\let\maybe=\iffalse
-%\def\title{VF$\,$\lowercase{to}$\,$VP changes for C}
-@z
-
-@x still [2] Set up for path reading.
-procedure initialize; {this procedure gets things started properly}
- var @!k:integer; {all-purpose index for initialization}
- begin print_ln(banner);@/
-@y
-@<Define |parse_arguments|@>
-procedure initialize; {this procedure gets things started properly}
- var @!k:integer; {all-purpose index for initialization}
- begin
- kpse_set_progname (argv[0]);
- kpse_init_prog ('VFTOVP', 0, nil, nil);
- parse_arguments;
-@z
-
-% [4] No name_length.
-% Also, AIX defines `class' in <math.h>, so let's take this opportunity to
-% define that away.
-@x
-@<Constants...@>=
-@y
-@d class == class_var
-@<Constants...@>=
-@z
-
-@x
-@!name_length=50; {a file name shouldn't be longer than this}
-@y
-@z
-
-@x [11] Open the files.
-@ On some systems you may have to do something special to read a
-packed file of bytes. For example, the following code didn't work
-when it was first tried at Stanford, because packed files have to be
-opened with a special switch setting on the \PASCAL\ that was used.
-@^system dependencies@>
-
-@<Set init...@>=
-reset(tfm_file); reset(vf_file);
-@y
-@ We don't have to do anything special to read a packed file of bytes,
-but we do want to use environment variables to find the input files.
-@^system dependencies@>
-
-@<Set init...@>=
-{See comments at |kpse_find_vf| in \.{kpathsea/tex-file.h} for why we
- don't use it.}
-vf_file := kpse_open_file (vf_name, kpse_ovf_format);
-tfm_file := kpse_open_file (tfm_name, kpse_ofm_format);
-
-if verbose then begin
- print (banner);
- print_ln (version_string);
-end;
-@z
-
-@x [21] Open VPL file.
-@!vpl_file:text;
-
-@ @<Set init...@>=
-rewrite(vpl_file);
-@y
-@!vpl_file:text;
-
-@ If an explicit filename isn't given, we write to |stdout|.
-
-@<Set init...@>=
-if optind + 3 > argc then begin
- vpl_file := stdout;
-end else begin
- vpl_name := extend_filename (cmdline (optind + 2), 'ovp');
- rewrite (vpl_file, vpl_name);
-end;
-@z
-
-% [24] `index' is not a good choice of identifier in C.
-@x
-@<Types...@>=
-@!index=0..tfm_size; {address of a byte in |tfm|}
-@y
-@d index == index_type
-
-@<Types...@>=
-@!index=0..tfm_size; {address of a byte in |tfm|}
-@z
-
-% [24] abort() should cause a bad exit code.
-@x
-@d abort(#)==begin print_ln(#);
- print_ln('Sorry, but I can''t go on; are you sure this is a OFM?');
- goto final_end;
- end
-@y
-@d abort(#)==begin print_ln(#);
- write_ln(stderr, 'Sorry, but I can''t go on; are you sure this is a OFM?');
- uexit(1);
- end
-@z
-
-% [31] Ditto for vf_abort.
-@x
-@d vf_abort(#)==begin
- print_ln(#);
- print_ln('Sorry, but I can''t go on; are you sure this is a OVF?');
- goto final_end;
- end
-@y
-@d vf_abort(#)==begin
- write_ln(stderr, #);
- write_ln(stderr, 'Sorry, but I can''t go on; are you sure this is a OVF?');
- uexit(1);
- end
-@z
-
-@x [32] Be quiet if not -verbose.
-for k:=0 to vf_ptr-1 do print(xchr[vf[k]]);
-print_ln(' '); reg_count:=0;
-@y
-if verbose then begin
- for k:=0 to vf_ptr-1 do print(xchr[vf[k]]);
- print_ln(' ');
-end;
-reg_count:=0;
-@z
-
-@x [35] Be quiet if not -verbose.
-@<Print the name of the local font@>;
-@y
-if verbose then begin
- @<Print the name of the local font@>;
-end;
-@z
-
-@x [36] Output of real numbers.
-print_ln(' at ',(((vf[k]*256+vf[k+1])*256+vf[k+2])/@'4000000)*real_dsize:2:2,
- 'pt')
-@y
-print(' at ');
-print_real((((vf[k]*256+vf[k+1])*256+vf[k+2])/@'4000000)*real_dsize, 2, 2);
-print_ln('pt')
-@z
-
-@x [37] No arbitrary max on cur_name.
-@!cur_name:packed array[1..name_length] of char; {external name,
- with no lower case letters}
-@y
-@!cur_name:^char; {external tfm name}
-@z
-
-@x [39] Open another TFM file.
-reset(tfm_file,cur_name);
-@^system dependencies@>
-if eof(tfm_file) then
- print_ln('---not loaded, font metric file can''t be opened!')
-@.font metric file can\'t be opened@>
-else begin font_bc:=0; font_ec:=65536; {will cause error if not modified soon}
-@y
-tfm_file := kpse_open_file (cur_name, kpse_ofm_format);
-@^system dependencies@>
-if eof(tfm_file) then
- print_ln('---not loaded, font metric file can''t be opened!')
-@.font metric file can\'t be opened@>
-else begin font_bc:=0; font_ec:=65536; {will cause error if not modified soon}
-@z
-
-@x [40] Be quiet if not -verbose.
- print_ln('Check sum in OVF file being replaced by font metric check sum');
-@y
- if verbose then
- print_ln('Check sum in OVF file being replaced by font metric check sum');
-@z
-
-@x [42] Remove initialization of now-defunct array.
-@ @<Set init...@>=
-default_directory:=default_directory_name;
-@y
-@ (No initialization to be done. Keep this module to preserve numbering.)
-@z
-
-@x [44] Don't append `.tfm' here, and keep lowercase.
-for k:=1 to name_length do cur_name[k]:=' ';
-if a=0 then begin
- for k:=1 to default_directory_name_length do
- cur_name[k]:=default_directory[k];
- r:=default_directory_name_length;
- end
-else r:=0;
-for k:=font_start[font_ptr]+14 to vf_ptr-1 do begin
- incr(r);
- if r+4>name_length then vf_abort('Font name too long for me!');
-@.Font name too long for me@>
- if (vf[k]>="a")and(vf[k]<="z") then
- cur_name[r]:=xchr[vf[k]-@'40]
- else cur_name[r]:=xchr[vf[k]];
- end;
-cur_name[r+1]:='.'; cur_name[r+2]:='T'; cur_name[r+3]:='F'; cur_name[r+4]:='M'
-@y
-@ The string |cur_name| is supposed to be set to the external name of the
-\.{TFM} file for the current font. We do not impose an arbitrary limit
-on the filename length.
-@^system dependencies@>
-
-@d name_start == (font_start[font_ptr] + 14)
-@d name_end == vf_ptr
-
-@<Move font name into the |cur_name| string@>=
-r := name_end - name_start;
-cur_name := xmalloc (r + 1);
-{|strncpy| might be faster, but it's probably a good idea to keep the
- |xchr| translation.}
-for k := name_start to name_end do begin
- cur_name[k - name_start] := xchr[vf[k]];
-end;
-cur_name[r] := 0; {Append null byte since this is C.}
-@z
-
-@x [49] Change strings to C char pointers, so we can initialize them.
-@!ASCII_04,@!ASCII_10,@!ASCII_14,HEX: packed array [1..32] of char;
- {strings for output in the user's external character set}
-@!xchr:packed array [0..255] of char;
-@!MBL_string,@!RI_string,@!RCE_string:packed array [1..3] of char;
- {handy string constants for |face| codes}
-@y
-@!ASCII_04,@!ASCII_10,@!ASCII_14,HEX: c_string;
- {strings for output in the user's external character set}
-@!ASCII_all: packed array[0..256] of char;
-@!xchr:packed array [0..255] of char;
-@!MBL_string,@!RI_string,@!RCE_string: c_string;
- {handy string constants for |face| codes}
-@z
-
-@x [50] The Pascal strings are indexed starting at 1, so we pad with a blank.
-ASCII_04:=' !"#$%&''()*+,-./0123456789:;<=>?';@/
-ASCII_10:='@@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_';@/
-ASCII_14:='`abcdefghijklmnopqrstuvwxyz{|}~?';@/
-HEX:='0123456789ABCDEF';@/
-@y
-ASCII_04:=' !"#$%&''()*+,-./0123456789:;<=>?';@/
-ASCII_10:=' @@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_';@/
-ASCII_14:=' `abcdefghijklmnopqrstuvwxyz{|}~?';@/
-HEX:=' 0123456789ABCDEF';@/
-strcpy (ASCII_all, ASCII_04);
-strcat (ASCII_all, '@@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_');
-strcat (ASCII_all, '`abcdefghijklmnopqrstuvwxyz{|}~');@/
-@z
-
-@x
-MBL_string:='MBL'; RI_string:='RI '; RCE_string:='RCE';
-@y
-MBL_string:=' MBL'; RI_string:=' RI '; RCE_string:=' RCE';
-@z
-
-% [60] How we output the character code depends on |charcode_format|.
-@x
-begin if font_type>vanilla then
- out_hex_char(c)
-else if (c>="0")and(c<="9") then
- out(' C ',c-"0":1)
-else if (c>="A")and(c<="Z") then
- out(' C ',ASCII_10[c-"A"+2])
-else if (c>="a")and(c<="z") then
- out(' C ',ASCII_14[c-"a"+2])
-else out_hex_char(c);
-end;
-@y
-begin if (font_type > vanilla) or (charcode_format = charcode_hex) then
- out_hex_char(c)
-else if (charcode_format = charcode_ascii) and (c > " ") and (c <= "~")
- and (c <> "(") and (c <> ")") then
- out(' C ', ASCII_all[c - " " + 1])
-{default case, use hex}
-else out_hex_char(c);
-end;
-@z
-
-% [61] Don't output the face code as an integer.
-@x
- out(MBL_string[1+(b mod 3)]);
- out(RI_string[1+s]);
- out(RCE_string[1+(b div 3)]);
-@y
- put_byte(MBL_string[1+(b mod 3)], vpl_file);
- put_byte(RI_string[1+s], vpl_file);
- put_byte(RCE_string[1+(b div 3)], vpl_file);
-@z
-
-@x [62] Force 32-bit constant arithmetic for 16-bit machines.
-f:=((tfm[k+1] mod 16)*@'400+tfm[k+2])*@'400+tfm[k+3];
-@y
-f:=((tfm[k+1] mod 16)*intcast(@'400)+tfm[k+2])*@'400+tfm[k+3];
-@z
-
-% [100] No progress reports unless verbose.
-@x
- incr(chars_on_line);
- end;
- for cprime:=c to (c+no_repeats(c)) do begin
- print_hex(cprime); {progress report}
-@y
- if verbose then incr(chars_on_line);
- end;
- for cprime:=c to (c+no_repeats(c)) do begin
- if verbose then print_hex(cprime); {progress report}
-@z
-
-% [112] No nonlocal goto's.
-@x
- print_ln('Sorry, I haven''t room for so many ligature/kern pairs!');
-@.Sorry, I haven't room...@>
- goto final_end;
-@y
- write_ln(stderr, 'Sorry, I haven''t room for so many ligature/kern pairs!');
-@.Sorry, I haven't room...@>
- uexit(1);
-@z
-
-% still [112] We can't have a function named `f', because of the local
-% variable in do_simple_things. It would be better, but harder, to fix
-% web2c.
-@x
- r:=f(r,(hash[r]-1)div xmax_char,(hash[r]-1)mod xmax_char);
-@y
- r:=lig_f(r,(hash[r]-1)div xmax_char,(hash[r]-1)mod xmax_char);
-@z
-
-@x
- out('(INFINITE LIGATURE LOOP MUST BE BROKEN!)'); goto final_end;
-@y
- out('(INFINITE LIGATURE LOOP MUST BE BROKEN!)'); uexit(1);
-@z
-
-% [116] web2c can't handle these mutually recursive procedures.
-% But let's do a fake definition of f here, so that it gets into web2c's
-% symbol table...
-@x
-@p function f(@!h,@!x,@!y:index):index; forward;@t\2@>
- {compute $f$ for arguments known to be in |hash[h]|}
-@y
-@p
-ifdef('notdef')
-function lig_f(@!h,@!x,@!y:index):index; begin end;@t\2@>
- {compute $f$ for arguments known to be in |hash[h]|}
-endif('notdef')
-@z
-
-@x
-else eval:=f(h,x,y);
-@y
-else eval:=lig_f(h,x,y);
-@z
-
-@x [117] ... and then really define it now.
-@p function f;
-@y
-@p function lig_f(@!h,@!x,@!y:index):index;
-@z
-
-@x
-f:=lig_z[h];
-@y
-lig_f:=lig_z[h];
-@z
-
-@x [124] Some cc's can't handle 136 case labels.
- o:=vf[vf_ptr]; incr(vf_ptr);
- case o of
- @<Cases of \.{DVI} instructions that can appear in character packets@>@;
-@y
- o:=vf[vf_ptr]; incr(vf_ptr);
- if ((o<=set_char_0+127))or
- ((o>=set1)and(o<=set1+3))or((o>=put1)and(o<=put1+3)) then
-begin if o>=set1 then
- if o>=put1 then c:=get_bytes(o-put1+1,false)
- else c:=get_bytes(o-set1+1,false)
- else c:=o;
- if f=font_ptr then
- bad_vf('Character ',c:1,' in undeclared font will be ignored')
-@.Character...will be ignored@>
- else begin vf[font_start[f+1]-1]:=c; {store |c| in the ``hole'' we left}
- k:=font_chars[f];@+while vf[k]<>c do incr(k);
- if k=font_start[f+1]-1 then
- bad_vf('Character ',c:1,' in font ',f:1,' will be ignored')
- else begin if o>=put1 then out('(PUSH)');
- left; out('SETCHAR'); out_char(c);
- if o>=put1 then out(')(POP');
- right;
- end;
- end;
- end
- else case o of
- @<Cases of \.{DVI} instructions that can appear in character packets@>
-@z
-
-@x [125] `signed' is a reserved word in ANSI C.
-@p function get_bytes(@!k:integer;@!signed:boolean):integer;
-@y
-@d signed == is_signed {|signed| is a reserved word in ANSI C}
-@p function get_bytes(@!k:integer;@!signed:boolean):integer;
-@z
-
-@x [126] No nonlocal goto's.
- begin print_ln('Stack overflow!'); goto final_end;
-@y
- begin write_ln(stderr, 'Stack overflow!'); uexit(1);
-@z
-
-@x [129] This code moved outside the case statement
-@ Before we typeset a character we make sure that it exists.
-
-@<Cases...@>=
-sixty_four_cases(set_char_0),sixty_four_cases(set_char_0+64),
- four_cases(set1),four_cases(put1):begin if o>=set1 then
- if o>=put1 then c:=get_bytes(o-put1+1,false)
- else c:=get_bytes(o-set1+1,false)
- else c:=o;
- if f=font_ptr then
- bad_vf('Character ',c:1,' in undeclared font will be ignored')
-@.Character...will be ignored@>
- else begin vf[font_start[f+1]-1]:=c; {store |c| in the ``hole'' we left}
- k:=font_chars[f];@+while vf[k]<>c do incr(k);
- if k=font_start[f+1]-1 then
- bad_vf('Character ',c:1,' in font ',f:1,' will be ignored')
- else begin if o>=put1 then out('(PUSH)');
- left; out('SETCHAR'); out_char(c);
- if o>=put1 then out(')(POP');
- right;
- end;
- end;
- end;
-@y
-@ Before we typeset a character we make sure that it exists.
-(These cases moved outside the case statement, section 124.)
-@z
-
-@x [134] No final newline unless verbose.
-print_ln('.');@/
-@y
-if verbose then print_ln('.');@/
-@z
-
-@x [135] System-dependent changes.
-This section should be replaced, if necessary, by changes to the program
-that are necessary to make \.{VFtoVP} work at a particular installation.
-It is usually best to design your change file so that all changes to
-previous sections preserve the section numbering; then everybody's version
-will be consistent with the printed program. More extensive changes,
-which introduce new sections, can be inserted here; then only the index
-itself will get a new section number.
-@^system dependencies@>
-@y
-Parse a Unix-style command line.
-
-@d argument_is (#) == (strcmp (long_options[option_index].name, #) = 0)
-
-@<Define |parse_arguments|@> =
-procedure parse_arguments;
-const n_options = 4; {Pascal won't count array lengths for us.}
-var @!long_options: array[0..n_options] of getopt_struct;
- @!getopt_return_val: integer;
- @!option_index: c_int_type;
- @!current_option: 0..n_options;
-begin
- @<Initialize the option variables@>;
- @<Define the option table@>;
- repeat
- getopt_return_val := getopt_long_only (argc, argv, '', long_options,
- address_of (option_index));
- if getopt_return_val = -1 then begin
- {End of arguments; we exit the loop below.} ;
- end else if getopt_return_val = "?" then begin
- usage ('ovf2ovp');
-
- end else if argument_is ('help') then begin
- usage_help (OVF2OVP_HELP, nil);
-
- end else if argument_is ('version') then begin
- print_version_and_exit
- (banner, nil, 'J. Plaice, Y. Haralambous, D.E. Knuth', nil);
-
- end else if argument_is ('charcode-format') then begin
- if strcmp (optarg, 'ascii') = 0 then
- charcode_format := charcode_ascii
- else if strcmp (optarg, 'hex') = 0 then
- charcode_format := charcode_hex
- else
- write_ln (stderr, 'Bad character code format', optarg, '.');
-
- end; {Else it was a flag; |getopt| has already done the assignment.}
- until getopt_return_val = -1;
-
- {Now |optind| is the index of first non-option on the command line.
- We must have one two three remaining arguments.}
- if (optind + 1 <> argc) and (optind + 2 <> argc)
- and (optind + 3 <> argc) then begin
- write_ln (stderr, 'ovf2ovp: Need one to three file arguments.');
- usage ('ovf2ovp');
- end;
-
- vf_name := cmdline (optind);
- if optind + 2 <= argc then begin
- tfm_name := cmdline (optind + 1); {The user specified the TFM name.}
- end else begin
- {User did not specify TFM name; default it from the VF name.}
- tfm_name := basename_change_suffix (vf_name, '.ovf', '.ofm');
- end;
-end;
-
-@ Here are the options we allow. The first is one of the standard GNU options.
-@.-help@>
-
-@<Define the option...@> =
-current_option := 0;
-long_options[current_option].name := 'help';
-long_options[current_option].has_arg := 0;
-long_options[current_option].flag := 0;
-long_options[current_option].val := 0;
-incr (current_option);
-
-@ Another of the standard options.
-@.-version@>
-
-@<Define the option...@> =
-long_options[current_option].name := 'version';
-long_options[current_option].has_arg := 0;
-long_options[current_option].flag := 0;
-long_options[current_option].val := 0;
-incr (current_option);
-
-@ Print progress information?
-@.-verbose@>
-
-@<Define the option...@> =
-long_options[current_option].name := 'verbose';
-long_options[current_option].has_arg := 0;
-long_options[current_option].flag := address_of (verbose);
-long_options[current_option].val := 1;
-incr (current_option);
-
-@ The global variable |verbose| determines whether or not we print
-progress information.
-
-@<Glob...@> =
-@!verbose: c_int_type;
-
-@ It starts off |false|.
-
-@<Initialize the option...@> =
-verbose := false;
-
-@ Here is an option to change how we output character codes.
-@.-charcode-format@>
-
-@<Define the option...@> =
-long_options[current_option].name := 'charcode-format';
-long_options[current_option].has_arg := 1;
-long_options[current_option].flag := 0;
-long_options[current_option].val := 0;
-incr (current_option);
-
-@ We use an ``enumerated'' type to store the information.
-
-@<Type...@> =
-@!charcode_format_type = charcode_ascii..charcode_default;
-
-@
-@<Const...@> =
-@!charcode_ascii = 0;
-@!charcode_hex = 1;
-@!charcode_default = 2;
-
-@
-@<Global...@> =
-@!charcode_format: charcode_format_type;
-
-@ It starts off as the default, which is hex for OFM2OPL.
-
-@<Initialize the option...@> =
-charcode_format := charcode_default;
-
-@ An element with all zeros always ends the list.
-
-@<Define the option...@> =
-long_options[current_option].name := 0;
-long_options[current_option].has_arg := 0;
-long_options[current_option].flag := 0;
-long_options[current_option].val := 0;
-
-@ Global filenames.
-
-@<Global...@> =
-@!vf_name, @!tfm_name, @!vpl_name:c_string;
-@z
diff --git a/Build/source/texk/web2c/omegaware/ovf2ovp.web b/Build/source/texk/web2c/omegaware/ovf2ovp.web
deleted file mode 100644
index 2e2e374dca5..00000000000
--- a/Build/source/texk/web2c/omegaware/ovf2ovp.web
+++ /dev/null
@@ -1,3138 +0,0 @@
-%
-% This file is part of the Omega project, which
-% is based in the web2c distribution of TeX.
-%
-% Copyright (c) 1994--2000 John Plaice and Yannis Haralambous
-% applies only to the changes to the original vftovp.web.
-%
-% This program by D. E. Knuth is not copyrighted and can be used freely.
-% Version 1 was implemented in December 1989.
-% Version 1.1 fixed problems of strict Pascal (April 1990).
-% Version 1.2 fixed various bugs found by Peter Breitenlohner (September 1990).
-
-% Here is TeX material that gets inserted after \input webmac
-\def\hang{\hangindent 3em\indent\ignorespaces}
-\font\ninerm=cmr9
-\let\mc=\ninerm % medium caps for names like SAIL
-\def\PASCAL{Pascal}
-
-\def\(#1){} % this is used to make section names sort themselves better
-\def\9#1{} % this is used for sort keys in the index
-
-\def\title{OVF2OVP}
-\def\contentspagenumber{101}
-\def\topofcontents{\null
- \def\titlepage{F} % include headline on the contents page
- \def\rheader{\mainfont\hfil \contentspagenumber}
- \vfill
- \centerline{\titlefont The {\ttitlefont OVF2OVP} processor}
- \vskip 15pt
- \centerline{(Version 1.11, February 2000)}
- \vfill}
-\def\botofcontents{\vfill
- \centerline{\hsize 5in\baselineskip9pt
- \vbox{\ninerm\noindent
- The preparation of this program
- was supported in part by the National Science
- Foundation and by the System Development Foundation. `\TeX' is a
- trademark of the American Mathematical Society.}}}
-\pageno=\contentspagenumber \advance\pageno by 1
-
-@* Introduction.
-The \.{VFtoVP} utility program converts a virtual font (``\.{VF}'') file
-and its associated \TeX\ font metric (``\.{TFM}'')
-file into an equivalent virtual-property-list (``\.{VPL}'') file. It also
-makes a thorough check of the given files, using algorithms that are
-essentially the same as those used by
-\.{DVI} device drivers and by \TeX. Thus if \TeX\ or a \.{DVI} driver
-complains that a \.{TFM} or \.{VF}
-file is ``bad,'' this program will pinpoint the source or sources of
-badness. A \.{VPL} file output by this program can be edited with
-a normal text editor, and the result can be converted back to \.{VF} and \.{TFM}
-format using the companion program \.{VPtoVF}.
-
-\indent\.{VFtoVP} is an extended version of the program \.{TFtoPL}, which
-is part of the standard \TeX ware library.
-The idea of a virtual font was inspired by the work of David R. Fuchs
-@^Fuchs, David Raymond@>
-who designed a similar set of conventions in 1984 while developing a
-device driver for ArborText, Inc. He wrote a somewhat similar program
-called \.{AMFtoXPL}.
-
-The |banner| string defined here should be changed whenever \.{VFtoVP}
-gets modified.
-
-@d banner=='This is OVF2OVP, Version 1.11' {printed when the program starts}
-
-@ This program is written entirely in standard \PASCAL, except that
-it occasionally has lower case letters in strings that are output.
-Such letters can be converted to upper case if necessary. The input is read
-from |vf_file| and |tfm_file|; the output is written on |vpl_file|.
-Error messages and
-other remarks are written on the |output| file, which the user may
-choose to assign to the terminal if the system permits it.
-@^system dependencies@>
-
-The term |print| is used instead of |write| when this program writes on
-the |output| file, so that all such output can be easily deflected.
-
-@d print(#)==write(#)
-@d print_ln(#)==write_ln(#)
-
-@p program OVF2OVP(@!vf_file,@!tfm_file,@!vpl_file,@!output);
-label @<Labels in the outer block@>@/
-const @<Constants in the outer block@>@/
-type @<Types in the outer block@>@/
-var @<Globals in the outer block@>@/
-procedure initialize; {this procedure gets things started properly}
- var @!k:integer; {all-purpose index for initialization}
- begin print_ln(banner);@/
- @<Set initial values@>@/
- end;
-
-@ If the program has to stop prematurely, it goes to the
-`|final_end|'.
-
-@d final_end=9999 {label for the end of it all}
-
-@<Labels...@>=final_end;
-
-@ The following parameters can be changed at compile time to extend or
-reduce \.{VFtoVP}'s capacity.
-
-@<Constants...@>=
-@!tfm_size=2000000; {maximum length of |tfm| data, in bytes}
-@!vf_size=600000; {maximum length of |vf| data, in bytes}
-@!max_fonts=300; {maximum number of local fonts in the |vf| file}
-@!lig_size=800000; {maximum length of |lig_kern| program, in words}
-@!hash_size=130003; {preferably a prime number, a bit larger than the number
- of character pairs in lig/kern steps}
-@!hash_mult=16007; {another prime}
-@!max_char=65535; {the largest character number in a font}
-@!xmax_char=65536; {|max_char|+1}
-@!xxmax_char=65537;{|max_char|+2}
-@!xmax_label=80001;{must be greater than |max_lig_steps|}
-@!mem_size=40008; {|max_char|*4+8}
-@!name_length=50; {a file name shouldn't be longer than this}
-@!max_stack=50; {maximum depth of \.{DVI} stack in character packets}
-
-@ Here are some macros for common programming idioms.
-
-@d incr(#) == #:=#+1 {increase a variable by unity}
-@d decr(#) == #:=#-1 {decrease a variable by unity}
-@d do_nothing == {empty statement}
-@d exit=10 {go here to leave a procedure}
-@d not_found=45 {go here when you've found nothing}
-@d return==goto exit {terminate a procedure call}
-@f return==nil
-
-@<Types...@>=
-@!byte=0..255; {unsigned eight-bit quantity}
-
-@* Virtual fonts. The idea behind \.{VF} files is that a general
-interface mechanism is needed to switch between the myriad font
-layouts provided by different suppliers of typesetting equipment.
-Without such a mechanism, people must go to great lengths writing
-inscrutable macros whenever they want to use typesetting conventions
-based on one font layout in connection with actual fonts that have
-another layout. This puts an extra burden on the typesetting system,
-interfering with the other things it needs to do (like kerning,
-hyphenation, and ligature formation).
-
-These difficulties go away when we have a ``virtual font,''
-i.e., a font that exists in a logical sense but not a physical sense.
-A typesetting system like \TeX\ can do its job without knowing where the
-actual characters come from; a device driver can then do its job by
-letting a \.{VF} file tell what actual characters correspond to the
-characters \TeX\ imagined were present. The actual characters
-can be shifted and/or magnified and/or combined with other characters
-from many different fonts. A virtual font can even make use of characters
-from virtual fonts, including itself.
-
-Virtual fonts also allow convenient character substitutions for proofreading
-purposes, when fonts designed for one output device are unavailable on another.
-
-@ A \.{VF} file is organized as a stream of 8-bit bytes, using conventions
-borrowed from \.{DVI} and \.{PK} files. Thus, a device driver that knows
-about \.{DVI} and \.{PK} format will already
-contain most of the mechanisms necessary to process \.{VF} files.
-We shall assume that \.{DVI} format is understood; the conventions in the
-\.{DVI} documentation (see, for example, {\sl \TeX: The Program}, part 31)
-are adopted here to define \.{VF} format.
-
-A preamble
-appears at the beginning, followed by a sequence of character definitions,
-followed by a postamble. More precisely, the first byte of every \.{VF} file
-must be the first byte of the following ``preamble command'':
-
-\yskip\hang|pre| 247 |i[1]| |k[1]| |x[k]| |cs[4]| |ds[4]|.
-Here |i| is the identification byte of \.{VF}, currently 202. The string
-|x| is merely a comment, usually indicating the source of the \.{VF} file.
-Parameters |cs| and |ds| are respectively the check sum and the design size
-of the virtual font; they should match the first two words in the header of
-the \.{TFM} file, as described below.
-
-\yskip
-After the |pre| command, the preamble continues with font definitions;
-every font needed to specify ``actual'' characters in later
-\\{set\_char} commands is defined here. The font definitions are
-exactly the same in \.{VF} files as they are in \.{DVI} files, except
-that the scaled size |s| is relative and the design size |d| is absolute:
-
-\yskip\hang|fnt_def1| 243 |k[1]| |c[4]| |s[4]| |d[4]| |a[1]| |l[1]| |n[a+l]|.
-Define font |k|, where |0<=k<256|.
-
-\yskip\hang|@!fnt_def2| 244 |k[2]| |c[4]| |s[4]| |d[4]| |a[1]| |l[1]| |n[a+l]|.
-Define font |k|, where |0<=k<65536|.
-
-\yskip\hang|@!fnt_def3| 245 |k[3]| |c[4]| |s[4]| |d[4]| |a[1]| |l[1]| |n[a+l]|.
-Define font |k|, where |0<=k<@t$2^{24}$@>|.
-
-\yskip\hang|@!fnt_def4| 246 |k[4]| |c[4]| |s[4]| |d[4]| |a[1]| |l[1]| |n[a+l]|.
-Define font |k|, where |@t$-2^{31}$@><=k<@t$2^{31}$@>|.
-
-\yskip\noindent
-These font numbers |k| are ``local''; they have no relation to font numbers
-defined in the \.{DVI} file that uses this virtual font. The dimension~|s|,
-which represents the scaled size of the local font being defined,
-is a |fix_word| relative to the design size of the virtual font.
-Thus if the local font is to be used at the same size
-as the design size of the virtual font itself, |s| will be the
-integer value $2^{20}$. The value of |s| must be positive and less than
-$2^{24}$ (thus less than 16 when considered as a |fix_word|).
-The dimension~|d| is a |fix_word| in units of printer's points; hence it
-is identical to the design size found in the corresponding \.{TFM} file.
-
-@d id_byte=202
-
-@<Glob...@>=
-@!vf_file:packed file of byte;
-
-@ The preamble is followed by zero or more character packets, where each
-character packet begins with a byte that is $<243$. Character packets have
-two formats, one long and one short:
-
-\yskip\hang|long_char| 242 |pl[4]| |cc[4]| |tfm[4]| |dvi[pl]|. This long form
-specifies a virtual character in the general case.
-
-\yskip\hang|short_char0..short_char241|
-|pl[1]| |cc[1]| |tfm[3]| |dvi[pl]|. This short form specifies a
-virtual character in the common case
-when |0<=pl<242| and |0<=cc<256| and $0\le|tfm|<2^{24}$.
-
-\yskip\noindent
-Here |pl| denotes the packet length following the |tfm| value; |cc| is
-the character code; and |tfm| is the character width copied from the
-\.{TFM} file for this virtual font. There should be at most one character
-packet having any given |cc| code.
-
-The |dvi| bytes are a sequence of complete \.{DVI} commands, properly
-nested with respect to |push| and |pop|. All \.{DVI} operations are
-permitted except |bop|, |eop|, and commands with opcodes |>=243|.
-Font selection commands (|fnt_num0| through |fnt4|) must refer to fonts
-defined in the preamble.
-
-Dimensions that appear in the \.{DVI} instructions are analogous to
-|fix_word| quantities; i.e., they are integer multiples of $2^{-20}$ times
-the design size of the virtual font. For example, if the virtual font
-has design size $10\,$pt, the \.{DVI} command to move down $5\,$pt
-would be a \\{down} instruction with parameter $2^{19}$. The virtual font
-itself might be used at a different size, say $12\,$pt; then that
-\\{down} instruction would move down $6\,$pt instead. Each dimension
-must be less than $2^{24}$ in absolute value.
-
-Device drivers processing \.{VF} files treat the sequences of |dvi| bytes
-as subroutines or macros, implicitly enclosing them with |push| and |pop|.
-Each subroutine begins with |w=x=y=z=0|, and with current font~|f| the
-number of the first-defined in the preamble (undefined if there's no
-such font). After the |dvi| commands have been
-performed, the |h| and~|v| position registers of \.{DVI} format and the
-current font~|f| are restored to their former values;
-then, if the subroutine has been invoked by a \\{set\_char} or \\{set}
-command, |h|~is increased by the \.{TFM} width
-(properly scaled)---just as if a simple character had been typeset.
-
-@d long_char=242 {\.{VF} command for general character packet}
-@d set_char_0=0 {\.{DVI} command to typeset character 0 and move right}
-@d set1=128 {typeset a character and move right}
-@d set_rule=132 {typeset a rule and move right}
-@d put1=133 {typeset a character}
-@d put_rule=137 {typeset a rule}
-@d nop=138 {no operation}
-@d push=141 {save the current positions}
-@d pop=142 {restore previous positions}
-@d right1=143 {move right}
-@d w0=147 {move right by |w|}
-@d w1=148 {move right and set |w|}
-@d x0=152 {move right by |x|}
-@d x1=153 {move right and set |x|}
-@d down1=157 {move down}
-@d y0=161 {move down by |y|}
-@d y1=162 {move down and set |y|}
-@d z0=166 {move down by |z|}
-@d z1=167 {move down and set |z|}
-@d fnt_num_0=171 {set current font to 0}
-@d fnt1=235 {set current font}
-@d xxx1=239 {extension to \.{DVI} primitives}
-@d xxx4=242 {potentially long extension to \.{DVI} primitives}
-@d fnt_def1=243 {define the meaning of a font number}
-@d pre=247 {preamble}
-@d post=248 {postamble beginning}
-@d improper_DVI_for_VF==139,140,243,244,245,246,247,248,249,250,251,252,
- 253,254,255
-
-@ The character packets are followed by a trivial postamble, consisting of
-one or more bytes all equal to |post| (248). The total number of bytes
-in the file should be a multiple of~4.
-
-@* Font metric data.
-The idea behind \.{TFM} files is that typesetting routines like \TeX\
-need a compact way to store the relevant information about several
-dozen fonts, and computer centers need a compact way to store the
-relevant information about several hundred fonts. \.{TFM} files are
-compact, and most of the information they contain is highly relevant,
-so they provide a solution to the problem.
-
-The information in a \.{TFM} file appears in a sequence of 8-bit bytes.
-Since the number of bytes is always a multiple of 4, we could
-also regard the file as a sequence of 32-bit words; but \TeX\ uses the
-byte interpretation, and so does \.{VFtoVP}. Note that the bytes
-are considered to be unsigned numbers.
-
-@<Glob...@>=
-@!tfm_file:packed file of byte;
-
-@ On some systems you may have to do something special to read a
-packed file of bytes. For example, the following code didn't work
-when it was first tried at Stanford, because packed files have to be
-opened with a special switch setting on the \PASCAL\ that was used.
-@^system dependencies@>
-
-@<Set init...@>=
-reset(tfm_file); reset(vf_file);
-
-@ The first 24 bytes (6 words) of a \.{TFM} file contain twelve 16-bit
-integers that give the lengths of the various subsequent portions
-of the file. These twelve integers are, in order:
-$$\vbox{\halign{\hfil#&$\null=\null$#\hfil\cr
-|@!lf|&length of the entire file, in words;\cr
-|@!lh|&length of the header data, in words;\cr
-|@!bc|&smallest character code in the font;\cr
-|@!ec|&largest character code in the font;\cr
-|@!nw|&number of words in the width table;\cr
-|@!nh|&number of words in the height table;\cr
-|@!nd|&number of words in the depth table;\cr
-|@!ni|&number of words in the italic correction table;\cr
-|@!nl|&number of words in the lig/kern table;\cr
-|@!nk|&number of words in the kern table;\cr
-|@!ne|&number of words in the extensible character table;\cr
-|@!np|&number of font parameter words.\cr}}$$
-They are all nonnegative and less than $2^{15}$. We must have |bc-1<=ec<=255|,
-|ne<=256|, and
-$$\hbox{|lf=6+lh+(ec-bc+1)+nw+nh+nd+ni+nl+nk+ne+np|.}$$
-Note that a font may contain as many as 256 characters (if |bc=0| and |ec=255|),
-and as few as 0 characters (if |bc=ec+1|).
-
-Incidentally, when two or more 8-bit bytes are combined to form an integer of
-16 or more bits, the most significant bytes appear first in the file.
-This is called BigEndian order.
-
-@<Glob...@>=
-@!ofm_level,
-@!nco,@!ncw,@!npc,@!nki,@!nwi,@!nkf,@!nwf,@!nkr,@!nwr,@!nkg,@!nwg,@!nkp,@!nwp,
-@!nkm,@!nwm,@!real_lf,
-@!lf,@!lh,@!bc,@!ec,@!nw,@!nh,@!nd,@!ni,@!nl,@!nk,@!ne,@!np,@!font_dir:integer;
- {subfile sizes}
-@!ofm_on:boolean;
-
-@ @<Set init...@>=
-ofm_on:=false; ofm_level:=-1; lf:=0; lh:=0;
-nco:=0; ncw:=0; npc:=0; bc:=0; ec:=0; nw:=0; nh:=0; nd:=0; ni:=0;
-nl:=0; nk:=0; ne:=0; np:=0;
-nki:=0; nwi:=0; nkf:=0; nwf:=0;
-nkm:=0; nwm:=0; real_lf:=0;
-nkr:=0; nwr:=0; nkg:=0; nwg:=0;
-nkp:=0; nwp:=0; font_dir:=0;
-
-@ The rest of the \.{TFM} file may be regarded as a sequence of ten data
-arrays having the informal specification
-$$\def\arr$[#1]#2${\&{array} $[#1]$ \&{of} #2}
-\vbox{\halign{\hfil\\{#}&$\,:\,$\arr#\hfil\cr
-header&|[0..lh-1]stuff|\cr
-char\_info&|[bc..ec]char_info_word|\cr
-width&|[0..nw-1]fix_word|\cr
-height&|[0..nh-1]fix_word|\cr
-depth&|[0..nd-1]fix_word|\cr
-italic&|[0..ni-1]fix_word|\cr
-lig\_kern&|[0..nl-1]lig_kern_command|\cr
-kern&|[0..nk-1]fix_word|\cr
-exten&|[0..ne-1]extensible_recipe|\cr
-param&|[1..np]fix_word|\cr}}$$
-The most important data type used here is a |@!fix_word|, which is
-a 32-bit representation of a binary fraction. A |fix_word| is a signed
-quantity, with the two's complement of the entire word used to represent
-negation. Of the 32 bits in a |fix_word|, exactly 12 are to the left of the
-binary point; thus, the largest |fix_word| value is $2048-2^{-20}$, and
-the smallest is $-2048$. We will see below, however, that all but one of
-the |fix_word| values will lie between $-16$ and $+16$.
-
-@ The first data array is a block of header information, which contains
-general facts about the font. The header must contain at least two words,
-and for \.{TFM} files to be used with Xerox printing software it must
-contain at least 18 words, allocated as described below. When different
-kinds of devices need to be interfaced, it may be necessary to add further
-words to the header block.
-
-\yskip\hang|header[0]| is a 32-bit check sum that \TeX\ will copy into the
-\.{DVI} output file whenever it uses the font. Later on when the \.{DVI}
-file is printed, possibly on another computer, the actual font that gets
-used is supposed to have a check sum that agrees with the one in the
-\.{TFM} file used by \TeX. In this way, users will be warned about
-potential incompatibilities. (However, if the check sum is zero in either
-the font file or the \.{TFM} file, no check is made.) The actual relation
-between this check sum and the rest of the \.{TFM} file is not important;
-the check sum is simply an identification number with the property that
-incompatible fonts almost always have distinct check sums.
-@^check sum@>
-
-\yskip\hang|header[1]| is a |fix_word| containing the design size of the
-font, in units of \TeX\ points (7227 \TeX\ points = 254 cm). This number
-must be at least 1.0; it is fairly arbitrary, but usually the design size
-is 10.0 for a ``10 point'' font, i.e., a font that was designed to look
-best at a 10-point size, whatever that really means. When a \TeX\ user
-asks for a font `\.{at} $\delta$ \.{pt}', the effect is to override the
-design size and replace it by $\delta$, and to multiply the $x$ and~$y$
-coordinates of the points in the font image by a factor of $\delta$
-divided by the design size. {\sl All other dimensions in the\/\ \.{TFM}
-file are |fix_word|\kern-1pt\ numbers in design-size units.} Thus, for example,
-the value of |param[6]|, one \.{em} or \.{\\quad}, is often the |fix_word|
-value $2^{20}=1.0$, since many fonts have a design size equal to one em.
-The other dimensions must be less than 16 design-size units in absolute
-value; thus, |header[1]| and |param[1]| are the only |fix_word| entries in
-the whole \.{TFM} file whose first byte might be something besides 0 or
-255. @^design size@>
-
-\yskip\hang|header[2..11]|, if present, contains 40 bytes that identify
-the character coding scheme. The first byte, which must be between 0 and
-39, is the number of subsequent ASCII bytes actually relevant in this
-string, which is intended to specify what character-code-to-symbol
-convention is present in the font. Examples are \.{ASCII} for standard
-ASCII, \.{TeX text} for fonts like \.{cmr10} and \.{cmti9}, \.{TeX math
-extension} for \.{cmex10}, \.{XEROX text} for Xerox fonts, \.{GRAPHIC} for
-special-purpose non-alphabetic fonts, \.{UNSPECIFIED} for the default case
-when there is no information. Parentheses should not appear in this name.
-(Such a string is said to be in {\mc BCPL} format.)
-@^coding scheme@>
-
-\yskip\hang|header[12..16]|, if present, contains 20 bytes that name the
-font family (e.g., \.{CMR} or \.{HELVETICA}), in {\mc BCPL} format.
-This field is also known as the ``font identifier.''
-@^family name@>
-@^font identifier@>
-
-\yskip\hang|header[17]|, if present, contains a first byte called the
-|seven_bit_safe_flag|, then two bytes that are ignored, and a fourth byte
-called the |face|. If the value of the fourth byte is less than 18, it has
-the following interpretation as a ``weight, slope, and expansion'': Add 0
-or 2 or 4 (for medium or bold or light) to 0 or 1 (for roman or italic) to
-0 or 6 or 12 (for regular or condensed or extended). For example, 13 is
-0+1+12, so it represents medium italic extended. A three-letter code
-(e.g., \.{MIE}) can be used for such |face| data.
-
-\yskip\hang|header[18..@twhatever@>]| might also be present; the individual
-words are simply called |header[18]|, |header[19]|, etc., at the moment.
-
-@ Next comes the |char_info| array, which contains one |char_info_word|
-per character. Each |char_info_word| contains six fields packed into
-four bytes as follows.
-
-\yskip\hang first byte: |width_index| (8 bits)\par
-\hang second byte: |height_index| (4 bits) times 16, plus |depth_index|
- (4~bits)\par
-\hang third byte: |italic_index| (6 bits) times 4, plus |tag|
- (2~bits)\par
-\hang fourth byte: |remainder| (8 bits)\par
-\yskip\noindent
-The actual width of a character is |width[width_index]|, in design-size
-units; this is a device for compressing information, since many characters
-have the same width. Since it is quite common for many characters
-to have the same height, depth, or italic correction, the \.{TFM} format
-imposes a limit of 16 different heights, 16 different depths, and
-64 different italic corrections.
-
-Incidentally, the relation |width[0]=height[0]=depth[0]=italic[0]=0|
-should always hold, so that an index of zero implies a value of zero.
-The |width_index| should never be zero unless the character does
-not exist in the font, since a character is valid if and only if it lies
-between |bc| and |ec| and has a nonzero |width_index|.
-
-@ The |tag| field in a |char_info_word| has four values that explain how to
-interpret the |remainder| field.
-
-\yskip\hang|tag=0| (|no_tag|) means that |remainder| is unused.\par
-\hang|tag=1| (|lig_tag|) means that this character has a ligature/kerning
-program starting at |lig_kern[remainder]|.\par
-\hang|tag=2| (|list_tag|) means that this character is part of a chain of
-characters of ascending sizes, and not the largest in the chain. The
-|remainder| field gives the character code of the next larger character.\par
-\hang|tag=3| (|ext_tag|) means that this character code represents an
-extensible character, i.e., a character that is built up of smaller pieces
-so that it can be made arbitrarily large. The pieces are specified in
-|exten[remainder]|.\par
-
-@d no_tag=0 {vanilla character}
-@d lig_tag=1 {character has a ligature/kerning program}
-@d list_tag=2 {character has a successor in a charlist}
-@d ext_tag=3 {character is extensible}
-
-@ The |lig_kern| array contains instructions in a simple programming language
-that explains what to do for special letter pairs. Each word is a
-|lig_kern_command| of four bytes.
-
-\yskip\hang first byte: |skip_byte|, indicates that this is the final program
- step if the byte is 128 or more, otherwise the next step is obtained by
- skipping this number of intervening steps.\par
-\hang second byte: |next_char|, ``if |next_char| follows the current character,
- then perform the operation and stop, otherwise continue.''\par
-\hang third byte: |op_byte|, indicates a ligature step if less than~128,
- a kern step otherwise.\par
-\hang fourth byte: |remainder|.\par
-\yskip\noindent
-In a kern step, an
-additional space equal to |kern[256*(op_byte-128)+remainder]| is inserted
-between the current character and |next_char|. This amount is
-often negative, so that the characters are brought closer together
-by kerning; but it might be positive.
-
-There are eight kinds of ligature steps, having |op_byte| codes $4a+2b+c$ where
-$0\le a\le b+c$ and $0\le b,c\le1$. The character whose code is
-|remainder| is inserted between the current character and |next_char|;
-then the current character is deleted if $b=0$, and |next_char| is
-deleted if $c=0$; then we pass over $a$~characters to reach the next
-current character (which may have a ligature/kerning program of its own).
-
-Notice that if $a=0$ and $b=1$, the current character is unchanged; if
-$a=b$ and $c=1$, the current character is changed but the next character is
-unchanged. \.{VFtoVP} will check to see that infinite loops are avoided.
-
-If the very first instruction of the |lig_kern| array has |skip_byte=255|,
-the |next_char| byte is the so-called right boundary character of this font;
-the value of |next_char| need not lie between |bc| and~|ec|.
-If the very last instruction of the |lig_kern| array has |skip_byte=255|,
-there is a special ligature/kerning program for a left boundary character,
-beginning at location |256*op_byte+remainder|.
-The interpretation is that \TeX\ puts implicit boundary characters
-before and after each consecutive string of characters from the same font.
-These implicit characters do not appear in the output, but they can affect
-ligatures and kerning.
-
-If the very first instruction of a character's |lig_kern| program has
-|skip_byte>128|, the program actually begins in location
-|256*op_byte+remainder|. This feature allows access to large |lig_kern|
-arrays, because the first instruction must otherwise
-appear in a location |<=255|.
-
-Any instruction with |skip_byte>128| in the |lig_kern| array must have
-|256*op_byte+remainder<nl|. If such an instruction is encountered during
-normal program execution, it denotes an unconditional halt; no ligature
-command is performed.
-
-@d stop_flag=128 {value indicating `\.{STOP}' in a lig/kern program}
-@d kern_flag=128 {op code for a kern step}
-
-@ Extensible characters are specified by an |extensible_recipe|,
-which consists of four bytes called |top|, |mid|,
-|bot|, and |rep| (in this order). These bytes are the character codes
-of individual pieces used to build up a large symbol.
-If |top|, |mid|, or |bot| are zero,
-they are not present in the built-up result. For example, an extensible
-vertical line is like an extensible bracket, except that the top and
-bottom pieces are missing.
-
-
-@ The final portion of a \.{TFM} file is the |param| array, which is another
-sequence of |fix_word| values.
-
-\yskip\hang|param[1]=@!slant| is the amount of italic slant, which is used
-to help position accents. For example, |slant=.25| means that when you go
-up one unit, you also go .25 units to the right. The |slant| is a pure
-number; it's the only |fix_word| other than the design size itself that is
-not scaled by the design size.
-
-\hang|param[2]=space| is the normal spacing between words in text.
-Note that character |" "| in the font need not have anything to do with
-blank spaces.
-
-\hang|param[3]=space_stretch| is the amount of glue stretching between words.
-
-\hang|param[4]=space_shrink| is the amount of glue shrinking between words.
-
-\hang|param[5]=x_height| is the height of letters for which accents don't
-have to be raised or lowered.
-
-\hang|param[6]=quad| is the size of one em in the font.
-
-\hang|param[7]=extra_space| is the amount added to |param[2]| at the
-ends of sentences.
-
-When the character coding scheme is \.{TeX math symbols}, the font is
-supposed to have 15 additional parameters called |num1|, |num2|, |num3|,
-|denom1|, |denom2|, |sup1|, |sup2|, |sup3|, |sub1|, |sub2|, |supdrop|,
-|subdrop|, |delim1|, |delim2|, and |axis_height|, respectively. When the
-character coding scheme is \.{TeX math extension}, the font is supposed to
-have six additional parameters called |default_rule_thickness| and
-|big_op_spacing1| through |big_op_spacing5|.
-
-@ So that is what \.{TFM} files hold. The next question is, ``What about
-\.{VPL} files?'' A complete answer to that question appears in the
-documentation of the companion program, \.{VPtoVF}, so it will not
-be repeated here. Suffice it to say that a \.{VPL} file is an ordinary
-\PASCAL\ text file, and that the output of \.{VFtoVP} uses only a
-subset of the possible constructions that might appear in a \.{VPL} file.
-Furthermore, hardly anybody really wants to look at the formal
-definition of \.{VPL} format, because it is almost self-explanatory when
-you see an example or two.
-
-@<Glob...@>=
-@!vpl_file:text;
-
-@ @<Set init...@>=
-rewrite(vpl_file);
-
-@* Unpacking the TFM file.
-The first thing \.{VFtoVP} does is read the entire |tfm_file| into an array of
-bytes, |tfm[0..(4*lf-1)]|.
-
-@<Types...@>=
-@!index=0..tfm_size; {address of a byte in |tfm|}
-@!char_type=0..65535;
-@!xchar_type=0..65536;
-@!xxchar_type=0..65537;
-@!xxxchar_type=0..65538;
-
-@
-@<Glob...@>=
-@!tfm:array [-1000..tfm_size] of byte; {the input data all goes here}
- {the negative addresses avoid range checks for invalid characters}
-@!top_char,@!top_width,@!top_height,@!top_depth,@!top_italic:integer;
-@!start_ptr,@!check_sum,@!design_size,@!scheme,@!family,@!random_word:integer;
-@!header_length,@!char_ptr,@!copies,@!j:integer;
-
-@ The input may, of course, be all screwed up and not a \.{TFM} file
-at all. So we begin cautiously.
-
-@d abort(#)==begin print_ln(#);
- print_ln('Sorry, but I can''t go on; are you sure this is a OFM?');
- goto final_end;
- end
-
-@<Read the whole font metric file@>=
-read(tfm_file,tfm[0]);
-if tfm[0]>127 then abort('The first byte of the input file exceeds 127!');
-@.The first byte...@>
-if eof(tfm_file) then abort('The input file is only one byte long!');
-@.The input...one byte long@>
-read(tfm_file,tfm[1]); lf:=tfm[0]*@'400+tfm[1];
-if lf=0 then begin
- for i:=2 to 7 do begin
- if eof(tfm_file)
- then abort('The input file is too short to designate its length!');
- read(tfm_file, tfm[i]);
- end;
- ofm_on := true; ofm_level := tfm[2]*@"100+tfm[3];
- if tfm[4]>127 then abort('The fifth byte of the input file exceeds 127!');
- lf := tfm[4]*@"1000000 + tfm[5]*@"10000 + tfm[6]*@"100 + tfm[7];
- end
-else begin
- ofm_on := false;
- end;
-case ofm_level of
- -1: begin start_ptr:=2; check_sum:=24; end;
- 0: begin start_ptr:=8; check_sum:=56; end;
- 1: begin start_ptr:=8; check_sum:=116; end;
- end;
-design_size:=check_sum+4;
-scheme:=design_size+4;
-family:=scheme+40;
-random_word:=family+20;
-if lf=0 then
- abort('The file claims to have length zero, but that''s impossible!');
-@.The file claims...@>
-if 4*lf-1>tfm_size then abort('The file is bigger than I can handle!');
-@.The file is bigger...@>
-for tfm_ptr:=start_ptr to 4*lf-1 do begin
- if eof(tfm_file) then
- abort('The file has fewer bytes than it claims!');
-@.The file has fewer bytes...@>
- read(tfm_file,tfm[tfm_ptr]);
- end;
-if not eof(tfm_file) then begin
- print_ln('There''s some extra junk at the end of the OFM file,');
-@.There's some extra junk...@>
- print_ln('but I''ll proceed as if it weren''t there.');
- end
-
-@ After the file has been read successfully, we look at the subfile sizes
-to see if they check out.
-
-@d eval_two_bytes(#)==begin if tfm[tfm_ptr]>127 then
- abort('One of the subfile sizes is negative!');
-@.One of the subfile sizes...@>
- #:=tfm[tfm_ptr]*@'400+tfm[tfm_ptr+1];
- tfm_ptr:=tfm_ptr+2;
- end
-@d eval_four_bytes(#)==begin if tfm[tfm_ptr]>127 then
- abort('One of the subfile sizes is negative!');
-@.One of the subfile sizes...@>
- #:=tfm[tfm_ptr]*@"1000000+tfm[tfm_ptr+1]*@"10000+
- tfm[tfm_ptr+2]*@"100+tfm[tfm_ptr+3];
- tfm_ptr:=tfm_ptr+4;
- end
-
-@<Set subfile sizes |lh|, |bc|, \dots, |np|@>=
-begin
-if not ofm_on then begin
- tfm_ptr:=2;
- eval_two_bytes(lh);
- eval_two_bytes(bc);
- eval_two_bytes(ec);
- eval_two_bytes(nw);
- eval_two_bytes(nh);
- eval_two_bytes(nd);
- eval_two_bytes(ni);
- eval_two_bytes(nl);
- eval_two_bytes(nk);
- eval_two_bytes(ne);
- eval_two_bytes(np);
- ncw:=(ec-bc+1);
- header_length:=6;
- top_char:=255;
- top_width:=255;
- top_height:=15;
- top_depth:=15;
- top_italic:=63;
- end
-else begin
- tfm_ptr:=8;
- eval_four_bytes(lh);
- eval_four_bytes(bc);
- eval_four_bytes(ec);
- eval_four_bytes(nw);
- eval_four_bytes(nh);
- eval_four_bytes(nd);
- eval_four_bytes(ni);
- eval_four_bytes(nl);
- eval_four_bytes(nk);
- eval_four_bytes(ne);
- eval_four_bytes(np);
- eval_four_bytes(font_dir);
- top_char:=65535;
- top_width:=65535;
- top_height:=255;
- top_depth:=255;
- top_italic:=255;
- if ofm_level=0 then begin
- header_length:=14;
- ncw:=2*(ec-bc+1);
- end
- else begin
- header_length:=29;
- eval_four_bytes(nco);
- eval_four_bytes(ncw);
- eval_four_bytes(npc);
- eval_four_bytes(nki); {Kinds of font ivalues}
- eval_four_bytes(nwi); {Words of font ivalues}
- eval_four_bytes(nkf); {Kinds of font fvalues}
- eval_four_bytes(nwf); {Words of font fvalues}
- eval_four_bytes(nkm); {Kinds of font mvalues}
- eval_four_bytes(nwm); {Words of font mvalues}
- eval_four_bytes(nkr); {Kinds of font rules}
- eval_four_bytes(nwr); {Words of font rules}
- eval_four_bytes(nkg); {Kinds of font glues}
- eval_four_bytes(nwg); {Words of font glues}
- eval_four_bytes(nkp); {Kinds of font penalties}
- eval_four_bytes(nwp); {Words of font penalties}
- end;
- end;
-if lf<>(header_length+lh+ncw+nw+nh+nd+ni+2*nl+nk+2*ne+np+
- nki+nwi+nkf+nwf+nkr+nwr+nkg+nwg+nkp+nwp) then
- abort('Subfile sizes don''t add up to the stated total!');
-@.Subfile sizes don't add up...@>
-if lh<2 then abort('The header length is only ',lh:1,'!');
-@.The header length...@>
-if (2*nl)>(4*lig_size) then
- abort('The lig/kern program is longer than I can handle!');
-@.The lig/kern program...@>
-if (bc>ec+1)or(ec>top_char) then abort('The character code range ',
-@.The character code range...@>
- bc:1,'..',ec:1,'is illegal!');
-if ec>max_char then
- abort('Character ',ec:1,'is too large. Ask a wizard to enlarge me.');
-if (nw=0)or(nh=0)or(nd=0)or(ni=0) then
- abort('Incomplete subfiles for character dimensions!');
-@.Incomplete subfiles...@>
-if ne>(top_char+1) then abort('There are ',ne:1,' extensible recipes!');
-@.There are ... recipes@>
-end
-
-@ Once the input data successfully passes these basic checks,
-\.{TFtoPL} believes that it is a \.{TFM} file, and the conversion
-to \.{PL} format will take place. Access to the various subfiles
-is facilitated by computing the following base addresses. For example,
-the |char_info| for character |c| in a \.{TFM} file will start in location
-|4*(char_base+c)| of the |tfm| array.
-
-@<Globals...@>=
-@!ivalues_start,@!fvalues_start,@!mvalues_start,
-@!rules_start,@!glues_start,@!penalties_start:
-integer;
-@!ivalues_base,@!fvalues_base,@!mvalues_base,
-@!rules_base,@!glues_base,@!penalties_base:
-integer;
-@!char_base,@!width_base,@!height_base,@!depth_base,@!italic_base: integer;
-@!lig_kern_base,@!kern_base,@!exten_base,@!param_base:integer;
- {base addresses for the subfiles}
-@!char_start:array [0..max_char] of integer;
-@!bytes_per_entry:integer;
-
-@ @<Compute the base addresses@>=
-begin
-ivalues_start:=header_length+lh;
-fvalues_start:=ivalues_start+nki;
-mvalues_start:=fvalues_start+nkf;
-rules_start:=mvalues_start+nkm;
-glues_start:=rules_start+nkr;
-penalties_start:=glues_start+nkg;
-ivalues_base:=penalties_start+nkp;
-fvalues_base:=ivalues_base+nwi;
-mvalues_base:=fvalues_base+nwi;
-rules_base:=mvalues_base+nwm;
-glues_base:=rules_base+nwr;
-penalties_base:=glues_base+nwg;
-char_base:=penalties_base+nwp;
-bytes_per_entry:=(12 + 2*npc) div 4 * 4;
-if not ofm_on then begin
- for i:=bc to ec do begin
- char_start[i]:=4*char_base+4*(i-bc);
- end;
- end
-else if ofm_level=0 then begin
- for i:=bc to ec do begin
- char_start[i]:=4*char_base+8*(i-bc);
- end;
- end
-else begin
- char_ptr:=4*char_base;
- i:=bc;
- while i<=ec do begin
- copies:=1+256*tfm[char_ptr+8]+tfm[char_ptr+9];
- for j:=1 to copies do begin
- char_start[i]:=char_ptr;
- i:=i+1;
- end;
- char_ptr:=char_ptr + bytes_per_entry;
- end;
- if char_ptr<>(4*(char_base+ncw)) then
- abort('Length of char info table does not correspond to specification');
- end;
-width_base:=char_base+ncw;
-height_base:=width_base+nw;
-depth_base:=height_base+nh;
-italic_base:=depth_base+nd;
-lig_kern_base:=italic_base+ni;
-kern_base:=lig_kern_base+2*nl;
-exten_base:=kern_base+nk;
-param_base:=exten_base+2*ne-1;
-end
-
-@ Of course we want to define macros that suppress the detail of how the
-font information is actually encoded. Each word will be referred to by
-the |tfm| index of its first byte. For example, if |c| is a character
-code between |bc| and |ec|, then |tfm[char_info(c)]| will be the
-first byte of its |char_info|, i.e., the |width_index|; furthermore
-|width(c)| will point to the |fix_word| for |c|'s width.
-
-@d char_info(#)==char_start[#]
-@d nonexistent(#)==((#<bc)or(#>ec)or(width_index(#)=0))
-@d width(#)==4*(width_base+width_index(#))
-@d height(#)==4*(height_base+height_index(#))
-@d depth(#)==4*(depth_base+depth_index(#))
-@d italic(#)==4*(italic_base+italic_index(#))
-@d kern(#)==4*(kern_base+#) {here \#\ is an index, not a character}
-@d param(#)==4*(param_base+#) {likewise}
-
-@p function width_index(c:char_type):integer;
-begin if not ofm_on then
- width_index:=tfm[char_info(c)]
-else
- width_index:=256*tfm[char_info(c)]+tfm[char_info(c)+1];
-end;
-
-function height_index(c:char_type):integer;
-begin if not ofm_on then
- height_index:=tfm[char_info(c)+1] div 16
-else
- height_index:=tfm[char_info(c)+2];
-end;
-
-function depth_index(c:char_type):integer;
-begin if not ofm_on then
- depth_index:=tfm[char_info(c)+1] mod 16
-else
- depth_index:=tfm[char_info(c)+3];
-end;
-
-function italic_index(c:char_type):integer;
-begin if not ofm_on then
- italic_index:=tfm[char_info(c)+2] div 4
-else if ofm_level=0 then
- italic_index:=tfm[char_info(c)+4]*64 + tfm[char_info(c)+5] div 4
-else
- italic_index:=tfm[char_info(c)+4];
-end;
-
-function tag(c:char_type):integer;
-begin if not ofm_on then
- tag:=tfm[char_info(c)+2] mod 4
-else
- tag:=tfm[char_info(c)+5] mod 4;
-end;
-
-procedure set_no_tag(c:char_type);
-begin if not ofm_on then
- tfm[char_info(c)+2] := (tfm[char_info(c)+2] div 64)*64 + no_tag
-else
- tfm[char_info(c)+5] := (tfm[char_info(c)+5] div 64)*64 + no_tag;
-end;
-
-function ctag(c:char_type):boolean;
-begin if not (ofm_level=1) then
- ctag:=false
-else
- ctag:=tfm[char_info(c)+5] div 4 mod 2;
-end;
-
-procedure set_no_ctag(c:char_type);
-begin if not (ofm_level=1) then
- tfm[char_info(c)+5] :=
- tfm[char_info(c)+5] div 8 * 8 + tfm[char_info(c)+5] mod 4;
-end;
-
-function no_repeats(c:char_type):integer;
-begin if ofm_level<=0 then
- no_repeats:=0
-else
- no_repeats:=256*tfm[char_info(c)+8]+tfm[char_info(c)+9];
-end;
-
-function char_param(c:char_type; i:integer):integer;
-begin
- char_param:=256*tfm[char_info(c)+2*i+10]+tfm[char_info(c)+2*i+11];
-end;
-
-function rremainder(c:char_type):integer;
-begin if not ofm_on then
- rremainder:=tfm[char_info(c)+3]
-else
- rremainder:=256*tfm[char_info(c)+6]+tfm[char_info(c)+7];
-end;
-
-function lig_step(c:char_type):integer;
-begin if not ofm_on then
- lig_step:=4*(lig_kern_base+c)
-else
- lig_step:=4*(lig_kern_base+2*c);
-end;
-
-function exten(c:char_type):integer;
-begin if not ofm_on then
- exten:=4*(exten_base+rremainder(c))
-else
- exten:=4*(exten_base+2*rremainder(c));
-end;
-
-function l_skip_byte(c:integer):integer;
-begin if not ofm_on then
- l_skip_byte:=tfm[c]
-else
- l_skip_byte:=256*tfm[c]+tfm[c+1];
-end;
-
-procedure set_l_skip_byte(c:integer; newc:integer);
-begin if not ofm_on then
- tfm[c]:=newc
-else begin
- tfm[c]:=newc div 256;
- tfm[c+1]:=newc mod 256
- end
-end;
-
-function l_next_char(c:integer):integer;
-begin if not ofm_on then
- l_next_char:=tfm[c+1]
-else
- l_next_char:=256*tfm[c+2]+tfm[c+3];
-end;
-
-procedure set_l_next_char(c:integer; newc:char_type);
-begin if not ofm_on then
- tfm[c+1]:=newc
-else begin
- tfm[c+2]:=newc div 256;
- tfm[c+3]:=newc mod 256
- end
-end;
-
-function l_op_byte(c:integer):integer;
-begin if not ofm_on then
- l_op_byte:=tfm[c+2]
-else
- l_op_byte:=256*tfm[c+4]+tfm[c+5];
-end;
-
-procedure set_l_op_byte(c:integer; newc:integer);
-begin if not ofm_on then
- tfm[c+2]:=newc
-else begin
- tfm[c+2]:=newc div 256;
- tfm[c+3]:=newc mod 256
- end
-end;
-
-function l_remainder(c:integer):integer;
-begin if not ofm_on then
- l_remainder:=tfm[c+3]
-else
- l_remainder:=256*tfm[c+6]+tfm[c+7];
-end;
-
-procedure set_l_remainder(c:integer; newc:char_type);
-begin if not ofm_on then
- tfm[c+3]:=newc
-else begin
- tfm[c+6]:=newc div 256;
- tfm[c+7]:=newc mod 256
- end
-end;
-
-@ One of the things we would like to do is take cognizance of fonts whose
-character coding scheme is \.{TeX math symbols} or \.{TeX math extension};
-we will set the |font_type| variable to one of the three choices
-|vanilla|, |mathsy|, or |mathex|.
-
-@d vanilla=0 {not a special scheme}
-@d mathsy=1 {\.{TeX math symbols} scheme}
-@d mathex=2 {\.{TeX math extension} scheme}
-
-@<Glob...@>=
-@!font_type:vanilla..mathex; {is this font special?}
-
-@* Unpacking the VF file.
-Once the \.{TFM} file has been brought into memory, \.{VFtoVP} completes
-the input phase by reading the \.{VF} information into another array of bytes.
-In this case we don't store all the data; we check the redundant bytes
-for consistency with their \.{TFM} counterparts, and we partially decode
-the packets.
-
-@<Glob...@>=
-@!vf:array[0..vf_size] of byte; {the \.{VF} input data goes here}
-@!font_number:array[0..max_fonts] of integer; {local font numbers}
-@!font_start,@!font_chars:array[0..max_fonts] of 0..vf_size; {font info}
-@!font_ptr:0..max_fonts; {number of local fonts}
-@!packet_start,@!packet_end:array[char_type] of 0..vf_size;
- {character packet boundaries}
-@!packet_found:boolean; {at least one packet has appeared}
-@!temp_byte:byte;@+@!reg_count:integer; {registers for simple calculations}
-@!real_dsize:real; {the design size, converted to floating point}
-@!pl:integer; {packet length}
-@!vf_ptr:0..vf_size; {first unused location in |vf|}
-@!vf_count:integer; {number of bytes read from |vf_file|}
-
-@ Again we cautiously verify that we've been given decent data.
-
-@d read_vf(#)==read(vf_file,#)
-@d vf_abort(#)==begin
- print_ln(#);
- print_ln('Sorry, but I can''t go on; are you sure this is a OVF?');
- goto final_end;
- end
-
-@<Read the whole \.{VF} file@>=
-read_vf(temp_byte);
-if temp_byte<>pre then vf_abort('The first byte isn''t `pre''!');
-@.The first byte...@>
-@<Read the preamble command@>;
-@<Read and store the font definitions and character packets@>;
-@<Read and verify the postamble@>
-
-@ @d vf_store(#)==@t@>@;@/
- if vf_ptr+#>=vf_size then vf_abort('The file is bigger than I can handle!');
-@.The file is bigger...@>
- for k:=vf_ptr to vf_ptr+#-1 do
- begin if eof(vf_file) then vf_abort('The file ended prematurely!');
-@.The file ended prematurely@>
- read_vf(vf[k]);
- end;
- vf_count:=vf_count+#; vf_ptr:=vf_ptr+#
-
-@<Read the preamble command@>=
-if eof(vf_file) then vf_abort('The input file is only one byte long!');
-@.The input...one byte long@>
-read_vf(temp_byte);
-if temp_byte<>id_byte then vf_abort('Wrong OVF version number in second byte!');
-@.Wrong OVF version...@>
-if eof(vf_file) then vf_abort('The input file is only two bytes long!');
-read_vf(temp_byte); {read the length of introductory comment}
-vf_count:=11; vf_ptr:=0; vf_store(temp_byte);
-for k:=0 to vf_ptr-1 do print(xchr[vf[k]]);
-print_ln(' '); reg_count:=0;
-for k:=0 to 7 do
- begin if eof(vf_file) then vf_abort('The file ended prematurely!');
-@.The file ended prematurely@>
- read_vf(temp_byte);
- if temp_byte=tfm[check_sum+k] then incr(reg_count);
- end;
-real_dsize:=(((tfm[design_size]*256+tfm[design_size+1])*256+tfm[design_size+2])
- *256+tfm[design_size+3])/@'4000000;
-if reg_count<>8 then
- begin print_ln('Check sum and/or design size mismatch.');
-@.Check sum...mismatch@>
- print_ln('Data from OFM file will be assumed correct.');
- end
-
-@ @<Read and store the font definitions and character packets@>=
-for k:=0 to 65535 do packet_start[k]:=vf_size;
-font_ptr:=0; packet_found:=false; font_start[0]:=vf_ptr;
-repeat if eof(vf_file) then
- begin print_ln('File ended without a postamble!'); temp_byte:=post;
-@.File ended without a postamble@>
- end
-else begin read_vf(temp_byte); incr(vf_count);
- if temp_byte<>post then
- if temp_byte>long_char then @<Read and store a font definition@>
- else @<Read and store a character packet@>;
- end;
-until temp_byte=post
-
-@ @<Read and verify the postamble@>=
-while (temp_byte=post)and not eof(vf_file) do
- begin read_vf(temp_byte); incr(vf_count);
- end;
-if not eof(vf_file) then
- begin print_ln('There''s some extra junk at the end of the OVF file.');
-@.There's some extra junk...@>
- print_ln('I''ll proceed as if it weren''t there.');
- end;
-if vf_count mod 4 <> 0 then
- print_ln('VF data not a multiple of 4 bytes')
-@.VF data not a multiple of 4 bytes@>
-
-@ @<Read and store a font definition@>=
-begin if packet_found or(temp_byte>=pre) then
- vf_abort('Illegal byte ',temp_byte:1,' at beginning of character packet!');
-@.Illegal byte...@>
-font_number[font_ptr]:=vf_read(temp_byte-fnt_def1+1);
-if font_ptr=max_fonts then vf_abort('I can''t handle that many fonts!');
-@.I can't handle that many fonts@>
-vf_store(14); {|c[4]| |s[4]| |d[4]| |a[1]| |l[1]|}
-if vf[vf_ptr-10]>0 then {|s| is negative or exceeds $2^{24}-1$}
- vf_abort('Mapped font size is too big!');
-@.Mapped font size...big@>
-a:=vf[vf_ptr-2]; l:=vf[vf_ptr-1]; vf_store(a+l); {|n[a+l]|}
-@<Print the name of the local font@>;
-@<Read the local font's \.{TFM} file and record the characters it contains@>;
-incr(font_ptr); font_start[font_ptr]:=vf_ptr;
-end
-
-@ The font area may need to be separated from the font name on some systems.
-Here we simply reproduce the font area and font name (with no space
-or punctuation between them).
-@^system dependencies@>
-
-@<Print the name...@>=
-print('MAPFONT ',font_ptr:1,': ');
-for k:=font_start[font_ptr]+14 to vf_ptr-1 do print(xchr[vf[k]]);
-k:=font_start[font_ptr]+5;
-print_ln(' at ',(((vf[k]*256+vf[k+1])*256+vf[k+2])/@'4000000)*real_dsize:2:2,
- 'pt')
-
-@ Now we must read in another \.{TFM} file. But this time we needn't be so
-careful, because we merely want to discover which characters are present.
-The next few sections of the program are copied pretty much verbatim from
-\.{DVItype}, so that system-dependent modifications can be copied from existing
-software.
-
-It turns out to be convenient to read four bytes at a time, when we are
-inputting from the local \.{TFM} files. The input goes into global variables
-|b0|, |b1|, |b2|, and |b3|, with |b0| getting the first byte and |b3|
-the fourth.
-
-@<Glob...@>=
-@!a:integer; {length of the area/directory spec}
-@!l:integer; {length of the font name proper}
-@!cur_name:packed array[1..name_length] of char; {external name,
- with no lower case letters}
-@!b0,@!b1,@!b2,@!b3: byte; {four bytes input at once}
-@!font_lh:integer; {header length of current local font}
-@!font_bc,@!font_ec:integer; {character range of current local font}
-@!font_ofm_level,@!font_extra_words:integer;
-@!font_kprime,@!font_j:integer;
-
-@ The |read_tfm_word| procedure sets |b0| through |b3| to the next
-four bytes in the current \.{TFM} file.
-@^system dependencies@>
-
-@d read_tfm(#)==if eof(tfm_file) then #:=0@+else read(tfm_file,#)
-
-@p procedure read_tfm_word;
-begin read_tfm(b0); read_tfm(b1);
-read_tfm(b2); read_tfm(b3);
-end;
-
-@ We use the |vf| array to store a list of all valid characters in the
-local font, beginning at location |font_chars[f]|.
-
-@<Read the local font's \.{TFM} file...@>=
-font_chars[font_ptr]:=vf_ptr;
-@<Move font name into the |cur_name| string@>;
-reset(tfm_file,cur_name);
-@^system dependencies@>
-if eof(tfm_file) then
- print_ln('---not loaded, font metric file can''t be opened!')
-@.font metric file can\'t be opened@>
-else begin font_bc:=0; font_ec:=65536; {will cause error if not modified soon}
- @<Read past the header@>;
- if font_bc<=font_ec then
- if font_ec>65535 then print_ln('---not loaded, bad font metric file!')
-@.bad font metric file@>
- else @<Read |char_info| entries@>;
- if eof(tfm_file) then
- print_ln('---trouble is brewing, font metric file ended too soon!');
-@.trouble is brewing...@>
- end;
-incr(vf_ptr) {leave space for character search later}
-
-@ @<Read past the header@>=
-read_tfm_word;
-if (b0*256+b1)<>0 then begin {TFM file}
- font_ofm_level:=-1;
- font_lh:=b2*256+b3;
- read_tfm_word; font_bc:=b0*256+b1; font_ec:=b2*256+b3;
- if font_ec<font_bc then font_bc:=font_ec+1;
- read_tfm_word;
- for k:=1 to 3+font_lh do begin
- read_tfm_word;
- if k=4 then @<Check the check sum@>;
- if k=5 then @<Check the design size@>;
- end;
- end
-else begin
- font_ofm_level:=b2*256+b3;
- read_tfm_word; font_lh:=((b0*256+b1)*256+b2)*256+b3;
- read_tfm_word; font_bc:=((b0*256+b1)*256+b2)*256+b3;
- read_tfm_word; font_ec:=((b0*256+b1)*256+b2)*256+b3;
- if font_ec<font_bc then font_bc:=font_ec+1;
- read_tfm_word;
- for k:=1 to 8 do begin
- read_tfm_word;
- end;
- if font_ofm_level=1 then begin
- read_tfm_word; read_tfm_word; read_tfm_word;
- font_extra_words:=(((b0*256+b1)*256+b2)*256+b3) div 2;
- for k:=1 to 5 do begin
- read_tfm_word;
- end;
- end;
- for k:=1 to lh do begin
- read_tfm_word;
- if k=1 then @<Check the check sum@>;
- if k=2 then @<Check the design size@>;
- end;
- end
-
-@ @<Read |char_info| entries@>=
-case font_ofm_level of
- -1: begin
- for k:=font_bc to font_ec do begin
- read_tfm_word;
- if b0>0 then begin {character |k| exists in the font}
- vf[vf_ptr]:=k; incr(vf_ptr);
- if vf_ptr=vf_size then vf_abort('I''m out of OVF memory!');
- end;
- end;
- end;
- 0: begin
- for k:=font_bc to font_ec do
- begin read_tfm_word;
- if (b0*256+b1)>0 then {character |k| exists in the font}
- begin vf[vf_ptr]:=k; incr(vf_ptr);
- if vf_ptr=vf_size then vf_abort('I''m out of OVF memory!');
- end;
- read_tfm_word;
- end;
- end;
- 1: begin
- k:=font_bc;
- while k<font_ec do begin
- read_tfm_word;
- if (b0*256+b1)>0 then begin {character |k| exists in the font}
- vf[vf_ptr]:=k; incr(vf_ptr);
- if vf_ptr=vf_size then vf_abort('I''m out of OVF memory!');
- end;
- read_tfm_word; read_tfm_word;
- font_kprime:=k+(b0*256+b1);
- for font_j:=k+1 to font_kprime do begin
- vf[vf_ptr]:=font_j; incr(vf_ptr);
- if vf_ptr=vf_size then vf_abort('I''m out of OVF memory!');
- end;
- k:=font_kprime;
- for font_j:=1 to font_extra_words do
- read_tfm_word;
- end
- end;
-end;
-
-@ @<Check the check sum@>=
-if b0+b1+b2+b3>0 then
- if(b0<>vf[font_start[font_ptr]])or@|
- (b1<>vf[font_start[font_ptr]+1])or@|
- (b2<>vf[font_start[font_ptr]+2])or@|
- (b3<>vf[font_start[font_ptr]+3]) then begin
- print_ln('Check sum in OVF file being replaced by font metric check sum');
-@.Check sum...replaced...@>
- vf[font_start[font_ptr]]:=b0;
- vf[font_start[font_ptr]+1]:=b1;
- vf[font_start[font_ptr]+2]:=b2;
- vf[font_start[font_ptr]+3]:=b3;
- end
-
-@ @<Check the design size@>=
-if(b0<>vf[font_start[font_ptr]+8])or@|
- (b1<>vf[font_start[font_ptr]+9])or@|
- (b2<>vf[font_start[font_ptr]+10])or@|
- (b3<>vf[font_start[font_ptr]+11]) then
- begin print_ln('Design size in OVF file being replaced by font metric design size');
-@.Design size...replaced...@>
- vf[font_start[font_ptr]+8]:=b0;
- vf[font_start[font_ptr]+9]:=b1;
- vf[font_start[font_ptr]+10]:=b2;
- vf[font_start[font_ptr]+11]:=b3;
- end
-
-@ If no font directory has been specified, \.{DVI}-reading software
-is supposed to use the default font directory, which is a
-system-dependent place where the standard fonts are kept.
-The string variable |default_directory| contains the name of this area.
-@^system dependencies@>
-
-@d default_directory_name=='TeXfonts:' {change this to the correct name}
-@d default_directory_name_length=9 {change this to the correct length}
-
-@<Glob...@>=
-@!default_directory:packed array[1..default_directory_name_length] of char;
-
-@ @<Set init...@>=
-default_directory:=default_directory_name;
-
-@ The string |cur_name| is supposed to be set to the external name of the
-\.{TFM} file for the current font. This usually means that we need to
-prepend the name of the default directory, and
-to append the suffix `\.{.TFM}'. Furthermore, we change lower case letters
-to upper case, since |cur_name| is a \PASCAL\ string.
-@^system dependencies@>
-
-@<Move font name into the |cur_name| string@>=
-for k:=1 to name_length do cur_name[k]:=' ';
-if a=0 then begin
- for k:=1 to default_directory_name_length do
- cur_name[k]:=default_directory[k];
- r:=default_directory_name_length;
- end
-else r:=0;
-for k:=font_start[font_ptr]+14 to vf_ptr-1 do begin
- incr(r);
- if r+4>name_length then vf_abort('Font name too long for me!');
-@.Font name too long for me@>
- if (vf[k]>="a")and(vf[k]<="z") then
- cur_name[r]:=xchr[vf[k]-@'40]
- else cur_name[r]:=xchr[vf[k]];
- end;
-cur_name[r+1]:='.'; cur_name[r+2]:='T'; cur_name[r+3]:='F'; cur_name[r+4]:='M'
-
-
-@ It's convenient to have a subroutine
-that reads a |k|-byte number from |vf_file|.
-
-@d get_vf(#)==if eof(vf_file) then #:=0 @+else read_vf(#)
-
-@p function vf_read(@!k:integer):integer; {actually |1<=k<=4|}
-var @!b:byte; {input byte}
-@!a:integer; {accumulator}
-begin vf_count:=vf_count+k; get_vf(b); a:=b;
-if k=4 then if b>=128 then a:=a-256; {4-byte numbers are signed}
-while k>1 do begin
- get_vf(b);
- a:=256*a+b; decr(k);
- end;
-vf_read:=a;
-end;
-
-@ The \.{VF} format supports arbitrary 4-byte character codes,
-but \.{VPL} format presently does not. But \.{OVP} does.
-
-@<Read and store a character packet@>=
-begin if temp_byte=long_char then
- begin pl:=vf_read(4); c:=vf_read(4); reg_count:=vf_read(4);
- {|pl[4]| |cc[4]| |tfm[4]|}
- end
-else begin pl:=temp_byte; c:=vf_read(1); reg_count:=vf_read(3);
- {|pl[1]| |cc[1]| |tfm[3]|}
- end;
-if nonexistent(c) then vf_abort('Character ',c:1,' does not exist!');
-@.Character c does not exist@>
-if packet_start[c]<vf_size then
- print_ln('Discarding earlier packet for character ',c:1);
-@.Discarding earlier packet...@>
-if reg_count<>tfm_width(c) then
- print_ln('Incorrect OFM width for character ',c:1,' in OVF file');
-@.Incorrect OFM width...@>
-if pl<0 then vf_abort('Negative packet length!');
-@.Negative packet length@>
-packet_start[c]:=vf_ptr; vf_store(pl); packet_end[c]:=vf_ptr-1;
-packet_found:=true;
-end
-
-@ The preceding code requires a simple subroutine that evaluates \.{TFM} data.
-
-@p function tfm_width(@!c:integer):integer;
-var @!a:integer; {accumulator}
-@!k:index; {index into |tfm|}
-begin k:=width(c); {we assume that character |c| exists}
-a:=tfm[k];
-if a>=128 then a:=a-256;
-tfm_width:=((256*a+tfm[k+1])*256+tfm[k+2])*256+tfm[k+3];
-end;
-
-@* Basic output subroutines.
-Let us now define some procedures that will reduce the rest of \.{VFtoVP}'s
-work to a triviality.
-
-First of all, it is convenient to have an abbreviation for output to the
-\.{VPL} file:
-
-@d out(#)==write(vpl_file,#)
-
-@ In order to stick to standard \PASCAL, we use an |xchr| array to do
-appropriate conversion of ASCII codes. Three other little strings are
-used to produce |face| codes like \.{MIE}.
-
-@<Glob...@>=
-@!ASCII_04,@!ASCII_10,@!ASCII_14,HEX: packed array [1..32] of char;
- {strings for output in the user's external character set}
-@!xchr:packed array [0..255] of char;
-@!MBL_string,@!RI_string,@!RCE_string:packed array [1..3] of char;
- {handy string constants for |face| codes}
-
-@ @<Set init...@>=
-ASCII_04:=' !"#$%&''()*+,-./0123456789:;<=>?';@/
-ASCII_10:='@@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_';@/
-ASCII_14:='`abcdefghijklmnopqrstuvwxyz{|}~?';@/
-HEX:='0123456789ABCDEF';@/
-for k:=0 to 255 do xchr[k]:='?';
-for k:=0 to @'37 do begin
- xchr[k+@'40]:=ASCII_04[k+1];
- xchr[k+@'100]:=ASCII_10[k+1];
- xchr[k+@'140]:=ASCII_14[k+1];
- end;
-MBL_string:='MBL'; RI_string:='RI '; RCE_string:='RCE';
-
-@ The array |dig| will hold a sequence of digits to be output.
-
-@<Glob...@>=
-@!dig:array[0..11] of integer;
-
-@ Here, in fact, are two procedures that output
-|dig[j-1]|$\,\ldots\,$|dig[0]|, given $j>0$.
-
-@p procedure out_digs(j:integer); {outputs |j| digits}
-begin repeat decr(j); out(HEX[1+dig[j]]);
- until j=0;
-end;
-@#
-procedure print_digs(j:integer); {prints |j| digits}
-begin repeat decr(j); print(HEX[1+dig[j]]);
- until j=0;
-end;
-
-@ The |print_number| procedure indicates how |print_digs| can be used.
-This procedure can print in octal, decimal or hex notation.
-
-@d print_hex(#)==print_number(#,16)
-@d print_octal(#)==print_number(#,8)
-@d print_decimal(#)==print_number(#,10)
-
-@p procedure print_number(c:integer; form:integer); {prints value of |c|}
-var j:0..32; {index into |dig|}
-begin
-j:=0;
-if (c<0) then begin
- print_ln('Internal error: print_number (negative value)');
- c:=0;
- end;
-if form=8 then
- print('''') {an apostrophe indicates the octal notation}
-else if form=16 then
- print('"') { a double apostrophe indicates the hexadecimal notation}
-else if form<>10 then begin
- print_ln('Internal error: print_number (form)');
- form:=16;
- end;
-while (c>0) or (j=0) do begin
- dig[j]:=c mod form; c:=c div form;
- j:=j+1;
- end;
-print_digs(j);
-end;
-
-@ A \.{VPL} file has nested parentheses, and we want to format the output
-so that its structure is clear. The |level| variable keeps track of the
-depth of nesting.
-
-@<Glob...@>=
-@!level:0..5;
-
-@ @<Set init...@>=
-level:=0;
-
-@ Three simple procedures suffice to produce the desired structure in the
-output.
-
-@p procedure out_ln; {finishes one line, indents the next}
-var l:0..5;
-begin write_ln(vpl_file);
-for l:=1 to level do out(' ');
-end;
-@#
-procedure left; {outputs a left parenthesis}
-begin incr(level); out('(');
-end;
-@#
-procedure right; {outputs a right parenthesis and finishes a line}
-begin decr(level); out(')'); out_ln;
-end;
-
-@ The value associated with a property can be output in a variety of
-ways. For example, we might want to output a {\mc BCPL} string that
-begins in |tfm[k]|:
-
-@p procedure out_BCPL(@!k:index); {outputs a string, preceded by a blank space}
-var l:0..39; {the number of bytes remaining}
-begin out(' '); l:=tfm[k];
-while l>0 do begin
- incr(k); decr(l); out(xchr[tfm[k]]);
- end;
-end;
-
-@ The property value might also be a sequence of |l| bytes, beginning
-in |tfm[k]|, that we would like to output in hex notation.
-The following procedure assumes that |l<=4|, but larger values of |l|
-could be handled easily by enlarging the |dig| array and increasing
-the upper bounds on |b| and |j|.
-
-@d out_octal_number(#)==out_number(#,8)
-@d out_decimal_number(#)==out_number(#,10)
-@d out_hex_number(#)==out_number(#,16)
-@d out_dec(#)==out_decimal_number(#)
-@d out_hex_char(#)==out_hex_number(#)
-
-@p procedure out_number(c:integer; form:integer); {outputs value of |c|}
-var j:0..32; {index into |dig|}
-begin
-j:=0;
-if (c<0) then begin
- print_ln('Internal error: print_number (negative value)');
- c:=0;
- end;
-if form=8 then
- out(' O ')
-else if form=10 then
- out(' D ')
-else if form=16 then
- out(' H ')
-else begin
- print_ln('Internal error: print_number (form)');
- form:=16;
- out(' H ')
- end;
-while (c>0) or (j=0) do begin
- dig[j]:=c mod form; c:=c div form;
- j:=j+1;
- end;
-out_digs(j);
-end;
-@#
-procedure out_hex(@!k,@!l:index);
- {outputs |l| bytes in hex}
-var a:0..@"7FFFFFFF; {accumulator for bits not yet output}
-@!b:0..32; {the number of significant bits in |a|}
-@!j:0..11; {the number of digits of output}
-begin
-out(' H ');
-a:=0; b:=0; j:=0;
-while l>0 do @<Reduce \(1)|l| by one, preserving the invariants@>;
-while (a>0)or(j=0) do begin
- dig[j]:=a mod 16; a:=a div 16; incr(j);
- end;
-out_digs(j);
-end;
-
-@ @<Reduce \(1)|l|...@>=
-begin decr(l);
-if tfm[k+l]<>0 then begin
- while b>2 do begin
- dig[j]:=a mod 16; a:=a div 16; b:=b-4; incr(j);
- end;
- case b of
- 0: a:=tfm[k+l];
- 1:a:=a+2*tfm[k+l];
- 2:a:=a+4*tfm[k+l];
- 3:a:=a+8*tfm[k+l];
- end;
- end;
-b:=b+8;
-end
-
-@ The property value may be a character, which is output in hex
-unless it is a letter or a digit. This procedure is the only place
-where a lowercase letter will be output to the \.{PL} file.
-@^system dependencies@>
-
-@p procedure out_char(@!c:integer); {outputs a character}
-begin if font_type>vanilla then
- out_hex_char(c)
-else if (c>="0")and(c<="9") then
- out(' C ',c-"0":1)
-else if (c>="A")and(c<="Z") then
- out(' C ',ASCII_10[c-"A"+2])
-else if (c>="a")and(c<="z") then
- out(' C ',ASCII_14[c-"a"+2])
-else out_hex_char(c);
-end;
-
-@ The property value might be a ``face'' byte, which is output in the
-curious code mentioned earlier, provided that it is less than 18.
-
-@p procedure out_face(@!k:index); {outputs a |face|}
-var s:0..1; {the slope}
-@!b:0..8; {the weight and expansion}
-begin if tfm[k]>=18 then out_hex(k,1)
-else begin
- out(' F '); {specify face-code format}
- s:=tfm[k] mod 2; b:=tfm[k] div 2;
- out(MBL_string[1+(b mod 3)]);
- out(RI_string[1+s]);
- out(RCE_string[1+(b div 3)]);
- end;
-end;
-
-@ And finally, the value might be a |fix_word|, which is output in
-decimal notation with just enough decimal places for \.{VPtoVF}
-to recover every bit of the given |fix_word|.
-
-All of the numbers involved in the intermediate calculations of
-this procedure will be nonnegative and less than $10\cdot2^{24}$.
-
-@p procedure out_fix(@!k:index); {outputs a |fix_word|}
-var a:0..@'7777; {accumulator for the integer part}
-@!f:integer; {accumulator for the fraction part}
-@!j:0..12; {index into |dig|}
-@!delta:integer; {amount if allowable inaccuracy}
-begin out(' R '); {specify real format}
-a:=(tfm[k]*16)+(tfm[k+1] div 16);
-f:=((tfm[k+1] mod 16)*@'400+tfm[k+2])*@'400+tfm[k+3];
-if a>@'3777 then @<Reduce \(2)negative to positive@>;
-@<Output the integer part, |a|, in decimal notation@>;
-@<Output the fraction part, $|f|/2^{20}$, in decimal notation@>;
-end;
-
-@ The following code outputs at least one digit even if |a=0|.
-
-@<Output the integer...@>=
-begin j:=0;
-repeat dig[j]:=a mod 10; a:=a div 10; incr(j);
-until a=0;
-out_digs(j);
-end
-
-@ And the following code outputs at least one digit to the right
-of the decimal point.
-
-@<Output the fraction...@>=
-begin out('.'); f:=10*f+5; delta:=10;
-repeat if delta>@'4000000 then f:=f+@'2000000-(delta div 2);
-out(f div @'4000000:1); f:=10*(f mod @'4000000); delta:=delta*10;
-until f<=delta;
-end;
-
-@ @<Reduce \(2)negative to positive@>=
-begin out('-'); a:=@'10000-a;
-if f>0 then begin
- f:=@'4000000-f; decr(a);
- end;
-end
-
-@* Outputting the TFM info.
-\TeX\ checks the information of a \.{TFM} file for validity as the
-file is being read in, so that no further checks will be needed when
-typesetting is going on. And when it finds something wrong, it justs
-calls the file ``bad,'' without identifying the nature of the problem,
-since \.{TFM} files are supposed to be good almost all of the time.
-
-Of course, a bad file shows up every now and again, and that's where
-\.{VFtoVP} comes in. This program wants to catch at least as many errors as
-\TeX\ does, and to give informative error messages besides.
-All of the errors are corrected, so that the \.{VPL} output will
-be correct (unless, of course, the \.{TFM} file was so loused up
-that no attempt is being made to fathom it).
-
-@ Just before each character is processed, its code is printed in hex
-notation. Up to eight such codes appear on a line; so we have a variable
-to keep track of how many are currently there. We also keep track of
-whether or not any errors have had to be corrected.
-
-@<Glob...@>=
-@!chars_on_line:0..8; {the number of characters printed on the current line}
-@!perfect:boolean; {was the file free of errors?}
-
-@ @<Set init...@>=
-chars_on_line:=0;@/
-perfect:=true; {innocent until proved guilty}
-
-@ Error messages are given with the help of the |bad| and |range_error|
-and |bad_char| macros:
-
-@d bad(#)==begin perfect:=false; if chars_on_line>0 then print_ln(' ');
- chars_on_line:=0; print_ln('Bad OFM file: ',#);
- end
-@.Bad OFM file@>
-@d range_error(#)==begin perfect:=false; print_ln(' ');
- print(#,' index for character ');
- print_hex(c); print_ln(' is too large;');
- print_ln('so I reset it to zero.');
- end
-@d bad_char_tail(#)==print_hex(#); print_ln('.');
- end
-@d bad_char(#)==begin perfect:=false; if chars_on_line>0 then print_ln(' ');
- chars_on_line:=0; print('Bad OFM file: ',#,' nonexistent character ');
- bad_char_tail
-@d correct_bad_char_tail(#)==#(k,0)
- end
-@d correct_bad_char_middle(#)==print_hex(#(k)); print_ln('.');
- correct_bad_char_tail
-@d correct_bad_char(#)== begin perfect:=false;
- if chars_on_line>0 then print_ln(' ');
- chars_on_line:=0; print('Bad OFM file: ',#,' nonexistent character ');
- correct_bad_char_middle
-
-@<Glob...@>=
-@!i:integer; {an index to words of a subfile}
-@!c:xchar_type; {a random character}
-@!d:0..3; {byte number in a word}
-@!k:index; {a random index}
-@!r:0..65535; {a random two-byte value}
-@!count:0..127; {for when we need to enumerate a small set}
-
-@ There are a lot of simple things to do, and they have to be done one
-at a time, so we might as well get down to business. The first things
-that \.{VFtoVP} will put into the \.{VPL} file appear in the header part.
-
-@<Do the header@>=
-begin
-case ofm_level of
- 0: begin out('(OFMLEVEL H 0)'); out_ln; end;
- 1: begin out('(OFMLEVEL H 1)'); out_ln; end;
- end;
-if ofm_on then begin
- left;
- if font_dir<=7 then out('FONTDIR')
- else out('NFONTDIR');
- case font_dir mod 8 of
- 0: out(' TL');
- 1: out(' LT');
- 2: out(' TR');
- 3: out(' LB');
- 4: out(' BL');
- 5: out(' RT');
- 6: out(' BR');
- 7: out(' RB');
- end;
- right
- end;
-font_type:=vanilla;
-if lh>=12 then begin
- @<Set the true |font_type|@>;
- if lh>=17 then begin
- @<Output the family name@>;
- if lh>=18 then @<Output the rest of the header@>;
- end;
- @<Output the character coding scheme@>;
- end;
-@<Output the design size@>;
-@<Output the check sum@>;
-@<Output the |seven_bit_safe_flag|@>;
-end
-
-@ @<Output the check sum@>=
-left; out('CHECKSUM'); out_hex(check_sum,4);
-right
-
-@ Incorrect design sizes are changed to 10 points.
-
-@d bad_design(#)==begin bad('Design size ',#,'!');
-@.Design size wrong@>
- print_ln('I''ve set it to 10 points.');
- out(' D 10');
- end
-
-@ @<Output the design size@>=
-left; out('DESIGNSIZE');
-if tfm[design_size]>127 then bad_design('negative')
-else if (tfm[design_size]=0)and(tfm[design_size+1]<16) then
- bad_design('too small')
-else out_fix(design_size);
-right;
-out('(COMMENT DESIGNSIZE IS IN POINTS)'); out_ln;
-out('(COMMENT OTHER SIZES ARE MULTIPLES OF DESIGNSIZE)'); out_ln
-@.DESIGNSIZE IS IN POINTS@>
-
-@ Since we have to check two different {\mc BCPL} strings for validity,
-we might as well write a subroutine to make the check.
-
-@p procedure check_BCPL(@!k,@!l:index); {checks a string of length |<l|}
-var j:index; {runs through the string}
-@!c:integer; {character being checked}
-begin if tfm[k]>=l then begin
- bad('String is too long; I''ve shortened it drastically.');
-@.String is too long...@>
- tfm[k]:=1;
- end;
-for j:=k+1 to k+tfm[k] do begin
- c:=tfm[j];
- if (c="(")or(c=")") then
- begin bad('Parenthesis in string has been changed to slash.');
-@.Parenthesis...changed to slash@>
- tfm[j]:="/";
- end
- else if (c<" ")or(c>"~") then begin
- bad('Nonstandard ASCII code has been blotted out.');
-@.Nonstandard ASCII code...@>
- tfm[j]:="?";
- end
- else if (c>="a")and(c<="z") then tfm[j]:=c+"A"-"a"; {upper-casify letters}
- end;
-end;
-
-@ The |font_type| starts out |vanilla|; possibly we need to reset it.
-
-@<Set the true |font_type|@>=
-begin check_BCPL(scheme,40);
-if (tfm[scheme]>=11)and@|(tfm[scheme+1]="T")and@|
- (tfm[scheme+2]="E")and@|(tfm[scheme+3]="X")and@|
- (tfm[scheme+4]=" ")and@|(tfm[scheme+5]="M")and@|
- (tfm[scheme+6]="A")and@|(tfm[scheme+7]="T")and@|
- (tfm[scheme+8]="H")and@|(tfm[scheme+9]=" ") then begin
- if (tfm[scheme+10]="S")and(tfm[scheme+11]="Y") then font_type:=mathsy
- else if (tfm[scheme+10]="E")and(tfm[scheme+11]="X") then font_type:=mathex;
- end;
-end
-
-@ @<Output the character coding scheme@>=
-left; out('CODINGSCHEME');
-out_BCPL(scheme);
-right
-
-@ @<Output the family name@>=
-left; out('FAMILY');
-check_BCPL(family,20);
-out_BCPL(family);
-right
-
-@ @<Output the rest of the header@>=
-begin left; out('FACE'); out_face(random_word+3); right;
-for i:=18 to lh-1 do begin
- left; out('HEADER D ',i:1);
- out_hex(check_sum+4*i,@,4); right;
- end;
-end
-
-@ This program does not check to see if the |seven_bit_safe_flag| has the
-correct setting, i.e., if it really reflects the seven-bit-safety of
-the \.{TFM} file; the stated value is merely put into the \.{VPL} file.
-The \.{VPtoVF} program will store a correct value and give a warning
-message if a file falsely claims to be safe.
-
-@<Output the |seven_bit_safe_flag|@>=
-if (lh>17) and (tfm[random_word]>127) then begin
- left; out('SEVENBITSAFEFLAG FALSE'); right;
- end
-
-@ The next thing to take care of is the list of parameters.
-
-@<Do the parameters@>=
-if np>0 then begin
- left; out('FONTDIMEN'); out_ln;
- for i:=1 to np do @<Check and output the $i$th parameter@>;
- right;
- end;
-@<Check to see if |np| is complete for this font type@>;
-
-@ @<Check to see if |np|...@>=
-if (font_type=mathsy)and(np<>22) then
- print_ln('Unusual number of fontdimen parameters for a math symbols font (',
-@.Unusual number of fontdimen...@>
- np:1,' not 22).')
-else if (font_type=mathex)and(np<>13) then
- print_ln('Unusual number of fontdimen parameters for an extension font (',
- np:1,' not 13).')
-
-@ All |fix_word| values except the design size and the first parameter
-will be checked to make sure that they are less than 16.0 in magnitude,
-using the |check_fix| macro:
-
-@d check_fix_tail(#)==bad(#,' ',i:1,' is too big;');
- print_ln('I have set it to zero.');
- end
-@d check_fix(#)==if (tfm[#]>0)and(tfm[#]<255) then
- begin tfm[#]:=0; tfm[(#)+1]:=0; tfm[(#)+2]:=0; tfm[(#)+3]:=0;
- check_fix_tail
-
-@<Check and output the $i$th parameter@>=
-begin left;
-if i=1 then out('SLANT') {this parameter is not checked}
-else begin check_fix(param(i))('Parameter');@/
-@.Parameter n is too big@>
- @<Output the name of parameter $i$@>;
- end;
-out_fix(param(i)); right;
-end
-
-@ @<Output the name...@>=
-if i<=7 then case i of
- 2:out('SPACE');@+3:out('STRETCH');@+4:out('SHRINK');
- 5:out('XHEIGHT');@+6:out('QUAD');@+7:out('EXTRASPACE')@+end
-else if (i<=22)and(font_type=mathsy) then case i of
- 8:out('NUM1');@+9:out('NUM2');@+10:out('NUM3');
- 11:out('DENOM1');@+12:out('DENOM2');
- 13:out('SUP1');@+14:out('SUP2');@+15:out('SUP3');
- 16:out('SUB1');@+17:out('SUB2');
- 18:out('SUPDROP');@+19:out('SUBDROP');
- 20:out('DELIM1');@+21:out('DELIM2');
- 22:out('AXISHEIGHT')@+end
-else if (i<=13)and(font_type=mathex) then
- if i=8 then out('DEFAULTRULETHICKNESS')
- else out('BIGOPSPACING',i-8:1)
-else out('PARAMETER D ',i:1)
-
-@ @<Glob...@>=
-@!start_counter,@!base_counter,@!number_entries:integer;
-@!value:integer;
-
-@ @<Do the ivalue parameters@>=
-if nki>0 then begin
- start_counter:=ivalues_start*4;
- base_counter:=ivalues_base*4;
- for i:=0 to nki-1 do @<Check and output the $i$th ivalue table@>;
- end;
-
-@ @<Check and output the $i$th ivalue table@>=
-begin
-left; out('FONTIVALUE'); out_hex_number(i); out_ln;
-number_entries:=256*tfm[start_counter+2]+tfm[start_counter+3];
-for j:=0 to number_entries-1 do begin
- left; out('IVALUE'); out_hex_number(j); out_ln;
- value:=256*tfm[base_counter+2]+tfm[base_counter+3];
- left; out('IVALUEVAL'); out_hex_number(value); right;
- right;
- base_counter:=base_counter+4;
- end;
-right;
-start_counter:=start_counter+4;;
-end;
-
-@ @<Do the fvalue parameters@>=
-if nkf>0 then begin
- start_counter:=fvalues_start*4;
- base_counter:=fvalues_base*4;
- for i:=0 to nkf-1 do @<Check and output the $i$th fvalue table@>;
- end;
-
-@ @<Check and output the $i$th fvalue table@>=
-begin
-left; out('FONTFVALUE'); out_hex_number(i); out_ln;
-number_entries:=256*tfm[start_counter+2]+tfm[start_counter+3];
-for j:=0 to number_entries-1 do begin
- left; out('FVALUE'); out_hex_number(j); out_ln;
- left; out('FVALUEVAL'); out_fix(base_counter); right;
- right;
- base_counter:=base_counter+4;
- end;
-right;
-start_counter:=start_counter+4;
-end;
-
-@ @<Do the mvalue parameters@>=
-if nkm>0 then begin
- start_counter:=mvalues_start*4;
- base_counter:=mvalues_base*4;
- for i:=0 to nkm-1 do @<Check and output the $i$th mvalue table@>;
- end;
-
-@ @<Check and output the $i$th mvalue table@>=
-begin
-left; out('FONTMVALUE'); out_hex_number(i); out_ln;
-number_entries:=256*tfm[start_counter+2]+tfm[start_counter+3];
-for j:=0 to number_entries-1 do begin
- left; out('MVALUE'); out_hex_number(j); out_ln;
- left; out('MVALUEVAL'); out_fix(base_counter); right;
- right;
- base_counter:=base_counter+4;
- end;
-right;
-start_counter:=start_counter+4;
-end;
-
-@ @<Do the rule parameters@>=
-if nkr>0 then begin
- start_counter:=rules_start*4;
- base_counter:=rules_base*4;
- for i:=0 to nkr-1 do @<Check and output the $i$th rule table@>;
- end;
-
-@ @<Check and output the $i$th rule table@>=
-begin
-left; out('FONTRULE'); out_hex_number(i); out_ln;
-number_entries:=256*tfm[start_counter+2]+tfm[start_counter+3];
-for j:=0 to number_entries-1 do begin
- left; out('RULE'); out_hex_number(j); out_ln;
- left; out('RULEWD'); out_fix(base_counter); right;
- left; out('RULEHT'); out_fix(base_counter+4); right;
- left; out('RULEDP'); out_fix(base_counter+8); right;
- right;
- base_counter:=base_counter+12;
- end;
-right;
-start_counter:=start_counter+4;
-end;
-
-@ @<Do the glue parameters@>=
-if nkg>0 then begin
- start_counter:=glues_start*4;
- base_counter:=glues_base*4;
- for i:=0 to nkg-1 do @<Check and output the $i$th glue table@>;
- end;
-
-@ @<Glob...@>=
-@!glue_subtype,@!glue_argument_kind,@!glue_stretch_order,
-@!glue_shrink_order,@!glue_argument:integer;
-
-@ @<Check and output the $i$th glue table@>=
-begin
-left; out('FONTGLUE'); out_hex_number(i); out_ln;
-number_entries:=256*tfm[start_counter+2]+tfm[start_counter+3];
-for j:=0 to number_entries-1 do begin
- left; out('GLUE'); out_hex_number(j); out_ln;
- glue_subtype:=tfm[base_counter] div 16;
- glue_argument_kind:=tfm[base_counter] mod 16;
- glue_stretch_order:=tfm[base_counter+1] div 16;
- glue_shrink_order:=tfm[base_counter+1] mod 16;
- glue_argument:=tfm[base_counter+2]*256+tfm[base_counter+3];
- left;
- out('GLUETYPE');
- case glue_subtype of
- 0: out(' H 0');
- 1: out(' H 1');
- 2: out(' H 2');
- 3: out(' H 3');
- end;
- right;
- case glue_argument_kind of
- 1: begin
- left; out('GLUERULE'); out_hex_number(glue_argument); right;
- end;
- 2: begin
- left; out('GLUECHAR'); out_hex_number(glue_argument); right;
- end;
- end;
- left;
- out('GLUESTRETCHORDER');
- case glue_stretch_order of
- 0: out(' H 0');
- 1: out(' H 1');
- 2: out(' H 2');
- 3: out(' H 3');
- 4: out(' H 4');
- end;
- right;
- left;
- out('GLUESHRINKORDER');
- case glue_shrink_order of
- 0: out(' H 0');
- 1: out(' H 1');
- 2: out(' H 2');
- 3: out(' H 3');
- 4: out(' H 4');
- end;
- right;
- left; out('GLUEWD'); out_fix(base_counter+4); right;
- left; out('GLUESTRETCH'); out_fix(base_counter+8); right;
- left; out('GLUESHRINK'); out_fix(base_counter+12); right;
- right;
- base_counter:=base_counter+16;
- end;
-right;
-start_counter:=start_counter+4;
-end;
-
-@ @<Do the penalty parameters@>=
-if nkp>0 then begin
- start_counter:=penalties_start*4;
- base_counter:=penalties_base*4;
- for i:=0 to nkp-1 do @<Check and output the $i$th penalty table@>;
- end;
-
-@ @<Check and output the $i$th penalty table@>=
-begin
-left; out('FONTPENALTY'); out_hex_number(i); out_ln;
-number_entries:=256*tfm[start_counter+2]+tfm[start_counter+3];
-for j:=0 to number_entries-1 do begin
- left; out('PENALTY'); out_hex_number(j); out_ln;
- value:=256*tfm[base_counter+2]+tfm[base_counter+3];
- left; out('PENALTYVAL'); out_hex_number(value); right;
- right;
- base_counter:=base_counter+4;
- end;
-right;
-start_counter:=start_counter+4;
-end;
-
-@ We need to check the range of all the remaining |fix_word| values,
-and to make sure that |width[0]=0|, etc.
-
-@d nonzero_fix(#)==(tfm[#]>0)or(tfm[#+1]>0)or(tfm[#+2]>0)or(tfm[#+3]>0)
-
-@<Check the |fix_word| entries@>=
-if nonzero_fix(4*width_base) then bad('width[0] should be zero.');
-@.should be zero@>
-if nonzero_fix(4*height_base) then bad('height[0] should be zero.');
-if nonzero_fix(4*depth_base) then bad('depth[0] should be zero.');
-if nonzero_fix(4*italic_base) then bad('italic[0] should be zero.');
-for i:=0 to nw-1 do check_fix(4*(width_base+i))('Width');
-@.Width n is too big@>
-for i:=0 to nh-1 do check_fix(4*(height_base+i))('Height');
-@.Height n is too big@>
-for i:=0 to nd-1 do check_fix(4*(depth_base+i))('Depth');
-@.Depth n is too big@>
-for i:=0 to ni-1 do check_fix(4*(italic_base+i))('Italic correction');
-@.Italic correction n is too big@>
-if nk>0 then for i:=0 to nk-1 do check_fix(kern(i))('Kern');
-@.Kern n is too big@>
-
-@ The ligature/kerning program comes next. Before we can put it out in
-\.{PL} format, we need to make a table of ``labels'' that will be inserted
-into the program. For each character |c| whose |tag| is |lig_tag| and
-whose starting address is |r|, we will store the pair |(c,r)| in the
-|label_table| array. If there's a boundary-char program starting at~|r|,
-we also store the pair |(256,r)|.
-This array is sorted by its second components, using the
-simple method of straight insertion.
-
-@<Glob...@>=
-@!label_table:array[xxxchar_type] of record
-@!cc:xchar_type;@!rr:0..lig_size;ischar:boolean;end;
-@!label_ptr:xxchar_type; {the largest entry in |label_table|}
-@!sort_ptr:xxchar_type; {index into |label_table|}
-@!boundary_char:xchar_type; {boundary character, or |xmax_char| if none}
-@!bchar_label:0..xmax_label; {beginning of boundary character program}
-
-@ @<Set init...@>=
-boundary_char:=xmax_char; bchar_label:=xmax_label;@/
-label_ptr:=0; label_table[0].rr:=0; {a sentinel appears at the bottom}
-
-@ We'll also identify and remove inaccessible program steps, using the
-|activity| array.
-
-@d unreachable=0 {a program step not known to be reachable}
-@d pass_through=1 {a program step passed through on initialization}
-@d accessible=2 {a program step that can be relevant}
-
-@<Glob...@>=
-@!activity:array[0..lig_size] of unreachable..accessible;
-@!ai,@!acti:0..lig_size; {indices into |activity|}
-
-@ @<Do the ligatures and kerns@>=
-if nl>0 then begin
- for ai:=0 to (nl-1) do activity[ai]:=unreachable;
- @<Check for a boundary char@>;
- end;
-@<Build the label table@>;
-if nl>0 then begin
- left; out('LIGTABLE'); out_ln;@/
- @<Compute the |activity| array@>;
- @<Output and correct the ligature/kern program@>;
- right;
- @<Check for ligature cycles@>;
- end
-
-@ We build the label table even when |nl=0|, because this catches errors
-that would not otherwise be detected.
-
-@<Build...@>=
-for c:=bc to ec do
-if (tag(c)=lig_tag) or (ctag(c)) then begin
- r:=rremainder(c);
- if (l_skip_byte(lig_step(r)) div 256)=0 then begin
- if r<nl then begin
- if l_skip_byte(lig_step(r))>stop_flag then begin
- r:=256*l_op_byte(lig_step(r))+l_remainder(lig_step(r));
- if r<nl then if activity[rremainder(c)]=unreachable then
- activity[rremainder(c)]:=pass_through;
- end;
- end;
- end;
- if r>=nl then begin
- perfect:=false; print_ln(' ');
- print('Ligature/kern starting index for character '); print_hex(c);
- print_ln(' is too large;'); print_ln('so I removed it.'); set_no_tag(c);
- set_no_ctag(c);
-@.Ligature/kern starting index...@>
- end
- else @<Insert |(c,r)| into |label_table|@>;
- end;
-label_table[label_ptr+1].rr:=lig_size; {put ``infinite'' sentinel at the end}
-
-@ @<Insert |(c,r)|...@>=
-begin sort_ptr:=label_ptr; {there's a hole at position |sort_ptr+1|}
-while label_table[sort_ptr].rr>r do begin
- label_table[sort_ptr+1]:=label_table[sort_ptr];
- decr(sort_ptr); {move the hole}
- end;
-label_table[sort_ptr+1].ischar:=not ctag(c);
-if ctag(c) then
- label_table[sort_ptr+1].cc:=char_param(c,0)
-else
- label_table[sort_ptr+1].cc:=c;
-label_table[sort_ptr+1].rr:=r; {fill the hole}
-incr(label_ptr); activity[r]:=accessible;
-end
-
-@ @<Check for a bound...@>=
-if l_skip_byte(lig_step(0))=255 then begin
- left; out('BOUNDARYCHAR');
- boundary_char:=l_next_char(lig_step(0)); out_char(boundary_char); right;
- activity[0]:=pass_through;
- end;
-if l_skip_byte(lig_step(nl-1))=255 then begin
- r:=256*l_op_byte(lig_step(nl-1))+l_remainder(lig_step(nl-1));
- if r>=nl then begin
- perfect:=false; print_ln(' ');
- print('Ligature/kern starting index for boundarychar is too large;');
- print_ln('so I removed it.');
-@.Ligature/kern starting index...@>
- end
- else begin
- label_ptr:=1; label_table[1].cc:=xmax_char;
- label_table[1].rr:=r;
- bchar_label:=r; activity[r]:=accessible;
- end;
- activity[nl-1]:=pass_through;
- end
-
-@ @<Compute the |activity| array@>=
-for ai:=0 to (nl-1) do
-if (l_skip_byte(lig_step(ai)) div 256)=1 then
- activity[ai]:=accessible
-else if activity[ai]=accessible then begin
- r:=l_skip_byte(lig_step(ai));
- if r<stop_flag then begin
- r:=r+ai+1;
- if r>=nl then begin
- bad('Ligature/kern step ',ai:1,' skips too far;');
-@.Lig...skips too far@>
- print_ln('I made it stop.'); set_l_skip_byte(lig_step(ai),stop_flag);
- end
- else activity[r]:=accessible;
- end;
- end
-
-@ We ignore |pass_through| items, which don't need to be mentioned in
-the \.{PL} file.
-
-@<Output and correct the ligature...@>=
-sort_ptr:=1; {point to the next label that will be needed}
-for acti:=0 to nl-1 do if activity[acti]<>pass_through then begin
- i:=acti; @<Take care of commenting out unreachable steps@>;
- @<Output any labels for step $i$@>;
- @<Output step $i$ of the ligature/kern program@>;
- end;
-if level=2 then right {the final step was unreachable}
-
-@ @<Globals...@>=
-@!output_clabels:array[0..256] of boolean;
-@!clabel_runner:integer;
-@!cprime:integer;
-
-@ @<Set init...@>=
-for clabel_runner:=0 to 256 do
- output_clabels[clabel_runner]:=false;
-
-@ @<Output any labels...@>=
-while i=label_table[sort_ptr].rr do begin
- if not label_table[sort_ptr].ischar then begin
- if not output_clabels[label_table[sort_ptr].cc] then begin
- output_clabels[label_table[sort_ptr].cc]:=true;
- left;
- out('CLABEL');
- out_char(label_table[sort_ptr].cc);
- right;
- end
- end
- else begin
- left;
- out('LABEL');
- if label_table[sort_ptr].cc=xmax_char then out(' BOUNDARYCHAR')
- else out_char(label_table[sort_ptr].cc);
- right;
- end;
- incr(sort_ptr);
- end
-
-@ @<Take care of commenting out...@>=
-if activity[i]=unreachable then begin
- if level=1 then begin
- left; out('COMMENT THIS PART OF THE PROGRAM IS NEVER USED!'); out_ln;
- end
- end
-else if level=2 then right
-
-@ @<Output step $i$...@>=
-begin k:=lig_step(i);
-if (l_skip_byte(k) div 256)=1 then begin
- case l_op_byte(k) of
- 17: begin
- left; out('CPEN');
- out_hex_number(l_next_char(k));
- out_hex_number(l_remainder(k));
- right;
- end;
- 18: begin
- left; out('CGLUE');
- out_hex_number(l_next_char(k));
- out_hex_number(l_remainder(k));
- right;
- end;
- 19: begin
- left; out('CPENGLUE');
- out_hex_number(l_next_char(k));
- out_hex_number(l_remainder(k) div 256);
- out_hex_number(l_remainder(k) mod 256);
- right;
- end;
- 20: begin
- left; out('CKRN');
- out_hex_number(l_next_char(k));
- r:=l_remainder(k);
- if r>=nk then begin
- bad('Kern index too large.');
-@.Kern index too large@>
- out(' R 0.0');
- end
- else out_fix(kern(r));
- right;
- end;
- end;
- end
-else if l_skip_byte(k)>stop_flag then begin
- if (256*l_op_byte(k)+l_remainder(k))>=nl then
- bad('Ligature unconditional stop command address is too big.');
-@.Ligature unconditional stop...@>
- end
-else if l_op_byte(k)>=kern_flag then @<Output a kern step@>
-else @<Output a ligature step@>;
-if (l_skip_byte(k) mod 256)>0 then
- if level=1 then @<Output either \.{SKIP} or \.{STOP}@>;
-end
-
-@ The \.{SKIP} command is a bit tricky, because we will be omitting all
-inaccessible commands.
-
-@<Output either...@>=
-begin if (l_skip_byte(k) mod 256)>=stop_flag then out('(STOP)')
-else begin
- count:=0;
- for ai:=(i+1) to (i+(l_skip_byte(k) mod 256)) do
- if activity[ai]=accessible then incr(count);
- out('(SKIP D ',count:1,')'); {possibly $count=0$, so who cares}
- end;
-out_ln;
-end
-
-@ @<Output a kern step@>=
-begin if nonexistent(l_next_char(k)) then
- if l_next_char(k)<>boundary_char then
- correct_bad_char('Kern step for')(l_next_char)(set_l_next_char);
-@.Kern step for nonexistent...@>
-left; out('KRN'); out_char(l_next_char(k));
-r:=256*(l_op_byte(k)-kern_flag)+l_remainder(k);
-if r>=nk then begin
- bad('Kern index too large.');
-@.Kern index too large@>
- out(' R 0.0');
- end
-else out_fix(kern(r));
-right;
-end
-
-@ @<Output a ligature step@>=
-begin if nonexistent(l_next_char(k)) then
- if l_next_char(k)<>boundary_char then
- correct_bad_char('Ligature step for')(l_next_char)(set_l_next_char);
-@.Ligature step for nonexistent...@>
-if nonexistent(l_remainder(k)) then
-correct_bad_char('Ligature step produces the')(l_remainder)(set_l_remainder);
-@.Ligature step produces...@>
-left; r:=l_op_byte(k);
-if (r=4)or((r>7)and(r<>11)) then begin
- print_ln('Ligature step with nonstandard code changed to LIG');
- r:=0; set_l_op_byte(k,0);
- end;
-if r mod 4>1 then out('/');
-out('LIG');
-if odd(r) then out('/');
-while r>3 do begin
- out('>'); r:=r-4;
- end;
-out_char(l_next_char(k)); out_char(l_remainder(k)); right;
-end
-
-@ The last thing on \.{VFtoVP}'s agenda is to go through the
-list of |char_info| and spew out the information about each individual
-character.
-
-@<Do the characters@>=
-sort_ptr:=0; {this will suppress `\.{STOP}' lines in ligature comments}
-c:=bc;
-while (c<=ec) do begin
- if width_index(c)>0 then begin
- if chars_on_line=8 then begin
- print_ln(' '); chars_on_line:=1;
- end
- else begin
- if chars_on_line>0 then print(' ');
- incr(chars_on_line);
- end;
- for cprime:=c to (c+no_repeats(c)) do begin
- print_hex(cprime); {progress report}
- left; out('CHARACTER'); out_char(cprime); out_ln;
- @<Output the character's width@>;
- if height_index(c)>0 then @<Output the character's height@>;
- if depth_index(c)>0 then @<Output the character's depth@>;
- if italic_index(c)>0 then @<Output the italic correction@>;
- case tag(c) of
- no_tag: do_nothing;
- lig_tag: @<Output the applicable part of the ligature/kern
- program as a comment@>;
- list_tag: @<Output the character link unless there is a problem@>;
- ext_tag: @<Output an extensible character recipe@>;
- end; {there are no other cases}
- for i:=0 to npc-1 do begin
- if char_param(c,i)<>0 then begin
- left;
- if i<nki then begin
- out('CHARIVALUE'); out_hex_number(i);
- end
- else if i<(nki+nkf) then begin
- out('CHARFVALUE'); out_hex_number(i-nki);
- end
- else if i<(nki+nkf+nkr) then begin
- out('CHARRULE'); out_hex_number(i-nki-nkf);
- end
- else if i<(nki+nkf+nkr+nkg) then begin
- out('CHARGLUE'); out_hex_number(i-nki-nkf-nkr);
- end
- else if i<(nki+nkf+nkr+nkg+nkp) then begin
- out('CHARPENALTY'); out_hex_number(i-nki-nkf-nkr-nkg);
- end;
- out_hex_number(char_param(c,i));
- right;
- end;
- end;
- if not do_map(cprime) then goto final_end;
- right;
- end;
- end;
- c:=c+1+no_repeats(c);
- end
-
-@ @<Output the character's width@>=
-if width_index(c)>=nw then range_error('Width')
-@.Width index for char...@>
-else begin left; out('CHARWD'); out_fix(width(c)); right;
- end
-
-@ @<Output the character's height@>=
-if height_index(c)>=nh then range_error('Height')
-@.Height index for char...@>
-else begin left; out('CHARHT'); out_fix(height(c)); right;
- end
-
-@ @<Output the character's depth@>=
-if depth_index(c)>=nd then range_error('Depth')
-@.Depth index for char@>
-else begin left; out('CHARDP'); out_fix(depth(c)); right;
- end
-
-@ @<Output the italic correction@>=
-if italic_index(c)>=ni then range_error('Italic correction')
-@.Italic correction index for char...@>
-else begin left; out('CHARIC'); out_fix(italic(c)); right;
- end
-
-@ @<Output the applicable part of the ligature...@>=
-begin left; out('COMMENT'); out_ln;@/
-i:=rremainder(c); r:=lig_step(i);
-if (l_skip_byte(r) mod 256)>stop_flag
-then i:=256*l_op_byte(r)+l_remainder(r);
-repeat @<Output step...@>;
-if (l_skip_byte(k) mod 256)>=stop_flag then i:=nl
-else i:=i+1+(l_skip_byte(k) mod 256);
-until i>=nl;
-right;
-end
-
-@ We want to make sure that there is no cycle of characters linked together
-by |list_tag| entries, since such a cycle would get \TeX\ into an endless
-loop. If such a cycle exists, the routine here detects it when processing
-the largest character code in the cycle.
-
-@<Output the character link unless there is a problem@>=
-begin r:=rremainder(c);
-if nonexistent(r) then begin
- bad_char('Character list link to')(r); set_no_tag(c);
-@.Character list link...@>
- end
-else begin
- while (r<c)and(tag(r)=list_tag) do r:=rremainder(r);
- if r=c then begin
- bad('Cycle in a character list!');
-@.Cycle in a character list@>
- print('Character '); print_hex(c);
- print_ln(' now ends the list.');
- set_no_tag(c);
- end
- else begin
- left; out('NEXTLARGER'); out_char(rremainder(c));
- right;
- end;
- end;
-end
-
-@ @<Output an extensible character recipe@>=
-if rremainder(c)>=ne then begin
- range_error('Extensible'); set_no_tag(c);
-@.Extensible index for char@>
- end
-else begin
- left; out('VARCHAR'); out_ln;
- @<Output the extensible pieces that exist@>;
- right;
- end
-
-@ @<Glob...@>=
-@!exten_char:integer;
-
-@ @<Output the extensible pieces that...@>=
-for d:=0 to 3 do begin
- if not ofm_on then begin
- k:=exten(c)+d;
- exten_char:=tfm[k];
- end
- else begin
- k:=exten(c)+2*d;
- exten_char:=256*tfm[k]+tfm[k+1];
- end;
- if (d=3)or(exten_char>0) then begin
- left;
- case d of
- 0:out('TOP');@+1:out('MID');@+2:out('BOT');@+3:out('REP')@+end;
- if nonexistent(exten_char) then out_char(c)
- else out_char(exten_char);
- right;
- end
- end
-
-@ Some of the extensible recipes may not actually be used, but \TeX\ will
-complain about them anyway if they refer to nonexistent characters.
-Therefore \.{VFtoVP} must check them too.
-
-@<Check the extensible recipes@>=
-if ne>0 then
- for c:=0 to ne-1 do
- for d:=0 to 3 do begin
- if not ofm_on then begin
- k:=4*(exten_base+c)+d;
- exten_char:=tfm[k];
- end
- else begin
- k:=4*(exten_base+c)+2*d;
- exten_char:=256*tfm[k]+tfm[k+1];
- end;
- if (exten_char>0)or(d=3) then begin
- if nonexistent(exten_char) then begin
- bad_char('Extensible recipe involves the')(exten_char);
-@.Extensible recipe involves...@>
- if d<3 then begin
- if not ofm_on then begin
- tfm[k]:=0;
- end
- else begin
- tfm[k]:=0;
- tfm[k+1]:=0;
- end;
- end;
- end;
- end;
- end
-
-@* Checking for ligature loops.
-We have programmed almost everything but the most interesting calculation of
-all, which has been saved for last as a special treat. \TeX's extended
-ligature mechanism allows unwary users to specify sequences of ligature
-replacements that never terminate. For example, the pair of commands
-$$\.{(/LIG $x$ $y$) (/LIG $y$ $x$)}$$
-alternately replaces character $x$ by character $y$ and vice versa. A similar
-loop occurs if \.{(LIG/ $z$ $y$)} occurs in the program for $x$ and
- \.{(LIG/ $z$ $x$)} occurs in the program for $y$.
-
-More complicated loops are also possible. For example, suppose the ligature
-programs for $x$ and $y$ are
-$$\vcenter{\halign{#\hfil\cr
-\.{(LABEL $x$)(/LIG/ $z$ $w$)(/LIG/> $w$ $y$)} \dots,\cr
-\.{(LABEL $y$)(LIG $w$ $x$)} \dots;\cr}}$$
-then the adjacent characters $xz$ change to $xwz$, $xywz$, $xxz$, $xxwz$,
-\dots, ad infinitum.
-
-@ To detect such loops, \.{TFtoPL} attempts to evaluate the function
-$f(x,y)$ for all character pairs $x$ and~$y$, where $f$ is defined as
-follows: If the current character is $x$ and the next character is
-$y$, we say the ``cursor'' is between $x$ and $y$; when the cursor
-first moves past $y$, the character immediately to its left is
-$f(x,y)$. This function is defined if and only if no infinite loop is
-generated when the cursor is between $x$ and~$y$.
-
-The function $f(x,y)$ can be defined recursively. It turns out that all pairs
-$(x,y)$ belong to one of five classes. The simplest class has $f(x,y)=y$;
-this happens if there's no ligature between $x$ and $y$, or in the cases
-\.{LIG/>} and \.{/LIG/>>}. Another simple class arises when there's a
-\.{LIG} or \.{/LIG>} between $x$ and~$y$, generating the character~$z$;
-then $f(x,y)=z$. Otherwise we always have $f(x,y)$ equal to
-either $f(x,z)$ or $f(z,y)$ or $f(f(x,z),y)$, where $z$ is the inserted
-ligature character.
-
-The first two of these classes can be merged; we can also consider
-$(x,y)$ to belong to the simple class when $f(x,y)$ has been evaluated.
-For technical reasons we allow $x$ to be 256 (for the boundary character
-at the left) or 257 (in cases when an error has been detected).
-
-For each pair $(x,y)$ having a ligature program step, we store
-$(x,y)$ in a hash table from which the values $z$ and $class$ can be read.
-
-@d simple=0 {$f(x,y)=z$}
-@d left_z=1 {$f(x,y)=f(z,y)$}
-@d right_z=2 {$f(x,y)=f(x,z)$}
-@d both_z=3 {$f(x,y)=f(f(x,z),y)$}
-@d pending=4 {$f(x,y)$ is being evaluated}
-
-@<Glob...@>=
-@!hash:array[0..hash_size] of integer;
-@!class:array[0..hash_size] of simple..pending;
-@!lig_z:array[0..hash_size] of xxchar_type;
-@!hash_ptr:0..hash_size; {the number of nonzero entries in |hash|}
-@!hash_list:array[0..hash_size] of 0..hash_size;
- {list of those nonzero entries}
-@!h,@!hh:0..hash_size; {indices into the hash table}
-@!x_lig_cycle,@!y_lig_cycle:xchar_type; {problematic ligature pair}
-
-@ @<Check for ligature cycles@>=
-hash_ptr:=0; y_lig_cycle:=xmax_char;
-for hh:=0 to hash_size do hash[hh]:=0; {clear the hash table}
-for c:=bc to ec do if tag(c)=lig_tag then begin
- i:=rremainder(c);
- if (l_skip_byte(lig_step(i)) mod 256)>stop_flag then
- i:=256*l_op_byte(lig_step(i))+l_remainder(lig_step(i));
- @<Enter data for character $c$ starting at location |i| in the hash table@>;
- end;
-if bchar_label<nl then begin
- c:=xmax_char; i:=bchar_label;
- @<Enter data for character $c$ starting at location |i| in the hash table@>;
- end;
-if hash_ptr=hash_size then begin
- print_ln('Sorry, I haven''t room for so many ligature/kern pairs!');
-@.Sorry, I haven't room...@>
- goto final_end;
- end;
-for hh:=1 to hash_ptr do begin
- r:=hash_list[hh];
- if class[r]>simple then {make sure $f$ is defined}
- r:=f(r,(hash[r]-1)div xmax_char,(hash[r]-1)mod xmax_char);
- end;
-if y_lig_cycle<xmax_char then begin
- print('Infinite ligature loop starting with ');
-@.Infinite ligature loop...@>
- if x_lig_cycle=xmax_char
- then print('boundary')@+else print_hex(x_lig_cycle);
- print(' and '); print_hex(y_lig_cycle); print_ln('!');
- out('(INFINITE LIGATURE LOOP MUST BE BROKEN!)'); goto final_end;
- end
-
-@ @<Enter data for character $c$...@>=
-repeat hash_input; k:=l_skip_byte(lig_step(i));
-if k>=stop_flag then i:=nl
-else i:=i+1+k;
-until i>=nl
-
-@ We use an ``ordered hash table'' with linear probing, because such a table
-is efficient when the lookup of a random key tends to be unsuccessful.
-
-@p procedure hash_input; {enter data for character |c| and command |i|}
-label 30; {go here for a quick exit}
-var @!cc:simple..both_z; {class of data being entered}
-@!zz:char_type; {function value or ligature character being entered}
-@!y:char_type; {the character after the cursor}
-@!key:integer; {value to be stored in |hash|}
-@!t:integer; {temporary register for swapping}
-begin if hash_ptr=hash_size then goto 30;
-@<Compute the command parameters |y|, |cc|, and |zz|@>;
-key:=xmax_char*c+y+1; h:=(hash_mult*(key mod hash_size)) mod hash_size;
-while hash[h]>0 do begin
- if hash[h]<=key then begin
- if hash[h]=key then goto 30; {unused ligature command}
- t:=hash[h]; hash[h]:=key; key:=t; {do ordered-hash-table insertion}
- t:=class[h]; class[h]:=cc; cc:=t; {namely, do a swap}
- t:=lig_z[h]; lig_z[h]:=zz; zz:=t;
- end;
- if h>0 then decr(h)@+else h:=hash_size;
- end;
-hash[h]:=key; class[h]:=cc; lig_z[h]:=zz;
-incr(hash_ptr); hash_list[hash_ptr]:=h;
-30:end;
-
-@ We must store kern commands as well as ligature commands, because
-the former might make the latter inapplicable.
-
-@<Compute the command param...@>=
-k:=lig_step(i); y:=l_next_char(k); t:=l_op_byte(k);
-cc:=simple; zz:=l_remainder(k);
-if t>=kern_flag then zz:=y
-else begin case t of
- 0,6:do_nothing; {\.{LIG},\.{/LIG>}}
- 5,11:zz:=y; {\.{LIG/>}, \.{/LIG/>>}}
- 1,7:cc:=left_z; {\.{LIG/}, \.{/LIG/>}}
- 2:cc:=right_z; {\.{/LIG}}
- 3:cc:=both_z; {\.{/LIG/}}
- end; {there are no other cases}
- end
-
-@ Evaluation of $f(x,y)$ is handled by two mutually recursive procedures.
-Kind of a neat algorithm, generalizing a depth-first search.
-
-@p function f(@!h,@!x,@!y:index):index; forward;@t\2@>
- {compute $f$ for arguments known to be in |hash[h]|}
-function eval(@!x,@!y:index):index; {compute $f(x,y)$ with hashtable lookup}
-var @!key:integer; {value sought in hash table}
-begin key:=xmax_char*x+y+1; h:=(hash_mult*key) mod hash_size;
-while hash[h]>key do
- if h>0 then decr(h)@+else h:=hash_size;
-if hash[h]<key then eval:=y {not in ordered hash table}
-else eval:=f(h,x,y);
-end;
-
-@ Pascal's beastly convention for |forward| declarations prevents us from
-saying |function f(h,x,y:index):index| here.
-
-@p function f;
-begin case class[h] of
-simple: do_nothing;
-left_z: begin class[h]:=pending; lig_z[h]:=eval(lig_z[h],y); class[h]:=simple;
- end;
-right_z: begin class[h]:=pending; lig_z[h]:=eval(x,lig_z[h]); class[h]:=simple;
- end;
-both_z: begin class[h]:=pending; lig_z[h]:=eval(eval(x,lig_z[h]),y);
- class[h]:=simple;
- end;
-pending: begin x_lig_cycle:=x; y_lig_cycle:=y;
- lig_z[h]:=xxmax_char; class[h]:=simple;
- end; {the value |xxmax_char| will break all cycles,
- since it's not in |hash|}
-end; {there are no other cases}
-f:=lig_z[h];
-end;
-
-@* Outputting the VF info.
-The routines we've used for output from the |tfm| array have counterparts
-for output from |vf|. One difference is that the string outputs from |vf|
-need to be checked for balanced parentheses. The |string_balance| routine
-tests the string of length~|l| that starts at location~|k|.
-
-@p function string_balance(@!k,@!l:integer):boolean;
-label not_found,exit;
-var @!j,@!bal:integer;
-begin if l>0 then if vf[k]=" " then goto not_found;
- {a leading blank is considered unbalanced}
-bal:=0;
-for j:=k to k+l-1 do begin
- if (vf[j]<" ")or(vf[j]>=127) then goto not_found;
- if vf[j]="(" then incr(bal)
- else if vf[j]=")" then
- if bal=0 then goto not_found else decr(bal);
- end;
-if bal>0 then goto not_found;
-string_balance:=true; return;
-not_found:string_balance:=false;
-exit:end;
-
-@ @d bad_vf(#)==begin perfect:=false; if chars_on_line>0 then print_ln(' ');
- chars_on_line:=0; print_ln('Bad OVF file: ',#);
- end
-@.Bad OVF file@>
-
-@<Do the virtual font title@>=
-if string_balance(0,font_start[0]) then begin
- left; out('VTITLE ');
- for k:=0 to font_start[0]-1 do out(xchr[vf[k]]);
- right;
- end
-else bad_vf('Title is not a balanced ASCII string')
-@.Title is not balanced@>
-
-@ We can re-use some code by moving |fix_word| data to |tfm|, using the
-fact that the design size has already been output.
-
-@p procedure out_as_fix(@!x:integer);
-var @!k:1..3;
-begin if abs(x)>=@'100000000 then
- bad_vf('Oversize dimension has been reset to zero.');
-@.Oversize dimension...@>
-if x>=0 then tfm[design_size]:=0
-else begin
- tfm[design_size]:=255; x:=x+@'100000000;
- end;
-for k:=3 downto 1 do begin
- tfm[design_size+k]:=x mod 256; x:=x div 256;
- end;
-out_fix(design_size);
-end;
-
-@ @<Do the local fonts@>=
-for f:=0 to font_ptr-1 do begin
- left; out('MAPFONT D ',f:1); out_ln;
- @<Output the font area and name@>;
- for k:=0 to 11 do tfm[k]:=vf[font_start[f]+k];
- if tfm[0]+tfm[1]+tfm[2]+tfm[3]>0 then begin
- left; out('FONTCHECKSUM'); out_hex(0,4); right;
- end;
- left; out('FONTAT'); out_fix(4); right;
- left; out('FONTDSIZE'); out_fix(8); right; right;
- end
-
-@ @<Output the font area and name@>=
-a:=vf[font_start[f]+12]; l:=vf[font_start[f]+13];
-if a>0 then
- if not string_balance(font_start[f]+14,a) then
- bad_vf('Improper font area will be ignored')
-@.Improper font area@>
- else begin
- left; out('FONTAREA ');
- for k:=font_start[f]+14 to font_start[f]+a+13 do out(xchr[vf[k]]);
- right;
- end;
-if (l=0)or not string_balance(font_start[f]+14+a,l) then
- bad_vf('Improper font name will be ignored')
-@.Improper font name@>
-else begin
- left; out('FONTNAME ');
- for k:=font_start[f]+14+a to font_start[f]+a+l+13 do out(xchr[vf[k]]);
- right;
- end
-
-@ Now we get to the interesting part of \.{VF} output, where \.{DVI}
-commands are translated into symbolic form. The \.{VPL} language is a subset
-of \.{DVI}, so we sometimes need to output semantic equivalents of
-the commands instead of producing a literal translation. This causes a
-small but tolerable loss of efficiency. We need to simulate the stack
-used by \.{DVI}-reading software.
-
-@<Glob...@>=
-@!top:0..max_stack; {\.{DVI} stack pointer}
-@!wstack,@!xstack,@!ystack,@!zstack:array[0..max_stack] of integer;
- {stacked values of \.{DVI} registers |w|, |x|, |y|, |z|}
-@!vf_limit:0..vf_size; {the current packet ends here}
-@!o:byte; {the current opcode}
-
-@ @<Do the packet for character |c|@>=
-if packet_start[c]=vf_size then
- bad_vf('Missing packet for character ',c:1)
-@.Missing packet@>
-else begin
- left; out('MAP'); out_ln;
- top:=0; wstack[0]:=0; xstack[0]:=0; ystack[0]:=0; zstack[0]:=0;
- vf_ptr:=packet_start[c]; vf_limit:=packet_end[c]+1; f:=0;
- while vf_ptr<vf_limit do begin
- o:=vf[vf_ptr]; incr(vf_ptr);
- case o of
- @<Cases of \.{DVI} instructions that can appear in character packets@>@;
- improper_DVI_for_VF: bad_vf('Illegal DVI code ',o:1,' will be ignored');
- end; {there are no other cases}
- end;
- if top>0 then begin
- bad_vf('More pushes than pops!');
-@.More pushes than pops@>
- repeat out('(POP)'); decr(top);@+until top=0;
- end;
- right;
- end
-
-@ A procedure called |get_bytes| helps fetch the parameters of \.{DVI} commands.
-
-@p function get_bytes(@!k:integer;@!signed:boolean):integer;
-var @!a:integer; {accumulator}
-begin if vf_ptr+k>vf_limit then begin
- bad_vf('Packet ended prematurely'); k:=vf_limit-vf_ptr;
- end;
-a:=vf[vf_ptr];
-if (k=4) or signed then
- if a>=128 then a:=a-256;
-incr(vf_ptr);
-while k>1 do begin
- a:=a*256+vf[vf_ptr]; incr(vf_ptr); decr(k);
- end;
-get_bytes:=a;
-end;
-
-@ Let's look at the simplest cases first, in order to get some experience.
-
-@d four_cases(#)==#,#+1,#+2,#+3
-@d eight_cases(#)==four_cases(#),four_cases(#+4)
-@d sixteen_cases(#)==eight_cases(#),eight_cases(#+8)
-@d thirty_two_cases(#)==sixteen_cases(#),sixteen_cases(#+16)
-@d sixty_four_cases(#)==thirty_two_cases(#),thirty_two_cases(#+32)
-
-@<Cases...@>=
-nop:do_nothing;
-push:begin if top=max_stack then
- begin print_ln('Stack overflow!'); goto final_end;
-@.Stack overflow@>
- end;
- incr(top); wstack[top]:=wstack[top-1]; xstack[top]:=xstack[top-1];
- ystack[top]:=ystack[top-1]; zstack[top]:=zstack[top-1]; out('(PUSH)');
- out_ln;
- end;
-pop:if top=0 then bad_vf('More pops than pushes!')
-@.More pops than pushes@>
- else begin decr(top); out('(POP)'); out_ln;
- end;
-set_rule,put_rule:begin if o=put_rule then out('(PUSH)');
- left; out('SETRULE'); out_as_fix(get_bytes(4,true));
- out_as_fix(get_bytes(4,true));
- if o=put_rule then out(')(POP');
- right;
- end;
-
-@ Horizontal and vertical motions become \.{RIGHT} and \.{DOWN} in \.{VPL}
-lingo.
-
-@<Cases...@>=
-four_cases(right1):begin out('(MOVERIGHT');
- out_as_fix(get_bytes(o-right1+1,true));
- out(')'); out_ln;@+end;
-w0,four_cases(w1):begin if o<>w0 then wstack[top]:=get_bytes(o-w1+1,true);
- out('(MOVERIGHT'); out_as_fix(wstack[top]); out(')'); out_ln;@+end;
-x0,four_cases(x1):begin if o<>x0 then xstack[top]:=get_bytes(o-x1+1,true);
- out('(MOVERIGHT'); out_as_fix(xstack[top]); out(')'); out_ln;@+end;
-four_cases(down1):begin out('(MOVEDOWN'); out_as_fix(get_bytes(o-down1+1,true));
- out(')'); out_ln;@+end;
-y0,four_cases(y1):begin if o<>y0 then ystack[top]:=get_bytes(o-y1+1,true);
- out('(MOVEDOWN'); out_as_fix(ystack[top]); out(')'); out_ln;@+end;
-z0,four_cases(z1):begin if o<>z0 then zstack[top]:=get_bytes(o-z1+1,true);
- out('(MOVEDOWN'); out_as_fix(zstack[top]); out(')'); out_ln;@+end;
-
-@ Variable |f| always refers to the current font. If |f=font_ptr|, it's
-a font that hasn't been defined (so its characters will be ignored).
-
-@<Cases...@>=
-sixty_four_cases(fnt_num_0),four_cases(fnt1):begin f:=0;
- if o>=fnt1 then font_number[font_ptr]:=get_bytes(o-fnt1+1,false)
- else font_number[font_ptr]:=o-fnt_num_0;
- while font_number[f]<>font_number[font_ptr] do incr(f);
- if f=font_ptr then bad_vf('Undeclared font selected')
-@.Undeclared font selected@>
- else begin out('(SELECTFONT D ',f:1,')'); out_ln;
- end;
- end;
-
-@ Before we typeset a character we make sure that it exists.
-
-@<Cases...@>=
-sixty_four_cases(set_char_0),sixty_four_cases(set_char_0+64),
- four_cases(set1),four_cases(put1):begin if o>=set1 then
- if o>=put1 then c:=get_bytes(o-put1+1,false)
- else c:=get_bytes(o-set1+1,false)
- else c:=o;
- if f=font_ptr then
- bad_vf('Character ',c:1,' in undeclared font will be ignored')
-@.Character...will be ignored@>
- else begin vf[font_start[f+1]-1]:=c; {store |c| in the ``hole'' we left}
- k:=font_chars[f];@+while vf[k]<>c do incr(k);
- if k=font_start[f+1]-1 then
- bad_vf('Character ',c:1,' in font ',f:1,' will be ignored')
- else begin if o>=put1 then out('(PUSH)');
- left; out('SETCHAR'); out_char(c);
- if o>=put1 then out(')(POP');
- right;
- end;
- end;
- end;
-
-@ The ``special'' commands are the only ones remaining to be dealt with.
-We use a hexadecimal
-output in the general case, if a simple string would be inadequate.
-
-@d vf_out_hex(#)==begin a:=#;
- if a<10 then out(a:1)
- else out(xchr[a-10+"A"]);
- end
-
-@<Cases...@>=
-four_cases(xxx1):begin k:=get_bytes(o-xxx1+1,false);
- if k<0 then bad_vf('String of negative length!')
- else begin left;
- if k+vf_ptr>vf_limit then
- begin bad_vf('Special command truncated to packet length');
- k:=vf_limit-vf_ptr;
- end;
- if (k>64)or not string_balance(vf_ptr,k) then
- begin out('SPECIALHEX ');
- while k>0 do
- begin if k mod 32=0 then out_ln
- else if k mod 4=0 then out(' ');
- vf_out_hex(vf[vf_ptr] div 16); vf_out_hex(vf[vf_ptr] mod 16);
- incr(vf_ptr); decr(k);
- end;
- end
- else begin out('SPECIAL ');
- while k>0 do
- begin out(xchr[vf[vf_ptr]]); incr(vf_ptr); decr(k);
- end;
- end;
- right;
- end;
- end;
-
-@* The main program.
-The routines sketched out so far need to be packaged into separate procedures,
-on some systems, since some \PASCAL\ compilers place a strict limit on the
-size of a routine. The packaging is done here in an attempt to avoid some
-system-dependent changes.
-
-First come the |vf_input| and |organize| procedures, which read the input data
-and get ready for subsequent events. If something goes wrong, the routines
-return |false|.
-
-@p function vf_input:boolean;
-label final_end, exit;
-var vf_ptr:0..vf_size; {an index into |vf|}
-@!k:integer; {all-purpose index}
-@!c:integer; {character code}
-begin @<Read the whole \.{VF} file@>;
-vf_input:=true; return;
-final_end: vf_input:=false;
-exit: end;
-@#
-function organize:boolean;
-label final_end, exit;
-var tfm_ptr:index; {an index into |tfm|}
-begin @<Read the whole font metric file@>;
-@<Set subfile sizes |lh|, |bc|, \dots, |np|@>;
-@<Compute the base addresses@>;
-organize:=vf_input; return;
-final_end: organize:=false;
-exit: end;
-
-@ Next we do the simple things.
-
-@p procedure do_simple_things;
-var i:0..@'77777; {an index to words of a subfile}
-@!f:0..vf_size; {local font number}
-@!k:integer; {all-purpose index}
-begin @<Do the virtual font title@>;
-@<Do the header@>;
-@<Do the parameters@>;
-@<Do the ivalue parameters@>;@/
-@<Do the fvalue parameters@>;@/
-@<Do the rule parameters@>;@/
-@<Do the glue parameters@>;@/
-@<Do the penalty parameters@>;@/
-@<Do the local fonts@>;
-@<Check the |fix_word| entries@>;
-end;
-
-@ And then there's a routine for individual characters.
-
-@p function do_map(@!c:integer):boolean;
-label final_end,exit;
-var @!k:integer;
-@!f:0..vf_size; {current font number}
-begin @<Do the packet for character |c|@>;
-do_map:=true; return;
-final_end: do_map:=false;
-exit:end;
-@#
-function do_characters:boolean;
-label final_end, exit;
-var @!c:integer; {character being done}
-@!k:index; {a random index}
-@!ai:0..lig_size; {index into |activity|}
-begin @<Do the characters@>;@/
-do_characters:=true; return;
-final_end: do_characters:=false;
-exit:end;
-
-@ Here is where \.{VFtoVP} begins and ends.
-@p begin initialize;@/
-if not organize then goto final_end;
-do_simple_things;@/
-@<Do the ligatures and kerns@>;
-@<Check the extensible recipes@>;
-if not do_characters then goto final_end;
-print_ln('.');@/
-if level<>0 then print_ln('This program isn''t working!');
-@.This program isn't working@>
-if not perfect then begin
- out('(COMMENT THE OFM AND/OR OVF FILE WAS BAD, ');
- out('SO THE DATA HAS BEEN CHANGED!)');
- end;
-@.THE OFM AND/OR OVF FILE WAS BAD...@>
-final_end:end.
-
-@* System-dependent changes.
-This section should be replaced, if necessary, by changes to the program
-that are necessary to make \.{VFtoVP} work at a particular installation.
-It is usually best to design your change file so that all changes to
-previous sections preserve the section numbering; then everybody's version
-will be consistent with the printed program. More extensive changes,
-which introduce new sections, can be inserted here; then only the index
-itself will get a new section number.
-@^system dependencies@>
-
-@* Index.
-Pointers to error messages appear here together with the section numbers
-where each ident\-i\-fier is used.
diff --git a/Build/source/texk/web2c/omegaware/ovp2ovf.ch b/Build/source/texk/web2c/omegaware/ovp2ovf.ch
deleted file mode 100644
index 058f755c138..00000000000
--- a/Build/source/texk/web2c/omegaware/ovp2ovf.ch
+++ /dev/null
@@ -1,320 +0,0 @@
-%
-% This file is part of the Omega project, which
-% is based in the web2c distribution of TeX.
-%
-% Copyright (c) 1994--1998 John Plaice and Yannis Haralambous
-% applies only to the changes to the original vptovf.ch.
-%
-% vptovf.ch for C compilation with web2c.
-
-@x [0] WEAVE: print changes only.
-\pageno=\contentspagenumber \advance\pageno by 1
-@y
-\pageno=\contentspagenumber \advance\pageno by 1
-%\let\maybe=\iffalse
-%\def\title{OVP2OVF changes for C}
-@z
-
-@x [2] Print the banner later.
-procedure initialize; {this procedure gets things started properly}
- var @<Local variables for initialization@>@/
- begin print_ln(banner);@/
-@y
-@<Define |parse_arguments|@>
-procedure initialize; {this procedure gets things started properly}
- var @<Local variables for initialization@>@/
- begin
- kpse_set_progname (argv[0]);
- parse_arguments;
-@z
-
-@x [3] Increase constants.
-@!buf_size=60; {length of lines displayed in error messages}
-@y
-@!buf_size=3000; {max input line length, output error line length}
-@z
-%@x
-%@!vf_size=10000; {maximum length of |vf| data, in bytes}
-%@!max_stack=100; {maximum depth of simulated \.{DVI} stack}
-%@!max_param_words=30; {the maximum number of \.{fontdimen} parameters allowed}
-%@!max_lig_steps=5000;
-% {maximum length of ligature program, must be at most $32767-257=32510$}
-%@!max_kerns=500; {the maximum number of distinct kern values}
-%@!hash_size=5003; {preferably a prime number, a bit larger than the number
-% of character pairs in lig/kern steps}
-%@y
-%@!vf_size=50000; {maximum length of |vf| data, in bytes}
-%@!max_stack=100; {maximum depth of simulated \.{DVI} stack}
-%@!max_param_words=30; {the maximum number of \.{fontdimen} parameters allowed}
-%@!max_lig_steps=10000;
-% {maximum length of ligature program, must be at most $32767-257=32510$}
-%@!max_kerns=10000; {the maximum number of distinct kern values}
-%@!hash_size=10007; {preferably a prime number, a bit larger than the number
-% of character pairs in lig/kern steps}
-%@z
-
-@x [6] Open VPL file.
-reset(vpl_file);
-@y
-reset (vpl_file, vpl_name);
-if verbose then begin
- print (banner);
- print_ln (banner);
-end;
-@z
-
-@x [22] Open output files.
-@ On some systems you may have to do something special to write a
-packed file of bytes. For example, the following code didn't work
-when it was first tried at Stanford, because packed files have to be
-opened with a special switch setting on the \PASCAL\ that was used.
-@^system dependencies@>
-
-@<Set init...@>=
-rewrite(vf_file); rewrite(tfm_file);
-@y
-@ On some systems you may have to do something special to write a
-packed file of bytes.
-@^system dependencies@>
-
-@<Set init...@>=
-rewritebin (vf_file, vf_name);
-rewritebin (tfm_file, tfm_name);
-@z
-
-% [89] `index' is not a good choice for an identifier on Unix systems.
-% Neither is `class', on AIX.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-@x
-|k|th element of its list.
-@y
-|k|th element of its list.
-
-@d index == index_var
-@d class == class_var
-@z
-
-@x [118] No output unless verbose.
-@<Print |c| in hex notation@>;
-@y
-if verbose then @<Print |c| in hex notation@>;
-@z
-
-@x
-@!HEX: packed array [1..32] of char;
-@y
-@!HEX: c_string;
-@z
-
-@x
-HEX:='0123456789ABCDEF';@/
-@y
-HEX:=' 0123456789ABCDEF';@/
-@z
-
-@x [144] Output of real numbers.
-@ @d round_message(#)==if delta>0 then print_ln('I had to round some ',
-@.I had to round...@>
- #,'s by ',(((delta+1) div 2)/@'4000000):1:7,' units.')
-@y
-@ @d round_message(#)==if delta>0 then begin print('I had to round some ',
-@.I had to round...@>
- #,'s by '); print_real((((delta+1) div 2)/@'4000000),1,7);
- print_ln(' units.'); end
-@z
-
-@x [152] Fix up the mutually recursive procedures a la pltotf.
-@p function f(@!h,@!x,@!y:indx):indx; forward;@t\2@>
- {compute $f$ for arguments known to be in |hash[h]|}
-@y
-@p
-ifdef('notdef')
-function f(@!h,@!x,@!y:indx):indx; begin end;@t\2@>
- {compute $f$ for arguments known to be in |hash[h]|}
-endif('notdef')
-@z
-
-@x [153] Finish fixing up f.
-@p function f;
-@y
-@p function f(@!h,@!x,@!y:indx):indx;
-@z
-
-@x [156] Change TFM-byte output to fix ranges.
-@d out(#)==write(tfm_file,#)
-@y
-@d out(#)==putbyte(#,tfm_file)
-@z
-
-@x [165] Fix output of reals.
-@p procedure out_scaled(x:fix_word); {outputs a scaled |fix_word|}
-var @!n:byte; {the first byte after the sign}
-@!m:0..65535; {the two least significant bytes}
-begin if abs(x/design_units)>=16.0 then begin
- print_ln('The relative dimension ',x/@'4000000:1:3,
- ' is too large.');
-@.The relative dimension...@>
- print(' (Must be less than 16*designsize');
- if design_units<>unity then print(' =',design_units/@'200000:1:3,
- ' designunits');
-@y
-@p procedure out_scaled(x:fix_word); {outputs a scaled |fix_word|}
-var @!n:byte; {the first byte after the sign}
-@!m:0..65535; {the two least significant bytes}
-begin if fabs(x/design_units)>=16.0 then begin
- print('The relative dimension ');
- print_real(x/@'4000000,1,3);
- print_ln(' is too large.');
-@.The relative dimension...@>
- print(' (Must be less than 16*designsize');
- if design_units<>unity then begin print(' =');
- print_real(design_units/@'200000,1,3);
- print(' designunits');
- end;
-@z
-
-% [141] char_remainder[c] is unsigned, and label_table[sort_ptr].rr
-% might be -1, and if -1 is coerced to being unsigned, it will be bigger
-% than anything else.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-@x
- while label_table[sort_ptr].rr>char_remainder[c] do begin
-@y
- while label_table[sort_ptr].rr>intcast(char_remainder[c]) do begin
-@z
-
-@x [175] Change VF-byte output to fix ranges.
-@d vout(#)==write(vf_file,#)
-@y
-@d vout(#)==putbyte(#,vf_file)
-@z
-
-@x [181] Be quiet unless verbose.
-read_input; print_ln('.');@/
-@y
-read_input;
-if verbose then print_ln('.');
-@z
-
-@x [182] System-dependent changes.
-This section should be replaced, if necessary, by changes to the program
-that are necessary to make \.{VPtoVF} work at a particular installation.
-It is usually best to design your change file so that all changes to
-previous sections preserve the section numbering; then everybody's version
-will be consistent with the printed program. More extensive changes,
-which introduce new sections, can be inserted here; then only the index
-itself will get a new section number.
-@^system dependencies@>
-@y
-Parse a Unix-style command line.
-
-@d argument_is (#) == (strcmp (long_options[option_index].name, #) = 0)
-
-@<Define |parse_arguments|@> =
-procedure parse_arguments;
-const n_options = 3; {Pascal won't count array lengths for us.}
-var @!long_options: array[0..n_options] of getopt_struct;
- @!getopt_return_val: integer;
- @!option_index: c_int_type;
- @!current_option: 0..n_options;
-begin
- @<Initialize the option variables@>;
- @<Define the option table@>;
- repeat
- getopt_return_val := getopt_long_only (argc, argv, '', long_options,
- address_of (option_index));
- if getopt_return_val = -1 then begin
- {End of arguments; we exit the loop below.} ;
-
- end else if getopt_return_val = "?" then begin
- usage ('ovp2ovf'); {|getopt| has already given an error message.}
-
- end else if argument_is ('help') then begin
- usage_help (OVP2OVF_HELP, nil);
-
- end else if argument_is ('version') then begin
- print_version_and_exit
- (banner, nil, 'J. Plaice, Y. Haralambous, D.E. Knuth', nil);
-
- end; {Else it was a flag; |getopt| has already done the assignment.}
- until getopt_return_val = -1;
-
- {Now |optind| is the index of first non-option on the command line.
- We must have one to three remaining arguments.}
- if (optind + 1 <> argc) and (optind + 2 <> argc)
- and (optind + 3 <> argc) then begin
- write_ln (stderr, 'ovp2ovf: Need one to three file arguments.');
- usage ('ovp2ovf');
- end;
-
- vpl_name := extend_filename (cmdline (optind), 'ovp');
-
- if optind + 2 <= argc then begin
- {Specified one or both of the output files.}
- vf_name := extend_filename (cmdline (optind + 1), 'ovf');
- if optind + 3 <= argc then begin {Both.}
- tfm_name := extend_filename (cmdline (optind + 2), 'ofm');
- end else begin {Just one.}
- tfm_name := extend_filename (cmdline (optind + 1), 'ofm');
- end;
- end else begin {Neither.}
- vf_name := basename_change_suffix (vpl_name, '.ovp', '.ovf');
- tfm_name := basename_change_suffix (vpl_name, '.ovp', '.ofm');
- end;
-end;
-
-@ Here are the options we allow. The first is one of the standard GNU options.
-@.-help@>
-
-@<Define the option...@> =
-current_option := 0;
-long_options[current_option].name := 'help';
-long_options[current_option].has_arg := 0;
-long_options[current_option].flag := 0;
-long_options[current_option].val := 0;
-incr (current_option);
-
-@ Another of the standard options.
-@.-version@>
-
-@<Define the option...@> =
-long_options[current_option].name := 'version';
-long_options[current_option].has_arg := 0;
-long_options[current_option].flag := 0;
-long_options[current_option].val := 0;
-incr (current_option);
-
-@ Print progress information?
-@.-verbose@>
-
-@<Define the option...@> =
-long_options[current_option].name := 'verbose';
-long_options[current_option].has_arg := 0;
-long_options[current_option].flag := address_of (verbose);
-long_options[current_option].val := 1;
-incr (current_option);
-
-@ The global variable |verbose| determines whether or not we print
-progress information.
-
-@<Glob...@> =
-@!verbose: c_int_type;
-
-@ It starts off |false|.
-
-@<Initialize the option...@> =
-verbose := false;
-
-@ An element with all zeros always ends the list.
-
-@<Define the option...@> =
-long_options[current_option].name := 0;
-long_options[current_option].has_arg := 0;
-long_options[current_option].flag := 0;
-long_options[current_option].val := 0;
-
-@ Global filenames.
-
-@<Global...@> =
-@!vpl_name, @!tfm_name, @!vf_name:c_string;
-@z
diff --git a/Build/source/texk/web2c/omegaware/ovp2ovf.web b/Build/source/texk/web2c/omegaware/ovp2ovf.web
deleted file mode 100644
index 0b6a6a329a7..00000000000
--- a/Build/source/texk/web2c/omegaware/ovp2ovf.web
+++ /dev/null
@@ -1,5071 +0,0 @@
-%
-% This file is part of the Omega project, which
-% is based in the web2c distribution of TeX.
-%
-% Copyright (c) 1994--2000 John Plaice and Yannis Haralambous
-% applies only to the changes to the original vptovf.web.
-%
-% This program by D. E. Knuth is not copyrighted and can be used freely.
-% Version 1 was implemented in December 1989.
-% Version 1.1 fixed some for-loop indices for stricter Pascal (April 1990).
-% Version 1.2 fixed `nonexistent char 0' bug, and a bit more (September 1990).
-% Version 1.3 has more robust `out_scaled' (March 1991).
-% Version 1.4 (March 1995) initialized lk_step_ended (Armin K\"ollner).
-
-% Here is TeX material that gets inserted after \input webmac
-\def\hang{\hangindent 3em\indent\ignorespaces}
-\font\ninerm=cmr9
-\let\mc=\ninerm % medium caps for names like SAIL
-\def\PASCAL{Pascal}
-\font\logo=logo10 % for the METAFONT logo
-\def\MF{{\logo METAFONT}}
-
-\def\(#1){} % this is used to make section names sort themselves better
-\def\9#1{} % this is used for sort keys in the index
-
-\def\title{OVP2OVF}
-\def\contentspagenumber{201}
-\def\topofcontents{\null
- \def\titlepage{F} % include headline on the contents page
- \def\rheader{\mainfont\hfil \contentspagenumber}
- \vfill
- \centerline{\titlefont The {\ttitlefont OVP2OVF} processor}
- \vskip 15pt
- \centerline{(Version 1.11, February 2000)}
- \vfill}
-\def\botofcontents{\vfill
- \centerline{\hsize 5in\baselineskip9pt
- \vbox{\ninerm\noindent
- The preparation of this program
- was supported in part by the National Science
- Foundation and by the System Development Foundation. `\TeX' is a
- trademark of the American Mathematical Society.}}}
-\pageno=\contentspagenumber \advance\pageno by 1
-
-@* Introduction.
-The \.{OVP2OVF} utility program converts virtual-property-list (``\.{VPL}''
-and ``\.{OVP}'') files into an equivalent pair of files called a virtual
-font (``\.{OVF}'') file and an $\Omega$ font metric (``\.{OFM}'') file.
-It also makes a thorough check of the given \.{VPL} or \.{OVP} file,
-so that the \.{OVF} file should be acceptable to device drivers and
-the \.{OFM} file should be acceptable to $\Omega$.
-
-In the following documentation, all unchanged references to
-the \.{VPtoVF} program and to \.{VPL}, \.{VF} and \.{TFM} files also apply to
-the \.{OVP2OVF} program and to \.{OVP}, \.{OVF} and \.{OFM} files.
-
-\indent\.{VPtoVF} is an extended version of the program \.{PLtoTF}, which
-is part of the standard \TeX ware library.
-\.{OVP2OVF} is an extended version of \.{VPtoVF} that allows
-much larger fonts.
-The idea of a virtual font was inspired by the work of David R. Fuchs
-@^Fuchs, David Raymond@>
-who designed a similar set of conventions in 1984 while developing a
-device driver for ArborText, Inc. He wrote a somewhat similar program
-called \.{PLFONT}.
-
-The |banner| string defined here should be changed whenever \.{OVP2OVF}
-gets modified.
-
-@d banner=='This is OVP2OVF, Version 1.11'
-{printed when the program starts}
-
-@ This program is written entirely in standard \PASCAL, except that
-it has to do some slightly system-dependent character code conversion
-on input. Furthermore, lower case letters are used in error messages;
-they could be converted to upper case if necessary. The input is read
-from |vpl_file|, and the output is written on |vf_file| and |tfm_file|;
-error messages and
-other remarks are written on the |output| file, which the user may
-choose to assign to the terminal if the system permits it.
-@^system dependencies@>
-
-The term |print| is used instead of |write| when this program writes on
-the |output| file, so that all such output can be easily deflected.
-
-@d print(#)==write(#)
-@d print_ln(#)==write_ln(#)
-
-@p program OVP2OVF(@!vpl_file,@!vf_file,@!tfm_file,@!output);
-const @<Constants in the outer block@>@/
-type @<Types in the outer block@>@/
-var @<Globals in the outer block@>@/
-procedure initialize; {this procedure gets things started properly}
- var @<Local variables for initialization@>@/
- begin print_ln(banner);@/
- @<Set initial values@>@/
- end;
-
-@ The following parameters can be changed at compile time to extend or
-reduce \.{VPtoVF}'s capacity.
-
-@<Constants...@>=
-@!ofm_type=0; {16-bit OFM; sufficient for most purposes}
-@!max_char=65535; {the largest character number in a font}
-@!xmax_char=65536; {|max_char|+1}
-@!xxmax_char=65537;{|max_char|+2}
-@!mem_size=262148; {|max_char|*4+8}
-@!max_font=1000; {the largest font number}
-@!xmax_font=1001; {|max_font|+1}
-@!xxmax_font=1002; {|max_font|+2}
-@!max_width=65535; {the largest character width number}
-@!max_height=255; {the largest character height number}
-@!max_depth=255; {the largest character depth number}
-@!max_italic=255; {the largest character italic correction number}
-@!buf_size=60; {length of lines displayed in error messages}
-@!max_header_bytes=100; {four times the maximum number of words allowed in
- the \.{TFM} file header block, must be 1024 or less}
-@!vf_size=200000; {maximum length of |vf| data, in bytes}
-@!max_stack=100; {maximum depth of simulated \.{DVI} stack}
-@!max_param_words=100; {the maximum number of \.{fontdimen} parameters allowed}
-@!max_lig_steps=800000; {maximum length of ligature program}
-@!xmax_label=800001; {must be greater than |max_lig_steps|}
-@!hash_size=130003; {preferably a prime number,
- a bit larger than |max_lig_steps|, the number
- of character pairs in lig/kern steps}
-@!hash_mult=16007; {another prime}
-@!max_kerns=100000; {the maximum number of distinct kern values}
-
-@ Here are some macros for common programming idioms.
-
-@d incr(#) == #:=#+1 {increase a variable by unity}
-@d decr(#) == #:=#-1 {decrease a variable by unity}
-@d do_nothing == {empty statement}
-
-@* Property list description of font metric data.
-The idea behind \.{VPL} files is that precise details about fonts, i.e., the
-facts that are needed by typesetting routines like \TeX, sometimes have to
-be supplied by hand. The nested property-list format provides a reasonably
-convenient way to do this.
-
-A good deal of computation is necessary to parse and process a
-\.{VPL} file, so it would be inappropriate for \TeX\ itself to do this
-every time it loads a font. \TeX\ deals only with the compact descriptions
-of font metric data that appear in \.{TFM} files. Such data is so compact,
-however, it is almost impossible for anybody but a computer to read it.
-
-Device drivers also need a compact way to describe mappings from \TeX's idea
-of a font to the actual characters a device can produce. They can do this
-conveniently when given a packed sequence of bytes called a \.{VF} file.
-
-The purpose of \.{VPtoVF} is to convert from a human-oriented file of text
-to computer-oriented files of binary numbers. There's a companion program,
-\.{VFtoVP}, which goes the other way.
-
-@<Glob...@>=
-@!vpl_file:text;
-
-@ @<Set init...@>=
-reset(vpl_file);
-
-@ A \.{VPL} file is like a \.{PL} file with a few extra features, so we
-can begin to define it by reviewing the definition of \.{PL} files. The
-material in the next few sections is copied from the program \.{PLtoTF}.
-An \.{OVP} file is simply a \.{VPL} file that does not restrict fonts
-to 256 characters.
-
-A \.{PL} file is a list of entries of the form
-$$\.{(PROPERTYNAME VALUE)}$$
-where the property name is one of a finite set of names understood by
-this program, and the value may itself in turn be a property list.
-The idea is best understood by looking at an example, so let's consider
-a fragment of the \.{PL} file for a hypothetical font.
-$$\vbox{\halign{\.{#}\hfil\cr
-(FAMILY NOVA)\cr
-(FACE F MIE)\cr
-(CODINGSCHEME ASCII)\cr
-(DESIGNSIZE D 10)\cr
-(DESIGNUNITS D 18)\cr
-(COMMENT A COMMENT IS IGNORED)\cr
-(COMMENT (EXCEPT THIS ONE ISN'T))\cr
-(COMMENT (ACTUALLY IT IS, EVEN THOUGH\cr
-\qquad\qquad IT SAYS IT ISN'T))\cr
-(FONTDIMEN\cr
-\qquad (SLANT R -.25)\cr
-\qquad (SPACE D 6)\cr
-\qquad (SHRINK D 2)\cr
-\qquad (STRETCH D 3)\cr
-\qquad (XHEIGHT R 10.55)\cr
-\qquad (QUAD D 18)\cr
-\qquad )\cr
-(LIGTABLE\cr
-\qquad (LABEL C f)\cr
-\qquad (LIG C f O 200)\cr
-\qquad (SKIP D 1)\cr
-\qquad (LABEL O 200)\cr
-\qquad (LIG C i O 201)\cr
-\qquad (KRN O 51 R 1.5)\cr
-\qquad (/LIG C ? C f)\cr
-\qquad (STOP)\cr
-\qquad )\cr
-(CHARACTER C f\cr
-\qquad (CHARWD D 6)\cr
-\qquad (CHARHT R 13.5)\cr
-\qquad (CHARIC R 1.5)\cr
-\qquad )\cr}}$$
-This example says that the font whose metric information is being described
-belongs to the hypothetical
-\.{NOVA} family; its face code is medium italic extended;
-and the characters appear in ASCII code positions. The design size is 10 points,
-and all other sizes in this \.{PL} file are given in units such that 18 units
-equals the design size. The font is slanted with a slope of $-.25$ (hence the
-letters actually slant backward---perhaps that is why the family name is
-\.{NOVA}). The normal space between words is 6 units (i.e., one third of
-the 18-unit design size), with glue that shrinks by 2 units or stretches by 3.
-The letters for which accents don't need to be raised or lowered are 10.55
-units high, and one em equals 18 units.
-
-The example ligature table is a bit trickier. It specifies that the
-letter \.f followed by another \.f is changed to code @'200, while
-code @'200 followed by \.i is changed to @'201; presumably codes @'200
-and @'201 represent the ligatures `ff' and `ffi'. Moreover, in both cases
-\.f and @'200, if the following character is the code @'51 (which is a
-right parenthesis), an additional 1.5 units of space should be inserted
-before the @'51. (The `\.{SKIP}~\.D~\.1' skips over one \.{LIG} or
-\.{KRN} command, which in this case is the second \.{LIG}; in this way
-two different ligature/kern programs can come together.)
-Finally, if either \.f or @'200 is followed by a question mark,
-the question mark is replaced by \.f and the ligature program is
-started over. (Thus, the character pair `\.{f?}' would actually become
-the ligature `ff', and `\.{ff?}' or `\.{f?f}' would become `fff'. To
-avoid this restart procedure, the \.{/LIG} command could be replaced
-by \.{/LIG>}; then `\.{f?} would become `f\kern0ptf' and `\.{f?f}'
-would become `f\kern0ptff'.)
-
-Character \.f itself is 6 units wide and 13.5 units tall, in this example.
-Its depth is zero (since \.{CHARDP} is not given), and its italic correction
-is 1.5 units.
-
-@ The example above illustrates most of the features found in \.{PL} files.
-Note that some property names, like \.{FAMILY} or \.{COMMENT}, take a
-string as their value; this string continues until the first unmatched
-right parenthesis. But most property names, like \.{DESIGNSIZE} and \.{SLANT}
-and \.{LABEL}, take a number as their value. This number can be expressed in
-a variety of ways, indicated by a prefixed code; \.D stands for decimal,
-\.H for hexadecimal, \.O for octal, \.R for real, \.C for character, and
-\.F for ``face.'' Other property names, like \.{LIG}, take two numbers as
-their value. And still other names, like \.{FONTDIMEN} and \.{LIGTABLE} and
-\.{CHARACTER}, have more complicated values that involve property lists.
-
-A property name is supposed to be used only in an appropriate property
-list. For example, \.{CHARWD} shouldn't occur on the outer level or
-within \.{FONTDIMEN}.
-
-The individual property-and-value pairs in a property list can appear in
-any order. For instance, `\.{SHRINK}' precedes `\.{STRETCH}' in the above
-example, although the \.{TFM} file always puts the stretch parameter first.
-One could even give the information about characters like `\.f' before
-specifying the number of units in the design size, or before specifying the
-ligature and kerning table. However, the \.{LIGTABLE} itself is an exception
-to this rule; the individual elements of the \.{LIGTABLE} property list
-can be reordered only to a certain extent without changing the meaning
-of that table.
-
-If property-and-value pairs are omitted, a default value is used. For example,
-we have already noted that the default for \.{CHARDP} is zero. The default
-for {\sl every\/} numeric value is, in fact, zero, unless otherwise stated
-below.
-
-If the same property name is used more than once, \.{VPtoVF} will not notice
-the discrepancy; it simply uses the final value given. Once again, however, the
-\.{LIGTABLE} is an exception to this rule; \.{VPtoVF} will complain if there
-is more than one label for some character. And of course many of the
-entries in the \.{LIGTABLE} property list have the same property name.
-
-@ A \.{VPL} file also includes information about how to create each character,
-by typesetting characters from other fonts and/or by drawing lines, etc.
-Such information is the value of the `\.{MAP}' property, which can be
-illustrated as follows:
-$$\vbox{\halign{\.{#}\hfil\cr
-(MAPFONT D 0 (FONTNAME Times-Roman))\cr
-(MAPFONT D 1 (FONTNAME Symbol))\cr
-(MAPFONT D 2 (FONTNAME cmr10)(FONTAT D 20))\cr
-(CHARACTER O 0 (MAP (SELECTFONT D 1)(SETCHAR C G)))\cr
-(CHARACTER O 76 (MAP (SETCHAR O 277)))\cr
-(CHARACTER D 197 (MAP\cr
-\qquad(PUSH)(SETCHAR C A)(POP)\cr
-\qquad(MOVEUP R 0.937)(MOVERIGHT R 1.5)(SETCHAR O 312)))\cr
-(CHARACTER O 200 (MAP (MOVEDOWN R 2.1)(SETRULE R 1 R 8)))\cr
-(CHARACTER O 201 (MAP\cr
-\qquad (SPECIAL ps: /SaveGray currentgray def .5 setgray)\cr
-\qquad (SELECTFONT D 2)(SETCHAR C A)\cr
-\qquad (SPECIAL ps: SaveGray setgray)))\cr
-}}$$
-(These specifications appear in addition to the conventional \.{PL}
-information. The \.{MAP} attribute can be mixed in with other attributes
-like \.{CHARWD} or it can be given separately.)
-
-In this example, the virtual font is composed of characters that can be
-fabricated from three actual fonts, `\.{Times-Roman}',
-`\.{Symbol}', and `\.{cmr10} \.{at} \.{20\\u}' (where \.{\\u}
-is the unit size in this \.{VPL} file). Character |@'0| is typeset as
-a `G' from the symbol font. Character |@'76| is typeset as character |@'277|
-from the ordinary Times font. (If no other font is selected, font
-number~0 is the default. If no \.{MAP} attribute is given, the default map
-is a character of the same number in the default font.)
-
-Character 197 (decimal) is more interesting: First an A is typeset (in the
-default font Times), and this is enclosed by \.{PUSH} and \.{POP} so that
-the original position is restored. Then the accent character |@'312| is
-typeset, after moving up .937 units and right 1.5 units.
-
-To typeset character |@'200| in this virtual font, we move down 2.1 units,
-then typeset a rule that is 1 unit high and 8 units wide.
-
-Finally, to typeset character |@'201|, we do something that requires a
-special ability to interpret PostScript commands; this example
-sets the PostScript ``color'' to 50\char`\%\ gray and typesets an `A'
-from \.{cmr10} in that color.
-
-In general, the \.{MAP} attribute of a virtual character can be any sequence
-of typesetting commands that might appear in a page of a \.{DVI} file.
-A single character might map into an entire page.
-
-@ But instead of relying on a hypothetical example, let's consider a complete
-grammar for \.{VPL} files, beginning with the (unchanged) grammatical rules
-for \.{PL} files. At the outer level, the following property names
-are valid in any \.{PL} file:
-
-\yskip\hang\.{CHECKSUM} (four-byte value). The value, which should be a
-nonnegative integer less than $2^{32}$, is used to identify a particular
-version of a font; it should match the check sum value stored with the font
-itself. An explicit check sum of zero is used to bypass
-check sum testing. If no checksum is specified in the \.{VPL} file,
-\.{VPtoVF} will compute the checksum that \MF\ would compute from the
-same data.
-
-\yskip\hang\.{DESIGNSIZE} (numeric value, default is 10). The value, which
-should be a real number in the range |1.0<=x<2048|, represents the default
-amount by which all quantities will be scaled if the font is not loaded
-with an `\.{at}' specification. For example, if one says
-`\.{\\font\\A=cmr10 at 15pt}' in \TeX\ language, the design size in the \.{TFM}
-file is ignored and effectively replaced by 15 points; but if one simply
-says `\.{\\font\\A=cmr10}' the stated design size is used. This quantity is
-always in units of printer's points.
-
-\yskip\hang\.{DESIGNUNITS} (numeric value, default is 1). The value
-should be a positive real number; it says how many units equals the design
-size (or the eventual `\.{at}' size, if the font is being scaled). For
-example, suppose you have a font that has been digitized with 600 pixels per
-em, and the design size is one em; then you could say `\.{(DESIGNUNITS R 600)}'
-if you wanted to give all of your measurements in units of pixels.
-
-\yskip\hang\.{CODINGSCHEME} (string value, default is `\.{UNSPECIFIED}').
-The string should not contain parentheses, and its length must be less than 40.
-It identifies the correspondence between the numeric codes and font characters.
-(\TeX\ ignores this information, but other software programs make use of it.)
-
-\yskip\hang\.{FAMILY} (string value, default is `\.{UNSPECIFIED}').
-The string should not contain parentheses, and its length must be less than 20.
-It identifies the name of the family to which this font belongs, e.g.,
-`\.{HELVETICA}'. (\TeX\ ignores this information; but it is needed, for
-example, when converting \.{DVI} files to \.{PRESS} files for Xerox
-equipment.)
-
-\yskip\hang\.{FACE} (one-byte value). This number, which must lie between
-0 and 255 inclusive, is a subsidiary ident\-ifi\-ca\-tion of the font within its
-family. For example, bold italic condensed fonts might have the same family name
-as light roman extended fonts, differing only in their face byte. (\TeX\
-ignores this information; but it is needed, for example, when converting
-\.{DVI} files to \.{PRESS} files for Xerox equipment.)
-
-\yskip\hang\.{SEVENBITSAFEFLAG} (string value, default is `\.{FALSE}'). The
-value should start with either `\.T' (true) or `\.F' (false). If true, character
-codes less than 128 cannot lead to codes of 128 or more via ligatures or
-charlists or extensible characters. (\TeX82 ignores this flag, but older
-versions of \TeX\ would only accept \.{TFM} files that were seven-bit safe.)
-\.{VPtoVF} computes the correct value of this flag and gives an error message
-only if a claimed ``true'' value is incorrect.
-
-\yskip\hang\.{HEADER} (a one-byte value followed by a four-byte value).
-The one-byte value should be between 18 and a maximum limit that can be
-raised or lowered depending on the compile-time setting of |max_header_bytes|.
-The four-byte value goes into the header word whose index is the one-byte
-value; for example, to set |header[18]:=1|, one may write
-`\.{(HEADER D 18 O 1)}'. This notation is used for header information that
-is presently unnamed. (\TeX\ ignores it.)
-
-\yskip\hang\.{FONTDIMEN} (property list value). See below for the names
-allowed in this property list.
-
-\yskip\hang\.{LIGTABLE} (property list value). See below for the rules
-about this special kind of property list.
-
-\yskip\hang\.{BOUNDARYCHAR} (integer value). If this character appears in
-a \.{LIGTABLE} command, it matches ``end of word'' as well as itself.
-If no boundary character is given and no \.{LABEL} \.{BOUNDARYCHAR} occurs
-within \.{LIGTABLE}, word boundaries will not affect ligatures or kerning.
-
-\yskip\hang\.{CHARACTER}. The value is an integer followed by
-a property list. The integer represents the number of a character that is
-present in the font; the property list of a character is defined below.
-The default is an empty property list.
-
-@ Numeric property list values can be given in various forms identified by
-a prefixed letter.
-
-\yskip\hang\.C denotes an ASCII character, which should be a standard visible
-character that is not a parenthesis. The numeric value will therefore be
-between @'41 and @'176 but not @'50 or @'51.
-
-\yskip\hang\.D denotes an unsigned decimal integer, which must be
-less than $2^{32}$, i.e., at most `\.{D 4294967295}'.
-
-\yskip\hang\.F denotes a three-letter Xerox face code; the admissible codes
-are \.{MRR}, \.{MIR}, \.{BRR}, \.{BIR}, \.{LRR}, \.{LIR}, \.{MRC}, \.{MIC},
-\.{BRC}, \.{BIC}, \.{LRC}, \.{LIC}, \.{MRE}, \.{MIE}, \.{BRE}, \.{BIE},
-\.{LRE}, and \.{LIE}, denoting the integers 0 to 17, respectively.
-
-\yskip\hang\.O denotes an unsigned octal integer, which must be less than
-$2^{32}$, i.e., at most `\.{O 37777777777}'.
-
-\yskip\hang\.H denotes an unsigned hexadecimal integer, which must be less than
-$2^{32}$, i.e., at most `\.{H FFFFFFFF}'.
-
-\yskip\hang\.R denotes a real number in decimal notation, optionally preceded
-by a `\.+' or `\.-' sign, and optionally including a decimal point. The
-absolute value must be less than 2048.
-
-@ The property names allowed in a \.{FONTDIMEN} property list correspond to
-various \TeX\ parameters, each of which has a (real) numeric value. All
-of the parameters except \.{SLANT} are in design units. The admissible
-names are \.{SLANT}, \.{SPACE}, \.{STRETCH}, \.{SHRINK}, \.{XHEIGHT},
-\.{QUAD}, \.{EXTRASPACE}, \.{NUM1}, \.{NUM2}, \.{NUM3}, \.{DENOM1},
-\.{DENOM2}, \.{SUP1}, \.{SUP2}, \.{SUP3}, \.{SUB1}, \.{SUB2}, \.{SUPDROP},
-\.{SUBDROP}, \.{DELIM1}, \.{DELIM2}, and \.{AXISHEIGHT}, for parameters
-1~to~22. The alternate names \.{DEFAULTRULETHICKNESS},
-\.{BIGOPSPACING1}, \.{BIGOPSPACING2}, \.{BIGOPSPACING3},
-\.{BIGOPSPACING4}, and \.{BIGOPSPACING5}, may also be used for parameters
-8 to 13.
-
-The notation `\.{PARAMETER} $n$' provides another way to specify the
-$n$th parameter; for example, `\.{(PARAMETER} \.{D 1 R -.25)}' is another way
-to specify that the \.{SLANT} is $-0.25$. The value of $n$ must be positive
-and less than |max_param_words|.
-
-@ The elements of a \.{CHARACTER} property list can be of six different types.
-
-\yskip\hang\.{CHARWD} (real value) denotes the character's width in
-design units.
-
-\yskip\hang\.{CHARHT} (real value) denotes the character's height in
-design units.
-
-\yskip\hang\.{CHARDP} (real value) denotes the character's depth in
-design units.
-
-\yskip\hang\.{CHARIC} (real value) denotes the character's italic correction in
-design units.
-
-\yskip\hang\.{NEXTLARGER} (integer value), specifies the character that
-follows the present one in a ``charlist.'' The value must be the number of a
-character in the font, and there must be no infinite cycles of supposedly
-larger and larger characters.
-
-\yskip\hang\.{VARCHAR} (property list value), specifies an extensible character.
-This option and \.{NEXTLARGER} are mutually exclusive; i.e., they cannot
-both be used within the same \.{CHARACTER} list.
-
-\yskip\noindent
-The elements of a \.{VARCHAR} property list are either \.{TOP}, \.{MID},
-\.{BOT} or \.{REP}; the values are integers, which must be zero or the number
-of a character in the font. A zero value for \.{TOP}, \.{MID}, or \.{BOT} means
-that the corresponding piece of the extensible character is absent. A nonzero
-value, or a \.{REP} value of zero, denotes the character code used to make
-up the top, middle, bottom, or replicated piece of an extensible character.
-
-@ A \.{LIGTABLE} property list contains elements of four kinds, specifying a
-program in a simple command language that \TeX\ uses for ligatures and kerns.
-If several \.{LIGTABLE} lists appear, they are effectively concatenated into
-a single list.
-
-\yskip\hang\.{LABEL} (integer value) means that the program for the
-stated character value starts here. The integer must be the number of a
-character in the font; its \.{CHARACTER} property list must not have a
-\.{NEXTLARGER} or \.{VARCHAR} field. At least one \.{LIG} or \.{KRN} step
-must follow.
-
-\yskip\hang\.{LABEL} \.{BOUNDARYCHAR} means that the program for
-beginning-of-word ligatures starts here.
-
-\yskip\hang\.{LIG} (two integer values). The instruction `\.{(LIG} $c$ $r$\.)'
-means, ``If the next character is $c$, then insert character~$r$ and
-possibly delete the current character and/or~$c$;
-otherwise go on to the next instruction.''
-Characters $r$ and $c$ must be present in the font. \.{LIG} may be immediately
-preceded or followed by a slash, and then immediately followed by \.>
-characters not exceeding the number of slashes. Thus there are eight
-possible forms:
-$$\hbox to .8\hsize{\.{LIG}\hfil\.{/LIG}\hfil\.{/LIG>}\hfil
-\.{LIG/}\hfil\.{LIG/>}\hfil\.{/LIG/}\hfil\.{/LIG/>}\hfil\.{/LIG/>>}}$$
-The slashes specify retention of the left or right original character; the
-\.> signs specify passing over the result without further ligature processing.
-
-\yskip\hang\.{KRN} (an integer value and a real value). The instruction
-`\.{(KRN} $c$ $r$\.)' means, ``If the next character is $c$, then insert
-a blank space of width $r$ between the current character character and $c$;
-otherwise go on to the next intruction.'' The value of $r$, which is in
-units of the design size, is often negative. Character code $c$ must exist
-in the font.
-
-\yskip\hang\.{STOP} (no value). This instruction ends a ligature/kern program.
-It must follow either a \.{LIG} or \.{KRN} instruction, not a \.{LABEL}
-or \.{STOP} or \.{SKIP}.
-
-\yskip\hang\.{SKIP} (value in the range |0..127|). This instruction specifies
-continuation of a ligature/kern program after the specified number of \.{LIG}
-or \.{KRN} has been skipped over. The number of subsequent \.{LIG} and \.{KRN}
-instructions must therefore exceed this specified amount.
-
-@ In addition to all these possibilities, the property name \.{COMMENT} is
-allowed in any property list. Such comments are ignored.
-
-@ So that is what \.{PL} files hold. In a \.{VPL} file additional
-properties are recognized; two of these are valid on the outermost level:
-
-\yskip\hang\.{VTITLE} (string value, default is empty). The value will be
-reproduced at the beginning of the \.{VF} file (and printed on the terminal
-by \.{VFtoVP} when it examines that file).
-
-\yskip\hang\.{MAPFONT}. The value is a nonnegative integer followed by
-a property list. The integer represents an identifying number for fonts
-used in \.{MAP} attributes. The property list, which identifies the font and
-relative size, is defined below.
-
-\yskip\noindent
-And one additional ``virtual property'' is valid within a \.{CHARACTER}:
-
-\yskip\hang\.{MAP}. The value is a property list consisting of typesetting
-commands. Default is the single command \.{SETCHAR}~$c$, where $c$ is
-the current character number.
-
-@ The elements of a \.{MAPFONT} property list can be of the following types.
-
-\yskip\hang\.{FONTNAME} (string value, default is \.{NULL}).
-This is the font's identifying name.
-
-\yskip\hang\.{FONTAREA} (string value, default is empty). If the font appears
-in a nonstandard directory, according to local conventions, the directory
-name is given here. (This is system dependent, just as in \.{DVI} files.)
-
-\yskip\hang\.{FONTCHECKSUM} (four-byte value, default is zero). This value,
-which should be a nonnegative integer less than $2^{32}$, can be used to
-check that the font being referred to matches the intended font. If nonzero,
-it should equal the \.{CHECKSUM} parameter in that font.
-
-\yskip\hang\.{FONTAT} (numeric value, default is the \.{DESIGNUNITS} of the
-present virtual font). This value is relative to the design units of
-the present virtual font, hence it will be scaled when the virtual
-font is magnified or reduced. It represents the value that will
-effectively replace the design size of the font being referred to,
-so that all characters will be scaled appropriately.
-
-\yskip\hang\.{FONTDSIZE} (numeric value, default is 10). This value is
-absolute, in units of printer's points. It should equal the \.{DESIGNSIZE}
-parameter in the font being referred to.
-
-\yskip\noindent
-If any of the
-string values contain parentheses, the parentheses must be balanced. Leading
-blanks are removed from the strings, but trailing blanks are not.
-
-@ Finally, the elements of a \.{MAP} property list are an ordered sequence
-of typesetting commands chosen from among the following:
-
-\yskip\hang\.{SELECTFONT} (four-byte integer value). The value must be the
-number of a previously defined \.{MAPFONT}. This font (or more precisely, the
-final font that is mapped to that code number, if two \.{MAPFONT} properties
-happen to specify the same code) will be used in subsequent \.{SETCHAR}
-instructions until overridden by another \.{SELECTFONT}. The first-specified
-\.{MAPFONT} is implicitly selected before the first \.{SELECTFONT} in every
-character's map.
-
-\yskip\hang\.{SETCHAR} (integer value). There must be a character of
-this number in the currently selected font. (\.{VPtoVF} doesn't check that
-the character is valid, but \.{VFtoVP} does.) That character is typeset at the
-current position, and the typesetter moves right by the \.{CHARWD} in
-that character's \.{TFM} file.
-
-\yskip\hang\.{SETRULE} (two real values). The first value specifies height,
-the second specifies width, in design units. If both height and width are
-positive, a rule is typeset at the current position. Then the typesetter
-moves right, by the specified width.
-
-\yskip\hang\.{MOVERIGHT}, \.{MOVELEFT}, \.{MOVEUP}, \.{MOVEDOWN} (real
-value). The typesetter moves its current position
-by the number of design units specified.
-
-\yskip\hang\.{PUSH} The current typesetter position is remembered, to
-be restored on a subsequent \.{POP}.
-
-\yskip\hang\.{POP} The current typesetter position is reset to where it
-was on the most recent unmatched \.{PUSH}. The \.{PUSH} and \.{POP}
-commands in any \.{MAP} must be properly nested like balanced parentheses.
-
-\yskip\hang\.{SPECIAL} (string value). The subsequent characters, starting
-with the first nonblank and ending just before the first `\.)' that has no
-matching `\.(', are interpreted according to local conventions with the
-same system-dependent meaning as a `special' (\\{xxx}) command
-in a \.{DVI} file.
-
-\yskip\hang\.{SPECIALHEX} (hexadecimal string value). The subsequent
-nonblank characters before the next `\.)' must consist entirely of
-hexadecimal digits, and they must contain an even number of such digits.
-Each pair of hex digits specifies a byte, and this string of bytes is
-treated just as the value of a \.{SPECIAL}. (This convention permits
-arbitrary byte strings to be represented in an ordinary text file.)
-
-@ Virtual font mapping is a recursive process, like macro expansion.
-Thus, a \.{MAPFONT} might
-specify another virtual font, whose characters are themselves mapped to
-other fonts. As an example of this possibility, consider the
-following curious file called \.{recurse.vpl}, which defines a
-virtual font that is self-contained and self-referential:
-$$\vbox{\halign{\.{#}\cr
-(VTITLE Example of recursion)\cr
-(MAPFONT D 0 (FONTNAME recurse)(FONTAT D 2))\cr
-(CHARACTER C A (CHARWD D 1)(CHARHT D 1)(MAP (SETRULE D 1 D 1)))\cr
-(CHARACTER C B (CHARWD D 2)(CHARHT D 2)(MAP (SETCHAR C A)))\cr
-(CHARACTER C C (CHARWD D 4)(CHARHT D 4)(MAP (SETCHAR C B)))\cr
-}}$$
-The design size is 10 points (the default), hence the character \.A
-in font \.{recurse} is a $10\times10$ point black square. Character \.B
-is typeset as character \.A in \.{recurse} {scaled} {2000}, hence it
-is a $20\times20$ point black square. And character \.C is typeset as
-character \.{B} in \.{recurse} {scaled} {2000}, hence its size is
-$40\times40$.
-
-Users are responsible for making sure that infinite recursion doesn't happen.
-
-@ So that is what \.{VPL} files hold. From these rules,
-you can guess (correctly) that \.{VPtoVF} operates in four main stages.
-First it assigns the default values to all properties; then it scans
-through the \.{VPL} file, changing property values as new ones are seen; then
-it checks the information and corrects any problems; and finally it outputs
-the \.{VF} and \.{TFM} files.
-
-@ The next question is, ``What are \.{VF} and
-\.{TFM} files?'' A complete answer to that question appears in the
-documentation of the companion programs, \.{VFtoVP} and
-\.{TFtoPL}, so the details will not
-be repeated here. Suffice it to say that a \.{VF} or
-\.{TFM} file stores all of the
-relevant font information in a sequence of 8-bit bytes. The number of
-bytes is always a multiple of 4, so we could regard the files
-as sequences of 32-bit words; but \TeX\ uses the byte interpretation,
-and so does \.{VPtoVF}. Note that the bytes are considered to be unsigned
-numbers.
-
-@<Glob...@>=
-@!vf_file:packed file of 0..255;
-@!tfm_file:packed file of 0..255;
-
-@ On some systems you may have to do something special to write a
-packed file of bytes. For example, the following code didn't work
-when it was first tried at Stanford, because packed files have to be
-opened with a special switch setting on the \PASCAL\ that was used.
-@^system dependencies@>
-
-@<Set init...@>=
-rewrite(vf_file); rewrite(tfm_file);
-
-@* Basic input routines.
-For the purposes of this program, a |byte| is an unsigned 16-bit quantity,
-and an |ASCII_code| is an integer between @'40 and @'177. Such ASCII codes
-correspond to one-character constants like \.{"A"} in \.{WEB} language.
-
-@<Types...@>=
-@!byte=0..65535; {unsigned 16-bit quantity}
-@!ASCII_code=@'40..@'177; {standard ASCII code numbers}
-
-@ One of the things \.{VPtoVF} has to do is convert characters of strings
-to ASCII form, since that is the code used for the family name and the
-coding scheme in a \.{TFM} file. An array |xord| is used to do the
-conversion from |char|; the method below should work with little or no change
-on most \PASCAL\ systems.
-@^system dependencies@>
-
-@d first_ord=0 {ordinal number of the smallest element of |char|}
-@d last_ord=127 {ordinal number of the largest element of |char|}
-
-@<Global...@>=
-@!xord:array[char] of ASCII_code; {conversion table}
-
-@ @<Local variables for init...@>=
-@!k:integer; {all-purpose initialization index}
-
-@ Characters that should not appear in \.{VPL} files (except in comments)
-are mapped into @'177.
-
-@d invalid_code=@'177 {code deserving an error message}
-
-@<Set init...@>=
-for k:=first_ord to last_ord do xord[chr(k)]:=invalid_code;
-xord[' ']:=" "; xord['!']:="!"; xord['"']:=""""; xord['#']:="#";
-xord['$']:="$"; xord['%']:="%"; xord['&']:="&"; xord['''']:="'";
-xord['(']:="("; xord[')']:=")"; xord['*']:="*"; xord['+']:="+"; xord[',']:=",";
-xord['-']:="-"; xord['.']:="."; xord['/']:="/"; xord['0']:="0"; xord['1']:="1";
-xord['2']:="2"; xord['3']:="3"; xord['4']:="4"; xord['5']:="5"; xord['6']:="6";
-xord['7']:="7"; xord['8']:="8"; xord['9']:="9"; xord[':']:=":"; xord[';']:=";";
-xord['<']:="<"; xord['=']:="="; xord['>']:=">"; xord['?']:="?";
-xord['@@']:="@@"; xord['A']:="A"; xord['B']:="B"; xord['C']:="C";
-xord['D']:="D"; xord['E']:="E"; xord['F']:="F"; xord['G']:="G"; xord['H']:="H";
-xord['I']:="I"; xord['J']:="J"; xord['K']:="K"; xord['L']:="L"; xord['M']:="M";
-xord['N']:="N"; xord['O']:="O"; xord['P']:="P"; xord['Q']:="Q"; xord['R']:="R";
-xord['S']:="S"; xord['T']:="T"; xord['U']:="U"; xord['V']:="V"; xord['W']:="W";
-xord['X']:="X"; xord['Y']:="Y"; xord['Z']:="Z"; xord['[']:="["; xord['\']:="\";
-xord[']']:="]"; xord['^']:="^"; xord['_']:="_"; xord['`']:="`"; xord['a']:="a";
-xord['b']:="b"; xord['c']:="c"; xord['d']:="d"; xord['e']:="e"; xord['f']:="f";
-xord['g']:="g"; xord['h']:="h"; xord['i']:="i"; xord['j']:="j"; xord['k']:="k";
-xord['l']:="l"; xord['m']:="m"; xord['n']:="n"; xord['o']:="o"; xord['p']:="p";
-xord['q']:="q"; xord['r']:="r"; xord['s']:="s"; xord['t']:="t"; xord['u']:="u";
-xord['v']:="v"; xord['w']:="w"; xord['x']:="x"; xord['y']:="y"; xord['z']:="z";
-xord['{']:="{"; xord['|']:="|"; xord['}']:="}"; xord['~']:="~";
-
-@ In order to help catch errors of badly nested parentheses, \.{VPtoVF}
-assumes that the user will begin each line with a number of blank spaces equal
-to some constant times the number of open parentheses at the beginning of
-that line. However, the program doesn't know in advance what the constant
-is, nor does it want to print an error message on every line for a user
-who has followed no consistent pattern of indentation.
-
-Therefore the following strategy is adopted: If the user has been consistent
-with indentation for ten or more lines, an indentation error will be
-reported. The constant of indentation is reset on every line that should
-have nonzero indentation.
-
-@<Glob...@>=
-@!line:integer; {the number of the current line}
-@!good_indent:integer; {the number of lines since the last bad indentation}
-@!indent: integer; {the number of spaces per open parenthesis, zero if unknown}
-@!level: integer; {the current number of open parentheses}
-
-@ @<Set init...@>=
-line:=0; good_indent:=0; indent:=0; level:=0;
-
-@ The input need not really be broken into lines of any maximum length, and
-we could read it character by character without any buffering. But we shall
-place it into a small buffer so that offending lines can be displayed in error
-messages.
-
-@<Glob...@>=
-@!left_ln,@!right_ln:boolean; {are the left and right ends of the buffer
- at end-of-line marks?}
-@!limit:0..buf_size; {position of the last character present in the buffer}
-@!loc:0..buf_size; {position of the last character read in the buffer}
-@!buffer:array[1..buf_size] of char;
-@!input_has_ended:boolean; {there is no more input to read}
-
-@ @<Set init...@>=
-limit:=0; loc:=0; left_ln:=true; right_ln:=true; input_has_ended:=false;
-
-@ Just before each \.{CHARACTER} property list is evaluated, the character
-code is printed in octal notation. Up to eight such codes appear on a line;
-so we have a variable to keep track of how many are currently there.
-
-@<Glob...@>=
-@!chars_on_line:0..8; {the number of characters printed on the current line}
-
-@ @<Set init...@>=
-chars_on_line:=0;
-
-@ The following routine prints an error message and an indication of
-where the error was detected. The error message should not include any
-final punctuation, since this procedure supplies its own.
-
-@d err_print(#)==begin if chars_on_line>0 then print_ln(' ');
- print(#); show_error_context;
- end
-
-@p procedure show_error_context; {prints the current scanner location}
-var k:0..buf_size; {an index into |buffer|}
-begin print_ln(' (line ',line:1,').');
-if not left_ln then print('...');
-for k:=1 to loc do print(buffer[k]); {print the characters already scanned}
-print_ln(' ');
-if not left_ln then print(' ');
-for k:=1 to loc do print(' '); {space out the second line}
-for k:=loc+1 to limit do print(buffer[k]); {print the characters yet unseen}
-if right_ln then print_ln(' ')@+else print_ln('...');
-chars_on_line:=0;
-end;
-
-@ Here is a procedure that does the right thing when we are done
-reading the present contents of the buffer. It keeps |buffer[buf_size]|
-empty, in order to avoid range errors on certain \PASCAL\ compilers.
-
-An infinite sequence of right parentheses is placed at the end of the
-file, so that the program is sure to get out of whatever level of nesting
-it is in.
-
-On some systems it is desirable to modify this code so that tab marks
-in the buffer are replaced by blank spaces. (Simply setting
-|xord[chr(@'11)]:=" "| would not work; for example, two-line
-error messages would not come out properly aligned.)
-@^system dependencies@>
-
-@p procedure fill_buffer;
-begin left_ln:=right_ln; limit:=0; loc:=0;
-if left_ln then begin
- if line>0 then read_ln(vpl_file);
- incr(line);
- end;
-if eof(vpl_file) then begin
- limit:=1; buffer[1]:=')'; right_ln:=false; input_has_ended:=true;
- end
-else begin
- while (limit<buf_size-1)and(not eoln(vpl_file)) do begin
- incr(limit); read(vpl_file,buffer[limit]);
- end;
- buffer[limit+1]:=' '; right_ln:=eoln(vpl_file);
- if left_ln then @<Set |loc| to the number of leading blanks in
- the buffer, and check the indentation@>;
- end;
-end;
-
-@ The interesting part about |fill_buffer| is the part that learns what
-indentation conventions the user is following, if any.
-
-@d bad_indent(#)==begin if good_indent>=10 then err_print(#);
- good_indent:=0; indent:=0;
- end
-
-@<Set |loc|...@>=
-begin while (loc<limit)and(buffer[loc+1]=' ') do incr(loc);
-if loc<limit then begin
- if level=0 then
- if loc=0 then incr(good_indent)
- else bad_indent('Warning: Indented line occurred at level zero')
-@.Warning: Indented line...@>
- else if indent=0 then
- if loc mod level=0 then begin
- indent:=loc div level; good_indent:=1;
- end
- else good_indent:=0
- else if indent*level=loc then incr(good_indent)
- else bad_indent('Warning: Inconsistent indentation; ',
-@.Warning: Inconsistent indentation...@>
- 'you are at parenthesis level ',level:1);
- end;
-end
-
-@* Basic scanning routines.
-The global variable |cur_char| holds the ASCII code corresponding to the
-character most recently read from the input buffer, or to a character that
-has been substituted for the real one.
-
-@<Global...@>=
-@!cur_char:ASCII_code; {we have just read this}
-
-@ Here is a procedure that sets |cur_char| to an ASCII code for the
-next character of input, if that character is a letter or digit or slash
-or \.>. Otherwise
-it sets |cur_char:=" "|, and the input system will be poised to reread the
-character that was rejected, whether or not it was a space.
-Lower case letters are converted to upper case.
-
-@p procedure get_keyword_char;
-begin while (loc=limit)and(not right_ln) do fill_buffer;
-if loc=limit then cur_char:=" " {end-of-line counts as a delimiter}
-else begin
- cur_char:=xord[buffer[loc+1]];
- if cur_char>="a" then cur_char:=cur_char-@'40;
- if ((cur_char>="0")and(cur_char<="9")) then incr(loc)
- else if ((cur_char>="A")and(cur_char<="Z")) then incr(loc)
- else if cur_char="/" then incr(loc)
- else if cur_char=">" then incr(loc)
- else cur_char:=" ";
- end;
-end;
-
-@ The following procedure sets |cur_char| to the next character code,
-and converts lower case to upper case. If the character is a left or
-right parenthesis, it will not be ``digested''; the character will
-be read again and again, until the calling routine does something
-like `|incr(loc)|' to get past it. Such special treatment of parentheses
-insures that the structural information they contain won't be lost in
-the midst of other error recovery operations.
-
-@d backup==begin if (cur_char>")")or(cur_char<"(") then decr(loc);
- end {undoes the effect of |get_next|}
-
-@p procedure get_next; {sets |cur_char| to next, balks at parentheses}
-begin while loc=limit do fill_buffer;
-incr(loc); cur_char:=xord[buffer[loc]];
-if cur_char>="a" then
- if cur_char<="z" then cur_char:=cur_char-@'40 {uppercasify}
- else begin
- if cur_char=invalid_code then begin
- err_print('Illegal character in the file');
-@.Illegal character...@>
- cur_char:="?";
- end;
- end
-else if (cur_char<=")")and(cur_char>="(") then decr(loc);
-end;
-
-@ Here's a procedure that scans a hexadecimal digit or a right parenthesis.
-
-@p function get_hex:byte;
-var @!a:integer; {partial result}
-begin repeat get_next;
-until cur_char<>" ";
-a:=cur_char-")";
-if a>0 then begin
- a:=cur_char-"0";
- if cur_char>"9" then
- if cur_char<"A" then a:=-1 else a:=cur_char-"A"+10;
- end;
-if (a<0)or(a>15) then begin
- err_print('Illegal hexadecimal digit'); get_hex:=0;
-@.Illegal hexadecimal digit@>
- end
-else get_hex:=a;
-end;
-
-@ The next procedure is used to ignore the text of a comment, or to pass over
-erroneous material. As such, it has the privilege of passing parentheses.
-It stops after the first right parenthesis that drops the level below
-the level in force when the procedure was called.
-
-@p procedure skip_to_end_of_item;
-var l:integer; {initial value of |level|}
-begin l:=level;
-while level>=l do begin
- while loc=limit do fill_buffer;
- incr(loc);
- if buffer[loc]=')' then decr(level)
- else if buffer[loc]='(' then incr(level);
- end;
-if input_has_ended then err_print('File ended unexpectedly: No closing ")"');
-@.File ended unexpectedly...@>
-cur_char:=" "; {now the right parenthesis has been read and digested}
-end;
-
-@ A similar procedure copies the bytes remaining in an item. The copied bytes
-go into an array |vf| that we'll declare later. Leading blanks are ignored.
-
-@d vf_store(#)==
- begin vf[vf_ptr]:=#;
- if vf_ptr=vf_size then err_print('I''m out of memory---increase my vfsize!')
-@.I'm out of memory...@>
- else incr(vf_ptr);
- end
-
-@p procedure copy_to_end_of_item;
-label 30;
-var l:integer; {initial value of |level|}
-@!nonblank_found:boolean; {have we seen a nonblank character yet?}
-begin l:=level; nonblank_found:=false;
-while true do begin
- while loc=limit do fill_buffer;
- if buffer[loc+1]=')' then
- if level=l then goto 30@+else decr(level);
- incr(loc);
- if buffer[loc]='(' then incr(level);
- if buffer[loc]<>' ' then nonblank_found:=true;
- if nonblank_found then
- if xord[buffer[loc]]=invalid_code then begin
- err_print('Illegal character in the file');
-@.Illegal character...@>
- vf_store("?");
- end
- else vf_store(xord[buffer[loc]]);
- end;
-30:end;
-
-@ Sometimes we merely want to skip past characters in the input until we
-reach a left or a right parenthesis. For example, we do this whenever we
-have finished scanning a property value and we hope that a right parenthesis
-is next (except for possible blank spaces).
-
-@d skip_to_paren==repeat get_next@;@+ until (cur_char="(")or(cur_char=")")
-@d skip_error(#)==begin err_print(#); skip_to_paren;
- end {this gets to the right parenthesis if something goes wrong}
-@d flush_error(#)==begin err_print(#); skip_to_end_of_item;
- end {this gets past the right parenthesis if something goes wrong}
-
-@ After a property value has been scanned, we want to move just past the
-right parenthesis that should come next in the input (except for possible
-blank spaces).
-
-@p procedure finish_the_property; {do this when the value has been scanned}
-begin while cur_char=" " do get_next;
-if cur_char<>")" then err_print('Junk after property value will be ignored');
-@.Junk after property value...@>
-skip_to_end_of_item;
-end;
-
-@* Scanning property names.
-We have to figure out the meaning of names that appear in the \.{VPL} file,
-by looking them up in a dictionary of known keywords. Keyword number $n$
-appears in locations |start[n]| through |start[n+1]-1| of an array called
-|dictionary|.
-
-@d max_name_index=300 {upper bound on the number of keywords}
-@d max_letters=3000 {upper bound on the total length of all keywords}
-
-@<Global...@>=
-@!start:array[1..max_name_index] of 0..max_letters;
-@!dictionary:array[0..max_letters] of ASCII_code;
-@!start_ptr:0..max_name_index; {the first available place in |start|}
-@!dict_ptr:0..max_letters; {the first available place in |dictionary|}
-
-@ @<Set init...@>=
-start_ptr:=1; start[1]:=0; dict_ptr:=0;
-
-@ When we are looking for a name, we put it into the |cur_name| array.
-When we have found it, the corresponding |start| index will go into
-the global variable |name_ptr|.
-
-@d longest_name=20 {length of \.{DEFAULTRULETHICKNESS}}
-
-@<Glob...@>=
-@!cur_name:array[1..longest_name] of ASCII_code; {a name to look up}
-@!name_length:0..longest_name; {its length}
-@!name_ptr:0..max_name_index; {its ordinal number in the dictionary}
-
-@ A conventional hash table with linear probing (cf.\ Algorithm 6.4L
-in {\sl The Art of Computer Pro\-gram\-ming\/}) is used for the dictionary
-operations. If |nhash[h]=0|, the table position is empty, otherwise |nhash[h]|
-points into the |start| array.
-
-@d hash_prime=307 {size of the hash table}
-
-@<Glob...@>=
-@!nhash:array[0..hash_prime-1] of 0..max_name_index;
-@!cur_hash:0..hash_prime-1; {current position in the hash table}
-
-@ @<Local...@>=
-@!h:0..hash_prime-1; {runs through the hash table}
-
-@ @<Set init...@>=
-for h:=0 to hash_prime-1 do nhash[h]:=0;
-
-@ Since there is no chance of the hash table overflowing, the procedure
-is very simple. After |lookup| has done its work, |cur_hash| will point
-to the place where the given name was found, or where it should be inserted.
-
-@p procedure lookup; {finds |cur_name| in the dictionary}
-var k:0..longest_name; {index into |cur_name|}
-@!j:0..max_letters; {index into |dictionary|}
-@!not_found:boolean; {clumsy thing necessary to avoid |goto| statement}
-@!cur_hash_reset:boolean;
-begin @<Compute the hash code, |cur_hash|, for |cur_name|@>;
-not_found:=true;
-cur_hash_reset:=false;
-while not_found do begin
- if (cur_hash=0) and (cur_hash_reset) then
- not_found:=false
- else begin
- if cur_hash=0 then begin
- cur_hash:=hash_prime-1;
- cur_hash_reset:=true
- end
- else decr(cur_hash);
- if nhash[cur_hash]=0 then not_found:=false
- else begin
- j:=start[nhash[cur_hash]];
- if start[nhash[cur_hash]+1]=j+name_length then begin
- not_found:=false;
- for k:=1 to name_length do
- if dictionary[j+k-1]<>cur_name[k] then not_found:=true;
- end
- end
- end
- end;
-name_ptr:=nhash[cur_hash];
-end;
-
-@ @<Compute the hash...@>=
-cur_hash:=cur_name[1];
-for k:=2 to name_length do
- cur_hash:=(cur_hash+cur_hash+cur_name[k]) mod hash_prime
-
-@ The ``meaning'' of the keyword that begins at |start[k]| in the
-dictionary is kept in |equiv[k]|. The numeric |equiv| codes are given
-symbolic meanings by the following definitions.
-
-@d comment_code=0
-@d check_sum_code=1
-@d design_size_code=2
-@d design_units_code=3
-@d coding_scheme_code=4
-@d family_code=5
-@d face_code=6
-@d seven_bit_safe_flag_code=7
-@d header_code= 8
-@d font_dimen_code=9
-@d lig_table_code=10
-@d boundary_char_code=11
-@d virtual_title_code=12
-@d map_font_code=13
-@d font_dir_code=14
-@d n_font_dir_code=15
-@d character_code=16
-@d font_name_code=21
-@d font_area_code=22
-@d font_checksum_code=23
-@d font_at_code=24
-@d font_dsize_code=25
-@d parameter_code=30
-@d char_info_code=70
-@d width=1
-@d height=2
-@d depth=3
-@d italic=4
-@d sec_width=5
-@d sec_height=6
-@d sec_depth=7
-@d sec_italic=8
-@d accent=9
-@d prim_top_axis=10
-@d prim_top_axis_bis=11
-@d prim_bot_axis=12
-@d prim_bot_axis_bis=13
-@d prim_mid_hor=14
-@d prim_mid_vert=15
-@d prim_base_slant=16
-@d sec_top_axis=17
-@d sec_top_axis_bis=18
-@d sec_bot_axis=19
-@d sec_bot_axis_bis=20
-@d sec_mid_hor=21
-@d sec_mid_vert=22
-@d sec_base_slant=23
-@d char_wd_code=char_info_code+width
-@d char_ht_code=char_info_code+height
-@d char_dp_code=char_info_code+depth
-@d char_ic_code=char_info_code+italic
-@d sec_width_code=char_info_code+sec_width
-@d sec_height_code=char_info_code+sec_height
-@d sec_depth_code=char_info_code+sec_depth
-@d sec_italic_code=char_info_code+sec_italic
-@d accent_code=char_info_code+accent
-@d prim_top_axis_code=char_info_code+prim_top_axis
-@d prim_top_axis_bis_code=char_info_code+prim_top_axis_bis
-@d prim_bot_axis_code=char_info_code+prim_bot_axis
-@d prim_bot_axis_bis_code=char_info_code+prim_bot_axis_bis
-@d prim_mid_hor_code=char_info_code+prim_mid_hor
-@d prim_mid_vert_code=char_info_code+prim_mid_vert
-@d prim_base_slant_code=char_info_code+prim_base_slant
-@d sec_top_axis_code=char_info_code+sec_top_axis
-@d sec_top_axis_bis_code=char_info_code+sec_top_axis_bis
-@d sec_bot_axis_code=char_info_code+sec_bot_axis
-@d sec_bot_axis_bis_code=char_info_code+sec_bot_axis_bis
-@d sec_mid_hor_code=char_info_code+sec_mid_hor
-@d sec_mid_vert_code=char_info_code+sec_mid_vert
-@d sec_base_slant_code=char_info_code+sec_base_slant
-@d next_larger_code=100
-@d map_code=101
-@d var_char_code=102
-@d select_font_code=110
-@d set_char_code=111
-@d set_rule_code=112
-@d move_right_code=113
-@d move_down_code=115
-@d push_code=117
-@d pop_code=118
-@d special_code=119
-@d special_hex_code=120
-@d label_code=130
-@d stop_code=131
-@d skip_code=132
-@d krn_code=133
-@d lig_code=134
-@d ofm_level_code=140
-@d char_repeat_code=150
-@d char_ivalue_code=151
-@d char_fvalue_code=152
-@d char_mvalue_code=153
-@d char_rule_code=154
-@d char_glue_code=155
-@d char_penalty_code=156
-@d font_rule_code=160
-@d rule_code=161
-@d rule_width_code=162
-@d rule_height_code=163
-@d rule_depth_code=164
-@d font_glue_code=170
-@d glue_code=171
-@d glue_type_code=172
-@d glue_stretch_order_code=173
-@d glue_shrink_order_code=174
-@d glue_width_code=175
-@d glue_stretch_code=176
-@d glue_shrink_code=177
-@d glue_char_code=178
-@d glue_rule_code=179
-@d order_unit_code=181
-@d order_fi_code=182
-@d order_fil_code=183
-@d order_fill_code=184
-@d order_filll_code=185
-@d type_normal_code=186
-@d type_aleaders_code=187
-@d type_cleaders_code=188
-@d type_xleaders_code=189
-@d font_penalty_code=190
-@d penalty_code=191
-@d penalty_val_code=192
-@d font_mvalue_code=200
-@d mvalue_code=201
-@d mvalue_val_code=202
-@d font_fvalue_code=210
-@d fvalue_code=211
-@d fvalue_val_code=212
-@d font_ivalue_code=220
-@d ivalue_code=221
-@d ivalue_val_code=222
-@d clabel_code=231
-@d cpen_code=232
-@d cglue_code=233
-@d cpenglue_code=234
-@d ckrn_code=235
-@d TL_dir_code=240
-@d LT_dir_code=241
-@d TR_dir_code=242
-@d LB_dir_code=243
-@d BL_dir_code=244
-@d RT_dir_code=245
-@d BR_dir_code=246
-@d RB_dir_code=247
-
-@<Glo...@>=
-@!equiv:array[0..max_name_index] of byte;
-@!cur_code:byte; {equivalent most recently found in |equiv|}
-
-@ We have to get the keywords into the hash table and into the dictionary in
-the first place (sigh). The procedure that does this has the desired
-|equiv| code as a parameter. In order to facilitate \.{WEB} macro writing
-for the initialization, the keyword being initialized is placed into the
-last positions of |cur_name|, instead of the first positions.
-
-@p procedure enter_name(v:byte); {|cur_name| goes into the dictionary}
-var k:0..longest_name;
-begin for k:=1 to name_length do
- cur_name[k]:=cur_name[k+longest_name-name_length];
-{now the name has been shifted into the correct position}
-lookup; {this sets |cur_hash| to the proper insertion place}
-nhash[cur_hash]:=start_ptr; equiv[start_ptr]:=v;
-for k:=1 to name_length do begin
- dictionary[dict_ptr]:=cur_name[k]; incr(dict_ptr);
- end;
-incr(start_ptr); start[start_ptr]:=dict_ptr;
-end;
-
-@ Here are the macros to load a name of up to 20 letters into the
-dictionary. For example, the macro |load5| is used for five-letter keywords.
-
-@d tail(#)==enter_name(#)
-@d t20(#)==cur_name[20]:=#;tail
-@d t19(#)==cur_name[19]:=#;t20
-@d t18(#)==cur_name[18]:=#;t19
-@d t17(#)==cur_name[17]:=#;t18
-@d t16(#)==cur_name[16]:=#;t17
-@d t15(#)==cur_name[15]:=#;t16
-@d t14(#)==cur_name[14]:=#;t15
-@d t13(#)==cur_name[13]:=#;t14
-@d t12(#)==cur_name[12]:=#;t13
-@d t11(#)==cur_name[11]:=#;t12
-@d t10(#)==cur_name[10]:=#;t11
-@d t9(#)==cur_name[9]:=#;t10
-@d t8(#)==cur_name[8]:=#;t9
-@d t7(#)==cur_name[7]:=#;t8
-@d t6(#)==cur_name[6]:=#;t7
-@d t5(#)==cur_name[5]:=#;t6
-@d t4(#)==cur_name[4]:=#;t5
-@d t3(#)==cur_name[3]:=#;t4
-@d t2(#)==cur_name[2]:=#;t3
-@d t1(#)==cur_name[1]:=#;t2
-@d load2==name_length:=2;t19
-@d load3==name_length:=3;t18
-@d load4==name_length:=4;t17
-@d load5==name_length:=5;t16
-@d load6==name_length:=6;t15
-@d load7==name_length:=7;t14
-@d load8==name_length:=8;t13
-@d load9==name_length:=9;t12
-@d load10==name_length:=10;t11
-@d load11==name_length:=11;t10
-@d load12==name_length:=12;t9
-@d load13==name_length:=13;t8
-@d load14==name_length:=14;t7
-@d load15==name_length:=15;t6
-@d load16==name_length:=16;t5
-@d load17==name_length:=17;t4
-@d load18==name_length:=18;t3
-@d load19==name_length:=19;t2
-@d load20==name_length:=20;t1
-
-@ (Thank goodness for keyboard macros in the text editor used to create this
-\.{WEB} file.)
-
-@<Enter all the \.{PL} names and their equivalents,
- except the parameter names@>=
-equiv[0]:=comment_code; {this is used after unknown keywords}
-load8("C")("H")("E")("C")("K")("S")("U")("M")(check_sum_code);@/
-load10("D")("E")("S")("I")("G")("N")("S")("I")("Z")("E")(design_size_code);@/
-load11("D")("E")("S")("I")("G")("N")
- ("U")("N")("I")("T")("S")(design_units_code);@/
-load12("C")("O")("D")("I")("N")("G")
- ("S")("C")("H")("E")("M")("E")(coding_scheme_code);@/
-load6("F")("A")("M")("I")("L")("Y")(family_code);@/
-load4("F")("A")("C")("E")(face_code);@/
-load16("S")("E")("V")("E")("N")("B")("I")("T")@/@t\hskip2em@>
- ("S")("A")("F")("E")("F")("L")("A")("G")(seven_bit_safe_flag_code);@/
-load6("H")("E")("A")("D")("E")("R")(header_code);@/
-load9("F")("O")("N")("T")("D")("I")("M")("E")("N")(font_dimen_code);@/
-load8("L")("I")("G")("T")("A")("B")("L")("E")(lig_table_code);@/
-load12("B")("O")("U")("N")("D")("A")("R")("Y")("C")("H")("A")("R")
- (boundary_char_code);@/
-load9("C")("H")("A")("R")("A")("C")("T")("E")("R")(character_code);@/
-load9("P")("A")("R")("A")("M")("E")("T")("E")("R")(parameter_code);@/
-load6("C")("H")("A")("R")("W")("D")(char_wd_code);@/
-load6("C")("H")("A")("R")("H")("T")(char_ht_code);@/
-load6("C")("H")("A")("R")("D")("P")(char_dp_code);@/
-load6("C")("H")("A")("R")("I")("C")(char_ic_code);@/
-load5("S")("E")("C")("W")("D")(sec_width_code);@/
-load5("S")("E")("C")("H")("T")(sec_height_code);@/
-load5("S")("E")("C")("D")("P")(sec_depth_code);@/
-load5("S")("E")("C")("I")("C")(sec_italic_code);@/
-load6("A")("C")("C")("E")("N")("T")(accent_code);@/
-load11("P")("R")("I")("M")("T")("O")("P")("A")("X")("I")("S")(prim_top_axis_code);@/
-load14("P")("R")("I")("M")("T")("O")("P")("A")("X")("I")("S")("B")("I")("S")(prim_top_axis_bis_code);@/
-load11("P")("R")("I")("M")("B")("O")("T")("A")("X")("I")("S")(prim_bot_axis_code);@/
-load14("P")("R")("I")("M")("B")("O")("T")("A")("X")("I")("S")("B")("I")("S")(prim_bot_axis_bis_code);@/
-load10("P")("R")("I")("M")("M")("I")("D")("H")("O")("R")(prim_mid_hor_code);@/
-load10("P")("R")("I")("M")("M")("I")("D")("V")("E")("R")(prim_mid_vert_code);@/
-load13("P")("R")("I")("M")("B")("A")("S")("E")("S")("L")("A")("N")("T")(prim_base_slant_code);@/
-load10("S")("E")("C")("T")("O")("P")("A")("X")("I")("S")(sec_top_axis_code);@/
-load13("S")("E")("C")("T")("O")("P")("A")("X")("I")("S")("B")("I")("S")(sec_top_axis_bis_code);@/
-load10("S")("E")("C")("B")("O")("T")("A")("X")("I")("S")(sec_bot_axis_code);@/
-load13("S")("E")("C")("B")("O")("T")("A")("X")("I")("S")("B")("I")("S")(sec_bot_axis_bis_code);@/
-load9("S")("E")("C")("M")("I")("D")("H")("O")("R")(sec_mid_hor_code);@/
-load9("S")("E")("C")("M")("I")("D")("V")("E")("R")(sec_mid_vert_code);@/
-load12("S")("E")("C")("B")("A")("S")("E")("S")("L")("A")("N")("T")(sec_base_slant_code);@/
-load10("N")("E")("X")("T")("L")("A")("R")("G")("E")("R")(next_larger_code);@/
-load7("V")("A")("R")("C")("H")("A")("R")(var_char_code);@/
-load3("T")("O")("P")(var_char_code+1);@/
-load3("M")("I")("D")(var_char_code+2);@/
-load3("B")("O")("T")(var_char_code+3);@/
-load3("R")("E")("P")(var_char_code+4);@/
-load3("E")("X")("T")(var_char_code+4); {compatibility with older \.{PL} format}
-load7("C")("O")("M")("M")("E")("N")("T")(comment_code);@/
-load5("L")("A")("B")("E")("L")(label_code);@/
-load4("S")("T")("O")("P")(stop_code);@/
-load4("S")("K")("I")("P")(skip_code);@/
-load3("K")("R")("N")(krn_code);@/
-load3("L")("I")("G")(lig_code);@/
-load4("/")("L")("I")("G")(lig_code+2);@/
-load5("/")("L")("I")("G")(">")(lig_code+6);@/
-load4("L")("I")("G")("/")(lig_code+1);@/
-load5("L")("I")("G")("/")(">")(lig_code+5);@/
-load5("/")("L")("I")("G")("/")(lig_code+3);@/
-load6("/")("L")("I")("G")("/")(">")(lig_code+7);@/
-load7("/")("L")("I")("G")("/")(">")(">")(lig_code+11);@/
-load6("C")("L")("A")("B")("E")("L")(clabel_code);@/
-load4("C")("P")("E")("N")(cpen_code);@/
-load5("C")("G")("L")("U")("E")(cglue_code);@/
-load8("C")("P")("E")("N")("G")("L")("U")("E")(cpenglue_code);@/
-load4("C")("K")("R")("N")(ckrn_code);@/
-load8("O")("F")("M")("L")("E")("V")("E")("L")(ofm_level_code);@/
-load7("F")("O")("N")("T")("D")("I")("R")(font_dir_code);@/
-load8("N")("F")("O")("N")("T")("D")("I")("R")(n_font_dir_code);@/
-load10("C")("H")("A")("R")("R")("E")("P")("E")("A")("T")(char_repeat_code);@/
-load10("C")("H")("A")("R")("I")("V")("A")("L")("U")("E")(char_ivalue_code);@/
-load10("C")("H")("A")("R")("F")("V")("A")("L")("U")("E")(char_fvalue_code);@/
-load10("C")("H")("A")("R")("M")("V")("A")("L")("U")("E")(char_mvalue_code);@/
-load8("C")("H")("A")("R")("R")("U")("L")("E")(char_rule_code);@/
-load8("C")("H")("A")("R")("G")("L")("U")("E")(char_glue_code);@/
-load11("C")("H")("A")("R")("P")("E")("N")("A")("L")("T")("Y")(char_penalty_code);@/
-load8("F")("O")("N")("T")("R")("U")("L")("E")(font_rule_code);@/
-load4("R")("U")("L")("E")(rule_code);@/
-load6("R")("U")("L")("E")("W")("D")(rule_width_code);@/
-load6("R")("U")("L")("E")("H")("T")(rule_height_code);@/
-load6("R")("U")("L")("E")("D")("P")(rule_depth_code);@/
-load8("F")("O")("N")("T")("G")("L")("U")("E")(font_glue_code);@/
-load4("G")("L")("U")("E")(glue_code);@/
-load8("G")("L")("U")("E")("T")("Y")("P")("E")(glue_type_code);@/
-load16("G")("L")("U")("E")("S")("T")("R")("E")("T")("C")("H")("O")("R")("D")("E")("R")(glue_stretch_order_code);@/
-load15("G")("L")("U")("E")("S")("H")("R")("I")("N")("K")("O")("R")("D")("E")("R")(glue_shrink_order_code);@/
-load8("G")("L")("U")("E")("R")("U")("L")("E")(glue_rule_code);@/
-load8("G")("L")("U")("E")("C")("H")("A")("R")(glue_char_code);@/
-load6("G")("L")("U")("E")("W")("D")(glue_width_code);@/
-load11("G")("L")("U")("E")("S")("T")("R")("E")("T")("C")("H")(glue_stretch_code);@/
-load10("G")("L")("U")("E")("S")("H")("R")("I")("N")("K")(glue_shrink_code);@/
-load4("U")("N")("I")("T")(order_unit_code);@/
-load2("F")("I")(order_fi_code);@/
-load3("F")("I")("L")(order_fil_code);@/
-load4("F")("I")("L")("L")(order_fill_code);@/
-load5("F")("I")("L")("L")("L")(order_filll_code);@/
-load6("N")("O")("R")("M")("A")("L")(type_normal_code);@/
-load8("A")("L")("E")("A")("D")("E")("R")("S")(type_aleaders_code);@/
-load8("C")("L")("E")("A")("D")("E")("R")("S")(type_cleaders_code);@/
-load8("X")("L")("E")("A")("D")("E")("R")("S")(type_xleaders_code);@/
-load11("F")("O")("N")("T")("P")("E")("N")("A")("L")("T")("Y")(font_penalty_code);@/
-load7("P")("E")("N")("A")("L")("T")("Y")(penalty_code);@/
-load10("P")("E")("N")("A")("L")("T")("Y")("V")("A")("L")(penalty_val_code);@/
-load10("F")("O")("N")("T")("M")("V")("A")("L")("U")("E")(font_mvalue_code);@/
-load6("M")("V")("A")("L")("U")("E")(mvalue_code);@/
-load9("M")("V")("A")("L")("U")("E")("V")("A")("L")(mvalue_val_code);@/
-load10("F")("O")("N")("T")("F")("V")("A")("L")("U")("E")(font_fvalue_code);@/
-load6("F")("V")("A")("L")("U")("E")(fvalue_code);@/
-load9("F")("V")("A")("L")("U")("E")("V")("A")("L")(fvalue_val_code);@/
-load10("F")("O")("N")("T")("I")("V")("A")("L")("U")("E")(font_ivalue_code);@/
-load6("I")("V")("A")("L")("U")("E")(ivalue_code);@/
-load9("I")("V")("A")("L")("U")("E")("V")("A")("L")(ivalue_val_code);@/
-load2("T")("L")(TL_dir_code);
-load2("L")("T")(LT_dir_code);
-load2("T")("R")(TR_dir_code);
-load2("L")("B")(LB_dir_code);
-load2("B")("L")(BL_dir_code);
-load2("R")("T")(RT_dir_code);
-load2("B")("R")(BR_dir_code);
-load2("R")("B")(RB_dir_code);
-
-@ \.{VPL} files may contain the following in addition to the \.{PL} names.
-
-@<Enter all the \.{VPL} names@>=
-load6("V")("T")("I")("T")("L")("E")(virtual_title_code);@/
-load7("M")("A")("P")("F")("O")("N")("T")(map_font_code);@/
-load3("M")("A")("P")(map_code);@/
-load8("F")("O")("N")("T")("N")("A")("M")("E")(font_name_code);@/
-load8("F")("O")("N")("T")("A")("R")("E")("A")(font_area_code);@/
-load12("F")("O")("N")("T")
- ("C")("H")("E")("C")("K")("S")("U")("M")(font_checksum_code);@/
-load6("F")("O")("N")("T")("A")("T")(font_at_code);@/
-load9("F")("O")("N")("T")("D")("S")("I")("Z")("E")(font_dsize_code);@/
-load10("S")("E")("L")("E")("C")("T")("F")("O")("N")("T")(select_font_code);@/
-load7("S")("E")("T")("C")("H")("A")("R")(set_char_code);@/
-load7("S")("E")("T")("R")("U")("L")("E")(set_rule_code);@/
-load9("M")("O")("V")("E")("R")("I")("G")("H")("T")(move_right_code);@/
-load8("M")("O")("V")("E")("L")("E")("F")("T")(move_right_code+1);@/
-load8("M")("O")("V")("E")("D")("O")("W")("N")(move_down_code);@/
-load6("M")("O")("V")("E")("U")("P")(move_down_code+1);@/
-load4("P")("U")("S")("H")(push_code);@/
-load3("P")("O")("P")(pop_code);@/
-load7("S")("P")("E")("C")("I")("A")("L")(special_code);@/
-load10("S")("P")("E")("C")("I")("A")("L")("H")("E")("X")(special_hex_code);@/
-
-@ @<Enter the parameter names@>=
-load5("S")("L")("A")("N")("T")(parameter_code+1);@/
-load5("S")("P")("A")("C")("E")(parameter_code+2);@/
-load7("S")("T")("R")("E")("T")("C")("H")(parameter_code+3);@/
-load6("S")("H")("R")("I")("N")("K")(parameter_code+4);@/
-load7("X")("H")("E")("I")("G")("H")("T")(parameter_code+5);@/
-load4("Q")("U")("A")("D")(parameter_code+6);@/
-load10("E")("X")("T")("R")("A")("S")("P")("A")("C")("E")(parameter_code+7);@/
-load4("N")("U")("M")("1")(parameter_code+8);@/
-load4("N")("U")("M")("2")(parameter_code+9);@/
-load4("N")("U")("M")("3")(parameter_code+10);@/
-load6("D")("E")("N")("O")("M")("1")(parameter_code+11);@/
-load6("D")("E")("N")("O")("M")("2")(parameter_code+12);@/
-load4("S")("U")("P")("1")(parameter_code+13);@/
-load4("S")("U")("P")("2")(parameter_code+14);@/
-load4("S")("U")("P")("3")(parameter_code+15);@/
-load4("S")("U")("B")("1")(parameter_code+16);@/
-load4("S")("U")("B")("2")(parameter_code+17);@/
-load7("S")("U")("P")("D")("R")("O")("P")(parameter_code+18);@/
-load7("S")("U")("B")("D")("R")("O")("P")(parameter_code+19);@/
-load6("D")("E")("L")("I")("M")("1")(parameter_code+20);@/
-load6("D")("E")("L")("I")("M")("2")(parameter_code+21);@/
-load10("A")("X")("I")("S")("H")("E")("I")("G")("H")("T")(parameter_code+22);@/
-load20("D")("E")("F")("A")("U")("L")("T")("R")("U")("L")("E")@/@t\hskip2em@>
- ("T")("H")("I")("C")("K")("N")("E")("S")("S")(parameter_code+8);@/
-load13("B")("I")("G")("O")("P")
- ("S")("P")("A")("C")("I")("N")("G")("1")(parameter_code+9);@/
-load13("B")("I")("G")("O")("P")
- ("S")("P")("A")("C")("I")("N")("G")("2")(parameter_code+10);@/
-load13("B")("I")("G")("O")("P")
- ("S")("P")("A")("C")("I")("N")("G")("3")(parameter_code+11);@/
-load13("B")("I")("G")("O")("P")
- ("S")("P")("A")("C")("I")("N")("G")("4")(parameter_code+12);@/
-load13("B")("I")("G")("O")("P")
- ("S")("P")("A")("C")("I")("N")("G")("5")(parameter_code+13);@/
-
-@ When a left parenthesis has been scanned, the following routine
-is used to interpret the keyword that follows, and to store the
-equivalent value in |cur_code|.
-
-@p procedure get_name;
-begin incr(loc); incr(level); {pass the left parenthesis}
-cur_char:=" ";
-while cur_char=" " do get_next;
-if (cur_char>")")or(cur_char<"(") then decr(loc); {back up one character}
-name_length:=0; get_keyword_char; {prepare to scan the name}
-while cur_char<>" " do begin
- if name_length=longest_name then cur_name[1]:="X" {force error}
- else incr(name_length);
- cur_name[name_length]:=cur_char;
- get_keyword_char;
- end;
-lookup;
-if name_ptr=0 then err_print('Sorry, I don''t know that property name');
-@.Sorry, I don't know...@>
-cur_code:=equiv[name_ptr];
-end;
-
-@* Scanning numeric data.
-The next thing we need is a trio of subroutines to read the one-byte,
-four-byte, and real numbers that may appear as property values.
-These subroutines are careful to stick to numbers between $-2^{31}$
-and $2^{31}-1$, inclusive, so that a computer with two's complement
-32-bit arithmetic will not be interrupted by overflow.
-
-@ The first number scanner, which returns a one-byte value, surely has
-no problems of arithmetic overflow.
-
-@p function get_byte:byte; {scans a one-byte property value}
-var acc:integer; {an accumulator}
-@!t:ASCII_code; {the type of value to be scanned}
-begin repeat get_next;
-until cur_char<>" "; {skip the blanks before the type code}
-t:=cur_char; acc:=0;
-repeat get_next;
-until cur_char<>" "; {skip the blanks after the type code}
-if t="C" then @<Scan an ASCII character code@>
-else if t="D" then @<Scan a small decimal number@>
-else if t="O" then @<Scan a small octal number@>
-else if t="H" then @<Scan a small hexadecimal number@>
-else if t="F" then @<Scan a face code@>
-else skip_error('You need "C" or "D" or "O" or "H" or "F" here');
-@.You need "C" or "D" ...here@>
-cur_char:=" "; get_byte:=acc;
-end;
-
-@ The |get_next| routine converts lower case to upper case, but it leaves
-the character in the buffer, so we can unconvert it.
-
-@<Scan an ASCII...@>=
-if (cur_char>=@'41)and(cur_char<=@'176)and
- ((cur_char<"(")or(cur_char>")")) then
- acc:=xord[buffer[loc]]
-else skip_error('"C" value must be standard ASCII and not a paren')
-@:C value}\.{"C" value must be...@>
-
-@ @<Scan a small dec...@>=
-begin while (cur_char>="0")and(cur_char<="9") do begin
- acc:=acc*10+cur_char-"0";
- if acc>65535 then begin
- skip_error('This value shouldn''t exceed 65535');
-@.This value shouldn't...@>
- acc:=0; cur_char:=" ";
- end
- else get_next;
- end;
-backup;
-end
-
-@ @<Scan a small oct...@>=
-begin while (cur_char>="0")and(cur_char<="7") do begin
- acc:=acc*8+cur_char-"0";
- if acc>65535 then begin
- skip_error('This value shouldn''t exceed ''177777');
-@.This value shouldn't...@>
- acc:=0; cur_char:=" ";
- end
- else get_next;
- end;
-backup;
-end
-
-@ @<Scan a small hex...@>=
-begin while ((cur_char>="0")and(cur_char<="9"))or
- ((cur_char>="A")and(cur_char<="F")) do begin
- if cur_char>="A" then cur_char:=cur_char+"0"+10-"A";
- acc:=acc*16+cur_char-"0";
- if acc>65535 then begin
- skip_error('This value shouldn''t exceed "FFFF');
-@.This value shouldn't...@>
- acc:=0; cur_char:=" ";
- end
- else get_next;
- end;
-backup;
-end
-
-@ @<Scan a face...@>=
-begin if cur_char="B" then acc:=2
-else if cur_char="L" then acc:=4
-else if cur_char<>"M" then acc:=18;
-get_next;
-if cur_char="I" then incr(acc)
-else if cur_char<>"R" then acc:=18;
-get_next;
-if cur_char="C" then acc:=acc+6
-else if cur_char="E" then acc:=acc+12
-else if cur_char<>"R" then acc:=18;
-if acc>=18 then begin
- skip_error('Illegal face code, I changed it to MRR');
-@.Illegal face code...@>
- acc:=0;
- end;
-end
-
-@ The routine that scans a four-byte value puts its output into |cur_bytes|,
-which is a record containing (yes, you guessed it) four bytes.
-
-@<Types...@>=
-@!four_bytes=record @!b0:byte;@+@!b1:byte;@+@!b2:byte;@+@!b3:byte;@+end;
-
-@ @d c0==cur_bytes.b0
-@d c1==cur_bytes.b1
-@d c2==cur_bytes.b2
-@d c3==cur_bytes.b3
-
-@<Glob...@>=
-@!cur_bytes:four_bytes; {a four-byte accumulator}
-@!zero_bytes:four_bytes; {four bytes all zero}
-
-@ @<Set init...@>=
-zero_bytes.b0:=0; zero_bytes.b1:=0; zero_bytes.b2:=0; zero_bytes.b3:=0;
-
-@ Since the |get_four_bytes| routine is used very infrequently, no attempt
-has been made to make it fast; we only want it to work.
-This is no longer the case, but we hope it's not too slow.
-
-@p procedure get_four_bytes; {scans an unsigned constant and sets |four_bytes|}
-var c:integer; {local two-byte accumulator}
-@!r:integer; {radix}
-begin repeat get_next;
-until cur_char<>" "; {skip the blanks before the type code}
-r:=0; cur_bytes:=zero_bytes; {start with the accumulator zero}
-if cur_char="H" then r:=16
-else if cur_char="O" then r:=8
-else if cur_char="D" then r:=10
-else skip_error('Decimal ("D"), octal ("O"), or hex ("H") value needed here');
-@.Decimal ("D"), octal ("O"), or hex...@>
-if r>0 then begin
- repeat get_next;
- until cur_char<>" "; {skip the blanks after the type code}
- while ((cur_char>="0")and(cur_char<="9"))or@|
- ((cur_char>="A")and(cur_char<="F")) do
- @<Multiply by |r|, add |cur_char-"0"|, and |get_next|@>;
- end;
-end;
-
-function get_integer:integer; {scans an integer property value}
-begin get_four_bytes;
-get_integer:=(c0*@"1000000)+(c1*@"10000)+(c2*@"100)+c3;
-end;
-
-
-@ @<Multiply by |r|...@>=
-begin if cur_char>="A" then cur_char:=cur_char+"0"+10-"A";
-if cur_char>="0"+r then skip_error('Illegal digit')
-@.Illegal digit@>
-else begin
- c:=c3*r+cur_char-"0"; c3:=c mod 256;@/
- c:=c2*r+c div 256; c2:=c mod 256;@/
- c:=c1*r+c div 256; c1:=c mod 256;@/
- c:=c0*r+c div 256;
- if c<256 then c0:=c
- else begin
- cur_bytes:=zero_bytes;
- if r=8 then
- skip_error('Sorry, the maximum octal value is O 37777777777')
-@.Sorry, the maximum...@>
- else if r=10 then
- skip_error('Sorry, the maximum decimal value is D 4294967295')
- else skip_error('Sorry, the maximum hex value is H FFFFFFFF');
- end;
- get_next;
- end;
-end
-
-@ The remaining scanning routine is the most interesting. It scans a real
-constant and returns the nearest |fix_word| approximation to that constant.
-A |fix_word| is a 32-bit integer that represents a real value that
-has been multiplied by $2^{20}$. Since \.{VPtoVF} restricts the magnitude
-of reals to 2048, the |fix_word| will have a magnitude less than $2^{31}$.
-
-@d unity==@'4000000 {$2^{20}$, the |fix_word| 1.0}
-
-@<Types...@>=
-@!fix_word=integer; {a scaled real value with 20 bits of fraction}
-@!unsigned_integer=integer;
-
-@ When a real value is desired, we might as well treat `\.D' and `\.R'
-formats as if they were identical.
-
-@p function get_fix:fix_word; {scans a real property value}
-var negative:boolean; {was there a minus sign?}
-@!acc:integer; {an accumulator}
-@!int_part:integer; {the integer part}
-@!j:0..7; {the number of decimal places stored}
-begin repeat get_next;
-until cur_char<>" "; {skip the blanks before the type code}
-negative:=false; acc:=0; {start with the accumulators zero}
-if (cur_char<>"R")and(cur_char<>"D") then
- skip_error('An "R" or "D" value is needed here')
-@.An "R" or "D" ... needed here@>
-else begin @<Scan the blanks and/or signs after the type code@>;
- while (cur_char>="0") and (cur_char<="9") do
- @<Multiply by 10, add |cur_char-"0"|, and |get_next|@>;
- int_part:=acc; acc:=0;
- if cur_char="." then @<Scan the fraction part and put it in |acc|@>;
- if (acc>=unity)and(int_part=2047) then
- skip_error('Real constants must be less than 2048')
-@.Real constants must be...@>
- else acc:=int_part*unity+acc;
- end;
-if negative then get_fix:=-acc@+else get_fix:=acc;
-end;
-
-@ @<Scan the blanks...@>=
-repeat get_next;
-if cur_char="-" then begin
- cur_char:=" "; negative:=true;
- end
-else if cur_char="+" then cur_char:=" ";
-until cur_char<>" "
-
-@ @<Multiply by 10...@>=
-begin acc:=acc*10+cur_char-"0";
-if acc>=2048 then begin
- skip_error('Real constants must be less than 2048');
-@.Real constants must be...@>
- acc:=0; cur_char:=" ";
- end
-else get_next;
-end
-
-@ To scan the fraction $.d_1d_2\ldots\,$, we keep track of up to seven
-of the digits $d_j$. A correct result is obtained if we first compute
-$f^\prime=\lfloor 2^{21}(d_1\ldots d_j)/10^j\rfloor$, after which
-$f=\lfloor(f^\prime+1)/2\rfloor$. It is possible to have $f=1.0$.
-
-@<Glob...@>=
-@!fraction_digits:array[1..7] of integer; {$2^{21}$ times $d_j$}
-
-@ @<Scan the frac...@>=
-begin j:=0; get_next;
-while (cur_char>="0")and(cur_char<="9") do begin
- if j<7 then begin
- incr(j); fraction_digits[j]:=@'10000000*(cur_char-"0");
- end;
- get_next;
- end;
-acc:=0;
-while j>0 do begin
- acc:=fraction_digits[j]+(acc div 10); decr(j);
- end;
-acc:=(acc+10) div 20;
-end
-
-@* Storing the property values.
-When property values have been found, they are squirreled away in a bunch
-of arrays. The header information is unpacked into bytes in an array
-called |header_bytes|. The ligature/kerning program is stored in an array
-of type |four_bytes|.
-Another |four_bytes| array holds the specifications of extensible characters.
-The kerns and parameters are stored in separate arrays of |fix_word| values.
-Virtual font data goes into an array |vf| of single-byte values.
-
-We maintain information about at most |max_font+1| local fonts.
-
-Instead of storing the design size in the header array, we will keep it
-in a |fix_word| variable until the last minute. The number of units in the
-design size is also kept in a |fix_word|.
-
-@<Glob...@>=
-@!header_bytes:array[header_index] of byte; {the header block}
-@!header_ptr:header_index; {the number of header bytes in use}
-@!design_size:fix_word; {the design size}
-@!design_units:fix_word; {reciprocal of the scaling factor}
-@!frozen_du:boolean; {have we used |design_units| irrevocably?}
-@!seven_bit_safe_flag:boolean; {does the file claim to be seven-bit-safe?}
-@!lig_kern:array[0..max_lig_steps] of four_bytes; {the ligature program}
-@!nl:unsigned_integer; {the number of ligature/kern instructions so far}
-@!min_nl:unsigned_integer; {the final value of |nl| must be at least this}
-@!kern:array[0..max_kerns] of fix_word; {the distinct kerning amounts}
-@!nk:0..max_kerns; {the number of entries of |kern|}
-@!exten:array[char_type] of four_bytes; {extensible character specs}
-@!ne:xchar_type; {the number of extensible characters}
-@!param:array[1..max_param_words] of fix_word; {\.{FONTDIMEN} parameters}
-@!np:0..max_param_words; {the largest parameter set nonzero}
-@!check_sum_specified:boolean; {did the user name the check sum?}
-@!bchar:xchar_type; {right boundary character, |xmax_char| if unspecified}
-@!font_dir:integer; {font direction}
-@!vf:array[0..vf_size] of byte; {stored bytes for \.{VF} file}
-@!vf_ptr:0..vf_size; {first unused location in |vf|}
-@!vtitle_start:0..vf_size; {starting location of \.{VTITLE} string}
-@!vtitle_length:byte; {length of \.{VTITLE} string}
-@!packet_start:array[char_type] of 0..vf_size;
- {beginning location of character packet}
-@!packet_length:array[char_type] of integer; {length of character packet}
-@!font_ptr:xfont_type; {number of distinct local fonts seen}
-@!cur_font:xfont_type; {number of the current local font}
-@!fname_start:array[font_type] of 0..vf_size; {beginning of local font name}
-@!fname_length:array[font_type] of byte; {length of local font name}
-@!farea_start:array[font_type] of 0..vf_size; {beginning of local font area}
-@!farea_length:array[font_type] of byte; {length of local font area}
-@!font_checksum:array[font_type] of four_bytes; {local font checksum}
-@!font_number:array[xfont_type] of integer; {local font id number}
-@!font_at:array[font_type] of fix_word; {local font ``at size''}
-@!font_dsize:array[font_type] of fix_word; {local font design size}
-
-@ @<Types...@>=
-@!char_type=0..max_char;
-@!xchar_type=0..xmax_char;
-@!xxchar_type=0..xxmax_char;
-@!font_type=0..max_font;
-@!xfont_type=0..xmax_font;
-@!header_index=0..max_header_bytes;
-@!indx=xxchar_type;
-
-@ @<Local...@>=
-@!d:header_index; {an index into |header_bytes|}
-
-@ We start by setting up the default values.
-
-@d check_sum_loc=0
-@d design_size_loc=4
-@d coding_scheme_loc=8
-@d family_loc=coding_scheme_loc+40
-@d seven_flag_loc=family_loc+20
-@d face_loc=seven_flag_loc+3
-
-@<Set init...@>=
-for d:=0 to 18*4-1 do header_bytes[d]:=0;
-header_bytes[8]:=11; header_bytes[9]:="U";
-header_bytes[10]:="N";
-header_bytes[11]:="S";
-header_bytes[12]:="P";
-header_bytes[13]:="E";
-header_bytes[14]:="C";
-header_bytes[15]:="I";
-header_bytes[16]:="F";
-header_bytes[17]:="I";
-header_bytes[18]:="E";
-header_bytes[19]:="D";
-@.UNSPECIFIED@>
-for d:=family_loc to family_loc+11 do header_bytes[d]:=header_bytes[d-40];
-design_size:=10*unity; design_units:=unity; frozen_du:=false;
-seven_bit_safe_flag:=false;@/
-header_ptr:=18*4; nl:=0; min_nl:=0; nk:=0; ne:=0; np:=0;@/
-check_sum_specified:=false; bchar:=xmax_char;@/
-font_dir:=0;
-vf_ptr:=0; vtitle_start:=0; vtitle_length:=0; font_ptr:=0;
-for k:=0 to max_char do packet_start[k]:=vf_size;
-for k:=0 to 127 do packet_length[k]:=1;
-for k:=128 to 255 do packet_length[k]:=2;
-for k:=256 to max_char do packet_length[k]:=3;
-
-@ Most of the dimensions, however, go into the |memory| array. There are
-at most |max_char+2| widths, |max_char+2| heights,
-|max_char+2| depths, and |max_char+2| italic corrections,
-since the value 0 is required but it need not be used. So |memory| has room
-for |4*max_char+8| entries, each of which is a |fix_word|. An auxiliary table called
-|link| is used to link these words together in linear lists, so that
-sorting and other operations can be done conveniently.
-
-We also add four ``list head'' words to the |memory| and |link| arrays;
-these are in locations |width| through |italic|, i.e., 1 through 4.
-For example, |link[height]| points to the smallest element in
-the sorted list of distinct heights that have appeared so far, and
-|memory[height]| is the number of distinct heights.
-
-@<Types...@>=
-@!pointer=0..mem_size; {an index into memory}
-
-@ The arrays |char_wd|, |char_ht|, |char_dp|, and |char_ic| contain
-pointers to the |memory| array entries where the corresponding dimensions
-appear. Two other arrays, |char_tag| and |char_remainder|, hold
-the other information that \.{TFM} files pack into a |char_info_word|.
-
-@d no_tag=0 {vanilla character}
-@d lig_tag=1 {character has a ligature/kerning program}
-@d list_tag=2 {character has a successor in a charlist}
-@d ext_tag=3 {character is extensible}
-@d bchar_label==char_remainder[xmax_char]
- {beginning of ligature program for left boundary}
-
-@<Glob...@>=
-@!memory:array[pointer] of fix_word; {character dimensions and kerns}
-@!mem_ptr:pointer; {largest |memory| word in use}
-@!link:array[pointer] of pointer; {to make lists of |memory| items}
-@!char_wd:array[char_type] of pointer; {pointers to the widths}
-@!char_ht:array[char_type] of pointer; {pointers to the heights}
-@!char_dp:array[char_type] of pointer; {pointers to the depths}
-@!char_ic:array[char_type] of pointer; {pointers to italic corrections}
-@!char_tag:array[char_type] of no_tag..ext_tag; {character tags}
-@!char_remainder:array[xchar_type] of xchar_type;
- {pointers to ligature labels,
- next larger characters, or extensible characters}
-@!top_width,@!top_height,@!top_depth,@!top_italic:integer;
-
-@ @<Local...@>=
-@!c:integer; {runs through all character codes}
-
-@ @<Set init...@>=
-bchar_label:=xmax_label;
-for c:=0 to max_char do begin
- char_wd[c]:=0; char_ht[c]:=0; char_dp[c]:=0; char_ic[c]:=0;@/
- char_tag[c]:=no_tag; char_remainder[c]:=0;
- end;
-memory[0]:=@'17777777777; {an ``infinite'' element at the end of the lists}
-memory[width]:=0; link[width]:=0; {width list is empty}
-memory[height]:=0; link[height]:=0; {height list is empty}
-memory[depth]:=0; link[depth]:=0; {depth list is empty}
-memory[italic]:=0; link[italic]:=0; {italic list is empty}
-mem_ptr:=italic;
-
-@ As an example of these data structures, let us consider the simple
-routine that inserts a potentially new element into one of the dimension
-lists. The first parameter indicates the list head (i.e., |h=width| for
-the width list, etc.); the second parameter is the value that is to be
-inserted into the list if it is not already present. The procedure
-returns the value of the location where the dimension appears in |memory|.
-The fact that |memory[0]| is larger than any legal dimension makes the
-algorithm particularly short.
-
-We do have to handle two somewhat subtle situations. A width of zero must be
-put into the list, so that a zero-width character in the font will not appear
-to be nonexistent (i.e., so that its |char_wd| index will not be zero), but
-this does not need to be done for heights, depths, or italic corrections.
-Furthermore, it is necessary to test for memory overflow even though we
-have provided room for the maximum number of different dimensions in any
-legal font, since the \.{VPL} file might foolishly give any number of
-different sizes to the same character.
-
-@p function sort_in(@!h:pointer;@!d:fix_word):pointer; {inserts into list}
-var p:pointer; {the current node of interest}
-begin if (d=0)and(h<>width) then sort_in:=0
-else begin p:=h;
- while d>=memory[link[p]] do p:=link[p];
- if (d=memory[p])and(p<>h) then sort_in:=p
- else if mem_ptr=mem_size then begin
- err_print('Memory overflow: too many widths, etc');
-@.Memory overflow...@>
- print_ln('Congratulations! It''s hard to make this error.');
- sort_in:=p;
- end
- else begin
- incr(mem_ptr); memory[mem_ptr]:=d;
- link[mem_ptr]:=link[p]; link[p]:=mem_ptr; incr(memory[h]);
- sort_in:=mem_ptr;
- end;
- end;
-end;
-
-@ When these lists of dimensions are eventually written to the \.{OFM}
-file, we may have to do some rounding of values, because the \.{OFM} file
-allows at most 65536 widths, 256 heights, 256 depths, and 256 italic
-corrections. The following procedure takes a given list head |h| and a
-given dimension |d|, and returns the minimum $m$ such that the elements
-of the list can be covered by $m$ intervals of width $d$. It also sets
-|next_d| to the smallest value $d^\prime>d$ such that the covering found
-by this procedure would be different. In particular, if $d=0$ it computes
-the number of elements of the list, and sets |next_d| to the smallest
-distance between two list elements. (The covering by intervals of width
-|next_d| is not guaranteed to have fewer than $m$ elements, but in
-practice this seems to happen most of the time.)
-
-@<Glob...@>=
-@!next_d:fix_word; {the next larger interval that is worth trying}
-
-@ Once again we can make good use of the fact that |memory[0]| is ``infinite.''
-
-@p function min_cover(@!h:pointer;@!d:fix_word):integer;
-var p:pointer; {the current node of interest}
-@!l:fix_word; {the least element covered by the current interval}
-@!m:integer; {the current size of the cover being generated}
-begin m:=0; p:=link[h]; next_d:=memory[0];
-while p<>0 do begin
- incr(m); l:=memory[p];
- while memory[link[p]]<=l+d do p:=link[p];
- p:=link[p];
- if memory[p]-l<next_d then next_d:=memory[p]-l;
- end;
-min_cover:=m;
-end;
-
-@ The following procedure uses |min_cover| to determine the smallest $d$
-such that a given list can be covered with at most a given number of
-intervals.
-
-@p function shorten(@!h:pointer;m:integer):fix_word; {finds best way to round}
-var d:fix_word; {the current trial interval length}
-@!k:integer; {the size of a minimum cover}
-begin if memory[h]>m then begin
- excess:=memory[h]-m;
- k:=min_cover(h,0); d:=next_d; {now the answer is at least |d|}
- repeat d:=d+d; k:=min_cover(h,d);
- until k<=m; {first we ascend rapidly until finding the range}
- d:=d div 2; k:=min_cover(h,d); {now we run through the feasible steps}
- while k>m do begin
- d:=next_d; k:=min_cover(h,d);
- end;
- shorten:=d;
- end
-else shorten:=0;
-end;
-
-@ When we are nearly ready to output the \.{TFM} file, we will set
-|index[p]:=k| if the dimension in |memory[p]| is being rounded to the
-|k|th element of its list.
-
-@<Glob...@>=
-@!index:array[pointer] of byte;
-@!excess:byte; {number of words to remove, if list is being shortened}
-
-@ Here is the procedure that sets the |index| values. It also shortens
-the list so that there is only one element per covering interval;
-the remaining elements are the midpoints of their clusters.
-
-@p procedure set_indices(@!h:pointer;@!d:fix_word); {reduces and indexes a list}
-var p:pointer; {the current node of interest}
-@!q:pointer; {trails one step behind |p|}
-@!m:byte; {index number of nodes in the current interval}
-@!l:fix_word; {least value in the current interval}
-begin q:=h; p:=link[q]; m:=0;
-while p<>0 do begin
- incr(m); l:=memory[p]; index[p]:=m;
- while memory[link[p]]<=l+d do begin
- p:=link[p]; index[p]:=m; decr(excess);
- if excess=0 then d:=0;
- end;
- link[q]:=p; memory[p]:=l+(memory[p]-l) div 2; q:=p; p:=link[p];
- end;
-memory[h]:=m;
-end;
-
-@* The input phase.
-We're ready now to read and parse the \.{VPL} file, storing property
-values as we go.
-
-@<Glob...@>=
-@!c:integer; {the current character or byte being processed}
-@!cprime:char_type; {Processing for several characters together}
-@!crange:char_type; {ditto}
-@!x:fix_word; {current dimension of interest}
-@!k:integer; {general-purpose index}
-
-@ @<Read all the input@>=
-cur_char:=" ";
-repeat while cur_char=" " do get_next;
-if cur_char="(" then @<Read a font property value@>
-else if (cur_char=")")and not input_has_ended then begin
- err_print('Extra right parenthesis');
- incr(loc); cur_char:=" ";
- end
-@.Extra right parenthesis@>
-else if not input_has_ended then junk_error;
-until input_has_ended
-
-@ The |junk_error| routine just referred to is called when something
-appears in the forbidden area between properties of a property list.
-
-@p procedure junk_error; {gets past no man's land}
-begin err_print('There''s junk here that is not in parentheses');
-@.There's junk here...@>
-skip_to_paren;
-end;
-
-@ For each font property, we are supposed to read the data from the
-left parenthesis that is the current value of |cur_char| to the right
-parenthesis that matches it in the input. The main complication is
-to recover with reasonable grace from various error conditions that
-might arise.
-
-@<Read a font property value@>=
-begin get_name;
-if cur_code=comment_code then skip_to_end_of_item
-else if (cur_code<110) and (cur_code>character_code) then
- flush_error('This property name doesn''t belong on the outer level')
-else if (cur_code>=110) and ((cur_code mod 10)<>0) then
- flush_error('This property name doesn''t belong on the outer level')
-@.This property name doesn't belong...@>
-else begin
- @<Read the font property value specified by |cur_code|@>;
- finish_the_property;
- end;
-end
-
-@ @<Read the font property value spec...@>=
-case cur_code of
-check_sum_code: begin check_sum_specified:=true; read_four_bytes(check_sum_loc);
- end;
-design_size_code: @<Read the design size@>;
-design_units_code: @<Read the design units@>;
-coding_scheme_code: read_BCPL(coding_scheme_loc,40);
-family_code: read_BCPL(family_loc,20);
-face_code: begin c:=get_byte; if c>255 then begin
- err_print('FACE clipped to 255'); c:=255 end;
- header_bytes[face_loc]:=c
- end;
-seven_bit_safe_flag_code: @<Read the seven-bit-safe flag@>;
-header_code: @<Read an indexed header word@>;
-font_dimen_code: @<Read font parameter list@>;
-lig_table_code: read_lig_kern;
-boundary_char_code: bchar:=get_byte;
-virtual_title_code: begin vtitle_start:=vf_ptr; copy_to_end_of_item;
- if vf_ptr>vtitle_start+255 then begin
- err_print('VTITLE clipped to 255 characters'); vtitle_length:=255;
-@.VTITLE clipped...@>
- end
- else vtitle_length:=vf_ptr-vtitle_start;
- end;
-map_font_code:@<Read a local font list@>;
-character_code: read_char_info;
-ofm_level_code: @<Read OFM level code@>;
-font_dir_code: @<Read font direction code@>;
-n_font_dir_code: @<Read natural font direction code@>;
-char_repeat_code: read_repeated_character_info;
-font_rule_code: read_font_rule_list;
-font_glue_code: read_font_glue_list;
-font_penalty_code: read_font_penalty_list;
-font_mvalue_code: read_font_mvalue_list;
-font_fvalue_code: read_font_fvalue_list;
-font_ivalue_code: read_font_ivalue_list;
-end
-
-@ The |case| statement just given makes use of three subroutines that we
-haven't defined yet. The first of these puts a 32-bit octal quantity
-into four specified bytes of the header block.
-
-@p procedure read_four_bytes(l:header_index);
-begin get_four_bytes;
-header_bytes[l]:=c0;
-header_bytes[l+1]:=c1;
-header_bytes[l+2]:=c2;
-header_bytes[l+3]:=c3;
-end;
-
-@ The second little procedure is used to scan a string and to store it in
-the ``{\mc BCPL} format'' required by \.{TFM} files. The string is supposed
-to contain at most |n| bytes, including the first byte (which holds the
-length of the rest of the string).
-
-@p procedure read_BCPL(l:header_index;n:byte);
-var k:header_index;
-begin k:=l;
-while cur_char=" " do get_next;
-while (cur_char<>"(")and(cur_char<>")") do begin
- if k<l+n then incr(k);
- if k<l+n then header_bytes[k]:=cur_char;
- get_next;
- end;
-if k=l+n then begin
- err_print('String is too long; its first ',n-1:1,
-@.String is too long...@>
- ' characters will be kept'); decr(k);
- end;
-header_bytes[l]:=k-l;
-while k<l+n-1 do begin {tidy up the remaining bytes by setting them to nulls}
- incr(k); header_bytes[k]:=0;
- end;
-end;
-
-@ @<Read the design size@>=
-begin next_d:=get_fix;
-if next_d<unity then
- err_print('The design size must be at least 1')
-@.The design size must...@>
-else design_size:=next_d;
-end
-
-@ @<Read the design units@>=
-begin next_d:=get_fix;
-if next_d<=0 then
- err_print('The number of units per design size must be positive')
-@.The number of units...@>
-else if frozen_du then
- err_print('Sorry, it''s too late to change the design units')
-@.Sorry, it's too late...@>
-else design_units:=next_d;
-end
-
-@ @<Read the seven-bit-safe...@>=
-begin while cur_char=" " do get_next;
-if cur_char="T" then seven_bit_safe_flag:=true
-else if cur_char="F" then seven_bit_safe_flag:=false
-else err_print('The flag value should be "TRUE" or "FALSE"');
-@.The flag value should be...@>
-skip_to_paren;
-end
-
-@ @<Read an indexed header word@>=
-begin c:=get_byte;
-if c<18 then skip_error('HEADER indices should be 18 or more')
-@.HEADER indices...@>
-else if 4*c+4>max_header_bytes then
- skip_error('This HEADER index is too big for my present table size')
-@.This HEADER index is too big...@>
-else begin
- while header_ptr<4*c+4 do begin
- header_bytes[header_ptr]:=0; incr(header_ptr);
- end;
- read_four_bytes(4*c);
- end;
-end
-
-@ The remaining kinds of font property values that need to be read are
-those that involve property lists on higher levels. Each of these has a
-loop similar to the one that was used at level zero. Then we put the
-right parenthesis back so that `|finish_the_property|' will be happy;
-there is probably a more elegant way to do this.
-
-@d finish_inner_property_list==begin decr(loc); incr(level); cur_char:=")";
- end
-
-@<Read font parameter list@>=
-begin while level=1 do
- begin while cur_char=" " do get_next;
- if cur_char="(" then @<Read a parameter value@>
- else if cur_char=")" then skip_to_end_of_item
- else junk_error;
- end;
-finish_inner_property_list;
-end
-
-@ @<Read a parameter value@>=
-begin get_name;
-if cur_code=comment_code then skip_to_end_of_item
-else if (cur_code<parameter_code)or(cur_code>=char_wd_code) then
- flush_error('This property name doesn''t belong in a FONTDIMEN list')
-@.This property name doesn't belong...@>
-else begin if cur_code=parameter_code then c:=get_integer
- else c:=cur_code-parameter_code;
- if c=0 then flush_error('PARAMETER index must not be zero')
-@.PARAMETER index must not...@>
- else if c>max_param_words then
- flush_error('This PARAMETER index is too big for my present table size')
-@.This PARAMETER index is too big...@>
- else begin
- while np<c do begin
- incr(np); param[np]:=0;
- end;
- param[c]:=get_fix;
- finish_the_property;
- end;
- end;
-end
-
-@ @<Read a local font list@>=
-begin font_number[font_ptr]:=get_integer; cur_font:=0;
-while font_number[font_ptr]<>font_number[cur_font] do incr(cur_font);
-if cur_font=font_ptr then {it's a new font number}
- if font_ptr<xmax_font then @<Initialize a new local font@>
- else err_print('Sorry, too many different mapfonts');
-@.Sorry, too many different mapfonts@>
-if cur_font=font_ptr then skip_to_end_of_item
-else while level=1 do begin
- while cur_char=" " do get_next;
- if cur_char="(" then @<Read a local font property@>
- else if cur_char=")" then skip_to_end_of_item
- else junk_error;
- end;
-finish_inner_property_list;
-end
-
-@ @<Initialize a new local font@>=
-begin incr(font_ptr);
-fname_start[cur_font]:=vf_size; fname_length[cur_font]:=4; {\.{NULL}}
-farea_start[cur_font]:=vf_size; farea_length[cur_font]:=0;
-font_checksum[cur_font]:=zero_bytes;
-font_at[cur_font]:=@'4000000; {denotes design size of this virtual font}
-font_dsize[cur_font]:=@'50000000; {the |fix_word| for 10}
-end
-
-@ @<Read a local font property@>=
-begin get_name;
-if cur_code=comment_code then skip_to_end_of_item
-else if (cur_code<font_name_code)or(cur_code>font_dsize_code) then
- flush_error('This property name doesn''t belong in a MAPFONT list')
-@.This property name doesn't belong...@>
-else begin
- case cur_code of
- font_name_code:@<Read a local font name@>;
- font_area_code:@<Read a local font area@>;
- font_checksum_code:begin
- get_four_bytes; font_checksum[cur_font]:=cur_bytes;
- end;
- font_at_code: begin frozen_du:=true;
- if design_units=unity then font_at[cur_font]:=get_fix
- else font_at[cur_font]:=round((get_fix/design_units)*1048576.0);
- end;
- font_dsize_code:font_dsize[cur_font]:=get_fix;
- end; {there are no other cases}
- finish_the_property;
- end;
-end
-
-@ @<Read a local font name@>=
-begin fname_start[cur_font]:=vf_ptr; copy_to_end_of_item;
-if vf_ptr>fname_start[cur_font]+255 then begin
- err_print('FONTNAME clipped to 255 characters');
-@.FONTNAME clipped...@>
- fname_length[cur_font]:=255;
- end
-else fname_length[cur_font]:=vf_ptr-fname_start[cur_font];
-end
-
-@ @<Read a local font area@>=
-begin farea_start[cur_font]:=vf_ptr; copy_to_end_of_item;
-if vf_ptr>farea_start[cur_font]+255 then begin
- err_print('FONTAREA clipped to 255 characters');
-@.FONTAREA clipped...@>
- farea_length[cur_font]:=255;
- end
-else farea_length[cur_font]:=vf_ptr-farea_start[cur_font];
-end
-
-@ @<Read ligature/kern list@>=
-begin lk_step_ended:=false;
-while level=1 do
- begin while cur_char=" " do get_next;
- if cur_char="(" then read_lig_kern_command
- else if cur_char=")" then skip_to_end_of_item
- else junk_error;
- end;
-finish_inner_property_list;
-end
-
-@ @<Read a ligature/kern command@>=
-begin get_name;
-if cur_code=comment_code then skip_to_end_of_item
-else if (cur_code>=label_code) and (cur_code<=(lig_code+11)) then begin
- case cur_code of
- label_code:@<Read a label step@>;
- stop_code:@<Read a stop step@>;
- skip_code:@<Read a skip step@>;
- krn_code:@<Read a kerning step@>;
- lig_code,lig_code+1,lig_code+2,lig_code+3,lig_code+5,lig_code+6,
- lig_code+7,lig_code+11:@<Read a ligature step@>;
- end; {there are no other cases |>=label_code|}
- finish_the_property;
- end
-else if (cur_code>=clabel_code) and (cur_code<=cpenglue_code) then begin
- case cur_code of
- clabel_code:@<Read an extended label step@>;
- cpen_code:@<Read an extended penalty step@>;
- cglue_code:@<Read an extended glue step@>;
- cpenglue_code:@<Read an extended penalty/glue step@>;
- ckrn_code:@<Read an extended kern step@>;
- end; {there are no other cases |>=label_code|}
- finish_the_property;
- end
-else flush_error('This property name doesn''t belong in a LIGTABLE list');
-@.This property name doesn't belong...@>
-end
-
-@ When a character is about to be tagged, we call the following
-procedure so that an error message is given in case of multiple tags.
-
-@p procedure check_tag(c:byte); {print error if |c| already tagged}
-begin case char_tag[c] of
-no_tag: do_nothing;
-lig_tag: err_print('This character already appeared in a LIGTABLE LABEL');
-@.This character already...@>
-list_tag: err_print('This character already has a NEXTLARGER spec');
-ext_tag: err_print('This character already has a VARCHAR spec');
-end;
-end;
-
-@ @<Read a label step@>=
-begin while cur_char=" " do get_next;
-if cur_char="B" then begin
- bchar_label:=nl; skip_to_paren; {\.{LABEL BOUNDARYCHAR}}
- end
-else begin
- backup; c:=get_byte;
- check_tag(c); char_tag[c]:=lig_tag; char_remainder[c]:=nl;
- end;
-if min_nl<=nl then min_nl:=nl+1;
-lk_step_ended:=false;
-end
-
-@ @d stop_flag=128 {value indicating `\.{STOP}' in a lig/kern program}
-@d kern_flag=128 {op code for a kern step}
-
-@<Globals...@>=
-@!lk_step_ended:boolean;
- {was the last \.{LIGTABLE} property \.{LIG} or \.{KRN}?}
-@!krn_ptr:0..max_kerns; {an index into |kern|}
-
-@ @<Read a stop step@>=
-if not lk_step_ended then
- err_print('STOP must follow LIG or KRN')
-@.STOP must follow LIG or KRN@>
-else begin
- lig_kern[nl-1].b0:=lig_kern[nl-1].b0 div 256 * 256 + stop_flag;
- lk_step_ended:=false;
- end
-
-@ @<Read a skip step@>=
-if not lk_step_ended then
- err_print('SKIP must follow LIG or KRN')
-@.SKIP must follow LIG or KRN@>
-else begin
- c:=get_byte;
- if c>=128 then err_print('Maximum SKIP amount is 127')
-@.Maximum SKIP amount...@>
- else if nl+c>=max_lig_steps then
- err_print('Sorry, LIGTABLE too long for me to handle')
-@.Sorry, LIGTABLE too long...@>
- else begin
- lig_kern[nl-1].b0:=c;
- if min_nl<=nl+c then min_nl:=nl+c+1;
- end;
- lk_step_ended:=false;
- end
-
-@ @<Read a ligature step@>=
-begin lig_kern[nl].b0:=0;
-lig_kern[nl].b2:=cur_code-lig_code;
-lig_kern[nl].b1:=get_byte;
-lig_kern[nl].b3:=get_byte;
-if nl>=max_lig_steps-1 then
- err_print('Sorry, LIGTABLE too long for me to handle')
-@.Sorry, LIGTABLE too long...@>
-else incr(nl);
-lk_step_ended:=true;
-end
-
-@ @<Read a kerning step@>=
-begin lig_kern[nl].b0:=0; lig_kern[nl].b1:=get_byte;
-kern[nk]:=get_fix; krn_ptr:=0;
-while kern[krn_ptr]<>kern[nk] do incr(krn_ptr);
-if krn_ptr=nk then begin
- if nk<max_kerns then incr(nk)
- else begin
- err_print('Sorry, too many different kerns for me to handle');
-@.Sorry, too many different kerns...@>
- decr(krn_ptr);
- end;
- end;
-if ofm_level=-1 then begin
- lig_kern[nl].b2:=kern_flag+(krn_ptr div 256);
- lig_kern[nl].b3:=krn_ptr mod 256;
- end
-else begin
- lig_kern[nl].b2:=kern_flag+(krn_ptr div 65536);
- lig_kern[nl].b3:=krn_ptr mod 65536;
- end;
-if nl>=max_lig_steps-1 then
- err_print('Sorry, LIGTABLE too long for me to handle')
-@.Sorry, LIGTABLE too long...@>
-else incr(nl);
-lk_step_ended:=true;
-end
-
-@ @<Global...@>=
-@!category_remainders:array[0..256] of integer;
-@!ivalue_category,@!max_ivalue_category:integer;
-@!glue_category,@!max_glue_category:integer;
-@!penalty_category,@!max_penalty_category:integer;
-
-@ @<Set init...@>=
-for ivalue_category:=0 to 256 do begin
- category_remainders[ivalue_category]:=-1;
-end;
-max_ivalue_category:=-1;
-max_glue_category:=-1;
-max_penalty_category:=-1;
-
-@ @<Read an extended label step@>=
-begin
-c:=get_byte;
-category_remainders[c]:=nl;
-if max_ivalue_category<c then max_ivalue_category:=c;
-if min_nl<=nl then min_nl:=nl+1;
-lk_step_ended:=false;
-end
-
-@ @<Read an extended penalty step@>=
-begin lig_kern[nl].b0:=256; lig_kern[nl].b1:=get_byte;
-lig_kern[nl].b2:=17;
-penalty_category:=get_byte;
-if max_penalty_category<penalty_category then
- max_penalty_category:=penalty_category;
-lig_kern[nl].b3:=penalty_category;
-if nl>=max_lig_steps-1 then
- err_print('Sorry, LIGTABLE too long for me to handle')
-@.Sorry, LIGTABLE too long...@>
-else incr(nl);
-lk_step_ended:=true;
-end
-
-@ @<Read an extended glue step@>=
-begin lig_kern[nl].b0:=256; lig_kern[nl].b1:=get_byte;
-lig_kern[nl].b2:=18;
-glue_category:=get_byte;
-if max_glue_category<glue_category then
- max_glue_category:=glue_category;
-lig_kern[nl].b3:=glue_category;
-if nl>=max_lig_steps-1 then
- err_print('Sorry, LIGTABLE too long for me to handle')
-@.Sorry, LIGTABLE too long...@>
-else incr(nl);
-lk_step_ended:=true;
-end
-
-@ @<Read an extended penalty/glue step@>=
-begin lig_kern[nl].b0:=256; lig_kern[nl].b1:=get_byte;
-lig_kern[nl].b2:=19;
-penalty_category:=get_byte;
-if max_penalty_category<penalty_category then
- max_penalty_category:=penalty_category;
-glue_category:=get_byte;
-if max_glue_category<glue_category then
- max_glue_category:=glue_category;
-lig_kern[nl].b3:=penalty_category*256+glue_category;
-if nl>=max_lig_steps-1 then
- err_print('Sorry, LIGTABLE too long for me to handle')
-@.Sorry, LIGTABLE too long...@>
-else incr(nl);
-lk_step_ended:=true;
-end
-
-@ @<Read an extended kern step@>=
-begin lig_kern[nl].b0:=256; lig_kern[nl].b1:=get_byte;
-lig_kern[nl].b2:=20;
-kern[nk]:=get_fix; krn_ptr:=0;
-while kern[krn_ptr]<>kern[nk] do incr(krn_ptr);
-if krn_ptr=nk then begin
- if nk<max_kerns then incr(nk)
- else begin
- err_print('Sorry, too many different kerns for me to handle');
-@.Sorry, too many different kerns...@>
- decr(krn_ptr);
- end;
- end;
-if krn_ptr>65535 then
- err_print('Sorry, too many different kerns for me to handle');
-lig_kern[nl].b3:=krn_ptr;
-if nl>=max_lig_steps-1 then
- err_print('Sorry, LIGTABLE too long for me to handle')
-@.Sorry, LIGTABLE too long...@>
-else incr(nl);
-lk_step_ended:=true;
-end
-
-@ @<Globals...@>=
-@!char_extended_tag:array [char_type] of boolean;
-
-@ @<Set init...@>=
-for c:=0 to max_char do
- char_extended_tag[c]:=false;
-
-@ @<Finish up the extended font stuff@>=
-begin
-if max_penalty_category>0 then begin
- if nkp=0 then
- err_print('No PENALTY table')
- else if npp[0]<max_penalty_category then
- err_print('Not enough PENALTY entries');
- end;
-if max_glue_category>0 then begin
- if nkg=0 then
- err_print('No GLUE table')
- else if npg[0]<max_glue_category then
- err_print('Not enough GLUE entries');
- end;
-if max_ivalue_category>0 then begin
- if nki=0 then
- err_print('No IVALUE table')
- else if npi[0]<max_ivalue_category then
- err_print('Not enough IVALUE entries')
- else begin
- for c:=0 to max_char do begin
- if (char_wd[c]<>0) then begin
- for j:=0 to max_ivalue_category do
- if char_table[c,0]=j then begin
- if category_remainders[j]<>-1 then begin
- if char_tag[c]<>0 then
- err_print('Character already has a tag')
- else begin
- char_extended_tag[c]:=true;
- char_remainder[c]:=category_remainders[j];
- end;
- end;
- end;
- end;
- end;
- end;
- end;
-end
-
-@ @<Global...@>=
-tables_read:boolean;
-
-@ @<Set init...@>=
-tables_read:=false;
-
-@ Finally we come to the part of \.{VPtoVF}'s input mechanism
-that is used most, the processing of individual character data.
-
-@<Read character info list@>=
-begin
-if not tables_read then begin
- @<Compute the new header information for OFM files@>;
- tables_read:=true;
- end;
-c:=get_byte; {read the character code that is being specified}
-@<Print |c| in hex notation@>;
-while level=1 do begin
- while cur_char=" " do get_next;
- if cur_char="(" then read_character_property
- else if cur_char=")" then skip_to_end_of_item
- else junk_error;
- end;
-if char_wd[c]=0 then char_wd[c]:=sort_in(width,0); {legitimatize |c|}
-finish_inner_property_list;
-end
-
-@ @<Globals...@>=
-@!char_original:array [0..max_char] of integer;
-@!char_repeats:array [0..max_char] of integer;
-@!diff:boolean;
-@!needed_space,@!extra_bytes:integer;
-
-@ @<Set init...@>=
-for ch_entry:=0 to max_char do begin
- char_original[ch_entry]:=ch_entry;
- char_repeats[ch_entry]:=0;
- end;
-
-@ @<Read repeated character info@>=
-begin
-if not tables_read then begin
- compute_new_header_ofm;
- tables_read:=true;
- end;
-c:=get_byte; {read the character code that is being specified}
-@<Print |c| in hex notation@>;
-crange:=get_byte; {read how many characters are being defined}
-if (crange<0) then begin
- err_print('Character ranges must be positive');
- crange:=0;
- end;
-if ((c+crange)>max_char) then begin
- err_print('Character range too large');
- crange:=0;
- end;
-print('-'); print_hex(c+crange);
-while level=1 do begin
- while cur_char=" " do get_next;
- if cur_char="(" then read_character_property
- else if cur_char=")" then skip_to_end_of_item
- else junk_error;
- end;
-if char_wd[c]=0 then char_wd[c]:=sort_in(width,0); {legitimatize |c|}
-finish_inner_property_list;
-cprime:=c;
-for c:=(cprime+1) to (cprime+crange) do begin
- char_wd[c]:=char_wd[cprime];
- char_ht[c]:=char_ht[cprime];
- char_dp[c]:=char_dp[cprime];
- char_ic[c]:=char_ic[cprime];
- for tab:=0 to (nki+nkf+nkr+nkg+nkp-1) do begin
- char_table[c,tab]:= char_table[cprime,tab];
- end;
- end;
-end
-
-@ Tables for character parameters
-
-@d char_param_tables==8
-
-@<Globals...@>=
-@!char_table:array [0..max_char,0..char_param_tables] of integer;
-@!ch_table,@!ch_entry:integer;
-@!temp_value:integer;
-
-@ @<Set init...@>=
-for c:=0 to max_char do
- for ch_table:=0 to char_param_tables do
- char_table[c,ch_table]:=0;
-
-@ @<Read a character property@>=
-begin get_name;
-if cur_code=comment_code then skip_to_end_of_item
-else if (cur_code<char_wd_code) or
- ((cur_code>var_char_code) and not
- ((cur_code>=char_ivalue_code) and (cur_code<=char_penalty_code)))
- then
- flush_error('This property name doesn''t belong in a CHARACTER list')
-@.This property name doesn't belong...@>
-else begin
- case cur_code of
- char_wd_code:char_wd[c]:=sort_in(width,get_fix);
- char_ht_code:char_ht[c]:=sort_in(height,get_fix);
- char_dp_code:char_dp[c]:=sort_in(depth,get_fix);
- char_ic_code:char_ic[c]:=sort_in(italic,get_fix);
- sec_width_code:temp_value:=get_fix;
- sec_height_code:temp_value:=get_fix;
- sec_depth_code:temp_value:=get_fix;
- sec_italic_code:temp_value:=get_fix;
- accent_code:temp_value:=get_fix;
- prim_top_axis_code:temp_value:=get_fix;
- prim_top_axis_bis_code:temp_value:=get_fix;
- prim_bot_axis_code:temp_value:=get_fix;
- prim_bot_axis_bis_code:temp_value:=get_fix;
- prim_mid_hor_code:temp_value:=get_fix;
- prim_mid_vert_code:temp_value:=get_fix;
- prim_base_slant_code:temp_value:=get_fix;
- sec_top_axis_code:temp_value:=get_fix;
- sec_top_axis_bis_code:temp_value:=get_fix;
- sec_bot_axis_code:temp_value:=get_fix;
- sec_bot_axis_bis_code:temp_value:=get_fix;
- sec_mid_hor_code:temp_value:=get_fix;
- sec_mid_vert_code:temp_value:=get_fix;
- sec_base_slant_code:temp_value:=get_fix;
- next_larger_code:begin check_tag(c); char_tag[c]:=list_tag;
- char_remainder[c]:=get_byte;
- end;
- map_code:read_packet(c);
- var_char_code:@<Read an extensible recipe for |c|@>;
- char_ivalue_code: begin
- ch_table:=get_integer;
- ch_entry:=get_integer;
- char_table[c,ch_table]:=ch_entry;
- if ch_table>nkci then nkci:=ch_table;
- end;
- char_fvalue_code: begin
- ch_table:=get_integer+nki;
- ch_entry:=get_integer;
- char_table[c,ch_table]:=ch_entry;
- if ch_table>nkcf then nkcf:=ch_table;
- end;
- char_mvalue_code: begin
- ch_table:=get_integer+nki+nkf;
- ch_entry:=get_integer;
- char_table[c,ch_table]:=ch_entry;
- if ch_table>nkcm then nkcm:=ch_table;
- end;
- char_rule_code: begin
- ch_table:=get_integer+nki+nkf+nkm;
- ch_entry:=get_integer;
- char_table[c,ch_table]:=ch_entry;
- if ch_table>nkcr then nkcr:=ch_table;
- end;
- char_glue_code: begin
- ch_table:=get_integer+nki+nkf+nkm+nkr;
- ch_entry:=get_integer;
- char_table[c,ch_table]:=ch_entry;
- if ch_table>nkcg then nkcg:=ch_table;
- end;
- char_penalty_code: begin
- ch_table:=get_integer+nki+nkf+nkm+nkr+nkg;
- ch_entry:=get_integer;
- char_table[c,ch_table]:=ch_entry;
- if ch_table>nkcp then nkcp:=ch_table;
- end;
- end;@/
- finish_the_property;
- end;
-end
-
-@ @<Read an extensible r...@>=
-begin if ne=xmax_char then
- err_print('Sorry, too many VARCHAR specs')
-@.Sorry, too many VARCHAR specs@>
-else begin
- check_tag(c); char_tag[c]:=ext_tag; char_remainder[c]:=ne;@/
- exten[ne]:=zero_bytes;
- while level=2 do begin
- while cur_char=" " do get_next;
- if cur_char="(" then @<Read an extensible piece@>
- else if cur_char=")" then skip_to_end_of_item
- else junk_error;
- end;
- incr(ne);
- finish_inner_property_list;
- end;
-end
-
-@ @<Read an extensible p...@>=
-begin get_name;
-if cur_code=comment_code then skip_to_end_of_item
-else if (cur_code<var_char_code+1)or(cur_code>var_char_code+4) then
- flush_error('This property name doesn''t belong in a VARCHAR list')
-@.This property name doesn't belong...@>
-else begin
- case cur_code-(var_char_code+1) of
- 0:exten[ne].b0:=get_byte;
- 1:exten[ne].b1:=get_byte;
- 2:exten[ne].b2:=get_byte;
- 3:exten[ne].b3:=get_byte;
- end;@/
- finish_the_property;
- end;
-end
-
-@ The input routine is now complete except for the following code,
-which prints a progress report as the file is being read.
-
-@ @<Glob...@>=
-@!HEX: packed array [1..32] of char;
-
-@ @<Set init...@>=
-HEX:='0123456789ABCDEF';@/
-
-@ The array |dig| will hold a sequence of digits to be output.
-
-@<Glob...@>=
-@!dig:array[0..32] of integer;
-
-@ Here, in fact, are two procedures that output
-|dig[j-1]|$\,\ldots\,$|dig[0]|, given $j>0$.
-
-@p procedure out_digs(j:integer); {outputs |j| digits}
-begin repeat decr(j); out(HEX[1+dig[j]]);
- until j=0;
-end;
-@#
-procedure print_digs(j:integer); {prints |j| digits}
-begin repeat decr(j); print(HEX[1+dig[j]]);
- until j=0;
-end;
-
-@ The |print_number| procedure indicates how |print_digs| can be used.
-This procedure can print in octal, decimal or hex notation.
-
-@d print_hex(#)==print_number(#,16)
-@d print_octal(#)==print_number(#,8)
-@d print_decimal(#)==print_number(#,10)
-
-@p procedure print_number(c:integer; form:integer); {prints value of
-|c|}
-var j:0..32; {index into |dig|}
-begin
-j:=0;
-if (c<0) then begin
- print_ln('Internal error: print_number (negative value)');
- c:=0;
- end;
-if form=8 then
- print('''') {an apostrophe indicates the octal notation}
-else if form=16 then
- print('"') { a double apostrophe indicates the hexadecimal
-notation}
-else if form<>10 then begin
- print_ln('Internal error: print_number (form)');
- form:=16;
- end;
-while (c>0) or (j=0) do begin
- dig[j]:=c mod form; c:=c div form;
- j:=j+1;
- end;
-print_digs(j);
-end;
-
-@ @<Print |c| in hex...@>=
-begin if chars_on_line=8 then begin
- print_ln(' '); chars_on_line:=1;
- end
-else begin
- if chars_on_line>0 then print(' ');
- incr(chars_on_line);
- end;
-print_hex(c); {progress report}
-end
-
-
-@* Assembling the mappings.
-Each \.{MAP} property is a sequence of \.{DVI} instructions, for which
-we need to know some of the opcodes.
-We add afterwards the definitions for outputting typesetting commands.
-
-@d set_char_0=0 {\.{DVI} command to typeset character 0 and move right}
-@d set1=128 {typeset a character and move right}
-@d set_rule=132 {typeset a rule and move right}
-@d push=141 {save the current positions}
-@d pop=142 {restore previous positions}
-@d right1=143 {move right}
-@d w0=147 {move right by |w|}
-@d w1=148 {move right and set |w|}
-@d x0=152 {move right by |x|}
-@d x1=153 {move right and set |x|}
-@d down1=157 {move down}
-@d y0=161 {move down by |y|}
-@d y1=162 {move down and set |y|}
-@d z0=166 {move down by |z|}
-@d z1=167 {move down and set |z|}
-@d fnt_num_0=171 {set current font to 0}
-@d fnt1=235 {set current font}
-@d xxx1=239 {extension to \.{DVI} primitives}
-@d xxx4=242 {potentially long extension to \.{DVI} primitives}
-@d fnt_def1=243 {define the meaning of a font number}
-@d pre=247 {preamble}
-@d post=248 {postamble beginning}
-@d Incr_Decr(#) == #
-@d Incr(#) == #:=#+Incr_Decr {increase a variable}
-
-@d out_four(#) ==
-if x>=0 then #(x div @"1000000)
-else begin Incr(x)(@"40000000); Incr(x)(@"40000000);
- #((x div @"1000000) + 128);
- end;
-x:=x mod @"1000000; #(x div @"10000);
-x:=x mod @"10000; #(x div @"100);
-#(x mod @"100)
-
-@d out_cmd(#) ==
-if (x<@"100)and(x>=0) then begin
- if (o<>set1)or(x>127) then
- if (o=fnt1)and(x<64) then Incr(x)(fnt_num_0) @+ else #(o);
- end
-else begin
- if (x<@"10000)and(x>=0) then #(o+1) @+ else begin
- if (x<@"1000000)and(x>=0) then #(o+2) @+ else begin
- #(o+3);
- if x>=0 then #(x div @"1000000)
- else begin
- Incr(x)(@"40000000); Incr(x)(@"40000000);
- #((x div @"1000000) + 128); x:=x mod @"1000000;
- end;
- #(x div @"10000); x:=x mod @"10000;
- end;
- #(x div @"10000); x:=x mod @"10000;
- end;
- #(x div @"100); x:=x mod @"100;
- end;
-#(x)
-
-@p
-procedure vf_store_set(@!x:integer);
-var @!o:byte;
-begin o:=set1; out_cmd(vf_store);
-end;
-
-procedure vfout_set(@!x:integer);
-var @!o:byte;
-begin o:=set1; out_cmd(vout);
-end;
-
-procedure vf_store_fnt(@!x:integer);
-var @!o:byte;
-begin o:=fnt1; out_cmd(vf_store);
-end;
-
-procedure vfout_fntdef(@!x:integer);
-var @!o:byte;
-begin o:=fnt_def1; out_cmd(vout);
-end;
-
-procedure vfout_char(@!x:integer);
-begin out_four(vout);
-end;
-
-
-@ We keep stacks of movement values, in order to optimize the \.{DVI} code
-in simple cases.
-
-@<Glob...@>=
-@!hstack:array[0..max_stack] of 0..2; {number of known horizontal movements}
-@!vstack:array[0..max_stack] of 0..2; {number of known vertical movements}
-@!wstack,@!xstack,@!ystack,@!zstack:array[0..max_stack] of fix_word;
-@!stack_ptr:0..max_stack;
-
-@ The packet is built by straightforward assembly of \.{DVI} instructions.
-
-@p @<Declare the |vf_fix| procedure@>@;@/
-procedure read_packet(@!c:byte);
-var @!cc:char_type; {character being typeset}
-@!x:fix_word; {movement}
-@!h,@!v:0..2; {top of |hstack| and |vstack|}
-@!special_start:0..vf_size; {location of |xxx1| command}
-@!k:0..vf_size; {loop index}
-begin packet_start[c]:=vf_ptr; stack_ptr:=0; h:=0; v:=0;
-cur_font:=0;
-while level=2 do begin
- while cur_char=" " do get_next;
- if cur_char="(" then @<Read and assemble a list of \.{DVI} commands@>
- else if cur_char=")" then skip_to_end_of_item
- else junk_error;
- end;
-while stack_ptr>0 do begin
- err_print('Missing POP supplied');
-@.Missing POP supplied@>
- vf_store(pop); decr(stack_ptr);
- end;
-packet_length[c]:=vf_ptr-packet_start[c];
-finish_inner_property_list;
-end;
-
-@ @<Read and assemble a list of \.{DVI}...@>=
-begin get_name;
-if cur_code=comment_code then skip_to_end_of_item
-else if (cur_code<select_font_code)or(cur_code>special_hex_code) then
- flush_error('This property name doesn''t belong in a MAP list')
-@.This property name doesn't belong...@>
-else begin
- case cur_code of
- select_font_code:@<Assemble a font selection@>;
- set_char_code:@<Assemble a typesetting instruction@>;
- set_rule_code:@<Assemble a rulesetting instruction@>;
- move_right_code,move_right_code+1:@<Assemble a horizontal movement@>;
- move_down_code,move_down_code+1:@<Assemble a vertical movement@>;
- push_code:@<Assemble a stack push@>;
- pop_code:@<Assemble a stack pop@>;
- special_code,special_hex_code:@<Assemble a special command@>;
- end;@/
- finish_the_property;
- end;
-end
-
-@ @<Assemble a font selection@>=
-begin font_number[font_ptr]:=get_integer;
-cur_font:=0;
-while font_number[font_ptr]<>font_number[cur_font] do incr(cur_font);
-if cur_font=font_ptr then err_print('Undefined MAPFONT cannot be selected')
-@.Undefined MAPFONT...@>
-else vf_store_fnt(cur_font);
-end
-
-@ @<Assemble a typesetting instruction@>=
-if cur_font=font_ptr then
- err_print('Character cannot be typeset in undefined font')
-@.Character cannot be typeset...@>
-else begin
- cc:=get_byte; vf_store_set(cc);
- end
-
-@ Here's a procedure that converts a |fix_word| to a sequence of
-\.{DVI} bytes.
-
-@<Declare the |vf_fix|...@>=
-procedure vf_fix(@!opcode:byte;@!x:fix_word);
-var negative:boolean;
-@!k:0..4; {number of bytes to typeset}
-@!t:integer; {threshold}
-begin frozen_du:=true;
-if design_units<>unity then x:=round((x/design_units)*1048576.0);
-if x>0 then negative:=false
-else begin negative:=true; x:=-1-x;@+end;
-if opcode=0 then begin
- k:=4; t:=@'100000000;@+end
-else begin
- t:=127; k:=1;
- while x>t do begin
- t:=256*t+255; incr(k);
- end;
- vf_store(opcode+k-1); t:=t div 128 +1;
- end;
-repeat if negative then begin
- vf_store(255-(x div t)); negative:=false;
- x:=(x div t)*t+t-1-x;
- end
-else vf_store((x div t) mod 256);
-decr(k); t:=t div 256;
-until k=0;
-end;
-
-@ @<Assemble a rulesetting instruction@>=
-begin vf_store(set_rule); vf_fix(0,get_fix); vf_fix(0,get_fix);
-end
-
-@ @<Assemble a horizontal movement@>=
-begin if cur_code=move_right_code then x:=get_fix@+else x:=-get_fix;
-if h=0 then begin
- wstack[stack_ptr]:=x; h:=1; vf_fix(w1,x);@+end
-else if x=wstack[stack_ptr] then vf_store(w0)
-else if h=1 then begin
- xstack[stack_ptr]:=x; h:=2; vf_fix(x1,x);@+end
-else if x=xstack[stack_ptr] then vf_store(x0)
-else vf_fix(right1,x);
-end
-
-@ @<Assemble a vertical movement@>=
-begin if cur_code=move_down_code then x:=get_fix@+else x:=-get_fix;
-if v=0 then begin
- ystack[stack_ptr]:=x; v:=1; vf_fix(y1,x);@+end
-else if x=ystack[stack_ptr] then vf_store(y0)
-else if v=1 then begin
- zstack[stack_ptr]:=x; v:=2; vf_fix(z1,x);@+end
-else if x=zstack[stack_ptr] then vf_store(z0)
-else vf_fix(down1,x);
-end
-
-@ @<Assemble a stack push@>=
-if stack_ptr=max_stack then {too pushy}
- err_print('Don''t push so much---stack is full!')
-@.Don't push so much...@>
-else begin
- vf_store(push); hstack[stack_ptr]:=h; vstack[stack_ptr]:=v;
- incr(stack_ptr); h:=0; v:=0;
- end
-
-@ @<Assemble a stack pop@>=
-if stack_ptr=0 then
- err_print('Empty stack cannot be popped')
-@.Empty stack...@>
-else begin
- vf_store(pop); decr(stack_ptr);
- h:=hstack[stack_ptr]; v:=vstack[stack_ptr];
- end
-
-@ @<Assemble a special command@>=
-begin vf_store(xxx1); vf_store(0); {dummy length}
-special_start:=vf_ptr;
-if cur_code=special_code then copy_to_end_of_item
-else begin
- repeat x:=get_hex;
- if cur_char>")" then vf_store(x*16+get_hex);
- until cur_char<=")";
- end;
-if vf_ptr-special_start>255 then @<Convert |xxx1| command to |xxx4|@>
-else vf[special_start-1]:=vf_ptr-special_start;
-end
-
-@ @<Convert |xxx1|...@>=
-if vf_ptr+3>vf_size then begin
- err_print('Special command being clipped---no room left!');
-@.Special command being clipped...@>
- vf_ptr:=special_start+255; vf[special_start-1]:=255;
- end
-else begin
- for k:=vf_ptr downto special_start do vf[k+3]:=vf[k];
- x:=vf_ptr-special_start; vf_ptr:=vf_ptr+3;
- vf[special_start-2]:=xxx4;
- vf[special_start-1]:=x div @'100000000;
- vf[special_start]:=(x div @'200000) mod 256;
- vf[special_start+1]:=(x div @'400) mod 256;
- vf[special_start+2]:=x mod 256;
- end
-
-@* The checking and massaging phase.
-Once the whole \.{VPL} file has been read in, we must check it for consistency
-and correct any errors. This process consists mainly of running through
-the characters that exist and seeing if they refer to characters that
-don't exist. We also compute the true value of |seven_unsafe|; we make sure
-that the charlists and ligature programs contain no loops; and we
-shorten the lists of widths, heights, depths, and italic corrections,
-if necessary, to keep from exceeding the required maximum sizes.
-
-@<Glob...@>=
-@!seven_unsafe:boolean; {do seven-bit characters generate eight-bit ones?}
-
-@ @<Correct and check the information@>=
-if nl>0 then @<Make sure the ligature/kerning program ends appropriately@>;
-seven_unsafe:=false;
-for c:=0 to max_char do if char_wd[c]<>0 then
- @<For all characters |g| generated by |c|,
- make sure that |char_wd[g]| is nonzero, and
- set |seven_unsafe| if |c<128<=g|@>;
-if bchar_label<xmax_label then begin
- c:=xmax_char; @<Check ligature program of |c|@>;
- end;
-if seven_bit_safe_flag and seven_unsafe then
- print_ln('The font is not really seven-bit-safe!');
-@.The font is not...safe@>
-@<Check for infinite ligature loops@>;
-@<Doublecheck the lig/kern commands and the extensible recipes@>;
-finish_extended_font;
-for c:=0 to max_char do
- @<Make sure that |c| is not the largest element of a charlist cycle@>;
-@<Put the width, height, depth, and italic lists into final form@>
-
-@ The checking that we need in several places is accomplished by three
-macros that are only slightly tricky.
-
-@d existence_tail(#)==begin char_wd[g]:=sort_in(width,0);
- print(#,' '); print_hex(c);
- print_ln(' had no CHARACTER spec.');
- end;
- end
-@d check_existence_and_safety(#)==begin g:=#;
- if (g>=128)and(c<128) then seven_unsafe:=true;
- if char_wd[g]=0 then existence_tail
-@d check_existence(#)==begin g:=#;
- if char_wd[g]=0 then existence_tail
-
-@<For all characters |g| generated by |c|...@>=
-case char_tag[c] of
-no_tag: do_nothing;
-lig_tag: @<Check ligature program of |c|@>;
-list_tag: check_existence_and_safety(char_remainder[c])
- ('The character NEXTLARGER than');
-@.The character NEXTLARGER...@>
-ext_tag:@<Check the pieces of |exten[c]|@>;
-end
-
-@ @<Check the pieces...@>=
-begin if exten[char_remainder[c]].b0>0 then
- check_existence_and_safety(exten[char_remainder[c]].b0)
- ('TOP piece of character');
-@.TOP piece of character...@>
-if exten[char_remainder[c]].b1>0 then
- check_existence_and_safety(exten[char_remainder[c]].b1)
- ('MID piece of character');
-@.MID piece of character...@>
-if exten[char_remainder[c]].b2>0 then
- check_existence_and_safety(exten[char_remainder[c]].b2)
- ('BOT piece of character');
-@.BOT piece of character...@>
-check_existence_and_safety(exten[char_remainder[c]].b3)
- ('REP piece of character');
-@.REP piece of character...@>
-end
-
-@ @<Make sure that |c| is not the largest element of a charlist cycle@>=
-if char_tag[c]=list_tag then begin
- g:=char_remainder[c];
- while (g<c)and(char_tag[g]=list_tag) do g:=char_remainder[g];
- if g=c then begin
- char_tag[c]:=no_tag;
- print('A cycle of NEXTLARGER characters has been broken at ');
-@.A cycle of NEXTLARGER...@>
- print_hex(c); print_ln('.');
- end;
- end
-
-@ @<Glob...@>=
-@!delta:fix_word; {size of the intervals needed for rounding}
-
-@ @d round_message(#)==if delta>0 then print_ln('I had to round some ',
-@.I had to round...@>
- #,'s by ',(((delta+1) div 2)/@'4000000):1:7,' units.')
-
-@<Put the width, height, depth, and italic lists into final form@>=
-case ofm_level of
- -1: begin
- top_width:=255; top_depth:=15; top_height:=15; top_italic:=63;
- end;
- 0: begin
- top_width:=65535; top_depth:=255; top_height:=255; top_italic:=255;
- end;
- 1: begin
- top_width:=65535; top_depth:=255; top_height:=255; top_italic:=255;
- end;
- end;
-delta:=shorten(width,max_width); set_indices(width,delta);
- round_message('width');@/
-delta:=shorten(height,max_height); set_indices(height,delta);
- round_message('height');@/
-delta:=shorten(depth,max_depth); set_indices(depth,delta);
- round_message('depth');@/
-delta:=shorten(italic,max_italic); set_indices(italic,delta);
- round_message('italic correction');
-
-@ @d clear_lig_kern_entry== {make an unconditional \.{STOP}}
- lig_kern[nl].b0:=255; lig_kern[nl].b1:=0;
- lig_kern[nl].b2:=0; lig_kern[nl].b3:=0
-
-@<Make sure the ligature/kerning program ends...@>=
-begin if bchar_label<xmax_label then begin {make room for it}
- clear_lig_kern_entry; incr(nl);
- end; {|bchar_label| will be stored later}
-while min_nl>nl do begin
- clear_lig_kern_entry; incr(nl);
- end;
-if (lig_kern[nl-1].b0 mod 256)=0 then
- lig_kern[nl-1].b0:=lig_kern[nl-1].b0 div 256 * 256 + stop_flag;
-end
-
-@ It's not trivial to check for infinite loops generated by repeated
-insertion of ligature characters. But fortunately there is a nice
-algorithm for such testing, copied here from the program \.{TFtoPL}
-where it is explained further.
-
-@d simple=0 {$f(x,y)=z$}
-@d left_z=1 {$f(x,y)=f(z,y)$}
-@d right_z=2 {$f(x,y)=f(x,z)$}
-@d both_z=3 {$f(x,y)=f(f(x,z),y)$}
-@d pending=4 {$f(x,y)$ is being evaluated}
-
-
-@ @<Glo...@>=
-@!lig_ptr:0..max_lig_steps; {an index into |lig_kern|}
-@!hash:array[0..hash_size] of integer;
-@!class:array[0..hash_size] of simple..pending;
-@!lig_z:array[0..hash_size] of xxchar_type;
-@!hash_ptr:0..hash_size; {the number of nonzero entries in |hash|}
-@!hash_list:array[0..hash_size] of 0..hash_size; {list of those nonzero entries}
-@!h,@!hh:0..hash_size; {indices into the hash table}
-@!tt:indx; {temporary register}
-@!x_lig_cycle,@!y_lig_cycle:xchar_type; {problematic ligature pair}
-
-@ @<Set init...@>=
-hash_ptr:=0; y_lig_cycle:=xmax_char;
-for k:=0 to hash_size do hash[k]:=0;
-
-@ @d lig_exam==lig_kern[lig_ptr].b1
-@d lig_gen==lig_kern[lig_ptr].b3
-
-@<Check lig...@>=
-begin lig_ptr:=char_remainder[c];
-repeat if hash_input(lig_ptr,c) then begin
- if lig_kern[lig_ptr].b2<kern_flag then begin
- if lig_exam<>bchar then
- check_existence(lig_exam)('LIG character examined by');
-@.LIG character examined...@>
- check_existence(lig_gen)('LIG character generated by');
-@.LIG character generated...@>
- if lig_gen>=128 then if(c<128)or(c=bchar) then
- if(lig_exam<128)or(lig_exam=bchar) then seven_unsafe:=true;
- end
- else if lig_exam<>bchar then
- check_existence(lig_exam)('KRN character examined by');
-@.KRN character examined...@>
- end;
-if (lig_kern[lig_ptr].b0 mod 256)>=stop_flag then lig_ptr:=nl
-else lig_ptr:=lig_ptr+1+lig_kern[lig_ptr].b0;
-until lig_ptr>=nl;
-end
-
-@ The |hash_input| procedure is copied from \.{TFtoPL}, but it is made
-into a boolean function that returns |false| if the ligature command
-was masked by a previous one.
-
-@p function hash_input(@!p,@!c:indx):boolean;
- {enter data for character |c| and command in location |p|, unless it isn't new}
-label 30; {go here for a quick exit}
-var @!cc:simple..both_z; {class of data being entered}
-@!zz:char_type; {function value or ligature character being entered}
-@!y:char_type; {the character after the cursor}
-@!key:integer; {value to be stored in |hash|}
-@!t:integer; {temporary register for swapping}
-begin if hash_ptr=hash_size then
- begin hash_input:=false; goto 30;@+end;
-@<Compute the command parameters |y|, |cc|, and |zz|@>;
-key:=xmax_char*c+y+1; h:=(hash_mult*(key mod hash_size)) mod hash_size;
-while hash[h]>0 do begin
- if hash[h]<=key then begin
- if hash[h]=key then begin
- hash_input:=false; goto 30; {unused ligature command}
- end;
- t:=hash[h]; hash[h]:=key; key:=t; {do ordered-hash-table insertion}
- t:=class[h]; class[h]:=cc; cc:=t; {namely, do a swap}
- t:=lig_z[h]; lig_z[h]:=zz; zz:=t;
- end;
- if h>0 then decr(h)@+else h:=hash_size;
- end;
-hash[h]:=key; class[h]:=cc; lig_z[h]:=zz;
-incr(hash_ptr); hash_list[hash_ptr]:=h;
-hash_input:=true;
-30:end;
-
-@ @<Compute the command param...@>=
-y:=lig_kern[p].b1; t:=lig_kern[p].b2; cc:=simple;
-zz:=lig_kern[p].b3;
-if t>=kern_flag then zz:=y
-else begin
- case t of
- 0,6:do_nothing; {\.{LIG},\.{/LIG>}}
- 5,11:zz:=y; {\.{LIG/>}, \.{/LIG/>>}}
- 1,7:cc:=left_z; {\.{LIG/}, \.{/LIG/>}}
- 2:cc:=right_z; {\.{/LIG}}
- 3:cc:=both_z; {\.{/LIG/}}
- end; {there are no other cases}
- end
-
-@ (More good stuff from \.{TFtoPL}.)
-
-@p function f(@!h,@!x,@!y:indx):indx; forward;@t\2@>
- {compute $f$ for arguments known to be in |hash[h]|}
-function eval(@!x,@!y:indx):indx; {compute $f(x,y)$ with hashtable lookup}
-var @!key:integer; {value sought in hash table}
-begin key:=xmax_char*x+y+1; h:=(hash_mult*(key mod hash_size)) mod hash_size;
-while hash[h]>key do
- if h>0 then decr(h)@+else h:=hash_size;
-if hash[h]<key then eval:=y {not in ordered hash table}
-else eval:=f(h,x,y);
-end;
-
-@ Pascal's beastly convention for |forward| declarations prevents us from
-saying |function f(h,x,y:indx):indx| here.
-
-@p function f;
-begin case class[h] of
- simple: do_nothing;
- left_z: begin class[h]:=pending; lig_z[h]:=eval(lig_z[h],y); class[h]:=simple;
- end;
- right_z: begin class[h]:=pending; lig_z[h]:=eval(x,lig_z[h]); class[h]:=simple;
- end;
- both_z: begin class[h]:=pending; lig_z[h]:=eval(eval(x,lig_z[h]),y);
- class[h]:=simple;
- end;
- pending: begin x_lig_cycle:=x; y_lig_cycle:=y;
- lig_z[h]:=xxmax_char; class[h]:=simple;
- end; {the value |xxmax_char| will break all cycles, since it's not in |hash|}
- end; {there are no other cases}
-f:=lig_z[h];
-end;
-
-@ @<Check for infinite...@>=
-if hash_ptr<hash_size then for hh:=1 to hash_ptr do begin
- tt:=hash_list[hh];
- if class[tt]>simple then {make sure $f$ is well defined}
- tt:=f(tt,(hash[tt]-1)div xmax_char,(hash[tt]-1)mod xmax_char);
- end;
-if(hash_ptr=hash_size)or(y_lig_cycle<xmax_char) then begin
- if hash_ptr<hash_size then begin
- print('Infinite ligature loop starting with ');
-@.Infinite ligature loop...@>
- if x_lig_cycle=xmax_char
- then print('boundary')@+else print_hex(x_lig_cycle);
- print(' and '); print_hex(y_lig_cycle); print_ln('!');
- end
- else print_ln('Sorry, I haven''t room for so many ligature/kern pairs!');
-@.Sorry, I haven't room...@>
- print_ln('All ligatures will be cleared.');
- for c:=0 to max_char do if char_tag[c]=lig_tag then begin
- char_tag[c]:=no_tag; char_remainder[c]:=0;
- end;
- nl:=0; bchar:=xmax_char; bchar_label:=xmax_label;
- end
-
-@ The lig/kern program may still contain references to nonexistent characters,
-if parts of that program are never used. Similarly, there may be extensible
-characters that are never used, because they were overridden by
-\.{NEXTLARGER}, say. This would produce an invalid \.{TFM} file; so we
-must fix such errors.
-
-@d double_check_tail(#)==@t\1@>if char_wd[0]=0
- then char_wd[0]:=sort_in(width,0);
- print('Unused ',#,' refers to nonexistent character ');
- print_hex(c); print_ln('!');
- end;
- end
-@d double_check_lig(#)==begin c:=lig_kern[lig_ptr].#;
- if char_wd[c]=0 then if c<>bchar then
- begin lig_kern[lig_ptr].#:=0; double_check_tail
-@d double_check_ext(#)==begin c:=exten[g].#;
- if c>0 then if char_wd[c]=0 then
- begin exten[g].#:=0; double_check_tail
-@d double_check_rep(#)==begin c:=exten[g].#;
- if char_wd[c]=0 then
- begin exten[g].#:=0; double_check_tail
-
-@<Doublecheck...@>=
-if nl>0 then for lig_ptr:=0 to nl-1 do
- if (lig_kern[lig_ptr].b0 div 256)=0 then begin
- if lig_kern[lig_ptr].b2<kern_flag then begin
- if lig_kern[lig_ptr].b0<255 then begin
- double_check_lig(b1)('LIG step'); double_check_lig(b3)('LIG step');
- end;
- end
- else double_check_lig(b1)('KRN step');
- end;
-@.Unused LIG step...@>
-@.Unused KRN step...@>
-if ne>0 then for g:=0 to ne-1 do begin
- double_check_ext(b0)('VARCHAR TOP');
- double_check_ext(b1)('VARCHAR MID');
- double_check_ext(b2)('VARCHAR BOT');
- double_check_rep(b3)('VARCHAR REP');
-@.Unused VARCHAR...@>
- end
-
-@* The TFM output phase.
-Now that we know how to get all of the font data correctly stored in
-\.{VPtoVF}'s memory, it only remains to write the answers out.
-
-First of all, it is convenient to have an abbreviation for output to the
-\.{TFM} file:
-
-@d out(#)==write(tfm_file,#)
-
-@p procedure out_int(@!x:integer);
-begin out_four(out);
-end;
-
-
-@ The general plan for producing \.{TFM} files is long but simple:
-
-@<Do the font metric output@>=
-compute_subfile_sizes;
-output_subfile_sizes;
-@<Output the header block@>;
-output_new_information_ofm;
-output_character_info;
-@<Output the dimensions themselves@>;
-@<Output the ligature/kern program@>;
-@<Output the extensible character recipes@>;
-@<Output the parameters@>
-
-@ A \.{TFM} file begins with 12 numbers that tell how big its subfiles are.
-We already know most of these numbers; for example, the number of distinct
-widths is |memory[width]+1|, where the $+1$ accounts for the zero width that
-is always supposed to be present. But we still should compute the beginning
-and ending character codes (|bc| and |ec|), the number of header words (|lh|),
-and the total number of words in the \.{TFM} file (|lf|).
-
-@<Gl...@>=
-@!bc:char_type; {the smallest character code in the font}
-@!ec:char_type; {the largest character code in the font}
-@!lh:char_type; {the number of words in the header block}
-@!lf:unsigned_integer; {the number of words in the entire \.{TFM} file}
-@!not_found:boolean; {has a font character been found?}
-@!temp_width:fix_word; {width being used to compute a check sum}
-@!ncw,@!nco,@!npc:integer;
-
-@ It might turn out that no characters exist at all. But \.{VPtoVF} keeps
-going and writes the \.{TFM} anyway. In this case |ec| will be~0 and |bc|
-will be~1.
-
-@<Compute the subfile sizes@>=
-case ofm_level of
- -1: begin
- lh:=header_ptr div 4;@/
- not_found:=true; bc:=0;
- while not_found do
- if (char_wd[bc]>0)or(bc=255) then not_found:=false
- else incr(bc);
- not_found:=true; ec:=255;
- while not_found do
- if (char_wd[ec]>0)or(ec=0) then not_found:=false
- else decr(ec);
- if bc>ec then bc:=1;
- incr(memory[width]); incr(memory[height]); incr(memory[depth]);
- incr(memory[italic]);@/
- @<Compute the ligature/kern program offset@>;
- lf:=6+lh+(ec-bc+1)+memory[width]+memory[height]+memory[depth]+
- memory[italic]+nl+lk_offset+nk+ne+np;
- end;
- 0: begin
- lh:=header_ptr div 4;@/
- not_found:=true; bc:=0;
- while not_found do
- if (char_wd[bc]>0)or(bc=max_char) then not_found:=false
- else incr(bc);
- not_found:=true; ec:=max_char;
- while not_found do
- if (char_wd[ec]>0)or(ec=0) then not_found:=false
- else decr(ec);
- if bc>ec then bc:=1;
- incr(memory[width]); incr(memory[height]); incr(memory[depth]);
- incr(memory[italic]);@/
- @<Compute the ligature/kern program offset@>;
- lf:=14+lh+2*(ec-bc+1)+memory[width]+memory[height]+memory[depth]+
- memory[italic]+2*nl+lk_offset+nk+2*ne+np;
- end;
- 1: begin
- lh:=header_ptr div 4;@/
- not_found:=true; bc:=0;
- while not_found do
- if (char_wd[bc]>0)or(bc=max_char) then not_found:=false
- else incr(bc);
- not_found:=true; ec:=max_char;
- while not_found do
- if (char_wd[ec]>0)or(ec=0) then not_found:=false
- else decr(ec);
- if bc>ec then bc:=1;
- incr(memory[width]); incr(memory[height]); incr(memory[depth]);
- incr(memory[italic]);@/
- @<Compute the ligature/kern program offset@>;
- @<Compute the character info size@>;
- lf:=29+lh+ncw+memory[width]+memory[height]+memory[depth]+
- memory[italic]+2*(nl+lk_offset)+nk+2*ne+np+
- nki+nwi+nkf+nwf+nkm+nwm+nkr+nwr+nkg+nwg+nkp+nwp;
- nco:=29+lh+nki+nwi+nkf+nwf+nkm+nwm+nkr+nwr+nkg+nwg+nkp+nwp;
- end;
- end;
-
-@ @d out_size(#)==out((#) div 256); out((#) mod 256)
- @d out_integer(#)==out((#) div @"1000000);
- out(((#) mod @"1000000) div @"10000);
- out(((#) mod @"10000) div @"100);
- out((#) mod @"100)
-
-@<Output the subfile sizes@>=
-case ofm_level of
- -1: begin
- out_size(lf); out_size(lh); out_size(bc); out_size(ec);
- out_size(memory[width]); out_size(memory[height]);
- out_size(memory[depth]); out_size(memory[italic]);
- out_size(nl+lk_offset); out_size(nk); out_size(ne); out_size(np);
- end;
- 0: begin
- out_integer(0);
- out_integer(lf); out_integer(lh); out_integer(bc); out_integer(ec);
- out_integer(memory[width]); out_integer(memory[height]);
- out_integer(memory[depth]); out_integer(memory[italic]);
- out_integer(nl+lk_offset); out_integer(nk);
- out_integer(ne); out_integer(np); out_integer(font_dir);
- end;
- 1: begin
- out_integer(1);
- out_integer(lf); out_integer(lh);
- out_integer(bc); out_integer(ec);
- out_integer(memory[width]); out_integer(memory[height]);
- out_integer(memory[depth]); out_integer(memory[italic]);
- out_integer(nl+lk_offset); out_integer(nk);
- out_integer(ne); out_integer(np); out_integer(font_dir);
- out_integer(nco); out_integer(ncw); out_integer(npc);
- out_integer(nki); out_integer(nwi); out_integer(nkf); out_integer(nwf);
- out_integer(nkm); out_integer(nwm); out_integer(nkr); out_integer(nwr);
- out_integer(nkg); out_integer(nwg); out_integer(nkp); out_integer(nwp);
- end;
- end;
-
-@ The routines that follow need a few temporary variables of different types.
-
-@<Gl...@>=
-@!j:0..max_header_bytes; {index into |header_bytes|}
-@!p:pointer; {index into |memory|}
-@!q:width..italic; {runs through the list heads for dimensions}
-@!par_ptr:0..max_param_words; {runs through the parameters}
-
-@ The header block follows the subfile sizes. The necessary information all
-appears in |header_bytes|, except that the design size and the seven-bit-safe
-flag must still be set.
-
-@<Output the header block@>=
-if not check_sum_specified then @<Compute the check sum@>;
-header_bytes[design_size_loc]:=design_size div @'100000000;
- {this works since |design_size>0|}
-header_bytes[design_size_loc+1]:=(design_size div @'200000) mod 256;
-header_bytes[design_size_loc+2]:=(design_size div 256) mod 256;
-header_bytes[design_size_loc+3]:=design_size mod 256;
-if not seven_unsafe then header_bytes[seven_flag_loc]:=128;
-for j:=0 to header_ptr-1 do out(header_bytes[j]);
-
-@ @<Compute the check sum@>=
-begin c0:=bc; c1:=ec; c2:=bc; c3:=ec;
-for c:=bc to ec do if char_wd[c]>0 then begin
- temp_width:=memory[char_wd[c]];
- if design_units<>unity then
- temp_width:=round((temp_width/design_units)*1048576.0);
- temp_width:=temp_width + (c+4)*@'20000000; {this should be positive}
- c0:=(c0+c0+temp_width) mod 255;
- c1:=(c1+c1+temp_width) mod 253;
- c2:=(c2+c2+temp_width) mod 251;
- c3:=(c3+c3+temp_width) mod 247;
- end;
-header_bytes[check_sum_loc]:=c0;
-header_bytes[check_sum_loc+1]:=c1;
-header_bytes[check_sum_loc+2]:=c2;
-header_bytes[check_sum_loc+3]:=c3;
-end
-
-@ @<Global...@>=
-@!tab:integer;
-
-@
-@<Compute the character info size@>=
-if ofm_level=1 then begin
- ncw:=0;
- if nkcp>-1 then
- npc:=nki+nkf+nkr+nkg+nkcp+1
- else if nkcg>-1 then
- npc:=nki+nkf+nkr+nkcg+1
- else if nkcr>-1 then
- npc:=nki+nkf+nkcr+1
- else if nkcf>-1 then
- npc:=nki+nkcf+1
- else if nkci>-1 then
- npc:=nkci+1
- else
- npc:=0;
- needed_space:=(12+npc*2) div 4;
- extra_bytes:=(needed_space*4) - (10+npc*2);
- for c:=bc to ec do begin
- if char_original[c]=c then begin
- cprime:=c+1;
- diff:=false;
- while (not diff) and (cprime<=ec) do begin
- if index[char_wd[c]]<>index[char_wd[cprime]] then diff:=true;
- if index[char_ht[c]]<>index[char_ht[cprime]] then diff:=true;
- if index[char_dp[c]]<>index[char_dp[cprime]] then diff:=true;
- if index[char_ic[c]]<>index[char_ic[cprime]] then diff:=true;
- if char_remainder[c]<>char_remainder[cprime] then diff:=true;
- for tab:=0 to npc-1 do begin
- if char_table[c,tab]<>char_table[cprime,tab] then diff:=true;
- end;
- if not diff then begin
- char_original[cprime]:=c;
- cprime:=cprime+1;
- end;
- end;
- if cprime>(c+1) then begin
- char_repeats[c]:=cprime-c-1;
- end;
- ncw:=ncw+needed_space;
- end;
- end;
- end;
-
-@ The next block contains packed |char_info|.
-
-@d out_two(#)==out((#) div 256); out((#) mod 256)
-
-@d out_three(#)==out((#) div 65536); out_two((#) mod 65536)
-
-
-@<Output the character info@>=
-index[0]:=0;
-for c:=bc to ec do
-case ofm_level of
- -1: begin
- out(index[char_wd[c]]);
- out(index[char_ht[c]]*16+index[char_dp[c]]);
- out(index[char_ic[c]]*4+char_tag[c]);
- out(char_remainder[c]);
- end;
- 0: begin
- out(index[char_wd[c]] div 256); out(index[char_wd[c]] mod 256);
- out(index[char_ht[c]]); out(index[char_dp[c]]);
- out(index[char_ic[c]] div 64);out((index[char_ic[c]] mod 64)*4+char_tag[c]);
- out(char_remainder[c] div 256); out(char_remainder[c] mod 256);
- end;
- 1: begin
- if c=char_original[c] then begin
- out(index[char_wd[c]] div 256); out(index[char_wd[c]] mod 256);
- out(index[char_ht[c]]); out(index[char_dp[c]]);
- out(index[char_ic[c]]);
- tab:=char_tag[c];
- if char_extended_tag[c] then begin
- tab:=5;
- end;
- out(tab);
- out(char_remainder[c] div 256); out(char_remainder[c] mod 256);
- out_size(char_repeats[c]);
- for tab:=0 to npc-1 do begin
- out(char_table[c,tab] div 256); out(char_table[c,tab] mod 256);
- end;
- for tab:=1 to extra_bytes do begin
- out(0);
- end;
- end;
- end;
- end;
-
-@ When a scaled quantity is output, we may need to divide it by |design_units|.
-The following subroutine takes care of this, using floating point arithmetic
-only if |design_units<>1.0|.
-
-@p procedure out_scaled(x:fix_word); {outputs a scaled |fix_word|}
-var @!n:byte; {the first byte after the sign}
-@!m:0..65535; {the two least significant bytes}
-begin if abs(x/design_units)>=16.0 then begin
- print_ln('The relative dimension ',x/@'4000000:1:3,
- ' is too large.');
-@.The relative dimension...@>
- print(' (Must be less than 16*designsize');
- if design_units<>unity then print(' =',design_units/@'200000:1:3,
- ' designunits');
- print_ln(')'); x:=0;
- end;
-if design_units<>unity then x:=round((x/design_units)*1048576.0);
-if x<0 then begin
- out(255); x:=x+@'100000000;
- if x<=0 then x:=1;
- end
-else begin
- out(0);
- if x>=@'100000000 then x:=@'77777777;
- end;
-n:=x div @'200000; m:=x mod @'200000;
-out(n); out(m div 256); out(m mod 256);
-end;
-
-@ We have output the packed indices for individual characters.
-The scaled widths, heights, depths, and italic corrections are next.
-
-@<Output the dimensions themselves@>=
-for q:=width to italic do begin
- out(0); out(0); out(0); out(0); {output the zero word}
- p:=link[q]; {head of list}
- while p>0 do begin
- out_scaled(memory[p]);
- p:=link[p];
- end;
- end;
-
-@ One embarrassing problem remains: The ligature/kern program might be very
-long, but the starting addresses in |char_remainder| can be at most~65535.
-Therefore we need to output some indirect address information; we want to
-compute |lk_offset| so that addition of |lk_offset| to all remainders makes
-all but |lk_offset| distinct remainders less than~65536.
-
-For this we need a sorted table of all relevant remainders.
-
-@<Glob...@>=
-@!label_table:array[xchar_type] of record
- @!rr: -1..xmax_label; {sorted label values}
- @!cc: char_type; {associated characters}
- end;
-@!label_ptr:xchar_type; {index of highest entry in |label_table|}
-@!sort_ptr:xchar_type; {index into |label_table|}
-@!lk_offset:xchar_type; {smallest offset value that might work}
-@!t:0..xmax_label; {label value that is being redirected}
-@!extra_loc_needed:boolean; {do we need a special word for |bchar|?}
-
-@ @<Compute the ligature/kern program offset@>=
-@<Insert all labels into |label_table|@>;
-if bchar<xmax_char then begin
- extra_loc_needed:=true; lk_offset:=1;
- end
-else begin
- extra_loc_needed:=false; lk_offset:=0;
- end;
-@<Find the minimum |lk_offset| and adjust all remainders@>;
-if bchar_label<xmax_label then begin
- lig_kern[nl-1].b2:=(bchar_label+lk_offset)div 65536;
- lig_kern[nl-1].b3:=(bchar_label+lk_offset)mod 65536;
- end
-
-@ @<Insert all labels...@>=
-label_ptr:=0; label_table[0].rr:=-1; {sentinel}
-for c:=bc to ec do if char_tag[c]=lig_tag then begin
- sort_ptr:=label_ptr; {there's a hole at position |sort_ptr+1|}
- while label_table[sort_ptr].rr>char_remainder[c] do begin
- label_table[sort_ptr+1]:=label_table[sort_ptr];
- decr(sort_ptr); {move the hole}
- end;
- label_table[sort_ptr+1].cc:=c;
- label_table[sort_ptr+1].rr:=char_remainder[c];
- incr(label_ptr);
- end
-
-@ @<Find the minimum |lk_offset| and adjust all remainders@>=
-begin sort_ptr:=label_ptr; {the largest unallocated label}
-if ofm_level=-1 then begin
- if label_table[sort_ptr].rr+lk_offset > 255 then begin
- lk_offset:=0; extra_loc_needed:=false; {location 0 can do double duty}
- repeat char_remainder[label_table[sort_ptr].cc]:=lk_offset;
- while label_table[sort_ptr-1].rr=label_table[sort_ptr].rr do begin
- decr(sort_ptr); char_remainder[label_table[sort_ptr].cc]:=lk_offset;
- end;
- incr(lk_offset); decr(sort_ptr);
- until lk_offset+label_table[sort_ptr].rr<256;
- {N.B.: |lk_offset=256| satisfies this when |sort_ptr=0|}
- end;
- end
-else begin
- if label_table[sort_ptr].rr+lk_offset > 65535 then begin
- lk_offset:=0; extra_loc_needed:=false; {location 0 can do double duty}
- repeat char_remainder[label_table[sort_ptr].cc]:=lk_offset;
- while label_table[sort_ptr-1].rr=label_table[sort_ptr].rr do begin
- decr(sort_ptr); char_remainder[label_table[sort_ptr].cc]:=lk_offset;
- end;
- incr(lk_offset); decr(sort_ptr);
- until lk_offset+label_table[sort_ptr].rr<65536;
- {N.B.: |lk_offset=65536| satisfies this when |sort_ptr=0|}
- end;
- end;
-if lk_offset>0 then
- while sort_ptr>0 do begin
- char_remainder[label_table[sort_ptr].cc]:=
- char_remainder[label_table[sort_ptr].cc]+lk_offset;
- decr(sort_ptr);
- end;
-end
-
-@ @<Output the ligature/kern program@>=
-if ofm_level=-1 then begin
- if extra_loc_needed then begin {|lk_offset=1|}
- out(255); out(bchar); out(0); out(0);
- end
- else for sort_ptr:=1 to lk_offset do begin {output the redirection specs}
- t:=label_table[label_ptr].rr;
- if bchar<256 then begin
- out(255); out(bchar);
- end
- else begin
- out(254); out(0);
- end;
- out_size(t+lk_offset);
- repeat decr(label_ptr); until label_table[label_ptr].rr<t;
- end;
- if nl>0 then for lig_ptr:=0 to nl-1 do begin
- out(lig_kern[lig_ptr].b0);
- out(lig_kern[lig_ptr].b1);
- out(lig_kern[lig_ptr].b2);
- out(lig_kern[lig_ptr].b3);
- end;
- if nk>0 then for krn_ptr:=0 to nk-1 do out_scaled(kern[krn_ptr])
- end
-else begin
- if extra_loc_needed then begin {|lk_offset=1|}
- out_size(255); out_size(bchar); out_size(0); out_size(0);
- end
- else for sort_ptr:=1 to lk_offset do begin {output the redirection specs}
- t:=label_table[label_ptr].rr;
- if bchar<xmax_char then begin
- out_size(255); out_size(bchar);
- end
- else begin
- out_size(254); out_size(0);
- end;
- out_size((t+lk_offset) div 256);
- out_size((t+lk_offset) mod 256);
- repeat decr(label_ptr); until label_table[label_ptr].rr<t;
- end;
- if nl>0 then for lig_ptr:=0 to nl-1 do begin
- out_size(lig_kern[lig_ptr].b0);
- out_size(lig_kern[lig_ptr].b1);
- out_size(lig_kern[lig_ptr].b2);
- out_size(lig_kern[lig_ptr].b3);
- end;
- if nk>0 then for krn_ptr:=0 to nk-1 do out_scaled(kern[krn_ptr])
- end
-
-@ @<Output the extensible character recipes@>=
-if ofm_level=-1 then begin
- if ne>0 then for c:=0 to ne-1 do begin
- out(exten[c].b0);
- out(exten[c].b1);
- out(exten[c].b2);
- out(exten[c].b3);
- end;
- end
-else begin
- if ne>0 then for c:=0 to ne-1 do begin
- out_size(exten[c].b0);
- out_size(exten[c].b1);
- out_size(exten[c].b2);
- out_size(exten[c].b3);
- end;
- end;
-
-@ For our grand finale, we wind everything up by outputting the parameters.
-
-@<Output the parameters@>=
-for par_ptr:=1 to np do begin
- if par_ptr=1 then
- @<Output the slant (|param[1]|) without scaling@>
- else out_scaled(param[par_ptr]);
- end
-
-@ @<Output the slant...@>=
-begin if param[1]<0 then begin
- param[1]:=param[1]+@'10000000000;
- out((param[1] div @'100000000)+256-64);
- end
-else out(param[1] div @'100000000);
-out((param[1] div @'200000) mod 256);
-out((param[1] div 256) mod 256);
-out(param[1] mod 256);
-end
-
-@* The VF output phase.
-Output to |vf_file| is considerably simpler.
-
-@d id_byte=202 {current version of \.{VF} format}
-@d vout(#)==write(vf_file,#)
-
-@<Glob...@>=
-@!vcount:integer; {number of bytes written to |vf_file|}
-
-@ We need a routine to output integers as four bytes. Negative values
-will never be less than $-2^{24}$.
-
-@p procedure vout_int(@!x:integer);
-begin if x>=0 then vout(x div @'100000000)
-else begin
- vout(255); x:=x+@'100000000;
- end;
-vout((x div @'200000) mod 256);
-vout((x div @'400) mod 256); vout(x mod 256);
-end;
-
-@ @<Do the \.{VF} output@>=
-vout(pre); vout(id_byte); vout(vtitle_length);
-for k:=0 to vtitle_length-1 do vout(vf[vtitle_start+k]);
-for k:=check_sum_loc to design_size_loc+3 do vout(header_bytes[k]);
-vcount:=vtitle_length+11;
-for cur_font:=0 to font_ptr-1 do @<Output a local font definition@>;
-for c:=bc to ec do if char_wd[c]>0 then
- @<Output a packet for character |c|@>;
-repeat vout(post); incr(vcount);
-until vcount mod 4 = 0
-
-@ @<Output a local font definition@>=
-begin vfout_fntdef(cur_font);@/
-vout(font_checksum[cur_font].b0);
-vout(font_checksum[cur_font].b1);
-vout(font_checksum[cur_font].b2);
-vout(font_checksum[cur_font].b3);
-vout_int(font_at[cur_font]);
-vout_int(font_dsize[cur_font]);
-vout(farea_length[cur_font]);
-vout(fname_length[cur_font]);
-for k:=0 to farea_length[cur_font]-1 do vout(vf[farea_start[cur_font]+k]);
-if fname_start[cur_font]=vf_size then begin
- vout("N"); vout("U"); vout("L"); vout("L");
- end
-else for k:=0 to fname_length[cur_font]-1 do vout(vf[fname_start[cur_font]+k]);
-vcount:=vcount+12+farea_length[cur_font]+fname_length[cur_font];
-end
-
-@ @<Output a packet for character |c|@>=
-begin x:=memory[char_wd[c]];
-if design_units<>unity then x:=round((x/design_units)*1048576.0);
-if (packet_length[c]>241)or(x<0)or(x>=@'100000000)or(c<0)or(c>255) then begin
- vout(242); vout_int(packet_length[c]); vfout_char(c); vout_int(x);
- vcount:=vcount+13+packet_length[c];
- end
-else begin
- vout(packet_length[c]); vout(c); vout(x div @'200000);
- vout((x div @'400) mod 256); vout(x mod 256);
- vcount:=vcount+5+packet_length[c];
- end;
-if packet_start[c]=vf_size then
- vfout_set(c)
-else for k:=0 to packet_length[c]-1 do vout(vf[packet_start[c]+k]);
-end
-
-@* The main program.
-The routines sketched out so far need to be packaged into separate procedures,
-on some systems, since some \PASCAL\ compilers place a strict limit on the
-size of a routine. The packaging is done here in an attempt to avoid some
-system-dependent changes.
-
-@p procedure param_enter;
-begin @<Enter the parameter names@>;
-end;
-@#
-procedure vpl_enter;
-begin @<Enter all the \.{VPL} names@>;
-end;
-@#
-procedure name_enter; {enter all names and their equivalents}
-begin @<Enter all the \.{PL} names...@>;
-vpl_enter; param_enter;
-end;
-@#
-procedure read_lig_kern;
-var @!krn_ptr:0..max_kerns; {an index into |kern|}
-@!c:byte; {runs through all character codes}
-begin @<Read ligature/kern list@>;
-end;
-@#
-procedure output_new_information_ofm;
-begin @<Output the new information for OFM files@>;
-end;
-@#
-procedure compute_new_header_ofm;
-begin @<Compute the new header information for OFM files@>;
-end;
-@#
-procedure finish_extended_font;
-begin @<Finish up the extended font stuff@>;
-end;
-@#
-procedure output_subfile_sizes;
-begin @<Output the subfile sizes@>;
-end;
-@#
-procedure compute_subfile_sizes;
-begin @<Compute the subfile sizes@>;
-end;
-@#
-procedure output_character_info;
-begin @<Output the character info@>;
-end;
-@#
-@#
-procedure read_font_rule_list;
-begin @<Read font rule list@>;
-end;
-@#
-procedure read_font_glue_list;
-begin @<Read font glue list@>;
-end;
-@#
-procedure read_font_penalty_list;
-begin @<Read font penalty list@>;
-end;
-@#
-procedure read_font_mvalue_list;
-begin @<Read font mvalue list@>;
-end;
-@#
-procedure read_font_fvalue_list;
-begin @<Read font fvalue list@>;
-end;
-@#
-procedure read_font_ivalue_list;
-begin @<Read font ivalue list@>;
-end;
-@#
-procedure read_repeated_character_info;
-begin @<Read repeated character info@>;
-end;
-@#
-procedure read_lig_kern_command;
-begin @<Read a ligature/kern command@>;
-end;
-@#
-procedure read_character_property;
-begin @<Read a character property@>;
-end;
-@#
-procedure read_char_info;
-begin @<Read character info list@>;
-end;
-@#
-procedure read_input;
-var @!c:byte; {header or parameter index}
-begin @<Read all the input@>;
-end;
-@#
-procedure corr_and_check;
-var @!c:xchar_type; {runs through all character codes}
-@!hh:0..hash_size; {an index into |hash_list|}
-@!lig_ptr:0..max_lig_steps; {an index into |lig_kern|}
-@!g:byte; {a character generated by the current character |c|}
-begin @<Correct and check the information@>
-end;
-@#
-procedure vf_output;
-var @!c:char_type; {runs through all character codes}
-@!cur_font:xfont_type; {runs through all local fonts}
-@!k:integer; {loop index}
-begin @<Do the \.{VF} output@>;
-end;
-
-@ Here is where \.{VPtoVF} begins and ends.
-
-@p begin initialize;@/
-name_enter;@/
-read_input; print_ln('.');@/
-corr_and_check;@/
-@<Do the font metric output@>;
-vf_output;
-end.
-
-@ @<Global...@>=
-@!ofm_level:integer;
-
-@ @<Set init...@>=
-ofm_level:=0; {Suppose that it is a level 0 OFM file}
-
-@ @<Read OFM level code@>=
-begin
-ofm_level:=get_integer;
-if (ofm_level<0) or (ofm_level>1) then begin
- flush_error('OFMLEVEL must be 0 or 1 -- 1 assumed');
- ofm_level:=1;
- end;
-end
-
-@ @<Read font direction code@>=
-begin
-font_dir:=-1;
-repeat get_next;
-until cur_char<>" ";
-case cur_char of
- "T": begin get_next;
- if cur_char="L" then font_dir:=0
- else if cur_char="R" then font_dir:=2;
- end;
- "B": begin get_next;
- if cur_char="L" then font_dir:=4
- else if cur_char="R" then font_dir:=6;
- end;
- "R": begin get_next;
- if cur_char="T" then font_dir:=5
- else if cur_char="B" then font_dir:=7;
- end;
- "L": begin get_next;
- if cur_char="T" then font_dir:=1
- else if cur_char="B" then font_dir:=3;
- end;
- end;
-while cur_char<>")" do get_next;
-if font_dir = -1 then begin
- flush_error('FONTDIR must be valid direction, -- TR assumed');
- font_dir:=0;
- end;
-end
-
-@ @<Read natural font direction code@>=
-begin
-font_dir:=-1;
-repeat get_next;
-until cur_char<>" ";
-case cur_char of
- "T": begin get_next;
- if cur_char="L" then font_dir:=8
- else if cur_char="R" then font_dir:=10;
- end;
- "B": begin get_next;
- if cur_char="L" then font_dir:=12
- else if cur_char="R" then font_dir:=14;
- end;
- "R": begin get_next;
- if cur_char="T" then font_dir:=13
- else if cur_char="B" then font_dir:=15;
- end;
- "L": begin get_next;
- if cur_char="T" then font_dir:=9
- else if cur_char="B" then font_dir:=11;
- end;
- end;
-while cur_char<>")" do get_next;
-if font_dir = -1 then begin
- flush_error('NFONTDIR must be valid direction, -- TR assumed');
- font_dir:=8;
- end;
-end
-
-@
-Here are some general values for the various entries.
-They can all be changed.
-
-@d arrays_per_kind==20
-@d entries_per_array==200
-
-@ @<Constants...@>=
-@!rule_arrays=arrays_per_kind;
-@!rule_entries=entries_per_array;
-
-@ @<Types...@>=
-rule_array_type=0..rule_arrays;
-rule_entry_type=0..rule_entries;
-rule_node=
-record
- rn_width: fix_word;
- rn_height: fix_word;
- rn_depth: fix_word;
-end;
-
-@ @<Global...@>=
-@!rules:array[rule_array_type,rule_entry_type] of rule_node;
-@!npr:array[rule_array_type] of integer;
-@!nkr:integer;
-@!nkcr:integer;
-@!nwr:integer;
-@!r_array:integer;
-@!r_number:integer;
-
-@ @<Set init...@>=
-for r_array := 0 to rule_arrays do begin
- npr[r_array]:=0;
- @<Null out the rule@>;
- end;
-nkr:=-1;
-nkcr:=-1;
-
-@ @<Read font rule list@>=
-begin
-if tables_read then
- flush_error('All parameter tables must appear before character info');
-r_array:=get_integer;
-if r_array>rule_arrays then
- flush_error('This FONTRULE table index is too big for my present size')
-else if r_array<0 then
- flush_error('This FONTRULE index is negative')
-else begin
- if r_array>nkr then nkr:=r_array;
- while level=1 do begin
- while cur_char=" " do get_next;
- if cur_char="(" then @<Read a rule@>
- else if cur_char=")" then skip_to_end_of_item
- else junk_error;
- end;
- finish_inner_property_list;
- end;
-end
-
-@ @<Read a rule@>=
-begin
-get_name;
-if cur_code=comment_code then skip_to_end_of_item
-else if cur_code<>rule_code then
- flush_error('This property name doesn''t belong in a RULE list')
-else begin
- r_number:=get_integer;
- if r_number>rule_entries then
- flush_error('This RULE index is too big for my present table size')
- else if r_number<0 then
- flush_error('This RULE index is negative')
- else begin
- while npr[r_array]<r_number do begin
- incr(npr[r_array]); @<Null out the rule@>;
- end;
- @<Read all of a rule's values@>;
- finish_the_property;
- end;
- end;
-end
-
-@ @<Null out the rule@>=
-begin
-rules[r_array,npr[r_array]].rn_width:=0;
-rules[r_array,npr[r_array]].rn_depth:=0;
-rules[r_array,npr[r_array]].rn_height:=0;
-end
-
-@ @<Read all of a rule's values@>=
-begin
-while level=2 do begin
- while cur_char=" " do get_next;
- if cur_char="(" then @<Read a single rule value@>
- else if cur_char=")" then skip_to_end_of_item
- else junk_error;
- end;
-finish_inner_property_list;
-end
-
-@ @<Read a single rule value@>=
-begin
-get_name;
-case cur_code of
- rule_width_code:
- rules[r_array,r_number].rn_width:=get_fix;
- rule_height_code:
- rules[r_array,r_number].rn_height:=get_fix;
- rule_depth_code:
- rules[r_array,r_number].rn_depth:=get_fix;
- end;
-finish_the_property;
-end
-
-@ @<Header information for rules@>=
-begin
-nwr:=0;
-for r_array := 0 to nkr do begin
- incr(npr[r_array]);
- nwr := nwr + 3*npr[r_array];
- end;
-incr(nkr);
-end
-
-@ @<Output the rules@>=
-begin
-for r_array:= 0 to nkr-1 do
- for r_number:=0 to npr[r_array]-1 do begin
- out_scaled(rules[r_array,r_number].rn_width);
- out_scaled(rules[r_array,r_number].rn_height);
- out_scaled(rules[r_array,r_number].rn_depth);
- end;
-end
-
-@ @<Output the rule headers@>=
-begin
-for r_array:= 0 to nkr-1 do begin
- out_integer(npr[r_array]);
- end;
-end
-
-@ @<Constants...@>=
-@!glue_arrays=arrays_per_kind;
-@!glue_entries=entries_per_array;
-
-@
-@d t_normal==0
-@d t_aleaders==1
-@d t_cleaders==2
-@d t_xleaders==3
-
-@d o_unit==0
-@d o_fi==1
-@d o_fil==2
-@d o_fill==3
-@d o_filll==4
-
-@d g_space==0
-@d g_rule==1
-@d g_char==2
-
-@<Types...@>=
-glue_array_type=0..glue_arrays;
-glue_entry_type=0..glue_entries;
-glue_node=
-record
- gn_width: fix_word;
- gn_stretch: fix_word;
- gn_shrink: fix_word;
- gn_type: integer;
- gn_arg_type: g_space..g_char;
- gn_stretch_order: integer;
- gn_shrink_order: integer;
- gn_argument: integer;
-end;
-
-@ @<Global...@>=
-@!glues:array[glue_array_type,glue_entry_type] of glue_node;
-@!npg:array[glue_array_type] of integer;
-@!nkg:integer;
-@!nkcg:integer;
-@!nwg:integer;
-@!g_array:integer;
-@!g_byte:integer;
-@!g_number:integer;
-
-@ @<Set init...@>=
-for g_array := 0 to glue_arrays do
-begin
- npg[g_array]:=0;
- @<Null out the glue@>;
-end;
-nkg:=-1;
-nkcg:=-1;
-
-@ @<Read font glue list@>=
-begin
-if tables_read then
- flush_error('All parameter tables must appear before character info');
-g_array:=get_integer;
-if g_array>glue_arrays then
- flush_error('This FONTGLUE table index is too big for my present size')
-else if g_array<0 then
- flush_error('This FONTGLUE index is negative')
-else begin
- if g_array>nkg then nkg:=g_array;
- while level=1 do begin
- while cur_char=" " do get_next;
- if cur_char="(" then @<Read a glue@>
- else if cur_char=")" then skip_to_end_of_item
- else junk_error;
- end;
- finish_inner_property_list;
- end;
-end
-
-@ @<Read a glue@>=
-begin
-get_name;
-if cur_code=comment_code then skip_to_end_of_item
-else if cur_code<>glue_code then
- flush_error('This property name doesn''t belong in a GLUE list')
-else begin
- g_number:=get_integer;
- if g_number>glue_entries then
- flush_error('This GLUE index is too big for my present table size')
- else if g_number<0 then
- flush_error('This GLUE index is negative')
- else begin
- while npg[g_array]<g_number do begin
- incr(npg[g_array]); @<Null out the glue@>;
- end;
- @<Read all of a glue's values@>;
- finish_the_property;
- end;
- end;
-end
-
-@ @<Null out the glue@>=
-begin
-glues[g_array,npg[g_array]].gn_width:=0;
-glues[g_array,npg[g_array]].gn_stretch:=0;
-glues[g_array,npg[g_array]].gn_shrink:=0;
-glues[g_array,npg[g_array]].gn_type:=0;
-glues[g_array,npg[g_array]].gn_arg_type:=0;
-glues[g_array,npg[g_array]].gn_stretch_order:=0;
-glues[g_array,npg[g_array]].gn_shrink_order:=0;
-glues[g_array,npg[g_array]].gn_argument:=0;
-end
-
-@ @<Read all of a glue's values@>=
-begin
-while level=2 do begin
- while cur_char=" " do get_next;
- if cur_char="(" then @<Read a single glue value@>
- else if cur_char=")" then skip_to_end_of_item
- else junk_error;
- end;
-finish_inner_property_list;
-end
-
-@ @<Read a single glue value@>=
-begin
-get_name;
-case cur_code of
- glue_width_code:
- glues[g_array,g_number].gn_width:=get_fix;
- glue_stretch_code:
- glues[g_array,g_number].gn_stretch:=get_fix;
- glue_shrink_code:
- glues[g_array,g_number].gn_shrink:=get_fix;
- glue_type_code: begin
- g_byte:=get_integer;
- if (g_byte<0) or (g_byte>3) then begin
- g_byte:=0;
- end;
- glues[g_array,g_number].gn_type:=g_byte;
- end;
- glue_stretch_order_code: begin
- g_byte:=get_integer;
- if (g_byte<0) or (g_byte>4) then begin
- g_byte:=0;
- end;
- glues[g_array,g_number].gn_stretch_order:=g_byte;
- end;
- glue_shrink_order_code: begin
- g_byte:=get_integer;
- if (g_byte<0) or (g_byte>4) then begin
- g_byte:=0;
- end;
- glues[g_array,g_number].gn_shrink_order:=g_byte;
- end;
- glue_char_code: begin
- glues[g_array,g_number].gn_argument:=get_integer;
- glues[g_array,g_number].gn_arg_type:=g_char;
- end;
- glue_rule_code: begin
- glues[g_array,g_number].gn_argument:=get_integer;
- glues[g_array,g_number].gn_arg_type:=g_rule;
- end;
- end;
-finish_the_property;
-end
-
-@ @<Header information for glues@>=
-begin
-nwg:=0;
-for g_array := 0 to nkg do begin
- incr(npg[g_array]);
- nwg := nwg + 4*npg[g_array];
- end;
-incr(nkg);
-end
-
-@ @<Output the glues@>=
-begin
-for g_array:= 0 to nkg-1 do
- for g_number:=0 to npg[g_array]-1 do begin
- g_byte:=glues[g_array,g_number].gn_type*16+
- glues[g_array,g_number].gn_arg_type;
- out(g_byte);
- g_byte:=glues[g_array,g_number].gn_stretch_order*16+
- glues[g_array,g_number].gn_shrink_order;
- out(g_byte);
- g_byte:=glues[g_array,g_number].gn_argument div 256;
- out(g_byte);
- g_byte:=glues[g_array,g_number].gn_argument mod 256;
- out(g_byte);
- out_scaled(glues[g_array,g_number].gn_width);
- out_scaled(glues[g_array,g_number].gn_stretch);
- out_scaled(glues[g_array,g_number].gn_shrink);
- end;
-end
-
-@ @<Output the glue headers@>=
-begin
-for g_array:= 0 to nkg-1 do begin
- out_integer(npg[g_array]);
- end;
-end
-
-@ @<Constants...@>=
-@!penalty_arrays=arrays_per_kind;
-@!penalty_entries=entries_per_array;
-
-@ @<Types...@>=
-penalty_array_type=0..penalty_arrays;
-penalty_entry_type=0..penalty_entries;
-penalty_node=
-record
- pn_val: integer;
-end;
-
-@ @<Global...@>=
-@!penalties:array[penalty_array_type,penalty_entry_type] of penalty_node;
-@!npp:array[penalty_array_type] of integer;
-@!nkp:integer;
-@!nkcp:integer;
-@!nwp:integer;
-@!p_array:integer;
-@!p_number:integer;
-
-@ @<Set init...@>=
-for p_array := 0 to penalty_arrays do begin
- npp[p_array]:=0;
- @<Null out the penalty@>;
- end;
-nkp:=-1;
-nkcp:=-1;
-
-@ @<Read font penalty list@>=
-begin
-if tables_read then
- flush_error('All parameter tables must appear before character info');
-p_array:=get_integer;
-if p_array>penalty_arrays then
- flush_error('This FONTPENALTY table index is too big for my present size')
-else if p_array<0 then
- flush_error('This FONTPENALTY index is negative')
-else begin
- if p_array>nkp then nkp:=p_array;
- while level=1 do begin
- while cur_char=" " do get_next;
- if cur_char="(" then @<Read a penalty@>
- else if cur_char=")" then skip_to_end_of_item
- else junk_error;
- end;
- finish_inner_property_list;
- end;
-end
-
-@ @<Read a penalty@>=
-begin
-get_name;
-if cur_code=comment_code then skip_to_end_of_item
-else if cur_code<>penalty_code then
- flush_error('This property name doesn''t belong in a PENALTY list')
-else begin
- p_number:=get_integer;
- if p_number>penalty_entries then
- flush_error('This PENALTY index is too big for my present table size')
- else if p_number<0 then
- flush_error('This PENALTY index is negative')
- else begin
- while npp[p_array]<p_number do begin
- incr(npp[p_array]); @<Null out the penalty@>;
- end;
- @<Read all of a penalty's values@>;
- finish_the_property;
- end;
- end;
-end
-
-@ @<Null out the penalty@>=
-begin
-penalties[p_array,npp[p_array]].pn_val:=0;
-end
-
-@ @<Read all of a penalty's values@>=
-begin
-while level=2 do begin
- while cur_char=" " do get_next;
- if cur_char="(" then @<Read a single penalty value@>
- else if cur_char=")" then skip_to_end_of_item
- else junk_error;
- end;
-finish_inner_property_list;
-end
-
-@ @<Read a single penalty value@>=
-begin
-get_name;
-case cur_code of
- penalty_val_code:
- penalties[p_array,p_number].pn_val:=get_integer;
- end;
-finish_the_property;
-end
-
-@ @<Header information for penalties@>=
-begin
-nwp:=0;
-for p_array := 0 to nkp do begin
- incr(npp[p_array]);
- nwp := nwp + npp[p_array];
- end;
-incr(nkp);
-end
-
-@ @<Output the penalties@>=
-begin
-for p_array:= 0 to nkp-1 do
- for p_number:=0 to npp[p_array]-1 do begin
- out_integer(penalties[p_array,p_number].pn_val);
- end;
-end
-
-@ @<Output the penalty headers@>=
-begin
-for p_array:= 0 to nkp-1 do begin
- out_integer(npp[p_array]);
- end;
-end
-
-@ @<Constants...@>=
-@!mvalue_arrays=arrays_per_kind;
-@!mvalue_entries=entries_per_array;
-
-@ @<Types...@>=
-mvalue_array_type=0..mvalue_arrays;
-mvalue_entry_type=0..mvalue_entries;
-mvalue_node=
-record
- fn_val: fix_word;
-end;
-
-@ @<Global...@>=
-@!mvalues:array[mvalue_array_type,mvalue_entry_type] of mvalue_node;
-@!npm:array[mvalue_array_type] of integer;
-@!nkm:integer;
-@!nkcm:integer;
-@!nwm:integer;
-@!m_array:integer;
-@!m_number:integer;
-
-@ @<Set init...@>=
-for m_array := 0 to mvalue_arrays do begin
- npm[m_array]:=0;
- @<Null out the mvalue@>;
- end;
-nkm:=-1;
-nkcm:=-1;
-
-@ @<Read font mvalue list@>=
-begin
-if tables_read then
- flush_error('All parameter tables must appear before character info');
-m_array:=get_integer;
-if m_array>mvalue_arrays then
- flush_error('This FONTMVALUE table index is too big for my present size')
-else if m_array<0 then
- flush_error('This FONTMVALUE index is negative')
-else begin
- if m_array>nkm then nkm:=m_array;
- while level=1 do begin
- while cur_char=" " do get_next;
- if cur_char="(" then @<Read an mvalue@>
- else if cur_char=")" then skip_to_end_of_item
- else junk_error;
- end;
- finish_inner_property_list;
- end;
-end
-
-@ @<Read an mvalue@>=
-begin
-get_name;
-if cur_code=comment_code then skip_to_end_of_item
-else if cur_code<>mvalue_code then
- flush_error('This property name doesn''t belong in an MVALUE list')
-else begin
- m_number:=get_integer;
- if m_number>mvalue_entries then
- flush_error('This MVALUE index is too big for my present table size')
- else if m_number<0 then
- flush_error('This MVALUE index is negative')
- else begin
- while npm[m_array]<m_number do begin
- incr(npm[m_array]); @<Null out the mvalue@>;
- end;
- @<Read all of an mvalue's values@>;
- finish_the_property;
- end;
- end;
-end
-
-@ @<Null out the mvalue@>=
-begin
-mvalues[m_array,npm[m_array]].fn_val:=0;
-end
-
-@ @<Read all of an mvalue's values@>=
-begin
-while level=2 do begin
- while cur_char=" " do get_next;
- if cur_char="(" then @<Read a single mvalue value@>
- else if cur_char=")" then skip_to_end_of_item
- else junk_error;
- end;
-finish_inner_property_list;
-end
-
-@ @<Read a single mvalue value@>=
-begin
-get_name;
-case cur_code of
- mvalue_val_code:
- mvalues[m_array,m_number].fn_val:=get_fix;
- end;
-finish_the_property;
-end
-
-@ @<Header information for mvalues@>=
-begin
-nwm:=0;
-for m_array := 0 to nkm do begin
- incr(npm[m_array]);
- nwm := nwm + npm[m_array];
- end;
-incr(nkm);
-end
-
-@ @<Output the mvalues@>=
-begin
-for m_array:= 0 to nkm-1 do
- for m_number:=0 to npm[m_array]-1 do begin
- out_scaled(mvalues[m_array,m_number].fn_val);
- end;
-end
-
-@ @<Output the mvalue headers@>=
-begin
-for m_array:= 0 to nkm-1 do begin
- out_integer(npm[m_array]);
- end;
-end
-
-@ @<Constants...@>=
-@!fvalue_arrays=arrays_per_kind;
-@!fvalue_entries=entries_per_array;
-
-@ @<Types...@>=
-fvalue_array_type=0..fvalue_arrays;
-fvalue_entry_type=0..fvalue_entries;
-fvalue_node=
-record
- fn_val: fix_word;
-end;
-
-@ @<Global...@>=
-@!fvalues:array[fvalue_array_type,fvalue_entry_type] of fvalue_node;
-@!npf:array[fvalue_array_type] of integer;
-@!nkf:integer;
-@!nkcf:integer;
-@!nwf:integer;
-@!f_array:integer;
-@!f_number:integer;
-
-@ @<Set init...@>=
-for f_array := 0 to fvalue_arrays do begin
- npf[f_array]:=0;
- @<Null out the fvalue@>;
- end;
-nkf:=-1;
-nkcf:=-1;
-
-@ @<Read font fvalue list@>=
-begin
-if tables_read then
- flush_error('All parameter tables must appear before character info');
-f_array:=get_integer;
-if f_array>fvalue_arrays then
- flush_error('This FONTFVALUE table index is too big for my present size')
-else if f_array<0 then
- flush_error('This FONTFVALUE index is negative')
-else begin
- if f_array>nkf then nkf:=f_array;
- while level=1 do begin
- while cur_char=" " do get_next;
- if cur_char="(" then @<Read an fvalue@>
- else if cur_char=")" then skip_to_end_of_item
- else junk_error;
- end;
- finish_inner_property_list;
- end;
-end
-
-@ @<Read an fvalue@>=
-begin
-get_name;
-if cur_code=comment_code then skip_to_end_of_item
-else if cur_code<>fvalue_code then
- flush_error('This property name doesn''t belong in an FVALUE list')
-else begin
- f_number:=get_integer;
- if f_number>fvalue_entries then
- flush_error('This FVALUE index is too big for my present table size')
- else if f_number<0 then
- flush_error('This FVALUE index is negative')
- else begin
- while npf[f_array]<f_number do begin
- incr(npf[f_array]); @<Null out the fvalue@>;
- end;
- @<Read all of an fvalue's values@>;
- finish_the_property;
- end;
- end;
-end
-
-@ @<Null out the fvalue@>=
-begin
-fvalues[f_array,npf[f_array]].fn_val:=0;
-end
-
-@ @<Read all of an fvalue's values@>=
-begin
-while level=2 do begin
- while cur_char=" " do get_next;
- if cur_char="(" then @<Read a single fvalue value@>
- else if cur_char=")" then skip_to_end_of_item
- else junk_error;
- end;
-finish_inner_property_list;
-end
-
-@ @<Read a single fvalue value@>=
-begin
-get_name;
-case cur_code of
- fvalue_val_code:
- fvalues[f_array,f_number].fn_val:=get_fix;
- end;
-finish_the_property;
-end
-
-@ @<Header information for fvalues@>=
-begin
-nwf:=0;
-for f_array := 0 to nkf do begin
- incr(npf[f_array]);
- nwf := nwf + npf[f_array];
- end;
-incr(nkf);
-end
-
-@ @<Output the fvalues@>=
-begin
-for f_array:= 0 to nkf-1 do
- for f_number:=0 to npf[f_array]-1 do begin
- out_scaled(fvalues[f_array,f_number].fn_val);
- end;
-end
-
-@ @<Output the fvalue headers@>=
-begin
-for f_array:= 0 to nkf-1 do begin
- out_integer(npf[f_array]);
- end;
-end
-
-@ @<Constants...@>=
-@!ivalue_arrays=arrays_per_kind;
-@!ivalue_entries=entries_per_array;
-
-@ @<Types...@>=
-ivalue_array_type=0..ivalue_arrays;
-ivalue_entry_type=0..ivalue_entries;
-ivalue_node=
-record
- in_val: integer;
-end;
-
-@ @<Global...@>=
-@!ivalues:array[ivalue_array_type,ivalue_entry_type] of ivalue_node;
-@!npi:array[ivalue_array_type] of integer;
-@!font_i_array:boolean;
-@!nki:integer;
-@!nkci:integer;
-@!nwi:integer;
-@!i_array:integer;
-@!i_number:integer;
-
-@ @<Set init...@>=
-for i_array := 0 to ivalue_arrays do begin
- npi[i_array]:=0;
- @<Null out the ivalue@>;
- end;
-nki:=-1;
-nkci:=-1;
-
-@ @<Read font ivalue list@>=
-begin
-if tables_read then
- flush_error('All parameter tables must appear before character info');
-i_array:=get_integer;
-if i_array>ivalue_arrays then
- flush_error('This FONTIVALUE table index is too big for my present size')
-else if i_array<0 then
- flush_error('This FONTIVALUE index is negative')
-else begin
- if i_array>nki then nki:=i_array;
- while level=1 do begin
- while cur_char=" " do get_next;
- if cur_char="(" then @<Read an ivalue@>
- else if cur_char=")" then skip_to_end_of_item
- else junk_error;
- end;
- finish_inner_property_list;
- end;
-end
-
-@ @<Read an ivalue@>=
-begin
-get_name;
-if cur_code=comment_code then skip_to_end_of_item
-else if cur_code<>ivalue_code then
- flush_error('This property name doesn''t belong in an IVALUE list')
-else begin
- i_number:=get_integer;
- if i_number>ivalue_entries then
- flush_error('This IVALUE index is too big for my present table size')
- else if i_number<0 then
- flush_error('This IVALUE index is negative')
- else begin
- while npi[i_array]<i_number do begin
- incr(npi[i_array]); @<Null out the ivalue@>;
- end;
- @<Read all of an ivalue's values@>;
- finish_the_property;
- end;
- end;
-end
-
-@ @<Null out the ivalue@>=
-begin
-ivalues[i_array,npi[i_array]].in_val:=0;
-end
-
-@ @<Read all of an ivalue's values@>=
-begin
-while level=2 do begin
- while cur_char=" " do get_next;
- if cur_char="(" then @<Read a single ivalue value@>
- else if cur_char=")" then skip_to_end_of_item
- else junk_error;
- end;
-finish_inner_property_list;
-end
-
-@ @<Read a single ivalue value@>=
-begin
-get_name;
-case cur_code of
- ivalue_val_code:
- ivalues[i_array,i_number].in_val:=get_integer;
- end;
-finish_the_property;
-end
-
-@ @<Header information for ivalues@>=
-begin
-nwi:=0;
-for i_array := 0 to nki do begin
- incr(npi[i_array]);
- nwi := nwi + npi[i_array];
- end;
-incr(nki);
-end
-
-@ @<Output the ivalues@>=
-begin
-for i_array:= 0 to nki-1 do
- for i_number:=0 to npi[i_array]-1 do begin
- out_integer(ivalues[i_array,i_number].in_val);
- end;
-end
-
-@ @<Output the ivalue headers@>=
-begin
-for i_array:= 0 to nki-1 do begin
- out_integer(npi[i_array]);
- end;
-end
-
-@ @<Compute the new header information for OFM files@>=
-begin
-@<Header information for ivalues@>;
-@<Header information for fvalues@>;
-@<Header information for mvalues@>;
-@<Header information for rules@>;
-@<Header information for glues@>;
-@<Header information for penalties@>;
-end
-
-@ @<Output the new information for OFM files@>=
-begin
-@<Output the ivalue headers@>;
-@<Output the fvalue headers@>;
-@<Output the mvalue headers@>;
-@<Output the rule headers@>;
-@<Output the glue headers@>;
-@<Output the penalty headers@>;
-@<Output the ivalues@>;
-@<Output the fvalues@>;
-@<Output the rules@>;
-@<Output the glues@>;
-@<Output the penalties@>;
-end
-
-@* System-dependent changes.
-This section should be replaced, if necessary, by changes to the program
-that are necessary to make \.{VPtoVF} work at a particular installation.
-It is usually best to design your change file so that all changes to
-previous sections preserve the section numbering; then everybody's version
-will be consistent with the printed program. More extensive changes,
-which introduce new sections, can be inserted here; then only the index
-itself will get a new section number.
-@^system dependencies@>
-
-@* Index.
-Pointers to error messages appear here together with the section numbers
-where each ident\-i\-fier is used.