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
19
if
 
known
 
metafun_loaded_xbox
 
:
 
endinput
 
;
 
fi
 
;
20
21
newinternal
 
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
27
vardef
 
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_
35
enddef
;
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
40
vardef
 
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
66
enddef
;
67
68
% Make sure the string boxes_n_gen is generisize(_n_):
69
70
string
 
boxes_n
,
 
boxes_n_cur
,
 
boxes_n_gen
;
 
boxes_n_cur
 
:
=
 
"
]
"
;
 
% this won't match _n_
71
72
vardef
 
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
77
enddef
;
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
85
vardef
 
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
93
enddef
;
94
95
% Here is another version that redeclares the vars even if they are already of the
96
% right type.
97
98
vardef
 
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
;
102
enddef
;
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
109
def
 
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
$
]
122
enddef
;
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
127
def
 
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
135
enddef
;
136
137
% Text t gives equations for joining box a to box b.
138
139
def
 
boxes_boxjoin
(
text
 
t
)
 
=
140    
def
 
boxes_prevbox
 
=
 
_
 
enddef
;
141    
def
 
boxes_dojoin
(
suffix
 
a
,
b
)
 
=
 
t
 
enddef
;
142
enddef
 
;
143
144
def
 
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
149
vardef
 
boxes_fixsize
(
text
 
t
)
 
=
150    
forsuffixes
 
$
 
=
 
t
 
:
 
scantokens
 
boxes_sproc
$
(
$
)
;
 
endfor
151
enddef
;
152
153
% Given a list of box names, give default values for any unknown positioning offsets.
154
155
vardef
 
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
160
enddef
;
161
162
% Return the boundary path for the given box
163
164
vardef
 
bpath
 
suffix
 
$
 
=
165    
boxes_fixsize
(
$
)
;
166    
boxes_fixpos
(
$
)
;
167    
scantokens
 
boxes_pproc
$
(
$
)
168
enddef
;
169
170
% Return the contents of the given box. First define a private version that the user can't
171
% accidently clobber.
172
173
vardef
 
boxes_pic_mac
 
suffix
 
$
 
=
174    
boxes_fixsize
(
$
)
;
175    
boxes_fixpos
(
$
)
;
176    
boxes_pic
$
 
shifted
 
$
off
177
enddef
;
178
179
vardef
 
pic
 
suffix
 
$
 
=
 
boxes_pic_mac
 
$
 
enddef
;
180
181
% Draw each box:
182
183
def
 
drawboxed
(
text
 
t
)
 
=
184    
boxes_fixsize
(
t
)
;
185    
boxes_fixpos
(
t
)
;
186    
forsuffixes
 
s
 
=
 
t
:
 
draw
 
boxes_pic_mac
.
s
;
 
draw
 
bpath
.
s
;
 
endfor
187
enddef
;
188
189
% Draw contents of each box:
190
191
def
 
drawunboxed
(
text
 
t
)
 
=
192    
boxes_fixsize
(
t
)
;
193    
boxes_fixpos
(
t
)
;
194    
forsuffixes
 
s
 
=
 
t
 
:
195        
draw
 
boxes_pic_mac
.
s
;
196    
endfor
197
enddef
;
198
199
% Draw boundary path for each box:
200
201
def
 
drawboxes
(
text
 
t
)
 
=
202    
forsuffixes
 
s
 
=
 
t
 
:
203        
draw
 
bpath
.
s
;
204    
endfor
205
enddef
;
206
207
% Rectangular boxes
208
209
newinternal
 
defaultdx
,
 
defaultdy
;
 
defaultdx
 
:
=
 
defaultdy
 
:
=
 
3
bp
;
210
211
vardef
 
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
,
@#
)
;
222
enddef
;
223
224
def
 
boxes_path
(
suffix
 
$
)
 
=
225    
$
.
sw
 
--
 
$
.
se
 
--
 
$
.
ne
 
--
 
$
.
nw
 
--
 
cycle
226
enddef
;
227
228
def
 
boxes_size
(
suffix
 
$
)
 
=
229    
if
 
unknown
 
$
.
dx
 
:
 
$
.
dx
 
=
 
defaultdx
;
 
fi
230    
if
 
unknown
 
$
.
dy
 
:
 
$
.
dy
 
=
 
defaultdy
;
 
fi
231
enddef
;
232
233
vardef
 
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
;
236
enddef
;
237
238
% Circular and oval boxes
239
240
newinternal
 
circmargin
;
 
circmargin
 
:
=
 
2
bp
;
  
% default clearance for picture corner
241
242
vardef
 
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
,
@#
)
;
248
enddef
;
249
250
def
 
boxes_the_circle
 
(
suffix
 
$
)
 
=
251    
$
.
e
{
up
}
 
...
 
$
.
n
{
left
}
 
...
 
$
.
w
{
down
}
 
...
 
$
.
s
{
right
}
 
...
 
cycle
252
enddef
;
253
254
vardef
 
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
;
257
enddef
;
258
259
vardef
 
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
278
enddef
;
279
280
vardef
 
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
)
287
enddef
;
288
289
def
 
boxes_init_all
 
=
290    
boxes_boxjoin
(
)
;
291    
save
 
boxes_pic
,
 
boxes_sproc
,
 
boxes_pproc
;
292    
def
 
boxes_clear_all
 
=
 
enddef
;
293
enddef
 
;
294
295
def
 
boxjoin
(
text
 
t
)
 
=
296    
def
 
boxes_prevbox
 
=
 
_
 
enddef
;
297    
def
 
boxes_dojoin
(
suffix
 
a
,
b
)
 
=
 
t
 
enddef
;
298
enddef
;
299
300
extra_beginfig
 
:
=
 
extra_beginfig
 
&
 
"
boxes_init_all;
"
;
301
extra_endfig
   
:
=
 
"
boxes_clear_all;
"
 
&
 
extra_endfig
;
302
303
if
 
makingfigure
 
:
304    
boxes_init_all
;
305
fi
 
;
306
307
% Rectangular boxes with rounded corners
308
309
newinternal
 
rbox_radius
 
;
 
rbox_radius
 
:
=
 
8
bp
 
;
310
311
vardef
 
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
,
@#
)
 
;
322
enddef
;
323
324
def
 
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
331
enddef
;
332
333