2021-07-16 22:01:00

11 files changed, 709 insertions, 6 deletions

diff --git a/metapost/context/base/common/boxes.mp b/metapost/context/base/common/boxes.mp
new file mode 100644
index 000000000..f9cb4a5bb
--- /dev/null
+++ b/metapost/context/base/common/boxes.mp
@@ -0,0 +1 @@
+scantokens("input mp-xbox.mp" & (if metapostversion > 2 : "xl" else : "iv" fi)) ;
diff --git a/metapost/context/base/common/hatching.mp b/metapost/context/base/common/hatching.mp
new file mode 100644
index 000000000..ae63b676e
--- /dev/null
+++ b/metapost/context/base/common/hatching.mp
@@ -0,0 +1,10 @@
+% This is placeholder for Bogluslaw Jackowski's hatching.mp file which can be found in
+% the public domain and dates from 2000. It provides:
+%
+% draw hatched (fullcircle scaled 10cm) (45, 4, 1) withcolor "red" ;
+%
+% interim hatch_match := 1;
+%
+% This macro is not in mp-tool so this is a placeholder. The hatching macro doesn't fit
+% into metafun because it assume withcolor to behave in a certain way. Also, we use more
+% efficient path constructor.
diff --git a/metapost/context/base/mpiv/mp-base.mpiv b/metapost/context/base/mpiv/mp-base.mpiv
index 9b85d5ffd..c5f69fbda 100644
--- a/metapost/context/base/mpiv/mp-base.mpiv
+++ b/metapost/context/base/mpiv/mp-base.mpiv
@@ -928,14 +928,21 @@ string extra_beginfig, extra_endfig ;
 extra_beginfig := "" ;
 extra_endfig   := "" ;
 
-def beginfig(expr c) =
+boolean makingfigure ; makingfigure := false ;
+numeric stacking ; stacking := 0 ;
+
+def beginfig(expr c) = % redefined in mp-grph !
     begingroup
+    save makingfigure ; boolean makingfigure ;
+    save stacking ; numeric stacking;
     charcode := c ;
     clearxy ;
     clearit ;
     clearpen ;
     pickup defaultpen ;
     drawoptions() ;
+    stacking := 0 ;
+    makingfigure := true;
     scantokens extra_beginfig ;
 enddef ;
 
diff --git a/metapost/context/base/mpiv/mp-grph.mpiv b/metapost/context/base/mpiv/mp-grph.mpiv
index d4316eb91..6e980fd0d 100644
--- a/metapost/context/base/mpiv/mp-grph.mpiv
+++ b/metapost/context/base/mpiv/mp-grph.mpiv
@@ -49,8 +49,10 @@ def resetfig =
     interim linecap := linecap ;
     interim linejoin := linejoin ;
     interim miterlimit := miterlimit ;
-    save _background_ ; color _background_ ; _background_ :=  background  ;
-    save  background  ; color  background  ;  background  := _background_ ;
+    save stacking ; numeric stacking ; stacking := 0 ;
+    save makingfigure ; boolean makingfigure ; makingfigure := true ;
+    save _background_ ; color _background_ ; _background_ := background  ;
+    save  background ; color background ;  background := _background_ ;
     drawoptions () ;
 enddef ;
 
diff --git a/metapost/context/base/mpiv/mp-tool.mpiv b/metapost/context/base/mpiv/mp-tool.mpiv
index fc983d5a8..611eafe77 100644
--- a/metapost/context/base/mpiv/mp-tool.mpiv
+++ b/metapost/context/base/mpiv/mp-tool.mpiv
@@ -3683,3 +3683,48 @@ def yslanted primary s =
             t
         endgroup
 enddef ;
