@x {hz int_pars go here} @y @d hz_state_code=80 @z @x @d error_context_lines==int_par(error_context_lines_code) @y @d hz_state==int_par(hz_state_code) @d hz_en==(hz_state>0) @d error_context_lines==int_par(error_context_lines_code) @z @x error_context_lines_code:print_esc("errorcontextlines"); @y error_context_lines_code:print_esc("errorcontextlines"); hz_state_code:print_esc("hzstate"); @z @x primitive("errorcontextlines",assign_int,int_base+error_context_lines_code);@/ @!@:error_context_lines_}{\.{\\errorcontextlines} primitive@> @y primitive("errorcontextlines",assign_int,int_base+error_context_lines_code);@/ @!@:error_context_lines_}{\.{\\errorcontextlines} primitive@> primitive("hzstate",assign_int,int_base+hz_state_code);@/ @!@:hz_state_}{\.{\\hzstate} primitive@> @z @x escape_char:="\"; end_line_char:=carriage_return; @y escape_char:="\"; end_line_char:=carriage_return; hz_state:=0; @z @x primitive("font",def_font,0);@/ @!@:font_}{\.{\\font} primitive@> @y primitive("font",def_font,0);@/ @!@:font_}{\.{\\font} primitive@> primitive("fontvariant",def_font,1);@/ @!@:fontvariant_}{\.{\\fontvariant} primitive@> @z @x def_font: print_esc("font"); @y def_font: if chr_code=0 then print_esc("font") else print_esc("fontvariant"); @z @x l.8326 @p procedure scan_something_internal(@!level:small_number;@!negative:boolean); {fetch an internal parameter} var m:halfword; {|chr_code| part of the operand token} @y @p procedure scan_something_internal(@!level:small_number;@!negative:boolean); {fetch an internal parameter} var m:halfword; {|chr_code| part of the operand token} r:pointer; {used with font variants} @z @x l.8379 else begin back_input; scan_font_ident; scanned_result(font_id_base+cur_val)(ident_val); end @y else begin if m=0 then begin back_input; scan_font_ident; scanned_result(font_id_base+cur_val)(ident_val); end else if hz_en then begin scan_font_ident; r:=font_variants[cur_val]; cur_val:=0; while r<>null do begin incr(cur_val); r:=link(r); end; scanned_result(cur_val)(int_val); end else begin print_err("Improper "); print_cmd_chr(def_font,m); error; end; end @z @x l.10710 @!font_false_bchar:array[internal_font_number] of min_quarterword..non_char; {|font_bchar| if it doesn't exist in the font, otherwise |non_char|} @y @!font_false_bchar:array[internal_font_number] of min_quarterword..non_char; {|font_bchar| if it doesn't exist in the font, otherwise |non_char|} @!font_variants:array[internal_font_number] of min_halfword..max_halfword; @z @x l.10762 for k:=0 to 6 do font_info[k].sc:=0; @y for k:=0 to 6 do font_info[k].sc:=0; font_variants[null_font]:=null; @z @x l.11189 fmem_ptr:=fmem_ptr+lf; font_ptr:=f; g:=f; goto done @y fmem_ptr:=fmem_ptr+lf; font_ptr:=f; g:=f; for a:=0 to 255 do begin qw:=char_info(f)(a); if char_exists(qw) then begin font_variants[f]:=get_avail; font(font_variants[f]):=f; character(font_variants[f]):=a; link(font_variants[f]):=null; goto done; end; end; goto done; @z @x l.12860 @ Here now is |hpack|, which contains few if any surprises. @p function hpack(@!p:pointer;@!w:scaled;@!m:small_number):pointer; label reswitch, common_ending, exit; var r:pointer; {the box node that will be returned} @!q:pointer; {trails behind |p|} @!h,@!d,@!x:scaled; {height, depth, and natural width} @y @ This routine replaces characters in the hlist |p| with variants from other fonts in order to stretch the natural width by |r|. It returns the amount by which the natural width could be stretched. @p function adjust_excess(p:pointer;r:real):scaled; label reswitch,found,done; var v,w,d,dd:scaled; f,ff,c:eight_bits; i,ii:four_quarters; s:pointer; j:integer; begin @!debug print("(adjust_excess: "); print_scaled(round(unity*r)); print(" --> "); gubed v:=0; w:=0; while p<>null do begin reswitch: while is_char_node(p) do begin c:=character(p); f:=font(p); i:=char_info(f)(c); w:=w+char_width(f)(i); s:=font_variants[f]; f:=font(s); i:=char_info(f)(c); d:=abs(v+char_width(f)(i)-r*w); s:=link(s); @!debug j:=0; gubed while s<>null do begin ff:=font(s); ii:=char_info(ff)(c); dd:=abs(v+char_width(ff)(ii)-r*w); if dd>=d then goto found; d:=dd; f:=ff; i:=ii; @!debug j:=j+1; gubed s:=link(s); end; found: font(p):=f; @!debug print_int(j); gubed v:=v+char_width(f)(i); p:=link(p); end; if p=null then goto done; if type(p)=ligature_node then @ else p:=link(p); end; done: @!debug print_ln; print(" got "); print_scaled(v-w); print(")"); gubed adjust_excess:=v-w; end; @ Here now is |hpack|, which contains few if any surprises. @p function hpack(@!p:pointer;@!w:scaled;@!m:small_number):pointer; label reswitch, common_ending, exit; var r:pointer; {the box node that will be returned} @!q:pointer; {trails behind |p|} @!h,@!d,@!x:scaled; {height, depth, and natural width} @!gw:scaled; {natural width coming from glyphs} @z @x h:=0; @; @y h:=0; gw:=0; @; @z @x @= begin f:=font(p); i:=char_info(f)(character(p)); hd:=height_depth(i); x:=x+char_width(f)(i);@/ @y @= begin f:=font(p); i:=char_info(f)(character(p)); hd:=height_depth(i); x:=x+char_width(f)(i);@/ gw:=gw+char_width(f)(i); @z @x else if x>0 then @ else @ @y else begin if hz_en then begin if gw<>0 then begin x:=x-adjust_excess(link(q),(gw+x)/gw); end; end; if x>0 then @ else @; end @z @x @d delta_node_size=7 {number of words in a delta node} @d delta_node=2 {|type| field in a delta node} @y @d delta_node_size=9 {number of words in a delta node} @d delta_node=2 {|type| field in a delta node} @z @x @d do_all_six(#)==#(1);#(2);#(3);#(4);#(5);#(6) @= @!active_width:array[1..6] of scaled; {distance from first active node to~|cur_p|} @!cur_active_width:array[1..6] of scaled; {distance from current active node} @!background:array[1..6] of scaled; {length of an ``empty'' line} @!break_width:array[1..6] of scaled; {length being computed after current break} @y For the hz algorithm, we add two more fields to store the finite stretch and shrink from glyphs. @d do_all_six(#)==#(1);#(2);#(3);#(4);#(5);#(6) @d do_all_eight(#)==do_all_six(#);#(7);#(8) @= @!active_width:array[1..8] of scaled; {distance from first active node to~|cur_p|} @!cur_active_width:array[1..8] of scaled; {distance from current active node} @!background:array[1..8] of scaled; {length of an ``empty'' line} @!break_width:array[1..8] of scaled; {length being computed after current break} @z @x background[6]:=shrink(q)+shrink(r); @y background[6]:=shrink(q)+shrink(r); background[7]:=0; background[8]:=0; @z @x do_all_six(copy_to_cur_active); @y do_all_eight(copy_to_cur_active); @z @x begin do_all_six(update_width); @y begin do_all_eight(update_width); @z @x begin no_break_yet:=false; do_all_six(set_break_width_to_background); @y begin no_break_yet:=false; do_all_eight(set_break_width_to_background); @z @x begin do_all_six(convert_to_break_width); @y begin do_all_eight(convert_to_break_width); @z @x begin do_all_six(store_break_width); @y begin do_all_eight(store_break_width); @z @x do_all_six(new_delta_to_break_width); @y do_all_eight(new_delta_to_break_width); @z @x do_all_six(new_delta_from_break_width); @y do_all_eight(new_delta_from_break_width); @z @x shortfall:=line_width-cur_active_width[1]; {we're this much too short} @y if hz_en then begin if cur_active_width[1]+cur_active_width[7]line_width then shortfall:=line_width-(cur_active_width[1]-cur_active_width[8]) else shortfall:=0; end else shortfall:=line_width-cur_active_width[1]; {we're this much too short} @z @x begin do_all_six(downdate_width); @y begin do_all_eight(downdate_width); @z @x begin do_all_six(update_width); do_all_six(combine_two_deltas); @y begin do_all_eight(update_width); do_all_eight(combine_two_deltas); @z @x begin do_all_six(update_active); do_all_six(copy_to_cur_active); @y begin do_all_eight(update_active); do_all_eight(copy_to_cur_active); @z @x do_all_six(store_background);@/ @y do_all_eight(store_background);@/ @z @x begin prev_p:=cur_p; repeat f:=font(cur_p); act_width:=act_width+char_width(f)(char_info(f)(character(cur_p))); cur_p:=link(cur_p); until not is_char_node(cur_p); end @y begin prev_p:=cur_p; repeat f:=font(cur_p); w:=char_width(f)(char_info(f)(character(cur_p))); act_width:=act_width+w; if hz_en then @; cur_p:=link(cur_p); until not is_char_node(cur_p); end @ @= @!w:scaled; {used when calculating character widths} @ @= begin r:=font_variants[f]; active_width[7]:=active_width[7]+ char_width(font(r))(char_info(font(r))(character(cur_p)))-w; while link(r)<>null do r:=link(r); active_width[8]:=active_width[8]+ w-char_width(font(r))(char_info(font(r))(character(cur_p))); end @z @x def_font: new_font(a); @y def_font: if cur_chr=0 then new_font(a) else if hz_en then font_variant(a) else begin print_err("Improper "); print_cmd_chr(def_font,cur_chr); error; end; @ @= procedure font_variant(@!a:small_number); label found,done; var @!f,ff:internal_font_number; @!i:eight_bits; @!qw,qww:four_quarters; @!r,s,p: pointer; begin scan_font_ident; f:=cur_val; scan_optional_equals; scan_font_ident; ff:=cur_val; @; @; s:=null; r:=font_variants[f]; i:=character(r); p:=new_character(ff,i); qww:=char_info(ff)(i); while r<>null do begin if font(r)=ff then goto done; qw:=char_info(font(r))(i); if char_width(font(r))(qw)null do begin print(font_name[font(r)]); r:=link(r); if r<>null then print(", "); end; print(")"); gubed end; @ Fonts can only be variants of each other if they provide the same characters. @= for i:=0 to 255 do begin qw:=char_info(f)(i); qww:=char_info(f)(i); if (char_exists(qw) and not char_exists(qww)) or (not char_exists(qw) and char_exists(qww)) then begin print_err("Font "); print_esc(font_id_text(ff)); print(" is not a variant of font "); print_esc(font_id_text(f)); @.Font x is not a...@> help2("Fonts can only be used as variants of each other")@/ ("if they contain the same characters."); error; goto done; end; end @ The only way to remove variants of a font is to assign |null_font| as a variant. @= if ff=null_font then begin r:=null; s:=null; p:=new_character(f,character(font_variants[f])); flush_node_list(font_variants[f]); goto found; end @z