1
2
3
4
5
6
7
8
9
10
11
12
13
14if unknown mplib : endinput ; fi ;
15if known context_mlib : endinput ; fi ;
16
17boolean context_mlib ; context_mlib := true ;
18
19
20
21
22
23vardef isobject expr p =
24 if picture p :
25
26 runscript("mp.isobject(" & prescriptpart p & ")")
27 else :
28 false
29 fi
30enddef ;
31
32
33
34
35
36newinternal normaltransparent ; normaltransparent := 1 ;
37newinternal multiplytransparent ; multiplytransparent := 2 ;
38newinternal screentransparent ; screentransparent := 3 ;
39newinternal overlaytransparent ; overlaytransparent := 4 ;
40newinternal softlighttransparent ; softlighttransparent := 5 ;
41newinternal hardlighttransparent ; hardlighttransparent := 6 ;
42newinternal colordodgetransparent ; colordodgetransparent := 7 ;
43newinternal colorburntransparent ; colorburntransparent := 8 ;
44newinternal darkentransparent ; darkentransparent := 9 ;
45newinternal lightentransparent ; lightentransparent := 10 ;
46newinternal differencetransparent ; differencetransparent := 11 ;
47newinternal exclusiontransparent ; exclusiontransparent := 12 ;
48
49
50
51newinternal huetransparent ; huetransparent := 13 ;
52newinternal saturationtransparent ; saturationtransparent := 14 ;
53newinternal colortransparent ; colortransparent := 15 ;
54newinternal luminositytransparent ; luminositytransparent := 16 ;
55
56vardef transparency_alternative_to_number(expr name) =
57 if string name :
58 if expandafter known scantokens(name & "transparent") :
59 scantokens(name & "transparent")
60 else :
61 0
62 fi
63 elseif name < 17 :
64 name
65 else :
66 0
67 fi
68enddef ;
69
70def namedcolor expr n =
71 (1)
72 withprescript "sp_type=named"
73 withprescript "sp_name=" & n
74enddef ;
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92def spotcolor(expr name, v) =
93 (1)
94 withprescript "sp_type=spot"
95 withprescript "sp_name=" & name
96 withprescript "sp_value=" & colordecimals v
97enddef ;
98
99
100
101def multitonecolor(expr name)(text t) =
102 (1)
103 withprescript "sp_type=multitone"
104 withprescript "sp_name=" & name
105 withprescript "sp_value=" & colordecimalslist(t)
106enddef ;
107
108def transparent(expr a, t)(text c) =
109 (1)
110 withprescript "tr_alternative=" & decimal transparency_alternative_to_number(a)
111 withprescript "tr_transparency=" & decimal t
112 withcolor c
113enddef ;
114
115def withtransparency(expr a, t) =
116 withprescript "tr_alternative=" & decimal transparency_alternative_to_number(a)
117 withprescript "tr_transparency=" & decimal t
118enddef ;
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136def withopacity expr t =
137 if pair t :
138 withprescript "tr_alternative=" & decimal transparency_alternative_to_number(xpart t)
139 withprescript "tr_transparency=" & decimal ypart t
140 else :
141 mfun_with_opacity (transparency_alternative_to_number(t))
142 fi
143enddef ;
144
145def mfun_with_opacity (expr a) expr t =
146 withprescript "tr_alternative=" & decimal a
147 withprescript "tr_transparency=" & decimal t
148enddef ;
149
150
151
152def cmyk(expr c, m, y, k) =
153 (c,m,y,k)
154enddef ;
155
156
157
158newinternal textextoffset ; textextoffset := 0 ;
159
160
161color mfun_tt_b ;
162numeric mfun_tt_n ; mfun_tt_n := 0 ;
163picture mfun_tt_p ; mfun_tt_p := nullpicture ;
164picture mfun_tt_o ; mfun_tt_o := nullpicture ;
165picture mfun_tt_c ; mfun_tt_c := nullpicture ;
166
167if unknown mfun_trial_run :
168 boolean mfun_trial_run ;
169 mfun_trial_run := false ;
170else :
171
172fi ;
173
174def mfun_reset_tex_texts =
175 mfun_tt_n := 0 ;
176 mfun_tt_p := nullpicture ;
177 mfun_tt_o := nullpicture ;
178 mfun_tt_c := nullpicture ;
179enddef ;
180
181def mfun_flush_tex_texts =
182 addto currentpicture also mfun_tt_p
183enddef ;
184
185extra_endfig := "mfun_flush_tex_texts ;" & extra_endfig ;
186extra_beginfig := extra_beginfig & "mfun_reset_tex_texts ;" ;
187
188
189
190
191
192
193boolean mfun_onetime_textext ; mfun_onetime_textext := false ;
194numeric mfun_global_textext ; mfun_global_textext := 0 ;
195
196def keepcached =
197 hide(mfun_global_textext := mfun_global_textext 1;)
198 withprescript ("tx_cache=" & decimal mfun_global_textext)
199enddef ;
200
201def notcached =
202 withprescript "tx_cache=no"
203enddef ;
204
205
206
207rgbcolor mfun_tt_r ;
208
209newinternal inicatcoderegime ; inicatcoderegime := runscript("return catcodes.numbers.ctxcatcodes") ;
210newinternal texcatcoderegime ; texcatcoderegime := runscript("return catcodes.numbers.texcatcodes") ;
211newinternal luacatcoderegime ; luacatcoderegime := runscript("return catcodes.numbers.luacatcodes") ;
212newinternal notcatcoderegime ; notcatcoderegime := runscript("return catcodes.numbers.notcatcodes") ;
213newinternal vrbcatcoderegime ; vrbcatcoderegime := runscript("return catcodes.numbers.vrbcatcodes") ;
214newinternal prtcatcoderegime ; prtcatcoderegime := runscript("return catcodes.numbers.prtcatcodes") ;
215newinternal ctxcatcoderegime ; ctxcatcoderegime := runscript("return catcodes.numbers.ctxcatcodes") ;
216newinternal txtcatcoderegime ; txtcatcoderegime := runscript("return catcodes.numbers.txtcatcodes") ;
217
218newinternal catcoderegime ; catcoderegime := ctxcatcoderegime ;
219
220vardef rawtextext(expr s) =
221 if s = "" :
222 nullpicture
223 else :
224 mfun_tt_n := mfun_tt_n 1 ;
225 mfun_tt_c := nullpicture ;
226 mfun_tt_o := nullpicture ;
227 addto mfun_tt_o doublepath origin _op_ ;
228 mfun_tt_r := lua.mp.mf_some_text(mfun_tt_n,s,catcoderegime) ;
229 addto mfun_tt_c doublepath unitsquare
230 xscaled wdpart mfun_tt_r
231 yscaled (htpart mfun_tt_r dppart mfun_tt_r)
232 shifted (0,dppart mfun_tt_r)
233 withprescript "mf_object=text"
234 withprescript "tx_index=" & decimal mfun_tt_n
235 withprescript "tx_color=" & colordecimals colorpart mfun_tt_o
236 ;
237 mfun_tt_c
238 fi
239enddef ;
240
241vardef rawmadetext =
242 mfun_tt_n := mfun_tt_n 1 ;
243 mfun_tt_c := nullpicture ;
244 mfun_tt_o := nullpicture ;
245 addto mfun_tt_o doublepath origin _op_ ;
246 mfun_tt_r := lua.mp.mf_made_text(mfun_tt_n) ;
247 addto mfun_tt_c doublepath unitsquare
248 xscaled wdpart mfun_tt_r
249 yscaled (htpart mfun_tt_r dppart mfun_tt_r)
250 shifted (0,dppart mfun_tt_r)
251 withprescript "mf_object=text"
252 withprescript "tx_index=" & decimal mfun_tt_n
253 withprescript "tx_color=" & colordecimals colorpart mfun_tt_o
254 ;
255 mfun_tt_c
256enddef ;
257
258vardef validtexbox(expr category, name) =
259 if category == "" :
260 false
261 elseif string name :
262 name <> ""
263 elseif numeric name :
264 name > 0
265 else :
266 true
267 fi
268enddef ;
269
270vardef rawtexbox(expr category, name) =
271 mfun_tt_c := nullpicture ;
272 if validtexbox(category,name) :
273 mfun_tt_b := lua.mp.mf_tb_dimensions(category, name) ;
274 addto mfun_tt_c doublepath unitsquare
275 xscaled wdpart mfun_tt_b
276 yscaled (htpart mfun_tt_b dppart mfun_tt_b)
277 shifted (0, dppart mfun_tt_b)
278 withprescript "mf_object=box"
279 withprescript "bx_category=" & if numeric category : decimal fi category
280 withprescript "bx_name=" & if numeric name : decimal fi name ;
281 fi
282 mfun_tt_c
283enddef ;
284
285
286
287defaultfont := "Mono" ;
288defaultscale := 1 ;
289
290extra_beginfig := extra_beginfig & "defaultscale:=1;" ;
291
292vardef fontsize expr name =
293 save size ; numeric size ;
294 size := bbwidth(textext("\MPfontsizehskip{" & name & "}")) ;
295 if size = 0 :
296 12pt
297 else :
298 size
299 fi
300enddef ;
301
302pair mfun_laboff ; mfun_laboff := origin ;
303pair mfun_laboff.lft ; mfun_laboff.lft := (-1,0) ;
304pair mfun_laboff.rt ; mfun_laboff.rt := (1,0) ;
305pair mfun_laboff.bot ; mfun_laboff.bot := (0,-1) ;
306pair mfun_laboff.top ; mfun_laboff.top := (0,1) ;
307pair mfun_laboff.ulft ; mfun_laboff.ulft := (-.7,.7) ;
308pair mfun_laboff.urt ; mfun_laboff.urt := (.7,.7) ;
309pair mfun_laboff.llft ; mfun_laboff.llft := (.7,.7) ;
310pair mfun_laboff.lrt ; mfun_laboff.lrt := (.7,-.7) ;
311
312pair mfun_laboff.d ; mfun_laboff.d := mfun_laboff ;
313pair mfun_laboff.dlft ; mfun_laboff.dlft := mfun_laboff.lft ;
314pair mfun_laboff.drt ; mfun_laboff.drt := mfun_laboff.rt ;
315pair mfun_laboff.origin ; mfun_laboff.origin := mfun_laboff ;
316pair mfun_laboff.raw ; mfun_laboff.raw := mfun_laboff ;
317
318pair mfun_laboff.l ; mfun_laboff.l := mfun_laboff.lft ;
319pair mfun_laboff.r ; mfun_laboff.r := mfun_laboff.rt ;
320pair mfun_laboff.b ; mfun_laboff.b := mfun_laboff.bot ;
321pair mfun_laboff.t ; mfun_laboff.t := mfun_laboff.top ;
322pair mfun_laboff.l_t ; mfun_laboff.l_t := mfun_laboff.ulft ;
323pair mfun_laboff.r_t ; mfun_laboff.r_t := mfun_laboff.urt ;
324pair mfun_laboff.l_b ; mfun_laboff.l_b := mfun_laboff.llft ;
325pair mfun_laboff.r_b ; mfun_laboff.r_b := mfun_laboff.lrt ;
326pair mfun_laboff.t_l ; mfun_laboff.t_l := mfun_laboff.ulft ;
327pair mfun_laboff.t_r ; mfun_laboff.t_r := mfun_laboff.urt ;
328pair mfun_laboff.b_l ; mfun_laboff.b_l := mfun_laboff.llft ;
329pair mfun_laboff.b_r ; mfun_laboff.b_r := mfun_laboff.lrt ;
330
331mfun_labxf := 0.5 ;
332mfun_labxf.lft := mfun_labxf.l := 1 ;
333mfun_labxf.rt := mfun_labxf.r := 0 ;
334mfun_labxf.bot := mfun_labxf.b := 0.5 ;
335mfun_labxf.top := mfun_labxf.t := 0.5 ;
336mfun_labxf.ulft := mfun_labxf.l_t := mfun_labxf.t_l := 1 ;
337mfun_labxf.urt := mfun_labxf.r_t := mfun_labxf.t_r := 0 ;
338mfun_labxf.llft := mfun_labxf.l_b := mfun_labxf.b_l := 1 ;
339mfun_labxf.lrt := mfun_labxf.r_b := mfun_labxf.b_r := 0 ;
340
341mfun_labxf.d := mfun_labxf ;
342mfun_labxf.dlft := mfun_labxf.lft ;
343mfun_labxf.drt := mfun_labxf.rt ;
344mfun_labxf.origin := 0 ;
345mfun_labxf.raw := 0 ;
346
347mfun_labyf := 0.5 ;
348mfun_labyf.lft := mfun_labyf.l := 0.5 ;
349mfun_labyf.rt := mfun_labyf.r := 0.5 ;
350mfun_labyf.bot := mfun_labyf.b := 1 ;
351mfun_labyf.top := mfun_labyf.t := 0 ;
352mfun_labyf.ulft := mfun_labyf.l_t := mfun_labyf.t_l := 0 ;
353mfun_labyf.urt := mfun_labyf.r_t := mfun_labyf.t_r := 0 ;
354mfun_labyf.llft := mfun_labyf.l_b := mfun_labyf.b_l := 1 ;
355mfun_labyf.lrt := mfun_labyf.r_b := mfun_labyf.b_r := 1 ;
356
357mfun_labyf.d := mfun_labyf ;
358mfun_labyf.dlft := mfun_labyf.lft ;
359mfun_labyf.drt := mfun_labyf.rt ;
360mfun_labyf.origin := 0 ;
361mfun_labyf.raw := 0 ;
362
363mfun_labtype := 0 ;
364mfun_labtype.lft := mfun_labtype.l := 1 ;
365mfun_labtype.rt := mfun_labtype.r := 2 ;
366mfun_labtype.bot := mfun_labtype.b := 3 ;
367mfun_labtype.top := mfun_labtype.t := 4 ;
368mfun_labtype.ulft := mfun_labtype.l_t := mfun_labtype.t_l := 5 ;
369mfun_labtype.urt := mfun_labtype.r_t := mfun_labtype.t_r := 6 ;
370mfun_labtype.llft := mfun_labtype.l_b := mfun_labtype.b_l := 7 ;
371mfun_labtype.lrt := mfun_labtype.r_b := mfun_labtype.b_r := 8 ;
372mfun_labtype.d := 10 ;
373mfun_labtype.dlft := 11 ;
374mfun_labtype.drt := 12 ;
375mfun_labtype.origin := 0 ;
376mfun_labtype.raw := 0 ;
377
378vardef installlabel@# (expr type, x, y, offset) =
379 numeric mfun_labtype@# ; mfun_labtype@# := type ;
380 pair mfun_laboff @# ; mfun_laboff @# := offset ;
381 numeric mfun_labxf @# ; mfun_labxf @# := x ;
382 numeric mfun_labyf @# ; mfun_labyf @# := y ;
383enddef ;
384
385installlabel.center (0, 0.5, 0.5, (0,0)) ;
386installlabel.c (0, 0.5, 0.5, (0,0)) ;
387
388installlabel.hcenter(0, 0.5, 0.5, (1,0)) ;
389installlabel.h (0, 0.5, 0.5, (1,0)) ;
390
391installlabel.vcenter(0, 0.5, 0.5, (0,1)) ;
392installlabel.v (0, 0.5, 0.5, (0,1)) ;
393
394vardef mfun_labshift@#(expr p) =
395 (mfun_labxf@#lrcorner p
396 mfun_labyf@#ulcorner p
397 (1mfun_labxf@#mfun_labyf@#)llcorner p)
398enddef ;
399
400vardef mfun_picshift@#(expr p) =
401 (mfun_labxf@#ulcorner p
402 mfun_labyf@#lrcorner p
403 (1mfun_labxf@#mfun_labyf@#)urcorner p)
404enddef ;
405
406
407
408vardef plain_thelabel@#(expr p,z) =
409 if string p :
410 plain_thelabel@#(rawtextext("\definedfont[" & defaultfont & "]" & p) scaled defaultscale,z)
411 else :
412 p shifted (z labeloffsetlaboff@# mfun_labshift@#(p))
413 fi
414enddef;
415
416def plain_label =
417 normaldraw plain_thelabel
418enddef ;
419
420let mfun_label = label ;
421let mfun_thelabel = thelabel ;
422
423def useplainlabels =
424 def label = plain_label enddef ;
425 def thelabel = plain_thelabel enddef ;
426enddef ;
427
428def usemetafunlabels =
429 let label = mfun_label ;
430 let thelabel = mfun_thelabel ;
431enddef ;
432
433vardef dotlabel@#(expr s,z) text t_ =
434 label@#(s,z) t_ ;
435 interim linecap := rounded ;
436 normaldraw z withpen pencircle scaled dotlabeldiam t_ ;
437enddef ;
438
439plain_compatibility_data := plain_compatibility_data & "save label, thelabel ;" & "useplainlabels ;" ;
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456newinternal anchortextexts ; anchortextexts := 0 ;
457
458vardef thetextext@#(expr p,z) =
459
460 if string p :
461 thetextext@#(rawtextext(p),z)
462 elseif numeric p :
463 thetextext@#(rawtextext(decimal p),z)
464 elseif pair p :
465 thetextext@#(rawtextext(ddecimal p),z)
466 else :
467 if anchortextexts > 0 :
468 image(draw p withprescript "tx_anchor=" & ddecimal z)
469 else :
470 p
471 fi
472 if (mfun_labtype@# >= 10) :
473 shifted (0,ypart center p)
474 fi
475 shifted (z textextoffsetmfun_laboff@# mfun_labshift@#(p))
476 fi
477enddef ;
478
479vardef textext@#(expr p) =
480 thetextext@#(p,origin)
481enddef ;
482
483vardef onetimetextext@#(expr p) =
484 mfun_onetime_textext := true ;
485 thetextext@#(p,origin)
486enddef ;
487
488
489
490pair mfun_tt_z ;
491
492vardef rawfmttext(text t) =
493 mfun_tt_n := mfun_tt_n 1 ;
494 mfun_tt_c := nullpicture ;
495 mfun_tt_o := nullpicture ;
496 addto mfun_tt_o doublepath origin _op_ ;
497 mfun_tt_r := lua.mp.mf_formatted_text(mfun_tt_n,t) ;
498 addto mfun_tt_c doublepath unitsquare
499 xscaled wdpart mfun_tt_r
500 yscaled (htpart mfun_tt_r dppart mfun_tt_r)
501 shifted (0,dppart mfun_tt_r)
502 withprescript "mf_object=text"
503 withprescript "tx_index=" & decimal mfun_tt_n
504 withprescript "tx_color=" & colordecimals colorpart mfun_tt_o
505 ;
506 for s = t :
507 if pair s : mfun_tt_z := s ; fi
508 endfor ;
509 mfun_tt_c
510enddef ;
511
512vardef thefmttext@#(text t) =
513 mfun_tt_z := origin ;
514 save p ; picture p ; p := rawfmttext(t) ;
515 if anchortextexts > 0 :
516 image(draw p withprescript "tx_anchor=" & ddecimal mfun_tt_z)
517 else :
518 p
519 fi
520 if (mfun_labtype@# >= 10) :
521 shifted (0,ypart center p)
522 fi
523 shifted (mfun_tt_z textextoffsetmfun_laboff@# mfun_labshift@#(p))
524enddef ;
525
526vardef fmttext@#(text t) =
527 thefmttext@#(t,origin)
528enddef ;
529
530
531
532vardef onetimefmttext@#(text t) =
533 mfun_onetime_textext := true ;
534 thefmttext@#(t,origin)
535enddef ;
536
537
538
539vardef thetexbox@#(expr category, name, z) =
540 save p ; picture p ; p := rawtexbox(category,name) ;
541 p
542 if (mfun_labtype@# >= 10) :
543 shifted (0,ypart center p)
544 fi
545 shifted (z textextoffsetmfun_laboff@# mfun_labshift@#(p))
546enddef ;
547
548vardef texbox@#(expr category, name) =
549 thetexbox@#(category,name,origin)
550enddef ;
551
552
553
554
555
556
557
558
559
560vardef theoffset@#(expr z) =
561 if pair z :
562 z
563 elseif path z :
564 if mfun_laboff@# = origin :
565 center z
566 else :
567 ((center z)-- mfun_picshift@#(z)) intersectionpoint (z if not cycle z: cycle fi)
568 fi
569 else :
570 mfun_picshift@#(z)
571 fi
572enddef;
573
574vardef thelabel@#(expr p,z) =
575 if string p :
576 thelabel@#(rawtextext("\definedfont[" & defaultfont & "]" & p) scaled defaultscale,z)
577 elseif numeric p :
578 thelabel@#(decimal p,z)
579 elseif pair p :
580 thelabel@#("(" & decimal(xpart p) & "," & decimal(ypart p) & ")",z)
581 else :
582 p shifted (theoffset@#(z) labeloffsetmfun_laboff@# mfun_labshift@#(p))
583 fi
584enddef;
585
586def label =
587 normaldraw thelabel
588enddef ;
589
590vardef anchored@#(expr p, z) =
591 p
592 if (mfun_labtype@# >= 10) :
593 shifted (0,ypart center p)
594 fi
595 shifted (z mfun_labshift@#(p))
596enddef ;
597
598let normalinfont = infont ;
599
600primarydef s infont name =
601 if name = "" :
602 textext(s)
603 else :
604 textext("\definedfont[" & name & "]" & s)
605 fi
606enddef ;
607
608
609
610string mfun_prescript_separator ; mfun_prescript_separator := char(13) ;
611
612
613
614
615
616newinternal shadefactor ; shadefactor := 1 ;
617pair shadeoffset ; shadeoffset := origin ;
618boolean trace_shades ; trace_shades := false ;
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669path mfun_shade_path ;
670numeric mfun_shade_step ; mfun_shade_step := 0 ;
671
672def withshadestep =
673 hide(mfun_shade_step := mfun_shade_step 1 ;)
674 mfun_withshadestep
675enddef ;
676
677def mfun_withshadestep (text t) =
678 withprescript "sh_step=" & decimal mfun_shade_step
679 t
680enddef ;
681
682numeric mfun_shade_fx, mfun_shade_fy ;
683numeric mfun_shade_lx, mfun_shade_ly ;
684numeric mfun_shade_nx, mfun_shade_ny ;
685numeric mfun_shade_dx, mfun_shade_dy ;
686numeric mfun_shade_tx, mfun_shade_ty ;
687
688
689
690def mfun_with_shade_method_analyze(expr p) =
691 mfun_shade_path := p ;
692 mfun_shade_step := 1 ;
693 mfun_shade_fx := xpart point 0 of p ;
694 mfun_shade_fy := ypart point 0 of p ;
695 mfun_shade_lx := mfun_shade_fx ;
696 mfun_shade_ly := mfun_shade_fy ;
697 mfun_shade_nx := 0 ;
698 mfun_shade_ny := 0 ;
699 mfun_shade_dx := abs(mfun_shade_fx mfun_shade_lx) ;
700 mfun_shade_dy := abs(mfun_shade_fy mfun_shade_ly) ;
701 for i=1 upto length(p) :
702 mfun_shade_tx := abs(mfun_shade_fx xpart point i of p) ;
703 mfun_shade_ty := abs(mfun_shade_fy ypart point i of p) ;
704 if mfun_shade_tx > mfun_shade_dx :
705 mfun_shade_nx := i 1 ;
706 mfun_shade_lx := xpart point i of p ;
707 mfun_shade_dx := mfun_shade_tx ;
708 fi ;
709 if mfun_shade_ty > mfun_shade_dy :
710 mfun_shade_ny := i 1 ;
711 mfun_shade_ly := ypart point i of p ;
712 mfun_shade_dy := mfun_shade_ty ;
713 fi ;
714 endfor ;
715enddef ;
716
717vardef mfun_max_radius(expr p) =
718 max (
719 (xpart center p xpart llcorner p) (ypart center p ypart llcorner p),
720 (xpart center p xpart ulcorner p) (ypart ulcorner p ypart center p),
721 (xpart lrcorner p xpart center p) (ypart center p ypart lrcorner p),
722 (xpart urcorner p xpart center p) (ypart urcorner p ypart center p)
723 )
724enddef ;
725
726vardef mfun_min_radius(expr p) =
727 min (
728 (xpart center p xpart llcorner p) (ypart center p ypart llcorner p),
729 (xpart center p xpart ulcorner p) (ypart ulcorner p ypart center p),
730 (xpart lrcorner p xpart center p) (ypart center p ypart lrcorner p),
731 (xpart urcorner p xpart center p) (ypart urcorner p ypart center p)
732 )
733enddef ;
734
735primarydef p withshademethod m =
736 hide(mfun_with_shade_method_analyze(p))
737 p
738 withprescript "sh_domain=0 1"
739 withprescript "sh_transform=yes"
740 withprescript "sh_color=into"
741 withprescript "sh_color_a=" & colordecimals white
742 withprescript "sh_color_b=" & colordecimals black
743 withprescript "sh_first=" & ddecimal point 0 of p
744 withprescript "sh_set_x=" & ddecimal (mfun_shade_nx,mfun_shade_lx)
745 withprescript "sh_set_y=" & ddecimal (mfun_shade_ny,mfun_shade_ly)
746 if m = "linear" :
747 withprescript "sh_type=linear"
748 withprescript "sh_factor=1"
749 withprescript "sh_center_a=" & ddecimal llcorner p
750 withprescript "sh_center_b=" & ddecimal urcorner p
751 else :
752 withprescript "sh_type=circular"
753 withprescript "sh_factor=1.2"
754 withprescript "sh_center_a=" & ddecimal center p
755 withprescript "sh_center_b=" & ddecimal center p
756 withprescript "sh_radius_a=" & decimal 0
757 withprescript "sh_radius_b=" & decimal mfun_max_radius(p)
758 fi
759enddef ;
760
761def withshaderadius expr a =
762 withprescript "sh_radius_a=" & decimal (xpart a)
763 withprescript "sh_radius_b=" & decimal (ypart a)
764enddef ;
765
766def withshadeorigin expr a =
767 withprescript "sh_center_a=" & ddecimal a
768 withprescript "sh_center_b=" & ddecimal a
769enddef ;
770
771def withshadevector expr a =
772 withprescript "sh_center_a=" & ddecimal (point xpart a of mfun_shade_path)
773 withprescript "sh_center_b=" & ddecimal (point ypart a of mfun_shade_path)
774enddef ;
775
776def withshadedirection expr a =
777 withprescript "sh_center_a=" & ddecimal (point xpart a of boundingbox(mfun_shade_path))
778 withprescript "sh_center_b=" & ddecimal (point ypart a of boundingbox(mfun_shade_path))
779enddef ;
780
781def withshadetransform expr a =
782 withprescript "sh_transform=" & a
783enddef ;
784
785pair shadedup ; shadedup := (0.5,2.5) ;
786pair shadeddown ; shadeddown := (2.5,0.5) ;
787pair shadedleft ; shadedleft := (1.5,3.5) ;
788pair shadedright ; shadedright := (3.5,1.5) ;
789
790def withshadecenter expr a =
791 withprescript "sh_center_a=" & ddecimal (
792 center mfun_shade_path shifted (
793 xpart a bbwidth (mfun_shade_path)2,
794 ypart a bbheight(mfun_shade_path)2
795 )
796 )
797enddef ;
798
799def withshadedomain expr d =
800 withprescript "sh_domain=" & ddecimal d
801enddef ;
802
803def withshadefactor expr f =
804 withprescript "sh_factor=" & decimal f
805enddef ;
806
807
808
809
810
811
812
813def withshadefraction expr a =
814 if mfun_shade_step > 0 :
815 withprescript "sh_fraction_" & decimal mfun_shade_step & "=" & decimal a
816 fi
817enddef ;
818
819def withshadecolors (expr a, b) =
820 if mfun_shade_step > 0 :
821 withprescript "sh_color=into"
822 withprescript "sh_color_a_" & decimal mfun_shade_step & "=" & colordecimals a
823 withprescript "sh_color_b_" & decimal mfun_shade_step & "=" & colordecimals b
824 else :
825 withprescript "sh_color=into"
826 withprescript "sh_color_a=" & colordecimals a
827 withprescript "sh_color_b=" & colordecimals b
828 fi
829enddef ;
830
831primarydef a shadedinto b =
832 1
833 withprescript "sh_color=into"
834 withprescript "sh_color_a=" & colordecimals a
835 withprescript "sh_color_b=" & colordecimals b
836enddef ;
837
838primarydef p withshade sc =
839 p withprescript mfun_defined_cs_pre[sc]
840enddef ;
841
842def defineshade suffix s =
843 mfun_defineshade(str s)
844enddef ;
845
846def mfun_defineshade (expr s) text t =
847 expandafter def scantokens s = t enddef ;
848enddef ;
849
850def shaded text s =
851 s
852enddef ;
853
854
855
856primarydef p shownshadevector v =
857 image (
858 drawarrow (point xpart v of p) -- (point ypart v of p) ;
859 fill fullcircle scaled 2 shifted point xpart v of p ;
860 setbounds currentpicture to center currentpicture -- cycle ;
861 )
862enddef ;
863
864primarydef p shownshadedirection v =
865 image (
866 drawarrow (point xpart v of boundingbox p) -- (point ypart v of boundingbox p) ;
867 fill fullcircle scaled 2 shifted (point xpart v of boundingbox p) ;
868 setbounds currentpicture to center currentpicture -- cycle ;
869 )
870enddef ;
871
872primarydef p shownshadecenter v =
873 image (
874 fill fullcircle scaled 2
875 shifted center p shifted (
876 xpart v bbwidth (p)2,
877 ypart v bbheight(p)2
878 ) ;
879 setbounds currentpicture to center currentpicture -- cycle ;
880 )
881enddef ;
882
883primarydef p shownshadeorigin v =
884 image (
885 fill fullcircle scaled 2 shifted v ;
886 setbounds currentpicture to center currentpicture -- cycle ;
887 )
888enddef ;
889
890
891
892def withcircularshade (expr a, b, ra, rb, ca, cb) =
893 withprescript "sh_type=circular"
894 withprescript "sh_transform=yes"
895 withprescript "sh_domain=0 1"
896 withprescript "sh_factor=1"
897 withprescript "sh_color_a=" & colordecimals ca
898 withprescript "sh_color_b=" & colordecimals cb
899 withprescript "sh_center_a=" & ddecimal a
900 withprescript "sh_center_b=" & ddecimal b
901 withprescript "sh_radius_a=" & decimal ra
902 withprescript "sh_radius_b=" & decimal rb
903enddef ;
904
905def withlinearshade (expr a, b, ca, cb) =
906 withprescript "sh_type=linear"
907 withprescript "sh_transform=yes"
908 withprescript "sh_domain=0 1"
909 withprescript "sh_factor=1"
910 withprescript "sh_color_a=" & colordecimals ca
911 withprescript "sh_color_b=" & colordecimals cb
912 withprescript "sh_center_a=" & ddecimal a
913 withprescript "sh_center_b=" & ddecimal b
914enddef ;
915
916
917
918def set_linear_vector (suffix a,b)(expr p,n) =
919 if (n=1) : a := llcorner p ; b := urcorner p ;
920 elseif (n=2) : a := lrcorner p ; b := ulcorner p ;
921 elseif (n=3) : a := urcorner p ; b := llcorner p ;
922 elseif (n=4) : a := ulcorner p ; b := lrcorner p ;
923 elseif (n=5) : a := .5[ulcorner p,llcorner p] ; b := .5[urcorner p,lrcorner p] ;
924 elseif (n=6) : a := .5[llcorner p,lrcorner p] ; b := .5[ulcorner p,urcorner p] ;
925 elseif (n=7) : a := .5[lrcorner p,urcorner p] ; b := .5[llcorner p,ulcorner p] ;
926 elseif (n=8) : a := .5[urcorner p,ulcorner p] ; b := .5[lrcorner p,llcorner p] ;
927 else : a := .5[ulcorner p,llcorner p] ; b := .5[urcorner p,lrcorner p] ;
928 fi ;
929enddef ;
930
931def set_circular_vector (suffix ab,r)(expr p,n) =
932 if (n=1) : ab := llcorner p ;
933 elseif (n=2) : ab := lrcorner p ;
934 elseif (n=3) : ab := urcorner p ;
935 elseif (n=4) : ab := ulcorner p ;
936 else : ab := center p ; r := .5r ;
937 fi ;
938enddef ;
939
940def circular_shade (expr p, n, ca, cb) =
941 begingroup ;
942 save ab, r ; pair ab ; numeric r ;
943 r := (xpart lrcorner p xpart llcorner p) (ypart urcorner p ypart lrcorner p) ;
944 set_circular_vector(ab,r)(p,n) ;
945 fill p withcircularshade(ab,ab,0,r,ca,cb) ;
946 if trace_shades :
947 drawarrow ab -- ab shifted (0,r) withpen pencircle scaled 1pt withcolor .5white ;
948 fi ;
949 endgroup ;
950enddef ;
951
952def linear_shade (expr p, n, ca, cb) =
953 begingroup ;
954 save a, b ; pair a, b ;
955 set_linear_vector(a,b)(p,n) ;
956 fill p withlinearshade(a,b,ca,cb) ;
957 if trace_shades :
958 drawarrow a -- b withpen pencircle scaled 1pt withcolor .5white ;
959 fi ;
960 endgroup ;
961enddef ;
962
963string mfun_defined_cs_pre[] ; numeric mfun_defined_cs ; mfun_defined_cs := 0 ;
964
965vardef define_circular_shade (expr a, b, ra, rb, ca, cb) =
966 mfun_defined_cs := mfun_defined_cs 1 ;
967 mfun_defined_cs_pre[mfun_defined_cs] := "sh_type=circular"
968 & mfun_prescript_separator & "sh_domain=0 1"
969 & mfun_prescript_separator & "sh_factor=1"
970 & mfun_prescript_separator & "sh_color_a=" & colordecimals ca
971 & mfun_prescript_separator & "sh_color_b=" & colordecimals cb
972 & mfun_prescript_separator & "sh_center_a=" & ddecimal a
973 & mfun_prescript_separator & "sh_center_b=" & ddecimal b
974 & mfun_prescript_separator & "sh_radius_a=" & decimal ra
975 & mfun_prescript_separator & "sh_radius_b=" & decimal rb
976 ;
977 mfun_defined_cs
978enddef ;
979
980vardef define_linear_shade (expr a, b, ca, cb) =
981 mfun_defined_cs := mfun_defined_cs 1 ;
982 mfun_defined_cs_pre[mfun_defined_cs] := "sh_type=linear"
983 & mfun_prescript_separator & "sh_domain=0 1"
984 & mfun_prescript_separator & "sh_factor=1"
985 & mfun_prescript_separator & "sh_color_a=" & colordecimals ca
986 & mfun_prescript_separator & "sh_color_b=" & colordecimals cb
987 & mfun_prescript_separator & "sh_center_a=" & ddecimal a
988 & mfun_prescript_separator & "sh_center_b=" & ddecimal b
989 ;
990 mfun_defined_cs
991enddef ;
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042def onlayer primary name =
1043 withprescript "la_name=" & name
1044enddef ;
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060def withmask primary filename =
1061 withprescript "fg_mask=" & filename
1062enddef ;
1063
1064vardef externalfigure primary filename =
1065 mfun_tt_c := nullpicture ;
1066 mfun_tt_r := lua.mp.mf_external_figure(filename) ;
1067 addto mfun_tt_c doublepath unitsquare
1068 xscaled wdpart mfun_tt_r
1069 yscaled htpart mfun_tt_r
1070 withprescript "mf_object=figure"
1071 withprescript "fg_name=" & filename ;
1072 ;
1073 mfun_tt_c
1074enddef ;
1075
1076def figure primary filename =
1077 rawtextext("\externalfigure[" & filename & "]")
1078enddef ;
1079
1080
1081
1082def register (expr tag, width, height, offset) =
1083
1084 addto currentpicture doublepath unitsquare xscaled width yscaled height shifted offset
1085 withprescript "ps_label=" & tag ;
1086
1087enddef ;
1088
1089
1090
1091numeric currentoutlinetext ; currentoutlinetext := 0 ;
1092
1093vardef mfun_do_outline_text_flush (expr kind, n, x, y, c) (text t) =
1094 if kind = "f" :
1095 mfun_do_outline_text_f (n, x, y, c) (t)
1096 elseif kind = "d" :
1097 mfun_do_outline_text_d (n, x, y, c) (t)
1098 elseif kind = "b" :
1099 mfun_do_outline_text_b (n, x, y, c) (t)
1100 elseif kind = "r" :
1101 mfun_do_outline_text_r (n, x, y, c) (t)
1102 elseif kind = "p" :
1103 mfun_do_outline_text_p (n, x, y, c) (t)
1104 elseif kind = "u" :
1105 mfun_do_outline_text_u (n, x, y, c) (t)
1106 else :
1107 mfun_do_outline_text_n (n, x, y, c) (t)
1108 fi ;
1109enddef ;
1110
1111vardef mfun_do_outline_rule_flush (expr kind, x, y, w, h) =
1112 mfun_do_outline_text_flush (kind, 1, x, y, "") (fullsquare xyscaled(w,h))
1113enddef ;
1114
1115numeric mfun_do_outline_n ; mfun_do_outline_n := 0 ;
1116
1117vardef mfun_do_outline_text_f (expr n, x, y, c) (text t) =
1118 mfun_do_outline_n := 0 ;
1119 for i=t :
1120 mfun_do_outline_n := mfun_do_outline_n 1 ;
1121 if mfun_do_outline_n = n : fill else : nofill fi (i shifted(x,y)) mfun_do_outline_options_f withpen pencircle scaled 0 withprescript c ;
1122 endfor ;
1123enddef ;
1124
1125vardef mfun_do_outline_text_u (expr n, x, y, c) (text t) =
1126 mfun_do_outline_n := 0 ;
1127 for i=t :
1128 mfun_do_outline_n := mfun_do_outline_n 1 ;
1129 if mfun_do_outline_n = n : fillup else : nofill fi (i shifted(x,y)) mfun_do_outline_options_f withprescript c ;
1130 endfor ;
1131enddef ;
1132
1133vardef mfun_do_outline_text_d (expr n, x, y, c) (text t) =
1134 for i=t :
1135 draw i shifted(x,y) mfun_do_outline_options_d ;
1136 endfor ;
1137enddef ;
1138
1139vardef mfun_do_outline_text_p (expr n, x, y, c) (text t) =
1140 for i=t :
1141 draw i shifted(x,y) withprescript c ;
1142 endfor ;
1143enddef ;
1144
1145vardef mfun_do_outline_text_b (expr n, x, y, c) (text t) =
1146 mfun_do_outline_n := 0 ;
1147 for i=t :
1148 mfun_do_outline_n := mfun_do_outline_n 1 ;
1149 if mfun_do_outline_n = n : fill else : nofill fi (i shifted(x,y)) mfun_do_outline_options_f ;
1150 endfor ;
1151 for i=t :
1152 draw i shifted(x,y) mfun_do_outline_options_d ;
1153 endfor ;
1154enddef ;
1155
1156vardef mfun_do_outline_text_r (expr n, x, y, c) (text t) =
1157 mfun_do_outline_n := 0 ;
1158 for i=t :
1159 draw i shifted(x,y) mfun_do_outline_options_d ;
1160 endfor ;
1161 for i=t :
1162 mfun_do_outline_n := mfun_do_outline_n 1 ;
1163 if mfun_do_outline_n = n : fill else : nofill fi (i shifted(x,y)) mfun_do_outline_options_f;
1164 endfor ;
1165enddef ;
1166
1167vardef mfun_do_outline_text_n (expr n, x, y, c) (text t) =
1168 mfun_do_outline_n := 0 ;
1169 for i=t :
1170 mfun_do_outline_n := mfun_do_outline_n 1 ;
1171 if mfun_do_outline_n = n : fill else : nofill fi (i shifted(x,y)) ;
1172 endfor ;
1173enddef ;
1174
1175vardef mfun_do_outline_text_set_f (text f) text r =
1176 def mfun_do_outline_options_f = f enddef ;
1177 def mfun_do_outline_options_r = r enddef ;
1178enddef ;
1179
1180vardef mfun_do_outline_text_set_u (text f) text r =
1181 def mfun_do_outline_options_f = f enddef ;
1182enddef ;
1183
1184vardef mfun_do_outline_text_set_d (text d) text r =
1185 def mfun_do_outline_options_d = d enddef ;
1186 def mfun_do_outline_options_r = r enddef ;
1187enddef ;
1188
1189vardef mfun_do_outline_text_set_b (text f) (text d) text r =
1190 def mfun_do_outline_options_f = f enddef ;
1191 def mfun_do_outline_options_d = d enddef ;
1192 def mfun_do_outline_options_r = r enddef ;
1193enddef ;
1194
1195vardef mfun_do_outline_text_set_r (text d) (text f) text r =
1196 def mfun_do_outline_options_d = d enddef ;
1197 def mfun_do_outline_options_f = f enddef ;
1198 def mfun_do_outline_options_r = r enddef ;
1199enddef ;
1200
1201vardef mfun_do_outline_text_set_n text r =
1202 def mfun_do_outline_options_r = r enddef ;
1203enddef ;
1204
1205vardef mfun_do_outline_text_set_p =
1206enddef ;
1207
1208def mfun_do_outline_options_d = enddef ;
1209def mfun_do_outline_options_f = enddef ;
1210def mfun_do_outline_options_r = enddef ;
1211
1212def outlinetexttopath(text o, p, n) =
1213 scantokens("numeric " & str n & ";") ;
1214 scantokens("path " & str p & "[];") ;
1215 n := 0 ;
1216 for i within o : p[incr(n)] := pathpart i ; endfor ;
1217enddef ;
1218
1219def filloutlinetext(expr o) =
1220 draw image (
1221 save n, m ; numeric n, m ; n := m := 0 ;
1222 for i within o :
1223 n := n 1 ;
1224 endfor ;
1225 for i within o :
1226 m := m 1 ;
1227 if n = m :
1228 eofill
1229 else :
1230 nofill
1231 fi pathpart i ;
1232 endfor ;
1233 )
1234enddef ;
1235
1236def drawoutlinetext(expr o) =
1237 draw image (
1238
1239 for i within o :
1240 draw pathpart i ;
1241 endfor ;
1242 )
1243enddef ;
1244
1245vardef outlinetext@# (expr t) text rest =
1246 save kind ; string kind ; kind := str @# ;
1247 currentoutlinetext := currentoutlinetext 1 ;
1248 def mfun_do_outline_options_d = enddef ;
1249 def mfun_do_outline_options_f = enddef ;
1250 def mfun_do_outline_options_r = enddef ;
1251 image ( normaldraw image (
1252
1253 lua.mp.mf_outline_text(currentoutlinetext,t,kind) ;
1254
1255 if kind = "f" :
1256 mfun_do_outline_text_set_f rest ;
1257 elseif kind = "d" :
1258 mfun_do_outline_text_set_d rest ;
1259 elseif kind = "b" :
1260 mfun_do_outline_text_set_b rest ;
1261 elseif kind = "u" :
1262 mfun_do_outline_text_set_f rest ;
1263 elseif kind = "r" :
1264 mfun_do_outline_text_set_r rest ;
1265 elseif kind = "p" :
1266 mfun_do_outline_text_set_p ;
1267 else :
1268 mfun_do_outline_text_set_n rest ;
1269 fi ;
1270 lua.mp.mf_get_outline_text(currentoutlinetext) ;
1271 ) mfun_do_outline_options_r ; )
1272enddef ;
1273
1274
1275
1276numeric mfun_c_b_llx, mfun_c_b_h, mfun_c_b_w, mfun_c_b_l ;
1277
1278vardef checkedbounds(expr llx,lly,urx,ury) =
1279 mfun_c_b_llx := min(xpart llcorner currentpicture,llx) ;
1280 mfun_c_b_urx := max(xpart urcorner currentpicture,urx) ;
1281 mfun_c_b_lly := min(ypart llcorner currentpicture,lly) ;
1282 mfun_c_b_ury := max(ypart urcorner currentpicture,ury) ;
1283 (mfun_c_b_llx,mfun_c_b_lly) --
1284 (mfun_c_b_urx,mfun_c_b_lly) --
1285 (mfun_c_b_urx,mfun_c_b_ury) --
1286 (mfun_c_b_llx,mfun_c_b_ury) -- cycle
1287enddef ;
1288
1289vardef checkbounds(expr llx,lly,urx,ury) =
1290 setbounds currentpicture to checkedbounds(llx,lly,urx,ury) ;
1291enddef ;
1292
1293vardef strut(expr ht,dp) =
1294 setbounds currentpicture to checkedbounds(0,0,ht,dp) ;
1295enddef ;
1296
1297vardef rule(expr wd,ht,dp) =
1298 image (fill (0,dp)--(wd,dp)--(wd,ht)--(0,ht)cycle)
1299enddef ;
1300
1301
1302
1303extra_beginfig := extra_beginfig & "currentgraphictext := 0 ; " ;
1304extra_beginfig := extra_beginfig & "currentoutlinetext := 0 ; " ;
1305extra_endfig := extra_endfig & "finishsavingdata ; " ;
1306extra_endfig := extra_endfig & "mfun_reset_tex_texts ; " ;
1307
1308
1309
1310vardef verbatim(expr s) =
1311 ditto & "\detokenize{" & s & "}" & ditto
1312enddef ;
1313
1314
1315
1316def bitmapimage(expr xresolution, yresolution, data) =
1317 image (
1318 addto currentpicture doublepath unitsquare
1319 withprescript "bm_xresolution=" & decimal xresolution
1320 withprescript "bm_yresolution=" & decimal yresolution
1321 withpostscript data ;
1322 )
1323enddef ;
1324
1325
1326
1327
1328
1329
1330let property = picture ;
1331
1332vardef properties(text t) =
1333 image(draw unitcircle t)
1334enddef ;
1335
1336def withproperties expr p =
1337 if colormodel p = graycolormodel :
1338 withcolor greypart p
1339 elseif colormodel p = rgbcolor :
1340 withcolor (redpart p,greenpart p,bluepart p)
1341 elseif colormodel p = cmykcolormodel :
1342 withcolor (cyanpart p,magentapart p,yellowpart p,blackpart p)
1343 fi
1344 withpen penpart p
1345 if length (dashpart p) > 0 :
1346 dashed dashpart p
1347 fi
1348 withprescript prescriptpart p
1349 withpostscript postscriptpart p
1350enddef ;
1351
1352
1353
1354primarydef t asgroup s =
1355 begingroup
1356 save grouppicture, wrappedpicture, groupbounds ;
1357 picture grouppicture, wrappedpicture ; path groupbounds ;
1358 grouppicture := if picture t : t else : image(draw t) fi ;
1359 groupbounds := boundingbox grouppicture ;
1360 wrappedpicture:= nullpicture ;
1361 addto wrappedpicture contour groupbounds
1362 withprescript "gr_state=start"
1363 withprescript "gr_type=" & s ;
1364 addto wrappedpicture also grouppicture ;
1365 addto wrappedpicture contour groupbounds
1366 withprescript "gr_state=stop" ;
1367 wrappedpicture
1368 endgroup
1369enddef ;
1370
1371
1372
1373string mfun_auto_align[] ;
1374
1375mfun_auto_align[0] := "rt" ;
1376mfun_auto_align[1] := "urt" ;
1377mfun_auto_align[2] := "top" ;
1378mfun_auto_align[3] := "ulft" ;
1379mfun_auto_align[4] := "lft" ;
1380mfun_auto_align[5] := "llft" ;
1381mfun_auto_align[6] := "bot" ;
1382mfun_auto_align[7] := "lrt" ;
1383mfun_auto_align[8] := "rt" ;
1384
1385def autoalign(expr n) =
1386 scantokens mfun_auto_align[round((n mod 360)45)]
1387enddef ;
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408vardef mfun_point_to_string(expr p,i) =
1409 decimal xpart (point i of p) & " " &
1410 decimal ypart (point i of p) & " " &
1411 decimal xpart (precontrol i of p) & " " &
1412 decimal ypart (precontrol i of p) & " " &
1413 decimal xpart (postcontrol i of p) & " " &
1414 decimal ypart (postcontrol i of p)
1415enddef ;
1416
1417vardef mfun_transform_to_string(expr t) =
1418 decimal xxpart t & " " &
1419 decimal xypart t & " " &
1420 decimal yxpart t & " " &
1421 decimal yypart t & " " &
1422 decimal xpart t & " " &
1423 decimal ypart t
1424enddef ;
1425
1426vardef mfun_numeric_to_string(expr n) =
1427 decimal n
1428enddef ;
1429
1430vardef mfun_pair_to_string(expr p) =
1431 decimal xpart p & " " &
1432 decimal ypart p
1433enddef ;
1434
1435vardef mfun_rgbcolor_to_string(expr c) =
1436 decimal redpart c & " " &
1437 decimal greenpart c & " " &
1438 decimal bluepart c
1439enddef ;
1440
1441vardef mfun_cmykcolor_to_string(expr c) =
1442 decimal cyanpart c & " " &
1443 decimal magentapart c & " " &
1444 decimal yellowpart c & " " &
1445 decimal blackpart c
1446enddef ;
1447
1448vardef mfun_pair_to_table(expr p) =
1449 "{" & decimal xpart p &
1450 "," & decimal ypart p &
1451 "}"
1452enddef ;
1453
1454vardef mfun_point_to_table(expr p,i) =
1455 "{" & decimal xpart (point i of p) &
1456 "," & decimal ypart (point i of p) &
1457 "," & decimal xpart (precontrol i of p) &
1458 "," & decimal ypart (precontrol i of p) &
1459 "," & decimal xpart (postcontrol i of p) &
1460 "," & decimal ypart (postcontrol i of p) &
1461 "}"
1462enddef ;
1463
1464vardef mfun_path_to_table(expr p) =
1465 "{" & mfun_point_to_table(p,0) for i=1 upto length(p) : & "," & mfun_point_to_table(p,i) endfor & "}"
1466enddef ;
1467
1468vardef mfun_rgb_to_table(expr c) =
1469 "{" & decimal redpart c &
1470 "," & decimal greenpart c &
1471 "," & decimal bluepart c &
1472 "}"
1473enddef ;
1474
1475vardef mfun_cmyk_to_table(expr c) =
1476 "{" & decimal cyanpart c &
1477 "," & decimal magentapart c &
1478 "," & decimal yellowpart c &
1479 "," & decimal blackpart c &
1480 "}"
1481enddef ;
1482
1483vardef mfun_grey_to_string(expr n) =
1484 decimal n
1485enddef ;
1486
1487vardef mfun_path_to_string(expr p) =
1488 mfun_point_to_string(p,0) for i=1 upto length(p) : & " " & mfun_point_to_string(p,i) endfor
1489enddef ;
1490
1491vardef mfun_boolean_to_string(expr b) =
1492 if b : "true" else : "false" fi
1493enddef ;
1494
1495vardef tostring primary v =
1496 if numeric v : mfun_numeric_to_string(v)
1497 elseif pair v : mfun_pair_to_string(v)
1498 elseif rgbcolor v : mfun_rgbcolor_to_string(v)
1499 elseif cmykcolor v : mfun_cmykcolor_to_string(v)
1500 elseif greycolor v : mfun_greycolor_to_string(v)
1501 elseif boolean v : mfun_boolean_to_string(v)
1502 elseif path v : mfun_path_to_string(v)
1503 elseif transform v : mfun_transform_to_string(v)
1504 else : v
1505 fi
1506enddef ;
1507
1508vardef topair primary p =
1509 if pair p : "(" & decimal xpart p & "," & decimal ypart p & ")"
1510 elseif numeric p : "(" & decimal p & "," & decimal p & ")"
1511 else : "" fi
1512enddef ;
1513
1514string dq ; dq := char 92 & char 34 ;
1515string sq ; sq := char 92 & char 39 ;
1516
1517vardef quote primary s = sq & tostring(s) & sq enddef;
1518vardef quotation primary s = dq & tostring(s) & dq enddef;
1519
1520vardef mfun_tagged_string(expr value) =
1521 if numeric value : "1:" & mfun_numeric_to_string(value)
1522 elseif pair value : "4:" & mfun_pair_to_string(value)
1523 elseif rgbcolor value : "5:" & mfun_rgbcolor_to_string(value)
1524 elseif cmykcolor value : "6:" & mfun_cmykcolor_to_string(value)
1525 elseif boolean value : "3:" & mfun_boolean_to_string(value)
1526 elseif path value : "7:" & mfun_path_to_string(value)
1527 elseif transform value : "8:" & mfun_transform_to_string(value)
1528 else : "2:" & value
1529 fi
1530enddef ;
1531
1532
1533
1534
1535
1536vardef mfun_key_to_lua(expr k) =
1537 if numeric k : decimal k else : "'" & k & "'" fi
1538enddef ;
1539
1540vardef mfun_point_to_lua(expr k,p,i) =
1541 runscript( "metapost.setvariable(" & mfun_key_to_lua(k) & ",{" &
1542 decimal xpart (point i of p) & "," &
1543 decimal ypart (point i of p) & "," &
1544 decimal xpart (precontrol i of p) & "," &
1545 decimal ypart (precontrol i of p) & "," &
1546 decimal xpart (postcontrol i of p) & "," &
1547 decimal ypart (postcontrol i of p)
1548 & "})" ) ;
1549enddef ;
1550
1551vardef mfun_transform_to_lua(expr k,t) =
1552 runscript( "metapost.setvariable(" & mfun_key_to_lua(k) & ",{" &
1553 decimal xxpart t & "," &
1554 decimal xypart t & "," &
1555 decimal yxpart t & "," &
1556 decimal yypart t & "," &
1557 decimal xpart t & "," &
1558 decimal ypart t
1559 & "})" ) ;
1560enddef ;
1561
1562vardef mfun_numeric_to_lua(expr k,n) =
1563 runscript( "metapost.setvariable(" & mfun_key_to_lua(k) & "," & decimal n & ")" ) ;
1564enddef ;
1565
1566vardef mfun_pair_to_lua(expr k,p) =
1567 runscript( "metapost.setvariable(" & mfun_key_to_lua(k) & ",{" &
1568 decimal xpart p & "," &
1569 decimal ypart p
1570 & "})" ) ;
1571enddef ;
1572
1573vardef mfun_rgbcolor_to_lua(expr k,c) =
1574 runscript( "metapost.setvariable(" & mfun_key_to_lua(k) & ",{" &
1575 decimal redpart c & "," &
1576 decimal greenpart c & "," &
1577 decimal bluepart c
1578 & "})" ) ;
1579enddef ;
1580
1581vardef mfun_cmykcolor_to_lua(expr k,c) =
1582 runscript( "metapost.setvariable(" & mfun_key_to_lua(k) & ",{" &
1583 decimal cyanpart c & "," &
1584 decimal magentapart c & "," &
1585 decimal yellowpart c & "," &
1586 decimal blackpart c
1587 & "})" ) ;
1588enddef ;
1589
1590vardef mfun_path_to_lua(expr k,p) =
1591 runscript("metapost.pushvariable(" & mfun_key_to_lua(k) & ")") ;
1592 for i=0 upto length(p) :
1593 mfun_point_to_lua(i+1,p,i) ;
1594 endfor ;
1595 runscript("metapost.popvariable()") ;
1596enddef ;
1597
1598vardef mfun_boolean_to_lua(expr k,b) =
1599 runscript( "metapost.setvariable(" & mfun_key_to_lua(k) & if b : ",true)" else : ",false)" fi ) ;
1600enddef ;
1601
1602vardef mfun_string_to_lua(expr k,s) =
1603 runscript( "metapost.setvariable(" & mfun_key_to_lua(k) & ",[==[" & s & "]==])" ) ;
1604enddef ;
1605
1606def passvariable(expr key, value) =
1607 if numeric value : mfun_numeric_to_lua (key,value) ;
1608 elseif pair value : mfun_pair_to_lua (key,value) ;
1609 elseif string value : mfun_string_to_lua (key,value) ;
1610 elseif boolean value : mfun_boolean_to_lua (key,value) ;
1611 elseif path value : mfun_path_to_lua (key,value) ;
1612 elseif rgbcolor value : mfun_rgbcolor_to_lua (key,value) ;
1613 elseif cmykcolor value : mfun_cmykcolor_to_lua(key,value) ;
1614 elseif transform value : mfun_transform_to_lua(key,value) ;
1615 fi ;
1616enddef ;
1617
1618def passarrayvariable(expr key)(suffix values)(expr first, last, stp) =
1619 runscript("metapost.pushvariable(" & mfun_key_to_lua(key) & ")") ;
1620 for i=first step stp until last :
1621 passvariable(i, values[i]) ;
1622 endfor
1623 runscript("metapost.popvariable()") ;
1624enddef ;
1625
1626def startpassingvariable(expr k) =
1627 runscript("metapost.pushvariable(" & mfun_key_to_lua(k) & ")") ;
1628enddef ;
1629
1630def stoppassingvariable =
1631 runscript("metapost.popvariable()") ;
1632enddef ;
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646numeric mfun_esc_b ;
1647numeric mfun_esc_l ;
1648string mfun_esc_s ;
1649
1650mfun_esc_s := "%" ;
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667vardef escaped_format(expr s) =
1668 mfun_esc_b := 0 ;
1669 mfun_esc_l := length(s) ;
1670 for n=0 upto mfun_esc_l-1 :
1671
1672 if substring (n,n+1) of s = mfun_esc_s :
1673 if mfun_esc_b = 0 :
1674 ""
1675 fi
1676 if n >= mfun_esc_b :
1677 & (substring (mfun_esc_b,n) of s)
1678 exitif numeric begingroup mfun_esc_b := n+1 endgroup ;
1679 fi
1680 & "@"
1681 fi
1682 endfor
1683 if mfun_esc_b = 0 :
1684 s
1685
1686 elseif mfun_esc_b < mfun_esc_l :
1687 & (substring (mfun_esc_b,mfun_esc_l) of s)
1688 fi
1689enddef ;
1690
1691vardef strfmt(expr f, x) = "\MPgraphformat{" & escaped_format(f) & "}{" & mfun_tagged_string(x) & "}" enddef ;
1692vardef varfmt(expr f, x) = "\MPformatted{" & escaped_format(f) & "}{" & mfun_tagged_string(x) & "}" enddef ;
1693
1694vardef format@# (expr f, x) = textext@#(strfmt(f, x)) enddef ;
1695vardef formatted@#(expr f, x) = textext@#(varfmt(f, x)) enddef ;
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710def fillup text t = draw t withpostscript "both" enddef ;
1711def eofillup text t = draw t withpostscript "eoboth" enddef ;
1712def eofill text t = fill t withpostscript "evenodd" enddef ;
1713def nofill text t = fill t withpostscript "collect" enddef ;
1714def nodraw text t = draw t withpostscript "collect" enddef ;
1715def dodraw text t = draw t withpostscript "flush" enddef ;
1716def dofill text t = fill t withpostscript "flush" enddef ;
1717
1718
1719
1720
1721
1722
1723if contextlmtxmode :
1724 def eoclip text t = clip t withpostscript "evenodd" enddef ;
1725else :
1726 def eoclip text t = clip t enddef ;
1727fi ;
1728
1729
1730
1731
1732
1733
1734
1735
1736def comment expr str =
1737 special "metapost.comment[[" & str & "]]" ;
1738enddef ;
1739
1740vardef report(text t) =
1741 lua.mp.report(t)
1742enddef ;
1743
1744
1745
1746vardef uniquelist(suffix list) =
1747
1748
1749 save i, j, h ;
1750 if known lis[0] :
1751 i := 0 ;
1752 j := -1 ;
1753 else :
1754 i := 1 ;
1755 j := 0 ;
1756 fi ;
1757 h := lua.mp.newhash() ;
1758 forever :
1759 exitif unknown list[i] ;
1760 if not lua.mp.inhash(h,list[i]) :
1761 j := j 1 ;
1762 list[j] := list[i] ;
1763 lua.mp.tohash(h,list[i]) ;
1764 fi ;
1765 i := i 1 ;
1766 endfor ;
1767 for n = j+1 step 1 until i-1 :
1768 dispose(list[n])
1769 endfor ;
1770 lua.mp.disposehash(h) ;
1771enddef ;
1772 |