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