summaryrefslogtreecommitdiff
path: root/Build/source/texk/web2c/omegaware/ovp2ovf.web
diff options
context:
space:
mode:
Diffstat (limited to 'Build/source/texk/web2c/omegaware/ovp2ovf.web')
-rw-r--r--Build/source/texk/web2c/omegaware/ovp2ovf.web750
1 files changed, 348 insertions, 402 deletions
diff --git a/Build/source/texk/web2c/omegaware/ovp2ovf.web b/Build/source/texk/web2c/omegaware/ovp2ovf.web
index 3cab42c23f7..c09ed23af6b 100644
--- a/Build/source/texk/web2c/omegaware/ovp2ovf.web
+++ b/Build/source/texk/web2c/omegaware/ovp2ovf.web
@@ -15,6 +15,7 @@
% Version 1.0 of OVP2OVF (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}
@@ -35,7 +36,7 @@
\vfill
\centerline{\titlefont The {\ttitlefont OVP2OVF} processor}
\vskip 15pt
- \centerline{(Version 1.12, September 2009)}
+ \centerline{(Version 1.13, January 2014)}
\vfill}
\def\botofcontents{\vfill
\centerline{\hsize 5in\baselineskip9pt
@@ -71,8 +72,7 @@ called \.{PLFONT}.
The |banner| string defined here should be changed whenever \.{OVP2OVF}
gets modified.
-@d banner=='This is OVP2OVF, Version 1.12'
-{printed when the program starts}
+@d banner=='This is OVP2OVF, Version 1.13' {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
@@ -131,8 +131,7 @@ reduce \.{VPtoVF}'s capacity.
@!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
+@!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}
@@ -240,7 +239,7 @@ 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}'
+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.
@@ -263,8 +262,8 @@ 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.
+any order. For instance, `\.{SHRINK}' precedes `\.{STRETCH}' in the example
+above, 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
@@ -326,7 +325,7 @@ 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.
+from \.{cmr10} \.{at} \.{20\\u} 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.
@@ -516,7 +515,7 @@ The slashes specify retention of the left or right original character; the
`\.{(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
+design units, is often negative. Character code $c$ must exist
in the font.
\yskip\hang\.{STOP} (no value). This instruction ends a ligature/kern program.
@@ -525,8 +524,8 @@ 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.
+or \.{KRN} steps 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.
@@ -606,10 +605,10 @@ moves right, by the specified width.
value). The typesetter moves its current position
by the number of design units specified.
-\yskip\hang\.{PUSH} The current typesetter position is remembered, to
+\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
+\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.
@@ -817,16 +816,15 @@ error messages would not come out properly aligned.)
@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);
+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;
+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]);
+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
@@ -843,14 +841,14 @@ indentation conventions the user is following, if any.
@<Set |loc|...@>=
begin while (loc<limit)and(buffer[loc+1]=' ') do incr(loc);
-if loc<limit then begin
- if level=0 then
+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;
+ 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)
@@ -878,8 +876,7 @@ 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]];
+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)
@@ -906,8 +903,8 @@ 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');
+ if cur_char=invalid_code then
+ begin err_print('Illegal character in the file');
@.Illegal character...@>
cur_char:="?";
end;
@@ -922,13 +919,13 @@ 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 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;
+if (a<0)or(a>15) then
+ begin err_print('Illegal hexadecimal digit'); get_hex:=0;
@.Illegal hexadecimal digit@>
end
else get_hex:=a;
@@ -942,8 +939,8 @@ 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;
+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);
@@ -968,16 +965,16 @@ 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;
+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');
+ if xord[buffer[loc]]=invalid_code then
+ begin err_print('Illegal character in the file');
@.Illegal character...@>
vf_store("?");
end
@@ -1254,8 +1251,8 @@ begin for k:=1 to name_length do
{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);
+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;
@@ -1485,8 +1482,8 @@ 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}
+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;
@@ -1507,8 +1504,6 @@ and $2^{31}-1$, inclusive, so that a computer with two's complement
@ The first number scanner, which returns a one-byte value, surely has
no problems of arithmetic overflow.
-@d max_byte=@"FFFF
-
@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}
@@ -1538,10 +1533,10 @@ 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>max_byte then begin
- skip_error('This value shouldn''t exceed 65535');
+begin while (cur_char>="0")and(cur_char<="9") do
+ begin acc:=acc*10+cur_char-"0";
+ if acc>char_max then
+ begin skip_error('This value shouldn''t exceed 65535');
@.This value shouldn't...@>
acc:=0; cur_char:=" ";
end
@@ -1551,10 +1546,10 @@ 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>max_byte then begin
- skip_error('This value shouldn''t exceed ''177777');
+begin while (cur_char>="0")and(cur_char<="7") do
+ begin acc:=acc*8+cur_char-"0";
+ if acc>char_max then
+ begin skip_error('This value shouldn''t exceed ''177777');
@.This value shouldn't...@>
acc:=0; cur_char:=" ";
end
@@ -1565,11 +1560,11 @@ 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";
+ ((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>max_byte then begin
- skip_error('This value shouldn''t exceed "FFFF');
+ if acc>char_max then
+ begin skip_error('This value shouldn''t exceed "FFFF');
@.This value shouldn't...@>
acc:=0; cur_char:=" ";
end
@@ -1589,8 +1584,8 @@ 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');
+if acc>=18 then
+ begin skip_error('Illegal face code, I changed it to MRR');
@.Illegal face code...@>
acc:=0;
end;
@@ -1629,8 +1624,8 @@ 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;
+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
@@ -1650,14 +1645,12 @@ end;
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;@/
+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;
+ else begin cur_bytes:=zero_bytes;
if r=8 then
skip_error('Sorry, the maximum octal value is O 37777777777')
@.Sorry, the maximum...@>
@@ -1710,16 +1703,16 @@ end;
@ @<Scan the blanks...@>=
repeat get_next;
-if cur_char="-" then begin
- cur_char:=" "; negative:=not negative;
+if cur_char="-" then
+ begin cur_char:=" "; negative:=not negative;
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');
+if acc>=2048 then
+ begin skip_error('Real constants must be less than 2048');
@.Real constants must be...@>
acc:=0; cur_char:=" ";
end
@@ -1736,15 +1729,15 @@ $f=\lfloor(f^\prime+1)/2\rfloor$. It is possible to have $f=1.0$.
@ @<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");
+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);
+while j>0 do
+ begin acc:=fraction_digits[j]+(acc div 10); decr(j);
end;
acc:=(acc+10) div 20;
end
@@ -1886,9 +1879,8 @@ the other information that \.{TFM} files pack into a |char_info_word|.
@!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}
+@!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...@>=
@@ -1896,8 +1888,8 @@ the other information that \.{TFM} files pack into a |char_info_word|.
@ @<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;@/
+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}
@@ -1931,14 +1923,13 @@ 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');
+ 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;
+ 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;
@@ -1949,14 +1940,14 @@ end;
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
+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.)
+|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}
@@ -1968,8 +1959,8 @@ 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 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;
@@ -1984,14 +1975,14 @@ 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;
+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);
+ while k>m do
+ begin d:=next_d; k:=min_cover(h,d);
end;
shorten:=d;
end
@@ -2016,10 +2007,10 @@ var p:pointer; {the current node of interest}
@!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);
+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];
@@ -2042,8 +2033,8 @@ values as we go.
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');
+else if (cur_char=")")and not input_has_ended then
+ begin err_print('Extra right parenthesis');
incr(loc); cur_char:=" ";
end
@.Extra right parenthesis@>
@@ -2062,8 +2053,7 @@ 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.
+to recover with reasonable grace from various error conditions that might arise.
@<Read a font property value@>=
begin get_name;
@@ -2071,8 +2061,7 @@ if cur_code=comment_code then skip_to_end_of_item
else if cur_code>char_repeat_code 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|@>;
+else begin @<Read the font property value specified by |cur_code|@>;
finish_the_property;
end;
end
@@ -2085,8 +2074,8 @@ 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;
+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@>;
@@ -2095,8 +2084,8 @@ 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;
+ 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;
@@ -2136,19 +2125,19 @@ length of the rest of the string).
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);
+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,
+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;
+while k<l+n-1 do {tidy up the remaining bytes by setting them to nulls}
+ begin incr(k); header_bytes[k]:=0;
end;
end;
@@ -2188,8 +2177,8 @@ 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);
+ while header_ptr<4*c+4 do
+ begin header_bytes[header_ptr]:=0; incr(header_ptr);
end;
read_four_bytes(4*c);
end;
@@ -2227,9 +2216,8 @@ else begin if cur_code=parameter_code then c:=get_integer
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;
+ else begin while np<c do
+ begin incr(np); param[np]:=0;
end;
param[c]:=get_fix;
finish_the_property;
@@ -2245,8 +2233,8 @@ if cur_font=font_ptr then {it's a new font number}
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;
+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;
@@ -2269,27 +2257,25 @@ 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}
+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');
+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
@@ -2298,8 +2284,8 @@ 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');
+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
@@ -2323,20 +2309,19 @@ if cur_code=comment_code then skip_to_end_of_item
else if (cur_code<label_code)or(cur_code>ckrn_code) then
flush_error('This property name doesn''t belong in a LIGTABLE list')
@.This property name doesn't belong...@>
-else 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@>;
- 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| and |<=ckrn_code|}
+else 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@>;
+ 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| and |<=ckrn_code|}
finish_the_property;
end;
end
@@ -2344,7 +2329,7 @@ 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}
+@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');
@@ -2356,11 +2341,10 @@ 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}}
+if cur_char="B" then
+ begin bchar_label:=nl; skip_to_paren; {\.{LABEL BOUNDARYCHAR}}
end
-else begin
- backup; c:=get_byte;
+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;
@@ -2388,15 +2372,13 @@ else begin
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;
+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;
+ else begin lig_kern[nl-1].b0:=c;
if min_nl<=nl+c then min_nl:=nl+c+1;
end;
lk_step_ended:=false;
@@ -2418,10 +2400,9 @@ end
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');
+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;
@@ -2448,16 +2429,15 @@ end
@!penalty_category,@!max_penalty_category:integer;
@ @<Set init...@>=
-for ivalue_category:=0 to 256 do begin
- category_remainders[ivalue_category]:=-1;
-end;
+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;
+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;
@@ -2514,10 +2494,9 @@ 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');
+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;
@@ -2595,8 +2574,8 @@ if not tables_read then begin
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;
+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;
@@ -2649,6 +2628,10 @@ for c:=(cprime+1) to (cprime+crange) do begin
char_ht[c]:=char_ht[cprime];
char_dp[c]:=char_dp[cprime];
char_ic[c]:=char_ic[cprime];
+ char_tag[c]:=char_tag[cprime];
+ char_remainder[c]:=char_remainder[cprime];
+ packet_start[c]:=packet_start[cprime];
+ packet_length[c]:=packet_length[cprime];
for tab:=0 to (nki+nkf+nkm+nkr+nkg+nkp-1) do begin
char_table[c,tab]:= char_table[cprime,tab];
end;
@@ -2693,43 +2676,42 @@ if cur_code=comment_code then skip_to_end_of_item
else if (cur_code<char_wd_code)or(cur_code>var_char_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,
- sec_height_code,
- sec_depth_code,
- sec_italic_code,
- accent_code,
- prim_top_axis_code,
- prim_top_axis_bis_code,
- prim_bot_axis_code,
- prim_bot_axis_bis_code,
- prim_mid_hor_code,
- prim_mid_vert_code,
- prim_base_slant_code,
- sec_top_axis_code,
- sec_top_axis_bis_code,
- sec_bot_axis_code,
- sec_bot_axis_bis_code,
- sec_mid_hor_code,
- sec_mid_vert_code,
- 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: get_char_table_entry(nki)(0);
- char_fvalue_code: get_char_table_entry(nkf)(nki);
- char_mvalue_code: get_char_table_entry(nkm)(nki+nkf);
- char_rule_code: get_char_table_entry(nkr)(nki+nkf+nkm);
- char_glue_code: get_char_table_entry(nkg)(nki+nkf+nkm+nkr);
- char_penalty_code: get_char_table_entry(nkp)(nki+nkf+nkm+nkr+nkg);
- end;@/
+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,
+ sec_height_code,
+ sec_depth_code,
+ sec_italic_code,
+ accent_code,
+ prim_top_axis_code,
+ prim_top_axis_bis_code,
+ prim_bot_axis_code,
+ prim_bot_axis_bis_code,
+ prim_mid_hor_code,
+ prim_mid_vert_code,
+ prim_base_slant_code,
+ sec_top_axis_code,
+ sec_top_axis_bis_code,
+ sec_bot_axis_code,
+ sec_bot_axis_bis_code,
+ sec_mid_hor_code,
+ sec_mid_vert_code,
+ 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: get_char_table_entry(nki)(0);
+ char_fvalue_code: get_char_table_entry(nkf)(nki);
+ char_mvalue_code: get_char_table_entry(nkm)(nki+nkf);
+ char_rule_code: get_char_table_entry(nkr)(nki+nkf+nkm);
+ char_glue_code: get_char_table_entry(nkg)(nki+nkf+nkm+nkr);
+ char_penalty_code: get_char_table_entry(nkp)(nki+nkf+nkm+nkr+nkg);
+ end;@/
finish_the_property;
end;
end
@@ -2738,11 +2720,10 @@ end
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;@/
+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;
+ 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;
@@ -2758,13 +2739,12 @@ 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;@/
+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
@@ -2942,14 +2922,14 @@ var @!cc:char_type; {character being typeset}
@!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;
+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');
+while stack_ptr>0 do
+ begin err_print('Missing POP supplied');
@.Missing POP supplied@>
vf_store(pop); decr(stack_ptr);
end;
@@ -2963,17 +2943,16 @@ 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;@/
+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
@@ -2989,10 +2968,10 @@ end
@ @<Assemble a typesetting instruction@>=
if cur_font=font_ptr then
- err_print('Character cannot be typeset in undefined font')
+ err_print('Character cannot be typeset in undefined font')
@.Character cannot be typeset...@>
-else begin
- cc:=get_byte; vf_store_set(cc);
+else begin cc:=get_byte;
+ vf_store_set(cc);
end
@ Here's a procedure that converts a |fix_word| to a sequence of
@@ -3005,19 +2984,18 @@ var negative:boolean;
@!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
+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);
+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;
+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);
@@ -3031,22 +3009,22 @@ 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
+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 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
+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 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
@@ -3055,8 +3033,7 @@ end
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;
+else begin vf_store(push); hstack[stack_ptr]:=h; vstack[stack_ptr]:=v;
incr(stack_ptr); h:=0; v:=0;
end
@@ -3064,8 +3041,7 @@ else begin
if stack_ptr=0 then
err_print('Empty stack cannot be popped')
@.Empty stack...@>
-else begin
- vf_store(pop); decr(stack_ptr);
+else begin vf_store(pop); decr(stack_ptr);
h:=hstack[stack_ptr]; v:=vstack[stack_ptr];
end
@@ -3073,9 +3049,8 @@ else begin
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);
+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|@>
@@ -3083,13 +3058,12 @@ 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!');
+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];
+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;
@@ -3117,8 +3091,8 @@ 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|@>;
+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!');
@@ -3173,11 +3147,11 @@ check_existence_and_safety(exten[char_remainder[c]].b3)
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];
+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;
+ 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('.');
@@ -3217,11 +3191,11 @@ delta:=shorten(italic,top_italic); set_indices(italic,delta);
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);
+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);
+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;
@@ -3241,7 +3215,7 @@ where it is explained further.
@ @<Glo...@>=
@!lig_ptr:0..max_lig_steps; {an index into |lig_kern|}
-@!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|}
@@ -3259,6 +3233,8 @@ for k:=0 to hash_size do hash[k]:=0;
@<Check lig...@>=
begin lig_ptr:=char_remainder[c];
+if lig_kern[lig_ptr].b0<256 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
@@ -3273,9 +3249,10 @@ repeat if hash_input(lig_ptr,c) then begin
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
+if lig_kern[lig_ptr].b0>=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
@@ -3288,18 +3265,19 @@ 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|}
+@!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
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}
+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
+ begin hash_input:=false; goto 30; {unused ligature command}
end;
- t:=hash[h]; hash[h]:=key; key:=t; {do ordered-hash-table insertion}
+ 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;
@@ -3314,23 +3292,22 @@ hash_input:=true;
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}
+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@>
+@p function f(@!h:integer64;@!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;
+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}
@@ -3338,44 +3315,42 @@ 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.
+saying |function f(h:integer64;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}
+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 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 ');
+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);
+ 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;
+ 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
@@ -3414,8 +3389,8 @@ if nl>0 then for lig_ptr:=0 to nl-1 do
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');
+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');
@@ -3473,55 +3448,30 @@ going and writes the \.{TFM} anyway. In this case |ec| will be~0 and |bc|
will be~1.
@<Compute the subfile sizes@>=
+lh:=header_ptr div 4;@/
+not_found:=true; bc:=0;
+if (ofm_level=-1) then ec:=255 @+ else ec:=max_char;
+while not_found do
+ if (char_wd[bc]>0)or(bc=ec) then not_found:=false
+ else incr(bc);
+not_found:=true;
+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@>;
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+
@@ -3591,8 +3541,8 @@ 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]];
+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}
@@ -3626,6 +3576,7 @@ if ofm_level=1 then begin
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_tag[c]<>char_tag[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;
@@ -3695,8 +3646,8 @@ 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,
+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');
@@ -3705,12 +3656,11 @@ begin if abs(x/design_units)>=16.0 then begin
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
+ begin out(255); x:=x+@'100000000;
if x<=0 then x:=1;
end
-else begin
- out(0);
+else begin out(0);
if x>=@'100000000 then x:=@'77777777;
end;
n:=x div @'200000; m:=x mod @'200000;
@@ -3721,11 +3671,11 @@ end;
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}
+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]);
+ while p>0 do
+ begin out_scaled(memory[p]);
p:=link[p];
end;
end;
@@ -3751,24 +3701,23 @@ For this we need a sorted table of all relevant remainders.
@ @<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;
+if bchar<xmax_char then
+ begin extra_loc_needed:=true; lk_offset:=1;
end
-else begin
- extra_loc_needed:=false; lk_offset:=0;
+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;
+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];
+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;
@@ -3802,12 +3751,11 @@ else begin
{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;
+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@>=
@@ -3880,15 +3828,15 @@ else begin
@ 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
+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;
+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);
@@ -3911,8 +3859,7 @@ 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;
+else begin vout(255); x:=x+@'100000000;
end;
vout((x div @'200000) mod 256);
vout((x div @'400) mod 256); vout(x mod 256);
@@ -3940,8 +3887,8 @@ 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");
+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];
@@ -3950,12 +3897,11 @@ 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);
+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);
+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;