SourceBrowser

mlib-lua.lua /size: 39 Kb last modification: 2020-07-01 14:35
1if
 not
 modules
 then
 modules
 =
 {
 }
 end
 modules
 [
'
mlib-lua
'
]
 =
 {
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-- This is very preliminary code!
10
11-- maybe we need mplib.model, but how with instances
12
13local
 type
,
 tostring
,
 tonumber
,
 select
,
 loadstring
 =
 type
,
 tostring
,
 tonumber
,
 select
,
 loadstring
14local
 find
,
 match
,
 gsub
,
 gmatch
 =
 string
.
find
,
 string
.
match
,
 string
.
gsub
,
 string
.
gmatch
15local
 concat
,
 insert
,
 remove
 =
 table
.
concat
,
 table
.
insert
,
 table
.
remove
16
17local
 formatters
   =
 string
.
formatters
18local
 lpegmatch
    =
 lpeg
.
match
19local
 lpegpatterns
 =
 lpeg
.
patterns
20
21local
 P
,
 S
,
 Ct
,
 Cs
,
 Cc
,
 C
 =
 lpeg
.
P
,
 lpeg
.
S
,
 lpeg
.
Ct
,
 lpeg
.
Cs
,
 lpeg
.
Cc
,
 lpeg
.
C
22
23local
 report_luarun
  =
 logs
.
reporter
(
"
metapost
"
,
"
lua
"
)
24local
 report_script
  =
 logs
.
reporter
(
"
metapost
"
,
"
script
"
)
25local
 report_message
 =
 logs
.
reporter
(
"
metapost
"
)
26
27local
 trace_luarun
   =
 false
  trackers
.
register
(
"
metapost.lua
"
,
function
(
v
)
 trace_luarun
 =
 v
 end
)
28
29local
 be_tolerant
    =
 true
   directives
.
register
(
"
metapost.lua.tolerant
"
,
 function
(
v
)
 be_tolerant
 =
 v
 end
)
30
31local
 get
,
 set
,
 aux
,
 scan
,
 inject
 =
 {
 }
,
 {
 }
,
 {
 }
,
 {
 }
,
 {
 }
32
33mp
 =
 mp
 or
 {
  -- system namespace
34    set
    =
 set
,
35    get
    =
 get
,
36    aux
    =
 aux
,
37    scan
   =
 scan
,
38    inject
 =
 inject
,
39}
40
41MP
 =
 MP
 or
 {
 -- user namespace
42}
43
44-- We had this:
45--
46--   table.setmetatablecall(mp,function(t,k) mpprint(k) end)
47--
48-- but the next one is more interesting because we cannot use calls like:
49--
50--   lua.mp.somedefdname("foo")
51--
52-- which is due to expansion of somedefdname during suffix creation. So:
53--
54--   lua.mp("somedefdname","foo")
55
56table
.
setmetatablecall
(
mp
,
function
(
t
,
k
,
...
)
 return
 t
[
k
]
(
...
)
 end
)
57table
.
setmetatablecall
(
MP
,
function
(
t
,
k
,
...
)
 return
 t
[
k
]
(
...
)
 end
)
58
59do
60
61    local
 currentmpx
 =
 nil
62    local
 stack
      =
 {
 }
63
64    if
 CONTEXTLMTXMODE
 >
 0
 then
65
66        local
 scan_next
       =
 mplib
.
scan_next
67        local
 scan_expression
 =
 mplib
.
scan_expression
68        local
 scan_token
      =
 mplib
.
scan_token
69        local
 scan_symbol
     =
 mplib
.
scan_symbol
70        local
 scan_numeric
    =
 mplib
.
scan_numeric
71        local
 scan_integer
    =
 mplib
.
scan_integer
72        local
 scan_boolean
    =
 mplib
.
scan_boolean
73        local
 scan_string
     =
 mplib
.
scan_string
74        local
 scan_pair
       =
 mplib
.
scan_pair
75        local
 scan_color
      =
 mplib
.
scan_color
76        local
 scan_cmykcolor
  =
 mplib
.
scan_cmykcolor
77        local
 scan_transform
  =
 mplib
.
scan_transform
78        local
 scan_path
       =
 mplib
.
scan_path
79        local
 scan_pen
        =
 mplib
.
scan_pen
80
81        scan
.
next
       =
 function
(
k
)
   return
 scan_next
      (
currentmpx
,
k
)
   end
82        scan
.
expression
 =
 function
(
k
)
   return
 scan_expression
(
currentmpx
,
k
)
   end
83        scan
.
token
      =
 function
(
k
)
   return
 scan_token
     (
currentmpx
,
k
)
   end
84        scan
.
symbol
     =
 function
(
k
,
e
)
 return
 scan_symbol
    (
currentmpx
,
k
,
e
)
 end
85        scan
.
numeric
    =
 function
(
)
    return
 scan_numeric
   (
currentmpx
)
     end
86        scan
.
integer
    =
 function
(
)
    return
 scan_integer
   (
currentmpx
)
     end
87        scan
.
boolean
    =
 function
(
)
    return
 scan_boolean
   (
currentmpx
)
     end
88        scan
.
string
     =
 function
(
)
    return
 scan_string
    (
currentmpx
)
     end
89        scan
.
pair
       =
 function
(
t
)
   return
 scan_pair
      (
currentmpx
,
t
)
   end
90        scan
.
color
      =
 function
(
t
)
   return
 scan_color
     (
currentmpx
,
t
)
   end
91        scan
.
cmykcolor
  =
 function
(
t
)
   return
 scan_cmykcolor
 (
currentmpx
,
t
)
   end
92        scan
.
transform
  =
 function
(
t
)
   return
 scan_transform
 (
currentmpx
,
t
)
   end
93        scan
.
path
       =
 function
(
t
)
   return
 scan_path
      (
currentmpx
,
t
)
   end
94        scan
.
pen
        =
 function
(
t
)
   return
 scan_pen
       (
currentmpx
,
t
)
   end
95
96        local
 inject_path
      =
 mplib
.
inject_path
97        local
 inject_numeric
   =
 mplib
.
inject_numeric
98        local
 inject_pair
      =
 mplib
.
inject_pair
99        local
 inject_boolean
   =
 mplib
.
inject_boolean
100        local
 inject_integer
   =
 mplib
.
inject_integer
101        local
 inject_string
    =
 mplib
.
inject_string
102        local
 inject_color
     =
 mplib
.
inject_color
103        local
 inject_cmykcolor
 =
 mplib
.
inject_cmykcolor
104        local
 inject_transform
 =
 mplib
.
inject_transform
105        local
 inject_whatever
  =
 mplib
.
inject_whatever
106
107        inject
.
path
      =
 function
(
t
,
cycle
,
curled
)
  return
 inject_path
     (
currentmpx
,
t
,
cycle
,
curled
)
  end
108        inject
.
numeric
   =
 function
(
n
)
               return
 inject_numeric
  (
currentmpx
,
n
)
               end
109        inject
.
pair
      =
 function
(
x
,
y
)
             return
 inject_pair
     (
currentmpx
,
x
,
y
)
             end
110        inject
.
boolean
   =
 function
(
b
)
               return
 inject_boolean
  (
currentmpx
,
b
)
               end
111        inject
.
integer
   =
 function
(
i
)
               return
 inject_integer
  (
currentmpx
,
i
)
               end
112        inject
.
string
    =
 function
(
s
)
               return
 inject_string
   (
currentmpx
,
s
)
               end
113        inject
.
color
     =
 function
(
r
,
g
,
b
)
           return
 inject_color
    (
currentmpx
,
r
,
g
,
b
)
           end
114        inject
.
cmykcolor
 =
 function
(
c
,
m
,
y
,
k
)
         return
 inject_cmykcolor
(
currentmpx
,
c
,
m
,
y
,
k
)
         end
115        inject
.
transform
 =
 function
(
x
,
y
,
xx
,
xy
,
yx
,
yy
)
 return
 inject_transform
(
currentmpx
,
x
,
y
,
xx
,
xy
,
yx
,
yy
)
 end
116        inject
.
whatever
  =
 function
(
...
)
             return
 inject_whatever
 (
currentmpx
,
...
)
             end
117
118        -- bonus:
119
120        scan
  .
number
    =
 scan
  .
numeric
121        inject
.
number
    =
 inject
.
numeric
122
123        table
.
setmetatablecall
(
inject
,
function
(
t
,
...
)
124            inject_whatever
(
currentmpx
,
...
)
125        end
)
126
127        -- experiment
128
129        function
 mp
.
autoinject
(
m
)
130            local
 t
 =
 type
(
m
)
131            if
 t
 =
=
 "
table
"
 then
132                local
 n
 =
 #
t
133                if
 n
 =
=
 2
 then
134                    inject_pair
(
currentmpx
,
m
)
135                elseif
 n
 =
=
 3
 then
136                    inject_color
(
currentmpx
,
m
)
137                elseif
 n
 =
=
 4
 then
138                    inject_cmykcolor
(
currentmpx
,
m
)
139                elseif
 n
 =
=
 6
 then
140                    inject_transform
(
currentmpx
,
m
)
141                end
142            elseif
 t
 =
=
 "
number
"
 then
143                inject_numeric
(
currentmpx
,
m
)
144            elseif
 t
 =
=
 "
string
"
 then
145                inject_string
(
currentmpx
,
m
)
146            elseif
 t
 =
=
 "
boolean
"
 then
147                inject_boolean
(
currentmpx
,
m
)
148            end
149        end
150
151    else
152
153        local
 get_numeric
 =
 mplib
.
get_numeric
154        local
 get_integer
 =
 mplib
.
get_integer
155        local
 get_string
  =
 mplib
.
get_string
156        local
 get_boolean
 =
 mplib
.
get_boolean
157        local
 get_path
    =
 mplib
.
get_path
158        local
 set_path
    =
 mplib
.
set_path
159
160        get
.
numeric
 =
 function
(
s
)
   return
 get_numeric
(
currentmpx
,
s
)
   end
161        get
.
number
  =
 function
(
s
)
   return
 get_numeric
(
currentmpx
,
s
)
   end
162        get
.
integer
 =
 function
(
s
)
   return
 get_integer
(
currentmpx
,
s
)
   end
163        get
.
string
  =
 function
(
s
)
   return
 get_string
 (
currentmpx
,
s
)
   end
164        get
.
boolean
 =
 function
(
s
)
   return
 get_boolean
(
currentmpx
,
s
)
   end
165        get
.
path
    =
 function
(
s
)
   return
 get_path
   (
currentmpx
,
s
)
   end
166        set
.
path
    =
 function
(
s
,
t
)
 return
 set_path
   (
currentmpx
,
s
,
t
)
 end
 -- not working yet
167
168    end
169
170    function
 metapost
.
pushscriptrunner
(
mpx
)
171        insert
(
stack
,
mpx
)
172        currentmpx
 =
 mpx
173    end
174
175    function
 metapost
.
popscriptrunner
(
)
176        currentmpx
 =
 remove
(
stack
,
mpx
)
177    end
178
179    function
 metapost
.
currentmpx
(
)
180        return
 currentmpx
181    end
182
183    local
 status
 =
 mplib
.
status
184
185    function
 metapost
.
currentmpxstatus
(
)
186        return
 status
 and
 status
(
currentmpx
)
 or
 0
187    end
188
189end
190
191-- unless we adapt the old mp library too, in the end we will have two
192-- variants
193
194do
195
196    local
 lmtxmode
       =
 CONTEXTLMTXMODE
 >
 0
197
198    -- serializers
199
200    local
 f_integer
      =
 formatters
[
"
%i
"
]
201    local
 f_numeric
      =
 formatters
[
"
%F
"
]
202
203    -- no %n as that can produce -e notation and that is not so nice for scaled butmaybe we
204    -- should then switch between ... i.e. make a push/pop for the formatters here ... not now.
205
206    local
 f_integer
      =
 formatters
[
"
%i
"
]
207    local
 f_numeric
      =
 formatters
[
"
%F
"
]
208    local
 f_pair
         =
 formatters
[
"
(%F,%F)
"
]
209    local
 f_ctrl
         =
 formatters
[
"
(%F,%F) .. controls (%F,%F) and (%F,%F)
"
]
210    local
 f_triplet
      =
 formatters
[
"
(%F,%F,%F)
"
]
211    local
 f_quadruple
    =
 formatters
[
"
(%F,%F,%F,%F)
"
]
212    local
 f_transform
    =
 formatters
[
"
totransform(%F,%F,%F,%F,%F,%F)
"
]
213    local
 f_pen
          =
 formatters
[
"
(pencircle transformed totransform(%F,%F,%F,%F,%F,%F))
"
]
214
215    local
 f_points
       =
 formatters
[
"
%p
"
]
216    local
 f_pair_pt
      =
 formatters
[
"
(%p,%p)
"
]
217    local
 f_ctrl_pt
      =
 formatters
[
"
(%p,%p) .. controls (%p,%p) and (%p,%p)
"
]
218    local
 f_triplet_pt
   =
 formatters
[
"
(%p,%p,%p)
"
]
219    local
 f_quadruple_pt
 =
 formatters
[
"
(%p,%p,%p,%p)
"
]
220
221    local
 r
 =
 P
(
'
%
'
)
  /
 "
percent
"
222            +
 P
(
'
"
'
)
  /
 "
dquote
"
223            +
 P
(
'
\n
'
)
 /
 "
crlf
"
224         -- + P(' ')  / "space"
225    local
 a
 =
 Cc
(
"
&
"
)
226    local
 q
 =
 Cc
(
'
"
'
)
227    local
 p
 =
 Cs
(
q
 *
 (
r
 *
 a
)
^
-1
 *
 (
a
 *
 r
 *
 (
P
(
-1
)
 +
 a
)
 +
 P
(
1
)
)
^
0
 *
 q
)
228
229    mp
.
cleaned
 =
 function
(
s
)
 return
 lpegmatch
(
p
,
s
)
 or
 s
 end
230
231    -- management
232
233    -- sometimes we gain (e.g. .5 sec on the sync test)
234
235    local
 cache
 =
 table
.
makeweak
(
)
236
237    local
 runscripts
 =
 {
 }
238    local
 runnames
   =
 {
 }
239    local
 nofscripts
 =
 0
240
241    function
 metapost
.
registerscript
(
name
,
f
)
242        nofscripts
 =
 nofscripts
 +
 1
243        if
 f
 then
244            runscripts
[
nofscripts
]
 =
 f
245            runnames
[
name
]
 =
 nofscripts
246        else
247            runscripts
[
nofscripts
]
 =
 name
248        end
249        return
 nofscripts
250    end
251
252    function
 metapost
.
scriptindex
(
name
)
253        return
 runnames
[
name
]
 or
 0
254    end
255
256    -- The gbuffer sharing and such is not really needed now but make a dent when
257    -- we have a high volume of simpel calls (loops) so we keep it around for a
258    -- while.
259
260    local
 nesting
 =
 0
261    local
 runs
    =
 0
262    local
 gbuffer
 =
 {
 }
263    local
 buffer
  =
 gbuffer
264    local
 n
       =
 0
265
266    local
 function
 mpdirect1
(
a
)
267        n
 =
 n
 +
 1
 buffer
[
n
]
 =
 a
268    end
269    local
 function
 mpdirect2
(
a
,
b
)
270        n
 =
 n
 +
 1
 buffer
[
n
]
 =
 a
271        n
 =
 n
 +
 1
 buffer
[
n
]
 =
 b
272    end
273    local
 function
 mpdirect3
(
a
,
b
,
c
)
274        n
 =
 n
 +
 1
 buffer
[
n
]
 =
 a
275        n
 =
 n
 +
 1
 buffer
[
n
]
 =
 b
276        n
 =
 n
 +
 1
 buffer
[
n
]
 =
 c
277    end
278    local
 function
 mpdirect4
(
a
,
b
,
c
,
d
)
279        n
 =
 n
 +
 1
 buffer
[
n
]
 =
 a
280        n
 =
 n
 +
 1
 buffer
[
n
]
 =
 b
281        n
 =
 n
 +
 1
 buffer
[
n
]
 =
 c
282        n
 =
 n
 +
 1
 buffer
[
n
]
 =
 d
283    end
284    local
 function
 mpdirect5
(
a
,
b
,
c
,
d
,
e
)
285        n
 =
 n
 +
 1
 buffer
[
n
]
 =
 a
286        n
 =
 n
 +
 1
 buffer
[
n
]
 =
 b
287        n
 =
 n
 +
 1
 buffer
[
n
]
 =
 c
288        n
 =
 n
 +
 1
 buffer
[
n
]
 =
 d
289        n
 =
 n
 +
 1
 buffer
[
n
]
 =
 e
290    end
291
292    local
 function
 mpflush
(
separator
)
293        buffer
[
1
]
 =
 concat
(
buffer
,
separator
 or
 "
"
,
1
,
n
)
294        n
 =
 1
295    end
296
297    function
 metapost
.
runscript
(
code
)
298        nesting
 =
 nesting
 +
 1
299        runs
    =
 runs
 +
 1
300
301        local
 index
 =
 type
(
code
)
 =
=
 "
number
"
302        local
 f
303        local
 result
304
305        if
 index
 then
306            f
 =
 runscripts
[
code
]
307            if
 not
 f
 then
308                report_luarun
(
"
%i: bad index: %s
"
,
nesting
,
code
)
309            elseif
 trace_luarun
 then
310                report_luarun
(
"
%i: index: %i
"
,
nesting
,
code
)
311            end
312        else
313            if
 trace_luarun
 then
314                report_luarun
(
"
%i: code: %s
"
,
nesting
,
code
)
315            end
316            f
 =
 cache
[
code
]
317            if
 not
 f
 then
318                f
 =
 loadstring
(
"
return 
"
 .
.
 code
)
319                if
 f
 then
320                    cache
[
code
]
 =
 f
321                elseif
 be_tolerant
 then
322                    f
 =
 loadstring
(
code
)
323                    if
 f
 then
324                        cache
[
code
]
 =
 f
325                    end
326                end
327            end
328        end
329
330        -- returning nil is more efficient and a signal not to scan in mp
331
332        if
 f
 then
333
334            local
 lbuffer
,
 ln
335
336            if
 nesting
 =
=
 1
 then
337                buffer
 =
 gbuffer
338                n
      =
 0
339            else
340                lbuffer
 =
 buffer
341                ln
      =
 n
342                buffer
  =
 {
 }
343                n
       =
 0
344            end
345
346            result
 =
 f
(
)
347            if
 result
 then
348                local
 t
 =
 type
(
result
)
349                if
 lmtxmode
 then
350                    -- we can consider to use the injector for tables but then we need to
351                    -- check of concatination is expected so best keep this!
352                    if
 t
 =
=
 "
number
"
 or
 t
 =
=
 "
boolean
"
 then
353                        -- native types
354                    elseif
 t
 =
=
 "
string
"
 or
 t
 =
=
 "
table
"
 then
355                        -- (concatenated) passed to scantokens
356                    else
357                        -- scantokens
358                        result
 =
 tostring
(
result
)
359                    end
360                else
361                    if
 t
 =
=
 "
number
"
 then
362                        result
 =
 f_numeric
(
result
)
363                    elseif
 t
 =
=
 "
table
"
 then
364                        result
 =
 concat
(
result
)
 -- no spaces here
365                    else
366                        result
 =
 tostring
(
result
)
367                    end
368                end
369                if
 trace_luarun
 then
370                    report_luarun
(
"
%i: %s result: %s
"
,
nesting
,
t
,
result
)
371                end
372            elseif
 n
 =
=
 0
 then
373--                 result = ""
374result
 =
 nil
 -- no scantokens done then
375                if
 trace_luarun
 then
376                    report_luarun
(
"
%i: no buffered result
"
,
nesting
)
377                end
378            elseif
 n
 =
=
 1
 then
379                result
 =
 buffer
[
1
]
380                if
 trace_luarun
 then
381                    report_luarun
(
"
%i: 1 buffered result: %s
"
,
nesting
,
result
)
382                end
383            else
384                -- the space is why we sometimes have collectors
385                if
 nesting
 =
=
 1
 then
386                    -- if we had no space we could pass result directly in lmtx
387                    result
 =
 concat
(
buffer
,
"
 
"
,
1
,
n
)
388                    if
 n
 >
 500
 or
 #
result
 >
 10000
 then
389                        gbuffer
 =
 {
 }
 -- newtable(20,0)
390                        lbuffer
 =
 gbuffer
391                    end
392                else
393                    -- if we had no space we could pass result directly in lmtx
394                    result
 =
 concat
(
buffer
,
"
 
"
)
395                end
396                if
 trace_luarun
 then
397                    report_luarun
(
"
%i: %i buffered results: %s
"
,
nesting
,
n
,
result
)
398                end
399            end
400
401            if
 nesting
 =
=
 1
 then
402                n
 =
 0
403            else
404                buffer
 =
 lbuffer
405                n
      =
 ln
406            end
407
408        else
409            report_luarun
(
"
%i: no result, invalid code: %s
"
,
nesting
,
code
)
410            result
 =
 "
"
411        end
412
413        nesting
 =
 nesting
 -
 1
414
415        return
 result
416    end
417
418    function
 metapost
.
nofscriptruns
(
)
419        return
 runs
420    end
421
422    -- writers
423
424    local
 function
 mpp
(
value
)
425        n
 =
 n
 +
 1
426        local
 t
 =
 type
(
value
)
427        if
 t
 =
=
 "
number
"
 then
428            buffer
[
n
]
 =
 f_numeric
(
value
)
429        elseif
 t
 =
=
 "
string
"
 then
430            buffer
[
n
]
 =
 value
431        elseif
 t
 =
=
 "
table
"
 then
432            if
 #
t
 =
=
 6
 then
433                buffer
[
n
]
 =
 "
totransform(
"
 .
.
 concat
(
value
,
"
,
"
)
 .
.
 "
)
"
434            else
435                buffer
[
n
]
 =
 "
(
"
 .
.
 concat
(
value
,
"
,
"
)
 .
.
 "
)
"
436            end
437        else
 -- boolean or whatever
438            buffer
[
n
]
 =
 tostring
(
value
)
439        end
440    end
441
442    local
 function
 mpprint
(
first
,
second
,
...
)
443        if
 second
 =
=
 nil
 then
444            if
 first
 ~
=
 nil
 then
445                mpp
(
first
)
446            end
447        else
448            for
 i
=
1
,
select
(
"
#
"
,
first
,
second
,
...
)
 do
449                local
 value
 =
 (
select
(
i
,
first
,
second
,
...
)
)
450                if
 value
 ~
=
 nil
 then
451                    mpp
(
value
)
452                end
453            end
454        end
455    end
456
457    local
 function
 mpp
(
value
)
458        n
 =
 n
 +
 1
459        local
 t
 =
 type
(
value
)
460        if
 t
 =
=
 "
number
"
 then
461            buffer
[
n
]
 =
 f_numeric
(
value
)
462        elseif
 t
 =
=
 "
string
"
 then
463            buffer
[
n
]
 =
 lpegmatch
(
p
,
value
)
464        elseif
 t
 =
=
 "
table
"
 then
465            if
 #
t
 >
 4
 then
466                buffer
[
n
]
 =
 "
"
467            else
468                buffer
[
n
]
 =
 "
(
"
 .
.
 concat
(
value
,
"
,
"
)
 .
.
 "
)
"
469            end
470        else
 -- boolean or whatever
471            buffer
[
n
]
 =
 tostring
(
value
)
472        end
473    end
474
475    local
 function
 mpvprint
(
first
,
second
,
...
)
 -- variable print
476        if
 second
 =
=
 nil
 then
477            if
 first
 ~
=
 nil
 then
478                mpp
(
first
)
479            end
480        else
481            for
 i
=
1
,
select
(
"
#
"
,
first
,
second
,
...
)
 do
482                local
 value
 =
 (
select
(
i
,
first
,
second
,
...
)
)
483                if
 value
 ~
=
 nil
 then
484                    mpp
(
value
)
485                end
486            end
487        end
488    end
489
490    local
 function
 mpstring
(
value
)
491        n
 =
 n
 +
 1
492        buffer
[
n
]
 =
 lpegmatch
(
p
,
value
)
493    end
494
495    local
 function
 mpboolean
(
b
)
496        n
 =
 n
 +
 1
497        buffer
[
n
]
 =
 b
 and
 "
true
"
 or
 "
false
"
498    end
499
500    local
 function
 mpnumeric
(
f
)
501        n
 =
 n
 +
 1
502        if
 not
 f
 or
 f
 =
=
 0
 then
503            buffer
[
n
]
 =
 "
0
"
504        else
505            buffer
[
n
]
 =
 f_numeric
(
f
)
506        end
507    end
508
509    local
 function
 mpinteger
(
i
)
510        n
 =
 n
 +
 1
511     -- buffer[n] = i and f_integer(i) or "0"
512        buffer
[
n
]
 =
 i
 or
 "
0
"
513    end
514
515    local
 function
 mppoints
(
i
)
516        n
 =
 n
 +
 1
517        if
 not
 i
 or
 i
 =
=
 0
 then
518            buffer
[
n
]
 =
 "
0pt
"
519        else
520            buffer
[
n
]
 =
 f_points
(
i
)
521        end
522    end
523
524    local
 function
 mppair
(
x
,
y
)
525        n
 =
 n
 +
 1
526        if
 type
(
x
)
 =
=
 "
table
"
 then
527            buffer
[
n
]
 =
 f_pair
(
x
[
1
]
,
x
[
2
]
)
528        else
529            buffer
[
n
]
 =
 f_pair
(
x
,
y
)
530        end
531    end
532
533    local
 function
 mppairpoints
(
x
,
y
)
534        n
 =
 n
 +
 1
535        if
 type
(
x
)
 =
=
 "
table
"
 then
536            buffer
[
n
]
 =
 f_pair_pt
(
x
[
1
]
,
x
[
2
]
)
537        else
538            buffer
[
n
]
 =
 f_pair_pt
(
x
,
y
)
539        end
540    end
541
542    local
 function
 mptriplet
(
x
,
y
,
z
)
543        n
 =
 n
 +
 1
544        if
 type
(
x
)
 =
=
 "
table
"
 then
545            buffer
[
n
]
 =
 f_triplet
(
x
[
1
]
,
x
[
2
]
,
x
[
3
]
)
546        else
547            buffer
[
n
]
 =
 f_triplet
(
x
,
y
,
z
)
548        end
549    end
550
551    local
 function
 mptripletpoints
(
x
,
y
,
z
)
552        n
 =
 n
 +
 1
553        if
 type
(
x
)
 =
=
 "
table
"
 then
554            buffer
[
n
]
 =
 f_triplet_pt
(
x
[
1
]
,
x
[
2
]
,
x
[
3
]
)
555        else
556            buffer
[
n
]
 =
 f_triplet_pt
(
x
,
y
,
z
)
557        end
558    end
559
560    local
 function
 mpquadruple
(
w
,
x
,
y
,
z
)
561        n
 =
 n
 +
 1
562        if
 type
(
w
)
 =
=
 "
table
"
 then
563            buffer
[
n
]
 =
 f_quadruple
(
w
[
1
]
,
w
[
2
]
,
w
[
3
]
,
w
[
4
]
)
564        else
565            buffer
[
n
]
 =
 f_quadruple
(
w
,
x
,
y
,
z
)
566        end
567    end
568
569    local
 function
 mpquadruplepoints
(
w
,
x
,
y
,
z
)
570        n
 =
 n
 +
 1
571        if
 type
(
w
)
 =
=
 "
table
"
 then
572            buffer
[
n
]
 =
 f_quadruple_pt
(
w
[
1
]
,
w
[
2
]
,
w
[
3
]
,
w
[
4
]
)
573        else
574            buffer
[
n
]
 =
 f_quadruple_pt
(
w
,
x
,
y
,
z
)
575        end
576    end
577
578    local
 function
 mptransform
(
x
,
y
,
xx
,
xy
,
yx
,
yy
)
579        n
 =
 n
 +
 1
580        if
 type
(
x
)
 =
=
 "
table
"
 then
581            buffer
[
n
]
 =
 f_transform
(
x
[
1
]
,
x
[
2
]
,
x
[
3
]
,
x
[
4
]
,
x
[
5
]
,
x
[
6
]
)
582        else
583            buffer
[
n
]
 =
 f_transform
(
x
,
y
,
xx
,
xy
,
yx
,
yy
)
584        end
585    end
586
587    local
 function
 mpcolor
(
c
,
m
,
y
,
k
)
588        n
 =
 n
 +
 1
589        if
 type
(
c
)
 =
=
 "
table
"
 then
590            local
 l
 =
 #
c
591            if
 l
 =
=
 4
 then
592                buffer
[
n
]
 =
 f_quadruple
(
c
[
1
]
,
c
[
2
]
,
c
[
3
]
,
c
[
4
]
)
593            elseif
 l
 =
=
 3
 then
594                buffer
[
n
]
 =
 f_triplet
(
c
[
1
]
,
c
[
2
]
,
c
[
3
]
)
595            else
596                buffer
[
n
]
 =
 f_numeric
(
c
[
1
]
)
597            end
598        else
599            if
 k
 then
600                buffer
[
n
]
 =
 f_quadruple
(
c
,
m
,
y
,
k
)
601            elseif
 y
 then
602                buffer
[
n
]
 =
 f_triplet
(
c
,
m
,
y
)
603            else
604                buffer
[
n
]
 =
 f_numeric
(
c
)
605            end
606        end
607    end
608
609    -- we have three kind of connectors:
610    --
611    -- .. ... -- (true)
612
613    local
 function
 mp_path
(
f2
,
f6
,
t
,
connector
,
cycle
)
614        if
 type
(
t
)
 =
=
 "
table
"
 then
615            local
 tn
 =
 #
t
616            if
 tn
 =
=
 1
 then
617                local
 t1
 =
 t
[
1
]
618                n
 =
 n
 +
 1
619                if
 t
.
pen
 then
620                    buffer
[
n
]
 =
 f_pen
(
unpack
(
t1
)
)
621                else
622                    buffer
[
n
]
 =
 f2
(
t1
[
1
]
,
t1
[
2
]
)
623                end
624            elseif
 tn
 >
 0
 then
625                if
 connector
 =
=
 true
 or
 connector
 =
=
 nil
 then
626                    connector
 =
 "
..
"
627                elseif
 connector
 =
=
 false
 then
628                    connector
 =
 "
--
"
629                end
630                if
 cycle
 =
=
 nil
 then
631                    cycle
 =
 t
.
cycle
632                    if
 cycle
 =
=
 nil
 then
633                        cycle
 =
 true
634                    end
635                end
636                local
 six
      =
 connector
 =
=
 "
..
"
 -- otherwise we use whatever gets asked for
637                local
 controls
 =
 connector
         -- whatever
638                local
 a
 =
 t
[
1
]
639                local
 b
 =
 t
[
2
]
640                n
 =
 n
 +
 1
641                buffer
[
n
]
 =
 "
(
"
642                n
 =
 n
 +
 1
643                if
 six
 and
 #
a
 =
=
 6
 and
 #
b
 =
=
 6
 then
644                    buffer
[
n
]
 =
 f6
(
a
[
1
]
,
a
[
2
]
,
a
[
5
]
,
a
[
6
]
,
b
[
3
]
,
b
[
4
]
)
645                    controls
  =
 "
..
"
646                else
647                    buffer
[
n
]
 =
 f2
(
a
[
1
]
,
a
[
2
]
)
648                    controls
  =
 connector
649                end
650                for
 i
=
2
,
tn
-1
 do
651                    a
 =
 b
652                    b
 =
 t
[
i
+
1
]
653                    n
 =
 n
 +
 1
654                    buffer
[
n
]
 =
 connector
655                    n
 =
 n
 +
 1
656                    if
 six
 and
 #
a
 =
=
 6
 and
 #
b
 =
=
 6
 then
657                        buffer
[
n
]
 =
 f6
(
a
[
1
]
,
a
[
2
]
,
a
[
5
]
,
a
[
6
]
,
b
[
3
]
,
b
[
4
]
)
658                        controls
  =
 "
..
"
659                    else
660                        buffer
[
n
]
 =
 f2
(
a
[
1
]
,
a
[
2
]
)
661                        controls
  =
 connector
662                    end
663                end
664                n
 =
 n
 +
 1
665                buffer
[
n
]
 =
 connector
666                a
 =
 b
667                b
 =
 t
[
1
]
668                n
 =
 n
 +
 1
669                if
 cycle
 then
670                    if
 six
 and
 #
a
 =
=
 6
 and
 #
b
 =
=
 6
 then
671                        buffer
[
n
]
 =
 f6
(
a
[
1
]
,
a
[
2
]
,
a
[
5
]
,
a
[
6
]
,
b
[
3
]
,
b
[
4
]
)
672                        controls
  =
 "
..
"
673                    else
674                        buffer
[
n
]
 =
 f2
(
a
[
1
]
,
a
[
2
]
)
675                        controls
  =
 connector
676                    end
677                    n
 =
 n
 +
 1
678                    buffer
[
n
]
 =
 connector
679                    n
 =
 n
 +
 1
680                    buffer
[
n
]
 =
 "
cycle
"
681                else
682                    buffer
[
n
]
 =
 f2
(
a
[
1
]
,
a
[
2
]
)
683                end
684                n
 =
 n
 +
 1
685                buffer
[
n
]
 =
 "
)
"
686            end
687        end
688    end
689
690    local
 function
 mppath
(
...
)
691        mp_path
(
f_pair
,
f_ctrl
,
...
)
692    end
693
694    local
 function
 mppathpoints
(
...
)
695        mp_path
(
f_pair_pt
,
f_ctrl_pt
,
...
)
696    end
697
698    local
 function
 mpsize
(
t
)
699        n
 =
 n
 +
 1
700        buffer
[
n
]
 =
 type
(
t
)
 =
=
 "
table
"
 and
 f_numeric
(
#
t
)
 or
 "
0
"
701    end
702
703    local
 replacer
 =
 lpeg
.
replacer
(
"
@
"
,
"
%%
"
)
704
705    local
 function
 mpfprint
(
fmt
,
...
)
706        n
 =
 n
 +
 1
707        if
 not
 find
(
fmt
,
"
%
"
,
1
,
true
)
 then
708            fmt
 =
 lpegmatch
(
replacer
,
fmt
)
709        end
710        buffer
[
n
]
 =
 formatters
[
fmt
]
(
...
)
711    end
712
713    local
 function
 mpquoted
(
fmt
,
s
,
...
)
714        if
 s
 then
715            n
 =
 n
 +
 1
716            if
 not
 find
(
fmt
,
"
%
"
,
1
,
true
)
 then
717                fmt
 =
 lpegmatch
(
replacer
,
fmt
)
718            end
719         -- buffer[n] = '"' .. formatters[fmt](s,...) .. '"'
720            buffer
[
n
]
 =
 lpegmatch
(
p
,
formatters
[
fmt
]
(
s
,
...
)
)
721        elseif
 fmt
 then
722            n
 =
 n
 +
 1
723         -- buffer[n] = '"' .. fmt .. '"'
724            buffer
[
n
]
 =
 lpegmatch
(
p
,
fmt
)
725        else
726            -- something is wrong
727        end
728    end
729
730    aux
.
direct
          =
 mpdirect1
731    aux
.
direct1
         =
 mpdirect1
732    aux
.
direct2
         =
 mpdirect2
733    aux
.
direct3
         =
 mpdirect3
734    aux
.
direct4
         =
 mpdirect4
735    aux
.
flush
           =
 mpflush
736
737    aux
.
print
           =
 mpprint
738    aux
.
vprint
          =
 mpvprint
739    aux
.
boolean
         =
 mpboolean
740    aux
.
string
          =
 mpstring
741    aux
.
numeric
         =
 mpnumeric
742    aux
.
number
          =
 mpnumeric
743    aux
.
integer
         =
 mpinteger
744    aux
.
points
          =
 mppoints
745    aux
.
pair
            =
 mppair
746    aux
.
pairpoints
      =
 mppairpoints
747    aux
.
triplet
         =
 mptriplet
748    aux
.
tripletpoints
   =
 mptripletpoints
749    aux
.
quadruple
       =
 mpquadruple
750    aux
.
quadruplepoints
 =
 mpquadruplepoints
751    aux
.
path
            =
 mppath
752    aux
.
pathpoints
      =
 mppathpoints
753    aux
.
size
            =
 mpsize
754    aux
.
fprint
          =
 mpfprint
755    aux
.
quoted
          =
 mpquoted
756    aux
.
transform
       =
 mptransform
757    aux
.
color
           =
 mpcolor
758
759    -- for the moment
760
761    local
 function
 mpdraw
(
lines
,
list
)
 -- n * 4
762        if
 list
 then
763            local
 c
 =
 #
lines
764            for
 i
=
1
,
c
 do
765                local
 ci
 =
 lines
[
i
]
766                local
 ni
 =
 #
ci
767                n
 =
 n
 +
 1
 buffer
[
n
]
 =
 i
 <
 c
 and
 "
d(
"
 or
 "
D(
"
768                for
 j
=
1
,
ni
,
2
 do
769                    local
 l
 =
 j
 +
 1
770                    n
 =
 n
 +
 1
 buffer
[
n
]
 =
 ci
[
j
]
771                    n
 =
 n
 +
 1
 buffer
[
n
]
 =
 "
,
"
772                    n
 =
 n
 +
 1
 buffer
[
n
]
 =
 ci
[
l
]
773                    n
 =
 n
 +
 1
 buffer
[
n
]
 =
 l
 <
 ni
 and
 "
)--(
"
 or
 "
);
"
774                end
775            end
776        else
777            local
 l
 =
 #
lines
778            local
 m
 =
 l
 -
 4
779            for
 i
=
1
,
l
,
4
 do
780                n
 =
 n
 +
 1
 buffer
[
n
]
 =
 i
 <
 m
 and
 "
d(
"
 or
 "
D(
"
781                n
 =
 n
 +
 1
 buffer
[
n
]
 =
 lines
[
i
]
782                n
 =
 n
 +
 1
 buffer
[
n
]
 =
 "
,
"
783                n
 =
 n
 +
 1
 buffer
[
n
]
 =
 lines
[
i
+
1
]
784                n
 =
 n
 +
 1
 buffer
[
n
]
 =
 "
)--(
"
785                n
 =
 n
 +
 1
 buffer
[
n
]
 =
 lines
[
i
+
2
]
786                n
 =
 n
 +
 1
 buffer
[
n
]
 =
 "
,
"
787                n
 =
 n
 +
 1
 buffer
[
n
]
 =
 lines
[
i
+
3
]
788                n
 =
 n
 +
 1
 buffer
[
n
]
 =
 "
);
"
789            end
790        end
791    end
792
793    local
 function
 mpfill
(
lines
,
list
)
794        if
 list
 then
795            local
 c
 =
 #
lines
796            for
 i
=
1
,
c
 do
797                local
 ci
 =
 lines
[
i
]
798                local
 ni
 =
 #
ci
799                n
 =
 n
 +
 1
 buffer
[
n
]
 =
 i
 <
 c
 and
 "
f(
"
 or
 "
F(
"
800                for
 j
=
1
,
ni
,
2
 do
801                    local
 l
 =
 j
 +
 1
802                    n
 =
 n
 +
 1
 buffer
[
n
]
 =
 ci
[
j
]
803                    n
 =
 n
 +
 1
 buffer
[
n
]
 =
 "
,
"
804                    n
 =
 n
 +
 1
 buffer
[
n
]
 =
 ci
[
l
]
805                    n
 =
 n
 +
 1
 buffer
[
n
]
 =
 l
 <
 ni
 and
 "
)--(
"
 or
 "
)--C;
"
806                end
807            end
808        else
809            local
 l
 =
 #
lines
810            local
 m
 =
 l
 -
 4
811            for
 i
=
1
,
l
,
4
 do
812                n
 =
 n
 +
 1
 buffer
[
n
]
 =
 i
 <
 m
 and
 "
f(
"
 or
 "
F(
"
813                n
 =
 n
 +
 1
 buffer
[
n
]
 =
 lines
[
i
]
814                n
 =
 n
 +
 1
 buffer
[
n
]
 =
 "
,
"
815                n
 =
 n
 +
 1
 buffer
[
n
]
 =
 lines
[
i
+
1
]
816                n
 =
 n
 +
 1
 buffer
[
n
]
 =
 "
)--(
"
817                n
 =
 n
 +
 1
 buffer
[
n
]
 =
 lines
[
i
+
2
]
818                n
 =
 n
 +
 1
 buffer
[
n
]
 =
 "
,
"
819                n
 =
 n
 +
 1
 buffer
[
n
]
 =
 lines
[
i
+
3
]
820                n
 =
 n
 +
 1
 buffer
[
n
]
 =
 "
)--C;
"
821            end
822        end
823    end
824
825    aux
.
draw
 =
 mpdraw
826    aux
.
fill
 =
 mpfill
827
828    for
 k
,
 v
 in
 next
,
 aux
 do
 mp
[
k
]
 =
 v
 end
829
830end
831
832do
833
834    -- Another experimental feature:
835
836    local
 mpnumeric
   =
 mp
.
numeric
837    local
 scanstring
  =
 scan
.
string
838    local
 scriptindex
 =
 metapost
.
scriptindex
839
840    function
 mp
.
mf_script_index
(
name
)
841        local
 index
 =
 scriptindex
(
name
)
842     -- report_script("method %i, name %a, index %i",1,name,index)
843        mpnumeric
(
index
)
844    end
845
846    -- once bootstrapped ... (needs pushed mpx instances)
847
848    metapost
.
registerscript
(
"
scriptindex
"
,
function
(
)
849        local
 name
  =
 scanstring
(
)
850        local
 index
 =
 scriptindex
(
name
)
851     -- report_script("method %i, name %a, index %i",2,name,index)
852        mpnumeric
(
index
)
853    end
)
854
855end
856
857-- the next will move to mlib-lmp.lua
858
859do
860
861    local
 mpnamedcolor
 =
 attributes
.
colors
.
mpnamedcolor
862    local
 mpprint
      =
 aux
.
print
863    local
 scanstring
   =
 scan
.
string
864
865    mp
.
mf_named_color
 =
 function
(
str
)
866        mpprint
(
mpnamedcolor
(
str
)
)
867    end
868
869    -- todo: we can inject but currently we always get a string back so then
870    -- we need to deal with it upstream in the color module ... not now
871
872    metapost
.
registerscript
(
"
namedcolor
"
,
function
(
)
873        mpprint
(
mpnamedcolor
(
scanstring
(
)
)
)
874    end
)
875
876end
877
878function
 mp
.
n
(
t
)
 -- used ?
879    return
 type
(
t
)
 =
=
 "
table
"
 and
 #
t
 or
 0
880end
881
882do
883
884    -- experiment: names can change
885
886    local
 mppath
     =
 aux
.
path
887    local
 mpsize
     =
 aux
.
size
888
889    local
 whitespace
 =
 lpegpatterns
.
whitespace
890    local
 newline
    =
 lpegpatterns
.
newline
891    local
 setsep
     =
 newline
^
2
892    local
 comment
    =
 (
S
(
"
#%
"
)
 +
 P
(
"
--
"
)
)
 *
 (
1
-
newline
)
^
0
 *
 (
whitespace
 -
 setsep
)
^
0
893    local
 value
      =
 (
1
-
whitespace
)
^
1
 /
 tonumber
894    local
 entry
      =
 Ct
(
 value
 *
 whitespace
 *
 value
)
895    local
 set
        =
 Ct
(
(
entry
 *
 (
whitespace
-
setsep
)
^
0
 *
 comment
^
0
)
^
1
)
896    local
 series
     =
 Ct
(
(
set
 *
 whitespace
^
0
)
^
1
)
897
898    local
 pattern
    =
 whitespace
^
0
 *
 series
899
900    local
 datasets
   =
 {
 }
901    mp
.
datasets
      =
 datasets
902
903    function
 mp
.
dataset
(
str
)
904        return
 lpegmatch
(
pattern
,
str
)
905    end
906
907    function
 datasets
.
load
(
tag
,
filename
)
908        if
 not
 filename
 then
909            tag
,
 filename
 =
 file
.
basename
(
tag
)
,
 tag
910        end
911        local
 data
 =
 lpegmatch
(
pattern
,
io
.
loaddata
(
filename
)
 or
 "
"
)
912        datasets
[
tag
]
 =
 {
913            data
 =
 data
,
914            line
 =
 function
(
n
)
 mppath
(
data
[
n
 or
 1
]
)
 end
,
915            size
 =
 function
(
)
  mpsize
(
data
)
         end
,
916        }
917    end
918
919    table
.
setmetatablecall
(
datasets
,
function
(
t
,
k
,
f
,
...
)
920        local
 d
 =
 datasets
[
k
]
921        local
 t
 =
 type
(
d
)
922        if
 t
 =
=
 "
table
"
 then
923            d
 =
 d
[
f
]
924            if
 type
(
d
)
 =
=
 "
function
"
 then
925                d
(
...
)
926            else
927                mpvprint
(
...
)
928            end
929        elseif
 t
 =
=
 "
function
"
 then
930            d
(
f
,
...
)
931        end
932    end
)
933
934end
935
936-- \startluacode
937--     local str = [[
938--         10 20 20 20
939--         30 40 40 60
940--         50 10
941--
942--         10 10 20 30
943--         30 50 40 50
944--         50 20 -- the last one
945--
946--         10 20 % comment
947--         20 10
948--         30 40 # comment
949--         40 20
950--         50 10
951--     ]]
952--
953--     MP.myset = mp.dataset(str)
954--
955--     inspect(MP.myset)
956-- \stopluacode
957--
958-- \startMPpage
959--     color c[] ; c[1] := red ; c[2] := green ; c[3] := blue ;
960--     for i=1 upto lua("mp.print(mp.n(MP.myset))") :
961--         draw lua("mp.path(MP.myset[" & decimal i & "])") withcolor c[i] ;
962--     endfor ;
963-- \stopMPpage
964
965-- texts:
966
967do
968
969    local
 mptriplet
    =
 mp
.
triplet
970
971    local
 bpfactor
     =
 number
.
dimenfactors
.
bp
972    local
 textexts
     =
 nil
973    local
 mptriplet
    =
 mp
.
triplet
974    local
 nbdimensions
 =
 nodes
.
boxes
.
dimensions
975
976    function
 mp
.
mf_tt_initialize
(
tt
)
977        textexts
 =
 tt
978    end
979
980    function
 mp
.
mf_tt_dimensions
(
n
)
981        local
 box
 =
 textexts
 and
 textexts
[
n
]
982        if
 box
 then
983            -- could be made faster with nuts but not critical
984            mptriplet
(
box
.
width
*
bpfactor
,
box
.
height
*
bpfactor
,
box
.
depth
*
bpfactor
)
985        else
986            mptriplet
(
0
,
0
,
0
)
987        end
988    end
989
990    function
 mp
.
mf_tb_dimensions
(
category
,
name
)
991        local
 w
,
 h
,
 d
 =
 nbdimensions
(
category
,
name
)
992        mptriplet
(
w
*
bpfactor
,
h
*
bpfactor
,
d
*
bpfactor
)
993    end
994
995    function
 mp
.
report
(
a
,
b
,
c
,
...
)
996        if
 c
 then
997            report_message
(
"
%s : %s
"
,
a
,
formatters
[
(
gsub
(
b
,
"
@
"
,
"
%%
"
)
)
]
(
c
,
...
)
)
998        elseif
 b
 then
999            report_message
(
"
%s : %s
"
,
a
,
b
)
1000        elseif
 a
 then
1001            report_message
(
"
%s : %s
"
,
"
message
"
,
a
)
1002        end
1003    end
1004
1005end
1006
1007do
1008
1009    local
 mpprint
     =
 aux
.
print
1010    local
 modes
       =
 tex
.
modes
1011    local
 systemmodes
 =
 tex
.
systemmodes
1012
1013    function
 mp
.
mode
(
s
)
1014        mpprint
(
modes
[
s
]
 and
 true
 or
 false
)
1015    end
1016
1017    function
 mp
.
systemmode
(
s
)
1018        mpprint
(
systemmodes
[
s
]
 and
 true
 or
 false
)
1019    end
1020
1021    mp
.
processingmode
 =
 mp
.
mode
1022
1023end
1024
1025-- for alan's nodes:
1026
1027do
1028
1029    local
 mpprint
  =
 aux
.
print
1030    local
 mpquoted
 =
 aux
.
quoted
1031
1032    function
 mp
.
isarray
(
str
)
1033         mpprint
(
find
(
str
,
"
%d
"
)
 and
 true
 or
 false
)
1034    end
1035
1036    function
 mp
.
prefix
(
str
)
1037         mpquoted
(
match
(
str
,
"
^(.-)[%d%[]
"
)
 or
 str
)
1038    end
1039
1040    -- function mp.dimension(str)
1041    --     local n = 0
1042    --     for s in gmatch(str,"%[?%-?%d+%]?") do --todo: lpeg
1043    --         n = n + 1
1044    --     end
1045    --     mpprint(n)
1046    -- end
1047
1048    mp
.
dimension
 =
 lpeg
.
counter
(
P
(
"
[
"
)
 *
 lpegpatterns
.
integer
 *
 P
(
"
]
"
)
 +
 lpegpatterns
.
integer
,
mpprint
)
1049
1050    -- faster and okay as we don't have many variables but probably only
1051    -- basename makes sense and even then it's not called that often
1052
1053    -- local hash  = table.setmetatableindex(function(t,k)
1054    --     local v = find(k,"%d") and true or false
1055    --     t[k] = v
1056    --     return v
1057    -- end)
1058    --
1059    -- function mp.isarray(str)
1060    --      mpprint(hash[str])
1061    -- end
1062    --
1063    -- local hash  = table.setmetatableindex(function(t,k)
1064    --     local v = '"' .. (match(k,"^(.-)%d") or k) .. '"'
1065    --     t[k] = v
1066    --     return v
1067    -- end)
1068    --
1069    -- function mp.prefix(str)
1070    --      mpprint(hash[str])
1071    -- end
1072
1073end
1074
1075do
1076
1077    local
 getmacro
  =
 tex
.
getmacro
1078    local
 getdimen
  =
 tex
.
getdimen
1079    local
 getcount
  =
 tex
.
getcount
1080    local
 gettoks
   =
 tex
.
gettoks
1081    local
 setmacro
  =
 tex
.
setmacro
1082    local
 setdimen
  =
 tex
.
setdimen
1083    local
 setcount
  =
 tex
.
setcount
1084    local
 settoks
   =
 tex
.
settoks
1085
1086    local
 mpprint
   =
 mp
.
print
1087    local
 mpquoted
  =
 mp
.
quoted
1088
1089    local
 bpfactor
  =
 number
.
dimenfactors
.
bp
1090
1091    -- more helpers
1092
1093    local
 function
 getmacro
(
k
)
   mpprint
 (
getmacro
(
k
)
)
 end
1094    local
 function
 getdimen
(
k
)
   mpprint
 (
getdimen
(
k
)
*
bpfactor
)
 end
1095    local
 function
 getcount
(
k
)
   mpprint
 (
getcount
(
k
)
)
 end
1096    local
 function
 gettoks
 (
k
)
   mpquoted
(
gettoks
 (
k
)
)
 end
1097
1098    local
 function
 setmacro
(
k
,
v
)
 setmacro
(
k
,
v
)
 end
1099    local
 function
 setdimen
(
k
,
v
)
 setdimen
(
k
,
v
/
bpfactor
)
 end
1100    local
 function
 setcount
(
k
,
v
)
 setcount
(
k
,
v
)
 end
1101    local
 function
 settoks
 (
k
,
v
)
 settoks
 (
k
,
v
)
 end
1102
1103    -- def foo = lua.mp.foo ... enddef ; % loops due to foo in suffix
1104
1105    mp
.
_get_macro_
 =
 getmacro
   mp
.
getmacro
 =
 getmacro
1106    mp
.
_get_dimen_
 =
 getdimen
   mp
.
getdimen
 =
 getdimen
1107    mp
.
_get_count_
 =
 getcount
   mp
.
getcount
 =
 getcount
1108    mp
.
_get_toks_
  =
 gettoks
    mp
.
gettoks
  =
 gettoks
1109
1110    mp
.
_set_macro_
 =
 setmacro
   mp
.
setmacro
 =
 setmacro
1111    mp
.
_set_dimen_
 =
 setdimen
   mp
.
setdimen
 =
 setdimen
1112    mp
.
_set_count_
 =
 setcount
   mp
.
setcount
 =
 setcount
1113    mp
.
_set_toks_
  =
 settoks
    mp
.
settoks
  =
 settoks
1114
1115end
1116
1117-- position fun
1118
1119do
1120
1121    local
 mpprint
      =
 mp
.
print
1122    local
 mpfprint
     =
 mp
.
fprint
1123    local
 mpquoted
     =
 mp
.
quoted
1124    local
 jobpositions
 =
 job
.
positions
1125    local
 getwhd
       =
 jobpositions
.
whd
1126    local
 getxy
        =
 jobpositions
.
xy
1127    local
 getposition
  =
 jobpositions
.
position
1128    local
 getpage
      =
 jobpositions
.
page
1129    local
 getregion
    =
 jobpositions
.
region
1130    local
 getmacro
     =
 tokens
.
getters
.
macro
1131
1132    function
 mp
.
positionpath
(
name
)
1133        local
 w
,
 h
,
 d
 =
 getwhd
(
name
)
1134        if
 w
 then
1135            mpfprint
(
"
((%p,%p)--(%p,%p)--(%p,%p)--(%p,%p)--cycle)
"
,
0
,
-
d
,
w
,
-
d
,
w
,
h
,
0
,
h
)
1136        else
1137            mpprint
(
"
(origin--cycle)
"
)
1138        end
1139    end
1140
1141    function
 mp
.
positioncurve
(
name
)
1142        local
 w
,
 h
,
 d
 =
 getwhd
(
name
)
1143        if
 w
 then
1144            mpfprint
(
"
((%p,%p)..(%p,%p)..(%p,%p)..(%p,%p)..cycle)
"
,
0
,
-
d
,
w
,
-
d
,
w
,
h
,
0
,
h
)
1145        else
1146            mpprint
(
"
(origin--cycle)
"
)
1147        end
1148    end
1149
1150    function
 mp
.
positionbox
(
name
)
1151        local
 p
,
 x
,
 y
,
 w
,
 h
,
 d
 =
 getposition
(
name
)
1152        if
 p
 then
1153            mpfprint
(
"
((%p,%p)--(%p,%p)--(%p,%p)--(%p,%p)--cycle)
"
,
x
,
y
-
d
,
x
+
w
,
y
-
d
,
x
+
w
,
y
+
h
,
x
,
y
+
h
)
1154        else
1155            mpprint
(
"
(%p,%p)
"
,
x
,
y
)
1156        end
1157    end
1158
1159    function
 mp
.
positionxy
(
name
)
1160        local
 x
,
 y
 =
 getxy
(
name
)
1161        if
 x
 then
1162            mpfprint
(
"
(%p,%p)
"
,
x
,
y
)
1163        else
1164            mpprint
(
"
origin
"
)
1165        end
1166    end
1167
1168    function
 mp
.
positionpage
(
name
)
1169        mpfprint
(
"
%i
"
,
getpage
(
name
)
 or
 0
)
1170    end
1171
1172    function
 mp
.
positionregion
(
name
)
1173        local
 r
 =
 getregion
(
name
)
1174        if
 r
 then
1175            mpquoted
(
r
)
1176        else
1177            mpquoted
(
"
unknown
"
)
1178        end
1179    end
1180
1181    function
 mp
.
positionwhd
(
name
)
1182        local
 w
,
 h
,
 d
 =
 getwhd
(
name
)
1183        if
 w
 then
1184            mpfprint
(
"
(%p,%p,%p)
"
,
w
,
h
,
d
)
1185        else
1186            mpprint
(
"
(0,0,0)
"
)
1187        end
1188    end
1189
1190    function
 mp
.
positionpxy
(
name
)
1191        local
 p
,
 x
,
 y
 =
 getposition
(
name
)
1192        if
 p
 then
1193            mpfprint
(
"
(%p,%p,%p)
"
,
p
,
x
,
y
)
1194        else
1195            mpprint
(
"
(0,0,0)
"
)
1196        end
1197    end
1198
1199    function
 mp
.
positionanchor
(
)
1200        mpquoted
(
getmacro
(
"
MPanchorid
"
)
)
1201    end
1202
1203end
1204
1205do
1206
1207    local
 mppair
 =
 mp
.
pair
1208
1209    function
 mp
.
textextanchor
(
s
)
1210        local
 x
,
 y
 =
 match
(
s
,
"
tx_anchor=(%S+) (%S+)
"
)
 -- todo: make an lpeg
1211        if
 x
 and
 y
 then
1212            x
 =
 tonumber
(
x
)
1213            y
 =
 tonumber
(
y
)
1214        end
1215        mppair
(
x
 or
 0
,
y
 or
 0
)
1216    end
1217
1218end
1219
1220do
1221
1222    local
 mpprint
  =
 mp
.
print
1223    local
 mpquoted
 =
 mp
.
quoted
1224    local
 getmacro
 =
 tokens
.
getters
.
macro
1225
1226    function
 mp
.
texvar
(
name
)
1227        mpprint
(
getmacro
(
metapost
.
namespace
 .
.
 name
)
)
1228    end
1229
1230    function
 mp
.
texstr
(
name
)
1231        mpquoted
(
getmacro
(
metapost
.
namespace
 .
.
 name
)
)
1232    end
1233
1234end
1235
1236do
1237
1238    local
 mpprint
  =
 aux
.
print
1239    local
 mpvprint
 =
 aux
.
vprint
1240
1241    local
 hashes
   =
 {
 }
1242
1243    function
 mp
.
newhash
(
name
)
1244        if
 name
 then
1245            hashes
[
name
]
 =
 {
 }
1246        else
1247            for
 i
=
1
,
#
hashes
+
1
 do
1248                if
 not
 hashes
[
i
]
 then
1249                    hashes
[
i
]
 =
 {
 }
1250                    mpvprint
(
i
)
1251                    return
1252                end
1253            end
1254        end
1255    end
1256
1257    function
 mp
.
disposehash
(
n
)
1258        if
 tonumber
(
n
)
 then
1259            hashes
[
n
]
 =
 false
1260        else
1261            hashes
[
n
]
 =
 nil
1262        end
1263    end
1264
1265    function
 mp
.
inhash
(
n
,
key
)
1266        local
 h
 =
 hashes
[
n
]
1267        mpvprint
(
h
 and
 h
[
key
]
 and
 true
 or
 false
)
1268    end
1269
1270    function
 mp
.
tohash
(
n
,
key
,
value
)
1271        local
 h
 =
 hashes
[
n
]
1272        if
 h
 then
1273            if
 value
 =
=
 nil
 then
1274                h
[
key
]
 =
 true
1275            else
1276                h
[
key
]
 =
 value
1277            end
1278        end
1279    end
1280
1281    function
 mp
.
fromhash
(
n
,
key
)
1282        local
 h
 =
 hashes
[
n
]
1283        mpvprint
(
h
 and
 h
[
key
]
 or
 false
)
1284    end
1285
1286    interfaces
.
implement
 {
1287        name
      =
 "
MPfromhash
"
,
1288        arguments
 =
 "
2 strings
"
,
1289        actions
   =
 function
(
name
,
key
)
1290            local
 h
 =
 hashes
[
name
]
 or
 hashes
[
tonumber
(
name
)
]
1291            if
 h
 then
1292                local
 v
 =
 h
[
key
]
 or
 h
[
tonumber
(
key
)
]
1293                if
 v
 then
1294                    context
(
v
)
1295                end
1296            end
1297        end
1298    }
1299
1300end
1301
1302do
1303
1304    -- a bit overkill: just a find(str,"mf_object=") can be enough
1305    --
1306    -- todo : share with mlib-pps.lua metapost,isobject
1307
1308    local
 mpboolean
 =
 aux
.
boolean
1309
1310    local
 p1
        =
 P
(
"
mf_object=
"
)
1311    local
 p2
        =
 lpegpatterns
.
eol
 *
 p1
1312    local
 pattern
   =
 (
1
-
p2
)
^
0
 *
 p2
 +
 p1
1313
1314    function
 mp
.
isobject
(
str
)
1315        mpboolean
(
pattern
 and
 str
 ~
=
 "
"
 and
 lpegmatch
(
pattern
,
str
)
)
1316    end
1317
1318end
1319
1320function
 mp
.
flatten
(
t
)
1321    local
 tn
 =
 #
t
1322
1323    local
 t1
 =
 t
[
1
]
1324    local
 t2
 =
 t
[
2
]
1325    local
 t3
 =
 t
[
3
]
1326    local
 t4
 =
 t
[
4
]
1327
1328    for
 i
=
1
,
tn
-5
,
2
 do
1329        local
 t5
 =
 t
[
i
+
4
]
1330        local
 t6
 =
 t
[
i
+
5
]
1331        if
 t1
 =
=
 t3
 and
 t3
 =
=
 t5
 and
 (
(
t2
 <
=
 t4
 and
 t4
 <
=
 t6
)
 or
 (
t6
 <
=
 t4
 and
 t4
 <
=
 t2
)
)
 then
1332            t
[
i
+
3
]
 =
 t2
1333            t4
     =
 t2
1334            t
[
i
]
   =
 false
1335            t
[
i
+
1
]
 =
 false
1336        elseif
 t2
 =
=
 t4
 and
 t4
 =
=
 t6
 and
 (
(
t1
 <
=
 t3
 and
 t3
 <
=
 t5
)
 or
 (
t5
 <
=
 t3
 and
 t3
 <
=
 t1
)
)
 then
1337            t
[
i
+
2
]
 =
 t1
1338            t3
     =
 t1
1339            t
[
i
]
   =
 false
1340            t
[
i
+
1
]
 =
 false
1341        end
1342        t1
 =
 t3
1343        t2
 =
 t4
1344        t3
 =
 t5
1345        t4
 =
 t6
1346    end
1347
1348    -- remove duplicates
1349
1350    local
 t1
 =
 t
[
1
]
1351    local
 t2
 =
 t
[
2
]
1352    for
 i
=
1
,
tn
-2
,
2
 do
1353        local
 t3
 =
 t
[
i
+
2
]
1354        local
 t4
 =
 t
[
i
+
3
]
1355        if
 t1
 =
=
 t3
 and
 t2
 =
=
 t4
 then
1356            t
[
i
]
   =
 false
1357            t
[
i
+
1
]
 =
 false
1358        end
1359        t1
 =
 t3
1360        t2
 =
 t4
1361    end
1362
1363    -- move coordinates
1364
1365    local
 m
 =
 0
1366    for
 i
=
1
,
tn
,
2
 do
1367        if
 t
[
i
]
 then
1368            m
 =
 m
 +
 1
 t
[
m
]
 =
 t
[
i
]
1369            m
 =
 m
 +
 1
 t
[
m
]
 =
 t
[
i
+
1
]
1370        end
1371    end
1372
1373    -- prune the table (not gc'd)
1374
1375    for
 i
=
tn
,
m
+
1
,
-1
 do
1376        t
[
i
]
 =
 nil
1377    end
1378
1379    -- safeguard so that we have at least one segment
1380
1381    if
 m
 =
=
 2
 then
1382        t
[
3
]
 =
 t
[
1
]
1383        t
[
4
]
 =
 t
[
2
]
1384    end
1385
1386end
1387
1388do
1389
1390    -- if needed we can optimize the sub (cache last split)
1391
1392    local
 utflen
 =
 utf
.
len
1393    local
 utfsub
 =
 utf
.
sub
1394
1395    function
 mp
.
utflen
(
s
)
1396        mpnumeric
(
utflen
(
s
)
)
1397    end
1398
1399    function
 mp
.
utfsub
(
s
,
f
,
t
)
1400        mpquoted
(
utfsub
(
s
,
f
,
t
 or
 f
)
)
1401    end
1402
1403end
1404
1405
Source Browser ?
