diff options
Diffstat (limited to 'Build/source/texk/web2c/omegaware/ovp2ovf.web')
| -rw-r--r-- | Build/source/texk/web2c/omegaware/ovp2ovf.web | 647 |
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 |