diff options
author | Norbert Preining <norbert@preining.info> | 2019-09-02 13:46:59 +0900 |
---|---|---|
committer | Norbert Preining <norbert@preining.info> | 2019-09-02 13:46:59 +0900 |
commit | e0c6872cf40896c7be36b11dcc744620f10adf1d (patch) | |
tree | 60335e10d2f4354b0674ec22d7b53f0f8abee672 /systems/tex-extensions/clasen/math |
Initial commit
Diffstat (limited to 'systems/tex-extensions/clasen/math')
-rw-r--r-- | systems/tex-extensions/clasen/math/accent.ch | 251 | ||||
-rw-r--r-- | systems/tex-extensions/clasen/math/cramp.ch | 48 | ||||
-rw-r--r-- | systems/tex-extensions/clasen/math/fraction.ch | 355 | ||||
-rw-r--r-- | systems/tex-extensions/clasen/math/math.ch | 683 | ||||
-rw-r--r-- | systems/tex-extensions/clasen/math/math.tex | 130 | ||||
-rw-r--r-- | systems/tex-extensions/clasen/math/radical.ch | 99 |
6 files changed, 1566 insertions, 0 deletions
diff --git a/systems/tex-extensions/clasen/math/accent.ch b/systems/tex-extensions/clasen/math/accent.ch new file mode 100644 index 0000000000..be9ba91347 --- /dev/null +++ b/systems/tex-extensions/clasen/math/accent.ch @@ -0,0 +1,251 @@ +@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 +primitive("mathaccent",math_accent,0);@/ +@!@:math_accent_}{\.{\\mathaccent} primitive@> +@y +primitive("mathaccent",math_accent,normal);@/ +@!@:math_accent_}{\.{\\mathaccent} primitive@> +primitive("nestingmathaccent",math_accent,normal+nesting);@/ +@!@:nesting_math_accent_}{\.{\\nestingmathaccent} primitive@> +primitive("mathunderaccent",math_accent,under_accent);@/ +@!@:math_under_accent_}{\.{\\mathunderaccent} primitive@> +primitive("nestingmathunderaccent",math_accent,under_accent+nesting);@/ +@!@:nesting_math_under_accent_}{\.{\\nestingmathunderaccent} primitive@> +@z + +@x +math_accent: print_esc("mathaccent"); +@y +math_accent: case chr_code of + normal: print_esc("mathaccent"); + normal+nesting: print_esc("nestingmathaccent"); + under_accent: print_esc("mathunderaccent"); + under_accent+nesting:print_esc("nestingmathunderaccent"); + othercases print("Unknown accent!") +endcases; +@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_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 + +% +% Here is the logic for finding the accentee: +% We pass by accent_noads as long as they are of the opposite kind +% or of same kind and also nesting. This logic is necessary to make +% \Hat{\uhat{\hat A}} align the two hats properly. + +@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 +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 + diff --git a/systems/tex-extensions/clasen/math/cramp.ch b/systems/tex-extensions/clasen/math/cramp.ch new file mode 100644 index 0000000000..57231a383f --- /dev/null +++ b/systems/tex-extensions/clasen/math/cramp.ch @@ -0,0 +1,48 @@ +@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 +primitive("displaystyle",math_style,display_style); +@!@:display_style_}{\.{\\displaystyle} primitive@> +primitive("textstyle",math_style,text_style); +@!@:text_style_}{\.{\\textstyle} primitive@> +primitive("scriptstyle",math_style,script_style); +@!@:script_style_}{\.{\\scriptstyle} primitive@> +primitive("scriptscriptstyle",math_style,script_script_style); +@!@:script_script_style_}{\.{\\scriptscriptstyle} primitive@> +@y +primitive("displaystyle",math_style,display_style); +@!@:display_style_}{\.{\\displaystyle} primitive@> +primitive("crampeddisplaystyle",math_style,display_style+cramped); +@!@:cramped_display_style_}{\.{\\crampeddisplaystyle} primitive@> +primitive("textstyle",math_style,text_style); +@!@:text_style_}{\.{\\textstyle} primitive@> +primitive("crampedtextstyle",math_style,text_style+cramped); +@!@:cramped_text_style_}{\.{\\crampedtextstyle} primitive@> +primitive("scriptstyle",math_style,script_style); +@!@:script_style_}{\.{\\scriptstyle} primitive@> +primitive("crampedscriptstyle",math_style,script_style+cramped); +@!@:cramped_script_style_}{\.{\\crampedscriptstyle} primitive@> +primitive("scriptscriptstyle",math_style,script_script_style); +@!@:script_script_style_}{\.{\\scriptscriptstyle} primitive@> +primitive("crampedscriptscriptstyle",math_style,script_script_style+cramped); +@!@:cramped_script_script_style_}{\.{\\crampedscriptscriptstyle} primitive@> +@z + + diff --git a/systems/tex-extensions/clasen/math/fraction.ch b/systems/tex-extensions/clasen/math/fraction.ch new file mode 100644 index 0000000000..ab27046166 --- /dev/null +++ b/systems/tex-extensions/clasen/math/fraction.ch @@ -0,0 +1,355 @@ +% idea: keep track of math style in integer parameter +% \mathstyle *while scanning the formula*. To be able +% to do this, we need to keep track of +% +% \overline +% ^ +% _ +% \mathaccent +% style atoms +% \fraction{...\over...} +% +% Change necessary: \mathstyle is *not* an ordinary +% integer parameter, since math style doesn't obey +% grouping. Try ${\scriptscriptstyle 1}2$. +% Therefore it should be a special readonly parameter and +% a \cramp primitive should be separately added. + +@x l.8392 +@d input_line_no_code=glue_val+1 {code for \.{\\inputlineno}} +@d badness_code=glue_val+2 {code for \.{\\badness}} +@y +@d input_line_no_code=glue_val+1 {code for \.{\\inputlineno}} +@d badness_code=glue_val+2 {code for \.{\\badness}} +@d math_style_code=glue_val+3 {code for \.{\\mathstyle}} +@z + +@x l.8420 +primitive("badness",last_item,badness_code); +@!@:badness_}{\.{\\badness} primitive@> +@y +primitive("badness",last_item,badness_code); +@!@:badness_}{\.{\\badness} primitive@> +primitive("mathstyle",last_item,math_style_code); +@!@:mathstyle_}{\.{\\mathstyle} primitive@> +@z + +@x l.8435 + input_line_no_code: print_esc("inputlineno"); + othercases print_esc("badness") +@y + input_line_no_code: print_esc("inputlineno"); + badness_code: print_esc("badness"); + math_style_code: print_esc("mathstyle"); + othercases confusion("last_item") +@:this can't happen last_item}{\quad last_item@> +@z + +% +% \mathstyle returns -1 if used outside math mode. +% + +@x l.8504 +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 l.14108 +@!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 l.21649 +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 l.21700 +push_math(math_shift_group); mode:=mmode; +eq_word_define(int_base+cur_fam_code,-1);@/ +@y +mathstyle:=display_style; +push_math(math_shift_group); mode:=mmode; +eq_word_define(int_base+cur_fam_code,-1);@/ +@z + +@x l.21798 +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 + +% +% we change scan_math to expect one additional parameter, +% the mathstyle for the next math atom. There are two +% cases here: +% - simple atom: use local var stack to hold old style +% and restore it from there +% - subformula: use save stack to hold old style and +% restore it when reading `}' +% + +@x l.21810 +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 l.21848 +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 l.21944 +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 l.21999 +%scan_delimiter(left_delimiter(tail),true); +%if t=1 then scan_delimiter(right_delimiter(tail),true) +%else mem[right_delimiter(tail)].qqqq:=null_delimiter; +%scan_math(nucleus(tail)); +%end; +%@y +%scan_delimiter(left_delimiter(tail),true); +%if t=1 then scan_delimiter(right_delimiter(tail),true) +%else mem[right_delimiter(tail)].qqqq:=null_delimiter; +%scan_math(nucleus(tail),cramped_style(mathstyle)); +%end; +%@z + +@x +{before |scan_math| in |math_radical|} +scan_math(nucleus(tail)); +@y +{before |scan_math| in |math_radical|} +scan_math(nucleus(tail),cramped_style(mathstyle)); +@z + +@x l.22012 +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 l.22066 +mmode+math_style: tail_append(new_style(cur_chr)); +@y +mmode+math_style: begin tail_append(new_style(cur_chr)); + mathstyle:=cur_chr; +end; +@z + +@x l.22076 +procedure append_choices; +begin tail_append(new_choice); incr(save_ptr); saved(-1):=0; +push_math(math_choice_group); scan_left_brace; +@y +procedure append_choices; +begin tail_append(new_choice); +incr(save_ptr); saved(-1):=mathstyle; +incr(save_ptr); saved(-1):=0; +push_math(math_choice_group); scan_left_brace; +mathstyle:=display_style; +@z + +@x l.22094 +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 l.22109 +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 l.22149 +@d delimited_code=3 { `\.{\\abovewithdelims}', etc.} +@y +@d delimited_code=3 { `\.{\\abovewithdelims}', etc.} +@d fraction_code=6 { `\.{\\fraction}', etc.} +@z + +@x l.22162 +primitive("atopwithdelims",above,delimited_code+atop_code); +@!@:atop_with_delims_}{\.{\\atopwithdelims} primitive@> +@y +primitive("atopwithdelims",above,delimited_code+atop_code); +@!@:atop_with_delims_}{\.{\\atopwithdelims} primitive@> +primitive("fraction",above,fraction_code); +@!@:fraction_}{\.{\\fraction} primitive@> +@z + +@x l.22171 + delimited_code+atop_code:print_esc("atopwithdelims"); + othercases print_esc("above") +@y + delimited_code+atop_code:print_esc("atopwithdelims"); + fraction_code:print_esc("fraction"); + othercases print_esc("above") +@z + +% We handle \fraction{...\over...} here, by scanning away +% the left brace and then doing the same as for +% mmode+left_brace +% The point is that we have a handle to update the +% math_style variable properly here. +% We do scan_left_brace followed by back_input to +% force the left brace to be there + +@x l.22176 +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 l.22258 +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 + + + diff --git a/systems/tex-extensions/clasen/math/math.ch b/systems/tex-extensions/clasen/math/math.ch new file mode 100644 index 0000000000..2fbe62230e --- /dev/null +++ b/systems/tex-extensions/clasen/math/math.ch @@ -0,0 +1,683 @@ +@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 +primitive("mathaccent",math_accent,0);@/ +@!@:math_accent_}{\.{\\mathaccent} primitive@> +@y +primitive("mathaccent",math_accent,normal);@/ +@!@:math_accent_}{\.{\\mathaccent} primitive@> +primitive("nestingmathaccent",math_accent,normal+nesting);@/ +@!@:nesting_math_accent_}{\.{\\nestingmathaccent} primitive@> +primitive("mathunderaccent",math_accent,under_accent);@/ +@!@:math_under_accent_}{\.{\\mathunderaccent} primitive@> +primitive("nestingmathunderaccent",math_accent,under_accent+nesting);@/ +@!@:nesting_math_under_accent_}{\.{\\nestingmathunderaccent} primitive@> +@z + +@x +primitive("radical",radical,0);@/ +@!@:radical_}{\.{\\radical} primitive@> +@y +primitive("radical",radical,0);@/ +@!@:radical_}{\.{\\radical} primitive@> +primitive("genradical",radical,1);@/ +@!@:genradical_}{\.{\\genradical} primitive@> +@z + +@x +math_accent: print_esc("mathaccent"); +@y +math_accent: case chr_code of + normal: print_esc("mathaccent"); + normal+nesting: print_esc("nestingmathaccent"); + under_accent: print_esc("mathunderaccent"); + under_accent+nesting:print_esc("nestingmathunderaccent"); + othercases print("Unknown accent!") +endcases; +@z + +@x +radical: print_esc("radical"); +@y +radical: if chr_code=0 then print_esc("radical") else print_esc("genradical"); +@z + +@x +@d input_line_no_code=glue_val+1 {code for \.{\\inputlineno}} +@d badness_code=glue_val+2 {code for \.{\\badness}} +@y +@d input_line_no_code=glue_val+1 {code for \.{\\inputlineno}} +@d badness_code=glue_val+2 {code for \.{\\badness}} +@d math_style_code=glue_val+3 {code for \.{\\mathstyle}} +@z + +@x +primitive("badness",last_item,badness_code); +@!@:badness_}{\.{\\badness} primitive@> +@y +primitive("badness",last_item,badness_code); +@!@:badness_}{\.{\\badness} primitive@> +primitive("mathstyle",last_item,math_style_code); +@!@:mathstyle_}{\.{\\mathstyle} primitive@> +@z + +@x + input_line_no_code: print_esc("inputlineno"); + othercases print_esc("badness") +@y + input_line_no_code: print_esc("inputlineno"); + badness_code: print_esc("badness"); + math_style_code: print_esc("mathstyle"); + othercases confusion("last_item") +@:this can't happen last_item}{\quad last_item@> +@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 +push_math(math_shift_group); mode:=mmode; +eq_word_define(int_base+cur_fam_code,-1);@/ +@y +mathstyle:=display_style; +push_math(math_shift_group); mode:=mmode; +eq_word_define(int_base+cur_fam_code,-1);@/ +@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 +type(tail):=radical_noad; subtype(tail):=normal; +@y +type(tail):=radical_noad; subtype(tail):=cur_chr; +@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 +primitive("displaystyle",math_style,display_style); +@!@:display_style_}{\.{\\displaystyle} primitive@> +primitive("textstyle",math_style,text_style); +@!@:text_style_}{\.{\\textstyle} primitive@> +primitive("scriptstyle",math_style,script_style); +@!@:script_style_}{\.{\\scriptstyle} primitive@> +primitive("scriptscriptstyle",math_style,script_script_style); +@!@:script_script_style_}{\.{\\scriptscriptstyle} primitive@> +@y +primitive("displaystyle",math_style,display_style); +@!@:display_style_}{\.{\\displaystyle} primitive@> +primitive("crampeddisplaystyle",math_style,display_style+cramped); +@!@:cramped_display_style_}{\.{\\crampeddisplaystyle} primitive@> +primitive("textstyle",math_style,text_style); +@!@:text_style_}{\.{\\textstyle} primitive@> +primitive("crampedtextstyle",math_style,text_style+cramped); +@!@:cramped_text_style_}{\.{\\crampedtextstyle} primitive@> +primitive("scriptstyle",math_style,script_style); +@!@:script_style_}{\.{\\scriptstyle} primitive@> +primitive("crampedscriptstyle",math_style,script_style+cramped); +@!@:cramped_script_style_}{\.{\\crampedscriptstyle} primitive@> +primitive("scriptscriptstyle",math_style,script_script_style); +@!@:script_script_style_}{\.{\\scriptscriptstyle} primitive@> +primitive("crampedscriptscriptstyle",math_style,script_script_style+cramped); +@!@:cramped_script_script_style_}{\.{\\crampedscriptscriptstyle} primitive@> +@z + +@x +mmode+math_style: tail_append(new_style(cur_chr)); +@y +mmode+math_style: begin tail_append(new_style(cur_chr)); + mathstyle:=cur_chr; +end; +@z + +@x +procedure append_choices; +begin tail_append(new_choice); incr(save_ptr); saved(-1):=0; +push_math(math_choice_group); scan_left_brace; +@y +procedure append_choices; +begin tail_append(new_choice); +incr(save_ptr); saved(-1):=mathstyle; +incr(save_ptr); saved(-1):=0; +push_math(math_choice_group); scan_left_brace; +mathstyle:=display_style; +@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 +@d delimited_code=3 { `\.{\\abovewithdelims}', etc.} +@y +@d delimited_code=3 { `\.{\\abovewithdelims}', etc.} +@d fraction_code=6 { `\.{\\fraction}', etc.} +@z + +@x +primitive("atopwithdelims",above,delimited_code+atop_code); +@!@:atop_with_delims_}{\.{\\atopwithdelims} primitive@> +@y +primitive("atopwithdelims",above,delimited_code+atop_code); +@!@:atop_with_delims_}{\.{\\atopwithdelims} primitive@> +primitive("fraction",above,fraction_code); +@!@:fraction_}{\.{\\fraction} primitive@> +@z + +@x + delimited_code+atop_code:print_esc("atopwithdelims"); + othercases print_esc("above") +@y + delimited_code+atop_code:print_esc("atopwithdelims"); + fraction_code:print_esc("fraction"); + othercases print_esc("above") +@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 + diff --git a/systems/tex-extensions/clasen/math/math.tex b/systems/tex-extensions/clasen/math/math.tex new file mode 100644 index 0000000000..1ce32accbc --- /dev/null +++ b/systems/tex-extensions/clasen/math/math.tex @@ -0,0 +1,130 @@ +\documentclass[preprint]{ltugboat} +\usepackage{shortvrb} +\usepackage{url} +\usepackage{booktabs} + +\providecommand{\meta}[1]{\ensuremath{\langle\textit{#1}\rangle}} +\makeatletter +\providecommand{\eTeX}{$\m@th\varepsilon$-\TeX} +\makeatother +\hyphenation{pa-ra-me-ter} + +\emergencystretch=4mm +\overfullrule=0pt +\title{Extending \TeX's mathematical typography} +\author{Matthias Clasen} +%\address{} +\netaddress{maclas@gmx.de} +\setcounter{page}{1} + +\begin{document} +\maketitle +\MakeShortVerb{\|} + +\section{Introduction} + +One of the reasons why \TeX\ is still in use is that its abilities +in setting mathematical formulas are still unsurmounted. But there +are some nits to pick. + +I propose a small set of extensions to \TeX\ to remove some deficiencies +in its handling of formulas. + +\section{Implementation} + +The implementation is split into a series of change files: + +|accent.ch| implements three new primitives for nestable accents and + under accents. To some extent these can be implemented in \TeX\ itself (see + \AmSLaTeX), but macro solutions are complicated, slow and error-prone. + \begin{description} + \item[]|\mathaccent|\meta{15-bit number}\meta{math field} can now + grok an extensible recipe at the end of a charlist. The extensible + recipe is used to construct longer variants of an accent (in analogy + to growing delimiters). + \item[]|\nestingmathaccent|\meta{15-bit number}\meta{math field} is + like |\math|\-|accent|, but it follows a chain of + |\nesting|\-|math|\-|accent| or |\nesting|\-|math|\-|under|\-|accent| + primitives to determine its accentee and the appropriate skew. + \item[]|\mathunderaccent|\meta{15-bit number}\meta{math field}\\ + places an accent \emph{under} the \meta{math field}. It uses the + \meta{accent}--\meta{accent} kerning to determine the vertical space + between the \meta{math field} and the \meta{accent} and the + \meta{skewchar}--\meta{accentee} kerning to determine the appropriate + skew to the left. + \item[]|\nestingmathunderaccent|\meta{15-bit number}% + $\langle$\textit{math}\\\null\hfill\textit{field}$\rangle$\\ + is a variant of |\math|\-|under|\-|accent| which + respects the nesting of accents. + \end{description} + +|cramp.ch| complements the |\display|\-|style|, \dots, +|\script|\-|script|\-|style| style-changing primitives by +|\cramped|\-|display|\-|style|, \dots, |\cramped|\-|script|\-|script|\-|style| +which change to the cramped styles. + +|fraction.ch| continues to improve the math style-handling. It + adds the following: + \begin{description} + \item[]|\mathstyle| is a special readonly integer parameter + corresponding to the current math style according to the + following table: + + \begin{tabular}{cc} + \toprule + math style&|\mathstyle|\\ + \midrule + none& \llap{${}<{}$}0\\ + D&0\\ + D'&1\\ + T&2\\ + T'&3\\ + S&4\\ + S'&5\\ + SS&6\\ + SS'&7\\ + \bottomrule + \end{tabular} + + \item[]|\fraction|\{\meta{math field}\} can be used to surround + fractions. Its sole purpose is that |\mathstyle| reports the correct + values in a subformula like |\fraction{...\over...}| while it fails to + do so in |{...\over...}|. + \end{description} + +|radical.ch| implements the following new primitive: + \begin{description} + \item[]|\genradical|\meta{27-bit number}\meta{27-bit number}% + $\langle$\textit{math}\\\null\hfill\textit{field}$\rangle$\\ + creates a radical with delimiters on both sides. By + specifiying a nonexisting left delimiter, you can also create a + right radical. + \end{description} + +\section{Installation} + + The change files are written for \TeX~3.1459. But it should need only + cosmetic changes to get them to work with other versions of \TeX3. + + To make the change files for \TeX{} work, you have to apply the change file + |pre.ch| first. I have only tried these files with |web2c|, and + for that you need to surround the |web2c| change file with |pre-web2c.ch| and + |post-web2c.ch|. + + All this boils down to the command line + +\begin{verbatim} +mv tex.ch tex.ch.orig +tie -c tex.ch tex.web pre.ch accent.ch \ + cramp.ch fraction.ch radical.ch \ + pre-web2c.ch tex.ch.orig \ + post-web2c.ch +\end{verbatim} + + \makesignature + + \bibliographystyle{plain} + \bibliography{etex} + +\end{document} + diff --git a/systems/tex-extensions/clasen/math/radical.ch b/systems/tex-extensions/clasen/math/radical.ch new file mode 100644 index 0000000000..757652cecd --- /dev/null +++ b/systems/tex-extensions/clasen/math/radical.ch @@ -0,0 +1,99 @@ +@x +primitive("radical",radical,0);@/ +@!@:radical_}{\.{\\radical} primitive@> +@y +primitive("radical",radical,0);@/ +@!@:radical_}{\.{\\radical} primitive@> +primitive("genradical",radical,1);@/ +@!@:genradical_}{\.{\\genradical} primitive@> +@z + +@x +radical: print_esc("radical"); +@y +radical: if chr_code=0 then print_esc("radical") else print_esc("genradical"); +@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 +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 +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 +type(tail):=radical_noad; subtype(tail):=normal; +@y +type(tail):=radical_noad; subtype(tail):=cur_chr; +@z + +@x +{before |scan_math| in |math_radical|} +@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|} +@z + + + + + |