From a06e8a0d7325ee248138a327e1117139b71aeaba Mon Sep 17 00:00:00 2001 From: Hans Hagen Date: Fri, 16 Jul 2021 22:58:17 +0200 Subject: 2021-07-16 22:01:00 --- metapost/context/base/common/boxes.mp | 1 + metapost/context/base/common/hatching.mp | 10 ++ metapost/context/base/mpiv/mp-base.mpiv | 9 +- metapost/context/base/mpiv/mp-grph.mpiv | 6 +- metapost/context/base/mpiv/mp-tool.mpiv | 45 +++++ metapost/context/base/mpiv/mp-xbox.mpiv | 293 +++++++++++++++++++++++++++++++ metapost/context/base/mpxl/mp-base.mpxl | 5 +- metapost/context/base/mpxl/mp-grph.mpxl | 4 +- metapost/context/base/mpxl/mp-mlib.mpxl | 3 + metapost/context/base/mpxl/mp-tool.mpxl | 47 +++++ metapost/context/base/mpxl/mp-xbox.mpxl | 292 ++++++++++++++++++++++++++++++ 11 files changed, 709 insertions(+), 6 deletions(-) create mode 100644 metapost/context/base/common/boxes.mp create mode 100644 metapost/context/base/common/hatching.mp create mode 100644 metapost/context/base/mpiv/mp-xbox.mpiv create mode 100644 metapost/context/base/mpxl/mp-xbox.mpxl (limited to 'metapost') 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 ; + -- cgit v1.2.3