ptexdir: patch from H. Kitagawa

git-svn-id: svn://tug.org/texlive/trunk@42040 c570f23f-e606-0410-a88d-b1316a301751

2 files changed, 71 insertions, 55 deletions

diff --git a/Build/source/texk/web2c/ptexdir/ChangeLog b/Build/source/texk/web2c/ptexdir/ChangeLog
index f0e1e4e62f9..bd88b7ee975 100644
--- a/Build/source/texk/web2c/ptexdir/ChangeLog
+++ b/Build/source/texk/web2c/ptexdir/ChangeLog
@@ -1,3 +1,7 @@
+2016-09-12  Hironori Kitagawa  <h_kitagawa2001@yahoo.co.jp>
+
+	* ptex-base.ch: New primitive \ifmbox to realize better box in math mode.
+
 2016-09-06  Hironori Kitagawa  <h_kitagawa2001@yahoo.co.jp>
 
 	* ptex-base.ch: Allow only 8bit arguments for \catcode etc.
diff --git a/Build/source/texk/web2c/ptexdir/ptex-base.ch b/Build/source/texk/web2c/ptexdir/ptex-base.ch
index a40aa7a78c3..3f31f30f89e 100644
--- a/Build/source/texk/web2c/ptexdir/ptex-base.ch
+++ b/Build/source/texk/web2c/ptexdir/ptex-base.ch
@@ -363,9 +363,10 @@ In p\TeX\ the |subtype| field records the box direction |box_dir|.
 @d hlist_node=0 {|type| of hlist nodes}
 @d box_node_size=8 {number of words to allocate for a box node}
 @#
