@x
@d normal=0 {the most common case when several cases are named}
@y
@d normal=0 {the most common case when several cases are named}
@d under_accent=2 {|subtype| of under math accents}
@d nesting=1 {add this to an accent |subtype| to make it nesting}
@z
@x
if cur_chr>glue_val then
begin if cur_chr=input_line_no_code then cur_val:=line
else cur_val:=last_badness; {|cur_chr=badness_code|}
cur_val_level:=int_val;
end
@y
if cur_chr>glue_val then
begin if cur_chr=input_line_no_code then cur_val:=line
else if cur_chr=math_style_code then begin
if abs(mode)=mmode then cur_val:=mathstyle
else cur_val:=-1;
end else cur_val:=last_badness;
cur_val_level:=int_val;
end
@z
@x
@d radical_noad_size=5 {number of |mem| words in a radical noad}
@y
@d radical_noad_size=6 {number of |mem| words in a radical noad}
@d is_null_delimiter(#) ==
((mem[#].qqqq.b0=0) and (mem[#].qqqq.b1=min_quarterword) and
(mem[#].qqqq.b2=0) and (mem[#].qqqq.b3=min_quarterword))
@z
@x
begin case c div 2 of
0: print_esc("displaystyle"); {|display_style=0|}
1: print_esc("textstyle"); {|text_style=2|}
2: print_esc("scriptstyle"); {|script_style=4|}
3: print_esc("scriptscriptstyle"); {|script_script_style=6|}
othercases print("Unknown style!")
@y
begin case c of
display_style: print_esc("displaystyle");
display_style+cramped: print_esc("crampeddisplaystyle");
text_style: print_esc("textstyle");
text_style+cramped: print_esc("crampedtextstyle");
script_style: print_esc("scriptstyle");
script_style+cramped: print_esc("crampedscriptstyle");
script_script_style: print_esc("scriptscriptstyle");
script_script_style+cramped: print_esc("crampedscriptscriptstyle");
othercases print("Unknown style!")
@z
@x
radical_noad: begin print_esc("radical"); print_delimiter(left_delimiter(p));
end;
@y
radical_noad: if subtype(p)=normal then begin
print_esc("radical"); print_delimiter(left_delimiter(p));
end else begin
print_esc("genradical"); print_delimiter(left_delimiter(p));
print_delimiter(right_delimiter(p));
end;
@z
@x
@!cur_style:small_number; {style code at current place in the list}
@y
@!cur_style,mathstyle:small_number; {style code at current place in the list}
@z
@x
accent_noad: make_math_accent(q);
@y
accent_noad: if subtype(q)<under_accent then make_math_accent(q)
else make_math_under_accent(q);
@z
@x
procedure make_radical(@!q:pointer);
var x,@!y:pointer; {temporary registers for box construction}
@!delta,@!clr:scaled; {dimensions involved in the calculation}
begin x:=clean_box(nucleus(q),cramped_style(cur_style));
if cur_style<text_style then {display style}
clr:=default_rule_thickness+(abs(math_x_height(cur_size)) div 4)
else begin clr:=default_rule_thickness; clr:=clr + (abs(clr) div 4);
end;
y:=var_delimiter(left_delimiter(q),cur_size,height(x)+depth(x)+clr+
default_rule_thickness);
delta:=depth(y)-(height(x)+depth(x)+clr);
if delta>0 then clr:=clr+half(delta); {increase the actual clearance}
shift_amount(y):=-(height(x)+clr);
link(y):=overbar(x,clr,height(y));
info(nucleus(q)):=hpack(y,natural); math_type(nucleus(q)):=sub_box;
end;
@y
procedure make_radical(@!q:pointer);
var x,@!y,z:pointer; {temporary registers for box construction}
@!delta,@!clr,ht:scaled; {dimensions involved in the calculation}
begin x:=clean_box(nucleus(q),cramped_style(cur_style));
if cur_style<text_style then {display style}
clr:=default_rule_thickness+(abs(math_x_height(cur_size)) div 4)
else begin clr:=default_rule_thickness; clr:=clr + (abs(clr) div 4);
end;
y:=var_delimiter(left_delimiter(q),cur_size,height(x)+depth(x)+clr+
default_rule_thickness);
delta:=depth(y)-(height(x)+depth(x)+clr);
if delta>0 then clr:=clr+half(delta); {increase the actual clearance}
shift_amount(y):=-(height(x)+clr);
ht:=height(y);
if subtype(q)=normal then link(y):=overbar(x,clr,ht)
else begin
z:=var_delimiter(right_delimiter(q),cur_size,height(x)+depth(x)+clr+
default_rule_thickness);
shift_amount(z):=-(height(x)+clr);
if height(z)>ht then ht:=height(z);
link(y):=overbar(x,clr,ht);
link(link(y)):=z;
end;
info(nucleus(q)):=hpack(y,natural); math_type(nucleus(q)):=sub_box;
end;
@z
@x
procedure make_math_accent(@!q:pointer);
label done,done1;
var p,@!x,@!y:pointer; {temporary registers for box construction}
@y
procedure horizontally_stack_into_box(@!b:pointer;@!f:internal_font_number;@!c:quarterword);
var p:pointer; {new node placed into |b|}
begin
p:=char_box(f,c); link(p):=list_ptr(b); list_ptr(b):=p;
width(b):=width(b)+width(p);
end;
procedure make_math_under_accent(@!q:pointer);
label done,done1,done2,done3;
var p,qq,@!x,@!y:pointer; {temporary registers for box construction}
@!a:integer; {address of lig/kern instruction}
@!c:quarterword; {accent character}
@!f:internal_font_number; {its font}
@!i,ii:four_quarters; {its |char_info|}
@!s:scaled; {amount to skew the accent to the right}
@!h:scaled; {height of character being accented}
@!delta,sep:scaled; {space to insert between accentee and accent}
@!w,v,u:scaled; {width of the accentee, not including sub/superscripts}
@!t:four_quarters;
@!m,n:integer;
@!hd:eight_bits;
begin fetch(accent_chr(q));
if char_exists(cur_i) then
begin i:=cur_i; c:=cur_c; f:=cur_f;@/
@<Compute under accent skew@>;
@<Compute separation for under accent@>;
x:=clean_box(nucleus(q),cur_style); w:=width(x); h:=height(x);
@<Switch to a larger accent if available and appropriate@>;
if (math_type(supscr(q))<>empty)or(math_type(subscr(q))<>empty) then
if math_type(nucleus(q))=math_char then
@<Swap the subscript and superscript into box |x|@>;
shift_amount(y):=half(w-width(y))-s; width(y):=0;
p:=new_kern(sep); link(x):=p; link(p):=y;
p:=new_kern(-sep-x_height(f)); link(y):=p;
y:=vpack(x,natural); width(y):=w;
depth(y):=depth(y)+height(y)-h; height(y):=h;
info(nucleus(q)):=y; math_type(nucleus(q)):=sub_box;
end;
end;
procedure make_math_accent(@!q:pointer);
label done,done1,done2;
var p,qq,@!x,@!y:pointer; {temporary registers for box construction}
@z
@x
@!w:scaled; {width of the accentee, not including sub/superscripts}
@y
@!w,v,u:scaled; {width of the accentee, not including sub/superscripts}
@!t:four_quarters;
@!m,n:integer;
@!hd:eight_bits;
@z
@x
y:=char_box(f,c);
@y
@z
@x
@ @<Switch to a larger accent if available and appropriate@>=
loop@+ begin if char_tag(i)<>list_tag then goto done;
y:=rem_byte(i);
i:=char_info(f)(y);
if not char_exists(i) then goto done;
if char_width(f)(i)>w then goto done;
c:=y;
end;
done:
@y
@ @<Switch to a larger accent if available and appropriate@>=
loop@+ begin
if char_tag(i)=ext_tag then begin
y:=new_null_box;
type(y):=hlist_node;
i:=font_info[exten_base[f]+rem_byte(i)].qqqq;@/
c:=ext_rep(i); t:=char_info(f)(c); u:=char_width(f)(t); v:=0;
hd:=height_depth(t); height(y):=char_height(f)(hd); depth(y):=char_depth(f)(hd);
c:=ext_bot(i); t:=char_info(f)(c); @+if c<>min_quarterword then v:=v+char_width(f)(t);
c:=ext_mid(i); t:=char_info(f)(c); @+if c<>min_quarterword then v:=v+char_width(f)(t);
c:=ext_top(i); t:=char_info(f)(c); @+if c<>min_quarterword then v:=v+char_width(f)(t);
n:=0;
if u>0 then while v<w do begin
v:=v+u; incr(n);
if ext_mid(i)<>min_quarterword then v:=v+u;
end;
c:=ext_bot(i);
if c<>min_quarterword then horizontally_stack_into_box(y,f,c);
c:=ext_rep(i);
for m:=1 to n do horizontally_stack_into_box(y,f,c);
c:=ext_mid(i);
if c<>min_quarterword then begin
horizontally_stack_into_box(y,f,c);
c:=ext_rep(i);
for m:=1 to n do horizontally_stack_into_box(y,f,c);
end;
c:=ext_top(i);
if c<>min_quarterword then horizontally_stack_into_box(y,f,c);
goto done2;
end;
if char_tag(i)<>list_tag then goto done;
y:=rem_byte(i);
i:=char_info(f)(y);
if not char_exists(i) then goto done;
if char_width(f)(i)>w then goto done;
c:=y;
end;
done:
y:=char_box(f,c);
done2:
@z
@x
@ @<Compute the amount of skew@>=
s:=0;
if math_type(nucleus(q))=math_char then
begin fetch(nucleus(q));
@y
@ @<Compute under accent skew@>=
s:=0;
qq:=q;
if odd(subtype(q)) then
while (math_type(nucleus(qq))=sub_mlist)and
(type(info(nucleus(qq)))=accent_noad)and
((subtype(qq)=subtype(q))or(subtype(qq) div 2<>subtype(q) div 2)) do
qq:=info(nucleus(qq));
if math_type(nucleus(qq))=math_char then
begin fetch(nucleus(qq));
ii:=char_info(cur_f)(skew_char[cur_f]);
if char_tag(ii)=lig_tag then
begin a:=lig_kern_start(cur_f)(ii);
ii:=font_info[a].qqqq;
if skip_byte(ii)>stop_flag then
begin a:=lig_kern_restart(cur_f)(ii);
ii:=font_info[a].qqqq;
end;
loop@+ begin if qo(next_char(ii))=cur_c then
begin if op_byte(ii)>=kern_flag then
if skip_byte(ii)<=stop_flag then s:=char_kern(cur_f)(ii);
goto done1;
end;
if skip_byte(ii)>=stop_flag then goto done1;
a:=a+qo(skip_byte(ii))+1;
ii:=font_info[a].qqqq;
end;
end;
end;
done1:
@ @<Compute separation for under accent@>=
sep:=0;
ii:=i;
if char_tag(ii)=lig_tag then
begin a:=lig_kern_start(f)(ii);
ii:=font_info[a].qqqq;
if skip_byte(ii)>stop_flag then
begin a:=lig_kern_restart(f)(ii);
ii:=font_info[a].qqqq;
end;
loop@+ begin if qo(next_char(ii))=c then
begin if op_byte(ii)>=kern_flag then
if skip_byte(ii)<=stop_flag then sep:=char_kern(f)(ii);
goto done3;
end;
if skip_byte(ii)>=stop_flag then goto done3;
a:=a+qo(skip_byte(ii))+1;
ii:=font_info[a].qqqq;
end;
end;
done3:
@ @<Compute the amount of skew@>=
s:=0;
qq:=q;
{while odd(subtype(qq))and(math_type(nucleus(qq))=sub_mlist)and
(type(info(nucleus(qq)))=accent_noad) do}
if odd(subtype(q)) then
while (math_type(nucleus(qq))=sub_mlist)and
(type(info(nucleus(qq)))=accent_noad)and
((subtype(qq)=subtype(q))or(subtype(qq) div 2<>subtype(q) div 2)) do
qq:=info(nucleus(qq));
if math_type(nucleus(qq))=math_char then
begin fetch(nucleus(qq));
@z
@x
begin push_math(math_shift_group); eq_word_define(int_base+cur_fam_code,-1);
if every_math<>null then begin_token_list(every_math,every_math_text);
@y
begin mathstyle:=text_style;
push_math(math_shift_group); eq_word_define(int_base+cur_fam_code,-1);
if every_math<>null then begin_token_list(every_math,every_math_text);
@z
@x
mmode+left_brace: begin tail_append(new_noad);
back_input; scan_math(nucleus(tail));
@y
mmode+left_brace: begin tail_append(new_noad);
back_input; scan_math(nucleus(tail),mathstyle);
@z
@x
procedure scan_math(@!p:pointer);
label restart,reswitch,exit;
var c:integer; {math character code}
begin restart:@<Get the next non-blank non-relax...@>;
reswitch:case cur_cmd of
letter,other_char,char_given: begin c:=ho(math_code(cur_chr));
if c=@'100000 then
begin @<Treat |cur_chr| as an active character@>;
goto restart;
end;
end;
char_num: begin scan_char_num; cur_chr:=cur_val; cur_cmd:=char_given;
goto reswitch;
end;
math_char_num: begin scan_fifteen_bit_int; c:=cur_val;
end;
math_given: c:=cur_chr;
delim_num: begin scan_twenty_seven_bit_int; c:=cur_val div @'10000;
end;
othercases @<Scan a subformula enclosed in braces and |return|@>
endcases;@/
math_type(p):=math_char; character(p):=qi(c mod 256);
if (c>=var_code)and fam_in_range then fam(p):=cur_fam
else fam(p):=(c div 256) mod 16;
exit:end;
@y
procedure scan_math(@!p:pointer;s:small_number);
label restart,reswitch,exit;
var c:integer; {math character code}
savedstyle:small_number;
begin
savedstyle:=mathstyle; mathstyle:=s;
restart:@<Get the next non-blank non-relax...@>;
reswitch:case cur_cmd of
letter,other_char,char_given: begin c:=ho(math_code(cur_chr));
if c=@'100000 then
begin @<Treat |cur_chr| as an active character@>;
goto restart;
end;
end;
char_num: begin scan_char_num; cur_chr:=cur_val; cur_cmd:=char_given;
goto reswitch;
end;
math_char_num: begin scan_fifteen_bit_int; c:=cur_val;
end;
math_given: c:=cur_chr;
delim_num: begin scan_twenty_seven_bit_int; c:=cur_val div @'10000;
end;
othercases @<Scan a subformula enclosed in braces and |return|@>
endcases;@/
math_type(p):=math_char; character(p):=qi(c mod 256);
if (c>=var_code)and fam_in_range then fam(p):=cur_fam
else fam(p):=(c div 256) mod 16;
mathstyle:=savedstyle;
exit:
end;
@z
@x
begin back_input; scan_left_brace;@/
saved(0):=p; incr(save_ptr); push_math(math_group); return;
@y
begin back_input; scan_left_brace;@/
saved(0):=p; incr(save_ptr); saved(0):=savedstyle; incr(save_ptr);
push_math(math_group); return;
@z
@x
mmode+math_comp: begin tail_append(new_noad);
type(tail):=cur_chr; scan_math(nucleus(tail));
@y
mmode+math_comp: begin tail_append(new_noad);
type(tail):=cur_chr;
case type(tail) of
over_noad: scan_math(nucleus(tail),cramped_style(mathstyle));
othercases scan_math(nucleus(tail),mathstyle);
endcases;
@z
@x
{before |scan_math| in |math_radical|}
scan_math(nucleus(tail));
@y
if subtype(tail)=normal then mem[right_delimiter(tail)].qqqq:=null_delimiter
else scan_delimiter(right_delimiter(tail),true);
{before |scan_math| in |math_radical|}
scan_math(nucleus(tail),cramped_style(mathstyle));
@z
@x
procedure math_ac;
begin if cur_cmd=accent then
@<Complain that the user should have said \.{\\mathaccent}@>;
tail_append(get_node(accent_noad_size));
type(tail):=accent_noad; subtype(tail):=normal;
@y
procedure math_ac;
begin if cur_cmd=accent then
@<Complain that the user should have said \.{\\mathaccent}@>;
tail_append(get_node(accent_noad_size));
type(tail):=accent_noad; subtype(tail):=cur_chr;
@z
@x
if (cur_val>=var_code)and fam_in_range then fam(accent_chr(tail)):=cur_fam
else fam(accent_chr(tail)):=(cur_val div 256) mod 16;
scan_math(nucleus(tail));
end;
@y
if (cur_val>=var_code)and fam_in_range then fam(accent_chr(tail)):=cur_fam
else fam(accent_chr(tail)):=(cur_val div 256) mod 16;
scan_math(nucleus(tail),cramped_style(mathstyle));
end;
@z
@x
3:begin script_script_mlist(tail):=p; decr(save_ptr); return;
end;
end; {there are no other cases}
incr(saved(-1)); push_math(math_choice_group); scan_left_brace;
@y
3:begin script_script_mlist(tail):=p; decr(save_ptr);
mathstyle:=saved(-1); decr(save_ptr);
return;
end;
end; {there are no other cases}
incr(saved(-1)); push_math(math_choice_group); scan_left_brace;
mathstyle:=2*saved(-1);
@z
@x
procedure sub_sup;
var t:small_number; {type of previous sub/superscript}
@!p:pointer; {field to be filled by |scan_math|}
begin t:=empty; p:=null;
if tail<>head then if scripts_allowed(tail) then
begin p:=supscr(tail)+cur_cmd-sup_mark; {|supscr| or |subscr|}
t:=math_type(p);
end;
if (p=null)or(t<>empty) then @<Insert a dummy noad to be sub/superscripted@>;
scan_math(p);
end;
@y
procedure sub_sup;
var t:small_number; {type of previous sub/superscript}
@!p:pointer; {field to be filled by |scan_math|}
begin t:=empty; p:=null;
if tail<>head then if scripts_allowed(tail) then
begin p:=supscr(tail)+cur_cmd-sup_mark; {|supscr| or |subscr|}
t:=math_type(p);
end;
if (p=null)or(t<>empty) then @<Insert a dummy noad to be sub/superscripted@>;
if cur_cmd=sup_mark then scan_math(p,sup_style(mathstyle))
else scan_math(p,sub_style(mathstyle));
end;
@z
@x
mmode+above: math_fraction;
@y
mmode+above: if cur_chr=fraction_code then begin
scan_left_brace; tail_append(new_noad);
back_input;
scan_math(nucleus(tail),num_style(mathstyle));
end else begin
math_fraction;
end;
@z
@x
procedure math_fraction;
var c:small_number; {the type of generalized fraction we are scanning}
begin c:=cur_chr;
@y
procedure math_fraction;
var c:small_number; {the type of generalized fraction we are scanning}
begin c:=cur_chr;
mathstyle:=denom_style(save_stack[cur_boundary-1].int);
@z
@x
math_group: begin unsave; decr(save_ptr);@/
math_type(saved(0)):=sub_mlist; p:=fin_mlist(null); info(saved(0)):=p;
@y
math_group: begin unsave; decr(save_ptr);@/
mathstyle:=saved(0); decr(save_ptr);
math_type(saved(0)):=sub_mlist; p:=fin_mlist(null); info(saved(0)):=p;
@z
