diff options
Diffstat (limited to 'Build/source/texk/web2c/omegaware/opl2ofm.web')
-rw-r--r-- | Build/source/texk/web2c/omegaware/opl2ofm.web | 634 |
1 files changed, 299 insertions, 335 deletions
diff --git a/Build/source/texk/web2c/omegaware/opl2ofm.web b/Build/source/texk/web2c/omegaware/opl2ofm.web index d249ce6e3f7..3b3be4ad807 100644 --- a/Build/source/texk/web2c/omegaware/opl2ofm.web +++ b/Build/source/texk/web2c/omegaware/opl2ofm.web @@ -1,4 +1,4 @@ -% +% % This file is part of the Omega project, which % is based in the web2c distribution of TeX. % @@ -77,11 +77,11 @@ in 1989. Extensions to handle extended font metric files (``\.{OFM}'') were added by John Plaice in December 1995 and January 1996, resulting in the -new program \.{OPLtoOFM}. In the following documentation, all unchanged +new program \.{OPL2OFM}. In the following documentation, all unchanged references to the \.{PLtoTF} program and to \.{TFM} and \.{PL} files also -apply to the \.{OPLtoOFM} program and to \.{OFM} and \.{OPL} files. +apply to the \.{OPL2OFM} program and to \.{OFM} and \.{OPL} files. -The |banner| string defined here should be changed whenever \.{OPLtoOFM} +The |banner| string defined here should be changed whenever \.{OPL2OFM} gets modified. @d banner=='This is OPL2OFM, Version 1.12' @@ -128,15 +128,15 @@ reduce \.{PLtoTF}'s capacity. @!hash_mult=16007; {another prime} @!tfm_size=2000000; {maximum length of |tfm| data, in bytes} @!lig_size=800000; {maximum length of |lig_kern| program, in words} -@!max_char=65535; {the largest character number in a font} -@!xmax_char=65536; {|max_char|+1} -@!xxmax_char=65537;{|max_char|+2} -@!xxxmax_char=65538;{|max_char|+3} -@!mem_size=262144; {|max_char|*4+8} -@!max_width=65535; {the largest character width number} -@!max_height=255; {the largest character height number} -@!max_depth=255; {the largest character depth number} -@!max_italic=255; {the largest character italic correction number} +@!max_char=65535; {the largest character number in a font} +@!xmax_char=65536; {|max_char|+1} +@!xxmax_char=65537;{|max_char|+2} +@!xxxmax_char=65538;{|max_char|+3} +@!mem_size=262144; {|max_char|*4+8} +@!max_width=65535; {the largest character width number} +@!max_height=255; {the largest character height number} +@!max_depth=255; {the largest character depth number} +@!max_italic=255; {the largest character italic correction number} @ Here are some macros for common programming idioms. @@ -865,6 +865,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 @@ -876,10 +877,20 @@ symbolic meanings by the following definitions. @d font_dimen_code=9 @d lig_table_code=10 @d boundary_char_code=11 -@d font_dir_code=14 -@d n_font_dir_code=15 -@d character_code=16 +@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 @@ -928,27 +939,31 @@ symbolic meanings by the following definitions. @d sec_mid_vert_code=char_info_code+sec_mid_vert @d sec_base_slant_code=char_info_code+sec_base_slant @d next_larger_code=100 -@d var_char_code=102 +@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 @@ -957,41 +972,18 @@ 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 @<Glo...@>= @!equiv:array[0..max_name_index] of byte; @@ -1157,15 +1149,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);@/ @@ -1178,14 +1161,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); @ @<Enter the parameter names@>= load5("S")("L")("A")("N")("T")(parameter_code+1);@/ @@ -1787,9 +1762,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 @<Read the font property value specified by |cur_code|@>; @@ -1964,7 +1937,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@>; @@ -1972,21 +1948,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 @@ -2157,27 +2126,27 @@ else incr(nl); lk_step_ended:=true; end -@ @<Read an extended kern step@>= +@ @<Read an extended kern step@>= begin lig_kern[nl].b0:=256; lig_kern[nl].b1:=get_byte; lig_kern[nl].b2:=20; -kern[nk]:=get_fix; krn_ptr:=0; -while kern[krn_ptr]<>kern[nk] do incr(krn_ptr); +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) + 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; - end; -if krn_ptr>65535 then - err_print('Sorry, too many different kerns for me to handle'); +@.Sorry, too many different kerns...@> + decr(krn_ptr); + end; + end; +if krn_ptr>65535 then + err_print('Sorry, too many different kerns for me to handle'); lig_kern[nl].b3:=krn_ptr; -if nl>=max_lig_steps-1 then - err_print('Sorry, LIGTABLE too long for me to handle') -@.Sorry, LIGTABLE too long...@> -else incr(nl); -lk_step_ended:=true; +if nl>=max_lig_steps-1 then + err_print('Sorry, LIGTABLE too long for me to handle') +@.Sorry, LIGTABLE too long...@> +else incr(nl); +lk_step_ended:=true; end @ @<Globals...@>= @@ -2297,7 +2266,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; @@ -2317,13 +2286,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 - ((cur_code<char_ivalue_code)or(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 @@ -2332,65 +2316,35 @@ 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; 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; @@ -2438,22 +2392,22 @@ which prints a progress report as the file is being read. {strings for output in the user's external character set} @!MBL_string,@!RI_string,@!RCE_string:packed array [1..3] of char; {handy string constants for |face| codes} - + @ @<Set init...@>= ASCII_04:=' !"#$%&''()*+,-./0123456789:;<=>?';@/ ASCII_10:='@@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_';@/ ASCII_14:='`abcdefghijklmnopqrstuvwxyz{|}~ ';@/ HEX:='0123456789ABCDEF';@/ MBL_string:='MBL'; RI_string:='RI '; RCE_string:='RCE'; - + @ 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; @@ -2467,11 +2421,11 @@ 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) - + @p procedure print_number(c:integer; form:integer); {prints value of |c|} var j:0..32; {index into |dig|} begin @@ -2845,6 +2799,18 @@ First of all, it is convenient to have an abbreviation for output to the @d out(#)==write(tfm_file,#) +@p procedure out_int(@!x:integer); {output a possibly negative value} +begin if x<0 then begin + x:=x+@"40000000; + x:=x+@"40000000; + out((x div @"1000000)+@"80); + end +else out(x div @"1000000); +out((x mod @"1000000) div @"10000); +out((x mod @"10000) div @"100); +out(x mod @"100); +end; + @ The general plan for producing \.{TFM} files is long but simple: @<Do the font metric output@>= @@ -2874,6 +2840,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 \.{PLtoTF} keeps going and writes the \.{TFM} anyway. In this case |ec| will be~0 and |bc| will be~1. @@ -3020,18 +2989,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 @@ -3521,7 +3479,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; @@ -3532,7 +3489,6 @@ for r_array := 0 to rule_arrays do begin @<Null out the rule@>; end; nkr:=-1; -nkcr:=-1; @ @<Read font rule list@>= begin @@ -3554,28 +3510,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 @@ -3598,15 +3554,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; +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; -finish_the_property; end @ @<Header information for rules@>= @@ -3640,7 +3601,7 @@ end @!glue_arrays=arrays_per_kind; @!glue_entries=entries_per_array; -@ +@ @d t_normal==0 @d t_aleaders==1 @d t_cleaders==2 @@ -3675,7 +3636,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; @@ -3688,7 +3648,6 @@ begin @<Null out the glue@>; end; nkg:=-1; -nkcg:=-1; @ @<Read font glue list@>= begin @@ -3710,28 +3669,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 @@ -3759,44 +3718,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@>= @@ -3852,7 +3816,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; @@ -3863,7 +3826,6 @@ for p_array := 0 to penalty_arrays do begin @<Null out the penalty@>; end; nkp:=-1; -nkcp:=-1; @ @<Read font penalty list@>= begin @@ -3885,28 +3847,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 @@ -3927,11 +3889,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@>= @@ -3948,7 +3912,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 @@ -3975,7 +3939,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; @@ -3986,7 +3949,6 @@ for m_array := 0 to mvalue_arrays do begin @<Null out the mvalue@>; end; nkm:=-1; -nkcm:=-1; @ @<Read font mvalue list@>= begin @@ -4008,28 +3970,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 @@ -4050,11 +4012,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@>= @@ -4098,7 +4062,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; @@ -4109,7 +4072,6 @@ for f_array := 0 to fvalue_arrays do begin @<Null out the fvalue@>; end; nkf:=-1; -nkcf:=-1; @ @<Read font fvalue list@>= begin @@ -4131,28 +4093,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 @@ -4173,11 +4135,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@>= @@ -4222,7 +4186,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; @@ -4233,7 +4196,6 @@ for i_array := 0 to ivalue_arrays do begin @<Null out the ivalue@>; end; nki:=-1; -nkci:=-1; @ @<Read font ivalue list@>= begin @@ -4255,28 +4217,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 @@ -4297,11 +4259,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@>= @@ -4318,7 +4282,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 |