mp-xbox.mpxl /size: 9 Kb    last modification: 2023-12-21 09:43
1% This file is a variant of "macros for boxes"::
2%
3% author    : Taco Hoekwater
4% version   : $Id: boxes.mp,v 1.5 2005/02/25 11:28:56 taco Exp $
5% copyright : Public domain
6% patched   : Hans Hagen
7%
8% author    : Karl Berry
9% version   : $Id: rboxes.mp,v 1.2 2004/09/19 21:47:11 karl Exp $
10% copyright : Public domain
11% patched   : Hans Hagen
12%
13% The code is the same but I've added s boxes_ namespace for somd so that we don't
14% clash with metafun. Loading and initialization is now under metafun control.
15
16if known metafun_loaded_xbox : endinput ; fi ;
17
18newinternal boolean metafun_loaded_xbox ; metafun_loaded_xbox := true ; immutable metafun_loaded_xbox ;
19
20% Find the length of the prefix of string s for which cond is true for each character
21% c of the prefix. Loading and initialization is now under metafun control. Only the
22% mpxl variant will be adapted. When needed this file will be adapted.
23
24vardef boxes_str_prefix (expr s) (text cond) =
25    save i_, c; string c; i_ = 0;
26    forever:
27        c := substring (i_, i_ + 1) of s;
28        exitunless cond;
29        exitif incr i_ = length s;
30    endfor
31    i_
32enddef;
33
34% Take a string returned by the str operator and return the same string with explicit
35% numeric subscripts replaced by generic subscript symbols [] (fixed by Eddie Kohler).
36
37vardef generisize (expr ss) =
38    save r, s, l; string r, s;
39    r = ""; % result so far
40    s = ss; % left to process
41    forever:
42        exitif s = "";
43        l := boxes_str_prefix(s, (c<>"[") and ((c<"0") or (c>"9")));
44        r := r & substring (0,l) of s;
45        s := substring (l, infinity) of s;
46        if s <> "" :
47            if (s >= "[") and (length s > 1) :
48                if (substring (1,2) of s) = "[" :
49                    l := 2;
50                    r := r & "[[";
51                else :
52                    l := 1 + boxes_str_prefix(s, c <> "]");
53                    r := r & "[]";
54                fi
55            else :
56                r := r & "[]";
57                l := boxes_str_prefix(s, (c = ".") or ("0" <= c) and (c <= "9"));
58            fi
59            s := substring(l, infinity) of s;
60        fi
61    endfor
62    r
63enddef;
64
65% Make sure the string boxes_n_gen is generisize(_n_):
66
67string boxes_n, boxes_n_cur, boxes_n_gen; boxes_n_cur := "]"; % this won't match _n_
68
69vardef boxes_set_n_gen =
70    if boxes_n <> boxes_n_cur:
71        boxes_n_cur := boxes_n;
72        boxes_n_gen := generisize(boxes_n);
73    fi
74enddef;
75
76% Given a type t and list of variable names vars, make sure that they are of type t
77% and redeclare them as necessary.  In the vars list _n represents scantokens boxes_n,
78% a suffix that might contain numeric subscripts. This suffix needs to be replaced
79% by scantokens boxes_n_gen in order to get a variable that can be declared to be of
80% type t.
81
82vardef boxes_declare(text t) text vars =
83    boxes_set_n_gen;
84    forsuffixes v_ = vars :
85        if forsuffixes _n = scantokens boxes_n : not t v_ endfor :
86            def boxes_gdmac text _n = t v_ enddef;
87            expandafter boxes_gdmac scantokens boxes_n_gen;
88        fi
89    endfor
90enddef;
91
92% Here is another version that redeclares the vars even if they are already of the
93% right type.
94
95vardef boxes_redeclare(text t) text vars =
96    boxes_set_n_gen;
97    def boxes_gdmac text _n = t vars enddef;
98    expandafter boxes_gdmac scantokens boxes_n_gen;
99enddef;
100
101% pp should be a string giving the name of a macro that finds the boundary path and
102% sp should be a string that names a macro for fixing the size and shape. The suffix
103% $ is the name of the box. The text t gives the box contents: either empty, a
104% picture, or a string to typeset.
105
106def boxes_begin (expr pp, sp) (suffix $) (text t) =
107    boxes_n := str $;
108    boxes_declare (pair) _n.off, _n.c;
109    boxes_declare (string) boxes_pproc._n, boxes_sproc._n;
110    boxes_declare (picture) boxes_pic._n;
111    boxes_pproc$ := pp;
112    boxes_sproc$ := sp;
113    boxes_pic$ := nullpicture;
114    for _p_ = t :
115      % boxes_pic$ := if picture _p_: _p_ else: _p_ infont defaultfont scaled defaultscale fi;
116        boxes_pic$ := if picture _p_: _p_ else: textext(_p_) fi;
117    endfor
118    $c = $off + .5[llcorner boxes_pic$, urcorner boxes_pic$]
119enddef;
120
121% The suffix cl names a vardef macro that clears box-related variables. The suffix $
122% is the name of the box being ended.
123
124def boxes_end(suffix cl, $) =
125    if known boxes_pic.boxes_prevbox:
126        boxes_dojoin(boxes_prevbox,$);
127    fi
128    def boxes_prevbox = $ enddef;
129    expandafter def expandafter boxes_clear_all expandafter =
130        boxes_clear_all cl($);
131    enddef
132enddef;
133
134% Text t gives equations for joining box a to box b.
135
136def boxes_boxjoin(text t) =
137    def boxes_prevbox = _ enddef;
138    def boxes_dojoin(suffix a,b) = t enddef;
139enddef ;
140
141def boxes_clear_all = enddef;
142
143% Given a list of box names, give whatever default values are necessary
144% in order to fix the size and shape of each box.
145
146vardef boxes_fixsize(text t) =
147    forsuffixes $ = t : scantokens boxes_sproc$($); endfor
148enddef;
149
150% Given a list of box names, give default values for any unknown positioning offsets.
151
152vardef boxes_fixpos(text t) =
153    forsuffixes $=t:
154        if unknown xpart $.off : xpart $.off = 0; fi
155        if unknown ypart $.off : ypart $.off = 0; fi
156    endfor
157enddef;
158
159% Return the boundary path for the given box
160
161vardef bpath suffix $ =
162    boxes_fixsize($);
163    boxes_fixpos($);
164    scantokens boxes_pproc$($)
165enddef;
166
167% Return the contents of the given box. First define a private version that the user can't
168% accidently clobber.
169
170vardef boxes_pic_mac suffix $ =
171    boxes_fixsize($);
172    boxes_fixpos($);
173    boxes_pic$ shifted $off
174enddef;
175
176vardef pic suffix $ = boxes_pic_mac $ enddef;
177
178% Draw each box:
179
180def drawboxed(text t) =
181    boxes_fixsize(t);
182    boxes_fixpos(t);
183    forsuffixes s = t: draw boxes_pic_mac.s; draw bpath.s; endfor
184enddef;
185
186% Draw contents of each box:
187
188def drawunboxed(text t) =
189    boxes_fixsize(t);
190    boxes_fixpos(t);
191    forsuffixes s = t :
192        draw boxes_pic_mac.s;
193    endfor
194enddef;
195
196% Draw boundary path for each box:
197
198def drawboxes(text t) =
199    forsuffixes s = t :
200        draw bpath.s;
201    endfor
202enddef;
203
204% Rectangular boxes
205
206newinternal defaultdx, defaultdy; defaultdx := defaultdy := 3bp;
207
208vardef boxit@#(text tt) =
209    boxes_begin("boxes_path","boxes_size",@#,tt);
210    boxes_declare (pair) _n.sw, _n.s, _n.se, _n.e, _n.ne, _n.n, _n.nw, _n.w;
211    0 = xpart(@#nw - @#sw) = ypart(@#se - @#sw);
212    0 = xpart(@#ne - @#se) = ypart(@#ne - @#nw);
213    @#w = .5[@#nw,@#sw];
214    @#s = .5[@#sw,@#se];
215    @#e = .5[@#ne,@#se];
216    @#n = .5[@#ne,@#nw];
217    @#ne - @#c = @#c - @#sw = (@#dx,@#dy) + .5*(urcorner boxes_pic@# - llcorner boxes_pic@#);
218    boxes_end(boxes_clear,@#);
219enddef;
220
221def boxes_path(suffix $) =
222    $.sw -- $.se -- $.ne -- $.nw -- cycle
223enddef;
224
225def boxes_size(suffix $) =
226    if unknown $.dx : $.dx = defaultdx; fi
227    if unknown $.dy : $.dy = defaultdy; fi
228enddef;
229
230vardef boxes_clear(suffix $) =
231    boxes_n := str $;
232    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;
233enddef;
234
235% Circular and oval boxes
236
237newinternal circmargin; circmargin := 2bp;  % default clearance for picture corner
238
239vardef circleit@#(text tt) =
240    boxes_begin("boxes_the_circle","boxes_size_circle",@#,tt);
241    boxes_declare(pair) _n.n, _n.s, _n.e, _n.w;
242    @#e - @#c = @#c - @#w = (@#dx,0) + .5*(lrcorner boxes_pic@# - llcorner boxes_pic@#);
243    @#n - @#c = @#c - @#s = (0,@#dy) + .5*(ulcorner boxes_pic@# - llcorner boxes_pic@#);
244    boxes_end(boxes_clear_circle,@#);
245enddef;
246
247def boxes_the_circle (suffix $) =
248    $.e{up} ... $.n{left} ... $.w{down} ... $.s{right} ... cycle
249enddef;
250
251vardef boxes_clear_circle (suffix $) =
252    boxes_n := str $;
253    boxes_redeclare(numeric) _n.n, _n.s, _n.e, _n.w, _n.c, _n.off, _n.dx, _n.dy;
254enddef;
255
256vardef boxes_size_circle (suffix $) =
257    save a_, b_;
258    (a_,b_) = .5*(urcorner boxes_pic$ - llcorner boxes_pic$);
259    if unknown $dx :
260        if unknown $dy :
261            if unknown($dy-$dx) :
262                a_ + $dx = b_ + $dy;
263            fi
264            if a_ + $dx = b_ + $dy :
265                a_ + $dx = a_ ++ b_ + circmargin;
266            else :
267                $dx = boxes_select(max(a_,b_ + $dx - $dy), (a_ + d_,0){up} ... (0,b_ + d_ + $dy - $dx){left});
268            fi
269        else :
270            $dx = boxes_select(a_, (a_ + d_,0){up}...(0,b_ + $dy){left});
271        fi
272    elseif unknown $dy :
273        $dy = boxes_select(b_, (a_ + $dx,0){up}...(0,b_ + d_){left});
274    fi
275enddef;
276
277vardef boxes_select(expr dhi)(text tt) =
278    save f_, p_; path p_;
279    p_ = origin .. (a_,b_) + circmargin * unitvector(a_,b_);
280    vardef f_ (expr d_) =
281        xpart((tt) intersectiontimes p_) >= 0
282    enddef;
283    solve f_(0, dhi + 1.5circmargin)
284enddef;
285
286def boxes_init_all =
287    boxes_boxjoin();
288    save boxes_pic, boxes_sproc, boxes_pproc;
289    def boxes_clear_all = enddef;
290enddef ;
291
292def boxjoin(text t) =
293    def boxes_prevbox = _ enddef;
294    def boxes_dojoin(suffix a,b) = t enddef;
295enddef;
296
297extra_beginfig := extra_beginfig & "boxes_init_all;";
298extra_endfig   := "boxes_clear_all;" & extra_endfig;
299
300if makingfigure :
301    boxes_init_all;
302fi ;
303
304% Rectangular boxes with rounded corners
305
306newinternal rbox_radius ; rbox_radius := 8bp ;
307
308vardef rboxit@#(text tt) =
309    boxes_begin("boxes_the_rounded","boxes_size",@#,tt) ;
310    boxes_declare (pair) _n.sw, _n.s, _n.se, _n.e, _n.ne, _n.n, _n.nw, _n.w ;
311    0 = xpart(@#nw - @#sw) = ypart(@#se - @#sw) ;
312    0 = xpart(@#ne - @#se) = ypart(@#ne - @#nw) ;
313    @#w = .5[@#nw,@#sw] ;
314    @#s = .5[@#sw,@#se] ;
315    @#e = .5[@#ne,@#se] ;
316    @#n = .5[@#ne,@#nw] ;
317    @#ne - @#c = @#c - @#sw = (@#dx,@#dy) + .5*(urcorner boxes_pic@# - llcorner boxes_pic@#) ;
318    boxes_end(boxes_clear,@#) ;
319enddef;
320
321def boxes_the_rounded(suffix $) =
322    save _r ; _r = min(rbox_radius, .5*ypart($.n-$.s), .5*xpart($.e-$.w));
323    $.sw + (_r,0) {right} .. {right} $.se - (_r,0) ..
324    $.se + (0,_r)    {up} .. {up}    $.ne - (0,_r) ..
325    $.ne - (_r,0)  {left} .. {left}  $.nw + (_r,0) ..
326    $.nw - (0,_r)  {down} .. {down}  $.sw + (0,_r) ..
327    cycle
328enddef;
329
330