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
10
11
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 {
34 set = set ,
35 get = get ,
36 aux = aux ,
37 scan = scan ,
38 inject = inject ,
39}
40
41MP = MP or {
42}
43
44
45
46
47
48
49
50
51
52
53
54
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
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
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
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
192
193
194do
195
196 local lmtxmode = CONTEXTLMTXMODE > 0
197
198
199
200 local f_integer = formatters [ " %i " ]
201 local f_numeric = formatters [ " %F " ]
202
203
204
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
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
232
233
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
257
258
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
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
351
352 if t = = " number " or t = = " boolean " then
353
354 elseif t = = " string " or t = = " table " then
355
356 else
357
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 )
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
374result = nil
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
385 if nesting = = 1 then
386
387 result = concat ( buffer , " " , 1 , n )
388 if n > 500 or # result > 10000 then
389 gbuffer = { }
390 lbuffer = gbuffer
391 end
392 else
393
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
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
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
471 buffer [ n ] = tostring ( value )
472 end
473 end
474
475 local function mpvprint ( first , second , ... )
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
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
610
611
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 = = " .. "
637 local controls = connector
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
720 buffer [ n ] = lpegmatch ( p , formatters [ fmt ] ( s , ... ) )
721 elseif fmt then
722 n = n + 1
723
724 buffer [ n ] = lpegmatch ( p , fmt )
725 else
726
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
760
761 local function mpdraw ( lines , list )
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
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
843 mpnumeric ( index )
844 end
845
846
847
848 metapost . registerscript ( " scriptindex " , function ( )
849 local name = scanstring ( )
850 local index = scriptindex ( name )
851
852 mpnumeric ( index )
853 end )
854
855end
856
857
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
870
871
872 metapost . registerscript ( " namedcolor " , function ( )
873 mpprint ( mpnamedcolor ( scanstring ( ) ) )
874 end )
875
876end
877
878function mp . n ( t )
879 return type ( t ) = = " table " and # t or 0
880end
881
882do
883
884
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
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
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
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
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
1041
1042
1043
1044
1045
1046
1047
1048 mp . dimension = lpeg . counter ( P ( " [ " ) * lpegpatterns . integer * P ( " ] " ) + lpegpatterns . integer , mpprint )
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
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
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
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
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+) " )
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
1305
1306
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
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
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
1374
1375 for i = tn , m + 1 , -1 do
1376 t [ i ] = nil
1377 end
1378
1379
1380
1381 if m = = 2 then
1382 t [ 3 ] = t [ 1 ]
1383 t [ 4 ] = t [ 2 ]
1384 end
1385
1386end
1387
1388do
1389
1390
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 |