summaryrefslogtreecommitdiff
path: root/Build/source/texk/web2c/omegaware/ovf2ovp.web
diff options
context:
space:
mode:
authorPeter Breitenlohner <peb@mppmu.mpg.de>2014-01-09 12:56:28 +0000
committerPeter Breitenlohner <peb@mppmu.mpg.de>2014-01-09 12:56:28 +0000
commit04d22733fda61f856746b38a37add87bd19aa035 (patch)
treef0e3bccdacb29d2d1aa11636aa68eb8778d3a00c /Build/source/texk/web2c/omegaware/ovf2ovp.web
parent05e38350226b5da4ed5ad2132525f9b31ac0bc50 (diff)
web2c/omegaware: Version 1.13 of Omega font utilities OFM2OPL & Co
git-svn-id: svn://tug.org/texlive/trunk@32616 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Build/source/texk/web2c/omegaware/ovf2ovp.web')
-rw-r--r--Build/source/texk/web2c/omegaware/ovf2ovp.web577
1 files changed, 279 insertions, 298 deletions
diff --git a/Build/source/texk/web2c/omegaware/ovf2ovp.web b/Build/source/texk/web2c/omegaware/ovf2ovp.web
index 3efb4cc19fb..d6d9a6f3e79 100644
--- a/Build/source/texk/web2c/omegaware/ovf2ovp.web
+++ b/Build/source/texk/web2c/omegaware/ovf2ovp.web
@@ -13,6 +13,7 @@
% Version 1.0 of OVF2OVP (Month Year).
% Version 1.11 (February 2000).
% Version 1.12 (September 2009) various bug fixes by Peter Breitenlohner.
+% Version 1.13 (January 2014) more bug fixes.
% Here is TeX material that gets inserted after \input webmac
\def\hang{\hangindent 3em\indent\ignorespaces}
@@ -31,7 +32,7 @@
\vfill
\centerline{\titlefont The {\ttitlefont OVF2OVP} processor}
\vskip 15pt
- \centerline{(Version 1.12, September 2009)}
+ \centerline{(Version 1.13, January 2014)}
\vfill}
\def\botofcontents{\vfill
\centerline{\hsize 5in\baselineskip9pt
@@ -66,7 +67,7 @@ called \.{AMFtoXPL}.
The |banner| string defined here should be changed whenever \.{VFtoVP}
gets modified.
-@d banner=='This is OVF2OVP, Version 1.12' {printed when the program starts}
+@d banner=='This is OVF2OVP, Version 1.13' {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.
@@ -619,8 +620,7 @@ bytes, |tfm[0..(4*lf-1)]|.
@!xxchar_type=0..xxchar_max;
@!xxxchar_type=0..xxxchar_max;
-@
-@<Glob...@>=
+@ @<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;
@@ -642,10 +642,10 @@ if tfm[0]>127 then abort('The first byte of the input file exceeds 127!');
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!');
+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];
@@ -656,14 +656,13 @@ if lf=0 then begin
@.The fifth byte...@>
lf := tfm[4]*@"1000000 + tfm[5]*@"10000 + tfm[6]*@"100 + tfm[7];
end
-else begin
- ofm_on := false;
+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;
+-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;
@@ -673,14 +672,14 @@ if lf=0 then
@.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
+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,');
+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
@@ -793,8 +792,8 @@ if ne>(top_char+1) then abort('There are ',ne:1,' extensible 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
+\.{VFtoVP} believes that it is a \.{TFM} file, and the conversion
+to \.{VPL} 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.
@@ -1083,8 +1082,8 @@ the packets.
@ Again we cautiously verify that we've been given decent data.
@d read_vf(#)==read(vf_file,#)
-@d vf_abort(#)==begin
- print_ln(#);
+@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
@@ -1209,7 +1208,7 @@ the fourth.
@!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;
+@!font_kprime,@!font_j,@!font_wd:integer;
@ The |read_tfm_word| procedure sets |b0| through |b3| to the next
four bytes in the current \.{TFM} file.
@@ -1222,10 +1221,10 @@ begin read_tfm(b0); read_tfm(b1);
read_tfm(b2); read_tfm(b3);
end;
-@ We use the |vc| array to store a list of all valid characters in the local
-font, beginning at location |font_chars[f]|. In \.{VFtoVP} the |vf| array
-is used for that purpose, but that is not possible for \.{OVF2OVP} with
-characters in the range |0..char_max|.
+@ We use the |vc| array to store a list of all valid characters in the
+local font, beginning at location |font_chars[f]|.
+In \.{VFtoVP} the |vf| array is used for that purpose, but that is not
+possible for \.{OVF2OVP} with characters in the range |0..char_max|.
@<Read the local font's \.{TFM} file...@>=
@<Move font name into the |cur_name| string@>;
@@ -1291,8 +1290,8 @@ 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}
- vc[vc_ptr]:=k; incr(vc_ptr);
+ if b0>0 then {character |k| exists in the font}
+ begin vc[vc_ptr]:=k; incr(vc_ptr);
if vc_ptr=vc_size then vf_abort('I''m out of OVF memory!');
end;
end;
@@ -1309,18 +1308,15 @@ case font_ofm_level of
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}
- vc[vc_ptr]:=k; incr(vc_ptr);
- if vc_ptr=vc_size then vf_abort('I''m out of OVF memory!');
- end;
+ while k<=font_ec do
+ begin read_tfm_word; font_wd:=b0*256+b1;
read_tfm_word; read_tfm_word;
font_kprime:=k+(b0*256+b1);
- for font_j:=k+1 to font_kprime do begin
- vc[vc_ptr]:=font_j; incr(vc_ptr);
- if vc_ptr=vc_size then vf_abort('I''m out of OVF memory!');
- end;
+ if font_wd>0 then {character |k| exists in the font}
+ for font_j:=k to font_kprime do
+ begin vc[vc_ptr]:=font_j; incr(vc_ptr);
+ if vc_ptr=vc_size then vf_abort('I''m out of OVF memory!');
+ end;
k:=font_kprime+1;
for font_j:=1 to font_extra_words do
read_tfm_word;
@@ -1333,8 +1329,8 @@ 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');
+ (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;
@@ -1379,14 +1375,14 @@ to upper case, since |cur_name| is a \PASCAL\ string.
@<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
+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);
+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
@@ -1406,15 +1402,16 @@ 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);
+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.
+but \.{VPL} format presently does not.
+But \.{OVP} does.
@<Read and store a character packet@>=
begin if temp_byte=long_char then
@@ -1475,8 +1472,8 @@ ASCII_04:=' !"#$%&''()*+,-./0123456789:;<=>?';@/
ASCII_10:='@@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_';@/
ASCII_14:='`abcdefghijklmnopqrstuvwxyz{|}~?';@/
for k:=0 to 255 do xchr[k]:='?';
-for k:=0 to @'37 do begin
- xchr[k+@'40]:=ASCII_04[k+1];
+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;
@@ -1488,17 +1485,17 @@ HEX:='0123456789ABCDEF';@/
@<Glob...@>=
@!dig:array[0..11] of integer;
-@ Here, in fact, are two procedures that output
-|dig[j-1]|$\,\ldots\,$|dig[0]|, given $j>0$.
+@ 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;
+until j=0;
end;
@#
procedure print_digs(j:integer); {prints |j| digits}
begin repeat decr(j); print(HEX[1+dig[j]]);
- until j=0;
+until j=0;
end;
@ The |print_number| procedure indicates how |print_digs| can be used.
@@ -1565,8 +1562,8 @@ 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]]);
+while l>0 do
+ begin incr(k); decr(l); out(xchr[tfm[k]]);
end;
end;
@@ -1630,11 +1627,11 @@ if tfm[k+l]<>0 then 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;
+ 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
@@ -1663,8 +1660,7 @@ curious code mentioned earlier, provided that it is less than 18.
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}
+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]);
@@ -1713,8 +1709,8 @@ end;
@ @<Reduce \(2)negative to positive@>=
begin out('-'); a:=@'10000-a;
-if f>0 then begin
- f:=@'4000000-f; decr(a);
+if f>0 then
+ begin f:=@'4000000-f; decr(a);
end;
end
@@ -1786,23 +1782,23 @@ 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;
+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;
+ 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;
@@ -1848,20 +1844,20 @@ 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.');
+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];
+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.');
+ else if (c<" ")or(c>"~") then
+ begin bad('Nonstandard ASCII code has been blotted out.');
@.Nonstandard ASCII code...@>
tfm[j]:="?";
end
@@ -1877,8 +1873,8 @@ 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
+ (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
@@ -1896,8 +1892,8 @@ 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);
+for i:=18 to lh-1 do
+ begin left; out('HEADER D ',i:1);
out_hex(check_sum+4*i,@,4); right;
end;
end
@@ -1921,8 +1917,8 @@ else if (lh>17) and (tfm[random_word]>127) then
@ 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;
+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;
@@ -2044,18 +2040,17 @@ start_counter:=start_counter+4;
end;
@ @<Do the rule parameters@>=
-if nkr>0 then begin
- start_counter:=rules_start*4;
+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;
+ end
@ @<Check and output the $i$th rule table@>=
-begin
-left; out('FONTRULE'); out_hex_number(i); out_ln;
+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;
+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;
@@ -2067,8 +2062,8 @@ start_counter:=start_counter+4;
end;
@ @<Do the glue parameters@>=
-if nkg>0 then begin
- start_counter:=glues_start*4;
+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;
@@ -2078,11 +2073,10 @@ if nkg>0 then begin
@!glue_shrink_order,@!glue_argument:integer;
@ @<Check and output the $i$th glue table@>=
-begin
-left; out('FONTGLUE'); out_hex_number(i); out_ln;
+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;
+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;
@@ -2091,39 +2085,39 @@ for j:=0 to number_entries-1 do begin
left;
out('GLUETYPE');
case glue_subtype of
- 0: out(' H 0');
- 1: out(' H 1');
- 2: out(' H 2');
- 3: out(' H 3');
- end;
+ 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;
+ 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;
+ 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;
+ 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;
@@ -2136,8 +2130,8 @@ start_counter:=start_counter+4;
end;
@ @<Do the penalty parameters@>=
-if nkp>0 then begin
- start_counter:=penalties_start*4;
+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;
@@ -2180,7 +2174,7 @@ 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
+\.{VPL} 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|,
@@ -2212,13 +2206,13 @@ label_ptr:=0; label_table[0].rr:=0; {a sentinel appears at the bottom}
@!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;
+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;@/
+if nl>0 then
+ begin left; out('LIGTABLE'); out_ln;@/
@<Compute the |activity| array@>;
@<Output and correct the ligature/kern program@>;
right;
@@ -2230,19 +2224,20 @@ 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 (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;
+ 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(' ');
+ 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);
@@ -2254,8 +2249,8 @@ 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];
+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);
@@ -2268,22 +2263,20 @@ incr(label_ptr); activity[r]:=accessible;
end
@ @<Check for a bound...@>=
-if l_skip_byte(lig_step(0))=255 then begin
- left; out('BOUNDARYCHAR');
+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(' ');
+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;
+ 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;
@@ -2307,12 +2300,12 @@ else if activity[ai]=accessible then begin
end
@ We ignore |pass_through| items, which don't need to be mentioned in
-the \.{PL} file.
+the \.{VPL} 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@>;
+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;
@@ -2349,9 +2342,9 @@ while i=label_table[sort_ptr].rr do begin
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;
+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
@@ -2409,9 +2402,8 @@ 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
+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;
@@ -2425,8 +2417,8 @@ begin if nonexistent(l_next_char(k)) then
@.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.');
+if r>=nk then
+ begin bad('Kern index too large.');
@.Kern index too large@>
out(' R 0.0');
end
@@ -2436,22 +2428,22 @@ 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);
+ 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);
+ 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');
+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;
+while r>3 do
+ begin out('>'); r:=r-4;
end;
out_char(l_next_char(k)); out_char(l_remainder(k)); right;
end
@@ -2463,58 +2455,57 @@ 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;
+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(' ');
+ 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;
- if ofm_on then check_unused(c);
- @<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+nkm) then begin
- out('CHARMVALUE'); out_hex_number(i-nki-nkf);
- end
- else if i<(nki+nkf+nkm+nkr) then begin
- out('CHARRULE'); out_hex_number(i-nki-nkf-nkm);
- end
- else if i<(nki+nkf+nkm+nkr+nkg) then begin
- out('CHARGLUE'); out_hex_number(i-nki-nkf-nkm-nkr);
- end
- else if i<(nki+nkf+nkm+nkr+nkg+nkp) then begin
- out('CHARPENALTY'); out_hex_number(i-nki-nkf-nkm-nkr-nkg);
- end;
- out_hex_number(char_param(c,i));
- right;
+ print_hex(cprime); {progress report}
+ left; out('CHARACTER'); out_char(cprime); out_ln;
+ if ofm_on then check_unused(c);
+ @<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+nkm) then begin
+ out('CHARMVALUE'); out_hex_number(i-nki-nkf);
+ end
+ else if i<(nki+nkf+nkm+nkr) then begin
+ out('CHARRULE'); out_hex_number(i-nki-nkf-nkm);
+ end
+ else if i<(nki+nkf+nkm+nkr+nkg) then begin
+ out('CHARGLUE'); out_hex_number(i-nki-nkf-nkm-nkr);
+ end
+ else if i<(nki+nkf+nkm+nkr+nkg+nkp) then begin
+ out('CHARPENALTY'); out_hex_number(i-nki-nkf-nkm-nkr-nkg);
end;
+ out_hex_number(char_param(c,i));
+ right;
end;
- if not do_map(cprime) then goto final_end;
- right;
end;
+ if not do_map(cprime) then goto final_end;
+ right;
+ end;
end;
c:=c+1+no_repeats(c);
end
@@ -2546,8 +2537,7 @@ else begin left; out('CHARIC'); out_fix(italic(c)); right;
@ @<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);
+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);
@@ -2562,33 +2552,30 @@ 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);
+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!');
+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));
+ 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);
+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;
+else begin left; out('VARCHAR'); out_ln;
@<Output the extensible pieces that exist@>;
right;
end
@@ -2609,10 +2596,10 @@ for d:=0 to 3 do begin
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;
+ 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
@@ -2651,9 +2638,9 @@ if ne>0 then
@* 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
+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
@@ -2667,7 +2654,7 @@ $$\vcenter{\halign{#\hfil\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
+@ To detect such loops, \.{VFtoVP} 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
@@ -2676,8 +2663,8 @@ $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
+$(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
@@ -2699,7 +2686,7 @@ $(x,y)$ in a hash table from which the values $z$ and $class$ can be read.
@d pending=4 {$f(x,y)$ is being evaluated}
@<Glob...@>=
-@!hash:array[0..hash_size] of integer;
+@!hash:array[0..hash_size] of integer64;
@!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|}
@@ -2711,31 +2698,30 @@ $(x,y)$ in a hash table from which the values $z$ and $class$ can be read.
@ @<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);
+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;
+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!');
+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];
+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 ');
+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);
+ 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
@@ -2750,19 +2736,20 @@ until i>=nl
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}
+label 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|}
+@!key:integer64; {value to be stored in |hash|}
+@!t64:integer64; {temporary register for swapping}
@!t:integer; {temporary register for swapping}
-begin if hash_ptr=hash_size then goto 30;
+begin if hash_ptr=hash_size then goto exit;
@<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}
+key:=int64cast(xmax_char)*c+y+1; h:=(hash_mult*key) mod hash_size;
+while hash[h]>0 do
+ begin if hash[h]<=key then
+ begin if hash[h]=key then goto exit; {unused ligature command}
+ t64:=hash[h]; hash[h]:=key; key:=t64; {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;
@@ -2770,10 +2757,10 @@ while hash[h]>0 do begin
end;
hash[h]:=key; class[h]:=cc; lig_z[h]:=zz;
incr(hash_ptr); hash_list[hash_ptr]:=h;
-30:end;
+exit:end;
-@ We must store kern commands as well as ligature commands, because
-the former might make the latter inapplicable.
+@ 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);
@@ -2791,11 +2778,11 @@ else begin case t of
@ 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@>
+@p function f(@!h:integer64;@!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;
+var @!key:integer64; {value sought in hash table}
+begin key:=int64cast(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}
@@ -2803,7 +2790,7 @@ 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.
+saying |function f(h:integer64;x,y:index):index| here.
@p function f;
begin case class[h] of
@@ -2815,10 +2802,8 @@ right_z: begin class[h]:=pending; lig_z[h]:=eval(x,lig_z[h]); class[h]:=simple;
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|}
+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;
@@ -2835,8 +2820,8 @@ 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;
+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);
@@ -2852,8 +2837,8 @@ exit:end;
@.Bad OVF file@>
@<Do the virtual font title@>=
-if string_balance(0,font_start[0]) then begin
- left; out('VTITLE ');
+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
@@ -2869,22 +2854,21 @@ 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;
+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;
+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;
+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;
+ 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;
@@ -2896,16 +2880,14 @@ 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 ');
+ 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 ');
+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
@@ -2928,19 +2910,18 @@ used by \.{DVI}-reading software.
if packet_start[c]=vf_size then
bad_vf('Missing packet for character ',c:1)
@.Missing packet@>
-else begin
- left; out('MAP'); out_ln;
+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);
+ 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!');
+ if top>0 then
+ begin bad_vf('More pushes than pops!');
@.More pushes than pops@>
repeat out('(POP)'); decr(top);@+until top=0;
end;
@@ -2951,15 +2932,15 @@ else begin
@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;
+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);
+while k>1 do
+ begin a:=a*256+vf[vf_ptr]; incr(vf_ptr); decr(k);
end;
get_bytes:=a;
end;
@@ -3165,8 +3146,8 @@ 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, ');
+if not perfect then
+ begin out('(COMMENT THE OFM AND/OR OVF FILE WAS BAD, ');
out('SO THE DATA HAS BEEN CHANGED!)');
write_ln(vpl_file);
end;