Source Browser ?

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