mlib-mpf.lmt /size: 25 Kb    last modification: 2021-10-28 13:51
1
if
not
modules
then
modules
=
{
}
end
modules
[
'
mlib-mpf
'
]
=
{
2
version
=
1
.
001
,
3
comment
=
"
companion to mlib-ctx.mkiv
"
,
4
author
=
"
Hans Hagen, PRAGMA-ADE, Hasselt NL
"
,
5
copyright
=
"
PRAGMA ADE / ConTeXt Development Team
"
,
6
license
=
"
see context related readme files
"
,
7
}
8 9
-- moved from mlib-lua:
10 11
local
type
,
tostring
,
tonumber
,
select
,
loadstring
=
type
,
tostring
,
tonumber
,
select
,
loadstring
12
local
find
,
gsub
=
string
.
find
,
string
.
gsub
13
local
concat
=
table
.
concat
14 15
local
formatters
=
string
.
formatters
16
local
lpegmatch
=
lpeg
.
match
17
local
lpegpatterns
=
lpeg
.
patterns
18 19
local
P
,
S
,
Ct
,
Cs
,
Cc
,
C
=
lpeg
.
P
,
lpeg
.
S
,
lpeg
.
Ct
,
lpeg
.
Cs
,
lpeg
.
Cc
,
lpeg
.
C
20 21
local
report_luarun
=
logs
.
reporter
(
"
metapost
"
,
"
lua
"
)
22
local
report_script
=
logs
.
reporter
(
"
metapost
"
,
"
script
"
)
23
local
report_message
=
logs
.
reporter
(
"
metapost
"
)
24 25
local
trace_luarun
=
false
trackers
.
register
(
"
metapost.lua
"
,
function
(
v
)
trace_luarun
=
v
end
)
26
local
trace_script
=
false
trackers
.
register
(
"
metapost.script
"
,
function
(
v
)
trace_script
=
v
end
)
27 28
local
be_tolerant
=
true
directives
.
register
(
"
metapost.lua.tolerant
"
,
function
(
v
)
be_tolerant
=
v
end
)
29 30
local
set
=
mp
.
set
31
local
get
=
mp
.
get
32
local
aux
=
mp
.
aux
33
local
scan
=
mp
.
scan
34 35
do
36 37
-- serializers
38 39
local
f_integer
=
formatters
[
"
%i
"
]
40
local
f_numeric
=
formatters
[
"
%F
"
]
41 42
-- no %n as that can produce -e notation and that is not so nice for scaled but maybe we
43
-- should then switch between ... i.e. make a push/pop for the formatters here ... not now.
44 45
local
f_integer
=
formatters
[
"
%i
"
]
46
local
f_numeric
=
formatters
[
"
%F
"
]
47
local
f_pair
=
formatters
[
"
(%F,%F)
"
]
48
local
f_ctrl
=
formatters
[
"
(%F,%F) .. controls (%F,%F) and (%F,%F)
"
]
49
local
f_triplet
=
formatters
[
"
(%F,%F,%F)
"
]
50
local
f_quadruple
=
formatters
[
"
(%F,%F,%F,%F)
"
]
51
local
f_transform
=
formatters
[
"
totransform(%F,%F,%F,%F,%F,%F)
"
]
52
local
f_pen
=
formatters
[
"
(pencircle transformed totransform(%F,%F,%F,%F,%F,%F))
"
]
53 54
local
f_points
=
formatters
[
"
%p
"
]
55
local
f_pair_pt
=
formatters
[
"
(%p,%p)
"
]
56
local
f_ctrl_pt
=
formatters
[
"
(%p,%p) .. controls (%p,%p) and (%p,%p)
"
]
57
local
f_triplet_pt
=
formatters
[
"
(%p,%p,%p)
"
]
58
local
f_quadruple_pt
=
formatters
[
"
(%p,%p,%p,%p)
"
]
59 60
local
r
=
P
(
'
%
'
)
/
"
percent
"
61
+
P
(
'
"
'
)
/
"
dquote
"
62
+
P
(
'
\n
'
)
/
"
crlf
"
63
-- + P(' ') / "space"
64
local
a
=
Cc
(
"
&
"
)
65
local
q
=
Cc
(
'
"
'
)
66
local
p
=
Cs
(
q
*
(
r
*
a
)
^
-1
*
(
a
*
r
*
(
P
(
-1
)
+
a
)
+
P
(
1
)
)
^
0
*
q
)
67 68
mp
.
cleaned
=
function
(
s
)
return
lpegmatch
(
p
,
s
)
or
s
end
69 70
-- management
71 72
-- sometimes we gain (e.g. .5 sec on the sync test)
73 74
local
cache
=
table
.
makeweak
(
)
75 76
local
runscripts
=
{
}
77
local
runnames
=
{
}
78
local
runmodes
=
{
}
79
local
nofscripts
=
0
80 81
local
function
registerscript
(
name
,
mode
,
f
)
82
nofscripts
=
nofscripts
+
1
83
if
not
f
then
84
f
=
mode
85
mode
=
"
buffered
"
86
end
87
if
f
then
88
runscripts
[
nofscripts
]
=
f
89
runnames
[
name
]
=
nofscripts
90
else
91
runscripts
[
nofscripts
]
=
name
92
end
93
runmodes
[
nofscripts
]
=
mode
94
if
trace_script
then
95
report_script
(
"
registering %s script %a as %i
"
,
mode
,
name
,
nofscripts
)
96
end
97
return
nofscripts
98
end
99 100
metapost
.
registerscript
=
registerscript
101 102
function
metapost
.
registerdirect
(
name
,
f
)
103
registerscript
(
name
,
"
direct
"
,
f
)
104
end
105 106
function
metapost
.
registertokens
(
name
,
f
)
107
registerscript
(
name
,
"
tokens
"
,
f
)
108
end
109 110
function
metapost
.
scriptindex
(
name
)
111
local
index
=
runnames
[
name
]
or
0
112
if
trace_script
then
113
report_script
(
"
fetching scriptindex %i of %a
"
,
index
,
name
)
114
end
115
return
index
116
end
117 118
-- The gbuffer sharing and such is not really needed now but make a dent when
119
-- we have a high volume of simpel calls (loops) so we keep it around for a
120
-- while.
121 122
local
nesting
=
0
123
local
runs
=
0
124
local
gbuffer
=
{
}
125
local
buffer
=
gbuffer
126
local
n
=
0
127 128
local
function
mpdirect
(
a
)
129
n
=
n
+
1
buffer
[
n
]
=
a
130
end
131 132
local
function
mpflush
(
separator
)
133
buffer
[
1
]
=
concat
(
buffer
,
separator
or
"
"
,
1
,
n
)
134
n
=
1
135
end
136 137
function
metapost
.
getbuffer
(
)
138
local
b
=
{
}
139
for
i
=
1
,
n
do
140
b
[
i
]
=
buffer
141
end
142
return
b
,
n
143
end
144 145
function
metapost
.
setbuffer
(
b
,
s
)
146
n
=
0
147
for
i
=
1
,
(
s
or
#
b
)
do
148
local
bi
=
b
[
i
]
149
if
bi
then
150
n
=
n
+
1
151
buffer
[
n
]
=
tostring
(
bi
)
152
end
153
end
154
end
155 156
function
metapost
.
runscript
(
code
)
157
nesting
=
nesting
+
1
158
runs
=
runs
+
1
159 160
local
index
=
type
(
code
)
=
=
"
number
"
161
local
f
162
local
result
163 164
if
index
then
165
f
=
runscripts
[
code
]
166
if
not
f
then
167
report_luarun
(
"
%i: bad index: %s
"
,
nesting
,
code
)
168
elseif
trace_luarun
then
169
report_luarun
(
"
%i: index: %i
"
,
nesting
,
code
)
170
end
171
local
m
=
runmodes
[
code
]
172
if
m
=
=
"
direct
"
then
173
result
=
f
(
)
174
if
trace_luarun
then
175
report_luarun
(
"
%i: direct: %a
"
,
nesting
,
type
(
result
)
)
176
end
177
nesting
=
nesting
-
1
178
return
result
,
true
-- string and tables as string and objects
179
elseif
m
=
=
"
tokens
"
then
180
result
=
f
(
)
181
if
trace_luarun
then
182
report_luarun
(
"
%i: tokens: %a
"
,
nesting
,
type
(
result
)
)
183
end
184
nesting
=
nesting
-
1
185
return
result
-- string and tables as text to be scanned
186
else
187
if
trace_luarun
then
188
report_luarun
(
"
%i: no mode
"
,
nesting
)
189
end
190
end
191
else
192
if
trace_luarun
then
193
report_luarun
(
"
%i: code: %s
"
,
nesting
,
code
)
194
end
195
f
=
cache
[
code
]
196
if
not
f
then
197
f
=
loadstring
(
"
return
"
.
.
code
)
198
if
f
then
199
cache
[
code
]
=
f
200
elseif
be_tolerant
then
201
f
=
loadstring
(
code
)
202
if
f
then
203
cache
[
code
]
=
f
204
end
205
end
206
end
207
end
208 209
-- returning nil is more efficient and a signal not to scan in mp
210 211
if
f
then
212 213
local
lbuffer
,
ln
214 215
if
nesting
=
=
1
then
216
buffer
=
gbuffer
217
n
=
0
218
else
219
lbuffer
=
buffer
220
ln
=
n
221
buffer
=
{
}
222
n
=
0
223
end
224 225
result
=
f
(
)
226
if
result
then
227
local
t
=
type
(
result
)
228
-- we can consider to use the injector for tables but then we need to
229
-- check if concatination is expected so best keep this!
230
if
t
=
=
"
number
"
or
t
=
=
"
boolean
"
then
231
-- native types
232
elseif
t
=
=
"
string
"
or
t
=
=
"
table
"
then
233
-- (concatenated) passed to scantokens
234
else
235
-- scantokens
236
result
=
tostring
(
result
)
237
end
238
if
trace_luarun
then
239
report_luarun
(
"
%i: %s result: %s
"
,
nesting
,
t
,
result
)
240
end
241
elseif
n
=
=
0
then
242
-- result = ""
243
result
=
nil
-- no scantokens done then
244
if
trace_luarun
then
245
report_luarun
(
"
%i: no buffered result
"
,
nesting
)
246
end
247
elseif
n
=
=
1
then
248
result
=
buffer
[
1
]
249
if
trace_luarun
then
250
report_luarun
(
"
%i: 1 buffered result: %s
"
,
nesting
,
result
)
251
end
252
else
253
-- the space is why we sometimes have collectors
254
if
nesting
=
=
1
then
255
-- if we had no space we could pass result directly in lmtx
256
result
=
concat
(
buffer
,
"
"
,
1
,
n
)
257
if
n
>
500
or
#
result
>
10000
then
258
gbuffer
=
{
}
-- newtable(20,0)
259
lbuffer
=
gbuffer
260
end
261
else
262
-- if we had no space we could pass result directly in lmtx
263
result
=
concat
(
buffer
,
"
"
)
264
end
265
if
trace_luarun
then
266
report_luarun
(
"
%i: %i buffered results: %s
"
,
nesting
,
n
,
result
)
267
end
268
end
269 270
if
nesting
=
=
1
then
271
n
=
0
272
else
273
buffer
=
lbuffer
274
n
=
ln
275
end
276 277
else
278
report_luarun
(
"
%i: no result, invalid code: %s
"
,
nesting
,
code
)
279
result
=
"
"
280
end
281 282
nesting
=
nesting
-
1
283 284
return
result
285
end
286 287
function
metapost
.
nofscriptruns
(
)
288
local
c
=
mplib
.
getcallbackstate
(
)
289
return
c
.
count
,
string
.
format
(
290
"
%s (file: %s, text: %s, script: %s, log: %s)
"
,
291
c
.
count
,
c
.
file
,
c
.
text
,
c
.
script
,
c
.
log
292
)
293
end
294 295
-- writers
296 297
local
function
rawmpp
(
value
)
298
n
=
n
+
1
299
local
t
=
type
(
value
)
300
if
t
=
=
"
number
"
then
301
buffer
[
n
]
=
f_numeric
(
value
)
302
elseif
t
=
=
"
string
"
then
303
buffer
[
n
]
=
value
304
elseif
t
=
=
"
table
"
then
305
if
#
t
=
=
6
then
306
buffer
[
n
]
=
"
totransform(
"
.
.
concat
(
value
,
"
,
"
)
.
.
"
)
"
307
else
308
buffer
[
n
]
=
"
(
"
.
.
concat
(
value
,
"
,
"
)
.
.
"
)
"
309
end
310
else
-- boolean or whatever
311
buffer
[
n
]
=
tostring
(
value
)
312
end
313
end
314 315
local
function
mpprint
(
first
,
second
,
...
)
316
if
second
=
=
nil
then
317
if
first
~
=
nil
then
318
rawmpp
(
first
)
319
end
320
else
321
for
i
=
1
,
select
(
"
#
"
,
first
,
second
,
...
)
do
322
local
value
=
(
select
(
i
,
first
,
second
,
...
)
)
323
if
value
~
=
nil
then
324
rawmpp
(
value
)
325
end
326
end
327
end
328
end
329 330
local
function
mpp
(
value
)
331
n
=
n
+
1
332
local
t
=
type
(
value
)
333
if
t
=
=
"
number
"
then
334
buffer
[
n
]
=
f_numeric
(
value
)
335
elseif
t
=
=
"
string
"
then
336
buffer
[
n
]
=
lpegmatch
(
p
,
value
)
337
elseif
t
=
=
"
table
"
then
338
if
#
t
>
4
then
339
buffer
[
n
]
=
"
"
340
else
341
buffer
[
n
]
=
"
(
"
.
.
concat
(
value
,
"
,
"
)
.
.
"
)
"
342
end
343
else
-- boolean or whatever
344
buffer
[
n
]
=
tostring
(
value
)
345
end
346
end
347 348
local
function
mpvprint
(
first
,
second
,
...
)
-- variable print
349
if
second
=
=
nil
then
350
if
first
~
=
nil
then
351
mpp
(
first
)
352
end
353
else
354
for
i
=
1
,
select
(
"
#
"
,
first
,
second
,
...
)
do
355
local
value
=
(
select
(
i
,
first
,
second
,
...
)
)
356
if
value
~
=
nil
then
357
mpp
(
value
)
358
end
359
end
360
end
361
end
362 363
local
function
mpstring
(
value
)
364
n
=
n
+
1
365
buffer
[
n
]
=
lpegmatch
(
p
,
value
)
366
end
367 368
local
function
mpboolean
(
b
)
369
n
=
n
+
1
370
buffer
[
n
]
=
b
and
"
true
"
or
"
false
"
371
end
372 373
local
function
mpnumeric
(
f
)
374
n
=
n
+
1
375
if
not
f
or
f
=
=
0
then
376
buffer
[
n
]
=
"
0
"
377
else
378
buffer
[
n
]
=
f_numeric
(
f
)
379
end
380
end
381 382
local
function
mpinteger
(
i
)
383
n
=
n
+
1
384
-- buffer[n] = i and f_integer(i) or "0"
385
buffer
[
n
]
=
i
or
"
0
"
386
end
387 388
local
function
mppoints
(
i
)
389
n
=
n
+
1
390
if
not
i
or
i
=
=
0
then
391
buffer
[
n
]
=
"
0pt
"
392
else
393
buffer
[
n
]
=
f_points
(
i
)
394
end
395
end
396 397
local
function
mppair
(
x
,
y
)
398
n
=
n
+
1
399
if
type
(
x
)
=
=
"
table
"
then
400
buffer
[
n
]
=
f_pair
(
x
[
1
]
,
x
[
2
]
)
401
else
402
buffer
[
n
]
=
f_pair
(
x
,
y
or
x
)
403
end
404
end
405 406
local
function
mppairpoints
(
x
,
y
)
407
n
=
n
+
1
408
if
type
(
x
)
=
=
"
table
"
then
409
buffer
[
n
]
=
f_pair_pt
(
x
[
1
]
,
x
[
2
]
)
410
else
411
buffer
[
n
]
=
f_pair_pt
(
x
,
y
or
x
)
412
end
413
end
414 415
local
function
mptriplet
(
x
,
y
,
z
)
416
n
=
n
+
1
417
if
type
(
x
)
=
=
"
table
"
then
418
buffer
[
n
]
=
f_triplet
(
x
[
1
]
,
x
[
2
]
,
x
[
3
]
)
419
else
420
buffer
[
n
]
=
f_triplet
(
x
,
y
,
z
)
421
end
422
end
423 424
local
function
mptripletpoints
(
x
,
y
,
z
)
425
n
=
n
+
1
426
if
type
(
x
)
=
=
"
table
"
then
427
buffer
[
n
]
=
f_triplet_pt
(
x
[
1
]
,
x
[
2
]
,
x
[
3
]
)
428
else
429
buffer
[
n
]
=
f_triplet_pt
(
x
,
y
,
z
)
430
end
431
end
432 433
local
function
mpquadruple
(
w
,
x
,
y
,
z
)
434
n
=
n
+
1
435
if
type
(
w
)
=
=
"
table
"
then
436
buffer
[
n
]
=
f_quadruple
(
w
[
1
]
,
w
[
2
]
,
w
[
3
]
,
w
[
4
]
)
437
else
438
buffer
[
n
]
=
f_quadruple
(
w
,
x
,
y
,
z
)
439
end
440
end
441 442
local
function
mpquadruplepoints
(
w
,
x
,
y
,
z
)
443
n
=
n
+
1
444
if
type
(
w
)
=
=
"
table
"
then
445
buffer
[
n
]
=
f_quadruple_pt
(
w
[
1
]
,
w
[
2
]
,
w
[
3
]
,
w
[
4
]
)
446
else
447
buffer
[
n
]
=
f_quadruple_pt
(
w
,
x
,
y
,
z
)
448
end
449
end
450 451
local
function
mptransform
(
x
,
y
,
xx
,
xy
,
yx
,
yy
)
452
n
=
n
+
1
453
if
type
(
x
)
=
=
"
table
"
then
454
buffer
[
n
]
=
f_transform
(
x
[
1
]
,
x
[
2
]
,
x
[
3
]
,
x
[
4
]
,
x
[
5
]
,
x
[
6
]
)
455
else
456
buffer
[
n
]
=
f_transform
(
x
,
y
,
xx
,
xy
,
yx
,
yy
)
457
end
458
end
459 460
local
function
mpcolor
(
c
,
m
,
y
,
k
)
461
n
=
n
+
1
462
if
type
(
c
)
=
=
"
table
"
then
463
local
l
=
#
c
464
if
l
=
=
4
then
465
buffer
[
n
]
=
f_quadruple
(
c
[
1
]
,
c
[
2
]
,
c
[
3
]
,
c
[
4
]
)
466
elseif
l
=
=
3
then
467
buffer
[
n
]
=
f_triplet
(
c
[
1
]
,
c
[
2
]
,
c
[
3
]
)
468
else
469
buffer
[
n
]
=
f_numeric
(
c
[
1
]
)
470
end
471
else
472
if
k
then
473
buffer
[
n
]
=
f_quadruple
(
c
,
m
,
y
,
k
)
474
elseif
y
then
475
buffer
[
n
]
=
f_triplet
(
c
,
m
,
y
)
476
else
477
buffer
[
n
]
=
f_numeric
(
c
)
478
end
479
end
480
end
481 482
-- we have three kind of connectors:
483
--
484
-- .. ... -- (true)
485 486
local
function
mp_path
(
f2
,
f6
,
t
,
connector
,
cycle
)
487
if
type
(
t
)
=
=
"
table
"
then
488
local
tn
=
#
t
489
if
tn
=
=
1
then
490
local
t1
=
t
[
1
]
491
n
=
n
+
1
492
if
t
.
pen
then
493
buffer
[
n
]
=
f_pen
(
unpack
(
t1
)
)
494
else
495
buffer
[
n
]
=
f2
(
t1
[
1
]
,
t1
[
2
]
)
496
end
497
elseif
tn
>
0
then
498
if
connector
=
=
true
or
connector
=
=
nil
then
499
connector
=
"
..
"
500
elseif
connector
=
=
false
then
501
connector
=
"
--
"
502
end
503
if
cycle
=
=
nil
then
504
cycle
=
t
.
cycle
505
if
cycle
=
=
nil
then
506
cycle
=
true
507
end
508
end
509
local
six
=
connector
=
=
"
..
"
-- otherwise we use whatever gets asked for
510
local
controls
=
connector
-- whatever
511
local
a
=
t
[
1
]
512
local
b
=
t
[
2
]
513
n
=
n
+
1
514
buffer
[
n
]
=
"
(
"
515
n
=
n
+
1
516
if
six
and
#
a
=
=
6
and
#
b
=
=
6
then
517
buffer
[
n
]
=
f6
(
a
[
1
]
,
a
[
2
]
,
a
[
5
]
,
a
[
6
]
,
b
[
3
]
,
b
[
4
]
)
518
controls
=
"
..
"
519
else
520
buffer
[
n
]
=
f2
(
a
[
1
]
,
a
[
2
]
)
521
controls
=
connector
522
end
523
for
i
=
2
,
tn
-1
do
524
a
=
b
525
b
=
t
[
i
+
1
]
526
n
=
n
+
1
527
buffer
[
n
]
=
connector
528
n
=
n
+
1
529
if
six
and
#
a
=
=
6
and
#
b
=
=
6
then
530
buffer
[
n
]
=
f6
(
a
[
1
]
,
a
[
2
]
,
a
[
5
]
,
a
[
6
]
,
b
[
3
]
,
b
[
4
]
)
531
controls
=
"
..
"
532
else
533
buffer
[
n
]
=
f2
(
a
[
1
]
,
a
[
2
]
)
534
controls
=
connector
535
end
536
end
537
n
=
n
+
1
538
buffer
[
n
]
=
connector
539
a
=
b
540
b
=
t
[
1
]
541
n
=
n
+
1
542
if
cycle
then
543
if
six
and
#
a
=
=
6
and
#
b
=
=
6
then
544
buffer
[
n
]
=
f6
(
a
[
1
]
,
a
[
2
]
,
a
[
5
]
,
a
[
6
]
,
b
[
3
]
,
b
[
4
]
)
545
controls
=
"
..
"
546
else
547
buffer
[
n
]
=
f2
(
a
[
1
]
,
a
[
2
]
)
548
controls
=
connector
549
end
550
n
=
n
+
1
551
buffer
[
n
]
=
connector
552
n
=
n
+
1
553
buffer
[
n
]
=
"
cycle
"
554
else
555
buffer
[
n
]
=
f2
(
a
[
1
]
,
a
[
2
]
)
556
end
557
n
=
n
+
1
558
buffer
[
n
]
=
"
)
"
559
end
560
end
561
end
562 563
local
function
mppath
(
...
)
564
mp_path
(
f_pair
,
f_ctrl
,
...
)
565
end
566 567
local
function
mppathpoints
(
...
)
568
mp_path
(
f_pair_pt
,
f_ctrl_pt
,
...
)
569
end
570 571
local
function
mpsize
(
t
)
572
n
=
n
+
1
573
buffer
[
n
]
=
type
(
t
)
=
=
"
table
"
and
f_numeric
(
#
t
)
or
"
0
"
574
end
575 576
local
replacer
=
lpeg
.
replacer
(
"
@
"
,
"
%%
"
)
577 578
local
function
mpfprint
(
fmt
,
...
)
579
n
=
n
+
1
580
if
not
find
(
fmt
,
"
%
"
,
1
,
true
)
then
581
fmt
=
lpegmatch
(
replacer
,
fmt
)
582
end
583
buffer
[
n
]
=
formatters
[
fmt
]
(
...
)
584
end
585 586
local
function
mpquoted
(
fmt
,
s
,
...
)
587
if
s
then
588
n
=
n
+
1
589
if
not
find
(
fmt
,
"
%
"
,
1
,
true
)
then
590
fmt
=
lpegmatch
(
replacer
,
fmt
)
591
end
592
-- buffer[n] = '"' .. formatters[fmt](s,...) .. '"'
593
buffer
[
n
]
=
lpegmatch
(
p
,
formatters
[
fmt
]
(
s
,
...
)
)
594
elseif
fmt
then
595
n
=
n
+
1
596
-- buffer[n] = '"' .. fmt .. '"'
597
buffer
[
n
]
=
lpegmatch
(
p
,
fmt
)
598
else
599
-- something is wrong
600
end
601
end
602 603
aux
.
direct
=
mpdirect
604
aux
.
flush
=
mpflush
605 606
aux
.
print
=
mpprint
607
aux
.
vprint
=
mpvprint
608
aux
.
boolean
=
mpboolean
609
aux
.
string
=
mpstring
610
aux
.
numeric
=
mpnumeric
611
aux
.
number
=
mpnumeric
612
aux
.
integer
=
mpinteger
613
aux
.
points
=
mppoints
614
aux
.
pair
=
mppair
615
aux
.
pairpoints
=
mppairpoints
616
aux
.
triplet
=
mptriplet
617
aux
.
tripletpoints
=
mptripletpoints
618
aux
.
quadruple
=
mpquadruple
619
aux
.
quadruplepoints
=
mpquadruplepoints
620
aux
.
path
=
mppath
621
aux
.
pathpoints
=
mppathpoints
622
aux
.
size
=
mpsize
623
aux
.
fprint
=
mpfprint
624
aux
.
quoted
=
mpquoted
625
aux
.
transform
=
mptransform
626
aux
.
color
=
mpcolor
627 628
-- for the moment
629 630
local
function
mpdraw
(
lines
,
list
)
-- n * 4
631
if
list
then
632
local
c
=
#
lines
633
for
i
=
1
,
c
do
634
local
ci
=
lines
[
i
]
635
local
ni
=
#
ci
636
n
=
n
+
1
buffer
[
n
]
=
i
<
c
and
"
d(
"
or
"
D(
"
637
for
j
=
1
,
ni
,
2
do
638
local
l
=
j
+
1
639
n
=
n
+
1
buffer
[
n
]
=
ci
[
j
]
640
n
=
n
+
1
buffer
[
n
]
=
"
,
"
641
n
=
n
+
1
buffer
[
n
]
=
ci
[
l
]
642
n
=
n
+
1
buffer
[
n
]
=
l
<
ni
and
"
)--(
"
or
"
);
"
643
end
644
end
645
else
646
local
l
=
#
lines
647
local
m
=
l
-
4
648
for
i
=
1
,
l
,
4
do
649
n
=
n
+
1
buffer
[
n
]
=
i
<
m
and
"
d(
"
or
"
D(
"
650
n
=
n
+
1
buffer
[
n
]
=
lines
[
i
]
651
n
=
n
+
1
buffer
[
n
]
=
"
,
"
652
n
=
n
+
1
buffer
[
n
]
=
lines
[
i
+
1
]
653
n
=
n
+
1
buffer
[
n
]
=
"
)--(
"
654
n
=
n
+
1
buffer
[
n
]
=
lines
[
i
+
2
]
655
n
=
n
+
1
buffer
[
n
]
=
"
,
"
656
n
=
n
+
1
buffer
[
n
]
=
lines
[
i
+
3
]
657
n
=
n
+
1
buffer
[
n
]
=
"
);
"
658
end
659
end
660
end
661 662
local
function
mpfill
(
lines
,
list
)
663
if
list
then
664
local
c
=
#
lines
665
for
i
=
1
,
c
do
666
local
ci
=
lines
[
i
]
667
local
ni
=
#
ci
668
n
=
n
+
1
buffer
[
n
]
=
i
<
c
and
"
f(
"
or
"
F(
"
669
for
j
=
1
,
ni
,
2
do
670
local
l
=
j
+
1
671
n
=
n
+
1
buffer
[
n
]
=
ci
[
j
]
672
n
=
n
+
1
buffer
[
n
]
=
"
,
"
673
n
=
n
+
1
buffer
[
n
]
=
ci
[
l
]
674
n
=
n
+
1
buffer
[
n
]
=
l
<
ni
and
"
)--(
"
or
"
)--C;
"
675
end
676
end
677
else
678
local
l
=
#
lines
679
local
m
=
l
-
4
680
for
i
=
1
,
l
,
4
do
681
n
=
n
+
1
buffer
[
n
]
=
i
<
m
and
"
f(
"
or
"
F(
"
682
n
=
n
+
1
buffer
[
n
]
=
lines
[
i
]
683
n
=
n
+
1
buffer
[
n
]
=
"
,
"
684
n
=
n
+
1
buffer
[
n
]
=
lines
[
i
+
1
]
685
n
=
n
+
1
buffer
[
n
]
=
"
)--(
"
686
n
=
n
+
1
buffer
[
n
]
=
lines
[
i
+
2
]
687
n
=
n
+
1
buffer
[
n
]
=
"
,
"
688
n
=
n
+
1
buffer
[
n
]
=
lines
[
i
+
3
]
689
n
=
n
+
1
buffer
[
n
]
=
"
)--C;
"
690
end
691
end
692
end
693 694
aux
.
draw
=
mpdraw
695
aux
.
fill
=
mpfill
696 697
for
k
,
v
in
next
,
aux
do
mp
[
k
]
=
v
end
698 699
-- mp.print = table.setmetatablecall(aux, function(t,...)
700
-- mpprint(...)
701
-- end)
702 703
mp
.
print
=
table
.
setmetatablecall
(
aux
,
function
(
t
,
first
,
second
,
...
)
704
if
second
=
=
nil
then
705
if
first
~
=
nil
then
706
rawmpp
(
first
)
707
end
708
else
709
for
i
=
1
,
select
(
"
#
"
,
first
,
second
,
...
)
do
710
local
value
=
(
select
(
i
,
first
,
second
,
...
)
)
711
if
value
~
=
nil
then
712
rawmpp
(
value
)
713
end
714
end
715
end
716
end
)
717 718
end
719 720
do
721 722
local
mpnumeric
=
mp
.
numeric
723
local
scanstring
=
scan
.
string
724
local
scriptindex
=
metapost
.
scriptindex
725 726
function
mp
.
mf_script_index
(
name
)
727
local
index
=
scriptindex
(
name
)
728
-- report_script("method %i, name %a, index %i",1,name,index)
729
mpnumeric
(
index
)
730
end
731 732
-- once bootstrapped ... (needs pushed mpx instances)
733 734
metapost
.
registerdirect
(
"
scriptindex
"
,
function
(
)
735
return
scriptindex
(
scanstring
(
)
)
736
end
)
737 738
end
739 740
function
mp
.
n
(
t
)
-- used ?
741
return
type
(
t
)
=
=
"
table
"
and
#
t
or
0
742
end
743 744
do
745 746
-- experiment: names can change
747 748
local
mppath
=
aux
.
path
749
local
mpsize
=
aux
.
size
750 751
local
whitespace
=
lpegpatterns
.
whitespace
752
local
newline
=
lpegpatterns
.
newline
753
local
setsep
=
newline
^
2
754
local
comment
=
(
S
(
"
#%
"
)
+
P
(
"
--
"
)
)
*
(
1
-
newline
)
^
0
*
(
whitespace
-
setsep
)
^
0
755
local
value
=
(
1
-
whitespace
)
^
1
/
tonumber
756
local
entry
=
Ct
(
value
*
whitespace
*
value
)
757
local
set
=
Ct
(
(
entry
*
(
whitespace
-
setsep
)
^
0
*
comment
^
0
)
^
1
)
758
local
series
=
Ct
(
(
set
*
whitespace
^
0
)
^
1
)
759 760
local
pattern
=
whitespace
^
0
*
series
761 762
local
datasets
=
{
}
763
mp
.
datasets
=
datasets
764 765
function
mp
.
dataset
(
str
)
766
return
lpegmatch
(
pattern
,
str
)
767
end
768 769
function
datasets
.
load
(
tag
,
filename
)
770
if
not
filename
then
771
tag
,
filename
=
file
.
basename
(
tag
)
,
tag
772
end
773
local
data
=
lpegmatch
(
pattern
,
io
.
loaddata
(
filename
)
or
"
"
)
774
datasets
[
tag
]
=
{
775
data
=
data
,
776
line
=
function
(
n
)
mppath
(
data
[
n
or
1
]
)
end
,
777
size
=
function
(
)
mpsize
(
data
)
end
,
778
}
779
end
780 781
table
.
setmetatablecall
(
datasets
,
function
(
t
,
k
,
f
,
...
)
782
local
d
=
datasets
[
k
]
783
local
t
=
type
(
d
)
784
if
t
=
=
"
table
"
then
785
d
=
d
[
f
]
786
if
type
(
d
)
=
=
"
function
"
then
787
d
(
...
)
788
else
789
mpvprint
(
...
)
790
end
791
elseif
t
=
=
"
function
"
then
792
d
(
f
,
...
)
793
end
794
end
)
795 796
end
797 798
-- \startluacode
799
-- local str = [[
800
-- 10 20 20 20
801
-- 30 40 40 60
802
-- 50 10
803
--
804
-- 10 10 20 30
805
-- 30 50 40 50
806
-- 50 20 -- the last one
807
--
808
-- 10 20 % comment
809
-- 20 10
810
-- 30 40 # comment
811
-- 40 20
812
-- 50 10
813
-- ]]
814
--
815
-- MP.myset = mp.dataset(str)
816
--
817
-- inspect(MP.myset)
818
-- \stopluacode
819
--
820
-- \startMPpage
821
-- color c[] ; c[1] := red ; c[2] := green ; c[3] := blue ;
822
-- for i=1 upto lua("mp.print(mp.n(MP.myset))") :
823
-- draw lua("mp.path(MP.myset[" & decimal i & "])") withcolor c[i] ;
824
-- endfor ;
825
-- \stopMPpage
826 827
-- texts:
828 829
function
mp
.
report
(
a
,
b
,
c
,
...
)
830
if
c
then
831
report_message
(
"
%s : %s
"
,
a
,
formatters
[
(
gsub
(
b
,
"
@
"
,
"
%%
"
)
)
]
(
c
,
...
)
)
832
elseif
b
then
833
report_message
(
"
%s : %s
"
,
a
,
b
)
834
elseif
a
then
835
report_message
(
"
message : %s
"
,
a
)
836
end
837
end
838 839
function
mp
.
flatten
(
t
)
840
local
tn
=
#
t
841 842
local
t1
=
t
[
1
]
843
local
t2
=
t
[
2
]
844
local
t3
=
t
[
3
]
845
local
t4
=
t
[
4
]
846 847
for
i
=
1
,
tn
-5
,
2
do
848
local
t5
=
t
[
i
+
4
]
849
local
t6
=
t
[
i
+
5
]
850
if
t1
=
=
t3
and
t3
=
=
t5
and
(
(
t2
<
=
t4
and
t4
<
=
t6
)
or
(
t6
<
=
t4
and
t4
<
=
t2
)
)
then
851
t
[
i
+
3
]
=
t2
852
t4
=
t2
853
t
[
i
]
=
false
854
t
[
i
+
1
]
=
false
855
elseif
t2
=
=
t4
and
t4
=
=
t6
and
(
(
t1
<
=
t3
and
t3
<
=
t5
)
or
(
t5
<
=
t3
and
t3
<
=
t1
)
)
then
856
t
[
i
+
2
]
=
t1
857
t3
=
t1
858
t
[
i
]
=
false
859
t
[
i
+
1
]
=
false
860
end
861
t1
=
t3
862
t2
=
t4
863
t3
=
t5
864
t4
=
t6
865
end
866 867
-- remove duplicates
868 869
local
t1
=
t
[
1
]
870
local
t2
=
t
[
2
]
871
for
i
=
1
,
tn
-2
,
2
do
872
local
t3
=
t
[
i
+
2
]
873
local
t4
=
t
[
i
+
3
]
874
if
t1
=
=
t3
and
t2
=
=
t4
then
875
t
[
i
]
=
false
876
t
[
i
+
1
]
=
false
877
end
878
t1
=
t3
879
t2
=
t4
880
end
881 882
-- move coordinates
883 884
local
m
=
0
885
for
i
=
1
,
tn
,
2
do
886
if
t
[
i
]
then
887
m
=
m
+
1
t
[
m
]
=
t
[
i
]
888
m
=
m
+
1
t
[
m
]
=
t
[
i
+
1
]
889
end
890
end
891 892
-- prune the table (not gc'd)
893 894
for
i
=
tn
,
m
+
1
,
-1
do
895
t
[
i
]
=
nil
896
end
897 898
-- safeguard so that we have at least one segment
899 900
if
m
=
=
2
then
901
t
[
3
]
=
t
[
1
]
902
t
[
4
]
=
t
[
2
]
903
end
904 905
end
906 907