summaryrefslogtreecommitdiff
path: root/Build/source/texk/web2c/omegaware/opl2ofm.web
diff options
context:
space:
mode:
Diffstat (limited to 'Build/source/texk/web2c/omegaware/opl2ofm.web')
-rw-r--r--Build/source/texk/web2c/omegaware/opl2ofm.web674
1 files changed, 309 insertions, 365 deletions
diff --git a/Build/source/texk/web2c/omegaware/opl2ofm.web b/Build/source/texk/web2c/omegaware/opl2ofm.web
index 0008e898708..1d18184f58e 100644
--- a/Build/source/texk/web2c/omegaware/opl2ofm.web
+++ b/Build/source/texk/web2c/omegaware/opl2ofm.web
@@ -29,6 +29,7 @@
% and generate OFM files.
% 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}
@@ -49,7 +50,7 @@
\vfill
\centerline{\titlefont The {\ttitlefont OPL2OFM} processor}
\vskip 15pt
- \centerline{(Version 1.12, September 2009)}
+ \centerline{(Version 1.13, January 2014)}
\vfill}
\def\botofcontents{\vfill
\centerline{\hsize 5in\baselineskip9pt
@@ -84,7 +85,7 @@ apply to the \.{OPL2OFM} program and to \.{OFM} and \.{OPL} files.
The |banner| string defined here should be changed whenever \.{OPL2OFM}
gets modified.
-@d banner=='This is OPL2OFM, Version 1.12'
+@d banner=='This is OPL2OFM, 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
@@ -466,7 +467,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.
@@ -475,8 +476,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.
@@ -640,16 +641,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(pl_file);
+if left_ln then
+ begin if line>0 then read_ln(pl_file);
incr(line);
end;
-if eof(pl_file) then begin
- limit:=1; buffer[1]:=')'; right_ln:=false; input_has_ended:=true;
+if eof(pl_file) then
+ begin limit:=1; buffer[1]:=')'; right_ln:=false; input_has_ended:=true;
end
-else begin
- while (limit<buf_size-1)and(not eoln(pl_file)) do begin
- incr(limit); read(pl_file,buffer[limit]);
+else begin while (limit<buf_size-1)and(not eoln(pl_file)) do
+ begin incr(limit); read(pl_file,buffer[limit]);
end;
buffer[limit+1]:=' '; right_ln:=eoln(pl_file);
if left_ln then @<Set |loc| to the number of leading blanks in
@@ -666,14 +666,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)
@@ -701,8 +701,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)
@@ -728,9 +727,8 @@ begin while loc=limit do fill_buffer;
incr(loc); cur_char:=xord[buffer[loc]];
if cur_char>="a" then
if cur_char<="z" then cur_char:=cur_char-@'40 {uppercasify}
- else begin
- if cur_char=invalid_code then begin
- err_print('Illegal character in the file');
+ else begin if cur_char=invalid_code then
+ begin err_print('Illegal character in the file');
@.Illegal character...@>
cur_char:="?";
end;
@@ -746,8 +744,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);
@@ -837,8 +835,8 @@ var k:0..longest_name; {index into |cur_name|}
begin @<Compute the hash code, |cur_hash|, for |cur_name|@>;
not_found:=true;
cur_hash_reset:=false;
-while not_found do begin
- if (cur_hash=0) and (cur_hash_reset) then
+while not_found do
+ begin if (cur_hash=0) and (cur_hash_reset) then
not_found:=false
else begin
if cur_hash=0 then begin
@@ -1213,8 +1211,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;
@@ -1235,8 +1233,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}
@@ -1266,10 +1262,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
@@ -1281,8 +1277,8 @@ 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');
+ if acc>char_max then
+ begin skip_error('This value shouldn''t exceed ''177777');
@.This value shouldn't...@>
acc:=0; cur_char:=" ";
end
@@ -1293,11 +1289,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
@@ -1317,8 +1313,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;
@@ -1423,8 +1419,7 @@ negative:=false; acc:=0; {start with the accumulators zero}
if (cur_char<>"R")and(cur_char<>"D") then
skip_error('An "R" or "D" value is needed here')
@.An "R" or "D" ... needed here@>
-else begin
- @<Scan the blanks and/or signs after the type code@>;
+else begin @<Scan the blanks and/or signs after the type code@>;
while (cur_char>="0") and (cur_char<="9") do
@<Multiply by 10, add |cur_char-"0"|, and |get_next|@>;
int_part:=acc; acc:=0;
@@ -1439,16 +1434,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
@@ -1465,15 +1460,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
@@ -1550,11 +1545,11 @@ font_dir:=0;
@ Most of the dimensions, however, go into the |memory| array. There are
at most |max_char+2| widths, |max_char+2| heights, |max_char+2| depths,
-and |max_char+2| italic corrections, since the value 0 is required but
-it need not be used. So |memory| has room for |4*max_char+8| entries,
-each of which is a |fix_word|. An auxiliary table called |link| is
-used to link these words together in linear lists, so that sorting and
-other operations can be done conveniently.
+and |max_char+2| italic corrections,
+since the value 0 is required but it need not be used. So |memory| has room
+for |4*max_char+8| entries, each of which is a |fix_word|. An auxiliary table called
+|link| is used to link these words together in linear lists, so that
+sorting and other operations can be done conveniently.
We also add four ``list head'' words to the |memory| and |link| arrays;
these are in locations |width| through |italic|, i.e., 1 through 4.
@@ -1586,9 +1581,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...@>=
@@ -1596,8 +1590,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}
@@ -1628,8 +1622,7 @@ different sizes to the same character.
@p function sort_in(@!h:pointer;@!d:fix_word):pointer; {inserts into list}
var p:pointer; {the current node of interest}
begin if (d=0)and(h<>width) then sort_in:=0
-else begin
- p:=h;
+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
@@ -1638,8 +1631,7 @@ else begin
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;
@@ -1650,14 +1642,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.)
+distance between two list elements. (The covering by intervals of width
+|next_d| is not guaranteed to have fewer than $m$ elements, but in practice
+this seems to happen most of the time.)
@<Glob...@>=
@!next_d:fix_word; {the next larger interval that is worth trying}
@@ -1669,8 +1661,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;
@@ -1691,8 +1683,8 @@ begin if memory[h]>m then begin
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
@@ -1711,17 +1703,16 @@ end;
the list so that there is only one element per covering interval;
the remaining elements are the midpoints of their clusters.
-@p procedure set_indices(@!h:pointer;@!d:fix_word);
- {reduces and indexes a list}
+@p procedure set_indices(@!h:pointer;@!d:fix_word); {reduces and indexes a list}
var p:pointer; {the current node of interest}
@!q:pointer; {trails one step behind |p|}
@!m:byte; {index number of nodes in the current interval}
@!l:fix_word; {least value in the current interval}
begin q:=h; p:=link[q]; m:=0;
-while p<>0 do begin
- incr(m); l:=memory[p]; index[p]:=m;
- while memory[link[p]]<=l+d do begin
- p:=link[p]; index[p]:=m; decr(excess);
+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];
@@ -1742,8 +1733,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@>
@@ -1762,8 +1753,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;
@@ -1778,36 +1768,33 @@ end
@ @<Read the font property value spec...@>=
case cur_code of
- check_sum_code: begin
- check_sum_specified:=true;
- read_four_bytes(check_sum_loc);
- end;
- design_size_code: @<Read the design size@>;
- design_units_code: @<Read the design units@>;
- coding_scheme_code: read_BCPL(coding_scheme_loc,40);
- family_code: read_BCPL(family_loc,20);
- face_code: begin
- c:=get_byte; if c>255 then
- begin err_print('FACE clipped to 255'); c:=255 end;
- header_bytes[face_loc]:=c
- end;
- seven_bit_safe_flag_code: @<Read the seven-bit-safe flag@>;
- header_code: @<Read an indexed header word@>;
- font_dimen_code: @<Read font parameter list@>;
- lig_table_code: read_lig_kern;
- boundary_char_code: bchar:=get_byte;
- character_code: read_char_info;
- ofm_level_code: @<Read OFM level code@>;
- font_dir_code: @<Read font direction code@>;
- n_font_dir_code: @<Read natural font direction code@>;
- char_repeat_code: read_repeated_character_info;
- font_rule_code: read_font_rule_list;
- font_glue_code: read_font_glue_list;
- font_penalty_code: read_font_penalty_list;
- font_mvalue_code: read_font_mvalue_list;
- font_fvalue_code: read_font_fvalue_list;
- font_ivalue_code: read_font_ivalue_list;
- end
+check_sum_code: begin check_sum_specified:=true; read_four_bytes(check_sum_loc);
+ end;
+design_size_code: @<Read the design size@>;
+design_units_code: @<Read the design units@>;
+coding_scheme_code: read_BCPL(coding_scheme_loc,40);
+family_code: read_BCPL(family_loc,20);
+face_code: begin c:=get_byte; if c>255 then
+ begin err_print('FACE clipped to 255'); c:=255; end;
+ header_bytes[face_loc]:=c;
+ end;
+seven_bit_safe_flag_code: @<Read the seven-bit-safe flag@>;
+header_code: @<Read an indexed header word@>;
+font_dimen_code: @<Read font parameter list@>;
+lig_table_code: read_lig_kern;
+boundary_char_code: bchar:=get_byte;
+character_code: read_char_info;
+ofm_level_code: @<Read OFM level code@>;
+font_dir_code: @<Read font direction code@>;
+n_font_dir_code: @<Read natural font direction code@>;
+char_repeat_code: read_repeated_character_info;
+font_rule_code: read_font_rule_list;
+font_glue_code: read_font_glue_list;
+font_penalty_code: read_font_penalty_list;
+font_mvalue_code: read_font_mvalue_list;
+font_fvalue_code: read_font_fvalue_list;
+font_ivalue_code: read_font_ivalue_list;
+end
@ The |case| statement just given makes use of two subroutines that we
haven't defined yet. The first of these puts a 32-bit octal quantity
@@ -1830,19 +1817,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;
@@ -1878,9 +1865,8 @@ if c<18 then skip_error('HEADER indices should be 18 or more')
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);
+else begin while header_ptr<4*c+4 do
+ begin header_bytes[header_ptr]:=0; incr(header_ptr);
end;
read_four_bytes(4*c);
end;
@@ -1896,8 +1882,8 @@ there is probably a more elegant way to do this.
end
@<Read font parameter list@>=
-begin while level=1 do begin
- while cur_char=" " do get_next;
+begin while level=1 do
+ begin while cur_char=" " do get_next;
if cur_char="(" then @<Read a parameter value@>
else if cur_char=")" then skip_to_end_of_item
else junk_error;
@@ -1911,17 +1897,15 @@ if cur_code=comment_code then skip_to_end_of_item
else if (cur_code<parameter_code)or(cur_code>=char_wd_code) then
flush_error('This property name doesn''t belong in a FONTDIMEN list')
@.This property name doesn't belong...@>
-else begin
- if cur_code=parameter_code then c:=get_integer
+else begin if cur_code=parameter_code then c:=get_integer
else c:=cur_code-parameter_code;
if c<1 then flush_error('PARAMETER index must be at least 1')
@.PARAMETER index must be...@>
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;
@@ -1931,8 +1915,8 @@ end
@ @<Read ligature/kern list@>=
begin lk_step_ended:=false;
-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_lig_kern_command
else if cur_char=")" then skip_to_end_of_item
else junk_error;
@@ -1946,20 +1930,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
@@ -1969,21 +1952,20 @@ procedure so that an error message is given in case of multiple tags.
@p procedure check_tag(c:integer); {print error if |c| already tagged}
begin case char_tag[c] of
- no_tag: do_nothing;
- lig_tag: err_print('This character already appeared in a LIGTABLE LABEL');
+no_tag: do_nothing;
+lig_tag: err_print('This character already appeared in a LIGTABLE LABEL');
@.This character already...@>
- list_tag: err_print('This character already has a NEXTLARGER spec');
- ext_tag: err_print('This character already has a VARCHAR spec');
- end;
+list_tag: err_print('This character already has a NEXTLARGER spec');
+ext_tag: err_print('This character already has a VARCHAR spec');
+end;
end;
@ @<Read a label step@>=
begin while cur_char=" " do get_next;
-if cur_char="B" then begin
- bchar_label:=nl; skip_to_paren; {\.{LABEL BOUNDARYCHAR}}
+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;
@@ -2002,8 +1984,7 @@ end
if not lk_step_ended then
err_print('STOP must follow LIG or KRN')
@.STOP must follow LIG or KRN@>
-else begin
- lig_kern[nl-1].b0:=lig_kern[nl-1].b0 div 256 * 256 + stop_flag;
+else begin lig_kern[nl-1].b0:=lig_kern[nl-1].b0 div 256 * 256 + stop_flag;
lk_step_ended:=false;
end
@@ -2011,15 +1992,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;
@@ -2041,10 +2020,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;
@@ -2079,8 +2057,7 @@ 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;
@@ -2211,15 +2188,14 @@ tables_read:=false;
that is used most, the processing of individual character data.
@<Read character info list@>=
-begin
-if not tables_read then begin
- compute_new_header_ofm;
+begin if not tables_read then
+ begin compute_new_header_ofm;
tables_read:=true;
end;
c:=get_byte; {read the character code that is being specified}
@<Print |c| in hex notation@>;
-while level=1 do begin
- while cur_char=" " do get_next;
+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;
@@ -2272,6 +2248,8 @@ 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];
for tab:=0 to (nki+nkf+nkm+nkr+nkg+nkp-1) do begin
char_table[c,tab]:= char_table[cprime,tab];
end;
@@ -2316,42 +2294,41 @@ 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;
- 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;
+ 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
@@ -2360,11 +2337,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;
@@ -2380,13 +2356,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
@@ -2444,13 +2419,11 @@ while (c>0) or (j=0) do begin
print_digs(j);
end;
-
@ @<Print |c| in hex...@>=
-begin if chars_on_line=8 then begin
- print_ln(' '); chars_on_line:=1;
+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;
print_hex(c); {progress report}
@@ -2475,8 +2448,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!');
@@ -2504,13 +2477,13 @@ macros that are only slightly tricky.
@<For all characters |g| generated by |c|...@>=
case char_tag[c] of
- no_tag: do_nothing;
- lig_tag: @<Check ligature program of |c|@>;
- list_tag: check_existence_and_safety(char_remainder[c])
- ('The character NEXTLARGER than');
+no_tag: do_nothing;
+lig_tag: @<Check ligature program of |c|@>;
+list_tag: check_existence_and_safety(char_remainder[c])
+ ('The character NEXTLARGER than');
@.The character NEXTLARGER...@>
- ext_tag:@<Check the pieces of |exten[c]|@>;
- end
+ext_tag:@<Check the pieces of |exten[c]|@>;
+end
@ @<Check the pieces...@>=
begin if exten[char_remainder[c]].b0>0 then
@@ -2531,18 +2504,18 @@ 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('.');
end;
end
-@ @<Global...@>=
+@ @<Glob...@>=
@!delta:fix_word; {size of the intervals needed for rounding}
@ @d round_message(#)==if delta>0 then print_ln('I had to round some ',
@@ -2575,11 +2548,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 {make room for it} begin
- 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;
@@ -2599,7 +2572,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|}
@@ -2617,11 +2590,11 @@ for k:=0 to hash_size do hash[k]:=0;
@<Check lig...@>=
begin lig_ptr:=char_remainder[c];
-if (lig_kern[lig_ptr].b0 div 256)=0 then
+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
+repeat if hash_input(lig_ptr,c) then
+ begin if lig_kern[lig_ptr].b2<kern_flag then
+ begin if lig_exam<>bchar then
check_existence(lig_exam)('LIG character examined by');
@.LIG character examined...@>
check_existence(lig_gen)('LIG character generated by');
@@ -2633,7 +2606,7 @@ 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;
@@ -2649,18 +2622,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;
@@ -2675,23 +2649,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;
+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}
@@ -2699,46 +2672,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}
+begin case class[h] of
+simple: do_nothing;
+left_z: begin class[h]:=pending; lig_z[h]:=eval(lig_z[h],y); class[h]:=simple;
+ end;
+right_z: begin class[h]:=pending; lig_z[h]:=eval(x,lig_z[h]); class[h]:=simple;
+ end;
+both_z: begin class[h]:=pending; lig_z[h]:=eval(eval(x,lig_z[h]),y);
+ class[h]:=simple;
+ end;
+pending: begin x_lig_cycle:=x; y_lig_cycle:=y; lig_z[h]:=xxmax_char; class[h]:=simple;
+ end; {the value |xxmax_char| will break all cycles, since it's not in |hash|}
+end; {there are no other cases}
f:=lig_z[h];
end;
@ @<Check for infinite...@>=
-if hash_ptr<hash_size then for hh:=1 to hash_ptr do begin
- tt:=hash_list[hh];
+if 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
@@ -2768,17 +2737,17 @@ must fix such errors.
@<Doublecheck...@>=
if nl>0 then for lig_ptr:=0 to nl-1 do
if (lig_kern[lig_ptr].b0 div 256)=0 then begin
- if lig_kern[lig_ptr].b2<kern_flag then begin
- if lig_kern[lig_ptr].b0<255 then begin
- double_check_lig(b1)('LIG step'); double_check_lig(b3)('LIG step');
- end;
- end
- else double_check_lig(b1)('KRN step');
- end;
+ if lig_kern[lig_ptr].b2<kern_flag then
+ begin if lig_kern[lig_ptr].b0<255 then
+ begin double_check_lig(b1)('LIG step'); double_check_lig(b3)('LIG step');
+ end;
+ end
+ else double_check_lig(b1)('KRN step');
+ end;
@.Unused LIG step...@>
@.Unused KRN step...@>
-if ne>0 then for g:=0 to ne-1 do begin
- double_check_ext(b0)('VARCHAR TOP');
+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');
@@ -2817,7 +2786,7 @@ output_character_info;
@<Output the dimensions themselves@>;
@<Output the ligature/kern program@>;
@<Output the extensible character recipes@>;
-@<Output the parameters@>;
+@<Output the parameters@>
@ A \.{TFM} file begins with 12 numbers that tell how big its subfiles are.
We already know most of these numbers; for example, the number of distinct
@@ -2843,55 +2812,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+
@@ -2956,13 +2900,13 @@ header_bytes[design_size_loc]:=design_size div @'100000000;
header_bytes[design_size_loc+1]:=(design_size div @'200000) mod 256;
header_bytes[design_size_loc+2]:=(design_size div 256) mod 256;
header_bytes[design_size_loc+3]:=design_size mod 256;
-if not seven_unsafe then header_bytes[seven_flag_loc]:=128;
+if (not seven_unsafe)and(ofm_level=-1) then header_bytes[seven_flag_loc]:=128;
for j:=0 to header_ptr-1 do out(header_bytes[j]);
@ @<Compute the check sum@>=
begin c0:=bc; c1:=ec; c2:=bc; c3:=ec;
-for c:=bc to ec do if char_wd[c]>0 then begin
- temp_width:=memory[char_wd[c]];
+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}
@@ -2996,6 +2940,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;
@@ -3060,8 +3005,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');
@@ -3070,8 +3015,8 @@ 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);
@@ -3085,11 +3030,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;
@@ -3115,11 +3060,10 @@ 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
@@ -3135,10 +3079,10 @@ if bchar_label<xmax_label then begin
@ @<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;
@@ -3172,8 +3116,8 @@ 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]:=
+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;
@@ -3250,15 +3194,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);