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 save kind ; string kind ; kind := getparameter "outline" "kind" ;
273 save align ; string align ; align := getparameter "outline" "align" ;
274 save style ; string style ; style := getparameter "outline" "style" ;
275 save width ; numeric width ; width := getparameter "outline" "width" ;
276 save isol ; boolean isol ; isol := (kind == "outline") ;
277 if isol :
278 kind := "p" ;
279 save ol ; picture ol ; ol :=
280 fi
281 image ( normaldraw image (
282 if kind = "draw" :
283 kind := "d" ;
284 elseif kind = "fill" :
285 kind := "f" ;
286 elseif kind = "both" :
287 kind := "b" ;
288 elseif kind = "reverse" :
289 kind := "r" ;
290 elseif kind = "fillup" :
291 kind := "u" ;
292 elseif kind = "path" :
293 kind := "p" ;
294 fi ;
295 currentoutlinetext := currentoutlinetext 1 ;
296 lua.mp.mf_outline_text(
297 currentoutlinetext,
298 if align = "" :
299 getparameter "outline" "text",
300 else :
301 "\framed[align={" & align & "}"
302 if width > 0 :
303 & ",width=" & decimal width & "bp"
304 fi
305 if style <> "" :
306 & ",foregroundstyle={" & style & "}"
307 fi
308 & ",offset=none,frame=off]{"
309 & (getparameter "outline" "text")
310 & "}",
311 fi,
312 kind
313 ) ;
314 save currentpen; pen currentpen ;
315 pickup pencircle scaled getparameter "outline" "rulethickness" ;
316 if kind = "f" :
317 mfun_do_outline_text_set_f (
318 withcolor getparameter "outline" "fillcolor"
319 );
320 elseif kind = "d" :
321 mfun_do_outline_text_set_d (
322 withcolor getparameter "outline" "drawcolor"
323 );
324 elseif kind = "b" :
325 mfun_do_outline_text_set_b (
326 withcolor getparameter "outline" "fillcolor"
327 ) (
328 withcolor getparameter "outline" "drawcolor"
329 );
330 elseif kind = "u" :
331 mfun_do_outline_text_set_u (
332 withcolor getparameter "outline" "fillcolor"
333 );
334 elseif kind = "r" :
335 mfun_do_outline_text_set_r (
336 withcolor getparameter "outline" "drawcolor"
337 ) (
338 withcolor getparameter "outline" "fillcolor"
339 ) ;
340 elseif kind = "p" :
341 mfun_do_outline_text_set_p ;
342 else :
343 mfun_do_outline_text_set_n (
344
345 );
346 fi ;
347 lua.mp.mf_get_outline_text(currentoutlinetext) ;
348 ) )
349 if isol :
350 ; for i within ol : pathpart i && endfor cycle
351 fi
352enddef ;
353
354presetparameters "followtext" [
355 text = "",
356 spread = true,
357 trace = false,
358 reverse = false,
359 autoscaleup = "no",
360 autoscaledown = "no",
361 path = (fullcircle),
362] ;
363
364def lmt_followtext = applyparameters "followtext" "lmt_do_followtext" enddef ;
365
366vardef lmt_do_followtext =
367 image (
368 pushparameters "followtext" ;
369 save scale_up ; string scale_up ; scale_up := getparameter "autoscaleup" ;
370 save scale_down ; string scale_down ; scale_down := getparameter "autoscaledown" ;
371 save followtextalternative ; followtextalternative := if getparameter "spread" : 1 else : 0 fi ;
372 save autoscaleupfollowtext ; autoscaleupfollowtext := if scale_up = "yes" : 1 elseif scale_up = "max" : 2 else : 0 fi ;
373 save autoscaledownfollowtext ; autoscaledownfollowtext := if scale_down = "yes" : 1 elseif scale_down = "max" : 2 else : 0 fi ;
374
375 interim tracingfollowtext := if getparameter "trace" : 1 else : 0 fi ;
376 draw followtext (
377 if (getparameter "reverse") : reverse fi (getparameter "path"),
378 (getparameter "text")
379 ) ;
380 popparameters ;
381 )
382enddef ;
383
384presetparameters "arrow" [
385 path = origin,
386
387 kind = "fill",
388 dimple = 15,
389 scale = 34,
390 penscale = 3,
391 length = 4,
392 angle = 45,
393 location = "end",
394 alternative = "normal",
395 percentage = 50,
396 headonly = false,
397] ;
398
399def lmt_arrow = applyparameters "arrow" "lmt_do_arrow" enddef ;
400
401vardef lmt_do_arrow =
402 image (
403 pushparameters "arrow" ;
404 save a ; string a ; a := getparameter "alternative" ;
405 save l ; string l ; l := getparameter "location" ;
406 save k ; string k ; k := getparameter "kind" ;
407 save p ; path p ; p := getparameter "path" ;
408 interim ahvariant := if a = "dimpled" : 1 elseif a = "curved" : 2 else : 0 fi ;
409 interim ahdimple := getparameter "dimple" ;
410 interim ahscale := getparameter "scale" ;
411 interim ahangle := getparameter "angle" ;
412 interim ahlength := getparameter "length" ;
413 if not getparameter "headonly" :
414 draw p ;
415 fi ;
416 if hasparameter "pen" :
417
418 if hasoption "pen" "auto" :
419 ahlength := (getparameter "penscale") boundingradius(currentpen) ;
420 else :
421 ahlength := (getparameter "penscale") boundingradius(getparameterpen "pen") ;
422 fi ;
423 fi ;
424 if k = "draw" : draw elseif k = "both" : filldraw else : fill fi
425 if l = "middle" :
426 midarrowhead p ;
427 elseif l = "percentage" :
428 arrowheadonpath (p, (getparameter "percentage")100) ;
429 elseif l = "both" :
430 arrowhead p ;
431 if k = "draw" : draw elseif k = "both" : filldraw else : fill fi
432 arrowhead reverse p ;
433 else :
434 arrowhead p ;
435 fi ;
436 popparameters ;
437 )
438enddef ;
439
440
441
442presetparameters "placeholder" [
443 color = "red",
444 width = 1,
445 height = 1,
446 reduction = 0,
447 alternative = "circle",
448] ;
449
450def lmt_placeholder = applyparameters "placeholder" "lmt_do_placeholder" enddef ;
451
452def lmt_do_placeholder =
453 begingroup ;
454 pushparameters "placeholder" ;
455 save w, h, d, r, p, c, b, s, q, a ;
456 numeric w, h, d, r ; path p ; string s, a ;
457 s := getparameter "color" ;
458 w := getparameter "width" ;
459 h := getparameter "height" ;
460 r := getparameter "reduction" ;
461 a := getparameter "alternative" ;
462 d := max(w,h) ;
463 if cmykcolor resolvedcolor(s) :
464 cmykcolor c, b ; b := (0,0,0,0)
465 else :
466 color c, b ; b := (1,1,1)
467 fi ;
468 c := resolvedcolor(s) ;
469 p := unitsquare xyscaled (w,h) ;
470 fill p withcolor r[.5c,b] ;
471 if a = "square" :
472 vardef q = fullsquare enddef ;
473 elseif a = "triangle" :
474 vardef q = fulltriangle rotated (90 round(uniformdeviate(4))) enddef ;
475 else :
476 vardef q = fullcircle enddef ;
477 fi ;
478 for i := 1 upto 60 :
479 fill q
480 scaled (d5 randomized (d5))
481 shifted (center p randomized (d))
482 withcolor r[c randomized(.3,.9),b] ;
483 endfor ;
484 clip currentpicture to p ;
485 popparameters ;
486 endgroup ;
487enddef ;
488
489
490
491vardef lmt_connected(text t) =
492 save p ; path p ;
493 p := origin t ;
494 subpath (1,length(p)) of p
495enddef ;
496
497def lmt_connection expr t =
498 -- t
499enddef ;
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
566
567
568
569
570
571
572
573
574
575
576presetparameters "function" [
577 sx = 1mm,
578 sy = 1mm,
579 offset = 0,
580 xmin = 1,
581 xmax = 1,
582 xstep = 1,
583 xsmall = 0,
584 xlarge = 0,
585 xlabels = "no",
586 xticks = "bottom",
587 xcaption = "",
588 ymin = 1,
589 ymax = 1,
590 ystep = 1,
591 ysmall = 0,
592 ylarge = 0,
593
594
595
596
597 ylabels = "no",
598 yticks = "left",
599 ycaption = "",
600 code = "",
601 close = false,
602 shape = "curve",
603 fillcolor = "",
604 drawsize = 1,
605 drawcolor = "",
606 frame = "",
607 linewidth = .05mm,
608 pointsymbol = "",
609 pointsize = 2,
610 pointcolor = "",
611 xarrow = "",
612 yarrow = "",
613 reverse = false,
614
615 axis = "both",
616] ;
617
618def lmt_function = applyparameters "function" "lmt_do_function" enddef ;
619
620vardef lmt_do_function_p(expr xmin, xmax, xstep, code, shape, close, fcolor, dsize, dcolor, psymbol, psize, pcolor) =
621 save p, q ; path p, q ;
622 p := lua.mp.lmt_function_x(xmin,xmax,xstep,code,shape) ;
623 if close :
624 q := (xmin,0) -- p -- (xmax,0) -- cycle ;
625 fill q withcolor fcolor ;
626 else :
627 draw p withpen currentpen scaled dsize withcolor dcolor ;
628 fi ;
629 if psize > 0 :
630 if psymbol = "dot" :
631 draw image (
632 for i = 0 upto length(p) :
633 draw point i of p ;
634 endfor ;
635 ) withpen currentpen scaled psize withcolor pcolor ;
636 fi ;
637 fi ;
638enddef ;
639
640vardef lmt_do_function =
641 image (
642 pushparameters "function" ;
643 save sx, sy, lw, tl, tr, ts, tt, currentpen ; transform tr, tt ; pen currentpen ;
644 sx := getparameter "sx" ;
645 sy := getparameter "sy" ;
646 lw := getparameter "linewidth" ;
647 tl := 120 ;
648 ts := 110 ;
649 tr := identity xyscaled(10sx,10sy) ;
650 tt := identity xyscaled(tssx,tssy) ;
651 pickup pencircle xyscaled(lwsx,lwsy) ;
652 draw image (
653 save xmin, xmax, xstep, xsmall, xlarge, ymin, ymax, ystep, ysmall, ylarge, p ;
654 save code, option, txl, txs, tyl, tys, swap, axis ;
655 string code, option, shape, axis ;
656 path txl, txs, tyl, tys ; boolean swap, close ;
657 picture p ;
658
659 xmin := getparameter "xmin" ;
660 xmax := getparameter "xmax" ;
661 xstep := getparameter "xstep" ;
662 xsmall := getparameter "xsmall" ;
663 xlarge := getparameter "xlarge" ;
664 ymin := getparameter "ymin" ;
665 ymax := getparameter "ymax" ;
666 ystep := getparameter "ystep" ;
667 ysmall := getparameter "ysmall" ;
668 ylarge := getparameter "ylarge" ;
669 code := getparameter "code" ;
670 swap := getparameter "reverse" ;
671 shape := getparameter "shape" ;
672 close := getparameter "close" ;
673 axis := getparameter "axis" ;
674 p := image (
675 if (getparametercount "functions") > 0 :
676 for s = 1 upto getparametercount "functions" :
677
678 pushparameters "functions" [s] ;
679 lmt_do_function_p (
680 (getparameterdefault "xmin" xmin),
681 (getparameterdefault "xmax" xmax),
682 (getparameterdefault "xstep" xstep),
683 (getparameterdefault "code" code),
684 (getparameterdefault "shape" shape),
685 (getparameterdefault "close" close),
686 (getparameterdefault "fillcolor" (getparameter "fillcolor")),
687 (getparameterdefault "drawsize" (getparameter "drawsize")),
688 (getparameterdefault "drawcolor" (getparameter "drawcolor")),
689 (getparameterdefault "pointsymbol" (getparameter "pointsymbol")),
690 (getparameterdefault "pointsize" (getparameter "pointsize")),
691 (getparameterdefault "pointcolor" (getparameter "pointcolor"))
692 ) ;
693 popparameters ;
694 endfor ;
695 elseif code <> "" :
696 lmt_do_function_p (
697 xmin,
698 xmax,
699 xstep,
700 code,
701 shape,
702 close,
703 getparameter "fillcolor",
704 getparameter "drawsize",
705 getparameter "drawcolor",
706 getparameter "pointsymbol",
707 getparameter "pointsize",
708 getparameter "pointcolor"
709 ) ;
710 fi ;
711 ) ;
712
713 if not swap : draw p fi ;
714
715if (axis = "") or (axis = "no") :
716
717else :
718
719
720
721 option := getparameter "xticks" ;
722 if option = "top" :
723 txs := (0,0) -- (0,tl) ;
724 elseif option = "bottom" :
725 txs := (0,tl) -- (0,0) ;
726 else :
727 txs := (0,tl) -- (0,tl) ;
728 fi ;
729
730 option := getparameter "yticks" ;
731 if option = "left" :
732 tys := (tl,0) -- (0,0) ;
733 elseif option = "right" :
734 tys := (0,0) -- (tl,0) ;
735 else :
736 tys := (tl,0) -- (tl,0) ;
737 fi ;
738
739 txs := txs transformed tr ;
740 tys := tys transformed tr ;
741 txl := txs scaled 2 ;
742 tyl := tys scaled 2 ;
743
744
745
746 xmin := getparameterdefault "xfirst" xmin ;
747 xmax := getparameterdefault "xlast" xmax ;
748 ymin := getparameterdefault "yfirst" ymin ;
749 ymax := getparameterdefault "ylast" ymax ;
750
751 if hasoption "frame" "ticks,sticks" :
752 if xsmall > 0 :
753 if hasoption "frame" "horizontal" :
754 for i = ymin step ((ymaxymin)ysmall) until ymax :
755 draw (xmin,i) -- (xmax,i) ;
756 endfor ;
757 dodraw (xmin,ymin) ;
758 fi ;
759 fi ;
760 if ysmall > 0 :
761 if hasoption "frame" "vertical" :
762 for i = xmin step ((xmaxxmin)xsmall) until xmax :
763 draw (i,ymin) -- (i,ymax) ;
764 endfor ;
765 dodraw (xmin,ymin) ;
766 fi ;
767 fi ;
768 fi ;
769
770 option := getparameter "xarrow" ;
771 if option = "yes" :
772 save ahlength ; ahlength := tl ;
773
774 drawarrow (xmin,0) -- (xmax,0) ;
775 else :
776 draw (xmin,0) -- (xmax,0) ;
777 fi ;
778
779 option := getparameter "yarrow" ;
780 if option = "yes" :
781 save ahlength ; ahlength := tl ;
782
783 drawarrow (xmin,ymin) -- (xmin,ymax) ;
784 else :
785 draw (xmin,ymin) -- (xmin,ymax) ;
786 fi ;
787
788 if hasoption "frame" "yes" :
789 draw (xmin,ymin) -- (xmax,ymin) -- (xmax,ymax) -- (xmin,ymax) -- cycle ;
790 fi ;
791
792 if hasoption "frame" "ticks,sticks" :
793 if xsmall > 0 :
794 if hasoption "frame" "horizontal" :
795 for i = ymin step ((ymaxymin)ysmall) until ymax :
796 draw (xmin,i) -- (xmax,i) ;
797 endfor ;
798 fi ;
799 if hasoption "frame" "bottom" :
800 txs := ((0,0) -- (0,tl)) if hasoption "frame" "sticks" : rotated 180 fi ;
801 txs := txs transformed tr ;
802 for i = xmin step ((xmaxxmin)xsmall) until xmax :
803 nodraw txs shifted (i,ymin) ;
804 endfor ;
805 fi ;
806 if hasoption "frame" "top" :
807 txs := (0,0) -- (0,tl) if hasoption "frame" "sticks" : rotated 180 fi ;
808 txs := txs transformed tr ;
809 for i = xmin step ((xmaxxmin)xsmall) until xmax :
810 nodraw txs shifted (i,ymax) ;
811 endfor ;
812 fi ;
813 dodraw (xmin,ymin) ;
814 fi ;
815 if ysmall > 0 :
816 if hasoption "frame" "vertical" :
817 for i = xmin step ((xmaxxmin)xsmall) until xmax :
818 draw (i,ymin) -- (i,ymax) ;
819 endfor ;
820 fi ;
821 if hasoption "frame" "left" :
822 tys := (0,0) -- (tl,0) if hasoption "frame" "sticks" : rotated 180 fi ;
823 tys := tys transformed tr ;
824 for i = ymin step ((ymaxymin)ysmall) until ymax :
825 nodraw tys shifted (xmin,i) ;
826 endfor ;
827 fi ;
828 if hasoption "frame" "right" :
829 tys := (0,0) -- (tl,0) if hasoption "frame" "sticks" : rotated 180 fi ;
830 tys := tys transformed tr ;
831 for i = ymin step ((ymaxymin)ysmall) until ymax :
832 nodraw tys shifted (xmax,i) ;
833 endfor ;
834 fi ;
835 dodraw (xmin,ymin) ;
836 fi ;
837 fi ;
838
839 if xsmall > 0 :
840 for i = xmin step xsmall until xmax :
841 nodraw txs shifted (i,0) ;
842 endfor ;
843 fi ;
844
845 if xlarge > 0 :
846 for i = xmin step xlarge until xmax :
847 nodraw txl shifted (i,0) ;
848 endfor ;
849 dodraw (xmin,0) ;
850 elseif xsmall > 0 :
851 dodraw (xmin,0) ;
852 fi ;
853
854 if ysmall > 0 :
855 for i = ymin step ysmall until ymax :
856 nodraw tys shifted (xmin,i) ;
857 endfor ;
858 fi ;
859
860 if ylarge > 0 :
861 for i = ymin step ylarge until ymax :
862 nodraw tyl shifted (xmin,i) ;
863 endfor ;
864 dodraw (xmin,ymin) ;
865 elseif ysmall > 0 :
866 dodraw (xmin,ymin) ;
867 fi ;
868
869 if swap : draw p fi ;
870
871 if xlarge > 0 :
872 option := getparameter "xlabels" ;
873 if option <> "no" :
874 for i = xmin step xlarge until xmax :
875 if ((i <> 0) and ((option <> "nolimits") or ((i > xmin) and (i < xmax)))) :
876 draw textext.bot(decimal i) transformed tt
877 shifted (i,1.25(ypart point 0 of txl)) ;
878 fi ;
879 endfor ;
880 fi ;
881 fi ;
882
883 if ylarge > 0 :
884 option := getparameter "ylabels" ;
885 if option <> "no" :
886 for i = ymin step ylarge until ymax :
887 if ((i <> 0) and ((option <> "nolimits") or ((i > ymin) and (i < ymax)))) :
888 draw textext.lft(decimal i) transformed tt
889 shifted (xmin+1.25(xpart point 0 of tyl),i) ;
890 fi ;
891 endfor ;
892 fi ;
893 fi ;
894
895 option := getparameter "xcaption" ;
896 if (option <> "") :
897 draw textext.bot(option) transformed tt
898 shifted (xmin,tl)
899 shifted center bottomboundary currentpicture ;
900 fi ;
901
902 option := getparameter "ycaption" ;
903 if (option <> "") :
904 draw textext.lft(option) transformed tt
905 shifted (xmintl,0)
906 shifted center leftboundary currentpicture ;
907 fi ;
908
909fi ;
910 )
911
912 xyscaled(sx,sy) ;
913
914 setbounds currentpicture to
915 boundingbox currentpicture
916 enlarged (getparameter "offset") ;
917
918 popparameters ;
919 )
920enddef ;
921
922
923
924presetparameters "mesh" [
925 trace = false,
926 auto = false,
927 step = 0.05,
928
929
930] ;
931
932def lmt_mesh = applyparameters "mesh" "lmt_do_mesh" enddef ;
933
934vardef lmt_do_mesh =
935 image (
936 save p, b ; path p, b ;
937 pushparameters "mesh" ;
938 if getparameter "auto" :
939 b := if hasparameter "box" : getparameter "box" else : OverlayBox fi ;
940 for i=1 upto getparametercount "paths" :
941 p := getparameter "paths" i ;
942 p := meshed(p if not cycle p : -- cycle fi,b,getparameter "step") ;
943 if getparameter "trace" :
944 draw p ;
945 fi ;
946 runscript("mp.lmt_mesh_update()") i p ;
947 endfor ;
948 elseif getparameter "trace" :
949 for i=1 upto getparametercount "paths" :
950 p := getparameter "paths" i ;
951 draw p if not cycle p : -- cycle fi ;
952 endfor ;
953 fi ;
954 popparameters ;
955 runscript("mp.lmt_mesh_set()") ;
956 )
957enddef ;
958
959vardef mfun_meshed_clipped(expr pat, box, pct) =
960 pp := point (arctime pct of pat) of pat ;
961 if (ypart pp <= lly) or (ypart pp >= ury) or (xpart pp <= llx) or (xpart pp >= urx) :
962 (cp -- pp) intersection_point bb
963 else :
964 pp
965 fi
966enddef ;
967
968vardef mfun_meshed_clipped(expr pat, box, pct) =
969 pp := point (arctime pct of pat) of pat ;
970 if ypart pp <= lly :
971 if xpart pp <= llx :
972 (llx, lly)
973 elseif xpart pp >= urx :
974 (urx, lly)
975 else :
976 (xpart pp, lly)
977 fi
978 elseif ypart pp >= ury :
979 if xpart pp <= llx :
980 (llx, ury)
981 elseif xpart pp >= urx :
982 (urx, ury)
983 else :
984 (xpart pp, ury)
985 fi
986 elseif xpart pp <= llx :
987 (llx, ypart pp)
988 elseif xpart pp >= urx :
989 (urx, ypart pp)
990 else :
991 pp
992 fi
993enddef ;
994
995vardef meshed(expr pth, box, stp) =
996 begingroup
997 save cb, cp, llx, lly, urx, ury, pp, lp, bb ; pair cb, cp, pp ; path bb ;
998 bb := box enlarged -110;
999 cb := center bb ;
1000 cp := center pth ;
1001 llx := xpart llcorner bb;
1002 lly := ypart llcorner bb;
1003 urx := xpart urcorner bb;
1004 ury := ypart urcorner bb;
1005 lp := arclength pth ;
1006 for i=stp step stp until 1stp2 :
1007 cp --
1008 mfun_meshed_clipped(pth,bb,lp(istp)) --
1009 mfun_meshed_clipped(pth,bb,lp(i )) --
1010 cp --
1011 endfor cycle
1012 endgroup
1013enddef ;
1014
1015vardef OverlayMesh(expr p, s) =
1016 lmt_mesh [ paths = { meshed(p,OverlayBox,s) } ]
1017enddef ;
1018
1019permanent meshed, OverlayMesh ;
1020
1021
1022
1023presetparameters "chart" [
1024 originsize = 1mm,
1025 trace = false,
1026 showlabels = true,
1027 showlegend = true,
1028 showvalues = false,
1029 showaxis = false,
1030 center = false,
1031
1032 samples = { },
1033
1034 cumulative = false,
1035 percentage = false,
1036 maximum = 0,
1037 distance = 1mm,
1038 threshold = eps,
1039
1040
1041 labelstyle = "",
1042 labelformat = "",
1043
1044
1045
1046 labelfraction = 0.8,
1047 labelcolor = "",
1048
1049 axisstyle = "",
1050 axiscolor = "",
1051 axisformat = "",
1052 axislinewidth = mm5,
1053 axislinecolor = "",
1054
1055 valuestyle = "",
1056 valuecolor = "",
1057 valueformat = "",
1058
1059 backgroundcolor = "",
1060 drawcolor = "white",
1061 fillcolors = {
1062 "darkred", "darkgreen", "darkblue",
1063 "darkyellow", "darkmagenta", "darkcyan",
1064 "darkgray"
1065 },
1066 linecolors = { },
1067 colormode = "global",
1068
1069 linewidth = .25mm,
1070
1071
1072 legendcolor = "",
1073 legendstyle = "",
1074 legend = { },
1075] ;
1076
1077presetparameters "chart:circle" "chart" [
1078 height = 5cm,
1079 width = 5mm,
1080 innerradius = 0,
1081 initialangle = 0,
1082 labelanchor = "",
1083 labeloffset = 0,
1084 labelstrut = "no",
1085] ;
1086
1087presetparameters "chart:histogram" "chart" [
1088 height = 5cm,
1089 width = 5mm,
1090 labelanchor = "bot",
1091 labeloffset = 1mm,
1092 labelstrut = "auto",
1093] ;
1094
1095presetparameters "chart:bar" "chart" [
1096 height = 5mm,
1097 width = 5cm,
1098 labelanchor = "lft",
1099 labeloffset = 1mm,
1100 labelstrut = "no",
1101] ;
1102
1103def lmt_chart_circle = applyparameters "chart:circle" "lmt_do_chart_circle" enddef ;
1104def lmt_chart_histogram = applyparameters "chart:histogram" "lmt_do_chart_histogram" enddef ;
1105def lmt_chart_bar = applyparameters "chart:bar" "lmt_do_chart_bar" enddef ;
1106
1107def lmt_do_chart_start (expr what) =
1108 pushparameters what ;
1109 save width, height, depth, distance,
1110 threshold,
1111 linewidth, linegap,
1112 value, nofsamples, nofsamplesets,
1113 fillcolor, linecolor, drawcolor,
1114 labelcolor, labelstyle, labelformat, labelgap, labelfraction, labelstrut, labelanchor,
1115 axiscolor, axisstyle, axisformat, axisgap, axislinewidth, axislinecolor,
1116 valuecolor, valuestyle, valueformat, valuegap,
1117 colormode ;
1118 string fillcolor, linecolor, drawcolor,
1119 labelcolor, labelstyle, labelformat, labelstrut, labelanchor,
1120 axiscolor, axisstyle, axisformat, axislinecolor,
1121 valuecolor, valuestyle, valueformat,
1122 colormode ;
1123 if hasparameter "sampleset" :
1124 setluaparameter what "samples" (getparameter "sampleset") ;
1125 fi ;
1126
1127 threshold := getparameter "threshold" ;
1128 colormode := getparameter "colormode" ;
1129
1130 linewidth := getparameter "linewidth" ;
1131 linegap := getparameterdefault "linegap" linewidth ;
1132
1133 height := getparameter "height" ;
1134 depth := max(getparameter "originsize", (getparameter "innerradius"), 8linewidth) ;
1135 width := getparameter "width" ;
1136 distance := getparameter "distance" ;
1137
1138 drawcolor := getparameter "drawcolor" ;
1139
1140 labelcolor := getparameter "labelcolor" ;
1141 labelstyle := getparameter "labelstyle" ;
1142 labelformat := getparameter "labelformat" ;
1143 labelgap := getparameter "labeloffset" ;
1144 labelstrut := getparameter "labelstrut" ;
1145 labelanchor := getparameter "labelanchor" ;
1146 labelfraction := getparameter "labelfraction" ;
1147
1148 axiscolor := getparameter "axiscolor" ;
1149 axisstyle := getparameter "axisstyle" ;
1150 axisformat := getparameter "axisformat" ;
1151 axisgap := getparameter "axisoffset" ;
1152 axislinewidth := getparameter "axislinewidth" ;
1153 axislinecolor := getparameter "axislinecolor" ;
1154
1155 valuecolor := getparameter "valuecolor" ;
1156 valuestyle := getparameter "valuestyle" ;
1157 valueformat := getparameter "valueformat" ;
1158 valuegap := getparameter "valueoffset" ;
1159
1160 nofsamplesets := getparametercount "samples" ;
1161 nofsamples := getmaxparametercount "samples" ;
1162enddef ;
1163
1164def lmt_do_chart_stop =
1165 if getparameter "center" :
1166 currentpicture := currentpicture shifted center currentpicture ;
1167 fi
1168 if (getparameter "backgroundcolor") <> "" :
1169 addbackground withcolor getparameter "backgroundcolor" ;
1170 fi
1171 if getparameter "trace" :
1172 save b ; path b ; b := boundingbox currentpicture ;
1173 draw image (
1174 draw fullcircle scaled 1mm ;
1175 draw b
1176 )
1177 dashed evenly scaled 14
1178 withpen pencircle scaled .125mm
1179 withcolor "darkgray" ;
1180 fi
1181 popparameters ;
1182enddef ;
1183
1184vardef lmt_do_chart_text(expr s, i, value) =
1185 lmt_text [
1186 style = labelstyle,
1187 format = labelformat,
1188 strut = labelstrut,
1189 anchor = labelanchor,
1190 offset = labelgap,
1191 color = labelcolor,
1192 text = (getparameterdefault "labels" s i (decimal value))
1193 background = "",
1194 ]
1195enddef ;
1196
1197def lmt_do_chart_legend =
1198 if getparameter "showlegend" :
1199 n := getparametercount "legend" ;
1200 if n > 0 :
1201 save dx, dy, p, l, w, o, d, ddy ; picture l ;
1202 dx := xpart urcorner currentpicture EmWidth ;
1203 dy := ypart urcorner currentpicture ;
1204 labelcolor := getparameter "legendcolor" ;
1205 labelstyle := getparameter "legendstyle" ;
1206 w := 2EmWidth ;
1207 o := .25EmWidth ;
1208 d := ExHeight ;
1209 ddy := .8LineHeight ;
1210 for i=1 upto n :
1211 dy := dy ddy ;
1212 l := lmt_text [
1213 text = getparameter "legend" i,
1214 anchor = "rt"
1215 style = labelstyle,
1216 color = labelcolor,
1217 background = "",
1218 ] ;
1219 fill leftboundary l rightenlarged w
1220 shifted (dx,dyd)
1221 withcolor getparameter "fillcolors" i ;
1222 draw l
1223 shifted (dxwo,dyd) ;
1224 endfor ;
1225 fi ;
1226 fi ;
1227enddef ;
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244vardef lmt_do_chart_circle =
1245 image (
1246 lmt_do_chart_start("chart:circle") ;
1247 if (nofsamplesets > 0) and (nofsamples > 0) :
1248 nofsamplesets := 1 ;
1249 save p, q, r, s, t, pl, ql, first, last, total, factor, n, percentage, initial, clockwise ;
1250 path p, q, r, s[], t[] ; boolean percentage, clockwise ;
1251 save value, v;
1252 clockwise := true ;
1253 percentage := getparameter "percentage" ;
1254 initial := if not clockwise : fi getparameter "initialangle" ;
1255 total := 0 ;
1256 for i = 1 upto nofsamples :
1257 value := getparameter "samples" (1) i ;
1258 if value > threshold :
1259 total := total value ;
1260 fi ;
1261 endfor ;
1262 if total = 0 :
1263 message("zero total in circular chart");
1264 else :
1265 factor := 100total ;
1266 first := initial ;
1267 if clockwise :
1268 p := (reverse fullcircle rotated first) ysized (height) ;
1269 q := (reverse fullcircle rotated first) ysized (depth) ;
1270 else :
1271 p := fullcircle ysized (height) ;
1272 q := fullcircle ysized (depth) ;
1273 fi ;
1274 r := origin -- (2height,0) ;
1275 pl := ((linewidth linegap) (arclength p)) 360;
1276 ql := ((linewidth linegap) (arclength q)) 360;
1277 v := 0 ;
1278 for i = 1 upto nofsamples :
1279 value := getparameter "samples" (1) i ;
1280 if value > threshold :
1281 v := v 1 ;
1282 fillcolor := getparameter "fillcolors" i ;
1283 linecolor := getparameterdefault "linecolors" i "" ;
1284 if linecolor = "" :
1285 linecolor := fillcolor ;
1286 fi ;
1287 value := value factor ;
1288 last := first if clockwise : else : fi (360100) value ;
1289 s[v] := ((p cutbefore (r rotated first)) cutafter (r rotated (last pl))) ;
1290 t[v] := reverse ((q cutbefore (r rotated first)) cutafter (r rotated (last ql))) ;
1291 path piece ; piece := s[v] -- t[v] -- cycle ;
1292 if fillcolor <> "" :
1293 fill piece
1294 withpen pencircle scaled linewidth
1295 withcolor fillcolor
1296 ;
1297 fi ;
1298 if linecolor <> "" :
1299 if linewidth > 0 :
1300 interim linecap := butt ;
1301 draw piece
1302 withpen pencircle scaled linewidth
1303 withcolor if linecolor <> "" : linecolor else drawcolor : fi
1304 ;
1305 fi ;
1306 fi ;
1307 first := last ;
1308 fi ;
1309 endfor ;
1310 if linewidth > 0 :
1311 clip currentpicture to p enlarged linewidth ;
1312 fi ;
1313 if getparameter "showlabels" :
1314 first := initial ;
1315 v := 0 ;
1316 for i = 1 upto nofsamples :
1317 value := getparameter "samples" (1) i ;
1318 if value > threshold :
1319 v := v 1 ;
1320 last := first if clockwise : else : fi (360100) value factor ;
1321 draw lmt_do_chart_text (s,i,value)
1322 shifted ((labelfraction(height2),0) rotated ((firstlast)2)) ;
1323 first := last ;
1324 fi
1325 endfor ;
1326 fi ;
1327 lmt_do_chart_legend ;
1328 fi ;
1329 fi ;
1330 lmt_do_chart_stop ;
1331 )
1332enddef ;
1333
1334vardef lmt_do_chart_histogram =
1335 image (
1336 lmt_do_chart_start("chart:histogram") ;
1337 if (nofsamplesets > 0) and (nofsamples > 0) :
1338 save value, maximum, cumulative, maxwidth ; boolean cumulative ;
1339 maximum := getparameter "maximum" ;
1340 cumulative := getparameter "cumulative" ;
1341 if labelanchor = "center" :
1342 labelanchor := "vcenter" ;
1343 fi ;
1344 if maximum = 0 :
1345 for s = 1 upto nofsamplesets :
1346 for i = 1 upto nofsamples :
1347 value := getparameter "samples" s i ;
1348 maximum := if cumulative :
1349 maximum value ;
1350 else :
1351 max(maximum,value) ;
1352 fi ;
1353 endfor ;
1354 endfor ;
1355 fi ;
1356 if nofsamplesets = 1 :
1357 distance := 0 ;
1358 fi ;
1359 maxwidth := nofsamplesets nofsamples width (nofsamples 1) distance ;
1360 value := 0 ;
1361 for s = 1 upto nofsamplesets :
1362 for i = 1 upto nofsamples :
1363 value := if cumulative : value fi (getparameter "samples" s i) height maximum ;
1364 fill unitsquare xyscaled (width,value)
1365 if linewidth > 0 :
1366 if i > 1 : leftenlarged (linewidth2) fi
1367 if i < nofsamples : rightenlarged (linewidth2) fi
1368 fi
1369 shifted (nofsamplesets(i-1)width(s-1)width(i-1)distance,0)
1370 withcolor getparameter "fillcolors" if colormode = "local" : s else : i fi ;
1371 endfor ;
1372 endfor ;
1373 setbounds currentpicture to unitsquare xyscaled (maxwidth,height) ;
1374 if getparameter "showlabels" :
1375 for s = 1 upto nofsamplesets :
1376 for i = 1 upto nofsamples :
1377 draw lmt_do_chart_text (s,i,getparameter "samples" s i)
1378 shifted (nofsamplesets((i-1)width)width2(s-1)width(i-1)distance,0) ;
1379 endfor ;
1380 endfor ;
1381 fi ;
1382 lmt_do_chart_legend ;
1383 fi ;
1384 lmt_do_chart_stop ;
1385 )
1386enddef ;
1387
1388vardef lmt_do_chart_bar =
1389
1390 image (
1391 lmt_do_chart_start("chart:bar") ;
1392 if (nofsamplesets > 0) and (nofsamples > 0) :
1393 save value, maximum, cumulative, maxheight ; boolean cumulative ;
1394 maximum := getparameter "maximum" ;
1395 cumulative := getparameter "cumulative" ;
1396 if labelanchor = "center" :
1397 labelanchor := "hcenter" ;
1398 fi ;
1399 if maximum = 0 :
1400 for s = 1 upto nofsamplesets :
1401 for i = 1 upto nofsamples :
1402 value := getparameter "samples" s i ;
1403 maximum := if cumulative : maximum value else : max(maximum,value) fi ;
1404 endfor ;
1405 endfor ;
1406 fi ;
1407 if nofsamplesets = 1 :
1408 distance := 0 ;
1409 fi ;
1410 maxheight := nofsamplesets nofsamples height (nofsamples 1) distance ;
1411 for s = 1 upto nofsamplesets :
1412 value := 0 ;
1413 for i = 1 upto nofsamples :
1414 value := if cumulative : value fi (getparameter "samples" s i) width maximum ;
1415 fill unitsquare xyscaled (value,height)
1416 if linewidth > 0 :
1417 if i > 1 : topenlarged (linewidth2) fi
1418 if i < nofsamples : bottomenlarged (linewidth2) fi
1419 fi
1420 shifted (0,maxheightnofsamplesetsiheight(s-1)height(i-1)distance)
1421 withcolor getparameter "fillcolors" if colormode = "local" : s else : i fi ;
1422 endfor ;
1423 endfor ;
1424 setbounds currentpicture to unitsquare xyscaled (width,maxheight) ;
1425 if getparameter "showlabels" :
1426 for s = 1 upto nofsamplesets :
1427 for i = 1 upto nofsamples :
1428 draw lmt_do_chart_text (s,i,getparameter "samples" s i)
1429 shifted (0,maxheightnofsamplesets(iheight)height2(s-1)height(i-1)distance) ;
1430 endfor ;
1431 endfor ;
1432 fi ;
1433 lmt_do_chart_legend ;
1434 fi ;
1435 lmt_do_chart_stop ;
1436 )
1437enddef ;
1438
1439
1440
1441
1442presetparameters "shade" [
1443 alternative = "circular",
1444 path = origin -- cycle,
1445 trace = false
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457] ;
1458
1459
1460
1461def lmt_shade = applyparameters "shade" "lmt_do_shade" enddef ;
1462
1463vardef lmt_do_shade =
1464 image (
1465 pushparameters "shade" ;
1466
1467 save domain_min, domain_max, radius_a, radius_b, factor ;
1468 save color_a, color_b, center_a, center_b, alternative, s ;
1469 string color_a, color_b, alternative, s ; pair center_a, center_b ;
1470
1471 alternative := getparameter "alternative" ;
1472
1473 mfun_with_shade_method_analyze(getparameter "path") ;
1474
1475 domain_min := 0 ;
1476 domain_max := 1 ;
1477
1478 color_a := "white" ;
1479 color_b := "black" ;
1480
1481 if alternative = "circular" :
1482 center_a := center mfun_shade_path ;
1483 center_b := center_a ;
1484 radius_a := 0 ;
1485 radius_b := mfun_max_radius(mfun_shade_path) ;
1486 factor := 1.2 ;
1487 else :
1488 center_a := llcorner mfun_shade_path ;
1489 center_b := urcorner mfun_shade_path ;
1490 radius_a := 0 ;
1491 radius_b := 0 ;
1492 factor := 0;
1493 fi ;
1494
1495 if hasparameter "domain" :
1496 domain_min := getparameter "domain" 1 ;
1497 domain_max := getparameter "domain" 2 ;
1498 fi
1499 if hasparameter "radius" :
1500 if numeric getparameter "radius" :
1501 radius_a := 0 ;
1502 radius_b := getparameter "radius" ;
1503 else :
1504 radius_a := getparameter "radius" 1 ;
1505 radius_b := getparameter "radius" 2 ;
1506 fi ;
1507 factor := 1 ;
1508 fi
1509 if hasparameter "factor" :
1510 factor := getparameter "factor" ;
1511 fi
1512 if hasparameter "origin" :
1513 if pair getparameter "origin" :
1514 center_a := getparameter "origin" ;
1515 center_b := center_b ;
1516 else :
1517 center_a := getparameter "origin" 1 ;
1518 center_b := getparameter "origin" 2 ;
1519 fi ;
1520 fi
1521 if hasparameter "colors" :
1522 color_a := getparameter "colors" 1 ;
1523 color_b := getparameter "colors" 2 ;
1524 fi
1525 if hasparameter "direction" :
1526 save a, b, bb, temp_x, temp_y ; path bb ;
1527 temp_x := temp_y := 0 ;
1528 bb := boundingbox(mfun_shade_path) ;
1529 a := b := -1 ;
1530 if string getparameter "direction" :
1531 s := getparameter "direction" ;
1532 if s = "up" :
1533 temp_x := xpart shadedup ;
1534 temp_y := ypart shadedup ;
1535 elseif s = "down" :
1536 temp_x := xpart shadeddown ;
1537 temp_y := ypart shadeddown ;
1538 elseif s = "left" :
1539 temp_x := xpart shadedleft ;
1540 temp_y := ypart shadedleft ;
1541 elseif s = "right" :
1542 temp_x := xpart shadedright ;
1543 temp_y := ypart shadedright ;
1544 fi
1545 else :
1546 temp_x := getparameter "direction" 1 ;
1547 temp_y := getparameter "direction" 2 ;
1548 fi
1549 if temp_x >= 0 :
1550 center_a := point temp_x of bb ;
1551 fi
1552 if temp_y >= 0 :
1553 center_b := point temp_y of bb ;
1554 fi
1555 fi ;
1556 if hasparameter "center" :
1557 save cx, cy ;
1558 if numeric getparameter "center" :
1559 cx := getparameter "center" ;
1560 cx := cy ;
1561
1562
1563
1564 else :
1565 cx := getparameter "center" 1 ;
1566 cy := getparameter "center" 2 ;
1567 fi
1568 center_a := center mfun_shade_path shifted (
1569 cx bbwidth (mfun_shade_path)2,
1570 cy bbheight(mfun_shade_path)2
1571 ) ;
1572 elseif hasparameter "vector" :
1573 center_a := point (getparameter "vector" 1) of mfun_shade_path ;
1574 center_b := point (getparameter "vector" 2) of mfun_shade_path ;
1575 fi
1576 fill mfun_shade_path
1577 withprescript "sh_domain=" & decimal domain_min & " " & decimal domain_max
1578 withprescript "sh_transform=yes"
1579 withprescript "sh_color=into"
1580 withprescript "sh_color_a=" & colordecimals color_a
1581 withprescript "sh_color_b=" & colordecimals color_b
1582 withprescript "sh_first=" & ddecimal point 0 of mfun_shade_path
1583 withprescript "sh_set_x=" & ddecimal (mfun_shade_nx,mfun_shade_lx)
1584 withprescript "sh_set_y=" & ddecimal (mfun_shade_ny,mfun_shade_ly)
1585 if alternative = "linear" :
1586 withprescript "sh_type=linear"
1587
1588 withprescript "sh_factor=" & decimal factor
1589 withprescript "sh_center_a=" & ddecimal center_a
1590 withprescript "sh_center_b=" & ddecimal center_b
1591 else :
1592 withprescript "sh_type=circular"
1593
1594 withprescript "sh_factor=" & decimal factor
1595 withprescript "sh_center_a=" & ddecimal center_a
1596 withprescript "sh_center_b=" & ddecimal center_b
1597 withprescript "sh_radius_a=" & decimal radius_a
1598 withprescript "sh_radius_b=" & decimal radius_b
1599 fi ;
1600 if getparameter "trace" :
1601 draw fullcircle scaled 1mm shifted center_a ;
1602 draw fullsquare scaled 2mm shifted center_b ;
1603 draw textext.top("\strut\ttx center a") ysized LineHeight shifted center_a shifted (0, 2mm) ;
1604 draw textext.bot("\strut\ttx center b") ysized LineHeight shifted center_b shifted (0,-2mm) ;
1605 if alternative = "circular" :
1606
1607
1608 draw fullcircle scaled ( radius_a) shifted center_a dashed evenly ;
1609 draw fullcircle scaled (factor radius_b) shifted center_b dashed evenly ;
1610 fi
1611 fi
1612 popparameters ;
1613 )
1614enddef ;
1615
1616
1617
1618
1619presetparameters "contour" [
1620 xmin = 0,
1621 xmax = 0,
1622 ymin = 0,
1623 ymax = 0,
1624 xstep = 0,
1625 ystep = 0,
1626 levels = 10,
1627
1628 preamble = "",
1629 function = "x + y",
1630 color = "lin(l)",
1631 background = "bitmap",
1632 foreground = "auto",
1633 linewidth = .25,
1634 backgroundcolor = "black",
1635 linecolor = "gray",
1636 xformat = "@0.2N",
1637 yformat = "@0.2N",
1638 zformat = "@0.2N",
1639 xstyle = "",
1640 ystyle = "",
1641 zstyle = "",
1642
1643 width = 0,
1644 height = 0,
1645
1646 trace = false,
1647 checkresult = false,
1648 defaultnan = 0,
1649 defaultinf = 0,
1650
1651 legend = "all",
1652 legendheight = LineHeight,
1653 legendwidth = LineHeight,
1654 legendgap = 0,
1655 legenddistance = EmWidth,
1656 textdistance = 2EmWidth3,
1657 functiondistance = ExHeight,
1658 functionstyle = "",
1659
1660 level = 4096,
1661
1662 axisdistance = ExHeight,
1663 axislinewidth = .25,
1664 axisoffset = ExHeight4,
1665 axiscolor = "black",
1666 ticklength = ExHeight,
1667
1668 xtick = 5,
1669 ytick = 5,
1670 xlabel = 5,
1671 ylabel = 5,
1672
1673] ;
1674
1675
1676
1677def lmt_contour = applyparameters "contour" "lmt_do_contour" enddef ;
1678
1679def mfun_only_draw = addto currentpicture doublepath enddef ;
1680def mfun_only_fill = addto currentpicture contour enddef ;
1681def mfun_only_fillup text t = addto currentpicture doublepath t withpostscript "both" enddef ;
1682def mfun_only_nodraw text t = addto currentpicture doublepath t withpostscript "collect" enddef ;
1683def mfun_only_nofill text t = addto currentpicture contour t withpostscript "evenodd" enddef ;
1684def mfun_only_eofill text t = addto currentpicture contour t withpostscript "collect" enddef ;
1685
1686def lmt_do_contour_shortcuts =
1687 save D ; let D = mfun_only_draw ;
1688 save E ; let E = mfun_only_eofill ;
1689 save F ; let F = mfun_only_fill ;
1690 save U ; let U = mfun_only_fillup ;
1691 save d ; let d = mfun_only_nodraw ;
1692 save e ; let f = mfun_only_eofill ;
1693 save f ; let f = mfun_only_nofill ;
1694 save C ; let C = cycle ;
1695 save B ; let B = controls ;
1696 save A ; let A = and ;
1697enddef ;
1698
1699def lmt_do_contour_band =
1700 lua.mp.lmt_contours_edge_set_by_band() ;
1701 for v=1 upto lua.mp.lmt_contours_nofvalues() :
1702 draw image (
1703 lua.mp.lmt_contours_edge_get_band(v) ;
1704 )
1705 withcolor lua.mp.lmt_contours_color(v) ;
1706 endfor ;
1707enddef;
1708
1709def lmt_do_contour_cell(expr dx,dy) =
1710 lua.mp.lmt_contours_edge_set_by_cell() ;
1711 draw image (
1712 if level = 4096 :
1713 for v=1+1 upto lua.mp.lmt_contours_nofvalues() :
1714 lua.mp.lmt_contours_edge_get_cell(v) ;
1715 endfor ;
1716 else :
1717 lua.mp.lmt_contours_edge_get_cell(level) ;
1718 fi
1719 )
1720 if (dx <>0) or (dy <> 0) : shifted (dx,dy) fi
1721 withcolor getparameter "linecolor"
1722 withpen pencircle scaled getparameter "linewidth" ;
1723enddef ;
1724
1725def lmt_do_contour_edge(expr dx, dy) =
1726 lua.mp.lmt_contours_edge_set() ;
1727 draw image (
1728 if level = 4096 :
1729 for v=1+1 upto lua.mp.lmt_contours_nofvalues() :
1730 lua.mp.lmt_contours_edge_paths(v);
1731 endfor ;
1732 else :
1733 lua.mp.lmt_contours_edge_paths(level);
1734 fi
1735 )
1736 if (dx <>0) or (dy <> 0) : shifted (dx,dy) fi
1737 withcolor getparameter "linecolor"
1738 withpen pencircle scaled getparameter "linewidth" ;
1739enddef ;
1740
1741def lmt_do_contour_edges(expr dx, dy) =
1742 lua.mp.lmt_contours_edge_set() ;
1743 if level = 4096 :
1744 for v=1+1 upto lua.mp.lmt_contours_nofvalues() :
1745 draw image (
1746 lua.mp.lmt_contours_edge_paths(v);
1747 )
1748 if (dx <>0) or (dy <> 0) : shifted (dx,dy) fi
1749 withpen pencircle scaled getparameter "linewidth"
1750 withcolor lua.mp.lmt_contours_color(v) ;
1751 endfor ;
1752 else :
1753 draw image (
1754 lua.mp.lmt_contours_edge_paths(level);
1755 )
1756 if (dx <>0) or (dy <> 0) : shifted (dx,dy) fi
1757 withpen pencircle scaled getparameter "linewidth"
1758 withcolor lua.mp.lmt_contours_color(level) ;
1759 fi ;
1760enddef ;
1761
1762def lmt_do_contour_cells(expr dx, dy) =
1763 lua.mp.lmt_contours_edge_set_by_cell() ;
1764 if level = 4096 :
1765 for v=1+1 upto lua.mp.lmt_contours_nofvalues() :
1766 draw image (
1767 lua.mp.lmt_contours_edge_get_cell(v) ;
1768 )
1769 if (dx <>0) or (dy <> 0) : shifted (dx,dy) fi
1770 withpen pencircle scaled getparameter "linewidth"
1771 withcolor lua.mp.lmt_contours_color(v) ;
1772 endfor ;
1773 else :
1774 draw image (
1775 lua.mp.lmt_contours_edge_get_cell(level) ;
1776 )
1777 if offset : shifted (-12,-12) fi
1778 withpen pencircle scaled getparameter "linewidth"
1779 withcolor lua.mp.lmt_contours_color(v) ;
1780 fi ;
1781enddef ;
1782
1783def lmt_do_contour_shape(expr dx, dy) =
1784 draw image (
1785 if level = 4096 :
1786 for v=1+1 upto lua.mp.lmt_contours_nofvalues() :
1787 lua.mp.lmt_contours_shape_paths(v);
1788 endfor ;
1789 else :
1790 lua.mp.lmt_contours_shape_paths(level);
1791 lua.mp.lmt_contours_shape_paths(1);
1792 fi
1793 )
1794 if (dx <>0) or (dy <> 0) : shifted (dx,dy) fi
1795 withcolor getparameter "linecolor"
1796 withpen pencircle scaled getparameter "linewidth" ;
1797enddef ;
1798
1799def lmt_do_contour_bitmap =
1800 lua.mp.lmt_contours_bitmap_set() ;
1801 lua.mp.lmt_contours_bitmap_get() ;
1802enddef ;
1803
1804def lmt_do_contour_shades(expr outlines) =
1805 lua.mp.lmt_contours_shade_set(outlines) ;
1806 if level = 4096 :
1807 for v=1 upto lua.mp.lmt_contours_nofvalues() :
1808 draw image (
1809 lua.mp.lmt_contours_shade_paths(v) ;
1810 )
1811 withpen pencircle scaled 0
1812 withcolor lua.mp.lmt_contours_color(v) ;
1813 endfor ;
1814 else :
1815 draw image (
1816 lua.mp.lmt_contours_shade_paths(level);
1817 )
1818 withpen pencircle scaled 0
1819 withcolor lua.mp.lmt_contours_color(level) ;
1820 fi ;
1821enddef ;
1822
1823def lmt_load_mlib_cnt =
1824 runscript("lua.registercode('mlib-cnt')");
1825 extra_beginfig := extra_beginfig &
1826 "runscript(" & ditto & "mp.lmt_contours_cleanup()" & ditto & ")" ;
1827 let lmt_load_mlib_cnt = relax ;
1828enddef ;
1829
1830vardef lmt_do_contour =
1831 image (
1832
1833 lmt_load_mlib_cnt ;
1834
1835 pushparameters "contour" ;
1836
1837 lua.mp.lmt_contours_start() ;
1838
1839
1840
1841 save bg, fg, nx, ny, trace, level, b, done ; string bg, fg ; boolean trace, done ; path b ;
1842
1843 bg := getparameter "background" ;
1844 fg := getparameter "foreground" ;
1845 nx := lua.mp.lmt_contours_nx() ;
1846 ny := lua.mp.lmt_contours_ny() ;
1847 trace := getparameter "trace" ;
1848 level := getparameter "level" ;
1849 done := true ;
1850
1851 begingroup ;
1852
1853 lmt_do_contour_shortcuts ;
1854
1855 if bg = "band" :
1856 lmt_do_contour_band ;
1857 b := boundingbox currentpicture ;
1858 if (fg = "auto") or (fg = "cell") :
1859 lmt_do_contour_cell(0,0) ;
1860 elseif (fg = "edge") :
1861 lmt_do_contour_edge(0,0) ;
1862 fi ;
1863
1864 elseif bg = "bitmap" :
1865
1866 lmt_do_contour_bitmap ;
1867 b := boundingbox currentpicture ;
1868 if (fg = "auto") or (fg = "cell") :
1869 lmt_do_contour_cell(-12,-12) ;
1870 elseif (fg = "edge") :
1871 lmt_do_contour_edge(-12,-12) ;
1872 fi ;
1873
1874 elseif bg = "shape" :
1875
1876 lmt_do_contour_shades((fg = "auto") or (fg = "shape")) ;
1877 b := boundingbox currentpicture ;
1878 if (fg == "auto") or (fg = "shape") :
1879 lmt_do_contour_shape(0,0) ;
1880 elseif fg == "cell" :
1881 lmt_do_contour_cell(-1,-1) ;
1882 elseif fg == "edge" :
1883 lmt_do_contour_edge(-1,-1) ;
1884 fi ;
1885
1886
1887
1888 elseif fg = "cell" :
1889
1890 lmt_do_contour_shortcuts ;
1891 lmt_do_contour_cells(0,0) ;
1892 b := boundingbox currentpicture ;
1893
1894 elseif fg = "edge" :
1895
1896 lmt_do_contour_shortcuts ;
1897 lmt_do_contour_edges(0,0) ;
1898 b := boundingbox currentpicture ;
1899
1900 else :
1901
1902 done := false ;
1903
1904 fi ;
1905
1906 endgroup ;
1907
1908 if done :
1909
1910 save w, h, cx, cy ;
1911
1912 cx := bbwidth (b)(nx 1) ;
1913 cy := bbheight(b)(ny 1) ;
1914 clip currentpicture to b
1915 leftenlarged cx rightenlarged cx
1916 topenlarged cy bottomenlarged cy ;
1917 currentpicture := currentpicture
1918 shifted (cx,cy) ;
1919
1920 w := getparameter "width" ;
1921 h := getparameter "height" ;
1922
1923
1924
1925 save xtic, ytic, auto ; boolean auto ;
1926
1927 xtic := getparameter "xtick" ;
1928 ytic := getparameter "ytick" ;
1929 auto := (w = 0) and (h = 0) ;
1930
1931
1932
1933 if w <> 0 :
1934 if h <> 0 :
1935 currentpicture := currentpicture xysized (w,h) ;
1936 else :
1937 currentpicture := currentpicture xsized w ;
1938 fi ;
1939 elseif h <> 0 :
1940 currentpicture := currentpicture ysized h ;
1941 fi ;
1942 if w = 0 :
1943 w := bbwidth(currentpicture) ;
1944 fi ;
1945 if h = 0 :
1946 h := bbheight(currentpicture) ;
1947 fi ;
1948
1949
1950
1951 if hasoption "legend" "all,x,y,z,range" :
1952
1953 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 ;
1954
1955
1956
1957 if hasoption "legend" "all,z" :
1958
1959
1960
1961 fmt := lua.mp.lmt_contours_format() ;
1962 pmin := lmt_text [ format = fmt, text = decimal lua.mp.lmt_contours_minmean() ] ;
1963 pmax := lmt_text [ format = fmt, text = decimal lua.mp.lmt_contours_maxmean() ] ;
1964 wx := max(bbwidth(pmin),bbwidth(pmax)) ;
1965 hx := bbheight(pmin) ;
1966
1967 else :
1968
1969 hx := 0;
1970
1971 fi ;
1972
1973 if auto :
1974
1975 u := lua.mp.lmt_contours_ny() 100 ;
1976 ry := 4u ;
1977 sy := 5u ;
1978 sx := 5u ;
1979 lg := 0 ;
1980 ox := 5u ;
1981 oy := sy2 ry2 ;
1982 tx := 2u ;
1983 ty := 1u ;
1984 ax := 1u ;
1985 ay := 1u ;
1986 ao := u ;
1987 al := u8 ;
1988 at := 3u2 ;
1989 al := u4 ;
1990 else :
1991 ry := 0 ;
1992 sy := getparameter "legendheight" ;
1993 sx := getparameter "legendwidth" ;
1994 lg := getparameter "legendgap" ;
1995 ox := getparameter "legenddistance" ;
1996 oy := sy2 hx2 ;
1997 tx := getparameter "textdistance" ;
1998 ty := getparameter "functiondistance" ;
1999 ax := getparameter "axisdistance" ;
2000 ay := ax ;
2001 ao := getparameter "axisoffset" ;
2002 at := getparameter "ticklength" ;
2003 al := getparameter "axislinewidth" ;
2004 fi ;
2005
2006 if hasoption "legend" "all,z" :
2007
2008 save dy ; dy := h ;
2009
2010 for v=1 upto lua.mp.lmt_contours_nofvalues() :
2011 dy := dy sy ;
2012 fill unitsquare xyscaled (sx,sy)
2013 shifted (wox,dy)
2014 withcolor lua.mp.lmt_contours_color(v) ;
2015 draw
2016 lmt_text [
2017 trace = trace,
2018 anchor = "llft",
2019 format = fmt,
2020 text = decimal lua.mp.lmt_contours_value(v),
2021 style = getparameter "zstyle",
2022 position = (wx,0),
2023 background = "",
2024 ]
2025 if ry <> 0 : ysized (ry) fi
2026 shifted (woxtxsx,dysyoy)
2027 ;
2028 dy := dy lg ;
2029 endfor ;
2030
2031 fi ;
2032
2033 if hasoption "legend" "x,all" :
2034
2035 save n, d, s, xmin, xmax, xlab ;
2036
2037 xmin := getparameter "xmin" ;
2038 xmax := getparameter "xmax" ;
2039 xlab := getparameter "xlabel" ;
2040
2041 draw image (
2042 interim linecap := butt ;
2043 draw ((0,0) -- (w,0)) ;
2044 n := al2 ; s := (w al) xtic ; d := (xmax xmin) xtic ;
2045 for i=xmin step d until xmax :
2046 draw (n,0) -- (n,at) ;
2047 n := n s ;
2048 endfor ;
2049 ) shifted (0,ay)
2050 withpen pencircle scaled al
2051 withcolor getparameter "axiscolor"
2052 ;
2053
2054 if hasoption "legend" "label,all" :
2055
2056 draw image (
2057 n := al2 ; s := (w al) xlab ; d := (xmax xmin) xlab ;
2058 for i=xmin step d until xmax :
2059 draw lmt_text [
2060 trace = trace,
2061 anchor = "bot",
2062 format = getparameter "xformat",
2063 style = getparameter "xstyle",
2064 text = decimal i
2065 background = "",
2066 ]
2067 if ry <> 0 : ysized (ry) fi
2068 shifted (n,atao)
2069 ;
2070 n := n s ;
2071 endfor ;
2072 ) shifted (0,ay) ;
2073
2074 fi ;
2075
2076 fi ;
2077
2078 if hasoption "legend" "y,all" :
2079
2080 save n, d, s, ymin, ymax, ylab ;
2081
2082 ymin := getparameter "ymin" ;
2083 ymax := getparameter "ymax" ;
2084 ylab := getparameter "ylabel" ;
2085
2086 draw image (
2087 interim linecap := butt ;
2088 draw ((0,0) -- (0,h)) ;
2089 n := al2 ; s := (h al) ytic ; d := (ymax ymin) ytic ;
2090 for i=ymin step d until ymax :
2091 draw (0,n) -- (at,n) ;
2092 n := n s ;
2093 endfor ;
2094 ) shifted (ax,0)
2095 withpen pencircle scaled al
2096 withcolor getparameter "axiscolor" ;
2097 ;
2098
2099 if hasoption "legend" "label,all" :
2100
2101 draw image (
2102 n := al2 ; s := (h al) ylab ; d := (ymax ymin) ylab ;
2103 for i=ymin step d until ymax :
2104 draw lmt_text [
2105 trace = trace,
2106 anchor = "lft",
2107 format = getparameter "yformat",
2108 style = getparameter "ystyle",
2109 text = decimal i
2110 background = "",
2111 ]
2112 if ry <> 0 : ysized (ry) fi
2113 shifted (atao,n)
2114 ;
2115 n := n s ;
2116 endfor ;
2117 ) shifted (ax,0) ;
2118
2119 fi ;
2120
2121 fi ;
2122
2123 if hasoption "legend" "range,all" :
2124
2125
2126
2127 save d ; d := ypart llcorner currentpicture ;
2128
2129 draw
2130 lmt_text [
2131 trace = trace,
2132 anchor = "bot",
2133 text = lua.mp.lmt_contours_range()
2134 background = "",
2135 ]
2136 if ry <> 0 : ysized (ry) fi
2137 shifted (w2,dty)
2138 ;
2139
2140
2141
2142 draw
2143 lmt_text [
2144 trace = trace,
2145 anchor = "lrt",
2146 text = lua.mp.lmt_contours_xrange()
2147 background = "",
2148 ]
2149 if ry <> 0 : ysized (ry) fi
2150 shifted (0,dty)
2151 ;
2152
2153 draw
2154 lmt_text [
2155 trace = trace,
2156 anchor = "llft",
2157 text = lua.mp.lmt_contours_yrange()
2158 background = "",
2159 ]
2160 if ry <> 0 : ysized (ry) fi
2161 shifted (w,dty)
2162 ;
2163
2164 fi ;
2165
2166 if hasoption "legend" "function,all" :
2167
2168
2169
2170 draw
2171 lmt_text [
2172 trace = trace,
2173 anchor = "bot",
2174 style = getparameter "functionstyle",
2175 text = lua.mp.lmt_contours_function()
2176 background = "",
2177 ]
2178 if ry <> 0 : ysized (ry) fi
2179 shifted (w2,ypart llcorner currentpicture ty)
2180 ;
2181
2182 fi ;
2183
2184 if trace :
2185 draw boundingbox currentpicture
2186 dashed evenly
2187 withpen pencircle scaled al ;
2188 fi ;
2189
2190 fi ;
2191
2192 fi ;
2193
2194 lua.mp.lmt_contours_stop() ;
2195
2196 popparameters ;
2197 )
2198enddef ;
2199
2200newinternal svgforcecmyk ; svgforcecmyk := 0 ;
2201
2202vardef svgcolor(expr r, g, b) =
2203 if svgforcecmyk > 0 :
2204 (1r,1g,1b,0)
2205 else :
2206 (r,g,b)
2207 fi
2208enddef ;
2209
2210vardef svgcmyk(expr c, m, y, k) =
2211 (c,m,y,k)
2212enddef ;
2213
2214vardef svggray(expr s) =
2215 s
2216enddef ;
2217
2218permanent svgforcecmyk, svgcolor, svgcmyk, svggray ;
2219
2220presetparameters "svg" [
2221 filename = "",
2222 fontname = "",
2223 colormap = "",
2224
2225 width = 0,
2226 height = 0,
2227 origin = false,
2228 offset = 0,
2229] ;
2230
2231def lmt_svg = applyparameters "svg" "lmt_do_svg" enddef ;
2232
2233vardef lmt_do_svg =
2234 save w, h, o;
2235 image (
2236 pushparameters "svg" ;
2237 w := getparameter "width" ;
2238 h := getparameter "height" ;
2239 o := getparameter "offset" ;
2240 lua.mp.lmt_svg_include() ;
2241 if getparameter "origin" :
2242 currentpicture := currentpicture shifted llcorner currentpicture ;
2243 fi ;
2244 popparameters ;
2245 if o <> 0 :
2246 setbounds currentpicture to boundingbox currentpicture enlarged o ;
2247 fi ;
2248 )
2249 if w > 0 :
2250 if h > 0 : xysized(w,h) else : xsized(w) fi
2251 else :
2252 if h > 0 : ysized(h) fi
2253 fi
2254enddef ;
2255
2256
2257
2258
2259presetparameters "surface" [
2260 code = "x + y",
2261 color = "f, 0, 0",
2262 linecolor = 1,
2263 xmin = -1,
2264 xmax = 1,
2265 ymin = -1,
2266 ymax = 1,
2267 xstep = .1,
2268 ystep = .1,
2269 snap = .01,
2270 xvector = { -0.7, -0.7 },
2271 yvector = { 1, 0 },
2272 zvector = { 0, 1 },
2273 light = { 3, 3, 10 },
2274 bright = 100,
2275 clip = false,
2276 lines = true,
2277 linecolor = 1,
2278
2279
2280 axiscolor = "gray"
2281 axislinewidth = 12,
2282] ;
2283
2284def lmt_surface = applyparameters "surface" "lmt_do_surface" enddef ;
2285
2286vardef lmt_do_surface =
2287 image (
2288
2289 lmt_load_mlib_cnt ;
2290
2291 pushparameters "surface" ;
2292
2293 save currentpen; pen currentpen ;
2294 currentpen := pencircle scaled .25 ;
2295
2296 interim linejoin := butt ;
2297
2298 lmt_do_contour_shortcuts ;
2299
2300 lua.mp.lmt_surface_do() ;
2301
2302 currentpicture := currentpicture ysized getparameter "height" ;
2303
2304 if hasparameter "axis" :
2305
2306 save p ; picture p ; p := image (
2307 if hasparameter "axis" 1 :
2308 draw ((origin) -- unitvector(getparameter "xvector")) scaled (getparameter "axis" 1) ;
2309 fi ;
2310 if hasparameter "axis" 2 :
2311 draw ((origin) -- unitvector(getparameter "yvector")) scaled (getparameter "axis" 2) ;
2312 fi ;
2313 if hasparameter "axis" 3 :
2314 draw ((origin) -- unitvector(getparameter "zvector")) scaled (getparameter "axis" 3) ;
2315 fi ;
2316 ) ;
2317
2318 if getparameterdefault "clipaxis" false :
2319 clip p to boundingbox currentpicture ;
2320 fi ;
2321
2322 draw p
2323 withpen pencircle scaled getparameter "axislinewidth"
2324 withcolor getparameter "axiscolor"
2325 ;
2326
2327 fi ;
2328
2329 popparameters ;
2330 )
2331enddef ;
2332
2333
2334
2335
2336presetparameters "mpsglyphs" [
2337 name = "dummy",
2338 units = 1000,
2339] ;
2340
2341presetparameters "mpsglyph" [
2342 category = "dummy",
2343 unicode = 0,
2344
2345] ;
2346
2347def lmt_registerglyphs = applyparameters "mpsglyphs" "lmt_do_registerglyphs" enddef ;
2348def lmt_registerglyph = applyparameters "mpsglyph" "lmt_do_registerglyph" enddef ;
2349
2350newscriptindex mfid_registerglyphs ; mfid_registerglyphs := scriptindex "registerglyphs" ; def lmt_do_registerglyphs = runscript mfid_registerglyphs enddef ;
2351newscriptindex mfid_registerglyph ; mfid_registerglyph := scriptindex "registerglyph" ; def lmt_do_registerglyph = runscript mfid_registerglyph enddef ;
2352
2353
2354
2355vardef registercomposedglyph (expr u) (suffix snippets) =
2356 save s ; s := getparameterdefault "mpsfont" "scale" 1 ;
2357 save llx, lly, urx, ury ;
2358 llx := xpart llcorner snippets[u] ;
2359 if llx <> 0 :
2360
2361 snippets[u] := snippets[u] shifted (llx, 0) ;
2362 llx := 0;
2363 fi ;
2364 lly := ypart llcorner snippets[u] s ;
2365 urx := xpart urcorner snippets[u] s ;
2366 ury := ypart urcorner snippets[u] s ;
2367 lmt_registerglyph [
2368 category = getparameter "mpsfont" "category",
2369 unicode = u,
2370 code = "draw " & str snippets & "[" & decimal u & "]",
2371 height = ury,
2372 depth = lly,
2373 width = urx llx,
2374 boundingbox = { llx, lly, urx, ury }
2375 ] ;
2376enddef ;
2377
2378vardef composeglyph (suffix snippets) =
2379 save u ; u := getparameter "mpsfont" "unicode" ;
2380 save s ; s := getparameterdefault "mpsfont" "scale" 1 ;
2381 snippets[u] := image (
2382 for i=1 upto getparametercount "mpsfont" "shapes" :
2383 draw scantokens ( getparameter "mpsfont" "shapes" i "shape" )
2384 if hasparameter "mpsfont" "shapes" i "color" :
2385 withcolor getparameter "mpsfont" "shapes" i "color"
2386 fi ;
2387 endfor ;
2388 ) scaled s ;
2389 registercomposedglyph(u, snippets) ;
2390enddef ;
2391
2392permanent registercomposeglyph, composeglyph ;
2393
2394
2395
2396
2397
2398newscriptindex mfid_remaptext ; mfid_remaptext := scriptindex "remaptext" ; def lmt_remaptext = runscript mfid_remaptext ; enddef ;
2399
2400triplet mfun_tt_s ;
2401
2402vardef rawmaptext(expr s) =
2403 mfun_tt_n := mfun_tt_n 1 ;
2404 mfun_tt_c := nullpicture ;
2405 mfun_tt_o := nullpicture ;
2406 addto mfun_tt_o doublepath origin base_draw_options ;
2407 mfun_tt_r := lua.mp.mf_map_text(mfun_tt_n,s,catcoderegime) ;
2408 mfun_tt_s := lua.mp.mf_map_move(mfun_tt_n) ;
2409 addto mfun_tt_c doublepath unitsquare
2410 xscaled wdpart mfun_tt_r
2411 yscaled (htpart mfun_tt_r dppart mfun_tt_r)
2412 shifted (0,dppart mfun_tt_r)
2413 withprescript "mf_object=text"
2414 withprescript "tx_index=" & decimal mfun_tt_n
2415 withprescript "tx_color=" & colordecimals colorpart mfun_tt_o
2416 ;
2417 mfun_tt_c
2418enddef ;
2419
2420vardef svgtext(expr t) =
2421 save p ; picture p ;
2422
2423
2424 p := rawmaptext(t) ;
2425 p
2426 if (mfun_labtype.drt >= 10) :
2427 shifted (0,ypart center p)
2428 fi
2429 shifted (
2430 mfun_labshift.drt(p)
2431 (redpart mfun_tt_s,0)
2432 (greenpart mfun_tt_s,bluepart mfun_tt_s)
2433 )
2434enddef ;
2435
2436vardef svg expr c = lmt_svg [ code = c ] enddef ;
2437
2438
2439
2440presetparameters "poisson" [
2441 width = 50,
2442 height = 50,
2443 initialx = 0,
2444 initialy = 0,
2445 distance = 1,
2446 count = 20,
2447 macro = "draw",
2448 arguments = 2
2449] ;
2450
2451def lmt_poisson = applyparameters "poisson" "lmt_do_poisson" enddef ;
2452
2453vardef lmt_do_poisson =
2454 image (
2455 pushparameters "poisson" ;
2456 lua.mp.lmt_poisson_generate();
2457 popparameters ;
2458 )
2459enddef ;
2460
2461permanent
2462 lmt_text, lmt_grid, lmt_axis, lmt_outline, lmt_followtext,
2463 lmt_arrow, lmt_placeholder,
2464 lmt_function, lmt_poisson, lmt_mesh,
2465 lmt_chart_circle, lmt_chart_histogram, lmt_chart_bar,
2466 lmt_shade, lmt_contour, lmt_svg, lmt_surface,
2467 lmt_registerglyphs, lmt_registerglyph,
2468 lmt_remaptext, rawmaptext, svgtext, svg,
2469 OverlayMesh ;
2470
2471
2472
2473newscriptindex mfid_scrutinized ; mfid_scrutinized := scriptindex "scrutinized" ;
2474newscriptindex mfid_recycled ; mfid_recycled := scriptindex "recycled" ;
2475
2476primarydef p scrutinized n = runscript mfid_scrutinized p n enddef ;
2477primarydef p recycled n = runscript mfid_recycled p n enddef ;
2478
2479permanent scrutinized, recycled ;
2480
2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499newscriptindex mfid_mpvard ; mfid_mpvard := scriptindex "mpvard" ; def mpvard = runscript mfid_mpvard enddef ;
2500newscriptindex mfid_mpvarn ; mfid_mpvarn := scriptindex "mpvarn" ; def mpvarn = runscript mfid_mpvarn enddef ;
2501newscriptindex mfid_mpvars ; mfid_mpvars := scriptindex "mpvars" ; def mpvars = runscript mfid_mpvars enddef ;
2502newscriptindex mfid_mpvarb ; mfid_mpvarb := scriptindex "mpvarb" ; def mpvarb = runscript mfid_mpvarb enddef ;
2503newscriptindex mfid_mpvar ; mfid_mpvar := scriptindex "mpvar" ; def mpvar = runscript mfid_mpvar enddef ;
2504
2505permanent mpvard, mpvarn, mpvars, mpvarb, mpvar ;
2506
2507
2508
2509vardef textual primary p = false enddef ;
2510
2511
2512
2513newscriptindex mfid_labtorgb ; mfid_labtorgb := scriptindex "labtorgb" ;
2514newscriptindex mfid_xyztorgb ; mfid_xyztorgb := scriptindex "xyztorgb" ;
2515newscriptindex mfid_lchtorgb ; mfid_lchtorgb := scriptindex "lchtorgb" ;
2516newscriptindex mfid_hsvtorgb ; mfid_hsvtorgb := scriptindex "hsvtorgb" ;
2517newscriptindex mfid_hwbtorgb ; mfid_hwbtorgb := scriptindex "hwbtorgb" ;
2518
2519def labtorgb(expr l, a, b) = runscript mfid_labtorgb l a b enddef ;
2520def xyztorgb(expr x, y, z) = runscript mfid_xyztorgb x y z enddef ;
2521def lchtorgb(expr l, c, h) = runscript mfid_lchtorgb l c h enddef ;
2522def hsvtorgb(expr h, s, v) = runscript mfid_hsvtorgb h s b enddef ;
2523def hwbtorgb(expr h, w, b) = runscript mfid_hwbtorgb h w b enddef ;
2524
2525permanent labtorgb, xyztorgb, lchtorgb, hsvtorgb, hwbtorgb ;
2526
2527presetparameters "labtorgb" [
2528 mina = -100,
2529 maxa = 100,
2530 minb = -100,
2531 maxb = 100,
2532 step = 5,
2533 l = 50,
2534] ;
2535
2536def lmt_labtorgb = applyparameters "labtorgb" "lmt_do_labtorgb" enddef ;
2537
2538vardef lmt_do_labtorgb =
2539 image (
2540 pushparameters "labtorgb" ;
2541 save l ; l := getparameter "l" ;
2542 for a = getparameter "mina" step getparameter "step" until getparameter "maxa" :
2543 for b = getparameter "minb" step getparameter "step" until getparameter "maxb" :
2544
2545 draw (a,b) withcolor runscript mfid_labtorgb l a b ;
2546 endfor ;
2547 endfor ;
2548 popparameters ;
2549 )
2550enddef ;
2551
2552presetparameters "lchcircle" [
2553 steps = 24,
2554 labels = true,
2555 l = 100,
2556 c = 100,
2557] ;
2558
2559def lmt_lchcircle = applyparameters "lchcircle" "lmt_do_lchcircle" enddef ;
2560
2561vardef lmt_do_lchcircle =
2562 image (
2563 pushparameters "lchcircle" ;
2564 save p, l, c, h, n, b ;
2565 path p ; numeric l, c, h, n ; boolean b ;
2566 l := getparameter "l" ;
2567 c := getparameter "c" ;
2568 n := getparameter "steps" ;
2569 b := getparameter "labels" ;
2570 p := arcpointlist n of fullcircle ;
2571 for i within p :
2572 h := i360n ;
2573 draw
2574 pathpoint scaled 50
2575 withpen pencircle scaled (120n)
2576 withcolor lchtorgb(l,c,h) ;
2577 if b :
2578 draw
2579 textext ("\tt\bf" & decimal h)
2580 scaled .4
2581 shifted (pathpoint scaled 50)
2582 withcolor white ;
2583 fi ;
2584 endfor ;
2585 popparameters ;
2586 )
2587enddef ;
2588
2589
2590
2591presetparameters "matrix" [
2592
2593
2594
2595
2596 connect = { "center", "center" },
2597
2598] ;
2599
2600def lmt_matrix = applyparameters "matrix" "lmt_do_matrix" enddef ;
2601
2602vardef mfun_lmt_matrix_cell (expr p) =
2603
2604 matrixcell (xpart p, ypart p)
2605enddef ;
2606
2607
2608
2609def mfun_lmt_matrix_connect (expr h, p, r, l, u, d, gap) =
2610 if h == "right" : center rightboundary (p enlarged gap) { r }
2611 elseif h == "left" : center leftboundary (p enlarged gap) { l }
2612 elseif h == "top" : center topboundary (p enlarged gap) { u }
2613 elseif h == "bottom" : center bottomboundary (p enlarged gap) { d }
2614 else : center (p enlarged gap)
2615 fi
2616enddef ;
2617
2618def mfun_lmt_matrix_source (expr p, h, gap) =
2619 mfun_lmt_matrix_connect(h, p, right, left, up, down, gap)
2620enddef ;
2621
2622def mfun_lmt_matrix_target (expr p, h, gap) =
2623 mfun_lmt_matrix_connect(h, p, left, right, down, up, gap)
2624enddef ;
2625
2626vardef mfun_lmt_matrix_enhance (expr p, h) =
2627 if h = "circle" :
2628 fullcircle xysized (bbwidth p, bbheight p) shifted center p
2629 elseif h = "round" :
2630 (p smoothed getparameterdefault "radius" ExHeight) xysized (bbwidth p, bbheight p)
2631 elseif h = "path" :
2632 (getparameterpath "path") shifted center p
2633 elseif h = "scaledpath" :
2634 (getparameterpath "path") xysized (bbwidth p, bbheight p) shifted center p
2635 else :
2636 p
2637 fi
2638enddef ;
2639
2640vardef lmt_do_matrix =
2641 image (
2642 pushparameters "matrix" ;
2643 draw image (
2644 save a, b, c, o, g ; path a, b, c ; numeric o, g ;
2645 if (hasparameter "arrowoffset") :
2646 g := getparameter "arrowoffset" ;
2647 elseif (hasparameter "linewidth") :
2648 g := getparameter "linewidth" ;
2649 else :
2650 g := 0;
2651 fi ;
2652 if (hasparameter "from") and (hasparameter "to") :
2653 a := mfun_lmt_matrix_cell(getparameter "from") ;
2654 b := mfun_lmt_matrix_cell(getparameter "to") ;
2655 if hasparameter "offset" :
2656 o := getparameter "offset" ;
2657 a := a enlarged o ;
2658 b := b enlarged o ;
2659 fi ;
2660 if hasparameter "shapes" :
2661 a := mfun_lmt_matrix_enhance(a, getparameter "shapes" 1) ;
2662 b := mfun_lmt_matrix_enhance(b, getparameter "shapes" 2) ;
2663 fi ;
2664 draw a
2665 if (hasparameter "colors") :
2666 withcolor (getparameter "colors" 1)
2667 elseif (hasparameter "color") :
2668 withcolor (getparameter "color")
2669 fi
2670 ;
2671 draw b
2672 if (hasparameter "colors") :
2673 withcolor (getparameter "colors" 2)
2674 elseif (hasparameter "color") :
2675 withcolor (getparameter "color")
2676 fi
2677 ;
2678 c :=
2679 mfun_lmt_matrix_source(a, getparameter "connect" 1, g) ..
2680 mfun_lmt_matrix_target(b, getparameter "connect" 2, g) ;
2681 drawarrow c
2682 if (hasparameter "arrowcolor") :
2683 withcolor (getparameter "arrowcolor")
2684 elseif (hasparameter "color") :
2685 withcolor (getparameter "color")
2686 fi
2687 ;
2688 if hasparameter "label" :
2689 pushparameters "label" ;
2690 draw lmt_text [
2691 text = getparameter "text",
2692 position = point (getparameterdefault "fraction" 12) of c,
2693 offset = if hasparameter "offset" : getparameter "offset" fi,
2694 color = if hasparameter "color" : getparameter "color" fi,
2695 anchor = if hasparameter "anchor" : getparameter "anchor" fi,
2696
2697 ] ;
2698 popparameters ;
2699 fi ;
2700 elseif (hasparameter "cell") :
2701 a := mfun_lmt_matrix_cell(getparameter "cell") ;
2702 if hasparameter "offset" :
2703 o := getparameter "offset" ;
2704 a := a enlarged o ;
2705 fi ;
2706 if hasparameter "shape" :
2707 a := mfun_lmt_matrix_enhance(a, getparameter "shape") ;
2708 fi ;
2709 draw a
2710 if (hasparameter "color") :
2711 withcolor (getparameter "color")
2712 fi
2713 ;
2714 fi;
2715 )
2716 if (hasparameter "linewidth") :
2717 withpen pencircle scaled (getparameter "linewidth")
2718 fi
2719 popparameters
2720 )
2721enddef ;
2722
2723
2724
2725presetparameters "glyphshape" [
2726
2727
2728 shape = true,
2729 boundingbox = false,
2730 baseline = false,
2731 usedline = true,
2732 usedbox = true,
2733 italic = false,
2734 accent = false,
2735 dimensions = false,
2736] ;
2737
2738def lmt_glyphshape = applyparameters "glyphshape" "lmt_do_glyphshape" enddef ;
2739
2740vardef glyphshape_start(expr id, character) =
2741 lua.mp.lmt_glyphshape_start(id, character) ;
2742enddef ;
2743
2744vardef glyphshape_stop = lua.mp.lmt_glyphshape_stop() ; enddef ;
2745vardef glyphshape_n = lua.mp.lmt_glyphshape_n() enddef ;
2746vardef glyphshape_path(expr i) = lua.mp.lmt_glyphshape_path(i) enddef ;
2747vardef glyphshape_boundingbox = lua.mp.lmt_glyphshape_boundingbox() enddef ;
2748vardef glyphshape_baseline = lua.mp.lmt_glyphshape_baseline() enddef ;
2749vardef glyphshape_usedbox = lua.mp.lmt_glyphshape_usedbox() enddef ;
2750vardef glyphshape_usedline = lua.mp.lmt_glyphshape_usedline() enddef ;
2751vardef glyphshape_width = lua.mp.lmt_glyphshape_width() enddef ;
2752vardef glyphshape_height = lua.mp.lmt_glyphshape_height() enddef ;
2753vardef glyphshape_depth = lua.mp.lmt_glyphshape_depth() enddef ;
2754vardef glyphshape_italic = lua.mp.lmt_glyphshape_italic() enddef ;
2755vardef glyphshape_accent = lua.mp.lmt_glyphshape_accent() enddef ;
2756vardef glyphshape_llx = lua.mp.lmt_glyphshape_llx() enddef ;
2757
2758
2759
2760
2761
2762
2763
2764
2765vardef glyphshape_usedaccent =
2766 (glyphshape_llxglyphshape_accent,0.8glyphshape_height) --
2767 (glyphshape_llxglyphshape_accent,1.2glyphshape_height)
2768enddef ;
2769
2770vardef glyphshape_useditalic =
2771 (glyphshape_llxglyphshape_width glyphshape_italic,glyphshape_depth) --
2772 (glyphshape_llxglyphshape_width glyphshape_italic,glyphshape_height)
2773enddef ;
2774
2775vardef lmt_do_glyphshape =
2776 image (
2777 pushparameters "glyphshape" ;
2778 glyphshape_start(getparameter "id", getparameter "character") ;
2779 if getparameter "shape" :
2780 draw for i=1 upto glyphshape_n :
2781 glyphshape_path(i) &&
2782 endfor cycle ;
2783 fi ;
2784
2785
2786
2787
2788
2789 if getparameter "boundingbox" :
2790 draw
2791 glyphshape_boundingbox
2792 withcolor red
2793 ;
2794 fi ;
2795 if getparameter "usedbox" :
2796 draw
2797 glyphshape_usedbox
2798 withcolor blue
2799 ;
2800 if getparameter "usedline" :
2801 draw
2802 glyphshape_usedline
2803 withcolor blue
2804 ;
2805 fi ;
2806 fi ;
2807 if (getparameter "accent") and (glyphshape_accent <> 0) :
2808 draw glyphshape_usedaccent
2809 withcolor green
2810 ;
2811 fi ;
2812 if (getparameter "italic") and (glyphshape_italic <> 0) :
2813 draw glyphshape_useditalic
2814 withcolor green
2815 ;
2816 fi ;
2817
2818
2819 glyphshape_stop ;
2820 popparameters ;
2821 )
2822enddef ;
2823
2824
2825
2826numeric last_potraced_count ;
2827numeric last_potraced_width ;
2828numeric last_potraced_height ;
2829numeric last_potraced_xsize ;
2830numeric last_potraced_ysize ;
2831numeric last_potraced_xoffset ;
2832numeric last_potraced_yoffset ;
2833
2834path last_potraced_bounds ; last_potraced_bounds := origin -- cycle ;
2835path last_potraced_sized ; last_potraced_sized := origin -- cycle ;
2836
2837pair last_potraced_offset ; last_potraced_offset := origin;
2838
2839presetparameters "potraced" [
2840 bytes = "",
2841 width = 0,
2842 height = 0,
2843 nx = 1,
2844 ny = 1,
2845 explode = false,
2846 swap = false,
2847 value = "1",
2848 optimize = false,
2849 threshold = 1,
2850 policy = "minority",
2851 tolerance = 0.2,
2852 size = 2,
2853
2854
2855 criterium = 127,
2856 alternative = "path",
2857 polygon = false,
2858] ;
2859
2860numeric n_lmt_potraced ; n_lmt_potraced := 0 ;
2861
2862def lmt_potraced = applyparameters "potraced" "lmt_do_potraced" enddef ;
2863
2864vardef lmt_do_potraced =
2865 if n_lmt_potraced = 0 :
2866 lmt_do_startpotraced ;
2867 lua.mp.lmt_step_potrace()
2868 hide (
2869 lmt_do_steppotraced ;
2870 lmt_do_stoppotraced ;
2871 )
2872 else :
2873 lua.mp.lmt_step_potrace()
2874 hide (
2875 lmt_do_steppotraced ;
2876 )
2877 fi
2878enddef ;
2879
2880def lmt_startpotraced = applyparameters "potraced" "lmt_do_startpotraced" enddef ;
2881def lmt_stoppotraced = lmt_do_stoppotraced enddef ;
2882
2883def lmt_do_startpotraced =
2884 if n_lmt_potraced = 0 :
2885 n_lmt_potraced := n_lmt_potraced 1 ;
2886 pushparameters "potraced" ;
2887 lua.mp.lmt_start_potrace() ;
2888 fi
2889enddef ;
2890
2891def lmt_do_stoppotraced =
2892 if n_lmt_potraced = 1 :
2893 n_lmt_potraced := n_lmt_potraced 1 ;
2894 lua.mp.lmt_stop_potrace() ;
2895 popparameters ;
2896 fi
2897enddef ;
2898
2899vardef lmt_do_steppotraced =
2900 last_potraced_count := getparameter("count") ;
2901 last_potraced_width := getparameter("width") ;
2902 last_potraced_height := getparameter("height") ;
2903 last_potraced_xsize := getparameter("xsize");
2904 last_potraced_ysize := getparameter("ysize");
2905 last_potraced_xoffset := getparameter("xoffset");
2906 last_potraced_yoffset := getparameter("yoffset");
2907 last_potraced_bounds := unitsquare xscaled last_potraced_width yscaled last_potraced_height ;
2908 last_potraced_sized := unitsquare xscaled last_potraced_xsize yscaled last_potraced_ysize ;
2909 last_potraced_offset := (last_potraced_xoffset,(last_potraced_ysize last_potraced_yoffset)) ;
2910enddef ;
2911
2912def lmt_showrivers(expr stepsize, width, height, showpolygon) =
2913 picture q ; q := image (
2914 lmt_startpotraced [
2915 stringname = "profile",
2916 threshold = .5,
2917 ] ;
2918
2919
2920
2921
2922
2923
2924
2925
2926 fill lmt_potraced [
2927 size = 1,
2928 first = 3,
2929 polygon = showpolygon,
2930 ] withcolor "middlegreen" ;
2931 fill lmt_potraced [
2932 size = 3,
2933 first = 3,
2934 polygon = showpolygon,
2935 ] withcolor "middleblue" ;
2936 fill lmt_potraced [
2937 size = stepsize,
2938 first = 3,
2939 polygon = showpolygon,
2940 ] withcolor "middlered" ;
2941 lmt_stoppotraced ;
2942 ) ;
2943
2944 setbounds q to last_potraced_bounds enlarged (-2,-2) ;
2945 draw q xysized (width,height) ;
2946enddef;
2947 |