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