@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
@<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.
@<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
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
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
