summaryrefslogtreecommitdiff
path: root/Master/texmf-dist/metapost/base/boxes.mp
diff options
context:
space:
mode:
Diffstat (limited to 'Master/texmf-dist/metapost/base/boxes.mp')
-rw-r--r--Master/texmf-dist/metapost/base/boxes.mp259
1 files changed, 259 insertions, 0 deletions
diff --git a/Master/texmf-dist/metapost/base/boxes.mp b/Master/texmf-dist/metapost/base/boxes.mp
new file mode 100644
index 00000000000..4ba1a6d2a45
--- /dev/null
+++ b/Master/texmf-dist/metapost/base/boxes.mp
@@ -0,0 +1,259 @@
+% Macros for boxes
+
+
+% Find the length of the prefix of string s for which cond is true for each
+% character c of the prefix
+vardef 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 [].
+vardef generisize(expr ss) =
+ save res, s, l; string res, s;
+ res = ""; % result so far
+ s = ss; % left to process
+ forever: exitif s="";
+ l := str_prefix(s, (c<>"[") and ((c<"0") or (c>"9")));
+ res := res & substring (0,l) of s;
+ s := substring (l,infinity) of s;
+ if s<>"":
+ res := res & "[]";
+ l := if s>="[": 1 + str_prefix(s, c<>"]")
+ else: str_prefix(s, (c=".") or ("0"<=c) and (c<="9"))
+ fi;
+ s := substring(l,infinity) of s;
+ fi
+ endfor
+ res
+enddef;
+
+
+% Make sure the string _n_gen_ is generisize(_n_):
+vardef set_n_gen_ =
+ if _n_ <> _n_cur_:
+ _n_cur_:=_n_;
+ _n_gen_:=generisize(_n_);
+ fi
+enddef;
+
+string _n_, _n_cur_, _n_gen_;
+_n_cur_ := "]"; % this won't match _n_
+
+
+% 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 _n_, a suffix that might contain numeric subscripts.
+% This suffix needs to be replaced by scantokens _n_gen_ in order to get
+% a variable that can be declared to be of type t.
+vardef generic_declare(text t) text vars =
+ set_n_gen_;
+ forsuffixes v_=vars:
+ if forsuffixes _n=scantokens _n_: not t v_ endfor:
+ def _gdmac_ text _n = t v_ enddef;
+ expandafter _gdmac_ scantokens _n_gen_;
+ fi
+ endfor
+enddef;
+
+% Here is another version that redeclares the vars even if they are already
+% of the right type.
+vardef generic_redeclare(text t) text vars =
+ set_n_gen_;
+ def _gdmac_ text _n = t vars enddef;
+ expandafter _gdmac_ scantokens _n_gen_;
+enddef;
+
+
+
+
+
+
+
+% pp should be a string giving the name of a macro that finds the boundary path
+% 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 beginbox_(expr pp,sp)(suffix $)(text t) =
+ _n_ := str $;
+ generic_declare(pair) _n.off, _n.c;
+ generic_declare(string) pproc_._n, sproc_._n;
+ generic_declare(picture) pic_._n;
+ pproc_$:=pp; sproc_$:=sp;
+ pic_$ = nullpicture;
+ for _p_=t:
+ pic_$:=
+ if picture _p_: _p_
+ else: _p_ infont defaultfont scaled defaultscale
+ fi;
+ endfor
+ $c = $off + .5[llcorner pic_$, urcorner 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 endbox_(suffix cl, $) =
+ if known pic_.prevbox: _dojoin(prevbox,$); fi
+ def prevbox = $ enddef;
+ expandafter def expandafter clearboxes expandafter =
+ clearboxes cl($);
+ enddef
+enddef;
+
+
+% Text t gives equations for joining box a to box b.
+def boxjoin(text t) =
+ def prevbox=_ enddef;
+ def _dojoin(suffix a,b) = t enddef;
+enddef;
+
+
+extra_beginfig := extra_beginfig
+ & "boxjoin();save pic_,sproc_,pproc_;def clearboxes=enddef;";
+extra_endfig := extra_endfig & "clearboxes";
+
+
+% Given a list of box names, give whatever default values are necessary
+% in order to fix the size and shape of each box.
+vardef fixsize(text t) =
+ forsuffixes $=t: scantokens sproc_$($); endfor
+enddef;
+
+
+% Given a list of box names, give default values for any unknown positioning
+% offsets
+vardef 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 $ =
+ fixsize($); fixpos($);
+ scantokens pproc_$($)
+enddef;
+
+
+% Return the contents of the given box. First define a private version that
+% the user can't accidently clobber.
+vardef pic_mac_ suffix $ =
+ fixsize($); fixpos($);
+ pic_$ shifted $off
+enddef;
+
+vardef pic suffix $ = pic_mac_ $ enddef;
+
+
+def drawboxed(text t) = % Draw each box
+ fixsize(t); fixpos(t);
+ forsuffixes s=t: draw pic_mac_.s; draw bpath.s; endfor
+enddef;
+
+def drawunboxed(text t) = % Draw contents of each box
+ fixsize(t); fixpos(t);
+ forsuffixes s=t: draw pic_mac_.s; endfor
+enddef;
+
+def drawboxes(text t) = % Draw boundary path for each box
+ forsuffixes s=t: draw bpath.s; endfor
+enddef;
+
+
+
+
+
+% Rectangular boxes
+
+newinternal defaultdx, defaultdy;
+defaultdx := defaultdy := 3bp;
+
+vardef boxit@#(text tt) =
+ beginbox_("boxpath_","sizebox_",@#,tt);
+ generic_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 pic_@# - llcorner pic_@#);
+ endbox_(clearb_,@#);
+enddef;
+
+def boxpath_(suffix $) =
+ $.sw -- $.se -- $.ne -- $.nw -- cycle
+enddef;
+
+def sizebox_(suffix $) =
+ if unknown $.dx: $.dx=defaultdx; fi
+ if unknown $.dy: $.dy=defaultdy; fi
+enddef;
+
+vardef clearb_(suffix $) =
+ _n_ := str $;
+ generic_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) =
+ beginbox_("thecirc_","sizecirc_",@#,tt);
+ generic_declare(pair) _n.n, _n.s, _n.e, _n.w;
+ @#e-@#c = @#c-@#w = (@#dx,0) + .5*(lrcorner pic_@#-llcorner pic_@#);
+ @#n-@#c = @#c-@#s = (0,@#dy) + .5*(ulcorner pic_@#-llcorner pic_@#);
+ endbox_(clearc_,@#);
+enddef;
+
+def thecirc_(suffix $) =
+ $.e{up} ... $.n{left} ... $.w{down} ... $.s{right} ... cycle
+enddef;
+
+vardef clearc_(suffix $) =
+ _n_ := str $;
+ generic_redeclare(numeric) _n.n, _n.s, _n.e, _n.w, _n.c, _n.off, _n.dx, _n.dy;
+enddef;
+
+vardef sizecirc_(suffix $) =
+ save a_, b_;
+ (a_,b_) = .5*(urcorner pic_$ - llcorner 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 =
+ pathsel_(max(a_,b_+$dx-$dy), (a_+d_,0){up}...(0,b_+d_+$dy-$dx){left});
+ fi
+ else: $dx = pathsel_(a_, (a_+d_,0){up}...(0,b_+$dy){left});
+ fi
+ elseif unknown $dy:
+ $dy = pathsel_(b_, (a_+$dx,0){up}...(0,b_+d_){left});
+ fi
+enddef;
+
+vardef pathsel_(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;