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