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