1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19if known metafun_loaded_xbox : endinput ; fi ;
20
21newinternal boolean metafun_loaded_xbox ; metafun_loaded_xbox : = true ; immutable metafun_loaded_xbox ;
22
23
24
25
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
38
39
40vardef generisize ( expr ss ) =
41 save r , s , l ; string r , s ;
42 r = " " ;
43 s = ss ;
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
69
70string boxes_n , boxes_n_cur , boxes_n_gen ; boxes_n_cur : = " ] " ;
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
80
81
82
83
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
96
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
105
106
107
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
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
125
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
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
147
148
149vardef boxes_fixsize ( text t ) =
150 forsuffixes $ = t : scantokens boxes_sproc $ ( $ ) ; endfor
151enddef ;
152
153
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
163
164vardef bpath suffix $ =
165 boxes_fixsize ( $ ) ;
166 boxes_fixpos ( $ ) ;
167 scantokens boxes_pproc $ ( $ )
168enddef ;
169
170
171
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
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
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
200
201def drawboxes ( text t ) =
202 forsuffixes s = t :
203 draw bpath . s ;
204 endfor
205enddef ;
206
207
208
209newinternal defaultdx , defaultdy ; defaultdx : = defaultdy : = 3 bp ;
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
239
240newinternal circmargin ; circmargin : = 2 bp ;
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.5 circmargin )
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
308
309newinternal rbox_radius ; rbox_radius : = 8 bp ;
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 |