1if not modules then modules = { } end modules [ ' mlib-pdf ' ] = {
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
9local gsub = string . gsub
10local concat , insert , remove = table . concat , table . insert , table . remove
11local abs , sqrt , round = math . abs , math . sqrt , math . round
12local setmetatable , rawset , tostring , tonumber , type = setmetatable , rawset , tostring , tonumber , type
13local P , S , C , Ct , Cc , Cg , Cf , Carg = lpeg . P , lpeg . S , lpeg . C , lpeg . Ct , lpeg . Cc , lpeg . Cg , lpeg . Cf , lpeg . Carg
14local lpegmatch = lpeg . match
15local formatters = string . formatters
16
17local report_metapost = logs . reporter ( " metapost " )
18
19local trace_variables = false trackers . register ( " metapost.variables " , function ( v ) trace_variables = v end )
20
21local mplib = mplib
22local context = context
23
24local allocate = utilities . storage . allocate
25
26local pen_info = mplib . pen_info
27local getfields = mplib . getfields or mplib . fields
28
29local save_table = false
30local force_stroke = false
31
32metapost = metapost or { }
33local metapost = metapost
34
35metapost . flushers = metapost . flushers or { }
36local pdfflusher = { }
37metapost . flushers . pdf = pdfflusher
38
39metapost . n = 0
40
41local experiment = true
42local savedliterals = nil
43local mpsliteral = nodes . pool . originliteral
44
45local f_f = formatters [ " %.6N " ]
46local f_m = formatters [ " %.6N %.6N m " ]
47local f_c = formatters [ " %.6N %.6N %.6N %.6N %.6N %.6N c " ]
48local f_l = formatters [ " %.6N %.6N l " ]
49local f_cm = formatters [ " %.6N %.6N %.6N %.6N %.6N %.6N cm " ]
50local f_M = formatters [ " %.6N M " ]
51local f_j = formatters [ " %i j " ]
52local f_J = formatters [ " %i J " ]
53local f_d = formatters [ " [%s] %.6N d " ]
54local f_w = formatters [ " %.6N w " ]
55
56directives . register ( " metapost.savetable " , function ( v )
57 if type ( v ) = = " string " then
58 save_table = file . addsuffix ( v , " mpl " )
59 elseif v then
60 save_table = file . addsuffix ( environment . jobname . . " -graphic " , " mpl " )
61 else
62 save_table = false
63 end
64end )
65
66trackers . register ( " metapost.forcestroke " , function ( v )
67 force_stroke = v
68end )
69
70
71
72
73
74
75local function getobjects ( result , figure , index )
76 return figure : objects ( )
77end
78
79function metapost . convert ( specification , result )
80 local flusher = specification . flusher
81 local askedfig = specification . askedfig
82 if save_table then
83 table . save ( save_table , metapost . totable ( result , 1 ) )
84 end
85 metapost . flush ( specification , result )
86 return true
87end
88
89function metapost . flushliteral ( d )
90 if savedliterals then
91 context ( mpsliteral ( savedliterals [ d ] ) )
92 else
93 report_metapost ( " problem flushing literal %a " , d )
94 end
95end
96
97function metapost . flushreset ( )
98 savedliterals = nil
99end
100
101function pdfflusher . comment ( message )
102 if message then
103 message = formatters [ " %% mps graphic %s: %s " ] ( metapost . n , message )
104 if experiment then
105 context ( mpsliteral ( message ) )
106 elseif savedliterals then
107 local last = # savedliterals + 1
108 savedliterals [ last ] = message
109 context . MPLIBtoPDF ( last )
110 else
111 savedliterals = { message }
112 context . MPLIBtoPDF ( 1 )
113 end
114 end
115end
116
117function pdfflusher . startfigure ( n , llx , lly , urx , ury , message )
118 savedliterals = nil
119 metapost . n = metapost . n + 1
120 context . startMPLIBtoPDF ( f_f ( llx ) , f_f ( lly ) , f_f ( urx ) , f_f ( ury ) )
121 if message then pdfflusher . comment ( message ) end
122end
123
124function pdfflusher . stopfigure ( message )
125 if message then pdfflusher . comment ( message ) end
126 context . stopMPLIBtoPDF ( )
127 context . MPLIBflushreset ( )
128end
129
130function pdfflusher . flushfigure ( pdfliterals )
131 if # pdfliterals > 0 then
132 pdfliterals = concat ( pdfliterals , " \n " )
133 if experiment then
134 context ( mpsliteral ( pdfliterals ) )
135 else
136 if savedliterals then
137 local last = # savedliterals + 1
138 savedliterals [ last ] = pdfliterals
139 context . MPLIBtoPDF ( last )
140 else
141 savedliterals = { pdfliterals }
142 context . MPLIBtoPDF ( 1 )
143 end
144 end
145 end
146end
147
148function pdfflusher . textfigure ( font , size , text , width , height , depth )
149 text = gsub ( text , " . " , " \\hbox{%1} " )
150 context . MPtextext ( font , size , text , 0 , - number . dimenfactors . bp * depth )
151end
152
153local bend_tolerance = 131 / 65536
154
155local rx , sx , sy , ry , tx , ty , divider = 1 , 0 , 0 , 1 , 0 , 0 , 1
156
157local function pen_characteristics ( object )
158 local t = pen_info ( object )
159 rx , ry , sx , sy , tx , ty = t . rx , t . ry , t . sx , t . sy , t . tx , t . ty
160 divider = sx * sy - rx * ry
161 return not ( sx = = 1 and rx = = 0 and ry = = 0 and sy = = 1 and tx = = 0 and ty = = 0 ) , t . width
162end
163
164local function mpconcat ( px , py )
165 return ( sy * px - ry * py ) / divider , ( sx * py - rx * px ) / divider
166end
167
168local function curved ( ith , pth )
169 local d = pth . left_x - ith . right_x
170 if abs ( ith . right_x - ith . x_coord - d ) < = bend_tolerance and abs ( pth . x_coord - pth . left_x - d ) < = bend_tolerance then
171 d = pth . left_y - ith . right_y
172 if abs ( ith . right_y - ith . y_coord - d ) < = bend_tolerance and abs ( pth . y_coord - pth . left_y - d ) < = bend_tolerance then
173 return false
174 end
175 end
176 return true
177end
178
179local function flushnormalpath ( path , t , open )
180 local pth , ith , nt
181 local length = # path
182 if t then
183 nt = # t
184 else
185 t = { }
186 nt = 0
187 end
188 for i = 1 , length do
189 nt = nt + 1
190 pth = path [ i ]
191 if not ith then
192 t [ nt ] = f_m ( pth . x_coord , pth . y_coord )
193 elseif curved ( ith , pth ) then
194 t [ nt ] = f_c ( ith . right_x , ith . right_y , pth . left_x , pth . left_y , pth . x_coord , pth . y_coord )
195 else
196 t [ nt ] = f_l ( pth . x_coord , pth . y_coord )
197 end
198 ith = pth
199 end
200 if not open then
201 nt = nt + 1
202 local one = path [ 1 ]
203 if curved ( pth , one ) then
204 t [ nt ] = f_c ( pth . right_x , pth . right_y , one . left_x , one . left_y , one . x_coord , one . y_coord )
205 else
206 t [ nt ] = f_l ( one . x_coord , one . y_coord )
207 end
208 elseif length = = 1 then
209
210 local one = path [ 1 ]
211 nt = nt + 1
212 t [ nt ] = f_l ( one . x_coord , one . y_coord )
213 end
214 return t
215end
216
217local function flushconcatpath ( path , t , open , transform )
218 local pth , ith , nt
219 local length = # path
220 if t then
221 nt = # t
222 else
223 t = { }
224 nt = 0
225 end
226 if transform then
227 nt = nt + 1
228 t [ nt ] = f_cm ( sx , rx , ry , sy , tx , ty )
229 end
230 for i = 1 , length do
231 nt = nt + 1
232 pth = path [ i ]
233 if not ith then
234 t [ nt ] = f_m ( mpconcat ( pth . x_coord , pth . y_coord ) )
235 elseif curved ( ith , pth ) then
236 local a , b = mpconcat ( ith . right_x , ith . right_y )
237 local c , d = mpconcat ( pth . left_x , pth . left_y )
238 t [ nt ] = f_c ( a , b , c , d , mpconcat ( pth . x_coord , pth . y_coord ) )
239 else
240 t [ nt ] = f_l ( mpconcat ( pth . x_coord , pth . y_coord ) )
241 end
242 ith = pth
243 end
244 if not open then
245 nt = nt + 1
246 local one = path [ 1 ]
247 if curved ( pth , one ) then
248 local a , b = mpconcat ( pth . right_x , pth . right_y )
249 local c , d = mpconcat ( one . left_x , one . left_y )
250 t [ nt ] = f_c ( a , b , c , d , mpconcat ( one . x_coord , one . y_coord ) )
251 else
252 t [ nt ] = f_l ( mpconcat ( one . x_coord , one . y_coord ) )
253 end
254 elseif length = = 1 then
255
256 nt = nt + 1
257 local one = path [ 1 ]
258 t [ nt ] = f_l ( mpconcat ( one . x_coord , one . y_coord ) )
259 end
260 return t
261end
262
263local function toboundingbox ( path )
264 local size = # path
265 if size = = 4 then
266 local pth = path [ 1 ]
267 local x = pth . x_coord
268 local y = pth . y_coord
269 local llx , lly , urx , ury = x , y , x , y
270 for i = 2 , size do
271 pth = path [ i ]
272 x = pth . x_coord
273 y = pth . y_coord
274 if x < llx then
275 llx = x
276 elseif x > urx then
277 urx = x
278 end
279 if y < lly then
280 lly = y
281 elseif y > ury then
282 ury = y
283 end
284 end
285 return { llx , lly , urx , ury }
286 else
287 return { 0 , 0 , 0 , 0 }
288 end
289end
290
291metapost . flushnormalpath = flushnormalpath
292
293
294
295
296
297
298
299
300
301
302
303local ignore = function ( ) end
304
305local space = P ( " " )
306local equal = P ( " = " )
307local key = C ( ( 1 - equal ) ^ 1 ) * equal
308local newline = S ( " \n\r " ) ^ 1
309local number = ( ( ( 1 - space - newline ) ^ 1 ) / tonumber ) * ( space ^ 0 )
310
311local p_number = number
312local p_string = C ( ( 1 - newline ) ^ 0 )
313local p_boolean = P ( " false " ) * Cc ( false ) + P ( " true " ) * Cc ( true )
314local p_set = Ct ( number ^ 1 )
315local p_path = Ct ( Ct ( number * number ^ -5 ) ^ 1 )
316
317local variable =
318 P ( " 1: " ) * p_number
319 + P ( " 2: " ) * p_string
320 + P ( " 3: " ) * p_boolean
321 + S ( " 4568 " ) * P ( " : " ) * p_set
322 + P ( " 7: " ) * p_path
323
324local pattern_tab = Cf ( Carg ( 1 ) * ( Cg ( variable * newline ^ 0 ) ^ 0 ) , rawset )
325
326local variable =
327 P ( " 1: " ) * p_number
328 + P ( " 2: " ) * p_string
329 + P ( " 3: " ) * p_boolean
330 + S ( " 4568 " ) * P ( " : " ) * number ^ 1
331 + P ( " 7: " ) * ( number * number ^ -5 ) ^ 1
332
333local pattern_lst = ( variable * newline ^ 0 ) ^ 0
334
335metapost . variables = { }
336metapost . properties = { }
337
338function metapost . untagvariable ( str , variables )
339 if variables = = false then
340 return lpegmatch ( pattern_lst , str )
341 else
342 return lpegmatch ( pattern_tab , str , 1 , variables or { } )
343 end
344end
345
346
347
348
349
350function metapost . processspecial ( str )
351 local code = loadstring ( str )
352 if code then
353 if trace_variables then
354 report_metapost ( " executing special code: %s " , str )
355 end
356 code ( )
357 else
358 report_metapost ( " invalid special code: %s " , str )
359 end
360end
361
362local stack = { }
363
364local function pushproperties ( figure )
365
366 local boundingbox = figure : boundingbox ( )
367 local slot = figure : charcode ( ) or 0
368 local properties = {
369 llx = boundingbox [ 1 ] ,
370 lly = boundingbox [ 2 ] ,
371 urx = boundingbox [ 3 ] ,
372 ury = boundingbox [ 4 ] ,
373 slot = slot ,
374 width = figure : width ( ) ,
375 height = figure : height ( ) ,
376 depth = figure : depth ( ) ,
377 italic = figure : italcorr ( ) ,
378 number = slot ,
379 }
380 insert ( stack , properties )
381 metapost . properties = properties
382 return properties
383end
384
385local function popproperties ( )
386 metapost . properties = remove ( stack )
387end
388
389local function nocomment ( ) end
390
391metapost . comment = nocomment
392
393function metapost . flush ( specification , result )
394 if result then
395 local flusher = specification . flusher
396 local askedfig = specification . askedfig
397 local incontext = specification . incontext
398 local figures = result . fig
399 if figures then
400 flusher = flusher or pdfflusher
401 local resetplugins = metapost . resetplugins or ignore
402 local processplugins = metapost . processplugins or ignore
403 local synchronizeplugins = metapost . synchronizeplugins or ignore
404 local pluginactions = metapost . pluginactions or ignore
405 local startfigure = flusher . startfigure
406 local stopfigure = flusher . stopfigure
407 local flushfigure = flusher . flushfigure
408 local textfigure = flusher . textfigure
409 local processspecial = flusher . processspecial or metapost . processspecial
410 metapost . comment = flusher . comment or nocomment
411 for index = 1 , # figures do
412 local figure = figures [ index ]
413 local properties = pushproperties ( figure )
414 if askedfig = = " direct " or askedfig = = " all " or askedfig = = properties . number then
415 local objects = getobjects ( result , figure , index )
416 local result = { }
417 local miterlimit = -1
418 local linecap = -1
419 local linejoin = -1
420 local dashed = false
421 local linewidth = false
422 local llx = properties . llx
423 local lly = properties . lly
424 local urx = properties . urx
425 local ury = properties . ury
426 if urx < llx then
427
428 startfigure ( properties . number , 0 , 0 , 0 , 0 , " invalid " , figure )
429 stopfigure ( )
430 else
431
432
433
434 local groupstack = { }
435
436 local function processfigure ( )
437 result [ # result + 1 ] = " q "
438 if objects then
439
440 local savedpath = nil
441 local savedhtap = nil
442 for o = 1 , # objects do
443 local object = objects [ o ]
444 local objecttype = object . type
445 if objecttype = = " text " then
446 result [ # result + 1 ] = " q "
447 local ot = object . transform
448 result [ # result + 1 ] = f_cm ( ot [ 3 ] , ot [ 4 ] , ot [ 5 ] , ot [ 6 ] , ot [ 1 ] , ot [ 2 ] )
449 flushfigure ( result )
450 result = { }
451 textfigure ( object . font , object . dsize , object . text , object . width , object . height , object . depth )
452 result [ # result + 1 ] = " Q "
453 elseif objecttype = = " special " then
454 if processspecial then
455 processspecial ( object . prescript )
456 end
457 elseif objecttype = = " start_clip " then
458 local evenodd = not object . istext and object . postscript = = " evenodd "
459 result [ # result + 1 ] = " q "
460 flushnormalpath ( object . path , result , false )
461 result [ # result + 1 ] = evenodd and " W* n " or " W n "
462 elseif objecttype = = " stop_clip " then
463 result [ # result + 1 ] = " Q "
464 miterlimit , linecap , linejoin , dashed , linewidth = -1 , -1 , -1 , " " , false
465 elseif objecttype = = " start_bounds " or objecttype = = " stop_bounds " then
466
467 elseif objecttype = = " start_group " then
468 if lpdf . flushgroup then
469 local before , after = processplugins ( object )
470 if before then
471 result [ # result + 1 ] = " q "
472 result = pluginactions ( before , result , flushfigure )
473 insert ( groupstack , {
474 after = after ,
475 result = result ,
476 bbox = toboundingbox ( object . path ) ,
477 } )
478 result = { }
479 miterlimit , linecap , linejoin , dashed , linewidth = -1 , -1 , -1 , " " , false
480 else
481 insert ( groupstack , false )
482 end
483 else
484 insert ( groupstack , false )
485 end
486 elseif objecttype = = " stop_group " then
487 local data = remove ( groupstack )
488 if data then
489 local reference = lpdf . flushgroup ( concat ( result , " \r " ) , data . bbox )
490 result = data . result
491 result [ # result + 1 ] = reference
492 result = pluginactions ( data . after , result , flushfigure )
493 result [ # result + 1 ] = " Q "
494 miterlimit , linecap , linejoin , dashed , linewidth = -1 , -1 , -1 , " " , false
495 end
496 else
497
498
499
500
501
502 local original = object
503 local object = { }
504 setmetatable ( object , {
505 __index = original
506 } )
507 local before ,
508 after = processplugins ( object )
509 local evenodd = false
510 local collect = false
511 local both = false
512 local flush = false
513 local postscript = object . postscript
514 if not object . istext then
515 if postscript = = " evenodd " then
516 evenodd = true
517 elseif postscript = = " collect " then
518 collect = true
519 elseif postscript = = " flush " then
520 flush = true
521 elseif postscript = = " both " then
522 both = true
523 elseif postscript = = " eoboth " then
524 evenodd = true
525 both = true
526 end
527 end
528
529 if flush and not savedpath then
530
531 elseif collect then
532 if not savedpath then
533 savedpath = { object . path or false }
534 savedhtap = { object . htap or false }
535 else
536 savedpath [ # savedpath + 1 ] = object . path or false
537 savedhtap [ # savedhtap + 1 ] = object . htap or false
538 end
539 else
540 local objecttype = object . type
541 if before then
542 result = pluginactions ( before , result , flushfigure )
543 end
544 local ml = object . miterlimit
545 if ml and ml ~ = miterlimit then
546 miterlimit = ml
547 result [ # result + 1 ] = f_M ( ml )
548 end
549 local lj = object . linejoin
550 if lj and lj ~ = linejoin then
551 linejoin = lj
552 result [ # result + 1 ] = f_j ( lj )
553 end
554 local lc = object . linecap
555 if lc and lc ~ = linecap then
556 linecap = lc
557 result [ # result + 1 ] = f_J ( lc )
558 end
559 if both then
560 if dashed ~ = false then
561 result [ # result + 1 ] = " [] 0 d "
562 dashed = false
563 end
564 else
565 local dl = object . dash
566 if dl then
567 local d = f_d ( concat ( dl . dashes or { } , " " ) , dl . offset )
568 if d ~ = dashed then
569 dashed = d
570 result [ # result + 1 ] = d
571 end
572 elseif dashed ~ = false then
573 result [ # result + 1 ] = " [] 0 d "
574 dashed = false
575 end
576 end
577 local path = object . path
578 local transformed = false
579 local penwidth = 1
580 local open = path and path [ 1 ] . left_type and path [ # path ] . right_type
581 local pen = object . pen
582 if pen then
583 if pen . type = = " elliptical " then
584 transformed , penwidth = pen_characteristics ( original )
585 if penwidth ~ = linewidth then
586 result [ # result + 1 ] = f_w ( penwidth )
587 linewidth = penwidth
588 end
589 if objecttype = = " fill " then
590 objecttype = " both "
591 end
592 else
593 objecttype = " fill "
594 end
595 end
596 if transformed then
597 result [ # result + 1 ] = " q "
598 end
599 if path then
600 if savedpath then
601 for i = 1 , # savedpath do
602 local path = savedpath [ i ]
603 if transformed then
604 flushconcatpath ( path , result , open , i = = 1 )
605 else
606 flushnormalpath ( path , result , open )
607 end
608 end
609 savedpath = nil
610 end
611 if flush then
612
613 elseif transformed then
614 flushconcatpath ( path , result , open , true )
615 else
616 flushnormalpath ( path , result , open )
617 end
618 if force_stroke then
619 result [ # result + 1 ] = open and " S " or " h S "
620 elseif objecttype = = " fill " then
621 result [ # result + 1 ] = evenodd and " h f* " or " h f "
622 elseif objecttype = = " outline " then
623 if both then
624 result [ # result + 1 ] = evenodd and " h B* " or " h B "
625 else
626 result [ # result + 1 ] = open and " S " or " h S "
627 end
628 elseif objecttype = = " both " then
629 result [ # result + 1 ] = evenodd and " h B* " or " h B "
630 end
631 end
632 if transformed then
633 result [ # result + 1 ] = " Q "
634 end
635 local path = object . htap
636 if path then
637 if transformed then
638 result [ # result + 1 ] = " q "
639 end
640 if savedhtap then
641 for i = 1 , # savedhtap do
642 local path = savedhtap [ i ]
643 if transformed then
644 flushconcatpath ( path , result , open , i = = 1 )
645 else
646 flushnormalpath ( path , result , open )
647 end
648 end
649 savedhtap = nil
650 evenodd = true
651 end
652 if transformed then
653 flushconcatpath ( path , result , open , true )
654 else
655 flushnormalpath ( path , result , open )
656 end
657 if force_stroke then
658 result [ # result + 1 ] = open and " S " or " h S "
659 elseif objecttype = = " fill " then
660 result [ # result + 1 ] = evenodd and " h f* " or " h f "
661 elseif objecttype = = " outline " then
662 result [ # result + 1 ] = open and " S " or " h S "
663 elseif objecttype = = " both " then
664 result [ # result + 1 ] = evenodd and " h B* " or " h B "
665 end
666 if transformed then
667 result [ # result + 1 ] = " Q "
668 end
669 end
670 if after then
671 result = pluginactions ( after , result , flushfigure )
672 end
673 end
674 if object . grouped then
675
676 miterlimit , linecap , linejoin , dashed , linewidth = -1 , -1 , -1 , " " , false
677 end
678 end
679 end
680 end
681 result [ # result + 1 ] = " Q "
682 flushfigure ( result )
683 end
684 startfigure ( properties . number , llx , lly , urx , ury , " begin " , figure )
685 if incontext then
686 context ( function ( ) processfigure ( ) end )
687 else
688 processfigure ( )
689 end
690 stopfigure ( " end " )
691
692 end
693 if askedfig ~ = " all " then
694 break
695 end
696 end
697 popproperties ( )
698 end
699 metapost . comment = nocomment
700 resetplugins ( result )
701 end
702 end
703end
704
705
706
707do
708
709 local result = { }
710
711 local flusher = {
712 startfigure = function ( )
713 result = { }
714 context . startnointerference ( )
715 end ,
716 flushfigure = function ( literals )
717 local n = # result
718 for i = 1 , # literals do
719 result [ n + i ] = literals [ i ]
720 end
721 end ,
722 stopfigure = function ( )
723 context . stopnointerference ( )
724 end
725 }
726
727 local specification = {
728 flusher = flusher ,
729
730 }
731
732 function metapost . pdfliterals ( result )
733 metapost . flush ( specification , result )
734 return result
735 end
736
737end
738
739function metapost . totable ( result , askedfig )
740 local askedfig = askedfig or 1
741 local figure = result and result . fig and result . fig [ 1 ]
742 if figure then
743 local results = { }
744 local objects = getobjects ( result , figure , askedfig )
745 for o = 1 , # objects do
746 local object = objects [ o ]
747 local result = { }
748 local fields = getfields ( object )
749 for f = 1 , # fields do
750 local field = fields [ f ]
751 result [ field ] = object [ field ]
752 end
753 results [ o ] = result
754 end
755 local boundingbox = figure : boundingbox ( )
756 return {
757 boundingbox = {
758 llx = boundingbox [ 1 ] ,
759 lly = boundingbox [ 2 ] ,
760 urx = boundingbox [ 3 ] ,
761 ury = boundingbox [ 4 ] ,
762 } ,
763 objects = results
764 }
765 else
766 return nil
767 end
768end
769 |
