1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17if known metafun_loaded_lmtx : endinput ; fi ;
18
19newinternal boolean metafun_loaded_lmtx ; metafun_loaded_lmtx := true ; immutable metafun_loaded_lmtx ;
20
21presetparameters "text" [
22 offset = 0,
23 strut = "auto",
24 style = "",
25 color = "",
26 text = "",
27 anchor = "",
28 format = "",
29 position = origin,
30 trace = false,
31
32 background = "",
33 backgroundcolor = "gray",
34] ;
35
36def lmt_text = applyparameters "text" "lmt_do_text" enddef ;
37
38vardef lmt_do_text =
39 image (
40 pushparameters "text" ;
41 save style, anchor, txt, fmt, strt ;
42 string style, anchor, txt, fmt, strt, bgr ;
43 interim textextoffset := getparameter "offset" ;
44 style := getparameter "style" ;
45 anchor := getparameter "anchor" ;
46 strt := getparameter "strut" ;
47 fmt := getparameter "format" ;
48 txt := getparameter "text" ;
49 bgr := getparameter "background" ;
50 if fmt <> "" :
51 txt := "\formatone{" & fmt & "}{" & txt & "}"
52 fi ;
53 if strt = "yes" :
54 txt := "\strut " & txt ;
55 elseif strt = "auto" :
56 txt := "\setstrut\strut " & txt ;
57 fi ;
58 if style <> "" :
59 txt := "\style[" & style & "]{" & txt & "}" ;
60 fi ;
61 if getparameter "trace" :
62 txt := "\ruledhbox{\showstruts" & txt & "}" ;
63 fi ;
64 draw
65 if anchor = "" : thetextext else : scantokens("thetextext." & anchor) fi (
66 txt,
67 getparameter "position"
68 )
69 withcolor getparameter "color" ;
70 if bgr = "color" :
71 addbackground withcolor getparameter "backgroundcolor" ;
72 fi ;
73 popparameters ;
74 )
75enddef ;
76
77presetparameters "grid" [
78 nx = 1, dx = 1,
79 ny = 1, dy = 1,
80] ;
81
82def lmt_grid = applyparameters "grid" "lmt_do_grid" enddef ;
83
84vardef lmt_do_grid =
85 image (
86 save nx; nx := getparameter "grid" "nx" ;
87 save ny; ny := getparameter "grid" "ny" ;
88 save dx; dx := getparameter "grid" "dx" ;
89 save dy; dy := getparameter "grid" "dy" ;
90 for i = 0 step dx until nx :
91 draw ((0,0) -- (0,ny)) shifted (i,0) ;
92 endfor ;
93 for i = 0 step dy until ny :
94 draw ((0,0) -- (nx,0)) shifted (0,i) ;
95 endfor ;
96 )
97enddef ;
98
99def lmt_axis = applyparameters "axis" "lmt_do_axis" enddef ;
100
101presetparameters "axis" [
102 nx = 1, dx = 1, tx = 0, sx = 1, startx = 0,
103 ny = 1, dy = 1, ty = 0, sy = 1, starty = 0,
104
105 samples = { },
106 list = { },
107 connect = false,
108 list = [ close = false ],
109 samplecolors = { "" },
110 axiscolor = "",
111 textcolor = "",
112] ;
113
114vardef lmt_do_axis =
115 image (
116
117 pushparameters "axis" ;
118 save nx, ny, dx, dy, tx, ty ;
119 save c, startx, starty ; string c ;
120 nx := getparameter "nx" ;
121 ny := getparameter "ny" ;
122 dx := getparameter "dx" ;
123 dy := getparameter "dy" ;
124 tx := getparameter "tx" ;
125 ty := getparameter "ty" ;
126 c := getparameter "axiscolor" ;
127 startx := getparameter "startx" ;
128 starty := getparameter "starty" ;
129 draw (startx,starty) -- (startx,ny) withcolor c ;
130 draw (startx,starty) -- (nx,starty) withcolor c ;
131 for i = startx step dx until nx :
132 if (i > startx) or (startx = 0) :
133 draw ((0,0) -- (0,-2)) shifted (i,starty) withcolor c ;
134 fi ;
135 endfor ;
136 for i = starty step dy until ny :
137 if (i > starty) or (starty = 0) :
138 draw ((0,0) -- (-2,0)) shifted (startx,i) withcolor c ;
139 fi ;
140 endfor ;
141 if tx <> 0 :
142 c := getparameter "textcolor" ;
143 for i = startx step tx until nx :
144 if (i > startx) or (startx = 0) :
145 draw
146 textext("\strut " & decimal (i)) ysized 2 shifted (i,-4starty)
147 withcolor c;
148 fi ;
149 endfor ;
150 fi ;
151 if ty <> 0 :
152 c := getparameter "textcolor" ;
153 for i = starty step ty until ny :
154 if (i > starty) or (starty = 0) :
155 draw
156 textext.lft("\strut " & decimal (i)) ysized 2 shifted (-3startx,i)
157 withcolor c;
158 fi ;
159 endfor ;
160 fi ;
161
162 if (getparametercount "samples") > 0 :
163 if getparameter "connect" :
164 for s = 1 upto getparametercount "samples" :
165 c := getparameter "samplecolors" s ;
166 draw for i = 1 upto getparametercount "samples" s :
167 if (i > 1) : -- fi (i, getparameter "samples" s i)
168 endfor
169 withcolor c ;
170 endfor ;
171 else :
172 for s = 1 upto getparametercount "samples" :
173 c := getparameter "samplecolors" s ;
174 for i = 1 upto getparametercount "samples" s :
175 draw (i, getparameter "samples" s i)
176 withcolor c ;
177 endfor ;
178 endfor ;
179 fi ;
180 fi ;
181
182 if (getparametercount "list") > 0 :
183
184 save p, ts, a, d ; path p ; numeric ts ; pair a, d ;
185
186 ts := (getparameter "sy") 20 ;
187
188 pushparameters "list" ;
189 for s = 1 upto getparametercount :
190 pushparameters s ;
191
192 c := getparameter "color" ;
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211 p := getparameterpath "points" (getparameterdefault "close" false) ;
212
213
214 draw p withcolor c ;
215
216 pushparameters "labels" ;
217 if (getparametercount) > 0 :
218 for i = 1 upto getparametercount:
219 n := i 1 ;
220 a := point n of p ;
221 d := direction n of p ;
222 draw
223 textext(getparametertext i true)
224 ysized ts
225 shifted (a .5 unitvector(d) rotated 90) ;
226 endfor ;
227 fi ;
228 popparameters ;
229
230 pushparameters "texts" ;
231 if (getparametercount) > 0 :
232 for i = 1 upto getparametercount :
233 n := i 0.5 ;
234 a := point n of p ;
235 d := direction n of p ;
236 draw textext.d(getparametertext i true)
237 if d < left : rotated 180 shifted (0,-5) else : shifted (0,5) fi
238 ysized ts
239 shifted a
240 if d <> origin :
241 rotatedaround(a,angle(d))
242 fi ;
243 endfor ;
244 fi ;
245 popparameters ;
246
247 popparameters ;
248 endfor ;
249 popparameters ;
250 fi ;
251
252 popparameters ;
253
254 )
255 xyscaled(getparameter "axis" "sx",getparameter "axis" "sy")
256enddef ;
257
258presetparameters "outline" [
259 text = "",
260 kind = "draw",
261 fillcolor = "",
262 drawcolor = "",
263 rulethickness = 110,
264 align = "",
265 style = "",
266 width = 0,
267] ;
268
269def lmt_outline = applyparameters "outline" "lmt_do_outline" enddef ;
270
271vardef lmt_do_outline =
272 image ( normaldraw image (
273 save kind ; string kind ; kind := getparameter "outline" "kind" ;
274 save align ; string align ; align := getparameter "outline" "align" ;
275 save style ; string style ; style := getparameter "outline" "style" ;
276 save width ; numeric width ; width := getparameter "outline" "width" ;
277 if kind = "draw" :
278 kind := "d" ;
279 elseif kind = "fill" :
280 kind := "f" ;
281 elseif kind = "both" :
282 kind := "b" ;
283 elseif kind = "reverse" :
284 kind := "r" ;
285 elseif kind = "fillup" :
286 kind := "u" ;
287 fi ;
288 currentoutlinetext := currentoutlinetext 1 ;
289 lua.mp.mf_outline_text(
290 currentoutlinetext,
291 if align = "" :
292 getparameter "outline" "text",
293 else :
294 "\framed[align={" & align & "}"
295 if width > 0 :
296 & ",width=" & decimal width & "bp"
297 fi
298 if style <> "" :
299 & ",foregroundstyle={" & style & "}"
300 fi
301 & ",offset=none,frame=off]{"
302 & (getparameter "outline" "text")
303 & "}",
304 fi,
305 kind
306 ) ;
307 save currentpen; pen currentpen ;
308 pickup pencircle scaled getparameter "outline" "rulethickness" ;
309 if kind = "f" :
310 mfun_do_outline_text_set_f (
311 withcolor getparameter "outline" "fillcolor"
312 );
313 elseif kind = "d" :
314 mfun_do_outline_text_set_d (
315 withcolor getparameter "outline" "drawcolor"
316 );
317 elseif kind = "b" :
318 mfun_do_outline_text_set_b (
319 withcolor getparameter "outline" "fillcolor"
320 ) (
321 withcolor getparameter "outline" "drawcolor"
322 );
323 elseif kind = "u" :
324 mfun_do_outline_text_set_u (
325 withcolor getparameter "outline" "fillcolor"
326 );
327 elseif kind = "r" :
328 mfun_do_outline_text_set_r (
329 withcolor getparameter "outline" "drawcolor"
330 ) (
331 withcolor getparameter "outline" "fillcolor"
332 ) ;
333 elseif kind = "p" :
334 mfun_do_outline_text_set_p ;
335 else :
336 mfun_do_outline_text_set_n (
337
338 );
339 fi ;
340 lua.mp.mf_get_outline_text(currentoutlinetext) ;
341 ) )
342enddef ;
343
344presetparameters "followtext" [
345 text = "",
346 spread = true,
347 trace = false,
348 reverse = false,
349 autoscaleup = "no",
350 autoscaledown = "no",
351 path = (fullcircle),
352] ;
353
354def lmt_followtext = applyparameters "followtext" "lmt_do_followtext" enddef ;
355
356vardef lmt_do_followtext =
357 image (
358 pushparameters "followtext" ;
359 save scale_up ; string scale_up ; scale_up := getparameter "autoscaleup" ;
360 save scale_down ; string scale_down ; scale_down := getparameter "autoscaledown" ;
361 save followtextalternative ; followtextalternative := if getparameter "spread" : 1 else : 0 fi ;
362 save autoscaleupfollowtext ; autoscaleupfollowtext := if scale_up = "yes" : 1 elseif scale_up = "max" : 2 else : 0 fi ;
363 save autoscaledownfollowtext ; autoscaledownfollowtext := if scale_down = "yes" : 1 elseif scale_down = "max" : 2 else : 0 fi ;
364
365 interim tracingfollowtext := if getparameter "trace" : 1 else : 0 fi ;
366 draw followtext (
367 if (getparameter "reverse") : reverse fi (getparameter "path"),
368 (getparameter "text")
369 ) ;
370 popparameters ;
371 )
372enddef ;
373
374presetparameters "arrow" [
375 path = origin,
376
377 kind = "fill",
378 dimple = 15,
379 scale = 34,
380 penscale = 3,
381 length = 4,
382 angle = 45,
383 location = "end",
384 alternative = "normal",
385 percentage = 50,
386 headonly = false,
387] ;
388
389def lmt_arrow = applyparameters "arrow" "lmt_do_arrow" enddef ;
390
391vardef lmt_do_arrow =
392 image (
393 pushparameters "arrow" ;
394 save a ; string a ; a := getparameter "alternative" ;
395 save l ; string l ; l := getparameter "location" ;
396 save k ; string k ; k := getparameter "kind" ;
397 save p ; path p ; p := getparameter "path" ;
398 interim ahvariant := if a = "dimpled" : 1 elseif a = "curved" : 2 else : 0 fi ;
399 interim ahdimple := getparameter "dimple" ;
400 interim ahscale := getparameter "scale" ;
401 interim ahangle := getparameter "angle" ;
402 interim ahlength := getparameter "length" ;
403 if not getparameter "headonly" :
404 draw p ;
405 fi ;
406 if hasparameter "pen" :
407
408 if hasoption "pen" "auto" :
409 ahlength := (getparameter "penscale") boundingradius(currentpen) ;
410 else :
411 ahlength := (getparameter "penscale") boundingradius(getparameterpen "pen") ;
412 fi ;
413 fi ;
414 if k = "draw" : draw elseif k = "both" : filldraw else : fill fi
415 if l = "middle" :
416 midarrowhead p ;
417 elseif l = "percentage" :
418 arrowheadonpath (p, (getparameter "percentage")100) ;
419 elseif l = "both" :
420 arrowhead p ;
421 if k = "draw" : draw elseif k = "both" : filldraw else : fill fi
422 arrowhead reverse p ;
423 else :
424 arrowhead p ;
425 fi ;
426 popparameters ;
427 )
428enddef ;
429
430
431
432presetparameters "placeholder" [
433 color = "red",
434 width = 1,
435 height = 1,
436 reduction = 0,
437 alternative = "circle",
438] ;
439
440def lmt_placeholder = applyparameters "placeholder" "lmt_do_placeholder" enddef ;
441
442def lmt_do_placeholder =
443 begingroup ;
444 pushparameters "placeholder" ;
445 save w, h, d, r, p, c, b, s, q, a ;
446 numeric w, h, d, r ; path p ; string s, a ;
447 s := getparameter "color" ;
448 w := getparameter "width" ;
449 h := getparameter "height" ;
450 r := getparameter "reduction" ;
451 a := getparameter "alternative" ;
452 d := max(w,h) ;
453 if cmykcolor resolvedcolor(s) :
454 cmykcolor c, b ; b := (0,0,0,0)
455 else :
456 color c, b ; b := (1,1,1)
457 fi ;
458 c := resolvedcolor(s) ;
459 p := unitsquare xyscaled (w,h) ;
460 fill p withcolor r[.5c,b] ;
461 if a = "square" :
462 vardef q = fullsquare enddef ;
463 elseif a = "triangle" :
464 vardef q = fulltriangle rotated (90 round(uniformdeviate(4))) enddef ;
465 else :
466 vardef q = fullcircle enddef ;
467 fi ;
468 for i := 1 upto 60 :
469 fill q
470 scaled (d5 randomized (d5))
471 shifted (center p randomized (d))
472 withcolor r[c randomized(.3,.9),b] ;
473 endfor ;
474 clip currentpicture to p ;
475 popparameters ;
476 endgroup ;
477enddef ;
478
479
480
481vardef lmt_connected(text t) =
482 save p ; path p ;
483 p := origin t ;
484 subpath (1,length(p)) of p
485enddef ;
486
487def lmt_connection expr t =
488 -- t
489enddef ;
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566presetparameters "function" [
567 sx = 1mm,
568 sy = 1mm,
569 offset = 0,
570 xmin = 1,
571 xmax = 1,
572 xstep = 1,
573 xsmall = 0,
574 xlarge = 0,
575 xlabels = "no",
576 xticks = "bottom",
577 xcaption = "",
578 ymin = 1,
579 ymax = 1,
580 ystep = 1,
581 ysmall = 0,
582 ylarge = 0,
583
584
585
586
587 ylabels = "no",
588 yticks = "left",
589 ycaption = "",
590 code = "",
591 close = false,
592 shape = "curve",
593 fillcolor = "",
594 drawsize = 1,
595 drawcolor = "",
596 frame = "",
597 linewidth = .05mm,
598 pointsymbol = "",
599 pointsize = 2,
600 pointcolor = "",
601 xarrow = "",
602 yarrow = "",
603 reverse = false,
604] ;
605
606def lmt_function = applyparameters "function" "lmt_do_function" enddef ;
607
608vardef lmt_do_function_p(expr xmin, xmax, xstep, code, shape, close, fcolor, dsize, dcolor, psymbol, psize, pcolor) =
609 save p, q ; path p, q ;
610 p := lua.mp.lmt_function_x(xmin,xmax,xstep,code,shape) ;
611 if close :
612 q := (xmin,0) -- p -- (xmax,0) -- cycle ;
613 fill q withcolor fcolor ;
614 else :
615 draw p withpen currentpen scaled dsize withcolor dcolor
616 ;
617 fi ;
618 if psize > 0 :
619 if psymbol = "dot" :
620 draw image (
621 for i = 0 upto length(p) :
622 draw point i of p ;
623 endfor ;
624 ) withpen currentpen scaled psize withcolor pcolor ;
625 fi ;
626 fi ;
627enddef ;
628
629vardef lmt_do_function =
630 image (
631 pushparameters "function" ;
632 save sx, sy, lw, tl, tr, ts, tt, currentpen ; transform tr, tt ; pen currentpen ;
633 sx := getparameter "sx" ;
634 sy := getparameter "sy" ;
635 lw := getparameter "linewidth" ;
636 tl := 120 ;
637 ts := 110 ;
638 tr := identity xyscaled(10sx,10sy) ;
639 tt := identity xyscaled(tssx,tssy) ;
640 pickup pencircle xyscaled(lwsx,lwsy) ;
641 draw image (
642 save xmin, xmax, xstep, xsmall, xlarge, ymin, ymax, ystep, ysmall, ylarge, p ;
643 save code, option, txl, txs, tyl, tys, swap ;
644 string code, option ;
645 path txl, txs, tyl, tys ; boolean swap ;
646 picture p ;
647
648 xmin := getparameter "xmin" ;
649 xmax := getparameter "xmax" ;
650 xstep := getparameter "xstep" ;
651 xsmall := getparameter "xsmall" ;
652 xlarge := getparameter "xlarge" ;
653 ymin := getparameter "ymin" ;
654 ymax := getparameter "ymax" ;
655 ystep := getparameter "ystep" ;
656 ysmall := getparameter "ysmall" ;
657 ylarge := getparameter "ylarge" ;
658 code := getparameter "code" ;
659 swap := getparameter "reverse" ;
660
661 p := image (
662
663 if (getparametercount "functions") > 0 :
664 for s = 1 upto getparametercount "functions" :
665 pushparameters "functions" s ;
666 lmt_do_function_p (
667 getparameter "xmin",
668 getparameter "xmax",
669 getparameter "xstep",
670 getparameter "code",
671 getparameter "shape",
672 getparameter "close",
673 getparameter "fillcolor",
674 getparameter "drawsize",
675 getparameter "drawcolor",
676 getparameter "pointsymbol",
677 getparameter "pointsize",
678 getparameter "pointcolor"
679 ) ;
680 popparameters ;
681 endfor ;
682 elseif code <> "" :
683 lmt_do_function_p (
684 getparameter "xmin",
685 getparameter "xmax",
686 getparameter "xstep",
687 getparameter "code",
688 getparameter "shape",
689 getparameter "close",
690 getparameter "fillcolor",
691 getparameter "drawsize",
692 getparameter "drawcolor",
693 getparameter "pointsymbol",
694 getparameter "pointsize",
695 getparameter "pointcolor"
696 ) ;
697 fi ;
698 ) ;
699
700 if not swap : draw p fi ;
701
702 option := getparameter "xticks" ;
703 if option = "top" :
704 txs := (0,0) -- (0,tl) ;
705 elseif option = "bottom" :
706 txs := (0,tl) -- (0,0) ;
707 else :
708 txs := (0,tl) -- (0,tl) ;
709 fi ;
710
711 option := getparameter "yticks" ;
712 if option = "left" :
713 tys := (tl,0) -- (0,0) ;
714 elseif option = "right" :
715 tys := (0,0) -- (tl,0) ;
716 else :
717 tys := (tl,0) -- (tl,0) ;
718 fi ;
719
720 txs := txs transformed tr ;
721 tys := tys transformed tr ;
722 txl := txs scaled 2 ;
723 tyl := tys scaled 2 ;
724
725
726
727 xmin := getparameterdefault "xfirst" xmin ;
728 xmax := getparameterdefault "xlast" xmax ;
729 ymin := getparameterdefault "yfirst" ymin ;
730 ymax := getparameterdefault "ylast" ymax ;
731
732 if hasoption "frame" "ticks,sticks" :
733 if xsmall > 0 :
734 if hasoption "frame" "horizontal" :
735 for i = ymin step ((ymaxymin)ysmall) until ymax :
736 draw (xmin,i) -- (xmax,i) ;
737 endfor ;
738 dodraw (xmin,ymin) ;
739 fi ;
740 fi ;
741 if ysmall > 0 :
742 if hasoption "frame" "vertical" :
743 for i = xmin step ((xmaxxmin)xsmall) until xmax :
744 draw (i,ymin) -- (i,ymax) ;
745 endfor ;
746 dodraw (xmin,ymin) ;
747 fi ;
748 fi ;
749 fi ;
750
751 option := getparameter "xarrow" ;
752 if option = "yes" :
753 save ahlength ; ahlength := tl ;
754
755 drawarrow (xmin,0) -- (xmax,0) ;
756 else :
757 draw (xmin,0) -- (xmax,0) ;
758 fi ;
759
760 option := getparameter "yarrow" ;
761 if option = "yes" :
762 save ahlength ; ahlength := tl ;
763
764 drawarrow (xmin,ymin) -- (xmin,ymax) ;
765 else :
766 draw (xmin,ymin) -- (xmin,ymax) ;
767 fi ;
768
769 if hasoption "frame" "yes" :
770 draw (xmin,ymin) -- (xmax,ymin) -- (xmax,ymax) -- (xmin,ymax) -- cycle ;
771 fi ;
772
773 if hasoption "frame" "ticks,sticks" :
774 if xsmall > 0 :
775 if hasoption "frame" "horizontal" :
776 for i = ymin step ((ymaxymin)ysmall) until ymax :
777 draw (xmin,i) -- (xmax,i) ;
778 endfor ;
779 fi ;
780 if hasoption "frame" "bottom" :
781 txs := ((0,0) -- (0,tl)) if hasoption "frame" "sticks" : rotated 180 fi ;
782 txs := txs transformed tr ;
783 for i = xmin step ((xmaxxmin)xsmall) until xmax :
784 nodraw txs shifted (i,ymin) ;
785 endfor ;
786 fi ;
787 if hasoption "frame" "top" :
788 txs := (0,0) -- (0,tl) if hasoption "frame" "sticks" : rotated 180 fi ;
789 txs := txs transformed tr ;
790 for i = xmin step ((xmaxxmin)xsmall) until xmax :
791 nodraw txs shifted (i,ymax) ;
792 endfor ;
793 fi ;
794 dodraw (xmin,ymin) ;
795 fi ;
796 if ysmall > 0 :
797 if hasoption "frame" "vertical" :
798 for i = xmin step ((xmaxxmin)xsmall) until xmax :
799 draw (i,ymin) -- (i,ymax) ;
800 endfor ;
801 fi ;
802 if hasoption "frame" "left" :
803 tys := (0,0) -- (tl,0) if hasoption "frame" "sticks" : rotated 180 fi ;
804 tys := tys transformed tr ;
805 for i = ymin step ((ymaxymin)ysmall) until ymax :
806 nodraw tys shifted (xmin,i) ;
807 endfor ;
808 fi ;
809 if hasoption "frame" "right" :
810 tys := (0,0) -- (tl,0) if hasoption "frame" "sticks" : rotated 180 fi ;
811 tys := tys transformed tr ;
812 for i = ymin step ((ymaxymin)ysmall) until ymax :
813 nodraw tys shifted (xmax,i) ;
814 endfor ;
815 fi ;
816 dodraw (xmin,ymin) ;
817 fi ;
818 fi ;
819
820 if xsmall > 0 :
821 for i = xmin step xsmall until xmax :
822 nodraw txs shifted (i,0) ;
823 endfor ;
824 fi ;
825
826 if xlarge > 0 :
827 for i = xmin step xlarge until xmax :
828 nodraw txl shifted (i,0) ;
829 endfor ;
830 dodraw (xmin,0) ;
831 elseif xsmall > 0 :
832 dodraw (xmin,0) ;
833 fi ;
834
835 if ysmall > 0 :
836 for i = ymin step ysmall until ymax :
837 nodraw tys shifted (xmin,i) ;
838 endfor ;
839 fi ;
840
841 if ylarge > 0 :
842 for i = ymin step ylarge until ymax :
843 nodraw tyl shifted (xmin,i) ;
844 endfor ;
845 dodraw (xmin,ymin) ;
846 elseif ysmall > 0 :
847 dodraw (xmin,ymin) ;
848 fi ;
849
850 if swap : draw p fi ;
851
852 if xlarge > 0 :
853 option := getparameter "xlabels" ;
854 if option <> "no" :
855 for i = xmin step xlarge until xmax :
856 if ((i <> 0) and ((option <> "nolimits") or ((i > xmin) and (i < xmax)))) :
857 draw textext.bot(decimal i) transformed tt
858 shifted (i,1.25(ypart point 0 of txl)) ;
859 fi ;
860 endfor ;
861 fi ;
862 fi ;
863
864 if ylarge > 0 :
865 option := getparameter "ylabels" ;
866 if option <> "no" :
867 for i = ymin step ylarge until ymax :
868 if ((i <> 0) and ((option <> "nolimits") or ((i > ymin) and (i < ymax)))) :
869 draw textext.lft(decimal i) transformed tt
870 shifted (xmin+1.25(xpart point 0 of tyl),i) ;
871 fi ;
872 endfor ;
873 fi ;
874 fi ;
875
876 option := getparameter "xcaption" ;
877 if (option <> "") :
878 draw textext.bot(option) transformed tt
879 shifted (xmin,tl)
880 shifted center bottomboundary currentpicture ;
881 fi ;
882
883 option := getparameter "ycaption" ;
884 if (option <> "") :
885 draw textext.lft(option) transformed tt
886 shifted (xmintl,0)
887 shifted center leftboundary currentpicture ;
888 fi ;
889 )
890
891 xyscaled(sx,sy) ;
892
893 setbounds currentpicture to
894 boundingbox currentpicture
895 enlarged (getparameter "offset") ;
896
897 popparameters ;
898 )
899enddef ;
900
901
902
903presetparameters "mesh" [
904 trace = false,
905 auto = false,
906 step = 0.05,
907
908
909] ;
910
911def lmt_mesh = applyparameters "mesh" "lmt_do_mesh" enddef ;
912
913vardef lmt_do_mesh =
914 image (
915 save p, b ; path p, b ;
916 pushparameters "mesh" ;
917 if getparameter "auto" :
918 b := if hasparameter "box" : getparameter "box" else : OverlayBox fi ;
919 for i=1 upto getparametercount "paths" :
920 p := getparameter "paths" i ;
921 p := meshed(p if not cycle p : -- cycle fi,b,getparameter "step") ;
922 if getparameter "trace" :
923 draw p ;
924 fi ;
925 runscript("mp.lmt_mesh_update()") i p ;
926 endfor ;
927 elseif getparameter "trace" :
928 for i=1 upto getparametercount "paths" :
929 p := getparameter "paths" i ;
930 draw p if not cycle p : -- cycle fi ;
931 endfor ;
932 fi ;
933 popparameters ;
934 runscript("mp.lmt_mesh_set()") ;
935 )
936enddef ;
937
938vardef mfun_meshed_clipped(expr pat, box, pct) =
939 pp := point (arctime pct of pat) of pat ;
940 if (ypart pp <= lly) or (ypart pp >= ury) or (xpart pp <= llx) or (xpart pp >= urx) :
941 (cp -- pp) intersection_point bb
942 else :
943 pp
944 fi
945enddef ;
946
947vardef mfun_meshed_clipped(expr pat, box, pct) =
948 pp := point (arctime pct of pat) of pat ;
949 if ypart pp <= lly :
950 if xpart pp <= llx :
951 (llx, lly)
952 elseif xpart pp >= urx :
953 (urx, lly)
954 else :
955 (xpart pp, lly)
956 fi
957 elseif ypart pp >= ury :
958 if xpart pp <= llx :
959 (llx, ury)
960 elseif xpart pp >= urx :
961 (urx, ury)
962 else :
963 (xpart pp, ury)
964 fi
965 elseif xpart pp <= llx :
966 (llx, ypart pp)
967 elseif xpart pp >= urx :
968 (urx, ypart pp)
969 else :
970 pp
971 fi
972enddef ;
973
974vardef meshed(expr pth, box, stp) =
975 begingroup
976 save cb, cp, llx, lly, urx, ury, pp, lp, bb ; pair cb, cp, pp ; path bb ;
977 bb := box enlarged -110;
978 cb := center bb ;
979 cp := center pth ;
980 llx := xpart llcorner bb;
981 lly := ypart llcorner bb;
982 urx := xpart urcorner bb;
983 ury := ypart urcorner bb;
984 lp := arclength pth ;
985 for i=stp step stp until 1stp2 :
986 cp --
987 mfun_meshed_clipped(pth,bb,lp(istp)) --
988 mfun_meshed_clipped(pth,bb,lp(i )) --
989 cp --
990 endfor cycle
991 endgroup
992enddef ;
993
994vardef OverlayMesh(expr p, s) =
995 lmt_mesh [ paths = { meshed(p,OverlayBox,s) } ]
996enddef ;
997
998permanent meshed, OverlayMesh ;
999
1000
1001
1002presetparameters "chart" [
1003 originsize = 1mm,
1004 trace = false,
1005 showlabels = true,
1006 center = false,
1007
1008 samples = { },
1009
1010 cumulative = false,
1011 percentage = false,
1012 maximum = 0,
1013 distance = 1mm,
1014
1015
1016 labelstyle = "",
1017 labelformat = "",
1018
1019
1020
1021 labelfraction = 0.8,
1022 labelcolor = "",
1023
1024 backgroundcolor = "",
1025 drawcolor = "white",
1026 fillcolors = {
1027 "darkred", "darkgreen", "darkblue",
1028 "darkyellow", "darkmagenta", "darkcyan",
1029 "darkgray"
1030 },
1031 colormode = "global",
1032
1033 linewidth = .25mm,
1034
1035 legendcolor = "",
1036 legendstyle = "",
1037 legend = { },
1038] ;
1039
1040presetparameters "chart:circle" "chart" [
1041 height = 5cm,
1042 width = 5mm,
1043 labelanchor = "",
1044 labeloffset = 0,
1045 labelstrut = "no",
1046] ;
1047
1048presetparameters "chart:histogram" "chart" [
1049 height = 5cm,
1050 width = 5mm,
1051 labelanchor = "bot",
1052 labeloffset = 1mm,
1053 labelstrut = "auto",
1054] ;
1055
1056presetparameters "chart:bar" "chart" [
1057 height = 5mm,
1058 width = 5cm,
1059 labelanchor = "lft",
1060 labeloffset = 1mm,
1061 labelstrut = "no",
1062] ;
1063
1064def lmt_chart_circle = applyparameters "chart:circle" "lmt_do_chart_circle" enddef ;
1065def lmt_chart_histogram = applyparameters "chart:histogram" "lmt_do_chart_histogram" enddef ;
1066def lmt_chart_bar = applyparameters "chart:bar" "lmt_do_chart_bar" enddef ;
1067
1068def lmt_do_chart_start (expr what) =
1069 pushparameters what ;
1070 save width, height, distance, linewidth, labelgap, labelfraction, value, nofsamples, nofsamplesets ;
1071 save fillcolor, drawcolor, labelcolor, labelstyle, labelformat, labelstrut, labelanchor, colormode ;
1072 string fillcolor, drawcolor, labelcolor, labelstyle, labelformat, labelstrut, labelanchor, colormode ;
1073 if hasparameter "sampleset" :
1074 setluaparameter "what" "samples" (getparameter "sampleset") ;
1075 fi ;
1076 height := getparameter "height" ;
1077 width := getparameter "width" ;
1078 distance := getparameter "distance" ;
1079 linewidth := getparameter "linewidth" ;
1080 drawcolor := getparameter "drawcolor" ;
1081 colormode := getparameter "colormode" ;
1082 labelcolor := getparameter "labelcolor" ;
1083 labelgap := getparameter "labeloffset" ;
1084 labelstyle := getparameter "labelstyle" ;
1085 labelformat := getparameter "labelformat" ;
1086 labelstrut := getparameter "labelstrut" ;
1087 labelanchor := getparameter "labelanchor" ;
1088 labelfraction := getparameter "labelfraction" ;
1089 nofsamplesets := getparametercount "samples" ;
1090 nofsamples := getmaxparametercount "samples" ;
1091enddef ;
1092
1093def lmt_do_chart_stop =
1094 if getparameter "center" :
1095 currentpicture := currentpicture shifted center currentpicture ;
1096 fi
1097 if (getparameter "backgroundcolor") <> "" :
1098 addbackground withcolor getparameter "backgroundcolor" ;
1099 fi
1100 if getparameter "trace" :
1101 save b ; path b ; b := boundingbox currentpicture ;
1102 draw image (
1103 draw fullcircle scaled 1mm ;
1104 draw b
1105 )
1106 dashed evenly scaled 14
1107 withpen pencircle scaled .125mm
1108 withcolor "darkgray" ;
1109 fi
1110 popparameters ;
1111enddef ;
1112
1113vardef lmt_do_chart_text(expr s, i, value) =
1114 lmt_text [
1115 style = labelstyle,
1116 format = labelformat,
1117 strut = labelstrut,
1118 anchor = labelanchor,
1119 offset = labelgap,
1120 color = labelcolor,
1121 text = (getparameterdefault "labels" s i (decimal value))
1122 background = "",
1123 ]
1124enddef ;
1125
1126def lmt_do_chart_legend =
1127 n := getparametercount "legend" ;
1128 if n > 0 :
1129 save dx, dy, p, l, w, o, d, ddy ; picture l ;
1130 dx := xpart urcorner currentpicture EmWidth ;
1131 dy := ypart urcorner currentpicture ;
1132 labelcolor := getparameter "legendcolor" ;
1133 labelstyle := getparameter "legendstyle" ;
1134 w := 2EmWidth ;
1135 o := .25EmWidth ;
1136 d := ExHeight ;
1137 ddy := .8LineHeight ;
1138 for i=1 upto n :
1139 dy := dy ddy ;
1140 l := lmt_text [
1141 text = getparameter "legend" i,
1142 anchor = "rt"
1143 style = labelstyle,
1144 color = labelcolor,
1145 background = "",
1146 ] ;
1147 fill leftboundary l rightenlarged w
1148 shifted (dx,dyd)
1149 withcolor getparameter "fillcolors" i ;
1150 draw l
1151 shifted (dxwo,dyd) ;
1152 endfor ;
1153 fi ;
1154enddef ;
1155
1156vardef lmt_do_chart_circle =
1157 image (
1158 lmt_do_chart_start("chart:circle") ;
1159 if (nofsamplesets > 0) and (nofsamples > 0) :
1160 nofsamplesets := 1 ;
1161 save p, r, s, first, last, total, factor, n, percentage ;
1162 path p, r, s[] ; boolean percentage ;
1163 percentage := getparameter "percentage" ;
1164 total := 0 ;
1165 for i = 1 upto nofsamples :
1166 total := total getparameter "samples" (1) i ;
1167 endfor ;
1168 factor := 100total ;
1169 first := 0 ;
1170 p := fullcircle ysized (height) ;
1171 r := origin -- (2height,0) ;
1172 for i = 1 upto nofsamples :
1173 fillcolor := getparameter "fillcolors" i ;
1174 value := (getparameter "samples" (1) i) factor ;
1175 last := first (360 100) value ;
1176 s[i] := ((p cutbefore (r rotated first)) cutafter (r rotated last)) ;
1177 fill origin -- s[i] -- cycle withcolor fillcolor ;
1178 first := last ;
1179 endfor ;
1180 if linewidth > 0 :
1181 if drawcolor = "" :
1182 drawcolor := backgroundcolor ;
1183 fi ;
1184 for i = 1 upto nofsamples :
1185 interim linecap := butt ;
1186 draw origin -- (point 0 of s[i]) withpen pencircle scaled linewidth withcolor drawcolor ;
1187 draw origin -- (point length(s[i]) of s[i]) withpen pencircle scaled linewidth withcolor drawcolor ;
1188 endfor ;
1189 fi ;
1190 if getparameter "showlabels" :
1191 first := 0 ;
1192 for i = 1 upto nofsamples :
1193 value := getparameter "samples" (1) i ;
1194 last := first (360100) value factor ;
1195 draw lmt_do_chart_text (s,i,value)
1196 shifted ((labelfraction(height2),0) rotated ((firstlast)2)) ;
1197 first := last ;
1198 endfor ;
1199 fi ;
1200 lmt_do_chart_legend ;
1201 n := getparameter "originsize" ;
1202 if n > 0 :
1203 fill fullcircle scaled n withcolor "white" ;
1204 fi ;
1205 fi ;
1206 lmt_do_chart_stop ;
1207 )
1208enddef ;
1209
1210vardef lmt_do_chart_histogram =
1211 image (
1212 lmt_do_chart_start("chart:histogram") ;
1213 if (nofsamplesets > 0) and (nofsamples > 0) :
1214 save value, maximum, cumulative, maxwidth ; boolean cumulative ;
1215 maximum := getparameter "maximum" ;
1216 cumulative := getparameter "cumulative" ;
1217 if labelanchor = "center" :
1218 labelanchor := "vcenter" ;
1219 fi ;
1220 if maximum = 0 :
1221 for s = 1 upto nofsamplesets :
1222 for i = 1 upto nofsamples :
1223 value := getparameter "samples" s i ;
1224 maximum := if cumulative :
1225 maximum value ;
1226 else :
1227 max(maximum,value) ;
1228 fi ;
1229 endfor ;
1230 endfor ;
1231 fi ;
1232 if nofsamplesets = 1 :
1233 distance := 0 ;
1234 fi ;
1235 maxwidth := nofsamplesets nofsamples width (nofsamples 1) distance ;
1236 value := 0 ;
1237 for s = 1 upto nofsamplesets :
1238 for i = 1 upto nofsamples :
1239 value := if cumulative : value fi (getparameter "samples" s i) height maximum ;
1240 fill unitsquare xyscaled (width,value)
1241 if linewidth > 0 :
1242 if i > 1 : leftenlarged (linewidth2) fi
1243 if i < nofsamples : rightenlarged (linewidth2) fi
1244 fi
1245 shifted (nofsamplesets(i-1)width(s-1)width(i-1)distance,0)
1246 withcolor getparameter "fillcolors" if colormode = "local" : s else : i fi ;
1247 endfor ;
1248 endfor ;
1249 setbounds currentpicture to unitsquare xyscaled (maxwidth,height) ;
1250 for s = 1 upto nofsamplesets :
1251 if getparameter "showlabels" :
1252 for i = 1 upto nofsamples :
1253 draw lmt_do_chart_text (s,i,getparameter "samples" s i)
1254 shifted (nofsamplesets((i-1)width)width2(s-1)width(i-1)distance,0) ;
1255 endfor ;
1256 fi ;
1257 endfor ;
1258 lmt_do_chart_legend ;
1259 fi ;
1260 lmt_do_chart_stop ;
1261 )
1262enddef ;
1263
1264vardef lmt_do_chart_bar =
1265
1266 image (
1267 lmt_do_chart_start("chart:bar") ;
1268 if (nofsamplesets > 0) and (nofsamples > 0) :
1269 save value, maximum, cumulative, maxheight ; boolean cumulative ;
1270 maximum := getparameter "maximum" ;
1271 cumulative := getparameter "cumulative" ;
1272 if labelanchor = "center" :
1273 labelanchor := "hcenter" ;
1274 fi ;
1275 if maximum = 0 :
1276 for s = 1 upto nofsamplesets :
1277 for i = 1 upto nofsamples :
1278 value := getparameter "samples" s i ;
1279 maximum := if cumulative : maximum value else : max(maximum,value) fi ;
1280 endfor ;
1281 endfor ;
1282 fi ;
1283 if nofsamplesets = 1 :
1284 distance := 0 ;
1285 fi ;
1286 maxheight := nofsamplesets nofsamples height (nofsamples 1) distance ;
1287 for s = 1 upto nofsamplesets :
1288 value := 0 ;
1289 for i = 1 upto nofsamples :
1290 value := if cumulative : value fi (getparameter "samples" s i) width maximum ;
1291 fill unitsquare xyscaled (value,height)
1292 if linewidth > 0 :
1293 if i > 1 : topenlarged (linewidth2) fi
1294 if i < nofsamples : bottomenlarged (linewidth2) fi
1295 fi
1296 shifted (0,maxheightnofsamplesetsiheight(s-1)height(i-1)distance)
1297 withcolor getparameter "fillcolors" if colormode = "local" : s else : i fi ;
1298 endfor ;
1299 endfor ;
1300 setbounds currentpicture to unitsquare xyscaled (width,maxheight) ;
1301 if getparameter "showlabels" :
1302 for s = 1 upto nofsamplesets :
1303 for i = 1 upto nofsamples :
1304 draw lmt_do_chart_text (s,i,getparameter "samples" s i)
1305 shifted (0,maxheightnofsamplesets(iheight)height2(s-1)height(i-1)distance) ;
1306 endfor ;
1307 endfor ;
1308 fi ;
1309 lmt_do_chart_legend ;
1310 fi ;
1311 lmt_do_chart_stop ;
1312 )
1313enddef ;
1314
1315
1316
1317
1318presetparameters "shade" [
1319 alternative = "circular",
1320 path = origin -- cycle,
1321 trace = false
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333] ;
1334
1335
1336
1337def lmt_shade = applyparameters "shade" "lmt_do_shade" enddef ;
1338
1339vardef lmt_do_shade =
1340 image (
1341 pushparameters "shade" ;
1342
1343 save domain_min, domain_max, radius_a, radius_b, factor ;
1344 save color_a, color_b, center_a, center_b, alternative, s ;
1345 string color_a, color_b, alternative, s ; pair center_a, center_b ;
1346
1347 alternative := getparameter "alternative" ;
1348
1349 mfun_with_shade_method_analyze(getparameter "path") ;
1350
1351 domain_min := 0 ;
1352 domain_max := 1 ;
1353
1354 color_a := "white" ;
1355 color_b := "black" ;
1356
1357 if alternative = "circular" :
1358 center_a := center mfun_shade_path ;
1359 center_b := center_a ;
1360 radius_a := 0 ;
1361 radius_b := mfun_max_radius(mfun_shade_path) ;
1362 factor := 1.2 ;
1363 else :
1364 center_a := llcorner mfun_shade_path ;
1365 center_b := urcorner mfun_shade_path ;
1366 radius_a := 0 ;
1367 radius_b := 0 ;
1368 factor := 0;
1369 fi ;
1370
1371 if hasparameter "domain" :
1372 domain_min := getparameter "domain" 1 ;
1373 domain_max := getparameter "domain" 2 ;
1374 fi
1375 if hasparameter "radius" :
1376 if numeric getparameter "radius" :
1377 radius_a := 0 ;
1378 radius_b := getparameter "radius" ;
1379 else :
1380 radius_a := getparameter "radius" 1 ;
1381 radius_b := getparameter "radius" 2 ;
1382 fi ;
1383 factor := 1 ;
1384 fi
1385 if hasparameter "factor" :
1386 factor := getparameter "factor" ;
1387 fi
1388 if hasparameter "origin" :
1389 if pair getparameter "origin" :
1390 center_a := getparameter "origin" ;
1391 center_b := center_b ;
1392 else :
1393 center_a := getparameter "origin" 1 ;
1394 center_b := getparameter "origin" 2 ;
1395 fi ;
1396 fi
1397 if hasparameter "colors" :
1398 color_a := getparameter "colors" 1 ;
1399 color_b := getparameter "colors" 2 ;
1400 fi
1401 if hasparameter "direction" :
1402 save a, b, bb, temp_x, temp_y ; path bb ;
1403 temp_x := temp_y := 0 ;
1404 bb := boundingbox(mfun_shade_path) ;
1405 a := b := -1 ;
1406 if string getparameter "direction" :
1407 s := getparameter "direction" ;
1408 if s = "up" :
1409 temp_x := xpart shadedup ;
1410 temp_y := ypart shadedup ;
1411 elseif s = "down" :
1412 temp_x := xpart shadeddown ;
1413 temp_y := ypart shadeddown ;
1414 elseif s = "left" :
1415 temp_x := xpart shadedleft ;
1416 temp_y := ypart shadedleft ;
1417 elseif s = "right" :
1418 temp_x := xpart shadedright ;
1419 temp_y := ypart shadedright ;
1420 fi
1421 else :
1422 temp_x := getparameter "direction" 1 ;
1423 temp_y := getparameter "direction" 2 ;
1424 fi
1425 if temp_x >= 0 :
1426 center_a := point temp_x of bb ;
1427 fi
1428 if temp_y >= 0 :
1429 center_b := point temp_y of bb ;
1430 fi
1431 fi ;
1432 if hasparameter "center" :
1433 save cx, cy ;
1434 if numeric getparameter "center" :
1435 cx := getparameter "center" ;
1436 cx := cy ;
1437
1438
1439
1440 else :
1441 cx := getparameter "center" 1 ;
1442 cy := getparameter "center" 2 ;
1443 fi
1444 center_a := center mfun_shade_path shifted (
1445 cx bbwidth (mfun_shade_path)2,
1446 cy bbheight(mfun_shade_path)2
1447 ) ;
1448 elseif hasparameter "vector" :
1449 center_a := point (getparameter "vector" 1) of mfun_shade_path ;
1450 center_b := point (getparameter "vector" 2) of mfun_shade_path ;
1451 fi
1452 fill mfun_shade_path
1453 withprescript "sh_domain=" & decimal domain_min & " " & decimal domain_max
1454 withprescript "sh_transform=yes"
1455 withprescript "sh_color=into"
1456 withprescript "sh_color_a=" & colordecimals color_a
1457 withprescript "sh_color_b=" & colordecimals color_b
1458 withprescript "sh_first=" & ddecimal point 0 of mfun_shade_path
1459 withprescript "sh_set_x=" & ddecimal (mfun_shade_nx,mfun_shade_lx)
1460 withprescript "sh_set_y=" & ddecimal (mfun_shade_ny,mfun_shade_ly)
1461 if alternative = "linear" :
1462 withprescript "sh_type=linear"
1463
1464 withprescript "sh_factor=" & decimal factor
1465 withprescript "sh_center_a=" & ddecimal center_a
1466 withprescript "sh_center_b=" & ddecimal center_b
1467 else :
1468 withprescript "sh_type=circular"
1469
1470 withprescript "sh_factor=" & decimal factor
1471 withprescript "sh_center_a=" & ddecimal center_a
1472 withprescript "sh_center_b=" & ddecimal center_b
1473 withprescript "sh_radius_a=" & decimal radius_a
1474 withprescript "sh_radius_b=" & decimal radius_b
1475 fi ;
1476 if getparameter "trace" :
1477 draw fullcircle scaled 1mm shifted center_a ;
1478 draw fullsquare scaled 2mm shifted center_b ;
1479 draw textext.top("\strut\ttx center a") ysized LineHeight shifted center_a shifted (0, 2mm) ;
1480 draw textext.bot("\strut\ttx center b") ysized LineHeight shifted center_b shifted (0,-2mm) ;
1481 if alternative = "circular" :
1482
1483
1484 draw fullcircle scaled ( radius_a) shifted center_a dashed evenly ;
1485 draw fullcircle scaled (factor radius_b) shifted center_b dashed evenly ;
1486 fi
1487 fi
1488 popparameters ;
1489 )
1490enddef ;
1491
1492
1493
1494
1495presetparameters "contour" [
1496 xmin = 0,
1497 xmax = 0,
1498 ymin = 0,
1499 ymax = 0,
1500 xstep = 0,
1501 ystep = 0,
1502 levels = 10,
1503
1504 preamble = "",
1505 function = "x + y",
1506 color = "lin(l)",
1507 background = "bitmap",
1508 foreground = "auto",
1509 linewidth = .25,
1510 backgroundcolor = "black",
1511 linecolor = "gray",
1512 xformat = "@0.2N",
1513 yformat = "@0.2N",
1514 zformat = "@0.2N",
1515 xstyle = "",
1516 ystyle = "",
1517 zstyle = "",
1518
1519 width = 0,
1520 height = 0,
1521
1522 trace = false,
1523 checkresult = false,
1524 defaultnan = 0,
1525 defaultinf = 0,
1526
1527 legend = "all",
1528 legendheight = LineHeight,
1529 legendwidth = LineHeight,
1530 legendgap = 0,
1531 legenddistance = EmWidth,
1532 textdistance = 2EmWidth3,
1533 functiondistance = ExHeight,
1534 functionstyle = "",
1535
1536 level = 4096,
1537
1538 axisdistance = ExHeight,
1539 axislinewidth = .25,
1540 axisoffset = ExHeight4,
1541 axiscolor = "black",
1542 ticklength = ExHeight,
1543
1544 xtick = 5,
1545 ytick = 5,
1546 xlabel = 5,
1547 ylabel = 5,
1548
1549] ;
1550
1551
1552
1553def lmt_contour = applyparameters "contour" "lmt_do_contour" enddef ;
1554
1555def mfun_only_draw = addto currentpicture doublepath enddef ;
1556def mfun_only_fill = addto currentpicture contour enddef ;
1557def mfun_only_fillup text t = addto currentpicture doublepath t withpostscript "both" enddef ;
1558def mfun_only_nodraw text t = addto currentpicture doublepath t withpostscript "collect" enddef ;
1559def mfun_only_nofill text t = addto currentpicture contour t withpostscript "evenodd" enddef ;
1560def mfun_only_eofill text t = addto currentpicture contour t withpostscript "collect" enddef ;
1561
1562def lmt_do_contour_shortcuts =
1563 save D ; let D = mfun_only_draw ;
1564 save E ; let E = mfun_only_eofill ;
1565 save F ; let F = mfun_only_fill ;
1566 save U ; let U = mfun_only_fillup ;
1567 save d ; let d = mfun_only_nodraw ;
1568 save e ; let f = mfun_only_eofill ;
1569 save f ; let f = mfun_only_nofill ;
1570 save C ; let C = cycle ;
1571 save B ; let B = controls ;
1572 save A ; let A = and ;
1573enddef ;
1574
1575def lmt_do_contour_band =
1576 lua.mp.lmt_contours_edge_set_by_band() ;
1577 for v=1 upto lua.mp.lmt_contours_nofvalues() :
1578 draw image (
1579 lua.mp.lmt_contours_edge_get_band(v) ;
1580 )
1581 withcolor lua.mp.lmt_contours_color(v) ;
1582 endfor ;
1583enddef;
1584
1585def lmt_do_contour_cell(expr dx,dy) =
1586 lua.mp.lmt_contours_edge_set_by_cell() ;
1587 draw image (
1588 if level = 4096 :
1589 for v=1+1 upto lua.mp.lmt_contours_nofvalues() :
1590 lua.mp.lmt_contours_edge_get_cell(v) ;
1591 endfor ;
1592 else :
1593 lua.mp.lmt_contours_edge_get_cell(level) ;
1594 fi
1595 )
1596 if (dx <>0) or (dy <> 0) : shifted (dx,dy) fi
1597 withcolor getparameter "linecolor"
1598 withpen pencircle scaled getparameter "linewidth" ;
1599enddef ;
1600
1601def lmt_do_contour_edge(expr dx, dy) =
1602 lua.mp.lmt_contours_edge_set() ;
1603 draw image (
1604 if level = 4096 :
1605 for v=1+1 upto lua.mp.lmt_contours_nofvalues() :
1606 lua.mp.lmt_contours_edge_paths(v);
1607 endfor ;
1608 else :
1609 lua.mp.lmt_contours_edge_paths(level);
1610 fi
1611 )
1612 if (dx <>0) or (dy <> 0) : shifted (dx,dy) fi
1613 withcolor getparameter "linecolor"
1614 withpen pencircle scaled getparameter "linewidth" ;
1615enddef ;
1616
1617def lmt_do_contour_edges(expr dx, dy) =
1618 lua.mp.lmt_contours_edge_set() ;
1619 if level = 4096 :
1620 for v=1+1 upto lua.mp.lmt_contours_nofvalues() :
1621 draw image (
1622 lua.mp.lmt_contours_edge_paths(v);
1623 )
1624 if (dx <>0) or (dy <> 0) : shifted (dx,dy) fi
1625 withpen pencircle scaled getparameter "linewidth"
1626 withcolor lua.mp.lmt_contours_color(v) ;
1627 endfor ;
1628 else :
1629 draw image (
1630 lua.mp.lmt_contours_edge_paths(level);
1631 )
1632 if (dx <>0) or (dy <> 0) : shifted (dx,dy) fi
1633 withpen pencircle scaled getparameter "linewidth"
1634 withcolor lua.mp.lmt_contours_color(level) ;
1635 fi ;
1636enddef ;
1637
1638def lmt_do_contour_cells(expr dx, dy) =
1639 lua.mp.lmt_contours_edge_set_by_cell() ;
1640 if level = 4096 :
1641 for v=1+1 upto lua.mp.lmt_contours_nofvalues() :
1642 draw image (
1643 lua.mp.lmt_contours_edge_get_cell(v) ;
1644 )
1645 if (dx <>0) or (dy <> 0) : shifted (dx,dy) fi
1646 withpen pencircle scaled getparameter "linewidth"
1647 withcolor lua.mp.lmt_contours_color(v) ;
1648 endfor ;
1649 else :
1650 draw image (
1651 lua.mp.lmt_contours_edge_get_cell(level) ;
1652 )
1653 if offset : shifted (-12,-12) fi
1654 withpen pencircle scaled getparameter "linewidth"
1655 withcolor lua.mp.lmt_contours_color(v) ;
1656 fi ;
1657enddef ;
1658
1659def lmt_do_contour_shape(expr dx, dy) =
1660 draw image (
1661 if level = 4096 :
1662 for v=1+1 upto lua.mp.lmt_contours_nofvalues() :
1663 lua.mp.lmt_contours_shape_paths(v);
1664 endfor ;
1665 else :
1666 lua.mp.lmt_contours_shape_paths(level);
1667 lua.mp.lmt_contours_shape_paths(1);
1668 fi
1669 )
1670 if (dx <>0) or (dy <> 0) : shifted (dx,dy) fi
1671 withcolor getparameter "linecolor"
1672 withpen pencircle scaled getparameter "linewidth" ;
1673enddef ;
1674
1675def lmt_do_contour_bitmap =
1676 lua.mp.lmt_contours_bitmap_set() ;
1677 lua.mp.lmt_contours_bitmap_get() ;
1678enddef ;
1679
1680def lmt_do_contour_shades(expr outlines) =
1681 lua.mp.lmt_contours_shade_set(outlines) ;
1682 if level = 4096 :
1683 for v=1 upto lua.mp.lmt_contours_nofvalues() :
1684 draw image (
1685 lua.mp.lmt_contours_shade_paths(v) ;
1686 )
1687 withpen pencircle scaled 0
1688 withcolor lua.mp.lmt_contours_color(v) ;
1689 endfor ;
1690 else :
1691 draw image (
1692 lua.mp.lmt_contours_shade_paths(level);
1693 )
1694 withpen pencircle scaled 0
1695 withcolor lua.mp.lmt_contours_color(level) ;
1696 fi ;
1697enddef ;
1698
1699def lmt_load_mlib_cnt =
1700 runscript("lua.registercode('mlib-cnt')");
1701 extra_beginfig := extra_beginfig &
1702 "runscript(" & ditto & "mp.lmt_contours_cleanup()" & ditto & ")" ;
1703 let lmt_load_mlib_cnt = relax ;
1704enddef ;
1705
1706vardef lmt_do_contour =
1707 image (
1708
1709 lmt_load_mlib_cnt ;
1710
1711 pushparameters "contour" ;
1712
1713 lua.mp.lmt_contours_start() ;
1714
1715
1716
1717 save bg, fg, nx, ny, trace, level, b, done ; string bg, fg ; boolean trace, done ; path b ;
1718
1719 bg := getparameter "background" ;
1720 fg := getparameter "foreground" ;
1721 nx := lua.mp.lmt_contours_nx() ;
1722 ny := lua.mp.lmt_contours_ny() ;
1723 trace := getparameter "trace" ;
1724 level := getparameter "level" ;
1725 done := true ;
1726
1727 begingroup ;
1728
1729 lmt_do_contour_shortcuts ;
1730
1731 if bg = "band" :
1732 lmt_do_contour_band ;
1733 b := boundingbox currentpicture ;
1734 if (fg = "auto") or (fg = "cell") :
1735 lmt_do_contour_cell(0,0) ;
1736 elseif (fg = "edge") :
1737 lmt_do_contour_edge(0,0) ;
1738 fi ;
1739
1740 elseif bg = "bitmap" :
1741
1742 lmt_do_contour_bitmap ;
1743 b := boundingbox currentpicture ;
1744 if (fg = "auto") or (fg = "cell") :
1745 lmt_do_contour_cell(-12,-12) ;
1746 elseif (fg = "edge") :
1747 lmt_do_contour_edge(-12,-12) ;
1748 fi ;
1749
1750 elseif bg = "shape" :
1751
1752 lmt_do_contour_shades((fg = "auto") or (fg = "shape")) ;
1753 b := boundingbox currentpicture ;
1754 if (fg == "auto") or (fg = "shape") :
1755 lmt_do_contour_shape(0,0) ;
1756 elseif fg == "cell" :
1757 lmt_do_contour_cell(-1,-1) ;
1758 elseif fg == "edge" :
1759 lmt_do_contour_edge(-1,-1) ;
1760 fi ;
1761
1762
1763
1764 elseif fg = "cell" :
1765
1766 lmt_do_contour_shortcuts ;
1767 lmt_do_contour_cells(0,0) ;
1768 b := boundingbox currentpicture ;
1769
1770 elseif fg = "edge" :
1771
1772 lmt_do_contour_shortcuts ;
1773 lmt_do_contour_edges(0,0) ;
1774 b := boundingbox currentpicture ;
1775
1776 else :
1777
1778 done := false ;
1779
1780 fi ;
1781
1782 endgroup ;
1783
1784 if done :
1785
1786 save w, h, cx, cy ;
1787
1788 cx := bbwidth (b)(nx 1) ;
1789 cy := bbheight(b)(ny 1) ;
1790 clip currentpicture to b
1791 leftenlarged cx rightenlarged cx
1792 topenlarged cy bottomenlarged cy ;
1793 currentpicture := currentpicture
1794 shifted (cx,cy) ;
1795
1796 w := getparameter "width" ;
1797 h := getparameter "height" ;
1798
1799
1800
1801 save xtic, ytic, auto ; boolean auto ;
1802
1803 xtic := getparameter "xtick" ;
1804 ytic := getparameter "ytick" ;
1805 auto := (w = 0) and (h = 0) ;
1806
1807
1808
1809 if w <> 0 :
1810 if h <> 0 :
1811 currentpicture := currentpicture xysized (w,h) ;
1812 else :
1813 currentpicture := currentpicture xsized w ;
1814 fi ;
1815 elseif h <> 0 :
1816 currentpicture := currentpicture ysized h ;
1817 fi ;
1818 if w = 0 :
1819 w := bbwidth(currentpicture) ;
1820 fi ;
1821 if h = 0 :
1822 h := bbheight(currentpicture) ;
1823 fi ;
1824
1825
1826
1827 if hasoption "legend" "all,x,y,z,range" :
1828
1829 save u, s, sx, sy, ax, ay, ao, al, at, tl, ox, oy, lg, tx, ty, wx, hx, ry, fmt, pmin, pmax ; string fmt; picture pmin, pmax ;
1830
1831
1832
1833 if hasoption "legend" "all,z" :
1834
1835
1836
1837 fmt := lua.mp.lmt_contours_format() ;
1838 pmin := lmt_text [ format = fmt, text = decimal lua.mp.lmt_contours_minmean() ] ;
1839 pmax := lmt_text [ format = fmt, text = decimal lua.mp.lmt_contours_maxmean() ] ;
1840 wx := max(bbwidth(pmin),bbwidth(pmax)) ;
1841 hx := bbheight(pmin) ;
1842
1843 else :
1844
1845 hx := 0;
1846
1847 fi ;
1848
1849 if auto :
1850
1851 u := lua.mp.lmt_contours_ny() 100 ;
1852 ry := 4u ;
1853 sy := 5u ;
1854 sx := 5u ;
1855 lg := 0 ;
1856 ox := 5u ;
1857 oy := sy2 ry2 ;
1858 tx := 2u ;
1859 ty := 1u ;
1860 ax := 1u ;
1861 ay := 1u ;
1862 ao := u ;
1863 al := u8 ;
1864 at := 3u2 ;
1865 al := u4 ;
1866 else :
1867 ry := 0 ;
1868 sy := getparameter "legendheight" ;
1869 sx := getparameter "legendwidth" ;
1870 lg := getparameter "legendgap" ;
1871 ox := getparameter "legenddistance" ;
1872 oy := sy2 hx2 ;
1873 tx := getparameter "textdistance" ;
1874 ty := getparameter "functiondistance" ;
1875 ax := getparameter "axisdistance" ;
1876 ay := ax ;
1877 ao := getparameter "axisoffset" ;
1878 at := getparameter "ticklength" ;
1879 al := getparameter "axislinewidth" ;
1880 fi ;
1881
1882 if hasoption "legend" "all,z" :
1883
1884 save dy ; dy := h ;
1885
1886 for v=1 upto lua.mp.lmt_contours_nofvalues() :
1887 dy := dy sy ;
1888 fill unitsquare xyscaled (sx,sy)
1889 shifted (wox,dy)
1890 withcolor lua.mp.lmt_contours_color(v) ;
1891 draw
1892 lmt_text [
1893 trace = trace,
1894 anchor = "llft",
1895 format = fmt,
1896 text = decimal lua.mp.lmt_contours_value(v),
1897 style = getparameter "zstyle",
1898 position = (wx,0),
1899 background = "",
1900 ]
1901 if ry <> 0 : ysized (ry) fi
1902 shifted (woxtxsx,dysyoy)
1903 ;
1904 dy := dy lg ;
1905 endfor ;
1906
1907 fi ;
1908
1909 if hasoption "legend" "x,all" :
1910
1911 save n, d, s, xmin, xmax, xlab ;
1912
1913 xmin := getparameter "xmin" ;
1914 xmax := getparameter "xmax" ;
1915 xlab := getparameter "xlabel" ;
1916
1917 draw image (
1918 interim linecap := butt ;
1919 draw ((0,0) -- (w,0)) ;
1920 n := al2 ; s := (w al) xtic ; d := (xmax xmin) xtic ;
1921 for i=xmin step d until xmax :
1922 draw (n,0) -- (n,at) ;
1923 n := n s ;
1924 endfor ;
1925 ) shifted (0,ay)
1926 withpen pencircle scaled al
1927 withcolor getparameter "axiscolor"
1928 ;
1929
1930 if hasoption "legend" "label,all" :
1931
1932 draw image (
1933 n := al2 ; s := (w al) xlab ; d := (xmax xmin) xlab ;
1934 for i=xmin step d until xmax :
1935 draw lmt_text [
1936 trace = trace,
1937 anchor = "bot",
1938 format = getparameter "xformat",
1939 style = getparameter "xstyle",
1940 text = decimal i
1941 background = "",
1942 ]
1943 if ry <> 0 : ysized (ry) fi
1944 shifted (n,atao)
1945 ;
1946 n := n s ;
1947 endfor ;
1948 ) shifted (0,ay) ;
1949
1950 fi ;
1951
1952 fi ;
1953
1954 if hasoption "legend" "y,all" :
1955
1956 save n, d, s, ymin, ymax, ylab ;
1957
1958 ymin := getparameter "ymin" ;
1959 ymax := getparameter "ymax" ;
1960 ylab := getparameter "ylabel" ;
1961
1962 draw image (
1963 interim linecap := butt ;
1964 draw ((0,0) -- (0,h)) ;
1965 n := al2 ; s := (h al) ytic ; d := (ymax ymin) ytic ;
1966 for i=ymin step d until ymax :
1967 draw (0,n) -- (at,n) ;
1968 n := n s ;
1969 endfor ;
1970 ) shifted (ax,0)
1971 withpen pencircle scaled al
1972 withcolor getparameter "axiscolor" ;
1973 ;
1974
1975 if hasoption "legend" "label,all" :
1976
1977 draw image (
1978 n := al2 ; s := (h al) ylab ; d := (ymax ymin) ylab ;
1979 for i=ymin step d until ymax :
1980 draw lmt_text [
1981 trace = trace,
1982 anchor = "lft",
1983 format = getparameter "yformat",
1984 style = getparameter "ystyle",
1985 text = decimal i
1986 background = "",
1987 ]
1988 if ry <> 0 : ysized (ry) fi
1989 shifted (atao,n)
1990 ;
1991 n := n s ;
1992 endfor ;
1993 ) shifted (ax,0) ;
1994
1995 fi ;
1996
1997 fi ;
1998
1999 if hasoption "legend" "range,all" :
2000
2001
2002
2003 save d ; d := ypart llcorner currentpicture ;
2004
2005 draw
2006 lmt_text [
2007 trace = trace,
2008 anchor = "bot",
2009 text = lua.mp.lmt_contours_range()
2010 background = "",
2011 ]
2012 if ry <> 0 : ysized (ry) fi
2013 shifted (w2,dty)
2014 ;
2015
2016
2017
2018 draw
2019 lmt_text [
2020 trace = trace,
2021 anchor = "lrt",
2022 text = lua.mp.lmt_contours_xrange()
2023 background = "",
2024 ]
2025 if ry <> 0 : ysized (ry) fi
2026 shifted (0,dty)
2027 ;
2028
2029 draw
2030 lmt_text [
2031 trace = trace,
2032 anchor = "llft",
2033 text = lua.mp.lmt_contours_yrange()
2034 background = "",
2035 ]
2036 if ry <> 0 : ysized (ry) fi
2037 shifted (w,dty)
2038 ;
2039
2040 fi ;
2041
2042 if hasoption "legend" "function,all" :
2043
2044
2045
2046 draw
2047 lmt_text [
2048 trace = trace,
2049 anchor = "bot",
2050 style = getparameter "functionstyle",
2051 text = lua.mp.lmt_contours_function()
2052 background = "",
2053 ]
2054 if ry <> 0 : ysized (ry) fi
2055 shifted (w2,ypart llcorner currentpicture ty)
2056 ;
2057
2058 fi ;
2059
2060 if trace :
2061 draw boundingbox currentpicture
2062 dashed evenly
2063 withpen pencircle scaled al ;
2064 fi ;
2065
2066 fi ;
2067
2068 fi ;
2069
2070 lua.mp.lmt_contours_stop() ;
2071
2072 popparameters ;
2073 )
2074enddef ;
2075
2076newinternal svgforcecmyk ; svgforcecmyk := 0 ;
2077
2078vardef svgcolor(expr r, g, b) =
2079 if svgforcecmyk > 0 :
2080 (1r,1g,1b,0)
2081 else :
2082 (r,g,b)
2083 fi
2084enddef ;
2085
2086vardef svgcmyk(expr c, m, y, k) =
2087 (c,m,y,k)
2088enddef ;
2089
2090vardef svggray(expr s) =
2091 s
2092enddef ;
2093
2094permanent svgforcecmyk, svgcolor, svgcmyk, svggray ;
2095
2096presetparameters "svg" [
2097 filename = "",
2098 fontname = "",
2099 colormap = "",
2100
2101 width = 0,
2102 height = 0,
2103 origin = false,
2104 offset = 0,
2105] ;
2106
2107def lmt_svg = applyparameters "svg" "lmt_do_svg" enddef ;
2108
2109vardef lmt_do_svg =
2110 save w, h, o;
2111 image (
2112 pushparameters "svg" ;
2113 w := getparameter "width" ;
2114 h := getparameter "height" ;
2115 o := getparameter "offset" ;
2116 lua.mp.lmt_svg_include() ;
2117 if getparameter "origin" :
2118 currentpicture := currentpicture shifted llcorner currentpicture ;
2119 fi ;
2120 popparameters ;
2121 if o <> 0 :
2122 setbounds currentpicture to boundingbox currentpicture enlarged o ;
2123 fi ;
2124 )
2125 if w > 0 :
2126 if h > 0 : xysized(w,h) else : xsized(w) fi
2127 else :
2128 if h > 0 : ysized(h) fi
2129 fi
2130enddef ;
2131
2132
2133
2134
2135presetparameters "surface" [
2136 code = "x + y",
2137 color = "f, 0, 0",
2138 linecolor = 1,
2139 xmin = -1,
2140 xmax = 1,
2141 ymin = -1,
2142 ymax = 1,
2143 xstep = .1,
2144 ystep = .1,
2145 snap = .01,
2146 xvector = { -0.7, -0.7 },
2147 yvector = { 1, 0 },
2148 zvector = { 0, 1 },
2149 light = { 3, 3, 10 },
2150 bright = 100,
2151 clip = false,
2152 lines = true,
2153 linecolor = 1,
2154
2155
2156 axiscolor = "gray"
2157 axislinewidth = 12,
2158] ;
2159
2160def lmt_surface = applyparameters "surface" "lmt_do_surface" enddef ;
2161
2162vardef lmt_do_surface =
2163 image (
2164
2165 lmt_load_mlib_cnt ;
2166
2167 pushparameters "surface" ;
2168
2169 save currentpen; pen currentpen ;
2170 currentpen := pencircle scaled .25 ;
2171
2172 interim linejoin := butt ;
2173
2174 lmt_do_contour_shortcuts ;
2175
2176 lua.mp.lmt_surface_do() ;
2177
2178 currentpicture := currentpicture ysized getparameter "height" ;
2179
2180 if hasparameter "axis" :
2181
2182 save p ; picture p ; p := image (
2183 if hasparameter "axis" 1 :
2184 draw ((origin) -- unitvector(getparameter "xvector")) scaled (getparameter "axis" 1) ;
2185 fi ;
2186 if hasparameter "axis" 2 :
2187 draw ((origin) -- unitvector(getparameter "yvector")) scaled (getparameter "axis" 2) ;
2188 fi ;
2189 if hasparameter "axis" 3 :
2190 draw ((origin) -- unitvector(getparameter "zvector")) scaled (getparameter "axis" 3) ;
2191 fi ;
2192 ) ;
2193
2194 if getparameterdefault "clipaxis" false :
2195 clip p to boundingbox currentpicture ;
2196 fi ;
2197
2198 draw p
2199 withpen pencircle scaled getparameter "axislinewidth"
2200 withcolor getparameter "axiscolor"
2201 ;
2202
2203 fi ;
2204
2205 popparameters ;
2206 )
2207enddef ;
2208
2209
2210
2211
2212presetparameters "mpsglyphs" [
2213 name = "dummy",
2214 units = 1000,
2215] ;
2216
2217presetparameters "mpsglyph" [
2218 category = "dummy",
2219 unicode = 0,
2220
2221] ;
2222
2223def lmt_registerglyphs = applyparameters "mpsglyphs" "lmt_do_registerglyphs" enddef ;
2224def lmt_registerglyph = applyparameters "mpsglyph" "lmt_do_registerglyph" enddef ;
2225
2226newscriptindex mfid_registerglyphs ; mfid_registerglyphs := scriptindex "registerglyphs" ; def lmt_do_registerglyphs = runscript mfid_registerglyphs enddef ;
2227newscriptindex mfid_registerglyph ; mfid_registerglyph := scriptindex "registerglyph" ; def lmt_do_registerglyph = runscript mfid_registerglyph enddef ;
2228
2229
2230
2231vardef registercomposedglyph (expr u) (suffix snippets) =
2232 save s ; s := getparameterdefault "mpsfont" "scale" 1 ;
2233 save llx, lly, urx, ury ;
2234 llx := xpart llcorner snippets[u] ;
2235 if llx <> 0 :
2236
2237 snippets[u] := snippets[u] shifted (llx, 0) ;
2238 llx := 0;
2239 fi ;
2240 lly := ypart llcorner snippets[u] s ;
2241 urx := xpart urcorner snippets[u] s ;
2242 ury := ypart urcorner snippets[u] s ;
2243 lmt_registerglyph [
2244 category = getparameter "mpsfont" "category",
2245 unicode = u,
2246 code = "draw " & str snippets & "[" & decimal u & "]",
2247 height = ury,
2248 depth = lly,
2249 width = urx llx,
2250 boundingbox = { llx, lly, urx, ury }
2251 ] ;
2252enddef ;
2253
2254vardef composeglyph (suffix snippets) =
2255 save u ; u := getparameter "mpsfont" "unicode" ;
2256 save s ; s := getparameterdefault "mpsfont" "scale" 1 ;
2257 snippets[u] := image (
2258 for i=1 upto getparametercount "mpsfont" "shapes" :
2259 draw scantokens ( getparameter "mpsfont" "shapes" i "shape" )
2260 if hasparameter "mpsfont" "shapes" i "color" :
2261 withcolor getparameter "mpsfont" "shapes" i "color"
2262 fi ;
2263 endfor ;
2264 ) scaled s ;
2265 registercomposedglyph(u, snippets) ;
2266enddef ;
2267
2268permanent registercomposeglyph, composeglyph ;
2269
2270
2271
2272
2273
2274newscriptindex mfid_remaptext ; mfid_remaptext := scriptindex "remaptext" ; def lmt_remaptext = runscript mfid_remaptext ; enddef ;
2275
2276triplet mfun_tt_s ;
2277
2278vardef rawmaptext(expr s) =
2279 mfun_tt_n := mfun_tt_n 1 ;
2280 mfun_tt_c := nullpicture ;
2281 mfun_tt_o := nullpicture ;
2282 addto mfun_tt_o doublepath origin base_draw_options ;
2283 mfun_tt_r := lua.mp.mf_map_text(mfun_tt_n,s,catcoderegime) ;
2284 mfun_tt_s := lua.mp.mf_map_move(mfun_tt_n) ;
2285 addto mfun_tt_c doublepath unitsquare
2286 xscaled wdpart mfun_tt_r
2287 yscaled (htpart mfun_tt_r dppart mfun_tt_r)
2288 shifted (0,dppart mfun_tt_r)
2289 withprescript "mf_object=text"
2290 withprescript "tx_index=" & decimal mfun_tt_n
2291 withprescript "tx_color=" & colordecimals colorpart mfun_tt_o
2292 ;
2293 mfun_tt_c
2294enddef ;
2295
2296vardef svgtext(expr t) =
2297 save p ; picture p ;
2298
2299
2300 p := rawmaptext(t) ;
2301 p
2302 if (mfun_labtype.drt >= 10) :
2303 shifted (0,ypart center p)
2304 fi
2305 shifted (
2306 mfun_labshift.drt(p)
2307 (redpart mfun_tt_s,0)
2308 (greenpart mfun_tt_s,bluepart mfun_tt_s)
2309 )
2310enddef ;
2311
2312vardef svg expr c = lmt_svg [ code = c ] enddef ;
2313
2314
2315
2316presetparameters "poisson" [
2317 width = 50,
2318 height = 50,
2319 initialx = 0,
2320 initialy = 0,
2321 distance = 1,
2322 count = 20,
2323 macro = "draw",
2324 arguments = 2
2325] ;
2326
2327def lmt_poisson = applyparameters "poisson" "lmt_do_poisson" enddef ;
2328
2329vardef lmt_do_poisson =
2330 image (
2331 pushparameters "poisson" ;
2332 lua.mp.lmt_poisson_generate();
2333 popparameters ;
2334 )
2335enddef ;
2336
2337permanent
2338 lmt_text, lmt_grid, lmt_axis, lmt_outline, lmt_followtext,
2339 lmt_arrow, lmt_placeholder,
2340 lmt_function, lmt_poisson, lmt_mesh,
2341 lmt_chart_circle, lmt_chart_histogram, lmt_chart_bar,
2342 lmt_shade, lmt_contour, lmt_svg, lmt_surface,
2343 lmt_registerglyphs, lmt_registerglyph,
2344 lmt_remaptext, rawmaptext, svgtext, svg,
2345 OverlayMesh ;
2346
2347
2348
2349newscriptindex mfid_scrutinized ; mfid_scrutinized := scriptindex "scrutinized" ;
2350
2351primarydef p scrutinized n =
2352 runscript mfid_scrutinized p n
2353enddef ;
2354
2355permanent scrutinized ;
2356
2357
2358
2359
2360
2361
2362
2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375newscriptindex mfid_mpvard ; mfid_mpvard := scriptindex "mpvard" ; def mpvard = runscript mfid_mpvard enddef ;
2376newscriptindex mfid_mpvarn ; mfid_mpvarn := scriptindex "mpvarn" ; def mpvarn = runscript mfid_mpvarn enddef ;
2377newscriptindex mfid_mpvars ; mfid_mpvars := scriptindex "mpvars" ; def mpvars = runscript mfid_mpvars enddef ;
2378newscriptindex mfid_mpvarb ; mfid_mpvarb := scriptindex "mpvarb" ; def mpvarb = runscript mfid_mpvarb enddef ;
2379newscriptindex mfid_mpvar ; mfid_mpvar := scriptindex "mpvar" ; def mpvar = runscript mfid_mpvar enddef ;
2380
2381permanent mpvard, mpvarn, mpvars, mpvarb, mpvar ;
2382
2383
2384
2385vardef textual primary p = false enddef ;
2386
2387
2388
2389newscriptindex mfid_labtorgb ; mfid_labtorgb := scriptindex "labtorgb" ;
2390
2391def labtorgb(expr l, a, b) = runscript mfid_labtorgb l a b enddef ;
2392
2393permanent labtorgb ;
2394
2395presetparameters "labtorgb" [
2396 mina = -100,
2397 maxa = 100,
2398 minb = -100,
2399 maxb = 100,
2400 step = 5,
2401 l = 50,
2402] ;
2403
2404def lmt_labtorgb = applyparameters "labtorgb" "lmt_do_labtorgb" enddef ;
2405
2406vardef lmt_do_labtorgb =
2407 image (
2408 pushparameters "labtorgb" ;
2409 save l ; l := getparameter "l" ;
2410 for a = getparameter "mina" step getparameter "step" until getparameter "maxa" :
2411 for b = getparameter "minb" step getparameter "step" until getparameter "maxb" :
2412
2413 draw (a,b) withcolor runscript mfid_labtorgb l a b ;
2414 endfor ;
2415 endfor ;
2416 popparameters ;
2417 )
2418enddef ;
2419
2420
2421
2422presetparameters "matrix" [
2423
2424
2425
2426
2427 connect = { "center", "center" },
2428
2429] ;
2430
2431def lmt_matrix = applyparameters "matrix" "lmt_do_matrix" enddef ;
2432
2433vardef mfun_lmt_matrix_cell (expr p) =
2434
2435 matrixcell (xpart p, ypart p)
2436enddef ;
2437
2438
2439
2440def mfun_lmt_matrix_connect (expr h, p, r, l, u, d, gap) =
2441 if h == "right" : center rightboundary (p enlarged gap) { r }
2442 elseif h == "left" : center leftboundary (p enlarged gap) { l }
2443 elseif h == "top" : center topboundary (p enlarged gap) { u }
2444 elseif h == "bottom" : center bottomboundary (p enlarged gap) { d }
2445 else : center (p enlarged gap)
2446 fi
2447enddef ;
2448
2449def mfun_lmt_matrix_source (expr p, h, gap) =
2450 mfun_lmt_matrix_connect(h, p, right, left, up, down, gap)
2451enddef ;
2452
2453def mfun_lmt_matrix_target (expr p, h, gap) =
2454 mfun_lmt_matrix_connect(h, p, left, right, down, up, gap)
2455enddef ;
2456
2457vardef mfun_lmt_matrix_enhance (expr p, h) =
2458 if h = "circle" :
2459 fullcircle xysized (bbwidth p, bbheight p) shifted center p
2460 elseif h = "round" :
2461 (p smoothed getparameterdefault "radius" ExHeight) xysized (bbwidth p, bbheight p)
2462 elseif h = "path" :
2463 (getparameterpath "path") shifted center p
2464 elseif h = "scaledpath" :
2465 (getparameterpath "path") xysized (bbwidth p, bbheight p) shifted center p
2466 else :
2467 p
2468 fi
2469enddef ;
2470
2471vardef lmt_do_matrix =
2472 image (
2473 pushparameters "matrix" ;
2474 draw image (
2475 save a, b, c, o, g ; path a, b, c ; numeric o, g ;
2476 if (hasparameter "arrowoffset") :
2477 g := getparameter "arrowoffset" ;
2478 elseif (hasparameter "linewidth") :
2479 g := getparameter "linewidth" ;
2480 else :
2481 g := 0;
2482 fi ;
2483 if (hasparameter "from") and (hasparameter "to") :
2484 a := mfun_lmt_matrix_cell(getparameter "from") ;
2485 b := mfun_lmt_matrix_cell(getparameter "to") ;
2486 if hasparameter "offset" :
2487 o := getparameter "offset" ;
2488 a := a enlarged o ;
2489 b := b enlarged o ;
2490 fi ;
2491 if hasparameter "shapes" :
2492 a := mfun_lmt_matrix_enhance(a, getparameter "shapes" 1) ;
2493 b := mfun_lmt_matrix_enhance(b, getparameter "shapes" 2) ;
2494 fi ;
2495 draw a
2496 if (hasparameter "colors") :
2497 withcolor (getparameter "colors" 1)
2498 elseif (hasparameter "color") :
2499 withcolor (getparameter "color")
2500 fi
2501 ;
2502 draw b
2503 if (hasparameter "colors") :
2504 withcolor (getparameter "colors" 2)
2505 elseif (hasparameter "color") :
2506 withcolor (getparameter "color")
2507 fi
2508 ;
2509 c :=
2510 mfun_lmt_matrix_source(a, getparameter "connect" 1, g) ..
2511 mfun_lmt_matrix_target(b, getparameter "connect" 2, g) ;
2512 drawarrow c
2513 if (hasparameter "arrowcolor") :
2514 withcolor (getparameter "arrowcolor")
2515 elseif (hasparameter "color") :
2516 withcolor (getparameter "color")
2517 fi
2518 ;
2519 if hasparameter "label" :
2520 pushparameters "label" ;
2521 draw lmt_text [
2522 text = getparameter "text",
2523 position = point (getparameterdefault "fraction" 12) of c,
2524 offset = if hasparameter "offset" : getparameter "offset" fi,
2525 color = if hasparameter "color" : getparameter "color" fi,
2526 anchor = if hasparameter "anchor" : getparameter "anchor" fi,
2527
2528 ] ;
2529 popparameters ;
2530 fi ;
2531 elseif (hasparameter "cell") :
2532 a := mfun_lmt_matrix_cell(getparameter "cell") ;
2533 if hasparameter "offset" :
2534 o := getparameter "offset" ;
2535 a := a enlarged o ;
2536 fi ;
2537 if hasparameter "shape" :
2538 a := mfun_lmt_matrix_enhance(a, getparameter "shape") ;
2539 fi ;
2540 draw a
2541 if (hasparameter "color") :
2542 withcolor (getparameter "color")
2543 fi
2544 ;
2545 fi;
2546 )
2547 if (hasparameter "linewidth") :
2548 withpen pencircle scaled (getparameter "linewidth")
2549 fi
2550 popparameters
2551 )
2552enddef ;
2553 |