@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
    @<Make node |p| look like a |char_node| and |goto reswitch|@>
  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; @<Clear dimensions to zero@>;
@y
h:=0; gw:=0; @<Clear dimensions to zero@>;
@z

@x
@<Incorporate character dimensions into the dimensions of the hbox...@>=
begin f:=font(p); i:=char_info(f)(character(p)); hd:=height_depth(i);
x:=x+char_width(f)(i);@/
@y
@<Incorporate character dimensions into the dimensions of the hbox...@>=
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 @<Determine horizontal glue stretch setting, then |return|
    or \hbox{|goto common_ending|}@>
else @<Determine horizontal glue shrink setting, then |return|
    or \hbox{|goto common_ending|}@>
@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 @<Determine horizontal glue stretch setting, then |return|
    or \hbox{|goto common_ending|}@>
  else @<Determine horizontal glue shrink setting, then |return|
    or \hbox{|goto common_ending|}@>;
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)

@<Glo...@>=
@!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)

@<Glo...@>=
@!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[7])
  else if cur_active_width[1]-cur_active_width[8]>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 @<Update stretch and shrink in the presence of font variants@>;
cur_p:=link(cur_p);
until not is_char_node(cur_p);
end

@ @<Local variables for line...@>=
@!w:scaled; {used when calculating character widths}

@ @<Update stretch and shrink...@>=
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;


@ @<Declare subprocedures for |prefixed_command|@>=
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;
  @<If |ff| is |null_font|, reset the list of variants and goto |found|@>;
  @<Check that |ff| is a valid variant of |f|, else goto |done|@>;
  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)<char_width(ff)(qww) then goto found;
    s:=r; r:=link(r);
  end;
found:
 link(p):=r;
 if s=null then font_variants[f]:=p
 else link(s):=p;
 done:
@!debug
 print("(fontvariants of ");
 print(font_name[f]); print(": ");
 r:=font_variants[f];
 while r<>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.

@<Check that |ff| is a valid variant of |f|...@>=
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| is |null_font|...@>=
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