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