mlib-lmp.lmt /size: 15 Kb    last modification: 2021-10-28 13:51
1
if
not
modules
then
modules
=
{
}
end
modules
[
'
mlib-lmp
'
]
=
{
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
-- path relates stuff ... todo: use a stack (or numeric index to list)
10 11
local
type
,
tonumber
,
tostring
=
type
,
tonumber
,
tostring
12
local
find
,
match
=
string
.
find
,
string
.
match
13
local
insert
,
remove
=
table
.
insert
,
table
.
remove
14 15
local
aux
=
mp
.
aux
16
local
mpnumeric
=
aux
.
numeric
17
local
mppair
=
aux
.
pair
18 19
local
registerdirect
=
metapost
.
registerdirect
20
local
registerscript
=
metapost
.
registerscript
21 22
local
scan
=
mp
.
scan
23
local
skip
=
mp
.
skip
24
local
get
=
mp
.
get
25
local
inject
=
mp
.
inject
26 27
local
scannumber
=
scan
.
number
28
local
scanstring
=
scan
.
string
29
local
scaninteger
=
scan
.
integer
30
local
scannumeric
=
scan
.
numeric
31
local
scanwhatever
=
scan
.
whatever
32
local
scanpath
=
scan
.
path
33
local
scanproperty
=
scan
.
property
34 35
local
gethashentry
=
get
.
hashentry
36 37
local
bpfactor
=
number
.
dimenfactors
.
bp
38 39
local
injectwhatever
=
inject
.
whatever
40
local
injectboolean
=
inject
.
boolean
41
local
injectnumeric
=
inject
.
numeric
42
local
injectstring
=
inject
.
string
43
local
injectpair
=
inject
.
pair
44 45
local
injectwhd
=
inject
.
whd
-- scaled
46
local
injectxy
=
inject
.
xy
47
local
injectpt
=
inject
.
pt
48 49
local
report
=
logs
.
reporter
(
"
metapost
"
,
"
log
"
)
50
local
report_message
=
logs
.
reporter
(
"
metapost
"
)
51 52
local
codes
=
metapost
.
codes
53
local
types
=
metapost
.
types
54
local
procodes
=
mplib
.
propertycodes
55 56
local
implement
=
interfaces
.
implement
57 58
do
59 60
local
p
=
nil
61
local
n
=
0
62 63
registerscript
(
"
pathreset
"
,
function
(
)
64
p
=
nil
65
n
=
0
66
end
)
67 68
registerdirect
(
"
pathlengthof
"
,
function
(
)
69
p
=
scanpath
(
)
70
return
p
and
#
p
or
1
71
end
)
72 73
registerdirect
(
"
pathpointof
"
,
function
(
)
74
local
i
=
scannumber
(
)
75
if
i
>
0
and
i
<
=
n
then
76
local
pi
=
p
[
i
]
77
injectpair
(
pi
[
1
]
,
pi
[
2
]
)
78
end
79
end
)
80 81
registerdirect
(
"
pathleftof
"
,
function
(
)
82
local
i
=
scannumber
(
)
83
if
i
>
0
and
i
<
=
n
then
84
local
pi
=
p
[
i
]
85
injectpair
(
pi
[
5
]
,
pi
[
6
]
)
86
end
87
end
)
88 89
registerdirect
(
"
pathrightof
"
,
function
(
)
90
local
i
=
scannumber
(
)
91
if
i
>
0
and
i
<
=
n
then
92
local
pn
93
if
i
=
=
1
then
94
pn
=
p
[
2
]
or
p
[
1
]
95
else
96
pn
=
p
[
i
+
1
]
or
p
[
1
]
97
end
98
injectpair
(
pn
[
3
]
,
pn
[
4
]
)
99
end
100
end
)
101 102
end
103 104
registerscript
(
"
showproperty
"
,
function
(
)
105
local
k
,
s
,
p
,
d
=
scanproperty
(
)
106
if
k
then
107
report
(
"
name %a, property %a, command %a, detail %a
"
,
s
,
procodes
[
p
]
or
"
-
"
,
codes
[
k
]
or
"
-
"
,
types
[
d
]
or
"
-
"
)
108
end
109
end
)
110 111
registerscript
(
"
showhashentry
"
,
function
(
)
112
local
s
=
scanstring
(
)
113
if
s
then
114
local
k
,
p
,
d
=
gethashentry
(
s
)
115
if
k
then
116
report
(
"
name %a, property %a, command %a, detail %a
"
,
s
,
procodes
[
p
]
or
"
-
"
,
codes
[
k
]
or
"
-
"
,
types
[
d
]
or
"
-
"
)
117
end
118
end
119
end
)
120 121
-- local getmacro = tokens.getters.macro
122
-- local mpgnamespace = getmacro("??graphicvariable")
123 124
-- registerscript("mpv_numeric", function() injectnumeric (getmacro(mpgnamespace .. getmacro("currentmpcategory") .. ":" .. scanmpstring())) end)
125
-- registerscript("mpv_dimension", function() return getmacro(mpgnamespace .. getmacro("currentmpcategory") .. ":" .. scanmpstring()) end)
126
-- registerscript("mpv_string", function() injectstring (getmacro(mpgnamespace .. getmacro("currentmpcategory") .. ":" .. scanmpstring())) end)
127 128
-- registerscript("mpvar", function() return getmacro(mpgnamespace .. getmacro("currentmpcategory") .. ":" .. scanmpstring(), true) end) -- Isn't it already edef'd?
129
-- registerscript("mpvar", function() return getmacro(metapost.namespace .. scanmpstring(), true) end) -- Isn't it already edef'd?
130 131
do
132 133
local
expandtex
=
mp
.
expandtex
134 135
local
tokenvalues
=
tokens
.
values
136
local
dimension_value
=
tokenvalues
.
dimension
137
local
integer_value
=
tokenvalues
.
integer
138
local
boolean_value
=
tokenvalues
.
boolean
139
local
string_value
=
tokenvalues
.
string
140
local
unknown_value
=
tokenvalues
.
none
141 142
registerdirect
(
"
mpvard
"
,
function
(
)
143
if
not
expandtex
(
dimension_value
,
"
mpcategoryparameter
"
,
true
,
scanstring
(
)
)
then
144
injectnumeric
(
0
)
145
end
146
end
)
147 148
registerdirect
(
"
mpvarn
"
,
function
(
)
149
if
not
expandtex
(
integer_value
,
"
mpcategoryparameter
"
,
true
,
scanstring
(
)
)
then
150
injectnumeric
(
0
)
151
end
152
end
)
153 154
registerdirect
(
"
mpvars
"
,
function
(
)
155
if
not
expandtex
(
string_value
,
"
mpcategoryparameter
"
,
true
,
scanstring
(
)
)
then
156
injectstring
(
"
"
)
157
end
158
end
)
159 160
registerdirect
(
"
mpvarb
"
,
function
(
)
161
if
not
expandtex
(
boolean_value
,
"
mpcategoryparameter
"
,
true
,
scanstring
(
)
)
then
162
injectboolean
(
false
)
163
end
164
end
)
165 166
registerdirect
(
"
mpvar
"
,
function
(
)
167
if
not
expandtex
(
unknown_value
,
"
mpcategoryparameter
"
,
true
,
scanstring
(
)
)
then
168
injectnumeric
(
0
)
169
end
170
end
)
171 172
--
173 174
local
mpprint
=
mp
.
print
175
local
mpquoted
=
mp
.
quoted
176
local
getmacro
=
tokens
.
getters
.
macro
177 178
registerscript
(
"
texvar
"
,
function
(
)
mpprint
(
getmacro
(
metapost
.
namespace
.
.
scanstring
(
)
)
)
end
)
179
registerscript
(
"
texstr
"
,
function
(
)
mpquoted
(
getmacro
(
metapost
.
namespace
.
.
scanstring
(
)
)
)
end
)
180 181
end
182 183
do
184 185
registerscript
(
"
textextanchor
"
,
function
(
)
186
local
x
,
y
=
match
(
scanstring
(
)
,
"
tx_anchor=(%S+) (%S+)
"
)
-- todo: make an lpeg
187
if
x
and
y
then
188
x
=
tonumber
(
x
)
189
y
=
tonumber
(
y
)
190
end
191
injectpair
(
x
or
0
,
y
or
0
)
192
end
)
193 194
end
195 196
do
197 198
local
mpnamedcolor
=
attributes
.
colors
.
mpnamedcolor
199
local
mpprint
=
mp
.
aux
.
print
200 201
mp
.
mf_named_color
=
function
(
str
)
202
mpprint
(
mpnamedcolor
(
str
)
)
203
end
204 205
-- todo: we can inject but currently we always get a string back so then
206
-- we need to deal with it upstream in the color module ... not now
207 208
registerscript
(
"
namedcolor
"
,
function
(
)
mpprint
(
mpnamedcolor
(
scanstring
(
)
)
)
end
)
209 210
end
211 212
do
213 214
local
hashes
=
table
.
setmetatableindex
(
"
table
"
)
215 216
registerdirect
(
"
lmt_hash_new
"
,
function
(
)
217
-- local name = scanstring()
218
local
name
=
scanwhatever
(
)
219
hashes
[
name
]
=
{
}
220
end
)
221 222
registerdirect
(
"
lmt_hash_dispose
"
,
function
(
)
223
-- local name = scanstring()
224
local
name
=
scanwhatever
(
)
225
hashes
[
name
]
=
nil
226
end
)
227 228
registerdirect
(
"
lmt_hash_in
"
,
function
(
)
229
-- local name = scanstring()
230
local
name
=
scanwhatever
(
)
231
-- local key = scanstring()
232
local
key
=
scanwhatever
(
)
233
local
hash
=
hashes
[
name
]
234
injectwhatever
(
hash
and
hash
[
key
]
and
true
or
false
)
235
end
)
236 237
registerdirect
(
"
lmt_hash_to
"
,
function
(
)
238
-- local name = scanstring()
239
local
name
=
scanwhatever
(
)
240
-- local key = scanstring()
241
local
key
=
scanwhatever
(
)
242
local
value
=
scanwhatever
(
)
243
local
hash
=
hashes
[
name
]
244
if
hash
then
245
hash
[
key
]
=
value
246
end
247
end
)
248 249
registerdirect
(
"
lmt_hash_from
"
,
function
(
)
250
-- local name = scanstring()
251
local
name
=
scanwhatever
(
)
252
-- local key = scanstring()
253
local
key
=
scanwhatever
(
)
254
local
hash
=
hashes
[
name
]
255
injectwhatever
(
hash
and
hash
[
key
]
or
false
)
256
end
)
257 258
interfaces
.
implement
{
259
name
=
"
MPfromhash
"
,
260
arguments
=
"
2 strings
"
,
261
actions
=
function
(
name
,
key
)
262
local
hash
=
hashes
[
name
]
or
hashes
[
tonumber
(
name
)
]
or
hashes
[
tostring
(
name
)
]
263
if
hash
then
264
local
v
=
hash
[
key
]
265
if
v
then
266
context
(
v
)
267
end
268
end
269
end
270
}
271 272
end
273 274
do
275 276
local
bpfactor
=
number
.
dimenfactors
.
bp
277
local
nbdimensions
=
nodes
.
boxes
.
dimensions
278 279
registerdirect
(
"
boxdimensions
"
,
function
(
)
280
local
category
=
scanstring
(
)
281
local
index
=
scanwhatever
(
)
282
injectwhd
(
nbdimensions
(
category
,
index
)
)
283
end
)
284 285
end
286 287
do
288 289
local
skiptoken
=
skip
.
token
290 291
local
comma_code
=
codes
.
comma
292 293
local
getmacro
=
tokens
.
getters
.
macro
294
local
setmacro
=
tokens
.
setters
.
macro
295 296
local
getdimen
=
tex
.
getdimen
297
local
getcount
=
tex
.
getcount
298
local
gettoks
=
tex
.
gettoks
299
local
setdimen
=
tex
.
setdimen
300
local
setcount
=
tex
.
setcount
301
local
settoks
=
tex
.
settoks
302 303
-- more helpers
304 305
registerdirect
(
"
getmacro
"
,
function
(
)
return
getmacro
(
scanstring
(
)
)
end
)
306
registerdirect
(
"
getcount
"
,
function
(
)
return
getcount
(
scanwhatever
(
)
)
end
)
307
registerdirect
(
"
gettoks
"
,
function
(
)
return
gettoks
(
scanwhatever
(
)
)
end
)
308
registerdirect
(
"
getdimen
"
,
function
(
)
return
getdimen
(
scanwhatever
(
)
)
*
bpfactor
end
)
309 310
registerscript
(
"
setmacro
"
,
function
(
)
setmacro
(
scanstring
(
)
,
scanstring
(
)
)
end
)
311
registerscript
(
"
setdimen
"
,
function
(
)
setdimen
(
scanwhatever
(
)
,
scannumeric
(
)
/
bpfactor
)
end
)
312
registerscript
(
"
setcount
"
,
function
(
)
setcount
(
scanwhatever
(
)
,
scannumeric
(
)
)
end
)
313
registerscript
(
"
settoks
"
,
function
(
)
settoks
(
scanwhatever
(
)
,
scanstring
(
)
)
end
)
314 315
registerscript
(
"
setglobalmacro
"
,
function
(
)
setmacro
(
scanstring
(
)
,
scanstring
(
)
,
"
global
"
)
end
)
316
registerscript
(
"
setglobaldimen
"
,
function
(
)
setdimen
(
"
global
"
,
scanwhatever
(
)
,
scannumeric
(
)
/
bpfactor
)
end
)
317
registerscript
(
"
setglobalcount
"
,
function
(
)
setcount
(
"
global
"
,
scanwhatever
(
)
,
scaninteger
(
)
)
end
)
318
registerscript
(
"
setglobaltoks
"
,
function
(
)
settoks
(
"
global
"
,
scanwhatever
(
)
,
scanstring
(
)
)
end
)
319 320
local
utfnum
=
utf
.
byte
321
local
utflen
=
utf
.
len
322
local
utfsub
=
utf
.
sub
323 324
registerdirect
(
"
utfnum
"
,
function
(
)
return
utfnum
(
scanstring
(
)
)
end
)
325
registerdirect
(
"
utflen
"
,
function
(
)
return
utflen
(
scanstring
(
)
)
end
)
326 327
registerdirect
(
"
utfsub
"
,
function
(
)
-- we have an optional third argument so we explicitly scan a text argument
328
return
utfsub
(
scanstring
(
)
,
skiptoken
(
comma_code
)
and
scannumeric
(
)
,
skiptoken
(
comma_code
)
and
scannumeric
(
)
)
329
end
)
330 331
local
setlogging
=
metapost
.
setlogging
332 333
registerscript
(
"
message
"
,
function
(
)
334
setlogging
(
false
)
335
local
str
=
scanstring
(
)
336
setlogging
(
true
)
337
report_message
(
"
message : %s
"
,
str
)
338
end
)
339 340
end
341 342
-- position fun
343 344
do
345 346
local
mpprint
=
mp
.
print
347
local
mpfprint
=
mp
.
fprint
348 349
local
jobpositions
=
job
.
positions
350
local
getwhd
=
jobpositions
.
whd
351
local
getxy
=
jobpositions
.
xy
352
local
getposition
=
jobpositions
.
position
353
local
getpage
=
jobpositions
.
page
354
local
getparagraph
=
jobpositions
.
paragraph
355
local
getregion
=
jobpositions
.
region
356
local
getcolumn
=
jobpositions
.
column
357
local
getmacro
=
tokens
.
getters
.
macro
358 359
registerscript
(
"
positionpath
"
,
function
(
)
360
local
w
,
h
,
d
=
getwhd
(
scanstring
(
)
)
361
if
w
then
362
mpfprint
(
"
((%p,%p)--(%p,%p)--(%p,%p)--(%p,%p)--cycle)
"
,
0
,
-
d
,
w
,
-
d
,
w
,
h
,
0
,
h
)
363
else
364
mpprint
(
"
(origin--cycle)
"
)
365
end
366
end
)
367 368
registerscript
(
"
positioncurve
"
,
function
(
)
369
local
w
,
h
,
d
=
getwhd
(
scanstring
(
)
)
370
if
w
then
371
mpfprint
(
"
((%p,%p)..(%p,%p)..(%p,%p)..(%p,%p)..cycle)
"
,
0
,
-
d
,
w
,
-
d
,
w
,
h
,
0
,
h
)
372
else
373
mpprint
(
"
(origin--cycle)
"
)
374
end
375
end
)
376 377
registerscript
(
"
positionbox
"
,
function
(
)
378
local
p
,
x
,
y
,
w
,
h
,
d
=
getposition
(
scanstring
(
)
)
379
if
p
then
380
mpfprint
(
"
((%p,%p)--(%p,%p)--(%p,%p)--(%p,%p)--cycle)
"
,
x
,
y
-
d
,
x
+
w
,
y
-
d
,
x
+
w
,
y
+
h
,
x
,
y
+
h
)
381
else
382
mpprint
(
"
(%p,%p)--cycle
"
,
x
or
0
,
y
or
0
)
383
end
384
end
)
385 386
registerdirect
(
"
positionpage
"
,
function
(
)
return
getpage
(
scanstring
(
)
)
or
0
end
)
387
registerdirect
(
"
positioncolumn
"
,
function
(
)
return
getcolumn
(
scanstring
(
)
)
or
0
end
)
388
registerdirect
(
"
positionparagraph
"
,
function
(
)
return
getparagraph
(
scanstring
(
)
)
or
0
end
)
389
registerdirect
(
"
positionregion
"
,
function
(
)
return
getregion
(
scanstring
(
)
)
or
"
unknown
"
end
)
390
registerdirect
(
"
positionanchor
"
,
function
(
)
return
getmacro
(
"
MPanchorid
"
)
end
)
391
registerdirect
(
"
positionwhd
"
,
function
(
)
injectwhd
(
getwhd
(
scanstring
(
)
)
)
end
)
392
registerdirect
(
"
positionxy
"
,
function
(
)
injectxy
(
getxy
(
scanstring
(
)
)
)
end
)
393
registerdirect
(
"
positionx
"
,
function
(
)
injectpt
(
getx
(
scanstring
(
)
)
)
end
)
394
registerdirect
(
"
positiony
"
,
function
(
)
injectpt
(
gety
(
scanstring
(
)
)
)
end
)
395 396
end
397 398
do
399 400
local
modes
=
tex
.
modes
401
local
systemmodes
=
tex
.
systemmodes
402 403
registerdirect
(
"
mode
"
,
function
(
)
injectboolean
(
modes
[
scanstring
(
)
]
and
true
or
false
)
end
)
404
registerdirect
(
"
systemmode
"
,
function
(
)
injectboolean
(
systemmodes
[
scanstring
(
)
]
and
true
or
false
)
end
)
405 406
-- for compatibility reasons we keep this (metafun manual):
407 408
local
modes
=
tex
.
modes
409
local
systemmodes
=
tex
.
systemmodes
410 411
function
mp
.
mode
(
s
)
412
injectboolean
(
modes
[
s
]
and
true
or
false
)
413
end
414 415
function
mp
.
systemmode
(
s
)
416
injectboolean
(
systemmodes
[
s
]
and
true
or
false
)
417
end
418 419
mp
.
processingmode
=
mp
.
mode
420 421
end
422 423
-- for alan's nodes:
424 425
do
426 427
local
lpegmatch
,
lpegpatterns
,
P
=
lpeg
.
match
,
lpeg
.
patterns
,
lpeg
.
P
428 429
-- todo: scansuffix / why no return boolean (first one)
430 431
registerdirect
(
"
isarray
"
,
function
(
)
432
injectboolean
(
find
(
scanstring
(
)
,
"
%d
"
)
and
true
or
false
)
433
end
)
434 435
registerdirect
(
"
prefix
"
,
function
(
)
436
local
str
=
scanstring
(
)
437
return
match
(
str
,
"
^(.-)[%d%[]
"
)
or
str
438
end
)
439 440
local
dimension
=
lpeg
.
counter
(
P
(
"
[
"
)
*
lpegpatterns
.
integer
*
P
(
"
]
"
)
+
lpegpatterns
.
integer
)
441 442
registerdirect
(
"
dimension
"
,
function
(
)
return
dimension
(
scanstring
(
)
)
end
)
443 444
-- todo : share with mlib-pps.lua metapost,isobject
445 446
-- registerdirect("isobject", function()
447
-- injectboolean(find(scanstring(),"mf_object="))
448
-- end
449 450
local
p1
=
P
(
"
mf_object=
"
)
451
local
p2
=
lpegpatterns
.
eol
*
p1
452
local
pattern
=
(
1
-
p2
)
^
0
*
p2
+
p1
453 454
registerdirect
(
"
isobject
"
,
function
(
)
455
local
str
=
scanstring
(
)
456
injectboolean
(
pattern
and
str
~
=
"
"
and
lpegmatch
(
pattern
,
str
)
)
457
end
)
458 459
end
460 461
-- key/values (moved here, old mechanism)
462 463
do
464 465
local
stack
,
top
=
{
}
,
nil
466 467
local
function
setvariable
(
k
,
v
)
468
if
top
then
469
top
[
k
]
=
v
470
else
471
metapost
.
variables
[
k
]
=
v
472
end
473
end
474 475
local
function
pushvariable
(
k
)
476
local
t
=
{
}
477
if
top
then
478
insert
(
stack
,
top
)
479
top
[
k
]
=
t
480
else
481
metapost
.
variables
[
k
]
=
t
482
end
483
top
=
t
484
end
485 486
local
function
popvariable
(
)
487
top
=
remove
(
stack
)
488
end
489 490
registerscript
(
"
passvariable
"
,
function
(
)
setvariable
(
scanstring
(
)
,
scanwhatever
(
)
)
end
)
491
registerscript
(
"
pushvariable
"
,
function
(
)
pushvariable
(
scanstring
(
)
)
end
)
492
registerscript
(
"
popvariable
"
,
function
(
)
popvariable
(
)
end
)
493 494
local
stack
=
{
}
495 496
local
function
pushvariables
(
)
497
insert
(
stack
,
metapost
.
variables
)
498
metapost
.
variables
=
{
}
499
end
500 501
local
function
popvariables
(
)
502
metapost
.
variables
=
remove
(
stack
)
or
metapost
.
variables
503
end
504 505
metapost
.
setvariable
=
setvariable
506
metapost
.
pushvariable
=
pushvariable
507
metapost
.
popvariable
=
popvariable
508
metapost
.
pushvariables
=
pushvariables
509
metapost
.
popvariables
=
popvariables
510 511
implement
{
512
name
=
"
mppushvariables
"
,
513
actions
=
pushvariables
,
514
}
515 516
implement
{
517
name
=
"
mppopvariables
"
,
518
actions
=
popvariables
,
519
}
520 521
end
522 523
do
524 525
local
repeatable
=
utilities
.
randomizer
.
repeatable
526 527
registerdirect
(
"
repeatablerandom
"
,
function
(
)
528
return
repeatable
(
scanstring
(
)
)
529
end
)
530 531
end
532