+
+% By Bogluslaw Jackowski (public domain):
+%
+% draw hatched (fullcircle scaled 10cm) (45, 4, 1) withcolor "red" ;
+
+newinternal hatch_match; hatch_match := 1;
+
+vardef hatched(expr o) primary c =
+    save a_, b_, d_, l_, i_, r_, za_, zb_, zc_, zd_;
+    path b_; picture r_; pair za_, zb_, zc_, zd_;
+    r_ := image (
+        a_ := redpart(c) mod 180 ;
+        l_ := greenpart(c) ;
+        d_ := -bluepart(c) ;
+        b_ := o rotated -a_ ;
+        b_ :=
+            if a_ >= 90 :
+                (lrcorner b_ -- llcorner b_ -- ulcorner b_ -- urcorner b_ -- cycle)
+            else :
+                (llcorner b_ -- lrcorner b_ -- urcorner b_ -- ulcorner b_ -- cycle)
+            fi
+            rotated a_ ;
+        za_ := point 0 of b_ ;
+        zb_ := point 1 of b_ ;
+        zc_ := point 2 of b_ ;
+        zd_ := point 3 of b_ ;
+        if hatch_match > 0 :
+            n_ := round(length(zd_-za_) / l_) ;
+            if n_ < 2:
+                n_ := 2 ;
+            fi ;
+            l_ := length(zd_-za_) / n_ ;
+        else :
+            n_ := length(zd_-za_) / l_ ;
+        fi
+        save currentpen; pen currentpen ; pickup pencircle scaled d_;
+        % we use a single path instead:
+        for i_ := if hatch_match > 0 : 1 else : 0 fi upto ceiling n_ - 1 :
+            nodraw (i_/n_)[zd_,za_] -- (i_/n_)[zc_,zb_] ;
+        endfor
+        dodraw origin ;
+    ) ;
+    clip r_ to o;
+    r_
+enddef;
diff --git a/metapost/context/base/mpiv/mp-xbox.mpiv b/metapost/context/base/mpiv/mp-xbox.mpiv
new file mode 100644
index 000000000..4b4c4c3cd
--- /dev/null
+++ b/metapost/context/base/mpiv/mp-xbox.mpiv
@@ -0,0 +1,293 @@
+% This file is a variant of "macros for boxes"::
+%
+% author    : Taco Hoekwater
+% version   : $Id: boxes.mp,v 1.5 2005/02/25 11:28:56 taco Exp $
+% copyright : Public domain
+% patched   : Hans Hagen
+%
+% The code is the same but I've added s boxes_ namespace for soem so that we don't
+% clash with metafun.
+
+if known metafun_loaded_xbox : endinput ; fi ;
+
+boolean metafun_loaded_xbox ; metafun_loaded_xbox := true ;
+
+% Find the length of the prefix of string s for which cond is true for each character
+% c of the prefix. Loading and initialization is now under metafun control. Only the
+% mpxl variant will be adapted. When needed this file will be adapted.
+
+vardef boxes_str_prefix (expr s) (text cond) =
+    save i_, c; string c; i_ = 0;
+    forever:
+        c := substring (i_, i_ + 1) of s;
+        exitunless cond;
+        exitif incr i_ = length s;
+    endfor
+    i_
+enddef;
+
+% Take a string returned by the str operator and return the same string with explicit
+% numeric subscripts replaced by generic subscript symbols [] (fixed by Eddie Kohler).
+
+vardef generisize (expr ss) =
+    save r, s, l; string r, s;
+    r = ""; % result so far
+    s = ss; % left to process
+    forever:
+        exitif s = "";
+        l := boxes_str_prefix(s, (c<>"[") and ((c<"0") or (c>"9")));
+        r := r & substring (0,l) of s;
+        s := substring (l, infinity) of s;
+        if s <> "" :
+            if (s >= "[") and (length s > 1) :
+                if (substring (1,2) of s) = "[" :
+                    l := 2;
+                    r := r & "[[";
+                else :
+                    l := 1 + boxes_str_prefix(s, c <> "]");
+                    r := r & "[]";
+                fi
+            else :
+                r := r & "[]";
+                l := boxes_str_prefix(s, (c = ".") or ("0" <= c) and (c <= "9"));
+            fi
+            s := substring(l, infinity) of s;
+        fi
+    endfor
+    r
+enddef;
+
+% Make sure the string boxes_n_gen is generisize(_n_):
+
+string boxes_n, boxes_n_cur, boxes_n_gen; boxes_n_cur := "]"; % this won't match _n_
+
+vardef boxes_set_n_gen =
+    if boxes_n <> boxes_n_cur:
+        boxes_n_cur := boxes_n;
+        boxes_n_gen := generisize(boxes_n);
+    fi
+enddef;
+
+% Given a type t and list of variable names vars, make sure that they are of type t
+% and redeclare them as necessary.  In the vars list _n represents scantokens boxes_n,
+% a suffix that might contain numeric subscripts. This suffix needs to be replaced
+% by scantokens boxes_n_gen in order to get a variable that can be declared to be of
+% type t.
+
+vardef boxes_declare(text t) text vars =
+    boxes_set_n_gen;
+    forsuffixes v_ = vars :
+        if forsuffixes _n = scantokens boxes_n : not t v_ endfor :
+            def boxes_gdmac text _n = t v_ enddef;
+            expandafter boxes_gdmac scantokens boxes_n_gen;
+        fi
+    endfor
+enddef;
+
+% Here is another version that redeclares the vars even if they are already of the
+% right type.
+
+vardef boxes_redeclare(text t) text vars =
+    boxes_set_n_gen;
+    def boxes_gdmac text _n = t vars enddef;
+    expandafter boxes_gdmac scantokens boxes_n_gen;
+enddef;
+
+% pp should be a string giving the name of a macro that finds the boundary path and
+% sp should be a string that names a macro for fixing the size and shape. The suffix
+% $ is the name of the box. The text t gives the box contents: either empty, a
+% picture, or a string to typeset.
+
+def boxes_begin (expr pp, sp) (suffix $) (text t) =
+    boxes_n := str $;
+    boxes_declare (pair) _n.off, _n.c;
+    boxes_declare (string) boxes_pproc._n, boxes_sproc._n;
+    boxes_declare (picture) boxes_pic._n;
+    boxes_pproc$ := pp;
+    boxes_sproc$ := sp;
+    boxes_pic$ := nullpicture;
+    for _p_ = t :
+      % boxes_pic$ := if picture _p_: _p_ else: _p_ infont defaultfont scaled defaultscale fi;
+        boxes_pic$ := if picture _p_: _p_ else: textext(_p_) fi;
+    endfor
+    $c = $off + .5[llcorner boxes_pic$, urcorner boxes_pic$]
+enddef;
+
+% The suffix cl names a vardef macro that clears box-related variables. The suffix $
+% is the name of the box being ended.
+
+def boxes_end(suffix cl, $) =
+    if known boxes_pic.boxes_prevbox:
+        boxes_dojoin(boxes_prevbox,$);
+    fi
+    def boxes_prevbox = $ enddef;
+    expandafter def expandafter boxes_clear_all expandafter =
+        boxes_clear_all cl($);
+    enddef
+enddef;
+
+% Text t gives equations for joining box a to box b.
+
+def boxes_boxjoin(text t) =
+    def boxes_prevbox = _ enddef;
+    def boxes_dojoin(suffix a,b) = t enddef;
+enddef ;
+
+def boxes_clear_all = enddef;
+
+% Given a list of box names, give whatever default values are necessary
+% in order to fix the size and shape of each box.
+
+vardef boxes_fixsize(text t) =
+    forsuffixes $ = t : scantokens boxes_sproc$($); endfor
+enddef;
+
+% Given a list of box names, give default values for any unknown positioning offsets.
+
+vardef boxes_fixpos(text t) =
+    forsuffixes $=t:
+        if unknown xpart $.off : xpart $.off = 0; fi
+        if unknown ypart $.off : ypart $.off = 0; fi
+    endfor
+enddef;
+
+% Return the boundary path for the given box
+
+vardef bpath suffix $ =
+    boxes_fixsize($);
+    boxes_fixpos($);
+    scantokens boxes_pproc$($)
+enddef;
+
+% Return the contents of the given box. First define a private version that the user can't
+% accidently clobber.
+
+vardef boxes_pic_mac suffix $ =
+    boxes_fixsize($);
+    boxes_fixpos($);
+    boxes_pic$ shifted $off
+enddef;
+
+vardef pic suffix $ = boxes_pic_mac $ enddef;
+
+% Draw each box:
+
+def drawboxed(text t) =
+    boxes_fixsize(t);
+    boxes_fixpos(t);
+    forsuffixes s = t: draw boxes_pic_mac.s; draw bpath.s; endfor
+enddef;
+
+% Draw contents of each box:
+
+def drawunboxed(text t) =
+    boxes_fixsize(t);
+    boxes_fixpos(t);
+    forsuffixes s = t :
+        draw boxes_pic_mac.s;
+    endfor
+enddef;
+
+% Draw boundary path for each box:
+
+def drawboxes(text t) =
+    forsuffixes s = t :
+        draw bpath.s;
+    endfor
+enddef;
+
+% Rectangular boxes
+
+newinternal defaultdx, defaultdy; defaultdx := defaultdy := 3bp;
+
+vardef boxit@#(text tt) =
+    boxes_begin("boxes_path","boxes_size",@#,tt);
+    boxes_declare (pair) _n.sw, _n.s, _n.se, _n.e, _n.ne, _n.n, _n.nw, _n.w;
+    0 = xpart(@#nw - @#sw) = ypart(@#se - @#sw);
+    0 = xpart(@#ne - @#se) = ypart(@#ne - @#nw);
+    @#w = .5[@#nw,@#sw];
+    @#s = .5[@#sw,@#se];
+    @#e = .5[@#ne,@#se];
+    @#n = .5[@#ne,@#nw];
+    @#ne - @#c = @#c - @#sw = (@#dx,@#dy) + .5*(urcorner boxes_pic@# - llcorner boxes_pic@#);
+    boxes_end(boxes_clear,@#);
+enddef;
+
+def boxes_path(suffix $) =
+    $.sw -- $.se -- $.ne -- $.nw -- cycle
+enddef;
+
+def boxes_size(suffix $) =
+    if unknown $.dx : $.dx = defaultdx; fi
+    if unknown $.dy : $.dy = defaultdy; fi
+enddef;
+
+vardef boxes_clear(suffix $) =
+    boxes_n := str $;
+    boxes_redeclare(numeric) _n.sw, _n.s, _n.se, _n.e, _n.ne, _n.n, _n.nw, _n.w, _n.c, _n.off, _n.dx, _n.dy;
+enddef;
+
+% Circular and oval boxes
+
+newinternal circmargin; circmargin := 2bp;  % default clearance for picture corner
+
+vardef circleit@#(text tt) =
+    boxes_begin("boxes_the_circle","boxes_size_circle",@#,tt);
+    boxes_generic_declare(pair) _n.n, _n.s, _n.e, _n.w;
+    @#e - @#c = @#c - @#w = (@#dx,0) + .5*(lrcorner boxes_pic@# - llcorner boxes_pic@#);
+    @#n - @#c = @#c - @#s = (0,@#dy) + .5*(ulcorner boxes_pic@# - llcorner boxes_pic@#);
+    boxes_end(boxes_clear_circle,@#);
+enddef;
+
+def boxes_the_circle (suffix $) =
+    $.e{up} ... $.n{left} ... $.w{down} ... $.s{right} ... cycle
+enddef;
+
+vardef boxes_clear_circle (suffix $) =
+    boxes_n := str $;
+    boxes_redeclare(numeric) _n.n, _n.s, _n.e, _n.w, _n.c, _n.off, _n.dx, _n.dy;
+enddef;
+
+vardef boxes_size_circle (suffix $) =
+    save a_, b_;
+    (a_,b_) = .5*(urcorner boxes_pic$ - llcorner boxes_pic$);
+    if unknown $dx :
+        if unknown $dy :
+            if unknown($dy-$dx) :
+                a_ + $dx = b_ + $dy;
+            fi
+            if a_ + $dx = b_ + $dy :
+                a_ + $dx = a_ ++ b_ + circmargin;
+            else :
+                $dx = boxes_select(max(a_,b_ + $dx - $dy), (a_ + d_,0){up} ... (0,b_ + d_ + $dy - $dx){left});
+            fi
+        else :
+            $dx = boxes_select(a_, (a_ + d_,0){up}...(0,b_ + $dy){left});
+        fi
+    elseif unknown $dy :
+        $dy = boxes_select(b_, (a_ + $dx,0){up}...(0,b_ + d_){left});
+    fi
+enddef;
+
+vardef boxes_select(expr dhi)(text tt) =
+    save f_, p_; path p_;
+    p_ = origin .. (a_,b_) + circmargin * unitvector(a_,b_);
+    vardef f_ (expr d_) =
+        xpart((tt) intersectiontimes p_) >= 0
+    enddef;
+    solve f_(0, dhi + 1.5circmargin)
+enddef;
+
+def boxes_init_all =
+    boxes_boxjoin();
+    save boxes_pic, boxes_sproc, boxes_pproc;
+    def boxes_clear_all = enddef;
+enddef ;
+
+extra_beginfig := extra_beginfig & "boxes_init_all;";
+extra_endfig   := "boxes_clear_all;" & extra_endfig;
+
+if makingfigure :
+    boxes_init_all;
+fi ;
+
diff --git a/metapost/context/base/mpxl/mp-base.mpxl b/metapost/context/base/mpxl/mp-base.mpxl
index 4cb44d69f..afdcda1ed 100644
--- a/metapost/context/base/mpxl/mp-base.mpxl
+++ b/metapost/context/base/mpxl/mp-base.mpxl
@@ -993,7 +993,9 @@ string extra_beginfig, extra_endfig ;
 extra_beginfig := "" ;
 extra_endfig   := "" ;
 
-def beginfig(expr c) =
+newinternal boolean makingfigure ; makingfigure := false ;
+
+def beginfig(expr c) = % redefined in mp-grph !
     begingroup
     charcode := c ;
     clearxy ;
@@ -1002,6 +1004,7 @@ def beginfig(expr c) =
     pickup defaultpen ;
     drawoptions() ;
     interim stacking := 0 ;
+    interim makingfigure := true;
     scantokens extra_beginfig ;
 enddef ;
 
diff --git a/metapost/context/base/mpxl/mp-grph.mpxl b/metapost/context/base/mpxl/mp-grph.mpxl
index 8517293aa..7dca4e935 100644
--- a/metapost/context/base/mpxl/mp-grph.mpxl
+++ b/metapost/context/base/mpxl/mp-grph.mpxl
@@ -47,10 +47,10 @@ def resetfig =
     interim linecap := linecap ;
     interim linejoin := linejoin ;
     interim miterlimit := miterlimit ;
-    % not really needed:
+    interim stacking := 0 ;
+    interim makingfigure := true;
     save temp_b ; color temp_b ; temp_b := background ;
     save background ; color background ; background := temp_b ;
-    %
     drawoptions () ;
 enddef ;
 
diff --git a/metapost/context/base/mpxl/mp-mlib.mpxl b/metapost/context/base/mpxl/mp-mlib.mpxl
index c81b4fe39..35854a987 100644
--- a/metapost/context/base/mpxl/mp-mlib.mpxl
+++ b/metapost/context/base/mpxl/mp-mlib.mpxl
@@ -1413,6 +1413,9 @@ def withproperties expr p =
     if length (dashpart p) > 0 :
         dashed dashpart p
     fi
+    if stackingpart p <> 0 :
+        withstacking stackingpart p
+    fi
     withprescript prescriptpart p
     withpostscript postscriptpart p
 enddef ;
diff --git a/metapost/context/base/mpxl/mp-tool.mpxl b/metapost/context/base/mpxl/mp-tool.mpxl
index 9c469b03a..a6f931fbd 100644
--- a/metapost/context/base/mpxl/mp-tool.mpxl
+++ b/metapost/context/base/mpxl/mp-tool.mpxl
@@ -3839,3 +3839,50 @@ vardef processpath (expr p) (text pp) =
 enddef ;
 
 permanent processpath ;
+
+% By Bogluslaw Jackowski (public domain):
+%
+% draw hatched (fullcircle scaled 10cm) (45, 4, 1) withcolor "red" ;
+
+newinternal hatch_match; hatch_match := 1;
+
+vardef hatched(expr o) primary c =
+    save a_, b_, d_, l_, i_, r_, za_, zb_, zc_, zd_;
+    path b_; picture r_; pair za_, zb_, zc_, zd_;
+    r_ := image (
+        a_ := redpart(c) mod 180 ;
+        l_ := greenpart(c) ;
+        d_ := -bluepart(c) ;
+        b_ := o rotated -a_ ;
+        b_ :=
+            if a_ >= 90 :
+                (lrcorner b_ -- llcorner b_ -- ulcorner b_ -- urcorner b_ -- cycle)
+            else :
+                (llcorner b_ -- lrcorner b_ -- urcorner b_ -- ulcorner b_ -- cycle)
+            fi
+            rotated a_ ;
+        za_ := point 0 of b_ ;
+        zb_ := point 1 of b_ ;
+        zc_ := point 2 of b_ ;
+        zd_ := point 3 of b_ ;
+        if hatch_match > 0 :
+            n_ := round(length(zd_-za_) / l_) ;
+            if n_ < 2:
+                n_ := 2 ;
+            fi ;
+            l_ := length(zd_-za_) / n_ ;
+        else :
+            n_ := length(zd_-za_) / l_ ;
+        fi
+        save currentpen; pen currentpen ; pickup pencircle scaled d_;
+        % we use a single path instead:
+        for i_ := if hatch_match > 0 : 1 else : 0 fi upto ceiling n_ - 1 :
+            nodraw (i_/n_)[zd_,za_] -- (i_/n_)[zc_,zb_] ;
+        endfor
+        dodraw origin ;
+    ) ;
+    clip r_ to o;
+    r_
+enddef;
+
+permanent hatched ;
diff --git a/metapost/context/base/mpxl/mp-xbox.mpxl b/metapost/context/base/mpxl/mp-xbox.mpxl
new file mode 100644
index 000000000..65a3da775
--- /dev/null
+++ b/metapost/context/base/mpxl/mp-xbox.mpxl
@@ -0,0 +1,292 @@
+% This file is a variant of "macros for boxes"::
+%
+% author    : Taco Hoekwater
+% version   : $Id: boxes.mp,v 1.5 2005/02/25 11:28:56 taco Exp $
+% copyright : Public domain
+% patched   : Hans Hagen
+%
+% The code is the same but I've added s boxes_ namespace for soem so that we don't
+% clash with metafun. Loading and initialization is now under metafun control.
+
+if known metafun_loaded_xbox : endinput ; fi ;
+
+newinternal boolean metafun_loaded_xbox ; metafun_loaded_xbox := true ; immutable metafun_loaded_xbox ;
+
+% Find the length of the prefix of string s for which cond is true for each character
+% c of the prefix.
+
+vardef boxes_str_prefix (expr s) (text cond) =
+    save i_, c; string c; i_ = 0;
+    forever:
+        c := substring (i_, i_ + 1) of s;
+        exitunless cond;
+        exitif incr i_ = length s;
+    endfor
+    i_
+enddef;
+
+% Take a string returned by the str operator and return the same string with explicit
+% numeric subscripts replaced by generic subscript symbols [] (fixed by Eddie Kohler).
+
+vardef generisize (expr ss) =
+    save r, s, l; string r, s;
+    r = ""; % result so far
+    s = ss; % left to process
+    forever:
+        exitif s = "";
+        l := boxes_str_prefix(s, (c<>"[") and ((c<"0") or (c>"9")));
+        r := r & substring (0,l) of s;
+        s := substring (l, infinity) of s;
+        if s <> "" :
+            if (s >= "[") and (length s > 1) :
+                if (substring (1,2) of s) = "[" :
+                    l := 2;
+                    r := r & "[[";
+                else :
+                    l := 1 + boxes_str_prefix(s, c <> "]");
+                    r := r & "[]";
+                fi
+            else :
+                r := r & "[]";
+                l := boxes_str_prefix(s, (c = ".") or ("0" <= c) and (c <= "9"));
+            fi
+            s := substring(l, infinity) of s;
+        fi
+    endfor
+    r
+enddef;
+
+% Make sure the string boxes_n_gen is generisize(_n_):
+
+string boxes_n, boxes_n_cur, boxes_n_gen; boxes_n_cur := "]"; % this won't match _n_
+
+vardef boxes_set_n_gen =
+    if boxes_n <> boxes_n_cur:
+        boxes_n_cur := boxes_n;
+        boxes_n_gen := generisize(boxes_n);
+    fi
+enddef;
+
+% Given a type t and list of variable names vars, make sure that they are of type t
+% and redeclare them as necessary.  In the vars list _n represents scantokens boxes_n,
+% a suffix that might contain numeric subscripts. This suffix needs to be replaced
+% by scantokens boxes_n_gen in order to get a variable that can be declared to be of
+% type t.
+
+vardef boxes_declare(text t) text vars =
+    boxes_set_n_gen;
+    forsuffixes v_ = vars :
+        if forsuffixes _n = scantokens boxes_n : not t v_ endfor :
+            def boxes_gdmac text _n = t v_ enddef;
+            expandafter boxes_gdmac scantokens boxes_n_gen;
+        fi
+    endfor
+enddef;
+
+% Here is another version that redeclares the vars even if they are already of the
+% right type.
+
+vardef boxes_redeclare(text t) text vars =
+    boxes_set_n_gen;
+    def boxes_gdmac text _n = t vars enddef;
+    expandafter boxes_gdmac scantokens boxes_n_gen;
+enddef;
+
+% pp should be a string giving the name of a macro that finds the boundary path and
+% sp should be a string that names a macro for fixing the size and shape. The suffix
+% $ is the name of the box. The text t gives the box contents: either empty, a
+% picture, or a string to typeset.
+
+def boxes_begin (expr pp, sp) (suffix $) (text t) =
+    boxes_n := str $;
+    boxes_declare (pair) _n.off, _n.c;
+    boxes_declare (string) boxes_pproc._n, boxes_sproc._n;
+    boxes_declare (picture) boxes_pic._n;
+    boxes_pproc$ := pp;
+    boxes_sproc$ := sp;
+    boxes_pic$ := nullpicture;
+    for _p_ = t :
+      % boxes_pic$ := if picture _p_: _p_ else: _p_ infont defaultfont scaled defaultscale fi;
+        boxes_pic$ := if picture _p_: _p_ else: textext(_p_) fi;
+    endfor
+    $c = $off + .5[llcorner boxes_pic$, urcorner boxes_pic$]
+enddef;
+
+% The suffix cl names a vardef macro that clears box-related variables. The suffix $
+% is the name of the box being ended.
+
+def boxes_end(suffix cl, $) =
+    if known boxes_pic.boxes_prevbox:
+        boxes_dojoin(boxes_prevbox,$);
+    fi
+    def boxes_prevbox = $ enddef;
+    expandafter def expandafter boxes_clear_all expandafter =
+        boxes_clear_all cl($);
+    enddef
+enddef;
+
+% Text t gives equations for joining box a to box b.
+
+def boxes_boxjoin(text t) =
+    def boxes_prevbox = _ enddef;
+    def boxes_dojoin(suffix a,b) = t enddef;
+enddef ;
+
+def boxes_clear_all = enddef;
+
+% Given a list of box names, give whatever default values are necessary
+% in order to fix the size and shape of each box.
+
+vardef boxes_fixsize(text t) =
+    forsuffixes $ = t : scantokens boxes_sproc$($); endfor
+enddef;
+
+% Given a list of box names, give default values for any unknown positioning offsets.
+
+vardef boxes_fixpos(text t) =
+    forsuffixes $=t:
+        if unknown xpart $.off : xpart $.off = 0; fi
+        if unknown ypart $.off : ypart $.off = 0; fi
+    endfor
+enddef;
+
+% Return the boundary path for the given box
+
+vardef bpath suffix $ =
+    boxes_fixsize($);
+    boxes_fixpos($);
+    scantokens boxes_pproc$($)
+enddef;
+
+% Return the contents of the given box. First define a private version that the user can't
+% accidently clobber.
+
+vardef boxes_pic_mac suffix $ =
+    boxes_fixsize($);
+    boxes_fixpos($);
+    boxes_pic$ shifted $off
+enddef;
+
+vardef pic suffix $ = boxes_pic_mac $ enddef;
+
+% Draw each box:
+
+def drawboxed(text t) =
+    boxes_fixsize(t);
+    boxes_fixpos(t);
+    forsuffixes s = t: draw boxes_pic_mac.s; draw bpath.s; endfor
+enddef;
+
+% Draw contents of each box:
+
+def drawunboxed(text t) =
+    boxes_fixsize(t);
+    boxes_fixpos(t);
+    forsuffixes s = t :
+        draw boxes_pic_mac.s;
+    endfor
+enddef;
+
+% Draw boundary path for each box:
+
+def drawboxes(text t) =
+    forsuffixes s = t :
+        draw bpath.s;
+    endfor
+enddef;
+
+% Rectangular boxes
+
+newinternal defaultdx, defaultdy; defaultdx := defaultdy := 3bp;
+
+vardef boxit@#(text tt) =
+    boxes_begin("boxes_path","boxes_size",@#,tt);
+    boxes_declare (pair) _n.sw, _n.s, _n.se, _n.e, _n.ne, _n.n, _n.nw, _n.w;
+    0 = xpart(@#nw - @#sw) = ypart(@#se - @#sw);
+    0 = xpart(@#ne - @#se) = ypart(@#ne - @#nw);
+    @#w = .5[@#nw,@#sw];
+    @#s = .5[@#sw,@#se];
+    @#e = .5[@#ne,@#se];
+    @#n = .5[@#ne,@#nw];
+    @#ne - @#c = @#c - @#sw = (@#dx,@#dy) + .5*(urcorner boxes_pic@# - llcorner boxes_pic@#);
+    boxes_end(boxes_clear,@#);
+enddef;
+
+def boxes_path(suffix $) =
+    $.sw -- $.se -- $.ne -- $.nw -- cycle
+enddef;
+
+def boxes_size(suffix $) =
+    if unknown $.dx : $.dx = defaultdx; fi
+    if unknown $.dy : $.dy = defaultdy; fi
+enddef;
+
+vardef boxes_clear(suffix $) =
+    boxes_n := str $;
+    boxes_redeclare(numeric) _n.sw, _n.s, _n.se, _n.e, _n.ne, _n.n, _n.nw, _n.w, _n.c, _n.off, _n.dx, _n.dy;
+enddef;
+
+% Circular and oval boxes
+
+newinternal circmargin; circmargin := 2bp;  % default clearance for picture corner
+
+vardef circleit@#(text tt) =
+    boxes_begin("boxes_the_circle","boxes_size_circle",@#,tt);
+    boxes_generic_declare(pair) _n.n, _n.s, _n.e, _n.w;
+    @#e - @#c = @#c - @#w = (@#dx,0) + .5*(lrcorner boxes_pic@# - llcorner boxes_pic@#);
+    @#n - @#c = @#c - @#s = (0,@#dy) + .5*(ulcorner boxes_pic@# - llcorner boxes_pic@#);
+    boxes_end(boxes_clear_circle,@#);
+enddef;
+
+def boxes_the_circle (suffix $) =
+    $.e{up} ... $.n{left} ... $.w{down} ... $.s{right} ... cycle
+enddef;
+
+vardef boxes_clear_circle (suffix $) =
+    boxes_n := str $;
+    boxes_redeclare(numeric) _n.n, _n.s, _n.e, _n.w, _n.c, _n.off, _n.dx, _n.dy;
+enddef;
+
+vardef boxes_size_circle (suffix $) =
+    save a_, b_;
+    (a_,b_) = .5*(urcorner boxes_pic$ - llcorner boxes_pic$);
+    if unknown $dx :
+        if unknown $dy :
+            if unknown($dy-$dx) :
+                a_ + $dx = b_ + $dy;
+            fi
+            if a_ + $dx = b_ + $dy :
+                a_ + $dx = a_ ++ b_ + circmargin;
+            else :
+                $dx = boxes_select(max(a_,b_ + $dx - $dy), (a_ + d_,0){up} ... (0,b_ + d_ + $dy - $dx){left});
+            fi
+        else :
+            $dx = boxes_select(a_, (a_ + d_,0){up}...(0,b_ + $dy){left});
+        fi
+    elseif unknown $dy :
+        $dy = boxes_select(b_, (a_ + $dx,0){up}...(0,b_ + d_){left});
+    fi
+enddef;
+
+vardef boxes_select(expr dhi)(text tt) =
+    save f_, p_; path p_;
+    p_ = origin .. (a_,b_) + circmargin * unitvector(a_,b_);
+    vardef f_ (expr d_) =
+        xpart((tt) intersectiontimes p_) >= 0
+    enddef;
+    solve f_(0, dhi + 1.5circmargin)
+enddef;
+
+def boxes_init_all =
+    boxes_boxjoin();
+    save boxes_pic, boxes_sproc, boxes_pproc;
+    def boxes_clear_all = enddef;
+enddef ;
+
+extra_beginfig := extra_beginfig & "boxes_init_all;";
+extra_endfig   := "boxes_clear_all;" & extra_endfig;
+
+if makingfigure :
+    boxes_init_all;
+fi ;
+