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