mp-xbox.mpxl /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
% 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