mp-mlib.mpxl /size: 59 Kb    last modification: 2021-10-28 13:50
1
%D \module
2
%D [ file=mp-mlib.mpiv,
3
%D version=2008.03.21,
4
%D title=\CONTEXT\ \METAPOST\ graphics,
5
%D subtitle=plugins,
6
%D author=Hans Hagen,
7
%D date=\currentdate,
8
%D copyright={PRAGMA ADE \& \CONTEXT\ Development Team}]
9
%C
10
%C This module is part of the \CONTEXT\ macro||package and is
11
%C therefore copyrighted by \PRAGMA. See licen-en.pdf for
12
%C details.
13 14
if
known
metafun_loaded_mlib
:
endinput
;
fi
;
15 16
newinternal
boolean
metafun_loaded_mlib
;
metafun_loaded_mlib
:
=
true
;
immutable
metafun_loaded_mlib
;
17 18
% numeric LUATEXFUNCTIONALITY ; LUATEXFUNCTIONALITY := runscript("mp.print(LUATEXFUNCTIONALITY or (status and status.development_id) or 6346)") ;
19 20
%D Color and transparency
21
%D
22
%D Separable:
23 24
newinternal
normaltransparent
;
normaltransparent
:
=
1
;
25
newinternal
multiplytransparent
;
multiplytransparent
:
=
2
;
26
newinternal
screentransparent
;
screentransparent
:
=
3
;
27
newinternal
overlaytransparent
;
overlaytransparent
:
=
4
;
28
newinternal
softlighttransparent
;
softlighttransparent
:
=
5
;
29
newinternal
hardlighttransparent
;
hardlighttransparent
:
=
6
;
30
newinternal
colordodgetransparent
;
colordodgetransparent
:
=
7
;
31
newinternal
colorburntransparent
;
colorburntransparent
:
=
8
;
32
newinternal
darkentransparent
;
darkentransparent
:
=
9
;
33
newinternal
lightentransparent
;
lightentransparent
:
=
10
;
34
newinternal
differencetransparent
;
differencetransparent
:
=
11
;
35
newinternal
exclusiontransparent
;
exclusiontransparent
:
=
12
;
36 37
%D Nonseparable:
38 39
newinternal
huetransparent
;
huetransparent
:
=
13
;
40
newinternal
saturationtransparent
;
saturationtransparent
:
=
14
;
41
newinternal
colortransparent
;
colortransparent
:
=
15
;
42
newinternal
luminositytransparent
;
luminositytransparent
:
=
16
;
43 44
permanent
normaltransparent
,
multiplytransparent
,
screentransparent
,
overlaytransparent
,
45
softlighttransparent
,
hardlighttransparent
,
colordodgetransparent
,
colorburntransparent
,
46
darkentransparent
,
lightentransparent
,
differencetransparent
,
exclusiontransparent
,
47
huetransparent
,
saturationtransparent
,
colortransparent
,
luminositytransparent
;
48 49
vardef
transparency_alternative_to_number
(
expr
name
)
=
50
if
string
name
:
51
if
expandafter
known
scantokens
(
name
&
"
transparent
"
)
:
52
scantokens
(
name
&
"
transparent
"
)
53
else
:
54
0
55
fi
56
elseif
name
<
17
:
57
name
58
else
:
59
0
60
fi
61
enddef
;
62 63
def
namedcolor
expr
n
=
64
(
1
)
65
withprescript
"
sp_type=named
"
66
withprescript
"
sp_name=
"
&
n
67
enddef
;
68 69
% def mfun_spotcolor(expr n, v) =
70
% 1
71
% withprescript "sp_type=xspot"
72
% withprescript "sp_name=" & n
73
% withprescript "sp_value=" & (if numeric v : decimal v else : v fi)
74
% enddef ;
75 76
% def mfun_multispotcolor(expr name, fractions, components, value) =
77
% 1
78
% withprescript "sp_type=multispot"
79
% withprescript "sp_name=" & name
80
% withprescript "sp_fractions=" & decimal fractions
81
% withprescript "sp_components=" & components
82
% withprescript "sp_value=" & value
83
% enddef ;
84 85
def
spotcolor
(
expr
name
,
v
)
=
86
(
1
)
87
withprescript
"
sp_type=spot
"
88
withprescript
"
sp_name=
"
&
name
89
withprescript
"
sp_value=
"
&
colordecimals
v
90
enddef
;
91 92
% In this case a mixed color will be calculated:
93 94
def
multitonecolor
(
expr
name
)
(
text
t
)
=
95
(
1
)
96
withprescript
"
sp_type=multitone
"
97
withprescript
"
sp_name=
"
&
name
98
withprescript
"
sp_value=
"
&
colordecimalslist
(
t
)
99
enddef
;
100 101
def
transparent
(
expr
a
,
t
)
(
text
c
)
=
% use withtransparency instead
102
(
1
)
% this permits withcolor x intoshade y
103
withprescript
"
tr_alternative=
"
&
decimal
transparency_alternative_to_number
(
a
)
104
withprescript
"
tr_transparency=
"
&
decimal
t
105
withcolor
c
106
enddef
;
107 108
def
withtransparency
(
expr
a
,
t
)
=
109
withprescript
"
tr_alternative=
"
&
decimal
transparency_alternative_to_number
(
a
)
110
withprescript
"
tr_transparency=
"
&
decimal
t
111
enddef
;
112 113
% for svg:
114 115
def
withopacity
expr
o
=
116
if
o
<
>
1
:
117
withprescript
"
tr_alternative=
"
&
decimal
normaltransparent
118
withprescript
"
tr_transparency=
"
&
decimal
o
119
fi
120
enddef
;
121 122
% Provided for downward compability:
123 124
def
cmyk
(
expr
c
,
m
,
y
,
k
)
=
125
(
c
,
m
,
y
,
k
)
126
enddef
;
127 128
permanent
spotcolor
,
multitonecolor
,
transparent
,
withtransparency
,
namedcolor
,
withopacity
,
cmyk
;
129 130
% Texts (todo: better strut ratio, now .7 hardcoded, should be passed)
131 132
newinternal
textextoffset
;
textextoffset
:
=
0
;
133 134
permanent
textextoffset
;
135 136
rgbcolor
mfun_tt_r
;
137
numeric
mfun_tt_n
;
mfun_tt_n
:
=
0
;
138
picture
mfun_tt_p
;
mfun_tt_p
:
=
nullpicture
;
139
picture
mfun_tt_o
;
mfun_tt_o
:
=
nullpicture
;
140
picture
mfun_tt_c
;
mfun_tt_c
:
=
nullpicture
;
141 142
if
unknown
mfun_trial_run
:
143
boolean
mfun_trial_run
;
144
mfun_trial_run
:
=
false
;
145
else
:
146
% already defined before the format is loaded
147
fi
;
148 149
def
mfun_reset_tex_texts
=
150
mfun_tt_n
:
=
0
;
151
mfun_tt_p
:
=
nullpicture
;
152
mfun_tt_o
:
=
nullpicture
;
% redundant
153
mfun_tt_c
:
=
nullpicture
;
% redundant
154
enddef
;
155 156
def
mfun_flush_tex_texts
=
157
addto
currentpicture
also
mfun_tt_p
158
enddef
;
159 160
extra_endfig
:
=
"
mfun_flush_tex_texts ;
"
&
extra_endfig
;
161
extra_beginfig
:
=
extra_beginfig
&
"
mfun_reset_tex_texts ;
"
;
162 163
% We collect and flush them all, as we can also have temporary textexts
164
% that gets never really flushed but are used for calculations. So, we
165
% flush twice: once in location in order to pick up e.g. color properties,
166
% and once at the end because we need to flush missing ones.
167 168
boolean
mfun_onetime_textext
;
mfun_onetime_textext
:
=
false
;
169
numeric
mfun_global_textext
;
mfun_global_textext
:
=
0
;
170 171
def
keepcached
=
172
hide
(
mfun_global_textext
:
=
mfun_global_textext
+
1
;
)
173
withprescript
(
"
tx_cache=
"
&
decimal
mfun_global_textext
)
174
enddef
;
175 176
def
notcached
=
177
withprescript
"
tx_cache=no
"
178
enddef
;
179 180
permanent
keepcached
,
notcached
;
181 182
% todo: onetime
183 184
rgbcolor
mfun_tt_r
;
185 186
newinternal
inicatcoderegime
;
inicatcoderegime
:
=
runscript
(
"
return catcodes.numbers.ctxcatcodes
"
)
;
187
newinternal
texcatcoderegime
;
texcatcoderegime
:
=
runscript
(
"
return catcodes.numbers.texcatcodes
"
)
;
188
newinternal
luacatcoderegime
;
luacatcoderegime
:
=
runscript
(
"
return catcodes.numbers.luacatcodes
"
)
;
189
newinternal
notcatcoderegime
;
notcatcoderegime
:
=
runscript
(
"
return catcodes.numbers.notcatcodes
"
)
;
190
newinternal
vrbcatcoderegime
;
vrbcatcoderegime
:
=
runscript
(
"
return catcodes.numbers.vrbcatcodes
"
)
;
191
newinternal
prtcatcoderegime
;
prtcatcoderegime
:
=
runscript
(
"
return catcodes.numbers.prtcatcodes
"
)
;
192
newinternal
ctxcatcoderegime
;
ctxcatcoderegime
:
=
runscript
(
"
return catcodes.numbers.ctxcatcodes
"
)
;
193
newinternal
txtcatcoderegime
;
txtcatcoderegime
:
=
runscript
(
"
return catcodes.numbers.txtcatcodes
"
)
;
194 195
newinternal
catcoderegime
;
catcoderegime
:
=
ctxcatcoderegime
;
196 197
immutable
inicatcoderegime
,
texcatcoderegime
,
luacatcoderegime
,
notcatcoderegime
,
198
vrbcatcoderegime
,
prtcatcoderegime
,
ctxcatcoderegime
,
txtcatcoderegime
;
199 200
permanent
catcoderegime
;
201 202
newscriptindex
mfid_sometextext
;
mfid_sometextext
:
=
scriptindex
"
sometextext
"
;
203
newscriptindex
mfid_madetextext
;
mfid_madetextext
:
=
scriptindex
"
madetextext
"
;
204
newscriptindex
mfid_boxdimensions
;
mfid_boxdimensions
:
=
scriptindex
"
boxdimensions
"
;
205 206
vardef
rawtextext
(
expr
s
)
=
207
if
s
=
"
"
:
208
nullpicture
209
else
:
210
mfun_tt_n
:
=
mfun_tt_n
+
1
;
211
mfun_tt_c
:
=
nullpicture
;
212
mfun_tt_o
:
=
nullpicture
;
213
addto
mfun_tt_o
doublepath
origin
base_draw_options
;
214
mfun_tt_r
:
=
runscript
mfid_sometextext
mfun_tt_n
s
catcoderegime
;
215
addto
mfun_tt_c
doublepath
unitsquare
216
xscaled
wdpart
mfun_tt_r
217
yscaled
(
htpart
mfun_tt_r
+
dppart
mfun_tt_r
)
218
shifted
(
0
,
-
dppart
mfun_tt_r
)
219
withprescript
"
mf_object=text
"
220
withprescript
"
tx_index=
"
&
decimal
mfun_tt_n
221
withprescript
"
tx_color=
"
&
colordecimals
colorpart
mfun_tt_o
222
;
223
mfun_tt_c
224
fi
225
enddef
;
226 227
vardef
rawmadetext
=
228
mfun_tt_n
:
=
mfun_tt_n
+
1
;
229
mfun_tt_c
:
=
nullpicture
;
230
mfun_tt_o
:
=
nullpicture
;
231
addto
mfun_tt_o
doublepath
origin
base_draw_options
;
232
mfun_tt_r
:
=
runscript
mfid_madetextext
mfun_tt_n
;
233
addto
mfun_tt_c
doublepath
unitsquare
234
xscaled
wdpart
mfun_tt_r
235
yscaled
(
htpart
mfun_tt_r
+
dppart
mfun_tt_r
)
236
shifted
(
0
,
-
dppart
mfun_tt_r
)
237
withprescript
"
mf_object=text
"
238
withprescript
"
tx_index=
"
&
decimal
mfun_tt_n
239
withprescript
"
tx_color=
"
&
colordecimals
colorpart
mfun_tt_o
240
;
241
mfun_tt_c
242
enddef
;
243 244
% \setbox\scratchbox\hbox{!!!!!!!!!!!!!}
245
% \putboxincache{one}{a}\scratchbox
246
% \startMPcode draw rawtexbox("one","a") ; \stopMPcode
247 248
vardef
validtexbox
(
expr
category
,
name
)
=
249
if
category
=
=
"
"
:
250
false
251
elseif
string
name
:
252
name
<
>
"
"
253
elseif
numeric
name
:
254
name
>
0
255
else
:
256
true
257
fi
258
enddef
;
259 260
vardef
rawtexbox
(
expr
category
,
name
)
=
261
mfun_tt_c
:
=
nullpicture
;
262
if
validtexbox
(
category
,
name
)
:
263
% mfun_tt_r := lua.mp.mf_tb_dimensions(category, name) ;
264
mfun_tt_r
:
=
runscript
mfid_boxdimensions
category
name
;
265
addto
mfun_tt_c
doublepath
unitsquare
266
xscaled
wdpart
mfun_tt_r
267
yscaled
(
htpart
mfun_tt_r
+
dppart
mfun_tt_r
)
268
shifted
(
0
,
-
dppart
mfun_tt_r
)
269
withprescript
"
mf_object=box
"
270
withprescript
"
bx_category=
"
&
if
numeric
category
:
decimal
fi
category
271
withprescript
"
bx_name=
"
&
if
numeric
name
:
decimal
fi
name
;
272
fi
273
mfun_tt_c
274
enddef
;
275 276
% More text
277 278
defaultfont
:
=
"
Mono
"
;
279
defaultscale
:
=
1
;
280 281
extra_beginfig
:
=
extra_beginfig
&
"
defaultscale:=1;
"
;
282 283
vardef
fontsize
expr
name
=
284
save
size
;
numeric
size
;
285
size
:
=
bbwidth
(
textext
(
"
\MPfontsizehskip{
"
&
name
&
"
}
"
)
)
;
286
if
size
=
0
:
287
12
pt
288
else
:
289
size
290
fi
291
enddef
;
292 293
permanent
fontsize
;
294 295
pair
mfun_laboff
;
mfun_laboff
:
=
origin
;
296
pair
mfun_laboff
.
lft
;
mfun_laboff
.
lft
:
=
(
-1
,
0
)
;
297
pair
mfun_laboff
.
rt
;
mfun_laboff
.
rt
:
=
(
1
,
0
)
;
298
pair
mfun_laboff
.
bot
;
mfun_laboff
.
bot
:
=
(
0
,
-1
)
;
299
pair
mfun_laboff
.
top
;
mfun_laboff
.
top
:
=
(
0
,
1
)
;
300
pair
mfun_laboff
.
ulft
;
mfun_laboff
.
ulft
:
=
(
-.7
,
.7
)
;
301
pair
mfun_laboff
.
urt
;
mfun_laboff
.
urt
:
=
(
.7
,
.7
)
;
302
pair
mfun_laboff
.
llft
;
mfun_laboff
.
llft
:
=
-
(
.7
,
.7
)
;
303
pair
mfun_laboff
.
lrt
;
mfun_laboff
.
lrt
:
=
(
.7
,
-.7
)
;
304 305
pair
mfun_laboff
.
d
;
mfun_laboff
.
d
:
=
mfun_laboff
;
306
pair
mfun_laboff
.
dlft
;
mfun_laboff
.
dlft
:
=
mfun_laboff
.
lft
;
307
pair
mfun_laboff
.
drt
;
mfun_laboff
.
drt
:
=
mfun_laboff
.
rt
;
308
pair
mfun_laboff
.
origin
;
mfun_laboff
.
origin
:
=
mfun_laboff
;
309
pair
mfun_laboff
.
raw
;
mfun_laboff
.
raw
:
=
mfun_laboff
;
310 311
pair
mfun_laboff
.
l
;
mfun_laboff
.
l
:
=
mfun_laboff
.
lft
;
312
pair
mfun_laboff
.
r
;
mfun_laboff
.
r
:
=
mfun_laboff
.
rt
;
313
pair
mfun_laboff
.
b
;
mfun_laboff
.
b
:
=
mfun_laboff
.
bot
;
314
pair
mfun_laboff
.
t
;
mfun_laboff
.
t
:
=
mfun_laboff
.
top
;
315
pair
mfun_laboff
.
l_t
;
mfun_laboff
.
l_t
:
=
mfun_laboff
.
ulft
;
316
pair
mfun_laboff
.
r_t
;
mfun_laboff
.
r_t
:
=
mfun_laboff
.
urt
;
317
pair
mfun_laboff
.
l_b
;
mfun_laboff
.
l_b
:
=
mfun_laboff
.
llft
;
318
pair
mfun_laboff
.
r_b
;
mfun_laboff
.
r_b
:
=
mfun_laboff
.
lrt
;
319
pair
mfun_laboff
.
t_l
;
mfun_laboff
.
t_l
:
=
mfun_laboff
.
ulft
;
320
pair
mfun_laboff
.
t_r
;
mfun_laboff
.
t_r
:
=
mfun_laboff
.
urt
;
321
pair
mfun_laboff
.
b_l
;
mfun_laboff
.
b_l
:
=
mfun_laboff
.
llft
;
322
pair
mfun_laboff
.
b_r
;
mfun_laboff
.
b_r
:
=
mfun_laboff
.
lrt
;
323 324
mfun_labxf
:
=
0.5
;
325
mfun_labxf
.
lft
:
=
mfun_labxf
.
l
:
=
1
;
326
mfun_labxf
.
rt
:
=
mfun_labxf
.
r
:
=
0
;
327
mfun_labxf
.
bot
:
=
mfun_labxf
.
b
:
=
0.5
;
328
mfun_labxf
.
top
:
=
mfun_labxf
.
t
:
=
0.5
;
329
mfun_labxf
.
ulft
:
=
mfun_labxf
.
l_t
:
=
mfun_labxf
.
t_l
:
=
1
;
330
mfun_labxf
.
urt
:
=
mfun_labxf
.
r_t
:
=
mfun_labxf
.
t_r
:
=
0
;
331
mfun_labxf
.
llft
:
=
mfun_labxf
.
l_b
:
=
mfun_labxf
.
b_l
:
=
1
;
332
mfun_labxf
.
lrt
:
=
mfun_labxf
.
r_b
:
=
mfun_labxf
.
b_r
:
=
0
;
333 334
mfun_labxf
.
d
:
=
mfun_labxf
;
335
mfun_labxf
.
dlft
:
=
mfun_labxf
.
lft
;
336
mfun_labxf
.
drt
:
=
mfun_labxf
.
rt
;
337
mfun_labxf
.
origin
:
=
0
;
338
mfun_labxf
.
raw
:
=
0
;
339 340
mfun_labyf
:
=
0.5
;
341
mfun_labyf
.
lft
:
=
mfun_labyf
.
l
:
=
0.5
;
342
mfun_labyf
.
rt
:
=
mfun_labyf
.
r
:
=
0.5
;
343
mfun_labyf
.
bot
:
=
mfun_labyf
.
b
:
=
1
;
344
mfun_labyf
.
top
:
=
mfun_labyf
.
t
:
=
0
;
345
mfun_labyf
.
ulft
:
=
mfun_labyf
.
l_t
:
=
mfun_labyf
.
t_l
:
=
0
;
346
mfun_labyf
.
urt
:
=
mfun_labyf
.
r_t
:
=
mfun_labyf
.
t_r
:
=
0
;
347
mfun_labyf
.
llft
:
=
mfun_labyf
.
l_b
:
=
mfun_labyf
.
b_l
:
=
1
;
348
mfun_labyf
.
lrt
:
=
mfun_labyf
.
r_b
:
=
mfun_labyf
.
b_r
:
=
1
;
349 350
mfun_labyf
.
d
:
=
mfun_labyf
;
351
mfun_labyf
.
dlft
:
=
mfun_labyf
.
lft
;
352
mfun_labyf
.
drt
:
=
mfun_labyf
.
rt
;
353
mfun_labyf
.
origin
:
=
0
;
354
mfun_labyf
.
raw
:
=
0
;
355 356
mfun_labtype
:
=
0
;
357
mfun_labtype
.
lft
:
=
mfun_labtype
.
l
:
=
1
;
358
mfun_labtype
.
rt
:
=
mfun_labtype
.
r
:
=
2
;
359
mfun_labtype
.
bot
:
=
mfun_labtype
.
b
:
=
3
;
360
mfun_labtype
.
top
:
=
mfun_labtype
.
t
:
=
4
;
361
mfun_labtype
.
ulft
:
=
mfun_labtype
.
l_t
:
=
mfun_labtype
.
t_l
:
=
5
;
362
mfun_labtype
.
urt
:
=
mfun_labtype
.
r_t
:
=
mfun_labtype
.
t_r
:
=
6
;
363
mfun_labtype
.
llft
:
=
mfun_labtype
.
l_b
:
=
mfun_labtype
.
b_l
:
=
7
;
364
mfun_labtype
.
lrt
:
=
mfun_labtype
.
r_b
:
=
mfun_labtype
.
b_r
:
=
8
;
365
mfun_labtype
.
d
:
=
10
;
366
mfun_labtype
.
dlft
:
=
11
;
367
mfun_labtype
.
drt
:
=
12
;
368
mfun_labtype
.
origin
:
=
0
;
369
mfun_labtype
.
raw
:
=
0
;
370 371
vardef
installlabel
@#
(
expr
type
,
x
,
y
,
offset
)
=
372
numeric
mfun_labtype
@#
;
mfun_labtype
@#
:
=
type
;
373
pair
mfun_laboff
@#
;
mfun_laboff
@#
:
=
offset
;
374
numeric
mfun_labxf
@#
;
mfun_labxf
@#
:
=
x
;
375
numeric
mfun_labyf
@#
;
mfun_labyf
@#
:
=
y
;
376
enddef
;
377 378
permanent
installlabel
;
379 380
installlabel
.
center
(
0
,
0.5
,
0.5
,
(
0
,
0
)
)
;
381
installlabel
.
c
(
0
,
0.5
,
0.5
,
(
0
,
0
)
)
;
382 383
installlabel
.
hcenter
(
0
,
0.5
,
0.5
,
(
1
,
0
)
)
;
384
installlabel
.
h
(
0
,
0.5
,
0.5
,
(
1
,
0
)
)
;
385 386
installlabel
.
vcenter
(
0
,
0.5
,
0.5
,
(
0
,
1
)
)
;
387
installlabel
.
v
(
0
,
0.5
,
0.5
,
(
0
,
1
)
)
;
388 389
vardef
mfun_labshift
@#
(
expr
p
)
=
390
(
mfun_labxf
@#
*
lrcorner
p
+
391
mfun_labyf
@#
*
ulcorner
p
+
392
(
1
-
mfun_labxf
@#
-
mfun_labyf
@#
)
*
llcorner
p
)
393
enddef
;
394 395
vardef
mfun_picshift
@#
(
expr
p
)
=
396
(
mfun_labxf
@#
*
ulcorner
p
+
397
mfun_labyf
@#
*
lrcorner
p
+
398
(
1
-
mfun_labxf
@#
-
mfun_labyf
@#
)
*
urcorner
p
)
399
enddef
;
400 401
% we save the plain variant
402 403
% vardef plain_thelabel@#(expr p,z) =
404
% if string p :
405
% plain_thelabel@#(rawtextext("\definedfont[" & defaultfont & "]" & p) scaled defaultscale,z)
406
% else :
407
% p shifted (z + labeloffset*laboff@# - mfun_labshift@#(p))
408
% fi
409
% enddef;
410
%
411
% def plain_label = % takes two arguments, contrary to textext that takes one
412
% normaldraw plain_thelabel
413
% enddef ;
414
%
415
% let mfun_label = label ;
416
% let mfun_thelabel = thelabel ;
417
%
418
% def useplainlabels = % somehow let doesn't work for all code
419
% def label = plain_label enddef ;
420
% def thelabel = plain_thelabel enddef ;
421
% enddef ;
422
%
423
% def usemetafunlabels =
424
% let label = mfun_label ;
425
% let thelabel = mfun_thelabel ;
426
% enddef ;
427
%
428
% plain_compatibility_data := plain_compatibility_data & "save label, thelabel ;" & "useplainlabels ;" ;
429 430
newinternal
anchortextexts
;
anchortextexts
:
=
0
;
% disabled by default
431 432
vardef
thetextext
@#
(
expr
p
,
z
)
=
433
% interim labeloffset := textextoffset ;
434
if
string
p
:
435
thetextext
@#
(
rawtextext
(
p
)
,
z
)
436
elseif
numeric
p
:
437
thetextext
@#
(
rawtextext
(
decimal
p
)
,
z
)
438
elseif
pair
p
:
439
thetextext
@#
(
rawtextext
(
ddecimal
p
)
,
z
)
440
else
:
441
if
anchortextexts
>
0
:
442
image
(
draw
p
withprescript
"
tx_anchor=
"
&
ddecimal
z
)
443
else
:
444
p
445
fi
446
if
(
mfun_labtype
@#
>
=
10
)
:
447
shifted
(
0
,
ypart
center
p
)
448
fi
449
shifted
(
z
+
textextoffset
*
mfun_laboff
@#
-
mfun_labshift
@#
(
p
)
)
450
fi
451
enddef
;
452 453
vardef
textext
@#
(
expr
p
)
=
% no draw here
454
thetextext
@#
(
p
,
origin
)
455
enddef
;
456 457
vardef
onetimetextext
@#
(
expr
p
)
=
% no draw here
458
mfun_onetime_textext
:
=
true
;
459
thetextext
@#
(
p
,
origin
)
460
enddef
;
461 462
permanent
rawtextext
,
rawmadetext
,
validtexbox
,
rawtexbox
,
thetextext
,
textext
,
onetimetextext
;
463 464
% formatted text
465 466
pair
mfun_tt_z
;
467 468
vardef
rawfmttext
(
text
t
)
=
469
mfun_tt_n
:
=
mfun_tt_n
+
1
;
470
mfun_tt_c
:
=
nullpicture
;
471
mfun_tt_o
:
=
nullpicture
;
472
addto
mfun_tt_o
doublepath
origin
base_draw_options
;
473
mfun_tt_r
:
=
lua.mp.mf_formatted_text
(
mfun_tt_n
,
t
)
;
474
addto
mfun_tt_c
doublepath
unitsquare
475
xscaled
wdpart
mfun_tt_r
476
yscaled
(
htpart
mfun_tt_r
+
dppart
mfun_tt_r
)
477
shifted
(
0
,
-
dppart
mfun_tt_r
)
478
withprescript
"
mf_object=text
"
479
withprescript
"
tx_index=
"
&
decimal
mfun_tt_n
480
withprescript
"
tx_color=
"
&
colordecimals
colorpart
mfun_tt_o
481
;
482
for
s
=
t
:
483
if
pair
s
:
mfun_tt_z
:
=
s
;
fi
484
endfor
;
485
mfun_tt_c
486
enddef
;
487 488
vardef
thefmttext
@#
(
text
t
)
=
489
mfun_tt_z
:
=
origin
;
% initialization
490
save
p
;
picture
p
;
p
:
=
rawfmttext
(
t
)
;
491
if
anchortextexts
>
0
:
492
image
(
draw
p
withprescript
"
tx_anchor=
"
&
ddecimal
mfun_tt_z
)
493
else
:
494
p
495
fi
496
if
(
mfun_labtype
@#
>
=
10
)
:
497
shifted
(
0
,
ypart
center
p
)
498
fi
499
shifted
(
mfun_tt_z
+
textextoffset
*
mfun_laboff
@#
-
mfun_labshift
@#
(
p
)
)
500
enddef
;
501 502
vardef
fmttext
@#
(
text
t
)
=
% no draw here
503
thefmttext
@#
(
t
,
origin
)
504
enddef
;
505 506
% or just: def fmttext = thefmttext enddef ;
507 508
vardef
onetimefmttext
@#
(
text
t
)
=
% no draw here
509
mfun_onetime_textext
:
=
true
;
510
thefmttext
@#
(
t
,
origin
)
511
enddef
;
512 513
% so much for formatted text
514 515
vardef
thetexbox
@#
(
expr
category
,
name
,
z
)
=
516
save
p
;
picture
p
;
p
:
=
rawtexbox
(
category
,
name
)
;
517
p
518
if
(
mfun_labtype
@#
>
=
10
)
:
519
shifted
(
0
,
ypart
center
p
)
520
fi
521
shifted
(
z
+
textextoffset
*
mfun_laboff
@#
-
mfun_labshift
@#
(
p
)
)
522
enddef
;
523 524
vardef
texbox
@#
(
expr
category
,
name
)
=
% no draw here
525
thetexbox
@#
(
category
,
name
,
origin
)
526
enddef
;
527 528
permanent
rawfmttext
,
thefmttext
,
fmttext
,
onetimefmttext
,
thetexbox
,
texbox
;
529 530
% vardef thelabel@#(expr p,z) =
531
% if string p :
532
% thelabel@#(rawtextext("\definedfont[" & defaultfont & "]" & p) scaled defaultscale,z)
533
% else :
534
% p shifted (z + labeloffset*mfun_laboff@# - (mfun_labxf@#*lrcorner p + mfun_labyf@#*ulcorner p + (1-mfun_labxf@#-mfun_labyf@#)*llcorner p))
535
% fi
536
% enddef;
537 538
vardef
theoffset
@#
(
expr
z
)
=
539
if
pair
z
:
540
z
541
elseif
path
z
:
542
if
mfun_laboff
@#
=
origin
:
543
center
z
544
else
:
545
(
(
center
z
)
--
mfun_picshift
@#
(
z
)
)
intersectionpoint
(
z
if
not
cycle
z
:
-
-
cycle
fi
)
546
fi
547
else
:
% picture
548
mfun_picshift
@#
(
z
)
549
fi
550
enddef
;
551 552
vardef
thelabel
@#
(
expr
p
,
z
)
=
553
if
string
p
:
554
thelabel
@#
(
rawtextext
(
"
\definedfont[
"
&
defaultfont
&
"
]
"
&
p
)
scaled
defaultscale
,
z
)
555
elseif
numeric
p
:
556
thelabel
@#
(
decimal
p
,
z
)
557
elseif
pair
p
:
558
thelabel
@#
(
"
(
"
&
decimal
(
xpart
p
)
&
"
,
"
&
decimal
(
ypart
p
)
&
"
)
"
,
z
)
559
else
:
560
p
shifted
(
theoffset
@#
(
z
)
+
labeloffset
*
mfun_laboff
@#
-
mfun_labshift
@#
(
p
)
)
561
fi
562
enddef
;
563 564
def
label
=
% takes two arguments, contrary to textext that takes one
565
normaldraw
thelabel
566
enddef
;
567 568
vardef
anchored
@#
(
expr
p
,
z
)
=
% beware: no "+ mfun_laboff@#" here (never!)
569
p
570
if
(
mfun_labtype
@#
>
=
10
)
:
571
shifted
(
0
,
ypart
center
p
)
572
fi
573
shifted
(
z
+
mfun_labshift
@#
(
p
)
)
574
enddef
;
575 576
let
normalinfont
=
infont
;
577 578
primarydef
s
infont
name
=
% nasty hack
579
if
name
=
"
"
:
580
textext
(
s
)
581
else
:
582
textext
(
"
\definedfont[
"
&
name
&
"
]
"
&
s
)
583
fi
584
enddef
;
585 586
permanent
theoffset
,
thelabel
,
anchored
;
587
primitive
infont
;
% fake primitive
588 589
% Helper
590 591
string
mfun_prescript_separator
;
mfun_prescript_separator
:
=
char
(
13
)
;
592 593
% Shades
594 595
% for while we had this:
596 597
newinternal
shadefactor
;
shadefactor
:
=
1
;
% currently obsolete
598
pair
shadeoffset
;
shadeoffset
:
=
origin
;
% currently obsolete
599
boolean
trace_shades
;
trace_shades
:
=
false
;
% still there
600 601
permanent
shadefactor
,
shadeoffset
;
602 603
% def withlinearshading (expr a, b) =
604
% withprescript "sh_type=linear"
605
% withprescript "sh_domain=0 1"
606
% withprescript "sh_factor=" & decimal shadefactor
607
% withprescript "sh_center_a=" & ddecimal (a shifted shadeoffset)
608
% withprescript "sh_center_b=" & ddecimal (b shifted shadeoffset)
609
% enddef ;
610
%
611
% def withcircularshading (expr a, b, ra, rb) =
612
% withprescript "sh_type=circular"
613
% withprescript "sh_domain=0 1"
614
% withprescript "sh_factor=" & decimal shadefactor
615
% withprescript "sh_center_a=" & ddecimal (a shifted shadeoffset)
616
% withprescript "sh_center_b=" & ddecimal (b shifted shadeoffset)
617
% withprescript "sh_radius_a=" & decimal ra
618
% withprescript "sh_radius_b=" & decimal rb
619
% enddef ;
620
%
621
% def withshading (expr how)(text rest) =
622
% if how = "linear" :
623
% withlinearshading(rest)
624
% elseif how = "circular" :
625
% withcircularshading(rest)
626
% else :
627
% % nothing
628
% fi
629
% enddef ;
630
%
631
% def withfromshadecolor expr t =
632
% withprescript "sh_color=into"
633
% withprescript "sh_color_a=" & colordecimals t
634
% enddef ;
635 636
% def withtoshadecolor expr t =
637
% withprescript "sh_color=into"
638
% withprescript "sh_color_b=" & colordecimals t
639
% enddef ;
640 641
% but this is nicer
642 643
% fill fullcircle scaled 10cm
644
% withshademethod "circular"
645
% withshadevector (5cm,1cm)
646
% withshadecenter (.1,.5)
647
% withshadedomain (.2,.6)
648
% withshadefactor 1.2
649
% withshadecolors (red,green)
650
% ;
651 652
path
mfun_shade_path
;
653
numeric
mfun_shade_step
;
mfun_shade_step
:
=
0
;
654 655
def
withshadestep
=
656
hide
(
mfun_shade_step
:
=
mfun_shade_step
+
1
;
)
657
mfun_withshadestep
658
enddef
;
659 660
def
mfun_withshadestep
(
text
t
)
=
661
withprescript
"
sh_step=
"
&
decimal
mfun_shade_step
662
t
663
enddef
;
664 665
numeric
mfun_shade_fx
,
mfun_shade_fy
;
666
numeric
mfun_shade_lx
,
mfun_shade_ly
;
667
numeric
mfun_shade_nx
,
mfun_shade_ny
;
668
numeric
mfun_shade_dx
,
mfun_shade_dy
;
669
numeric
mfun_shade_tx
,
mfun_shade_ty
;
670
pair
mfun_shade_center
;
671
path
mfun_shade_bbox
;
672 673
numeric
mfun_shade_height
,
mfun_shade_width
;
674
% first
675 676
def
mfun_with_shade_method_analyze
(
expr
p
)
=
677
mfun_shade_path
:
=
p
;
678
mfun_shade_center
:
=
center
p
;
679
mfun_shade_bbox
:
=
boundingbox
p
;
680
mfun_shade_width
:
=
bbwidth
p
;
681
mfun_shade_height
:
=
bbheight
p
;
682
mfun_shade_step
:
=
1
;
683
mfun_shade_fx
:
=
xpart
point
0
of
p
;
684
mfun_shade_fy
:
=
ypart
point
0
of
p
;
685
mfun_shade_lx
:
=
mfun_shade_fx
;
686
mfun_shade_ly
:
=
mfun_shade_fy
;
687
mfun_shade_nx
:
=
0
;
688
mfun_shade_ny
:
=
0
;
689
mfun_shade_dx
:
=
abs
(
mfun_shade_fx
-
mfun_shade_lx
)
;
690
mfun_shade_dy
:
=
abs
(
mfun_shade_fy
-
mfun_shade_ly
)
;
691
for
i
=
1
upto
length
(
p
)
:
692
mfun_shade_tx
:
=
abs
(
mfun_shade_fx
-
xpart
point
i
of
p
)
;
693
mfun_shade_ty
:
=
abs
(
mfun_shade_fy
-
ypart
point
i
of
p
)
;
694
if
mfun_shade_tx
>
mfun_shade_dx
:
695
mfun_shade_nx
:
=
i
+
1
;
696
mfun_shade_lx
:
=
xpart
point
i
of
p
;
697
mfun_shade_dx
:
=
mfun_shade_tx
;
698
fi
;
699
if
mfun_shade_ty
>
mfun_shade_dy
:
700
mfun_shade_ny
:
=
i
+
1
;
701
mfun_shade_ly
:
=
ypart
point
i
of
p
;
702
mfun_shade_dy
:
=
mfun_shade_ty
;
703
fi
;
704
endfor
;
705
enddef
;
706 707
% todo: native bbox
708 709
vardef
mfun_shade_center_fraction_do
expr
a
=
710
ddecimal
(
711
(
xpart
llcorner
mfun_shade_bbox
)
+
(
xpart
a
)
*
mfun_shade_width
,
712
(
ypart
llcorner
mfun_shade_bbox
)
+
(
ypart
a
)
*
mfun_shade_height
713
)
714
enddef
;
715 716
def
withshadecenterfraction
expr
a
=
717
withprescript
"
sh_center_a=
"
&
mfun_shade_center_fraction_do
a
718
withprescript
"
sh_center_b=
"
&
mfun_shade_center_fraction_do
a
719
enddef
;
720 721
def
withshadecenteronefraction
expr
a
=
722
withprescript
"
sh_center_a=
"
&
mfun_shade_center_fraction_do
a
723
enddef
;
724 725
def
withshadecentertwofraction
expr
a
=
726
withprescript
"
sh_center_b=
"
&
mfun_shade_center_fraction_do
a
727
enddef
;
728 729
def
withshaderadiusfraction
expr
a
=
730
withprescript
"
sh_radius_a=0
"
731
withprescript
"
sh_radius_b=
"
&
decimal
(
a
*
sqrt
(
mfun_shade_width
*
mfun_shade_width
+
mfun_shade_height
*
mfun_shade_height
)
/
2
)
732
enddef
;
733 734
vardef
mfun_max_radius
(
expr
p
)
=
735
max
(
736
(
xpart
center
p
-
xpart
llcorner
p
)
++
(
ypart
center
p
-
ypart
llcorner
p
)
,
737
(
xpart
center
p
-
xpart
ulcorner
p
)
++
(
ypart
ulcorner
p
-
ypart
center
p
)
,
738
(
xpart
lrcorner
p
-
xpart
center
p
)
++
(
ypart
center
p
-
ypart
lrcorner
p
)
,
739
(
xpart
urcorner
p
-
xpart
center
p
)
++
(
ypart
urcorner
p
-
ypart
center
p
)
740
)
741
enddef
;
742 743
vardef
mfun_min_radius
(
expr
p
)
=
744
min
(
745
(
xpart
center
p
-
xpart
llcorner
p
)
++
(
ypart
center
p
-
ypart
llcorner
p
)
,
746
(
xpart
center
p
-
xpart
ulcorner
p
)
++
(
ypart
ulcorner
p
-
ypart
center
p
)
,
747
(
xpart
lrcorner
p
-
xpart
center
p
)
++
(
ypart
center
p
-
ypart
lrcorner
p
)
,
748
(
xpart
urcorner
p
-
xpart
center
p
)
++
(
ypart
urcorner
p
-
ypart
center
p
)
749
)
750
enddef
;
751 752
primarydef
p
withshademethod
m
=
753
hide
(
mfun_with_shade_method_analyze
(
p
)
)
754
p
755
withprescript
"
sh_domain=0 1
"
756
withprescript
"
sh_transform=yes
"
757
withprescript
"
sh_color=into
"
758
withprescript
"
sh_color_a=
"
&
colordecimals
white
759
withprescript
"
sh_color_b=
"
&
colordecimals
black
760
withprescript
"
sh_first=
"
&
ddecimal
point
0
of
p
% used for support scaling
761
withprescript
"
sh_set_x=
"
&
ddecimal
(
mfun_shade_nx
,
mfun_shade_lx
)
%
762
withprescript
"
sh_set_y=
"
&
ddecimal
(
mfun_shade_ny
,
mfun_shade_ly
)
%
763
if
m
=
"
linear
"
:
764
withprescript
"
sh_type=linear
"
765
withprescript
"
sh_factor=1
"
766
withprescript
"
sh_center_a=
"
&
ddecimal
llcorner
p
767
withprescript
"
sh_center_b=
"
&
ddecimal
urcorner
p
768
else
:
769
withprescript
"
sh_type=circular
"
770
withprescript
"
sh_factor=1.2
"
771
withprescript
"
sh_center_a=
"
&
ddecimal
center
p
772
withprescript
"
sh_center_b=
"
&
ddecimal
center
p
773
withprescript
"
sh_radius_a=
"
&
decimal
0
774
withprescript
"
sh_radius_b=
"
&
decimal
mfun_max_radius
(
p
)
775
fi
776
enddef
;
777 778
def
withshaderadius
expr
a
=
779
withprescript
"
sh_radius_a=
"
&
decimal
(
xpart
a
)
780
withprescript
"
sh_radius_b=
"
&
decimal
(
ypart
a
)
781
enddef
;
782 783
def
withshadeorigin
expr
a
=
784
withprescript
"
sh_center_a=
"
&
ddecimal
a
785
withprescript
"
sh_center_b=
"
&
ddecimal
a
786
enddef
;
787 788
def
withshadecenterone
expr
a
=
789
withprescript
"
sh_center_a=
"
&
ddecimal
a
790
enddef
;
791 792
def
withshadecentertwo
expr
a
=
793
withprescript
"
sh_center_b=
"
&
ddecimal
a
794
enddef
;
795 796
def
withshadevector
expr
a
=
797
withprescript
"
sh_center_a=
"
&
ddecimal
(
point
xpart
a
of
mfun_shade_path
)
798
withprescript
"
sh_center_b=
"
&
ddecimal
(
point
ypart
a
of
mfun_shade_path
)
799
enddef
;
800 801
def
withshadedirection
expr
a
=
802
withprescript
"
sh_center_a=
"
&
ddecimal
(
point
xpart
a
of
boundingbox
(
mfun_shade_path
)
)
803
withprescript
"
sh_center_b=
"
&
ddecimal
(
point
ypart
a
of
boundingbox
(
mfun_shade_path
)
)
804
enddef
;
805 806
def
withshadetransform
expr
a
=
% yes | no
807
withprescript
"
sh_transform=
"
&
a
808
enddef
;
809 810
pair
shadedup
;
shadedup
:
=
(
0.5
,
2.5
)
;
811
pair
shadeddown
;
shadeddown
:
=
(
2.5
,
0.5
)
;
812
pair
shadedleft
;
shadedleft
:
=
(
1.5
,
3.5
)
;
813
pair
shadedright
;
shadedright
:
=
(
3.5
,
1.5
)
;
814 815
def
withshadecenter
expr
a
=
816
withprescript
"
sh_center_a=
"
&
ddecimal
(
817
center
mfun_shade_path
shifted
(
818
xpart
a
*
bbwidth
(
mfun_shade_path
)
/
2
,
819
ypart
a
*
bbheight
(
mfun_shade_path
)
/
2
820
)
821
)
822
enddef
;
823 824
def
withshadedomain
expr
d
=
825
withprescript
"
sh_domain=
"
&
ddecimal
d
826
enddef
;
827 828
def
withshadefactor
expr
f
=
829
withprescript
"
sh_factor=
"
&
decimal
f
830
enddef
;
831 832
% def withshadebound (expr a) =
833
% if mfun_shade_step > 0 :
834
% withprescript "sh_bound_" & decimal mfun_shade_step & "=" & decimal a
835
% fi
836
% enddef ;
837 838
def
withshadefraction
expr
a
=
839
if
mfun_shade_step
>
0
:
840
withprescript
"
sh_fraction_
"
&
decimal
mfun_shade_step
&
"
=
"
&
decimal
a
841
fi
842
enddef
;
843 844
% def withshadeopacity expr a =
845
% if mfun_shade_step > 0 :
846
% withprescript "sh_opacity_" & decimal mfun_shade_step & "=" & decimal a
847
% fi
848
% enddef ;
849 850
def
withshadecolors
(
expr
a
,
b
)
=
851
if
mfun_shade_step
>
0
:
852
withprescript
"
sh_color=into
"
853
withprescript
"
sh_color_a_
"
&
decimal
mfun_shade_step
&
"
=
"
&
colordecimals
a
854
withprescript
"
sh_color_b_
"
&
decimal
mfun_shade_step
&
"
=
"
&
colordecimals
b
855
else
:
856
withprescript
"
sh_color=into
"
857
withprescript
"
sh_color_a=
"
&
colordecimals
a
858
withprescript
"
sh_color_b=
"
&
colordecimals
b
859
fi
860
enddef
;
861 862
primarydef
a
shadedinto
b
=
% withcolor red shadedinto green
863
1
% does not work with transparency
864
withprescript
"
sh_color=into
"
865
withprescript
"
sh_color_a=
"
&
colordecimals
a
866
withprescript
"
sh_color_b=
"
&
colordecimals
b
867
enddef
;
868 869
primarydef
p
withshade
sc
=
870
p
withprescript
mfun_defined_cs_pre
[
sc
]
871
enddef
;
872 873
def
defineshade
suffix
s
=
874
mfun_defineshade
(
str
s
)
875
enddef
;
876 877
def
mfun_defineshade
(
expr
s
)
text
t
=
878
expandafter
def
scantokens
s
=
t
enddef
;
879
enddef
;
880 881
def
shaded
text
s
=
882
s
883
enddef
;
884 885 886
% For me.
887 888
primarydef
p
shownshadevector
v
=
889
image
(
890
drawarrow
(
point
xpart
v
of
p
)
--
(
point
ypart
v
of
p
)
;
891
fill
fullcircle
scaled
2
shifted
point
xpart
v
of
p
;
892
setbounds
currentpicture
to
center
currentpicture
--
cycle
;
893
)
894
enddef
;
895 896
primarydef
p
shownshadedirection
v
=
897
image
(
898
drawarrow
(
point
xpart
v
of
boundingbox
p
)
--
(
point
ypart
v
of
boundingbox
p
)
;
899
fill
fullcircle
scaled
2
shifted
(
point
xpart
v
of
boundingbox
p
)
;
900
setbounds
currentpicture
to
center
currentpicture
--
cycle
;
901
)
902
enddef
;
903 904
primarydef
p
shownshadecenter
v
=
905
image
(
906
fill
fullcircle
scaled
2
907
shifted
center
p
shifted
(
908
xpart
v
*
bbwidth
(
p
)
/
2
,
909
ypart
v
*
bbheight
(
p
)
/
2
910
)
;
911
setbounds
currentpicture
to
center
currentpicture
--
cycle
;
912
)
913
enddef
;
914 915
primarydef
p
shownshadeorigin
v
=
916
image
(
917
fill
fullcircle
scaled
2
shifted
v
;
918
setbounds
currentpicture
to
center
currentpicture
--
cycle
;
919
)
920
enddef
;
921 922
permanent
withshademethod
,
withshaderadius
,
withshadeorigin
,
withshadevector
,
withshadedirection
,
923
withshadetransform
,
withshadedomain
,
withshadefactor
,
withshadecenter
,
withshadefraction
,
withshadestep
,
924
withshadecolors
,
shadedinto
,
withshade
,
shaded
,
shadedup
,
shadeddown
,
shadedleft
,
shadedright
,
925
shownshadevector
,
shownshadedirection
,
shownshadecenter
,
shownshadeorigin
;
926 927
% Old macros:
928 929
def
withcircularshade
(
expr
a
,
b
,
ra
,
rb
,
ca
,
cb
)
=
930
withprescript
"
sh_type=circular
"
931
withprescript
"
sh_transform=yes
"
932
withprescript
"
sh_domain=0 1
"
933
withprescript
"
sh_factor=1
"
934
withprescript
"
sh_color_a=
"
&
colordecimals
ca
935
withprescript
"
sh_color_b=
"
&
colordecimals
cb
936
withprescript
"
sh_center_a=
"
&
ddecimal
a
% (a shifted shadeoffset)
937
withprescript
"
sh_center_b=
"
&
ddecimal
b
% (b shifted shadeoffset)
938
withprescript
"
sh_radius_a=
"
&
decimal
ra
939
withprescript
"
sh_radius_b=
"
&
decimal
rb
940
enddef
;
941 942
def
withlinearshade
(
expr
a
,
b
,
ca
,
cb
)
=
943
withprescript
"
sh_type=linear
"
944
withprescript
"
sh_transform=yes
"
945
withprescript
"
sh_domain=0 1
"
946
withprescript
"
sh_factor=1
"
947
withprescript
"
sh_color_a=
"
&
colordecimals
ca
948
withprescript
"
sh_color_b=
"
&
colordecimals
cb
949
withprescript
"
sh_center_a=
"
&
ddecimal
a
% (a shifted shadeoffset)
950
withprescript
"
sh_center_b=
"
&
ddecimal
b
% (b shifted shadeoffset)
951
enddef
;
952 953
permanent
withcircularshade
,
withlinearshade
;
954 955
% replaced (obsolete):
956 957
def
set_linear_vector
(
suffix
a
,
b
)
(
expr
p
,
n
)
=
958
if
(
n
=
1
)
:
a
:
=
llcorner
p
;
b
:
=
urcorner
p
;
959
elseif
(
n
=
2
)
:
a
:
=
lrcorner
p
;
b
:
=
ulcorner
p
;
960
elseif
(
n
=
3
)
:
a
:
=
urcorner
p
;
b
:
=
llcorner
p
;
961
elseif
(
n
=
4
)
:
a
:
=
ulcorner
p
;
b
:
=
lrcorner
p
;
962
elseif
(
n
=
5
)
:
a
:
=
.5
[
ulcorner
p
,
llcorner
p
]
;
b
:
=
.5
[
urcorner
p
,
lrcorner
p
]
;
963
elseif
(
n
=
6
)
:
a
:
=
.5
[
llcorner
p
,
lrcorner
p
]
;
b
:
=
.5
[
ulcorner
p
,
urcorner
p
]
;
964
elseif
(
n
=
7
)
:
a
:
=
.5
[
lrcorner
p
,
urcorner
p
]
;
b
:
=
.5
[
llcorner
p
,
ulcorner
p
]
;
965
elseif
(
n
=
8
)
:
a
:
=
.5
[
urcorner
p
,
ulcorner
p
]
;
b
:
=
.5
[
lrcorner
p
,
llcorner
p
]
;
966
else
:
a
:
=
.5
[
ulcorner
p
,
llcorner
p
]
;
b
:
=
.5
[
urcorner
p
,
lrcorner
p
]
;
967
fi
;
968
enddef
;
969 970
def
set_circular_vector
(
suffix
ab
,
r
)
(
expr
p
,
n
)
=
971
if
(
n
=
1
)
:
ab
:
=
llcorner
p
;
972
elseif
(
n
=
2
)
:
ab
:
=
lrcorner
p
;
973
elseif
(
n
=
3
)
:
ab
:
=
urcorner
p
;
974
elseif
(
n
=
4
)
:
ab
:
=
ulcorner
p
;
975
else
:
ab
:
=
center
p
;
r
:
=
.5
r
;
976
fi
;
977
enddef
;
978 979
def
circular_shade
(
expr
p
,
n
,
ca
,
cb
)
=
980
begingroup
;
981
save
ab
,
r
;
pair
ab
;
numeric
r
;
982
r
:
=
(
xpart
lrcorner
p
-
xpart
llcorner
p
)
++
(
ypart
urcorner
p
-
ypart
lrcorner
p
)
;
983
set_circular_vector
(
ab
,
r
)
(
p
,
n
)
;
984
fill
p
withcircularshade
(
ab
,
ab
,
0
,
r
,
ca
,
cb
)
;
985
if
trace_shades
:
986
drawarrow
ab
--
ab
shifted
(
0
,
r
)
withpen
pencircle
scaled
1
pt
withcolor
.5
white
;
987
fi
;
988
endgroup
;
989
enddef
;
990 991
def
linear_shade
(
expr
p
,
n
,
ca
,
cb
)
=
992
begingroup
;
993
save
a
,
b
;
pair
a
,
b
;
994
set_linear_vector
(
a
,
b
)
(
p
,
n
)
;
995
fill
p
withlinearshade
(
a
,
b
,
ca
,
cb
)
;
996
if
trace_shades
:
997
drawarrow
a
--
b
withpen
pencircle
scaled
1
pt
withcolor
.5
white
;
998
fi
;
999
endgroup
;
1000
enddef
;
1001 1002
string
mfun_defined_cs_pre
[
]
;
numeric
mfun_defined_cs
;
mfun_defined_cs
:
=
0
;
1003 1004
vardef
define_circular_shade
(
expr
a
,
b
,
ra
,
rb
,
ca
,
cb
)
=
1005
mfun_defined_cs
:
=
mfun_defined_cs
+
1
;
1006
mfun_defined_cs_pre
[
mfun_defined_cs
]
:
=
"
sh_type=circular
"
1007
&
mfun_prescript_separator
&
"
sh_domain=0 1
"
1008
&
mfun_prescript_separator
&
"
sh_factor=1
"
1009
&
mfun_prescript_separator
&
"
sh_color_a=
"
&
colordecimals
ca
1010
&
mfun_prescript_separator
&
"
sh_color_b=
"
&
colordecimals
cb
1011
&
mfun_prescript_separator
&
"
sh_center_a=
"
&
ddecimal
a
% (a shifted shadeoffset)
1012
&
mfun_prescript_separator
&
"
sh_center_b=
"
&
ddecimal
b
% (b shifted shadeoffset)
1013
&
mfun_prescript_separator
&
"
sh_radius_a=
"
&
decimal
ra
1014
&
mfun_prescript_separator
&
"
sh_radius_b=
"
&
decimal
rb
1015
;
1016
mfun_defined_cs
1017
enddef
;
1018 1019
vardef
define_linear_shade
(
expr
a
,
b
,
ca
,
cb
)
=
1020
mfun_defined_cs
:
=
mfun_defined_cs
+
1
;
1021
mfun_defined_cs_pre
[
mfun_defined_cs
]
:
=
"
sh_type=linear
"
1022
&
mfun_prescript_separator
&
"
sh_domain=0 1
"
1023
&
mfun_prescript_separator
&
"
sh_factor=1
"
1024
&
mfun_prescript_separator
&
"
sh_color_a=
"
&
colordecimals
ca
1025
&
mfun_prescript_separator
&
"
sh_color_b=
"
&
colordecimals
cb
1026
&
mfun_prescript_separator
&
"
sh_center_a=
"
&
ddecimal
a
% (a shifted shadeoffset)
1027
&
mfun_prescript_separator
&
"
sh_center_b=
"
&
ddecimal
b
% (b shifted shadeoffset)
1028
;
1029
mfun_defined_cs
1030
enddef
;
1031 1032
% I lost the example code that uses this:
1033
%
1034
% vardef define_sampled_linear_shade(expr a,b,n)(text t) =
1035
% mfun_defined_cs := mfun_defined_cs + 1 ;
1036
% mfun_defined_cs_pre[mfun_defined_cs] := "ssh_type=linear"
1037
% & mfun_prescript_separator & "ssh_center_a=" & ddecimal (a shifted shadeoffset)
1038
% & mfun_prescript_separator & "ssh_center_b=" & ddecimal (b shifted shadeoffset)
1039
% & mfun_prescript_separator & "ssh_nofcolors=" & decimal n
1040
% & mfun_prescript_separator & "ssh_domain=" & domstr
1041
% & mfun_prescript_separator & "ssh_extend=" & extstr
1042
% & mfun_prescript_separator & "ssh_colors=" & colstr
1043
% & mfun_prescript_separator & "ssh_bounds=" & bndstr
1044
% & mfun_prescript_separator & "ssh_ranges=" & ranstr
1045
% ;
1046
% mfun_defined_cs
1047
% enddef ;
1048
%
1049
% vardef define_sampled_circular_shade(expr a,b,ra,rb,n)(text t) =
1050
% mfun_defined_cs := mfun_defined_cs + 1 ;
1051
% mfun_defined_cs_pre[mfun_defined_cs] := "ssh_type=circular"
1052
% & mfun_prescript_separator & "ssh_center_a=" & ddecimal (a shifted shadeoffset)
1053
% & mfun_prescript_separator & "ssh_radius_a=" & decimal ra
1054
% & mfun_prescript_separator & "ssh_center_b=" & ddecimal (b shifted shadeoffset)
1055
% & mfun_prescript_separator & "ssh_radius_b=" & decimal rb
1056
% & mfun_prescript_separator & "ssh_nofcolors=" & decimal n
1057
% & mfun_prescript_separator & "ssh_domain=" & domstr
1058
% & mfun_prescript_separator & "ssh_extend=" & extstr
1059
% & mfun_prescript_separator & "ssh_colors=" & colstr
1060
% & mfun_prescript_separator & "ssh_bounds=" & bndstr
1061
% & mfun_prescript_separator & "ssh_ranges=" & ranstr
1062
% ;
1063
% mfun_defined_cs
1064
% enddef ;
1065 1066
% vardef predefined_linear_shade (expr p, n, ca, cb) =
1067
% save a, b, sh ; pair a, b ;
1068
% set_linear_vector(a,b)(p,n) ;
1069
% define_linear_shade (a,b,ca,cb)
1070
% enddef ;
1071
%
1072
% vardef predefined_circular_shade (expr p, n, ca, cb) =
1073
% save ab, r ; pair ab ; numeric r ;
1074
% r := (xpart lrcorner p - xpart llcorner p) ++ (ypart urcorner p - ypart lrcorner p) ;
1075
% set_circular_vector(ab,r)(p,n) ;
1076
% define_circular_shade(ab,ab,0,r,ca,cb)
1077
% enddef ;
1078 1079
% Layers
1080 1081
def
onlayer
primary
name
=
1082
withprescript
"
la_name=
"
&
name
1083
enddef
;
1084 1085
permanent
onlayer
;
1086 1087
% Figures
1088 1089
% def externalfigure primary filename =
1090
% doexternalfigure (filename)
1091
% enddef ;
1092
%
1093
% def doexternalfigure (expr filename) text transformation =
1094
% if true : % a bit incompatible esp scaled 1cm now scaled the natural size
1095
% draw rawtextext("\externalfigure[" & filename & "]") transformation ;
1096
% else :
1097
% draw unitsquare transformation withprescript "fg_name=" & filename ;
1098
% fi ;
1099
% enddef ;
1100 1101
def
withmask
primary
filename
=
1102
withprescript
"
fg_mask=
"
&
filename
1103
enddef
;
1104 1105
vardef
externalfigure
primary
filename
=
1106
mfun_tt_c
:
=
nullpicture
;
1107
mfun_tt_r
:
=
lua.mp.mf_external_figure
(
filename
)
;
1108
addto
mfun_tt_c
doublepath
unitsquare
1109
xscaled
wdpart
mfun_tt_r
1110
yscaled
htpart
mfun_tt_r
1111
withprescript
"
mf_object=figure
"
1112
withprescript
"
fg_name=
"
&
filename
;
1113
;
1114
mfun_tt_c
1115
enddef
;
1116 1117
def
figure
primary
filename
=
1118
rawtextext
(
"
\externalfigure[
"
&
filename
&
"
]
"
)
1119
enddef
;
1120 1121
vardef
svgembeddedfigure
primary
index
=
1122
% mfun_onetime_textext := true ;
1123
rawtextext
(
"
\svgembeddedfigure{
"
&
decimal
index
&
"
}
"
)
1124
enddef
;
1125 1126
permanent
withmask
,
externalfigure
,
figure
;
1127 1128
% Positions
1129 1130
def
register
(
expr
tag
,
width
,
height
,
offset
)
=
1131
% draw image (
1132
addto
currentpicture
doublepath
unitsquare
xscaled
width
yscaled
height
shifted
offset
1133
withprescript
"
ps_label=
"
&
tag
;
1134
% ) ; % no transformations
1135
enddef
;
1136 1137
permanent
register
;
1138 1139
% outlines (todo: pass around less arguments)
1140 1141
numeric
currentoutlinetext
;
currentoutlinetext
:
=
0
;
1142 1143
vardef
mfun_do_outline_text_flush
(
expr
kind
,
n
,
x
,
y
,
c
)
(
text
t
)
=
1144
if
kind
=
"
f
"
:
1145
mfun_do_outline_text_f
(
n
,
x
,
y
,
c
)
(
t
)
1146
elseif
kind
=
"
d
"
:
1147
mfun_do_outline_text_d
(
n
,
x
,
y
,
c
)
(
t
)
1148
elseif
kind
=
"
b
"
:
1149
mfun_do_outline_text_b
(
n
,
x
,
y
,
c
)
(
t
)
1150
elseif
kind
=
"
r
"
:
1151
mfun_do_outline_text_r
(
n
,
x
,
y
,
c
)
(
t
)
1152
elseif
kind
=
"
p
"
:
1153
mfun_do_outline_text_p
(
n
,
x
,
y
,
c
)
(
t
)
1154
elseif
kind
=
"
u
"
:
1155
mfun_do_outline_text_u
(
n
,
x
,
y
,
c
)
(
t
)
1156
else
:
1157
mfun_do_outline_text_n
(
n
,
x
,
y
,
c
)
(
t
)
1158
fi
;
1159
enddef
;
1160 1161
vardef
mfun_do_outline_rule_flush
(
expr
kind
,
x
,
y
,
w
,
h
)
=
1162
% mfun_do_outline_text_flush (kind, 1, x, y, "") (fullsquare xyscaled(w,h))
1163
mfun_do_outline_text_flush
(
kind
,
1
,
x
,
y
,
"
"
)
(
unitsquare
xyscaled
(
w
,
h
)
)
1164
enddef
;
1165 1166
numeric
mfun_do_outline_n
;
mfun_do_outline_n
:
=
0
;
1167 1168
vardef
mfun_do_outline_text_f
(
expr
n
,
x
,
y
,
c
)
(
text
t
)
=
1169
mfun_do_outline_n
:
=
0
;
1170
for
i
=
t
:
1171
mfun_do_outline_n
:
=
mfun_do_outline_n
+
1
;
1172
if
mfun_do_outline_n
=
n
:
fill
else
:
nofill
fi
(
i
shifted
(
x
,
y
)
)
mfun_do_outline_options_f
withpen
pencircle
scaled
0
withprescript
c
;
1173
endfor
;
1174
enddef
;
1175 1176
vardef
mfun_do_outline_text_u
(
expr
n
,
x
,
y
,
c
)
(
text
t
)
=
1177
mfun_do_outline_n
:
=
0
;
1178
for
i
=
t
:
1179
mfun_do_outline_n
:
=
mfun_do_outline_n
+
1
;
1180
if
mfun_do_outline_n
=
n
:
fillup
else
:
nofill
fi
(
i
shifted
(
x
,
y
)
)
mfun_do_outline_options_f
withprescript
c
;
1181
endfor
;
1182
enddef
;
1183 1184
vardef
mfun_do_outline_text_d
(
expr
n
,
x
,
y
,
c
)
(
text
t
)
=
1185
for
i
=
t
:
1186
draw
i
shifted
(
x
,
y
)
mfun_do_outline_options_d
;
1187
endfor
;
1188
enddef
;
1189 1190
vardef
mfun_do_outline_text_p
(
expr
n
,
x
,
y
,
c
)
(
text
t
)
=
1191
for
i
=
t
:
1192
draw
i
shifted
(
x
,
y
)
withprescript
c
;
1193
endfor
;
1194
enddef
;
1195 1196
vardef
mfun_do_outline_text_b
(
expr
n
,
x
,
y
,
c
)
(
text
t
)
=
1197
mfun_do_outline_n
:
=
0
;
1198
for
i
=
t
:
1199
mfun_do_outline_n
:
=
mfun_do_outline_n
+
1
;
1200
if
mfun_do_outline_n
=
n
:
fill
else
:
nofill
fi
(
i
shifted
(
x
,
y
)
)
mfun_do_outline_options_f
;
1201
endfor
;
1202
for
i
=
t
:
1203
draw
i
shifted
(
x
,
y
)
mfun_do_outline_options_d
;
1204
endfor
;
1205
enddef
;
1206 1207
vardef
mfun_do_outline_text_r
(
expr
n
,
x
,
y
,
c
)
(
text
t
)
=
1208
mfun_do_outline_n
:
=
0
;
1209
for
i
=
t
:
1210
draw
i
shifted
(
x
,
y
)
mfun_do_outline_options_d
;
1211
endfor
;
1212
for
i
=
t
:
1213
mfun_do_outline_n
:
=
mfun_do_outline_n
+
1
;
1214
if
mfun_do_outline_n
=
n
:
fill
else
:
nofill
fi
(
i
shifted
(
x
,
y
)
)
mfun_do_outline_options_f
;
1215
endfor
;
1216
enddef
;
1217 1218
vardef
mfun_do_outline_text_n
(
expr
n
,
x
,
y
,
c
)
(
text
t
)
=
1219
mfun_do_outline_n
:
=
0
;
1220
for
i
=
t
:
1221
mfun_do_outline_n
:
=
mfun_do_outline_n
+
1
;
1222
if
mfun_do_outline_n
=
n
:
fill
else
:
nofill
fi
(
i
shifted
(
x
,
y
)
)
;
1223
endfor
;
1224
enddef
;
1225 1226
vardef
mfun_do_outline_text_set_f
(
text
f
)
text
r
=
1227
def
mfun_do_outline_options_f
=
f
enddef
;
1228
def
mfun_do_outline_options_r
=
r
enddef
;
1229
enddef
;
1230 1231
vardef
mfun_do_outline_text_set_u
(
text
f
)
text
r
=
1232
def
mfun_do_outline_options_f
=
f
enddef
;
1233
enddef
;
1234 1235
vardef
mfun_do_outline_text_set_d
(
text
d
)
text
r
=
1236
def
mfun_do_outline_options_d
=
d
enddef
;
1237
def
mfun_do_outline_options_r
=
r
enddef
;
1238
enddef
;
1239 1240
vardef
mfun_do_outline_text_set_b
(
text
f
)
(
text
d
)
text
r
=
1241
def
mfun_do_outline_options_f
=
f
enddef
;
1242
def
mfun_do_outline_options_d
=
d
enddef
;
1243
def
mfun_do_outline_options_r
=
r
enddef
;
1244
enddef
;
1245 1246
vardef
mfun_do_outline_text_set_r
(
text
d
)
(
text
f
)
text
r
=
1247
def
mfun_do_outline_options_d
=
d
enddef
;
1248
def
mfun_do_outline_options_f
=
f
enddef
;
1249
def
mfun_do_outline_options_r
=
r
enddef
;
1250
enddef
;
1251 1252
vardef
mfun_do_outline_text_set_n
text
r
=
1253
def
mfun_do_outline_options_r
=
r
enddef
;
1254
enddef
;
1255 1256
vardef
mfun_do_outline_text_set_p
=
1257
enddef
;
1258 1259
def
mfun_do_outline_options_d
=
enddef
;
1260
def
mfun_do_outline_options_f
=
enddef
;
1261
def
mfun_do_outline_options_r
=
enddef
;
1262 1263
def
outlinetexttopath
(
text
o
,
p
,
n
)
=
1264
scantokens
(
"
numeric
"
&
str
n
&
"
;
"
)
;
1265
scantokens
(
"
path
"
&
str
p
&
"
[];
"
)
;
1266
n
:
=
0
;
1267
for
i
within
o
:
p
[
incr
(
n
)
]
:
=
pathpart
i
;
endfor
;
1268
enddef
;
1269 1270
def
filloutlinetext
(
expr
o
)
=
1271
draw
image
(
1272
save
n
,
m
;
numeric
n
,
m
;
n
:
=
m
:
=
0
;
1273
for
i
within
o
:
1274
n
:
=
n
+
1
;
1275
endfor
;
1276
for
i
within
o
:
1277
m
:
=
m
+
1
;
1278
if
n
=
m
:
1279
eofill
1280
else
:
1281
nofill
1282
fi
pathpart
i
;
1283
endfor
;
1284
)
1285
enddef
;
1286 1287
def
drawoutlinetext
(
expr
o
)
=
1288
draw
image
(
1289
% nicer for properties
1290
for
i
within
o
:
1291
draw
pathpart
i
;
1292
endfor
;
1293
)
1294
enddef
;
1295 1296
vardef
outlinetext
@#
(
expr
t
)
text
rest
=
1297
save
kind
;
string
kind
;
kind
:
=
str
@#
;
1298
currentoutlinetext
:
=
currentoutlinetext
+
1
;
1299
def
mfun_do_outline_options_d
=
enddef
;
1300
def
mfun_do_outline_options_f
=
enddef
;
1301
def
mfun_do_outline_options_r
=
enddef
;
1302
image
(
normaldraw
image
(
1303
% lua.mp.report("set outline text",currentoutlinetext);
1304
lua.mp.mf_outline_text
(
currentoutlinetext
,
t
,
kind
)
;
1305
% lua.mp.report("get outline text",currentoutlinetext);
1306
if
kind
=
"
f
"
:
1307
mfun_do_outline_text_set_f
rest
;
1308
elseif
kind
=
"
d
"
:
1309
mfun_do_outline_text_set_d
rest
;
1310
elseif
kind
=
"
b
"
:
1311
mfun_do_outline_text_set_b
rest
;
1312
elseif
kind
=
"
u
"
:
1313
mfun_do_outline_text_set_f
rest
;
1314
elseif
kind
=
"
r
"
:
1315
mfun_do_outline_text_set_r
rest
;
1316
elseif
kind
=
"
p
"
:
1317
mfun_do_outline_text_set_p
;
1318
else
:
1319
mfun_do_outline_text_set_n
rest
;
1320
fi
;
1321
lua.mp.mf_get_outline_text
(
currentoutlinetext
)
;
1322
)
mfun_do_outline_options_r
;
)
1323
enddef
;
1324 1325 1326
permanent
outlinetexttopath
,
filloutlinetext
,
drawoutlinetext
,
outlinetext
;
1327 1328
% A few helpers:
1329 1330
numeric
mfun_c_b_llx
,
mfun_c_b_h
,
mfun_c_b_w
,
mfun_c_b_l
;
1331 1332
vardef
checkedbounds
(
expr
llx
,
lly
,
urx
,
ury
)
=
1333
mfun_c_b_llx
:
=
min
(
xpart
llcorner
currentpicture
,
llx
)
;
1334
mfun_c_b_urx
:
=
max
(
xpart
urcorner
currentpicture
,
urx
)
;
1335
mfun_c_b_lly
:
=
min
(
ypart
llcorner
currentpicture
,
lly
)
;
1336
mfun_c_b_ury
:
=
max
(
ypart
urcorner
currentpicture
,
ury
)
;
1337
(
mfun_c_b_llx
,
mfun_c_b_lly
)
--
1338
(
mfun_c_b_urx
,
mfun_c_b_lly
)
--
1339
(
mfun_c_b_urx
,
mfun_c_b_ury
)
--
1340
(
mfun_c_b_llx
,
mfun_c_b_ury
)
--
cycle
1341
enddef
;
1342 1343
vardef
checkbounds
(
expr
llx
,
lly
,
urx
,
ury
)
=
1344
setbounds
currentpicture
to
checkedbounds
(
llx
,
lly
,
urx
,
ury
)
;
1345
enddef
;
1346 1347
vardef
strut
(
expr
ht
,
dp
)
=
1348
setbounds
currentpicture
to
checkedbounds
(
0
,
0
,
ht
,
dp
)
;
1349
enddef
;
1350 1351
vardef
rule
(
expr
wd
,
ht
,
dp
)
=
1352
image
(
fill
(
0
,
-
dp
)
--
(
wd
,
-
dp
)
--
(
wd
,
ht
)
--
(
0
,
ht
)
-
-
cycle
)
1353
enddef
;
1354 1355
permanent
checkedbounds
,
checkbounds
,
strut
,
rule
;
1356 1357
% Housekeeping
1358 1359
extra_beginfig
:
=
extra_beginfig
&
"
currentgraphictext := 0 ;
"
;
1360
extra_beginfig
:
=
extra_beginfig
&
"
currentoutlinetext := 0 ;
"
;
1361
extra_endfig
:
=
extra_endfig
&
"
finishsavingdata ;
"
;
1362
extra_endfig
:
=
extra_endfig
&
"
mfun_reset_tex_texts ;
"
;
1363 1364
% Bonus
1365 1366
vardef
verbatim
(
expr
s
)
=
1367
ditto
&
"
\detokenize{
"
&
s
&
"
}
"
&
ditto
1368
enddef
;
1369 1370
permanent
verbatim
;
1371 1372
% New
1373 1374
def
bitmapimage
(
expr
xresolution
,
yresolution
,
data
)
=
1375
image
(
1376
addto
currentpicture
doublepath
unitsquare
1377
withprescript
"
bm_xresolution=
"
&
decimal
xresolution
1378
withprescript
"
bm_yresolution=
"
&
decimal
yresolution
1379
withpostscript
data
;
1380
)
1381
enddef
;
1382 1383
permanent
bitmapimage
;
1384 1385
% Experimental:
1386
%
1387
% property p ; p = properties(withcolor (1,1,0,0)) ;
1388
% fill fullcircle scaled 20cm withproperties p ;
1389 1390
let
property
=
picture
;
permanent
property
;
1391 1392
vardef
properties
(
text
t
)
=
1393
image
(
draw
unitcircle
t
)
1394
enddef
;
1395 1396
def
withproperties
expr
p
=
1397
if
colormodel
p
=
graycolormodel
:
1398
withcolor
greypart
p
1399
elseif
colormodel
p
=
rgbcolormodel
:
1400
withcolor
(
redpart
p
,
greenpart
p
,
bluepart
p
)
1401
elseif
colormodel
p
=
cmykcolormodel
:
1402
withcolor
(
cyanpart
p
,
magentapart
p
,
yellowpart
p
,
blackpart
p
)
1403
fi
1404
withpen
penpart
p
1405
if
length
(
dashpart
p
)
>
0
:
1406
dashed
dashpart
p
1407
fi
1408
if
stackingpart
p
<
>
0
:
1409
withstacking
stackingpart
p
1410
fi
1411
withprescript
prescriptpart
p
1412
withpostscript
postscriptpart
p
1413
enddef
;
1414 1415
permanent
properties
,
withproperties
;
1416 1417
% Experimental:
1418 1419
primarydef
t
asgroup
s
=
% s = isolated|knockout
1420
begingroup
1421
save
temp_p
,
temp_q
,
temp_r
;
1422
picture
temp_p
,
temp_q
;
path
temp_r
;
1423
temp_p
:
=
if
picture
t
:
t
else
:
image
(
draw
t
)
fi
;
1424
temp_r
:
=
boundingbox
temp_p
;
1425
temp_q
:
=
nullpicture
;
1426
addto
temp_q
contour
temp_r
1427
withprescript
"
gr_state=start
"
1428
withprescript
"
gr_type=
"
&
s
1429
;
1430
addto
temp_q
also
temp_p
;
1431
addto
temp_q
contour
temp_r
1432
withprescript
"
gr_state=stop
"
1433
;
1434
temp_q
1435
endgroup
1436
enddef
;
1437 1438
permanent
asgroup
;
1439 1440
% Even more experimental:
1441 1442
pair
mfun_pattern_s
;
mfun_pattern_s
:
=
origin
;
% auto scale to fraction of shape (svg)
1443
boolean
mfun_pattern_f
;
mfun_pattern_f
:
=
false
;
% anchor or not (normally we do that)
1444 1445
def
withpatternscale
primary
s
=
hide
(
mfun_pattern_s
:
=
paired
s
;
)
enddef
;
1446
def
withpatternfloat
primary
s
=
hide
(
mfun_pattern_f
:
=
s
;
)
enddef
;
1447 1448
primarydef
t
withpattern
p
=
1449
begingroup
1450
%
1451
save
temp_q
,
temp_r
;
1452
picture
temp_q
;
path
temp_r
;
1453
% the combination
1454
temp_q
:
=
nullpicture
;
1455
% the pattern
1456
temp_r
:
=
boundingbox
p
;
1457
if
mfun_pattern_s
<
>
origin
:
1458
sx
:
=
(
xpart
mfun_pattern_s
)
*
bbwidth
(
t
)
;
1459
sy
:
=
(
ypart
mfun_pattern_s
)
*
bbheight
(
t
)
;
1460
temp_r
:
=
temp_r
xysized
(
sx
,
sy
)
;
1461
addto
temp_q
contour
temp_r
1462
withprescript
"
pt_state=start
"
1463
withprescript
"
pt_action=set
"
1464
withprescript
"
pt_float=
"
&
tostring
(
mfun_pattern_f
)
1465
;
1466
addto
temp_q
also
(
p
xysized
(
sx
,
sy
)
)
;
1467
else
:
1468
addto
temp_q
contour
temp_r
1469
withprescript
"
pt_state=start
"
1470
withprescript
"
pt_action=set
"
1471
withprescript
"
pt_float=
"
&
tostring
(
mfun_pattern_f
)
1472
;
1473
addto
temp_q
also
p
;
1474
fi
;
1475
addto
temp_q
contour
temp_r
1476
withprescript
"
pt_state=stop
"
1477
withprescript
"
pt_action=set
"
;
1478
% the path
1479
temp_r
:
=
boundingbox
t
;
1480
addto
temp_q
contour
temp_r
1481
withprescript
"
pt_state=start
"
1482
withprescript
"
pt_action=get
"
1483
;
1484
addto
temp_q
contour
temp_r
1485
withprescript
"
pt_state=stop
"
1486
withprescript
"
pt_action=get
"
;
1487
% make sure we fill only t
1488
clip
temp_q
to
t
;
1489
% reset
1490
mfun_pattern_s
:
=
origin
;
1491
mfun_pattern_f
:
=
false
;
1492
% the path
1493
temp_q
1494
endgroup
1495
enddef
;
1496 1497
% Also experimental ... needs to be made better ... so it can change!
1498 1499
string
mfun_auto_align
[
]
;
1500 1501
mfun_auto_align
[
0
]
:
=
"
rt
"
;
1502
mfun_auto_align
[
1
]
:
=
"
urt
"
;
1503
mfun_auto_align
[
2
]
:
=
"
top
"
;
1504
mfun_auto_align
[
3
]
:
=
"
ulft
"
;
1505
mfun_auto_align
[
4
]
:
=
"
lft
"
;
1506
mfun_auto_align
[
5
]
:
=
"
llft
"
;
1507
mfun_auto_align
[
6
]
:
=
"
bot
"
;
1508
mfun_auto_align
[
7
]
:
=
"
lrt
"
;
1509
mfun_auto_align
[
8
]
:
=
"
rt
"
;
1510 1511
def
autoalign
(
expr
n
)
=
1512
scantokens
mfun_auto_align
[
round
(
(
n
mod
360
)
/
45
)
]
1513
enddef
;
1514 1515
% draw textext.autoalign(60) ("\strut oeps 1") ;
1516
% draw textext.autoalign(160)("\strut oeps 2") ;
1517
% draw textext.autoalign(260)("\strut oeps 3") ;
1518
% draw textext.autoalign(360)("\strut oeps 4") ;
1519 1520
% new
1521
%
1522
% passvariable("version","1.0") ;
1523
% passvariable("number",123) ;
1524
% passvariable("string","whatever") ;
1525
% passvariable("point",(1,2)) ;
1526
% passvariable("triplet",(1,2,3)) ;
1527
% passvariable("quad",(1,2,3,4)) ;
1528
% passvariable("boolean",false) ;
1529
% passvariable("path",fullcircle scaled 1cm) ;
1530 1531
% we could use the new lua interface but there is not that much gain i.e.
1532
% we still need to serialize
1533 1534
vardef
mfun_point_to_string
(
expr
p
,
i
)
=
1535
decimal
xpart
(
point
i
of
p
)
&
"
"
&
1536
decimal
ypart
(
point
i
of
p
)
&
"
"
&
1537
decimal
xpart
(
precontrol
i
of
p
)
&
"
"
&
1538
decimal
ypart
(
precontrol
i
of
p
)
&
"
"
&
1539
decimal
xpart
(
postcontrol
i
of
p
)
&
"
"
&
1540
decimal
ypart
(
postcontrol
i
of
p
)
1541
enddef
;
1542 1543
vardef
mfun_transform_to_string
(
expr
t
)
=
1544
decimal
xxpart
t
&
"
"
&
% rx
1545
decimal
xypart
t
&
"
"
&
% sx
1546
decimal
yxpart
t
&
"
"
&
% sy
1547
decimal
yypart
t
&
"
"
&
% ry
1548
decimal
xpart
t
&
"
"
&
% tx
1549
decimal
ypart
t
% ty
1550
enddef
;
1551 1552
vardef
mfun_numeric_to_string
(
expr
n
)
=
1553
decimal
n
1554
enddef
;
1555 1556
vardef
mfun_pair_to_string
(
expr
p
)
=
1557
decimal
xpart
p
&
"
"
&
1558
decimal
ypart
p
1559
enddef
;
1560 1561
vardef
mfun_rgbcolor_to_string
(
expr
c
)
=
1562
decimal
redpart
c
&
"
"
&
1563
decimal
greenpart
c
&
"
"
&
1564
decimal
bluepart
c
1565
enddef
;
1566 1567
vardef
mfun_cmykcolor_to_string
(
expr
c
)
=
1568
decimal
cyanpart
c
&
"
"
&
1569
decimal
magentapart
c
&
"
"
&
1570
decimal
yellowpart
c
&
"
"
&
1571
decimal
blackpart
c
1572
enddef
;
1573 1574
vardef
mfun_pair_to_table
(
expr
p
)
=
1575
"
{
"
&
decimal
xpart
p
&
1576
"
,
"
&
decimal
ypart
p
&
1577
"
}
"
1578
enddef
;
1579 1580
vardef
mfun_point_to_table
(
expr
p
,
i
)
=
1581
"
{
"
&
decimal
xpart
(
point
i
of
p
)
&
1582
"
,
"
&
decimal
ypart
(
point
i
of
p
)
&
1583
"
,
"
&
decimal
xpart
(
precontrol
i
of
p
)
&
1584
"
,
"
&
decimal
ypart
(
precontrol
i
of
p
)
&
1585
"
,
"
&
decimal
xpart
(
postcontrol
i
of
p
)
&
1586
"
,
"
&
decimal
ypart
(
postcontrol
i
of
p
)
&
1587
"
}
"
1588
enddef
;
1589 1590
vardef
mfun_path_to_table
(
expr
p
)
=
1591
"
{
"
&
mfun_point_to_table
(
p
,
0
)
for
i
=
1
upto
length
(
p
)
:
&
"
,
"
&
mfun_point_to_table
(
p
,
i
)
endfor
&
"
}
"
1592
enddef
;
1593 1594
vardef
mfun_rgb_to_table
(
expr
c
)
=
1595
"
{
"
&
decimal
redpart
c
&
1596
"
,
"
&
decimal
greenpart
c
&
1597
"
,
"
&
decimal
bluepart
c
&
1598
"
}
"
1599
enddef
;
1600 1601
vardef
mfun_cmyk_to_table
(
expr
c
)
=
1602
"
{
"
&
decimal
cyanpart
c
&
1603
"
,
"
&
decimal
magentapart
c
&
1604
"
,
"
&
decimal
yellowpart
c
&
1605
"
,
"
&
decimal
blackpart
c
&
1606
"
}
"
1607
enddef
;
1608 1609
vardef
mfun_grey_to_string
(
expr
n
)
=
1610
decimal
n
1611
enddef
;
1612 1613
vardef
mfun_path_to_string
(
expr
p
)
=
1614
mfun_point_to_string
(
p
,
0
)
for
i
=
1
upto
length
(
p
)
:
&
"
"
&
mfun_point_to_string
(
p
,
i
)
endfor
1615
enddef
;
1616 1617
vardef
mfun_boolean_to_string
(
expr
b
)
=
1618
if
b
:
"
true
"
else
:
"
false
"
fi
1619
enddef
;
1620 1621
vardef
tostring
primary
v
=
1622
if
numeric
v
:
mfun_numeric_to_string
(
v
)
1623
elseif
pair
v
:
mfun_pair_to_string
(
v
)
1624
elseif
rgbcolor
v
:
mfun_rgbcolor_to_string
(
v
)
1625
elseif
cmykcolor
v
:
mfun_cmykcolor_to_string
(
v
)
1626
elseif
greycolor
v
:
mfun_greycolor_to_string
(
v
)
1627
elseif
boolean
v
:
mfun_boolean_to_string
(
v
)
1628
elseif
path
v
:
mfun_path_to_string
(
v
)
1629
elseif
transform
v
:
mfun_transform_to_string
(
v
)
1630
else
:
v
1631
fi
1632
enddef
;
1633 1634
vardef
topair
primary
p
=
1635
if
pair
p
:
"
(
"
&
decimal
xpart
p
&
"
,
"
&
decimal
ypart
p
&
"
)
"
1636
elseif
numeric
p
:
"
(
"
&
decimal
p
&
"
,
"
&
decimal
p
&
"
)
"
1637
else
:
"
"
fi
1638
enddef
;
1639 1640
string
dq
;
dq
:
=
char
92
&
char
34
;
1641
string
sq
;
sq
:
=
char
92
&
char
39
;
1642 1643
permanent
dq
,
sq
;
1644 1645
vardef
quote
primary
s
=
sq
&
tostring
(
s
)
&
sq
enddef
;
1646
vardef
quotation
primary
s
=
dq
&
tostring
(
s
)
&
dq
enddef
;
1647 1648
vardef
mfun_tagged_string
(
expr
value
)
=
1649
if
numeric
value
:
"
1:
"
&
mfun_numeric_to_string
(
value
)
1650
elseif
pair
value
:
"
4:
"
&
mfun_pair_to_string
(
value
)
1651
elseif
rgbcolor
value
:
"
5:
"
&
mfun_rgbcolor_to_string
(
value
)
1652
elseif
cmykcolor
value
:
"
6:
"
&
mfun_cmykcolor_to_string
(
value
)
1653
elseif
boolean
value
:
"
3:
"
&
mfun_boolean_to_string
(
value
)
1654
elseif
path
value
:
"
7:
"
&
mfun_path_to_string
(
value
)
1655
elseif
transform
value
:
"
8:
"
&
mfun_transform_to_string
(
value
)
1656
else
:
"
2:
"
&
value
1657
fi
1658
enddef
;
1659 1660
permanent
tostring
,
topair
,
quote
,
quotation
;
1661 1662
% A more flexible variant for passing data to context. We used to construct strings
1663
% but running lua is fast enough so we can gain on string construction in metapost
1664
% which is also not that efficient.
1665 1666
newscriptindex
mfid_passvariable
;
mfid_passvariable
:
=
scriptindex
(
"
passvariable
"
)
;
1667
newscriptindex
mfid_pushvariable
;
mfid_pushvariable
:
=
scriptindex
(
"
pushvariable
"
)
;
1668
newscriptindex
mfid_popvariable
;
mfid_popvariable
:
=
scriptindex
(
"
popvariable
"
)
;
1669 1670
def
passvariable
(
expr
key
,
value
)
=
runscript
mfid_passvariable
key
value
;
enddef
;
1671
def
startpassingvariable
(
expr
key
)
=
runscript
mfid_pushvariable
key
;
enddef
;
1672
def
stoppassingvariable
=
runscript
mfid_popvariable
;
enddef
;
1673 1674
def
passarrayvariable
(
expr
key
)
(
suffix
values
)
(
expr
first
,
last
,
stp
)
=
1675
startpassingvariable
(
key
)
;
1676
for
i
=
first
step
stp
until
last
:
1677
passvariable
(
i
,
values
[
i
]
)
;
1678
endfor
1679
stoppassingvariable
;
1680
enddef
;
1681 1682
permanent
passvariable
,
passarrayvariable
,
startpassingvariable
,
stoppassingvariable
;
1683 1684
% moved here from mp-grap.mpiv
1685 1686
% vardef escaped_format(expr s) =
1687
% "" for n=0 upto length(s) : &
1688
% if ASCII substring (n,n+1) of s = 37 :
1689
% "@"
1690
% else :
1691
% substring (n,n+1) of s
1692
% fi
1693
% endfor
1694
% enddef ;
1695 1696
numeric
mfun_esc_b
;
% begin
1697
numeric
mfun_esc_l
;
% length
1698
string
mfun_esc_s
;
% character
1699 1700
mfun_esc_s
:
=
"
%
"
;
% or: char(37)
1701 1702
% this one is the fastest when we have a match
1703 1704
% vardef escaped_format(expr s) =
1705
% "" for n=0 upto length(s)-1 : &
1706
% % if ASCII substring (n,n+1) of s = 37 :
1707
% if substring (n,n+1) of s = mfun_esc_s :
1708
% "@"
1709
% else :
1710
% substring (n,n+1) of s
1711
% fi
1712
% endfor
1713
% enddef ;
1714 1715
% this one wins when we have no match
1716 1717
vardef
escaped_format
(
expr
s
)
=
1718
mfun_esc_b
:
=
0
;
1719
mfun_esc_l
:
=
length
(
s
)
;
1720
for
n
=
0
upto
mfun_esc_l
-1
:
1721
% if ASCII substring (n,n+1) of s = 37 :
1722
if
substring
(
n
,
n
+1
)
of
s
=
mfun_esc_s
:
1723
if
mfun_esc_b
=
0
:
1724
"
"
1725
fi
1726
if
n
>
=
mfun_esc_b
:
1727
&
(
substring
(
mfun_esc_b
,
n
)
of
s
)
1728
exitif
numeric
begingroup
mfun_esc_b
:
=
n
+1
endgroup
;
% hide
1729
fi
1730
&
"
@
"
1731
fi
1732
endfor
1733
if
mfun_esc_b
=
0
:
1734
s
1735
% elseif mfun_esc_b > 0 :
1736
elseif
mfun_esc_b
<
mfun_esc_l
:
1737
&
(
substring
(
mfun_esc_b
,
mfun_esc_l
)
of
s
)
1738
fi
1739
enddef
;
1740 1741
vardef
strfmt
(
expr
f
,
x
)
=
"
\MPgraphformat{
"
&
escaped_format
(
f
)
&
"
}{
"
&
mfun_tagged_string
(
x
)
&
"
}
"
enddef
;
1742
vardef
varfmt
(
expr
f
,
x
)
=
"
\MPformatted{
"
&
escaped_format
(
f
)
&
"
}{
"
&
mfun_tagged_string
(
x
)
&
"
}
"
enddef
;
1743 1744
vardef
format
@#
(
expr
f
,
x
)
=
textext
@#
(
strfmt
(
f
,
x
)
)
enddef
;
1745
vardef
formatted
@#
(
expr
f
,
x
)
=
textext
@#
(
varfmt
(
f
,
x
)
)
enddef
;
1746 1747
permanent
format
,
formatted
;
1748 1749
% could be this (something to discuss with alan as it involves graph):
1750
%
1751
% vardef format (expr f,x) = lua.mp.graphformat(f,mfun_tagged_string(x) enddef ;
1752
% vardef formatted(expr f,x) = lua.mp.format (f, x) enddef ;
1753
%
1754
% def strfmt = format enddef ; % old
1755
% def varfmt = formatted enddef ; % old
1756 1757
% def fmttext = lua.mp.formatted enddef ;
1758 1759
% new
1760 1761
def
fillup
text
t
=
draw
t
withpostscript
"
both
"
enddef
;
% we use draw because we need the proper boundingbox
1762
def
eofillup
text
t
=
draw
t
withpostscript
"
eoboth
"
enddef
;
% we use draw because we need the proper boundingbox
1763
def
eofill
text
t
=
fill
t
withpostscript
"
evenodd
"
enddef
;
1764
def
nofill
text
t
=
fill
t
withpostscript
"
collect
"
enddef
;
1765
def
nodraw
text
t
=
draw
t
withpostscript
"
collect
"
enddef
;
1766
def
dodraw
text
t
=
draw
t
withpostscript
"
flush
"
enddef
;
1767
% eodraw text t = draw t withpostscript "evenodd" enddef ;
1768
def
dofill
text
t
=
fill
t
withpostscript
"
flush
"
enddef
;
1769
def
eoclip
text
t
=
clip
t
withpostscript
"
evenodd
"
enddef
;
1770 1771
permanent
fillup
,
eofillup
,
eofill
,
nofill
,
nodraw
,
dodraw
,
dofill
,
eoclip
;
1772 1773
% maybe (saves a bogus path but the problem is that it can influence the dimensions):
1774 1775
% def dodraw text t = draw center currentpicture withpostscript "flush" enddef ;
1776
% def dofill text t = fill center currentpicture --cycle withpostscript "flush" enddef ;
1777 1778
% def withrule expr r =
1779
% if (t = "even-odd") or (t = "evenodd") : withpostscript "evenodd" fi
1780
% enddef ;
1781 1782
% A comment will end up on top of the graphic in the output. This can be handy for
1783
% locating a graphic: comment("test graphic").
1784 1785
% This can be a prescript to currentpicture ... we can actually make
1786
%
1787
% setprescript str to picture/path ;
1788
% setpostscript str to picture/path ;
1789 1790
def
special
text
t
=
enddef
;
1791 1792
def
comment
expr
str
=
1793
special
"
metapost.comment[[
"
&
str
&
"
]]
"
;
1794
enddef
;
1795 1796
vardef
report
(
text
t
)
=
1797
lua.mp.report
(
t
)
1798
enddef
;
1799 1800
permanent
comment
,
report
;
1801 1802
% This overloads a dummy:
1803 1804
% todo: use mfid_* cum suis
1805 1806
newscriptindex
mfid_hash_new
;
mfid_hash_new
:
=
scriptindex
(
"
lmt_hash_new
"
)
;
1807
newscriptindex
mfid_hash_dispose
;
mfid_hash_dispose
:
=
scriptindex
(
"
lmt_hash_dispose
"
)
;
1808
newscriptindex
mfid_hash_in
;
mfid_hash_in
:
=
scriptindex
(
"
lmt_hash_in
"
)
;
1809
newscriptindex
mfid_hash_from
;
mfid_hash_from
:
=
scriptindex
(
"
lmt_hash_from
"
)
;
1810
newscriptindex
mfid_hash_to
;
mfid_hash_to
:
=
scriptindex
(
"
lmt_hash_to
"
)
;
1811 1812
def
newhash
=
runscript
mfid_hash_new
enddef
;
1813
def
disposehash
(
expr
n
)
=
runscript
mfid_hash_dispose
n
enddef
;
1814
def
inhash
(
expr
n
,
key
)
=
runscript
mfid_hash_in
n
key
enddef
;
1815
def
fromhash
(
expr
n
,
key
)
=
runscript
mfid_hash_from
n
key
enddef
;
1816
def
tohash
(
expr
n
,
key
,
value
)
=
runscript
mfid_hash_to
n
key
value
enddef
;
1817 1818
vardef
uniquelist
(
suffix
list
)
=
1819
% this can be optimized by passing all values at once and returning
1820
% a result but for now this is ok .. we need an undef foo
1821
save
i
,
j
,
h
;
1822
if
known
lis
[
0
]
:
1823
i
:
=
0
;
1824
j
:
=
-1
;
1825
else
:
1826
i
:
=
1
;
1827
j
:
=
0
;
1828
fi
;
1829
h
:
=
runscript
mfid_hash_new
;
1830
forever
:
1831
exitif
unknown
list
[
i
]
;
1832
if
not
(
runscript
mfid_hash_in
h
list
[
i
]
)
:
1833
j
:
=
j
+
1
;
1834
list
[
j
]
:
=
list
[
i
]
;
1835
runscript
mfid_hash_to
h
list
[
i
]
;
1836
fi
;
1837
i
:
=
i
+
1
;
1838
endfor
;
1839
for
n
=
j
+1
step
1
until
i
-1
:
1840
dispose
(
list
[
n
]
)
1841
endfor
;
1842
runscript
mfid_hash_dispose
h
;
1843
enddef
;
1844 1845
permanent
uniquelist
;
1846 1847
% This influences the decision for a curve or path segment; 1/4096 is the default but
1848
% 10/2048 works quite well.
1849 1850
def
withtolerance
expr
n
=
1851
withprescript
(
"
tolerance=
"
&
decimal
n
)
1852
enddef
;
1853 1854
% fun stuff: randomseed := repeatablerandom("default") ;
1855 1856
newscriptindex
mfid_repeatablerandom
;
mfid_repeatablerandom
:
=
scriptindex
(
"
repeatablerandom
"
)
;
1857 1858
def
repeatablerandom
=
runscript
mfid_repeatablerandom
enddef
;
1859 1860