-@d box_dir(#) == (qo(subtype(#))) {direction of a box}
+@d dir_max = 5 {the maximal absolute value of direction}
+@d box_dir(#) == (qo(subtype(#))-dir_max) {direction of a box}
 @d set_box_dir(#) == subtype(#):=set_box_dir_end
-@d set_box_dir_end(#) == qi(#)
+@d set_box_dir_end(#) == qi(#)+dir_max
 @#
 @d dir_default = 0 {direction of the box, default Left to Right}
 @d dir_dtou = 1 {direction of the box, Bottom to Top}
@@ -401,7 +402,7 @@ glue_sign(p):=normal; glue_order(p):=normal; set_glue_ratio_zero(glue_set(p));
 @y
 width(p):=0; depth(p):=0; height(p):=0; shift_amount(p):=0; list_ptr(p):=null;
 glue_sign(p):=normal; glue_order(p):=normal; set_glue_ratio_zero(glue_set(p));
-space_ptr(p):=zero_glue; xspace_ptr(p):=zero_glue;
+space_ptr(p):=zero_glue; xspace_ptr(p):=zero_glue; set_box_dir(p)(dir_default);
 add_glue_ref(zero_glue); add_glue_ref(zero_glue);
 @z
 
@@ -418,7 +419,7 @@ add_glue_ref(zero_glue); add_glue_ref(zero_glue);
 var p:pointer; {the new node}
 begin if type(b)>vlist_node then confusion("new_dir_node:not box");
 p:=new_null_box; type(p):=dir_node; set_box_dir(p)(dir);
-case box_dir(b) of
+case abs(box_dir(b)) of
   dir_yoko: @<Yoko to other direction@>;
   dir_tate: @<Tate to other direction@>;
   dir_dtou: @<DtoU to other direction@>;
@@ -468,7 +469,7 @@ end;
 @d rule_node=3 {|type| of rule nodes}
 @z
 
-@x [10.140] l.3083 - pTeX: renumber ins_node, add ins_dir field
+@x [10.140] l.3083 - pTeX: renumber ins_node, add ins_dirh field
 @d ins_node=3 {|type| of insertion nodes}
 @d ins_node_size=5 {number of words to allocate for an insertion}
 @d float_cost(#)==mem[#+1].int {the |floating_penalty| to be used}
@@ -480,7 +481,8 @@ end;
 @d float_cost(#)==mem[#+1].int {the |floating_penalty| to be used}
 @d ins_ptr(#)==info(#+4) {the vertical list to be inserted}
 @d split_top_ptr(#)==link(#+4) {the |split_top_skip| to be used}
-@d ins_dir(#)==subtype(#+5) {direction of |ins_node|}
+@d ins_dir(#)==(subtype(#+5)-dir_max) {direction of |ins_node|}
+@d set_ins_dir(#) == subtype(#+5):=set_box_dir_end
 @z
 
 @x [10.141] l.3089 - pTeX: disp_node
@@ -659,7 +661,7 @@ print(", natural size "); print_scaled(height(p));
 @y
 @ @<Display insertion |p|@>=
 begin print_esc("insert"); print_int(qo(subtype(p)));
-print_dir(ins_dir(p));
+print_dir(abs(ins_dir(p)));
 print(", natural size "); print_scaled(height(p));
 @z
 
@@ -2035,7 +2037,7 @@ if box(cur_val)=null then cur_val:=0 @+else cur_val:=mem[box(cur_val)+m].sc;
 begin scan_eight_bit_int; q:=box(cur_val);
 if q=null then cur_val:=0
 else  begin qx:=q;
-  while (q<>null)and(box_dir(q)<>abs(direction)) do q:=link(q);
+  while (q<>null)and(abs(box_dir(q))<>abs(direction)) do q:=link(q);
   if q=null then
     begin r:=link(qx); link(qx):=null;
     q:=new_dir_node(qx,abs(direction)); link(qx):=r;
@@ -2346,6 +2348,7 @@ string_code:if cur_cs<>0 then sprint_cs(cur_cs)
 @d if_tbox_code=if_mdir_code+1 { `\.{\\iftbox}' }
 @d if_ybox_code=if_tbox_code+1 { `\.{\\ifybox}' }
 @d if_dbox_code=if_ybox_code+1 { `\.{\\ifdbox}' }
+@d if_mbox_code=if_dbox_code+1 { `\.{\\ifmbox}' }
 @z
 
 @x [28.487] l.9887 - pTeX: iftdir, ifydir, ifddir, iftbox, ifybox, ifdbox
@@ -2368,6 +2371,8 @@ primitive("ifybox",if_test,if_ybox_code);
 @!@:if_ybox_}{\.{\\ifybox} primitive@>
 primitive("ifdbox",if_test,if_dbox_code);
 @!@:if_dbox_}{\.{\\ifdbox} primitive@>
+primitive("ifmbox",if_test,if_mbox_code);
+@!@:if_mbox_}{\.{\\ifmbox} primitive@>
 @z
 
 @x [28.488] l.9907 - pTeX: iftdir, ifydir, ifddir, iftbox, ifybox, ifdbox
@@ -2381,6 +2386,7 @@ primitive("ifdbox",if_test,if_dbox_code);
   if_tbox_code:print_esc("iftbox");
   if_ybox_code:print_esc("ifybox");
   if_dbox_code:print_esc("ifdbox");
+  if_mbox_code:print_esc("ifmbox");
 @z
 
 @x [28.501] l.10073 - pTeX: iftdir, ifydir, ifddir, iftbox, ifybox, ifdbox
@@ -2390,7 +2396,7 @@ if_tdir_code: b:=(abs(direction)=dir_tate);
 if_ydir_code: b:=(abs(direction)=dir_yoko);
 if_ddir_code: b:=(abs(direction)=dir_dtou);
 if_mdir_code: b:=(direction<0);
-if_void_code, if_hbox_code, if_vbox_code, if_tbox_code, if_ybox_code, if_dbox_code:
+if_void_code, if_hbox_code, if_vbox_code, if_tbox_code, if_ybox_code, if_dbox_code, if_mbox_code:
   @<Test box register status@>;
 @z
 
@@ -2406,9 +2412,10 @@ else begin
   if type(p)=dir_node then p:=list_ptr(p);
   if this_if=if_hbox_code then b:=(type(p)=hlist_node)
   else if this_if=if_vbox_code then b:=(type(p)=vlist_node)
-  else if this_if=if_tbox_code then b:=(box_dir(p)=dir_tate)
-  else if this_if=if_ybox_code then b:=(box_dir(p)=dir_yoko)
-  else b:=(box_dir(p)=dir_dtou);
+  else if this_if=if_tbox_code then b:=(abs(box_dir(p))=dir_tate)
+  else if this_if=if_ybox_code then b:=(abs(box_dir(p))=dir_yoko)
+  else if this_if=if_dbox_code then b:=(abs(box_dir(p))=dir_dtou)
+  else b:=(box_dir(p)<0);
   end
 @z
 
@@ -3169,7 +3176,7 @@ if type(p)=dir_node then
   free_node(del_node,box_node_size);
   end;
 flush_node_list(link(p)); link(p):=null;
-if box_dir(p)<>dir_yoko then p:=new_dir_node(p,dir_yoko);
+if abs(box_dir(p))<>dir_yoko then p:=new_dir_node(p,dir_yoko);
 @<Ship box |p| out@>;
 @z
 
@@ -3230,6 +3237,7 @@ var r:pointer; {the box node that will be returned}
 q:=r+list_offset; link(q):=p;@/
 h:=0; @<Clear dimensions to zero@>;
 @y
+set_box_dir(r)(dir_default);
 space_ptr(r):=cur_kanji_skip; xspace_ptr(r):=cur_xkanji_skip;
 add_glue_ref(cur_kanji_skip); add_glue_ref(cur_xkanji_skip);
 k:=cur_kanji_skip;
@@ -3344,7 +3352,7 @@ begin last_badness:=0; r:=get_node(box_node_size); type(r):=vlist_node;
 subtype(r):=min_quarterword; shift_amount(r):=0;
 @y
 begin last_badness:=0; r:=get_node(box_node_size); type(r):=vlist_node;
-subtype(r):=min_quarterword; shift_amount(r):=0;
+subtype(r):=min_quarterword; shift_amount(r):=0; set_box_dir(r)(dir_default);
 space_ptr(r):=zero_glue; xspace_ptr(r):=zero_glue;
 add_glue_ref(zero_glue); add_glue_ref(zero_glue);
 @z
@@ -3526,15 +3534,19 @@ function shift_sub_exp_box(@!q:pointer):pointer;
   { We assume that |math_type(q)=sub_exp_box| }
   var d: halfword; {displacement}
   begin
-    if direction=dir_tate then d:=t_baseline_shift
-    else d:=y_baseline_shift;
-    if cur_style<script_style then 
-      d:=xn_over_d(d,text_baseline_shift_factor, 1000)
-    else if cur_style<script_script_style then 
-      d:=xn_over_d(d,script_baseline_shift_factor, 1000)
-    else
-      d:=xn_over_d(d,scriptscript_baseline_shift_factor, 1000);
-    shift_amount(info(q)):=shift_amount(info(q))-d;
+    if abs(direction)=abs(box_dir(info(q))) then begin
+      if abs(direction)=dir_tate then begin
+        if box_dir(info(q))=dir_tate then d:=t_baseline_shift
+        else d:=y_baseline_shift end
+      else d:=y_baseline_shift;
+      if cur_style<script_style then 
+        d:=xn_over_d(d,text_baseline_shift_factor, 1000)
+      else if cur_style<script_script_style then 
+        d:=xn_over_d(d,script_baseline_shift_factor, 1000)
+      else
+        d:=xn_over_d(d,scriptscript_baseline_shift_factor, 1000);
+      shift_amount(info(q)):=shift_amount(info(q))-d;
+    end;
     math_type(q):=sub_box;
     shift_sub_exp_box:=info(q);
   end;
@@ -3948,7 +3960,7 @@ glue_order(q):=glue_order(p); glue_sign(q):=glue_sign(p);
 glue_set(q):=glue_set(p); shift_amount(q):=o;
 r:=link(list_ptr(q)); s:=link(list_ptr(p));
 @y
-set_box_dir(q)(abs(direction));
+set_box_dir(q)(direction);
 glue_order(q):=glue_order(p); glue_sign(q):=glue_sign(p);
 glue_set(q):=glue_set(p); shift_amount(q):=o;
 r:=link(list_ptr(q)); s:=link(list_ptr(p));
@@ -3964,7 +3976,7 @@ s:=link(s); link(u):=new_null_box; u:=link(u); t:=t+width(s);
 if mode=-vmode then width(u):=width(s)@+else
   begin type(u):=vlist_node; height(u):=width(s);
   end;
-set_box_dir(u)(abs(direction))
+set_box_dir(u)(direction)
 @z
 
 @x [37.810] l.16564 - pTeX: unset box -> BOX
@@ -3972,7 +3984,7 @@ width(r):=w; type(r):=hlist_node;
 end
 @y
 width(r):=w; type(r):=hlist_node;
-set_box_dir(r)(abs(direction));
+set_box_dir(r)(direction);
 end
 @z
 
@@ -3980,7 +3992,7 @@ end
 height(r):=w; type(r):=vlist_node;
 @y
 height(r):=w; type(r):=vlist_node;
-set_box_dir(r)(abs(direction));
+set_box_dir(r)(direction);
 @z
 
 @x [38.816] l.16687 - pTeX: init chain, delete disp_node
@@ -4451,7 +4463,7 @@ else height(r):=height(box(n))+depth(box(n));
 @y
 if box(n)=null then height(r):=0
 else
-  begin if ins_dir(p)<>box_dir(box(n)) then
+  begin if abs(ins_dir(p))<>abs(box_dir(box(n))) then
     begin print_err("Insertions can only be added to a same direction vbox");
 @.Insertions can only...@>
     help3("Tut tut: You're trying to \insert into a")@/
@@ -4478,9 +4490,9 @@ else  begin wait:=false; s:=last_ins_ptr(r); link(s):=ins_ptr(p);
 if best_ins_ptr(r)=null then wait:=true
 else  begin wait:=false;
   n:=qo(subtype(p));
-  case box_dir(box(n)) of
+  case abs(box_dir(box(n))) of
     any_dir:
-      if ins_dir(p)<>box_dir(box(n)) then begin
+      if abs(ins_dir(p))<>abs(box_dir(box(n))) then begin
         print_err("Insertions can only be added to a same direction vbox");
 @.Insertions can only...@>
         help3("Tut tut: You're trying to \insert into a")@/
@@ -4490,7 +4502,7 @@ else  begin wait:=false;
         box(n):=new_null_box; last_ins_ptr(r):=box(n)+list_offset;
       end;
     othercases
-      set_box_dir(box(n))(ins_dir(p));
+      set_box_dir(box(n))(abs(ins_dir(p)));
   endcases;
   s:=last_ins_ptr(r); link(s):=ins_ptr(p);
 @z
@@ -4511,7 +4523,7 @@ delete_glue_ref(space_ptr(box(n)));
 delete_glue_ref(xspace_ptr(box(n)));
 flush_node_list(link(box(n)));
 free_node(box(n),box_node_size);
-box(n):=vpack(temp_ptr,natural); set_box_dir(box(n))(ins_dir(p));
+box(n):=vpack(temp_ptr,natural); set_box_dir(box(n))(abs(ins_dir(p)));
 @z
 
 @x [46.1030] l.20687 -  pTeX:main_control
@@ -4807,7 +4819,7 @@ q:pointer;
   begin p:=link(cur_box); link(cur_box):=null;
   while p<>null do begin
     q:=p; p:=link(p);
-    if box_dir(q)=abs(direction) then
+    if abs(box_dir(q))=abs(direction) then
       begin list_ptr(q):=cur_box; cur_box:=q; link(cur_box):=null;
       end
     else begin
@@ -4816,7 +4828,7 @@ q:pointer;
       free_node(q,box_node_size);
       end;
   end;
-  if box_dir(cur_box)<>abs(direction) then
+  if abs(box_dir(cur_box))<>abs(direction) then
     cur_box:=new_dir_node(cur_box,abs(direction));
   shift_amount(cur_box):=box_context;
 @z
@@ -4839,7 +4851,7 @@ q:pointer;
     begin p:=link(cur_box); link(cur_box):=null;
     while p<>null do
       begin q:=p; p:=link(p);
-      if box_dir(q)=abs(direction) then
+      if abs(box_dir(q))=abs(direction) then
         begin list_ptr(q):=cur_box; cur_box:=q; link(cur_box):=null;
         end
       else begin
@@ -4848,7 +4860,7 @@ q:pointer;
         free_node(q,box_node_size);
         end;
       end;
-    if box_dir(cur_box)<>abs(direction) then
+    if abs(box_dir(cur_box))<>abs(direction) then
       cur_box:=new_dir_node(cur_box,abs(direction));
     end;
   leader_ptr(tail):=cur_box;
@@ -4947,7 +4959,7 @@ if type(cur_box)=dir_node then
   list_ptr(link(cur_box)):=null;
   end
 else
-  if box_dir(cur_box)=dir_default then set_box_dir(cur_box)(abs(direction));
+  if box_dir(cur_box)=dir_default then set_box_dir(cur_box)(direction);
 end
 @z
 
@@ -5009,10 +5021,10 @@ begin d:=box_max_depth;
   unsave; save_ptr:=save_ptr-3;
   if mode=-hmode then begin
     cur_box:=hpack(link(head),saved(2),saved(1));
-    set_box_dir(cur_box)(abs(direction)); pop_nest;
+    set_box_dir(cur_box)(direction); pop_nest;
   end else begin
     cur_box:=vpackage(link(head),saved(2),saved(1),d);
-    set_box_dir(cur_box)(abs(direction)); pop_nest;
+    set_box_dir(cur_box)(direction); pop_nest;
     if c=vtop_code then
       @<Readjust the height and depth of |cur_box|, for \.{\\vtop}@>;
   end;
@@ -5041,7 +5053,7 @@ vmode+letter,vmode+other_char,vmode+char_num,vmode+char_given,
 push_nest; mode:=hmode; space_factor:=1000; set_cur_lang; clang:=cur_lang;
 @y
 inhibit_glue_flag := false;
-push_nest; adjust_dir:=abs(direction);
+push_nest; adjust_dir:=direction;
 mode:=hmode; space_factor:=1000; set_cur_lang; clang:=cur_lang;
 @z
 
@@ -5085,19 +5097,19 @@ insert_group: begin end_graf; q:=split_top_skip; add_glue_ref(q);
 insert_group: begin end_graf; q:=split_top_skip; add_glue_ref(q);
   d:=split_max_depth; f:=floating_penalty; unsave; decr(save_ptr);
   {now |saved(0)| is the insertion number, or 255 for |vadjust|}
-  p:=vpack(link(head),natural); set_box_dir(p)(abs(direction)); pop_nest;
+  p:=vpack(link(head),natural); set_box_dir(p)(direction); pop_nest;
   if saved(0)<255 then
     begin r:=get_node(ins_node_size);
     type(r):=ins_node; subtype(r):=qi(saved(0));
     height(r):=height(p)+depth(p); ins_ptr(r):=list_ptr(p);
     split_top_ptr(r):=q; depth(r):=d; float_cost(r):=f;
-    ins_dir(r):=box_dir(p);
+    set_ins_dir(r)(box_dir(p));
     if not is_char_node(tail)and(type(tail)=disp_node) then
       prev_append(r)
     else tail_append(r);
     end
   else  begin
-    if box_dir(p)<>adjust_dir then
+    if abs(box_dir(p))<>abs(adjust_dir) then
       begin print_err("Direction Incompatible.");
       help1("\vadjust's argument and outer vlist must have same direction.");
       error; flush_node_list(list_ptr(p));
@@ -5203,9 +5215,9 @@ if (abs(mode)=mmode)or((abs(mode)=vmode)and(type(p)<>vlist_node))or@|
   ("And I can't open any boxes in math mode.");@/
   error; return;
 end;
-case box_dir(p) of
+case abs(box_dir(p)) of
   any_dir:
-    if abs(direction)<>box_dir(p) then begin
+    if abs(direction)<>abs(box_dir(p)) then begin
       print_err("Incompatible direction list can't be unboxed");
       help2("Sorry, Pandora. (You sneaky devil.)")@/
       ("I refuse to unbox a box in differrent direction.");@/
@@ -5602,8 +5614,8 @@ vcenter_group: begin end_graf; unsave; save_ptr:=save_ptr-2;
 @y
 vcenter_group: begin end_graf; unsave; save_ptr:=save_ptr-2;
   p:=vpack(link(head),saved(1),saved(0));
-  set_box_dir(p)(abs(direction)); pop_nest;
-  if box_dir(p)<>abs(direction) then p:=new_dir_node(p,abs(direction));
+  set_box_dir(p)(direction); pop_nest;
+  if abs(box_dir(p))<>abs(direction) then p:=new_dir_node(p,abs(direction));
   tail_append(new_noad); type(tail):=vcenter_noad;
   math_type(nucleus(tail)):=sub_box; info(nucleus(tail)):=p;
   end;
@@ -5692,7 +5704,7 @@ end
 @x [48.1200] l.23203 - pTeX: adjust direction
 push_nest; mode:=hmode; space_factor:=1000; set_cur_lang; clang:=cur_lang;
 @y
-push_nest; adjust_dir:=abs(direction);
+push_nest; adjust_dir:=direction;
 mode:=hmode; space_factor:=1000; set_cur_lang; clang:=cur_lang;
 @z
 
@@ -5888,10 +5900,10 @@ scan_normal_dimen;
 if box(b)<>null then
   begin q:=box(b); p:=link(q);
   while p<>null do
-    begin if abs(direction)=box_dir(p) then q:=p;
+    begin if abs(direction)=abs(box_dir(p)) then q:=p;
     p:=link(p);
     end;
-  if box_dir(q)<>abs(direction) then
+  if abs(box_dir(q))<>abs(direction) then
     begin p:=link(box(b)); link(box(b)):=null;
     q:=new_dir_node(q,abs(direction)); list_ptr(q):=null;
     link(q):=p; link(box(b)):=q;
@@ -6838,16 +6850,16 @@ begin this_box:=temp_ptr;
   temp_ptr:=list_ptr(this_box);
   if (type(temp_ptr)<>hlist_node)and(type(temp_ptr)<>vlist_node) then
     confusion("dir_out");
-  case box_dir(this_box) of
+  case abs(box_dir(this_box)) of
   dir_yoko:
-    case box_dir(temp_ptr) of
+    case abs(box_dir(temp_ptr)) of
     dir_tate: {Tate in Yoko}
       begin cur_v:=cur_v-height(this_box); cur_h:=cur_h+depth(temp_ptr) end;
     dir_dtou: {DtoU in Yoko}
       begin cur_v:=cur_v+depth(this_box); cur_h:=cur_h+height(temp_ptr) end;
     endcases;
   dir_tate:
-    case box_dir(temp_ptr) of
+    case abs(box_dir(temp_ptr)) of
     dir_yoko: {Yoko in Tate}
       begin cur_v:=cur_v+depth(this_box); cur_h:=cur_h+height(temp_ptr) end;
     dir_dtou: {DtoU in Tate}
@@ -6857,7 +6869,7 @@ begin this_box:=temp_ptr;
       end;
     endcases;
   dir_dtou:
-    case box_dir(temp_ptr) of
+    case abs(box_dir(temp_ptr)) of
     dir_yoko: {Yoko in DtoU}
       begin cur_v:=cur_v-height(this_box); cur_h:=cur_h+depth(temp_ptr) end;
     dir_tate: {Tate in DtoU}
@@ -6867,7 +6879,7 @@ begin this_box:=temp_ptr;
       end;
     endcases;
   endcases;
-  cur_dir_hv:=box_dir(temp_ptr);
+  cur_dir_hv:=abs(box_dir(temp_ptr));
   if type(temp_ptr)=vlist_node then vlist_out@+else hlist_out;
 end;