mp-lmtx.mpxl /size: 100 Kb    last modification: 2025-02-21 11:03
1%D \module
2%D   [       file=mp-lmtx.mpxl,
3%D        version=2019.06.23,
4%D          title=\CONTEXT\ \METAPOST\ graphics,
5%D       subtitle=\LUA,
6%D         author=Hans Hagen,
7%D           date=\currentdate,
8%D      copyright={PRAGMA ADE \& \CONTEXT\ Development Team}]
9%C
10%C This module is part of the \CONTEXT\ macro||package and is
11%C therefore copyrighted by \PRAGMA. See mreadme.pdf for
12%C details.
13
14% This is an experimental module where I test some new interface methods;
15% for real advanced graphics use the luapost module.
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      = "", % "color",
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,-4+starty)
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 (-3+startx,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                            % p := for i = 1 upto getparametercount "points":
195                            %     if (i > 1) : -- fi (getparameter "points" i)
196                            % endfor
197                            % if (getparameterdefault "close" false) : -- cycle fi ;
198
199                            % this can become:
200
201                            % p := if (getparameterdefault "close" false) :
202                            %   % getparameterpath "points" "--" true ;
203                            %     getparameterpath "points" true ;
204                            % else :
205                            %   % getparameterpath "points" "--" false ;
206                            %     getparameterpath "points" ;
207                            % fi ;
208
209                            % p := getparameterpath "points" if (getparameterdefault "close" false) : true fi ;
210
211                            p := getparameterpath "points" (getparameterdefault "close" false) ;
212                          % p := getparameterpath "points" getparameterdefault "close" false ;
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 = 1/10,
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                % what to use here
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      % save tracingfollowtext       ; tracingfollowtext          := if getparameter "trace"  : 1 else : 0 fi ;
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  % pen         = ...,
387    kind        = "fill",
388    dimple      = 1/5,
389    scale       = 3/4,
390    penscale    = 3,
391    length      = 4,
392    angle       = 45,
393    location    = "end",    % middle both
394    alternative = "normal", % dimpled curved
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            % a cheat: we should have a type check in lua
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% from dum
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 (d/5 randomized (d/5))
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% maybe:
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% also (todo)
502
503% % draw lmt_path [
504% %     points   = [ color = "darkred",    size  = 6 ],
505% %     controls = [ color = "darkgreen",  size  = 4 ],
506% %     lines    = [ color = "darkgray",   size  = 1 ],
507% %     shape    = [ color = "middlegray", size  = 8 ],
508% %     labels   = [ ],
509% %     path     = ((1cm,1cm) -- (1.5cm,1.5cm) .. (2cm,0cm) .. cycle)
510% % ] ;
511%
512% presetparameters "path" [
513%     labels    = [
514%         color = "",
515%         size  = 1
516%     ],
517%     controls  = [
518%         color = "black",
519%         size  = 2.5
520%     ],
521%     lines  = [
522%         color = "middlegray",
523%         size  = 1
524%     ],
525%     points    = [
526%         color = "black",
527%         size  = 4
528%     ],
529%     path      = [
530%         color = "lightgray",
531%         size  = 5,
532%         path  = origin
533%     ]
534% ] ;
535%
536% def lmt_path = applyparameters "path" "lmt_do_path" enddef ;
537%
538% vardef lmt_do_path =
539%     image (
540%         % This one is not that efficient ... we can better inline the drawing routines here, but
541%         % it's just an interfacing test after all.
542%             if hasparameter "path" "path" :
543%             save p ; path p ; p := getparameter "path" "path" ;
544%             drawpath p
545%                 withpen pencircle scaled (drawoptionsfactor * getparameterdefault "path" "shape" "size" "*")
546%                 withcolor getparameterdefault "path" "shape" "color" "*"
547%             ;
548%             if hasparameter "path" "controls" :
549%                 drawcontrollines  p
550%                     withpen pencircle scaled (drawoptionsfactor * getparameterdefault "path" "lines" "size" "*" )
551%                     withcolor getparameterdefault "path" "lines" "color" "*"
552%                 ;
553%                 drawcontrolpoints p
554%                     withpen pencircle scaled (drawoptionsfactor * getparameterdefault "path" "controls" "size" "*")
555%                     withcolor getparameterdefault "path" "controls" "color" "*"
556%                 ;
557%             fi ;
558%             if hasparameter "path" "points" :
559%                 drawpoints p
560%                     withpen pencircle scaled (drawoptionsfactor * getparameterdefault "path" "points" "size" "*")
561%                     withcolor getparameterdefault "path" "points" "color" "*"
562%                 ;
563%                 if hasparameter "path" "labels" :
564%                     drawpointlabels p
565%                         withcolor getparameterdefault "path" "labels" "color" "*"
566%                     ;
567%                 fi ;
568%             fi ;
569%         fi ;
570%     )
571% enddef ;
572
573% Here we use nodraw and dodraw to create efficient axis ticks. Yet another demo
574% of coding.
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", % top bottom middle
587    xcaption    = "",
588    ymin        = 1,
589    ymax        = 1,
590    ystep       = 1,
591    ysmall      = 0,
592    ylarge      = 0,
593  % xfirst      = 0,
594  % xlast       = 0,
595  % yfirst      = 0,
596  % ylast       = 0,
597    ylabels     = "no",
598    yticks      = "left", % left right middle
599    ycaption    = "",
600    code        = "",
601    close       = false,
602    shape       = "curve",
603    fillcolor   = "",
604    drawsize    = 1,
605    drawcolor   = "",
606    frame       = "",     % yes ticks
607    linewidth   = .05mm,
608    pointsymbol = "",
609    pointsize   = 2,
610    pointcolor  = "",
611    xarrow      = "",
612    yarrow      = "",
613    reverse     = false,
614  % function    : metatable is parent
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 := 1/20 ; % tick length
648        ts := 1/10 ; % text scale
649        tr := identity xyscaled(10/sx,10/sy) ;
650        tt := identity xyscaled(ts/sx,ts/sy) ;
651        pickup pencircle xyscaled(lw/sx,lw/sy) ;
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                        % todo: pushparameters with a metatable, here parent
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    % nothing
717else :
718
719    % todo: x y both
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            % this arrow head scaling is for Alan to sort out ...
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 ((ymax-ymin)/ysmall) until ymax :
755                            draw (xmin,i) -- (xmax,i) ;
756                        endfor ;
757                        dodraw (xmin,ymin) ; % flush snippets
758                    fi ;
759                fi ;
760                if ysmall > 0 :
761                    if hasoption "frame" "vertical" :
762                        for i = xmin step ((xmax-xmin)/xsmall) until xmax :
763                            draw (i,ymin) -- (i,ymax) ;
764                        endfor ;
765                        dodraw (xmin,ymin) ; % flush snippets
766                    fi ;
767                fi ;
768            fi ;
769
770            option := getparameter "xarrow" ;
771            if option = "yes" :
772                save ahlength ; ahlength  := tl ;
773                % save ahangle  ; ahangle   := 100/sy ;
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                % save ahangle  ; ahangle  := 100/sx ;
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 ((ymax-ymin)/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 ((xmax-xmin)/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 ((xmax-xmin)/xsmall) until xmax :
810                            nodraw txs shifted (i,ymax) ;
811                        endfor ;
812                    fi ;
813                    dodraw (xmin,ymin) ; % flush snippets
814                fi ;
815                if ysmall > 0 :
816                    if hasoption "frame" "vertical" :
817                        for i = xmin step ((xmax-xmin)/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 ((ymax-ymin)/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 ((ymax-ymin)/ysmall) until ymax :
832                            nodraw tys shifted (xmax,i) ;
833                        endfor ;
834                    fi ;
835                    dodraw (xmin,ymin) ; % flush snippets
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) ; % flush snippets
850            elseif xsmall > 0 :
851                dodraw (xmin,0) ; % flush snippets
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) ; % flush snippets
865            elseif ysmall > 0 :
866                dodraw (xmin,ymin) ; % flush snippets
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 (xmin-tl,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% Don't use this one!
923
924presetparameters "mesh" [
925    trace = false,
926    auto  = false,
927    step  = 0.05,
928  % box   = ...
929  % paths = { ..., ..., ... }
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 -1/10;
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 1+stp/2 :
1007        cp --
1008        mfun_meshed_clipped(pth,bb,lp*(i-stp)) --
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% charts
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  % labels          = { },
1041    labelstyle      = "",
1042    labelformat     = "",
1043  % labelstrut      = "auto",
1044  % labelanchor     = "",
1045  % labeloffset     = 0,
1046    labelfraction   = 0.8,
1047    labelcolor      = "",
1048
1049    axisstyle       = "",
1050    axiscolor       = "",
1051    axisformat      = "",
1052    axislinewidth   = mm/5,
1053    axislinecolor   = "",
1054
1055    valuestyle      = "",
1056    valuecolor      = "",
1057    valueformat     = "",
1058
1059    backgroundcolor = "",
1060    drawcolor       = "white",
1061    fillcolors      = { % use color palet
1062        "darkred", "darkgreen", "darkblue",
1063        "darkyellow", "darkmagenta", "darkcyan",
1064        "darkgray"
1065    },
1066    linecolors      = { },
1067    colormode       = "global",
1068
1069    linewidth       = .25mm,
1070  % linegap         = 0,
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, % -90 == top
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"), 8*linewidth) ;
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 1/4
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,dy+d)
1221                    withcolor getparameter "fillcolors" i ;
1222                draw l
1223                    shifted (dx+w+o,dy+d) ;
1224            endfor ;
1225        fi ;
1226    fi ;
1227enddef ;
1228
1229% draw lmt_chart_circle [
1230%     height       = 4cm,
1231%     innerradius  = 2.0cm,
1232%     samples      = { { 10, 20, 30, 40, 50 } },
1233%     percentage   = false,
1234%     initialangle = 90,
1235%     linewidth    = .125mm,
1236%     originsize   = 0,
1237%     showlabels   = false,
1238%     drawcolor    = "white",
1239%     fillcolors   = { "red",     "green",  "blue",     "",       "cyan" },
1240%     linecolors   = { "magenta", "orange", "darkgray", "orange", "darkgray" }
1241%     linecolors   = { "",        "orange", "",         "orange", "" }
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" ; % watch sign
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 := 100/total ;
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 -- (2*height,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 (360/100) * 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 (360/100) * value * factor ;
1321                            draw lmt_do_chart_text (s,i,value)
1322                                shifted ((labelfraction*(height/2),0) rotated ((first+last)/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  (-linewidth/2) fi
1367                            if i < nofsamples : rightenlarged (-linewidth/2) 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)+width/2+(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    (-linewidth/2) fi
1418                            if i < nofsamples : bottomenlarged (-linewidth/2) fi
1419                        fi
1420                        shifted (0,maxheight-nofsamplesets*i*height+(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,maxheight-nofsamplesets*(i*height)+height/2+(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%D This one is more complex than needed but I want to trace so I need all those
1440%D variables.
1441
1442presetparameters "shade" [
1443    alternative = "circular",
1444    path        = origin -- cycle,
1445    trace       = false
1446
1447 %  alternative = "circular" | "linear"
1448 %  domain      = { a, b }
1449 %  radius      = a | { a, b }
1450 %  factor      = a
1451 %  origin      = (a,b) | { (a,b), {c, d) }
1452 %  vector      = { a, b }
1453 %  colors      = { a, b }
1454 %  center      = a | { a, b }
1455 %  direction   = "up" | "down" | "left" | "right" | { a, b }
1456
1457] ;
1458
1459% TODO: pass colors as strings
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          % elseif pair getparameter "center" :
1562          %     cx := xpart getparameter "center" ;
1563          %     cy := ypart getparameter "center" ;
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 % used for support scaling
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             %  withprescript "sh_factor=1"
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              % withprescript "sh_factor=1.2"
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%                 draw fullcircle scaled (         radius_a * 2) shifted  center_a dashed evenly ;
1607%                 draw fullcircle scaled (factor * radius_b * 2) shifted -center_b dashed evenly ;
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% This is very experimental and will first be tested by a few users who
1617% are interested in this.
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  % colors           = { },          % used when set
1628    preamble         = "",
1629    function         = "x + y",
1630    color            = "lin(l)",     % l/n
1631    background       = "bitmap",     % bitmap | shape | band
1632    foreground       = "auto",       % cell| edge | shape | auto: bitmap/edge shape/shape
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,            % auto when 0
1644    height           = 0,            % auto when 0
1645
1646    trace            = false,
1647    checkresult      = false,
1648    defaultnan       = 0,
1649    defaultinf       = 0,
1650
1651    legend           = "all",  % x | y | z | function | range | all (but range)
1652    legendheight     = LineHeight,
1653    legendwidth      = LineHeight,
1654    legendgap        = 0,
1655    legenddistance   = EmWidth,
1656    textdistance     = 2EmWidth/3,
1657    functiondistance = ExHeight,
1658    functionstyle    = "",
1659
1660    level            = 4096,        % for selecting one (can't be too large for scaled)
1661
1662    axisdistance     = ExHeight,
1663    axislinewidth    = .25,
1664    axisoffset       = ExHeight/4,
1665    axiscolor        = "black",
1666    ticklength       = ExHeight,
1667
1668    xtick            = 5,
1669    ytick            = 5,
1670    xlabel           = 5,
1671    ylabel           = 5,
1672
1673] ;
1674
1675% we can as well push ...
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 (-1/2,-1/2) 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() : % no + 1 here
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 & % todo: use different hook
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        % graphic
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) ; % true ?
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(-1/2,-1/2) ;
1870                elseif (fg = "edge") :
1871                    lmt_do_contour_edge(-1/2,-1/2) ;
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                % currentpicture := currentpicture reflectedabout ( (0, ny/2), (nx,ny/2) ) ;
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            % axis
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            % resize
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            % legend
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                % move some in the ifs
1956
1957                if hasoption "legend" "all,z" :
1958
1959                    % colorbar
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                  % u  := 1 ;
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 := - sy/2 + ry/2 ;
1982                    tx := 2u ;
1983                    ty := 1u ;
1984                    ax := 1u ;
1985                    ay := 1u ;
1986                    ao := u ;
1987                    al := u/8 ;
1988                    at := 3u/2 ;
1989                    al := u/4 ;
1990                else :
1991                    ry := 0 ;
1992                    sy := getparameter "legendheight" ;
1993                    sx := getparameter "legendwidth" ;
1994                    lg := getparameter "legendgap" ;
1995                    ox := getparameter "legenddistance" ;
1996                    oy := - sy/2 + hx/2 ;
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 (w+ox,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 (w+ox+tx+sx,dy+sy+oy)
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 := al/2 ; 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 := al/2 ; 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,-at-ao)
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 := al/2 ; 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 := al/2 ; 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 (-at-ao,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                    % range
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 (w/2,d-ty)
2138                    ;
2139
2140                    % minmax
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,d-ty)
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,d-ty)
2162                    ;
2163
2164                fi ;
2165
2166                if hasoption "legend" "function,all" :
2167
2168                    % formula
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 (w/2,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        (1-r,1-g,1-b,0) % simple: no black component, kind of ok for emoji
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  % unicode  = 0,
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() ; % textext runs twice .. maybe force once here
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% Another experiment. Parameters might change pending a discussion between Alan
2257% and me.
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  % axis          = { }
2279  % clipaxis      = false
2280    axiscolor     = "gray"
2281    axislinewidth = 1/2,
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% I can make a variant that avoids the lmt_do ... and does an immediate function
2334% call instead.
2335
2336presetparameters "mpsglyphs" [
2337    name  = "dummy",
2338    units = 1000,
2339] ;
2340
2341presetparameters "mpsglyph" [
2342    category = "dummy",
2343    unicode  = 0,
2344  % unichar  = ""
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% An experimental macro:
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        % this should be an option or we need a lsb
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% Again an experiment (todo: the faster method):
2395
2396% watch the ; that we scan!
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) ; % can become mfid_maptext
2408    mfun_tt_s := lua.mp.mf_map_move(mfun_tt_n) ;                 % can become mfid_mapmove
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  % mfun_tt_s := (0,0,0) ;
2423  % mfun_tt_r := (0,0,0) ;
2424    p := rawmaptext(t) ;
2425    p
2426    if (mfun_labtype.drt >= 10) : % drt etc
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% Fun stuff:
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, % lmt_path,
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% nice hack
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% for now here
2482
2483% newscriptindex mfid_mpv_numeric   ; mfid_mpv_numeric   := scriptindex "mpv_numeric" ;
2484% newscriptindex mfid_mpv_dimension ; mfid_mpv_dimension := scriptindex "mpv_dimension" ;
2485% newscriptindex mfid_mpv_string    ; mfid_mpv_string    := scriptindex "mpv_string" ;
2486%
2487% def mpv_numeric   = runscript mfid_mpv_numeric   enddef ;
2488% def mpv_dimension = runscript mfid_mpv_dimension enddef ;
2489% def mpv_string    = runscript mfid_mpv_string    enddef ;
2490%
2491% permanent mpv_numeric, mpv_dimension, mpv_string ;
2492
2493% newscriptindex mfid_mpvar ; mfid_mpvar := scriptindex "mpvar" ;
2494%
2495% def mpvar = runscript mfid_mpvar enddef ;
2496
2497% d(imension) n(umber) s(tring) b(oolean) <heuristic>
2498
2499newscriptindex mfid_mpvard ; mfid_mpvard := scriptindex "mpvard" ; def mpvard = runscript mfid_mpvard enddef ; % dimension
2500newscriptindex mfid_mpvarn ; mfid_mpvarn := scriptindex "mpvarn" ; def mpvarn = runscript mfid_mpvarn enddef ; % numeric
2501newscriptindex mfid_mpvars ; mfid_mpvars := scriptindex "mpvars" ; def mpvars = runscript mfid_mpvars enddef ; % string
2502newscriptindex mfid_mpvarb ; mfid_mpvarb := scriptindex "mpvarb" ; def mpvarb = runscript mfid_mpvarb enddef ; % string
2503newscriptindex mfid_mpvar  ; mfid_mpvar  := scriptindex "mpvar"  ; def mpvar  = runscript mfid_mpvar  enddef ; % automatic
2504
2505permanent mpvard, mpvarn, mpvars, mpvarb, mpvar ;
2506
2507% for old times sake (metafun manual)
2508
2509vardef textual primary p = false enddef ;
2510
2511% also for the menafun manual:
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                  % draw (a,b) withcolor labtorgb(l,a,b) ;
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 := i*360/n ;
2573      draw
2574        pathpoint scaled 50
2575        withpen pencircle scaled (120/n)
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% For now we collect all lmt namespace extensions here, so also this one:
2590
2591presetparameters "matrix" [
2592  % cell    = (1, 1),
2593  % from    = (1, 1),
2594  % to      = (1, 1),
2595  % shape   = { "circle", "square" },
2596    connect = { "center", "center" },
2597  % text    = "",
2598] ;
2599
2600def lmt_matrix = applyparameters "matrix" "lmt_do_matrix" enddef ;
2601
2602vardef mfun_lmt_matrix_cell (expr p) =
2603  % anchorbox ("matrix", xpart p, ypart p) ("matrix", xpart p + 1, ypart p)
2604    matrixcell (xpart p, ypart p)
2605enddef ;
2606
2607% todo: lft rt etc but then we need to push/pop the linewidth too
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" 1/2) 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                      % strut style format background backgroundcolor
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% This might move to its own module if we add more:
2724
2725presetparameters "glyphshape" [
2726  % id        = "",
2727  % character = "",
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% vardef glyphshape_dimensions =
2759%     unitsquare
2760%         xscaled glyphshape_width
2761%         yscaled (glyphshape_height - glyphshape_depth)
2762%         shifted (glyphshape_llx,glyphshape_depth)
2763% enddef ;
2764
2765vardef glyphshape_usedaccent =
2766    (glyphshape_llx+glyphshape_accent,0.8*glyphshape_height) --
2767    (glyphshape_llx+glyphshape_accent,1.2*glyphshape_height)
2768enddef ;
2769
2770vardef glyphshape_useditalic =
2771    (glyphshape_llx+glyphshape_width + glyphshape_italic,glyphshape_depth) --
2772    (glyphshape_llx+glyphshape_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%             if getparameter "dimensions" :
2785%                 draw
2786%                     glyphshape_dimensions
2787%                     withcolor red;
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% drawdot (glyphshape_width,0) ;
2818% drawdot (glyphshape_llx,0) ;
2819            glyphshape_stop ;
2820        popparameters ;
2821    )
2822enddef ;
2823
2824% experimental:
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,      % opticurve
2849    threshold   = 1,          % alphamax
2850    policy      = "minority", % turnpolicy
2851    tolerance   = 0.2,        % opttolerance
2852    size        = 2,          % turdsize
2853  % stringname  = "",
2854  % filename    = "",
2855    criterium   = 127,
2856    alternative = "path", % draw fill -> picture
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      % draw lmt_potraced [
2919      %     size       = 1,
2920      %     index      = 1,
2921      % ] withcolor "middleyellow" ;
2922      % draw lmt_potraced [
2923      %     size       = 1,
2924      %     index      = 2,
2925      % ] withcolor "middlegray" ;
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