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.web647
1 files changed, 301 insertions, 346 deletions
diff --git a/Build/source/texk/web2c/omegaware/ovp2ovf.web b/Build/source/texk/web2c/omegaware/ovp2ovf.web
index 69c1ded4d6b..5591ce52d88 100644
--- a/Build/source/texk/web2c/omegaware/ovp2ovf.web
+++ b/Build/source/texk/web2c/omegaware/ovp2ovf.web
@@ -1,4 +1,4 @@
-%
+%
% This file is part of the Omega project, which
% is based in the web2c distribution of TeX.
%
@@ -1057,7 +1057,7 @@ var k:0..longest_name; {index into |cur_name|}
@!cur_hash_reset:boolean;
begin @<Compute the hash code, |cur_hash|, for |cur_name|@>;
not_found:=true;
-cur_hash_reset:=false;
+cur_hash_reset:=false;
while not_found do begin
if (cur_hash=0) and (cur_hash_reset) then
not_found:=false
@@ -1075,7 +1075,7 @@ while not_found do begin
for k:=1 to name_length do
if dictionary[j+k-1]<>cur_name[k] then not_found:=true;
end
- end
+ end
end
end;
name_ptr:=nhash[cur_hash];
@@ -1091,6 +1091,7 @@ dictionary is kept in |equiv[k]|. The numeric |equiv| codes are given
symbolic meanings by the following definitions.
@d comment_code=0
+@#{property names at the outer level}
@d check_sum_code=1
@d design_size_code=2
@d design_units_code=3
@@ -1104,15 +1105,20 @@ symbolic meanings by the following definitions.
@d boundary_char_code=11
@d virtual_title_code=12
@d map_font_code=13
-@d font_dir_code=14
-@d n_font_dir_code=15
-@d character_code=16
-@d font_name_code=21
-@d font_area_code=22
-@d font_checksum_code=23
-@d font_at_code=24
-@d font_dsize_code=25
+@d character_code=14
+@d font_dir_code=15
+@d n_font_dir_code=16
+@d ofm_level_code=17
+@d font_rule_code=18
+@d font_glue_code=19
+@d font_penalty_code=20
+@d font_mvalue_code=21
+@d font_fvalue_code=22
+@d font_ivalue_code=23
+@d char_repeat_code=24
+@#{property names in a FONTDIMEN list}
@d parameter_code=30
+@#{property names in a CHARACTER list}
@d char_info_code=70
@d width=1
@d height=2
@@ -1162,36 +1168,31 @@ symbolic meanings by the following definitions.
@d sec_base_slant_code=char_info_code+sec_base_slant
@d next_larger_code=100
@d map_code=101
-@d var_char_code=102
-@d select_font_code=110
-@d set_char_code=111
-@d set_rule_code=112
-@d move_right_code=113
-@d move_down_code=115
-@d push_code=117
-@d pop_code=118
-@d special_code=119
-@d special_hex_code=120
+@d char_ivalue_code=111
+@d char_fvalue_code=112
+@d char_mvalue_code=113
+@d char_rule_code=114
+@d char_glue_code=115
+@d char_penalty_code=116
+@d var_char_code=117
+@#{property names in a LIGTABLE list}
@d label_code=130
@d stop_code=131
@d skip_code=132
@d krn_code=133
@d lig_code=134
-@d ofm_level_code=140
-@d char_repeat_code=150
-@d char_ivalue_code=151
-@d char_fvalue_code=152
-@d char_mvalue_code=153
-@d char_rule_code=154
-@d char_glue_code=155
-@d char_penalty_code=156
-@d font_rule_code=160
-@d rule_code=161
+@d clabel_code=150
+@d cpen_code=151
+@d cglue_code=152
+@d cpenglue_code=153
+@d ckrn_code=154
+@#{property names in a FONTRULE list}
+@d rule_code=161
@d rule_width_code=162
@d rule_height_code=163
@d rule_depth_code=164
-@d font_glue_code=170
-@d glue_code=171
+@#{property names in a FONTGLUE list}
+@d glue_code=171
@d glue_type_code=172
@d glue_stretch_order_code=173
@d glue_shrink_order_code=174
@@ -1200,40 +1201,34 @@ symbolic meanings by the following definitions.
@d glue_shrink_code=177
@d glue_char_code=178
@d glue_rule_code=179
-@d order_unit_code=181
-@d order_fi_code=182
-@d order_fil_code=183
-@d order_fill_code=184
-@d order_filll_code=185
-@d type_normal_code=186
-@d type_aleaders_code=187
-@d type_cleaders_code=188
-@d type_xleaders_code=189
-@d font_penalty_code=190
-@d penalty_code=191
+@#{property names in a FONTPENALTY list}
+@d penalty_code=191
@d penalty_val_code=192
-@d font_mvalue_code=200
-@d mvalue_code=201
-@d mvalue_val_code=202
-@d font_fvalue_code=210
-@d fvalue_code=211
-@d fvalue_val_code=212
-@d font_ivalue_code=220
-@d ivalue_code=221
-@d ivalue_val_code=222
-@d clabel_code=231
-@d cpen_code=232
-@d cglue_code=233
-@d cpenglue_code=234
-@d ckrn_code=235
-@d TL_dir_code=240
-@d LT_dir_code=241
-@d TR_dir_code=242
-@d LB_dir_code=243
-@d BL_dir_code=244
-@d RT_dir_code=245
-@d BR_dir_code=246
-@d RB_dir_code=247
+@#{property names in a FONTMVALUE list}
+@d mvalue_code=193
+@d mvalue_val_code=194
+@#{property names in a FONTFVALUE list}
+@d fvalue_code=195
+@d fvalue_val_code=196
+@#{property names in a FONTIVALUE list}
+@d ivalue_code=197
+@d ivalue_val_code=198
+@#{property names in a MAPFONT list}
+@d font_name_code=200
+@d font_area_code=201
+@d font_checksum_code=202
+@d font_at_code=203
+@d font_dsize_code=204
+@#{property names in a MAP list}
+@d select_font_code=210
+@d set_char_code=211
+@d set_rule_code=212
+@d move_right_code=213
+@d move_down_code=215
+@d push_code=217
+@d pop_code=218
+@d special_code=219
+@d special_hex_code=220
@<Glo...@>=
@!equiv:array[0..max_name_index] of byte;
@@ -1400,15 +1395,6 @@ load8("G")("L")("U")("E")("C")("H")("A")("R")(glue_char_code);@/
load6("G")("L")("U")("E")("W")("D")(glue_width_code);@/
load11("G")("L")("U")("E")("S")("T")("R")("E")("T")("C")("H")(glue_stretch_code);@/
load10("G")("L")("U")("E")("S")("H")("R")("I")("N")("K")(glue_shrink_code);@/
-load4("U")("N")("I")("T")(order_unit_code);@/
-load2("F")("I")(order_fi_code);@/
-load3("F")("I")("L")(order_fil_code);@/
-load4("F")("I")("L")("L")(order_fill_code);@/
-load5("F")("I")("L")("L")("L")(order_filll_code);@/
-load6("N")("O")("R")("M")("A")("L")(type_normal_code);@/
-load8("A")("L")("E")("A")("D")("E")("R")("S")(type_aleaders_code);@/
-load8("C")("L")("E")("A")("D")("E")("R")("S")(type_cleaders_code);@/
-load8("X")("L")("E")("A")("D")("E")("R")("S")(type_xleaders_code);@/
load11("F")("O")("N")("T")("P")("E")("N")("A")("L")("T")("Y")(font_penalty_code);@/
load7("P")("E")("N")("A")("L")("T")("Y")(penalty_code);@/
load10("P")("E")("N")("A")("L")("T")("Y")("V")("A")("L")(penalty_val_code);@/
@@ -1421,14 +1407,6 @@ load9("F")("V")("A")("L")("U")("E")("V")("A")("L")(fvalue_val_code);@/
load10("F")("O")("N")("T")("I")("V")("A")("L")("U")("E")(font_ivalue_code);@/
load6("I")("V")("A")("L")("U")("E")(ivalue_code);@/
load9("I")("V")("A")("L")("U")("E")("V")("A")("L")(ivalue_val_code);@/
-load2("T")("L")(TL_dir_code);
-load2("L")("T")(LT_dir_code);
-load2("T")("R")(TR_dir_code);
-load2("L")("B")(LB_dir_code);
-load2("B")("L")(BL_dir_code);
-load2("R")("T")(RT_dir_code);
-load2("B")("R")(BR_dir_code);
-load2("R")("B")(RB_dir_code);
@ \.{VPL} files may contain the following in addition to the \.{PL} names.
@@ -2081,9 +2059,7 @@ might arise.
@<Read a font property value@>=
begin get_name;
if cur_code=comment_code then skip_to_end_of_item
-else if (cur_code<110) and (cur_code>character_code) then
- flush_error('This property name doesn''t belong on the outer level')
-else if (cur_code>=110) and ((cur_code mod 10)<>0) then
+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
@@ -2335,7 +2311,10 @@ end
@ @<Read a ligature/kern command@>=
begin get_name;
if cur_code=comment_code then skip_to_end_of_item
-else if (cur_code>=label_code) and (cur_code<=(lig_code+11)) then begin
+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@>;
@@ -2343,21 +2322,14 @@ else if (cur_code>=label_code) and (cur_code<=(lig_code+11)) then begin
krn_code:@<Read a kerning step@>;
lig_code,lig_code+1,lig_code+2,lig_code+3,lig_code+5,lig_code+6,
lig_code+7,lig_code+11:@<Read a ligature step@>;
- end; {there are no other cases |>=label_code|}
- finish_the_property;
- end
-else if (cur_code>=clabel_code) and (cur_code<=cpenglue_code) then begin
- case cur_code of
clabel_code:@<Read an extended label step@>;
cpen_code:@<Read an extended penalty step@>;
cglue_code:@<Read an extended glue step@>;
cpenglue_code:@<Read an extended penalty/glue step@>;
ckrn_code:@<Read an extended kern step@>;
- end; {there are no other cases |>=label_code|}
+ end; {there are no other cases |>=label_code| and |<=ckrn_code|}
finish_the_property;
- end
-else flush_error('This property name doesn''t belong in a LIGTABLE list');
-@.This property name doesn't belong...@>
+ end;
end
@ When a character is about to be tagged, we call the following
@@ -2445,11 +2417,11 @@ if krn_ptr=nk then begin
decr(krn_ptr);
end;
end;
-if ofm_level=-1 then begin
+if ofm_level=-1 then begin
lig_kern[nl].b2:=kern_flag+(krn_ptr div 256);
lig_kern[nl].b3:=krn_ptr mod 256;
- end
-else begin
+ end
+else begin
lig_kern[nl].b2:=kern_flag+(krn_ptr div 65536);
lig_kern[nl].b3:=krn_ptr mod 65536;
end;
@@ -2592,9 +2564,9 @@ if max_ivalue_category>0 then begin
end;
end;
end;
- end;
- end;
- end;
+ end;
+ end;
+ end;
end
@ @<Global...@>=
@@ -2610,7 +2582,7 @@ that is used most, the processing of individual character data.
begin
if not tables_read then begin
@<Compute the new header information for OFM files@>;
- tables_read:=true;
+ tables_read:=true;
end;
c:=get_byte; {read the character code that is being specified}
@<Print |c| in hex notation@>;
@@ -2668,7 +2640,7 @@ 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];
- for tab:=0 to (nki+nkf+nkr+nkg+nkp-1) do begin
+ for tab:=0 to (nki+nkf+nkm+nkr+nkg+nkp-1) do begin
char_table[c,tab]:= char_table[cprime,tab];
end;
end;
@@ -2688,13 +2660,28 @@ for c:=0 to max_char do
for ch_table:=0 to char_param_tables do
char_table[c,ch_table]:=0;
-@ @<Read a character property@>=
+@ @d get_char_table_entry(#)==
+ begin ch_table:=get_integer;
+ if (ch_table<0)or(ch_table>=#) then
+ flush_error('Character property index out of range')
+@.Character property index...@>
+ else begin get_char_table_entry_end
+@d get_char_table_entry_end(#)==
+ ch_table:=ch_table+#;
+ if ch_table>char_param_tables then
+ flush_error('Character property exceeds table size')
+@.Character property exceeds...@>
+ else begin
+ if ch_table>npc then npc:=ch_table;
+ char_table[c,ch_table]:=get_integer;
+ end;
+ end;
+ end
+
+@<Read a character property@>=
begin get_name;
if cur_code=comment_code then skip_to_end_of_item
-else if (cur_code<char_wd_code) or
- ((cur_code>var_char_code) and not
- ((cur_code>=char_ivalue_code) and (cur_code<=char_penalty_code)))
- then
+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
@@ -2703,66 +2690,36 @@ else begin
char_ht_code:char_ht[c]:=sort_in(height,get_fix);
char_dp_code:char_dp[c]:=sort_in(depth,get_fix);
char_ic_code:char_ic[c]:=sort_in(italic,get_fix);
- sec_width_code:temp_value:=get_fix;
- sec_height_code:temp_value:=get_fix;
- sec_depth_code:temp_value:=get_fix;
- sec_italic_code:temp_value:=get_fix;
- accent_code:temp_value:=get_fix;
- prim_top_axis_code:temp_value:=get_fix;
- prim_top_axis_bis_code:temp_value:=get_fix;
- prim_bot_axis_code:temp_value:=get_fix;
- prim_bot_axis_bis_code:temp_value:=get_fix;
- prim_mid_hor_code:temp_value:=get_fix;
- prim_mid_vert_code:temp_value:=get_fix;
- prim_base_slant_code:temp_value:=get_fix;
- sec_top_axis_code:temp_value:=get_fix;
- sec_top_axis_bis_code:temp_value:=get_fix;
- sec_bot_axis_code:temp_value:=get_fix;
- sec_bot_axis_bis_code:temp_value:=get_fix;
- sec_mid_hor_code:temp_value:=get_fix;
- sec_mid_vert_code:temp_value:=get_fix;
+ sec_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: begin
- ch_table:=get_integer;
- ch_entry:=get_integer;
- char_table[c,ch_table]:=ch_entry;
- if ch_table>nkci then nkci:=ch_table;
- end;
- char_fvalue_code: begin
- ch_table:=get_integer+nki;
- ch_entry:=get_integer;
- char_table[c,ch_table]:=ch_entry;
- if ch_table>nkcf then nkcf:=ch_table;
- end;
- char_mvalue_code: begin
- ch_table:=get_integer+nki+nkf;
- ch_entry:=get_integer;
- char_table[c,ch_table]:=ch_entry;
- if ch_table>nkcm then nkcm:=ch_table;
- end;
- char_rule_code: begin
- ch_table:=get_integer+nki+nkf+nkm;
- ch_entry:=get_integer;
- char_table[c,ch_table]:=ch_entry;
- if ch_table>nkcr then nkcr:=ch_table;
- end;
- char_glue_code: begin
- ch_table:=get_integer+nki+nkf+nkm+nkr;
- ch_entry:=get_integer;
- char_table[c,ch_table]:=ch_entry;
- if ch_table>nkcg then nkcg:=ch_table;
- end;
- char_penalty_code: begin
- ch_table:=get_integer+nki+nkf+nkm+nkr+nkg;
- ch_entry:=get_integer;
- char_table[c,ch_table]:=ch_entry;
- if ch_table>nkcp then nkcp:=ch_table;
- end;
+ 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;
@@ -2808,18 +2765,18 @@ which prints a progress report as the file is being read.
@ @<Glob...@>=
@!HEX: packed array [1..32] of char;
-
+
@ @<Set init...@>=
HEX:='0123456789ABCDEF';@/
-
+
@ The array |dig| will hold a sequence of digits to be output.
-
+
@<Glob...@>=
@!dig:array[0..32] of integer;
-
+
@ Here, in fact, are two procedures that output
|dig[j-1]|$\,\ldots\,$|dig[0]|, given $j>0$.
-
+
@p procedure out_digs(j:integer); {outputs |j| digits}
begin repeat decr(j); out(HEX[1+dig[j]]);
until j=0;
@@ -2829,10 +2786,10 @@ procedure print_digs(j:integer); {prints |j| digits}
begin repeat decr(j); print(HEX[1+dig[j]]);
until j=0;
end;
-
+
@ The |print_number| procedure indicates how |print_digs| can be used.
This procedure can print in octal, decimal or hex notation.
-
+
@d print_hex(#)==print_number(#,16)
@d print_octal(#)==print_number(#,8)
@d print_decimal(#)==print_number(#,10)
@@ -3235,7 +3192,7 @@ case ofm_level of
-1: begin
top_width:=255; top_depth:=15; top_height:=15; top_italic:=63;
end;
- 0: begin
+ 0: begin
top_width:=65535; top_depth:=255; top_height:=255; top_italic:=255;
end;
1: begin
@@ -3504,6 +3461,9 @@ and the total number of words in the \.{TFM} file (|lf|).
@!temp_width:fix_word; {width being used to compute a check sum}
@!ncw,@!nco,@!npc:integer;
+@ @<Set init...@>=
+npc:=-1;
+
@ It might turn out that no characters exist at all. But \.{VPtoVF} keeps
going and writes the \.{TFM} anyway. In this case |ec| will be~0 and |bc|
will be~1.
@@ -3650,18 +3610,7 @@ end
@<Compute the character info size@>=
if ofm_level=1 then begin
ncw:=0;
- if nkcp>-1 then
- npc:=nki+nkf+nkr+nkg+nkcp+1
- else if nkcg>-1 then
- npc:=nki+nkf+nkr+nkcg+1
- else if nkcr>-1 then
- npc:=nki+nkf+nkcr+1
- else if nkcf>-1 then
- npc:=nki+nkcf+1
- else if nkci>-1 then
- npc:=nkci+1
- else
- npc:=0;
+ incr(npc);
needed_space:=(12+npc*2) div 4;
extra_bytes:=(needed_space*4) - (10+npc*2);
for c:=bc to ec do begin
@@ -3687,7 +3636,7 @@ if ofm_level=1 then begin
end;
ncw:=ncw+needed_space;
end;
- end;
+ end;
end;
@ The next block contains packed |char_info|.
@@ -3712,7 +3661,7 @@ case ofm_level of
out(index[char_ht[c]]); out(index[char_dp[c]]);
out(index[char_ic[c]]); out(char_tag[c]);
out(char_remainder[c] div 256); out(char_remainder[c] mod 256);
- end;
+ end;
1: begin
if c=char_original[c] then begin
out(index[char_wd[c]] div 256); out(index[char_wd[c]] mod 256);
@@ -3721,18 +3670,18 @@ case ofm_level of
tab:=char_tag[c];
if char_extended_tag[c] then begin
tab:=5;
- end;
+ end;
out(tab);
out(char_remainder[c] div 256); out(char_remainder[c] mod 256);
out_size(char_repeats[c]);
for tab:=0 to npc-1 do begin
out(char_table[c,tab] div 256); out(char_table[c,tab] mod 256);
- end;
+ end;
for tab:=1 to extra_bytes do begin
out(0);
- end;
- end;
- end;
+ end;
+ end;
+ end;
end;
@ When a scaled quantity is output, we may need to divide it by |design_units|.
@@ -3825,7 +3774,7 @@ for c:=bc to ec do if char_tag[c]=lig_tag then begin
@ @<Find the minimum |lk_offset| and adjust all remainders@>=
begin sort_ptr:=label_ptr; {the largest unallocated label}
-if ofm_level=-1 then begin
+if ofm_level=-1 then begin
if label_table[sort_ptr].rr+lk_offset > 255 then begin
lk_offset:=0; extra_loc_needed:=false; {location 0 can do double duty}
repeat char_remainder[label_table[sort_ptr].cc]:=lk_offset;
@@ -3836,8 +3785,8 @@ if ofm_level=-1 then begin
until lk_offset+label_table[sort_ptr].rr<256;
{N.B.: |lk_offset=256| satisfies this when |sort_ptr=0|}
end;
- end
-else begin
+ end
+else begin
if label_table[sort_ptr].rr+lk_offset > 65535 then begin
lk_offset:=0; extra_loc_needed:=false; {location 0 can do double duty}
repeat char_remainder[label_table[sort_ptr].cc]:=lk_offset;
@@ -3896,7 +3845,7 @@ else begin
out_size((t+lk_offset) div 256);
out_size((t+lk_offset) mod 256);
repeat decr(label_ptr); until label_table[label_ptr].rr<t;
- end;
+ end;
if nl>0 then for lig_ptr:=0 to nl-1 do begin
out_size(lig_kern[lig_ptr].b0);
out_size(lig_kern[lig_ptr].b1);
@@ -4171,7 +4120,7 @@ case cur_char of
end;
while cur_char<>")" do get_next;
if font_dir = -1 then begin
- flush_error('FONTDIR must be valid direction, -- TR assumed');
+ flush_error('FONTDIR must be valid direction, -- TL assumed');
font_dir:=0;
end;
end
@@ -4201,7 +4150,7 @@ case cur_char of
end;
while cur_char<>")" do get_next;
if font_dir = -1 then begin
- flush_error('NFONTDIR must be valid direction, -- TR assumed');
+ flush_error('NFONTDIR must be valid direction, -- TL assumed');
font_dir:=8;
end;
end
@@ -4231,7 +4180,6 @@ end;
@!rules:array[rule_array_type,rule_entry_type] of rule_node;
@!npr:array[rule_array_type] of integer;
@!nkr:integer;
-@!nkcr:integer;
@!nwr:integer;
@!r_array:integer;
@!r_number:integer;
@@ -4242,7 +4190,6 @@ for r_array := 0 to rule_arrays do begin
@<Null out the rule@>;
end;
nkr:=-1;
-nkcr:=-1;
@ @<Read font rule list@>=
begin
@@ -4264,28 +4211,28 @@ else begin
finish_inner_property_list;
end;
end
-
-@ @<Read a rule@>=
+
+@ @<Read a rule@>=
begin
-get_name;
-if cur_code=comment_code then skip_to_end_of_item
-else if cur_code<>rule_code then
- flush_error('This property name doesn''t belong in a RULE list')
+get_name;
+if cur_code=comment_code then skip_to_end_of_item
+else if cur_code<>rule_code then
+ flush_error('This property name doesn''t belong in a FONTRULE list')
else begin
r_number:=get_integer;
- if r_number>rule_entries then
- flush_error('This RULE index is too big for my present table size')
+ if r_number>rule_entries then
+ flush_error('This RULE index is too big for my present table size')
else if r_number<0 then
flush_error('This RULE index is negative')
else begin
while npr[r_array]<r_number do begin
incr(npr[r_array]); @<Null out the rule@>;
- end;
+ end;
@<Read all of a rule's values@>;
- finish_the_property;
+ finish_the_property;
end;
- end;
-end
+ end;
+end
@ @<Null out the rule@>=
begin
@@ -4308,15 +4255,20 @@ end
@ @<Read a single rule value@>=
begin
get_name;
-case cur_code of
- rule_width_code:
- rules[r_array,r_number].rn_width:=get_fix;
- rule_height_code:
- rules[r_array,r_number].rn_height:=get_fix;
- rule_depth_code:
- rules[r_array,r_number].rn_depth:=get_fix;
- end;
-finish_the_property;
+if cur_code=comment_code then skip_to_end_of_item
+else if (cur_code<rule_width_code)or(cur_code>rule_depth_code) then
+ flush_error('This property name doesn''t belong in a RULE list')
+else begin
+ case cur_code of
+ rule_width_code:
+ rules[r_array,r_number].rn_width:=get_fix;
+ rule_height_code:
+ rules[r_array,r_number].rn_height:=get_fix;
+ rule_depth_code:
+ rules[r_array,r_number].rn_depth:=get_fix;
+ end;
+ finish_the_property;
+ end;
end
@ @<Header information for rules@>=
@@ -4350,7 +4302,7 @@ end
@!glue_arrays=arrays_per_kind;
@!glue_entries=entries_per_array;
-@
+@
@d t_normal==0
@d t_aleaders==1
@d t_cleaders==2
@@ -4385,7 +4337,6 @@ end;
@!glues:array[glue_array_type,glue_entry_type] of glue_node;
@!npg:array[glue_array_type] of integer;
@!nkg:integer;
-@!nkcg:integer;
@!nwg:integer;
@!g_array:integer;
@!g_byte:integer;
@@ -4398,7 +4349,6 @@ begin
@<Null out the glue@>;
end;
nkg:=-1;
-nkcg:=-1;
@ @<Read font glue list@>=
begin
@@ -4420,28 +4370,28 @@ else begin
finish_inner_property_list;
end;
end
-
-@ @<Read a glue@>=
+
+@ @<Read a glue@>=
begin
-get_name;
-if cur_code=comment_code then skip_to_end_of_item
-else if cur_code<>glue_code then
- flush_error('This property name doesn''t belong in a GLUE list')
+get_name;
+if cur_code=comment_code then skip_to_end_of_item
+else if cur_code<>glue_code then
+ flush_error('This property name doesn''t belong in a FONTGLUE list')
else begin
g_number:=get_integer;
- if g_number>glue_entries then
- flush_error('This GLUE index is too big for my present table size')
+ if g_number>glue_entries then
+ flush_error('This GLUE index is too big for my present table size')
else if g_number<0 then
flush_error('This GLUE index is negative')
else begin
while npg[g_array]<g_number do begin
incr(npg[g_array]); @<Null out the glue@>;
- end;
+ end;
@<Read all of a glue's values@>;
- finish_the_property;
- end;
- end;
-end
+ finish_the_property;
+ end;
+ end;
+end
@ @<Null out the glue@>=
begin
@@ -4469,44 +4419,49 @@ end
@ @<Read a single glue value@>=
begin
get_name;
-case cur_code of
- glue_width_code:
- glues[g_array,g_number].gn_width:=get_fix;
- glue_stretch_code:
- glues[g_array,g_number].gn_stretch:=get_fix;
- glue_shrink_code:
- glues[g_array,g_number].gn_shrink:=get_fix;
- glue_type_code: begin
- g_byte:=get_integer;
- if (g_byte<0) or (g_byte>3) then begin
- g_byte:=0;
+if cur_code=comment_code then skip_to_end_of_item
+else if (cur_code<glue_type_code)or(cur_code>glue_rule_code) then
+ flush_error('This property name doesn''t belong in a GLUE list')
+else begin
+ case cur_code of
+ glue_width_code:
+ glues[g_array,g_number].gn_width:=get_fix;
+ glue_stretch_code:
+ glues[g_array,g_number].gn_stretch:=get_fix;
+ glue_shrink_code:
+ glues[g_array,g_number].gn_shrink:=get_fix;
+ glue_type_code: begin
+ g_byte:=get_integer;
+ if (g_byte<0) or (g_byte>3) then begin
+ g_byte:=0;
+ end;
+ glues[g_array,g_number].gn_type:=g_byte;
end;
- glues[g_array,g_number].gn_type:=g_byte;
- end;
- glue_stretch_order_code: begin
- g_byte:=get_integer;
- if (g_byte<0) or (g_byte>4) then begin
- g_byte:=0;
+ glue_stretch_order_code: begin
+ g_byte:=get_integer;
+ if (g_byte<0) or (g_byte>4) then begin
+ g_byte:=0;
+ end;
+ glues[g_array,g_number].gn_stretch_order:=g_byte;
end;
- glues[g_array,g_number].gn_stretch_order:=g_byte;
- end;
- glue_shrink_order_code: begin
- g_byte:=get_integer;
- if (g_byte<0) or (g_byte>4) then begin
- g_byte:=0;
+ glue_shrink_order_code: begin
+ g_byte:=get_integer;
+ if (g_byte<0) or (g_byte>4) then begin
+ g_byte:=0;
+ end;
+ glues[g_array,g_number].gn_shrink_order:=g_byte;
+ end;
+ glue_char_code: begin
+ glues[g_array,g_number].gn_argument:=get_integer;
+ glues[g_array,g_number].gn_arg_type:=g_char;
+ end;
+ glue_rule_code: begin
+ glues[g_array,g_number].gn_argument:=get_integer;
+ glues[g_array,g_number].gn_arg_type:=g_rule;
end;
- glues[g_array,g_number].gn_shrink_order:=g_byte;
- end;
- glue_char_code: begin
- glues[g_array,g_number].gn_argument:=get_integer;
- glues[g_array,g_number].gn_arg_type:=g_char;
- end;
- glue_rule_code: begin
- glues[g_array,g_number].gn_argument:=get_integer;
- glues[g_array,g_number].gn_arg_type:=g_rule;
end;
+ finish_the_property;
end;
-finish_the_property;
end
@ @<Header information for glues@>=
@@ -4562,7 +4517,6 @@ end;
@!penalties:array[penalty_array_type,penalty_entry_type] of penalty_node;
@!npp:array[penalty_array_type] of integer;
@!nkp:integer;
-@!nkcp:integer;
@!nwp:integer;
@!p_array:integer;
@!p_number:integer;
@@ -4573,7 +4527,6 @@ for p_array := 0 to penalty_arrays do begin
@<Null out the penalty@>;
end;
nkp:=-1;
-nkcp:=-1;
@ @<Read font penalty list@>=
begin
@@ -4595,28 +4548,28 @@ else begin
finish_inner_property_list;
end;
end
-
-@ @<Read a penalty@>=
+
+@ @<Read a penalty@>=
begin
-get_name;
-if cur_code=comment_code then skip_to_end_of_item
-else if cur_code<>penalty_code then
- flush_error('This property name doesn''t belong in a PENALTY list')
+get_name;
+if cur_code=comment_code then skip_to_end_of_item
+else if cur_code<>penalty_code then
+ flush_error('This property name doesn''t belong in a FONTPENALTY list')
else begin
p_number:=get_integer;
- if p_number>penalty_entries then
- flush_error('This PENALTY index is too big for my present table size')
+ if p_number>penalty_entries then
+ flush_error('This PENALTY index is too big for my present table size')
else if p_number<0 then
flush_error('This PENALTY index is negative')
else begin
while npp[p_array]<p_number do begin
incr(npp[p_array]); @<Null out the penalty@>;
- end;
+ end;
@<Read all of a penalty's values@>;
- finish_the_property;
- end;
- end;
-end
+ finish_the_property;
+ end;
+ end;
+end
@ @<Null out the penalty@>=
begin
@@ -4637,11 +4590,13 @@ end
@ @<Read a single penalty value@>=
begin
get_name;
-case cur_code of
- penalty_val_code:
- penalties[p_array,p_number].pn_val:=get_integer;
+if cur_code=comment_code then skip_to_end_of_item
+else if cur_code<>penalty_val_code then
+ flush_error('This property name doesn''t belong in a PENALTY list')
+else begin
+ penalties[p_array,p_number].pn_val:=get_integer;
+ finish_the_property;
end;
-finish_the_property;
end
@ @<Header information for penalties@>=
@@ -4658,7 +4613,7 @@ end
begin
for p_array:= 0 to nkp-1 do
for p_number:=0 to npp[p_array]-1 do begin
- out_integer(penalties[p_array,p_number].pn_val);
+ out_int(penalties[p_array,p_number].pn_val);
end;
end
@@ -4685,7 +4640,6 @@ end;
@!mvalues:array[mvalue_array_type,mvalue_entry_type] of mvalue_node;
@!npm:array[mvalue_array_type] of integer;
@!nkm:integer;
-@!nkcm:integer;
@!nwm:integer;
@!m_array:integer;
@!m_number:integer;
@@ -4696,7 +4650,6 @@ for m_array := 0 to mvalue_arrays do begin
@<Null out the mvalue@>;
end;
nkm:=-1;
-nkcm:=-1;
@ @<Read font mvalue list@>=
begin
@@ -4718,28 +4671,28 @@ else begin
finish_inner_property_list;
end;
end
-
-@ @<Read an mvalue@>=
+
+@ @<Read an mvalue@>=
begin
-get_name;
-if cur_code=comment_code then skip_to_end_of_item
-else if cur_code<>mvalue_code then
- flush_error('This property name doesn''t belong in an MVALUE list')
+get_name;
+if cur_code=comment_code then skip_to_end_of_item
+else if cur_code<>mvalue_code then
+ flush_error('This property name doesn''t belong in an FONTMVALUE list')
else begin
m_number:=get_integer;
- if m_number>mvalue_entries then
- flush_error('This MVALUE index is too big for my present table size')
+ if m_number>mvalue_entries then
+ flush_error('This MVALUE index is too big for my present table size')
else if m_number<0 then
flush_error('This MVALUE index is negative')
else begin
while npm[m_array]<m_number do begin
incr(npm[m_array]); @<Null out the mvalue@>;
- end;
+ end;
@<Read all of an mvalue's values@>;
- finish_the_property;
- end;
- end;
-end
+ finish_the_property;
+ end;
+ end;
+end
@ @<Null out the mvalue@>=
begin
@@ -4760,11 +4713,13 @@ end
@ @<Read a single mvalue value@>=
begin
get_name;
-case cur_code of
- mvalue_val_code:
- mvalues[m_array,m_number].fn_val:=get_fix;
+if cur_code=comment_code then skip_to_end_of_item
+else if cur_code<>mvalue_val_code then
+ flush_error('This property name doesn''t belong in a MVALUE list')
+else begin
+ mvalues[m_array,m_number].fn_val:=get_fix;
+ finish_the_property;
end;
-finish_the_property;
end
@ @<Header information for mvalues@>=
@@ -4808,7 +4763,6 @@ end;
@!fvalues:array[fvalue_array_type,fvalue_entry_type] of fvalue_node;
@!npf:array[fvalue_array_type] of integer;
@!nkf:integer;
-@!nkcf:integer;
@!nwf:integer;
@!f_array:integer;
@!f_number:integer;
@@ -4819,7 +4773,6 @@ for f_array := 0 to fvalue_arrays do begin
@<Null out the fvalue@>;
end;
nkf:=-1;
-nkcf:=-1;
@ @<Read font fvalue list@>=
begin
@@ -4841,28 +4794,28 @@ else begin
finish_inner_property_list;
end;
end
-
-@ @<Read an fvalue@>=
+
+@ @<Read an fvalue@>=
begin
-get_name;
-if cur_code=comment_code then skip_to_end_of_item
-else if cur_code<>fvalue_code then
- flush_error('This property name doesn''t belong in an FVALUE list')
+get_name;
+if cur_code=comment_code then skip_to_end_of_item
+else if cur_code<>fvalue_code then
+ flush_error('This property name doesn''t belong in an FONTFVALUE list')
else begin
f_number:=get_integer;
- if f_number>fvalue_entries then
- flush_error('This FVALUE index is too big for my present table size')
+ if f_number>fvalue_entries then
+ flush_error('This FVALUE index is too big for my present table size')
else if f_number<0 then
flush_error('This FVALUE index is negative')
else begin
while npf[f_array]<f_number do begin
incr(npf[f_array]); @<Null out the fvalue@>;
- end;
+ end;
@<Read all of an fvalue's values@>;
- finish_the_property;
- end;
- end;
-end
+ finish_the_property;
+ end;
+ end;
+end
@ @<Null out the fvalue@>=
begin
@@ -4883,11 +4836,13 @@ end
@ @<Read a single fvalue value@>=
begin
get_name;
-case cur_code of
- fvalue_val_code:
- fvalues[f_array,f_number].fn_val:=get_fix;
+if cur_code=comment_code then skip_to_end_of_item
+else if cur_code<>fvalue_val_code then
+ flush_error('This property name doesn''t belong in a FVALUE list')
+else begin
+ fvalues[f_array,f_number].fn_val:=get_fix;
+ finish_the_property;
end;
-finish_the_property;
end
@ @<Header information for fvalues@>=
@@ -4932,7 +4887,6 @@ end;
@!npi:array[ivalue_array_type] of integer;
@!font_i_array:boolean;
@!nki:integer;
-@!nkci:integer;
@!nwi:integer;
@!i_array:integer;
@!i_number:integer;
@@ -4943,7 +4897,6 @@ for i_array := 0 to ivalue_arrays do begin
@<Null out the ivalue@>;
end;
nki:=-1;
-nkci:=-1;
@ @<Read font ivalue list@>=
begin
@@ -4965,28 +4918,28 @@ else begin
finish_inner_property_list;
end;
end
-
-@ @<Read an ivalue@>=
+
+@ @<Read an ivalue@>=
begin
-get_name;
-if cur_code=comment_code then skip_to_end_of_item
-else if cur_code<>ivalue_code then
- flush_error('This property name doesn''t belong in an IVALUE list')
+get_name;
+if cur_code=comment_code then skip_to_end_of_item
+else if cur_code<>ivalue_code then
+ flush_error('This property name doesn''t belong in an FONTIVALUE list')
else begin
i_number:=get_integer;
- if i_number>ivalue_entries then
- flush_error('This IVALUE index is too big for my present table size')
+ if i_number>ivalue_entries then
+ flush_error('This IVALUE index is too big for my present table size')
else if i_number<0 then
flush_error('This IVALUE index is negative')
else begin
while npi[i_array]<i_number do begin
incr(npi[i_array]); @<Null out the ivalue@>;
- end;
+ end;
@<Read all of an ivalue's values@>;
- finish_the_property;
- end;
- end;
-end
+ finish_the_property;
+ end;
+ end;
+end
@ @<Null out the ivalue@>=
begin
@@ -5007,11 +4960,13 @@ end
@ @<Read a single ivalue value@>=
begin
get_name;
-case cur_code of
- ivalue_val_code:
- ivalues[i_array,i_number].in_val:=get_integer;
+if cur_code=comment_code then skip_to_end_of_item
+else if cur_code<>ivalue_val_code then
+ flush_error('This property name doesn''t belong in a IVALUE list')
+else begin
+ ivalues[i_array,i_number].in_val:=get_integer;
+ finish_the_property;
end;
-finish_the_property;
end
@ @<Header information for ivalues@>=
@@ -5028,7 +4983,7 @@ end
begin
for i_array:= 0 to nki-1 do
for i_number:=0 to npi[i_array]-1 do begin
- out_integer(ivalues[i_array,i_number].in_val);
+ out_int(ivalues[i_array,i_number].in_val);
end;
end