mp-xbox.mpiv /size: 9 Kb    last modification: 2021-10-28 13:50
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
if
known
metafun_loaded_xbox
:
endinput
;
fi
;
17 18
boolean
metafun_loaded_xbox
;
metafun_loaded_xbox
:
=
true
;
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 24
vardef
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_
32
enddef
;
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 37
vardef
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
63
enddef
;
64 65
% Make sure the string boxes_n_gen is generisize(_n_):
66 67
string
boxes_n
,
boxes_n_cur
,
boxes_n_gen
;
boxes_n_cur
:
=
"
]
"
;
% this won't match _n_
68 69
vardef
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
74
enddef
;
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 82
vardef
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
90
enddef
;
91 92
% Here is another version that redeclares the vars even if they are already of the
93
% right type.
94 95
vardef
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
;
99
enddef
;
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 106
def
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
$
]
119
enddef
;
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 124
def
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
132
enddef
;
133 134
% Text t gives equations for joining box a to box b.
135 136
def
boxes_boxjoin
(
text
t
)
=
137
def
boxes_prevbox
=
_
enddef
;
138
def
boxes_dojoin
(
suffix
a
,
b
)
=
t
enddef
;
139
enddef
;
140 141
def
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 146
vardef
boxes_fixsize
(
text
t
)
=
147
forsuffixes
$
=
t
:
scantokens
boxes_sproc
$
(
$
)
;
endfor
148
enddef
;
149 150
% Given a list of box names, give default values for any unknown positioning offsets.
151 152
vardef
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
157
enddef
;
158 159
% Return the boundary path for the given box
160 161
vardef
bpath
suffix
$
=
162
boxes_fixsize
(
$
)
;
163
boxes_fixpos
(
$
)
;
164
scantokens
boxes_pproc
$
(
$
)
165
enddef
;
166 167
% Return the contents of the given box. First define a private version that the user can't
168
% accidently clobber.
169 170
vardef
boxes_pic_mac
suffix
$
=
171
boxes_fixsize
(
$
)
;
172
boxes_fixpos
(
$
)
;
173
boxes_pic
$
shifted
$
off
174
enddef
;
175 176
vardef
pic
suffix
$
=
boxes_pic_mac
$
enddef
;
177 178
% Draw each box:
179 180
def
drawboxed
(
text
t
)
=
181
boxes_fixsize
(
t
)
;
182
boxes_fixpos
(
t
)
;
183
forsuffixes
s
=
t
:
draw
boxes_pic_mac
.
s
;
draw
bpath
.
s
;
endfor
184
enddef
;
185 186
% Draw contents of each box:
187 188
def
drawunboxed
(
text
t
)
=
189
boxes_fixsize
(
t
)
;
190
boxes_fixpos
(
t
)
;
191
forsuffixes
s
=
t
:
192
draw
boxes_pic_mac
.
s
;
193
endfor
194
enddef
;
195 196
% Draw boundary path for each box:
197 198
def
drawboxes
(
text
t
)
=
199
forsuffixes
s
=
t
:
200
draw
bpath
.
s
;
201
endfor
202
enddef
;
203 204
% Rectangular boxes
205 206
newinternal
defaultdx
,
defaultdy
;
defaultdx
:
=
defaultdy
:
=
3
bp
;
207 208
vardef
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
,
@#
)
;
219
enddef
;
220 221
def
boxes_path
(
suffix
$
)
=
222
$
.
sw
--
$
.
se
--
$
.
ne
--
$
.
nw
--
cycle
223
enddef
;
224 225
def
boxes_size
(
suffix
$
)
=
226
if
unknown
$
.
dx
:
$
.
dx
=
defaultdx
;
fi
227
if
unknown
$
.
dy
:
$
.
dy
=
defaultdy
;
fi
228
enddef
;
229 230
vardef
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
;
233
enddef
;
234 235
% Circular and oval boxes
236 237
newinternal
circmargin
;
circmargin
:
=
2
bp
;
% default clearance for picture corner
238 239
vardef
circleit
@#
(
text
tt
)
=
240
boxes_begin
(
"
boxes_the_circle
"
,
"
boxes_size_circle
"
,
@#
,
tt
)
;
241
boxes_generic_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
,
@#
)
;
245
enddef
;
246 247
def
boxes_the_circle
(
suffix
$
)
=
248
$
.
e
{
up
}
...
$
.
n
{
left
}
...
$
.
w
{
down
}
...
$
.
s
{
right
}
...
cycle
249
enddef
;
250 251
vardef
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
;
254
enddef
;
255 256
vardef
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
275
enddef
;
276 277
vardef
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.5
circmargin
)
284
enddef
;
285 286
def
boxes_init_all
=
287
boxes_boxjoin
(
)
;
288
save
boxes_pic
,
boxes_sproc
,
boxes_pproc
;
289
def
boxes_clear_all
=
enddef
;
290
enddef
;
291 292
def
boxjoin
(
text
t
)
=
293
def
boxes_prevbox
=
_
enddef
;
294
def
boxes_dojoin
(
suffix
a
,
b
)
=
t
enddef
;
295
enddef
;
296 297
extra_beginfig
:
=
extra_beginfig
&
"
boxes_init_all;
"
;
298
extra_endfig
:
=
"
boxes_clear_all;
"
&
extra_endfig
;
299 300
if
makingfigure
:
301
boxes_init_all
;
302
fi
;
303 304
% Rectangular boxes with rounded corners
305 306
newinternal
rbox_radius
;
rbox_radius
:
=
8
bp
;
307 308
vardef
rboxit
@#
(
text
tt
)
=
309
boxes_begin
(
"
boxes_the_rounded
"
,
"
boxes_size
"
,
@#
,
tt
)
;
310
boxes_generic_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
,
@#
)
;
319
enddef
;
320 321
def
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
328
enddef
;
329 330