%D \module
%D   [       file=mp-lmtx.mpxl,
%D        version=2019.06.23,
%D          title=\CONTEXT\ \METAPOST\ graphics,
%D       subtitle=\LUA,
%D         author=Hans Hagen,
%D           date=\currentdate,
%D      copyright={PRAGMA ADE \& \CONTEXT\ Development Team}]
%C
%C This module is part of the \CONTEXT\ macro||package and is
%C therefore copyrighted by \PRAGMA. See mreadme.pdf for
%C details.

% This is an experimental module where I test some new interface methods;
% for real advanced graphics use the luapost module.

if known metafun_loaded_lmtx : endinput ; fi ;

newinternal boolean metafun_loaded_lmtx ; metafun_loaded_lmtx := true ; immutable metafun_loaded_lmtx ;

presetparameters "text" [
    offset     = 0,
    strut      = "auto",
    style      = "",
    color      = "",
    text       = "",
    anchor     = "",
    format     = "",
    position   = origin,
    trace      = false,

    background      = "", % "color",
    backgroundcolor = "gray",
] ;

def lmt_text = applyparameters "text" "lmt_do_text" enddef ;

vardef lmt_do_text =
    image (
        pushparameters "text" ;
        save style, anchor, txt, fmt, strt ;
        string style, anchor, txt, fmt, strt, bgr ;
        interim textextoffset := getparameter "offset" ;
        style := getparameter "style" ;
        anchor := getparameter "anchor" ;
        strt := getparameter "strut" ;
        fmt := getparameter "format" ;
        txt := getparameter "text" ;
        bgr := getparameter "background" ;
        if fmt <> "" :
            txt := "\formatone{" & fmt & "}{" & txt & "}"
        fi ;
        if strt = "yes" :
            txt := "\strut " & txt ;
        elseif strt = "auto" :
            txt := "\setstrut\strut " & txt ;
        fi ;
        if style <> "" :
            txt := "\style[" & style & "]{" & txt & "}" ;
        fi ;
        if getparameter "trace" :
            txt := "\ruledhbox{\showstruts" & txt & "}" ;
        fi ;
        draw
            if anchor = "" : thetextext else : scantokens("thetextext." & anchor) fi (
                txt,
                getparameter "position"
            )
            withcolor getparameter "color" ;
        if bgr = "color" :
            addbackground withcolor getparameter "backgroundcolor" ;
        fi ;
        popparameters ;
    )
enddef ;

presetparameters "grid" [
    nx = 1, dx = 1,
    ny = 1, dy = 1,
] ;

def lmt_grid = applyparameters "grid" "lmt_do_grid" enddef ;

vardef lmt_do_grid =
    image (
        save nx; nx := getparameter "grid" "nx" ;
        save ny; ny := getparameter "grid" "ny" ;
        save dx; dx := getparameter "grid" "dx" ;
        save dy; dy := getparameter "grid" "dy" ;
        for i = 0 step dx until nx :
            draw ((0,0) -- (0,ny)) shifted (i,0) ;
        endfor ;
        for i = 0 step dy until ny :
            draw ((0,0) -- (nx,0)) shifted (0,i) ;
        endfor ;
    )
enddef ;

def lmt_axis = applyparameters "axis" "lmt_do_axis" enddef ;

presetparameters "axis" [
    nx = 1, dx = 1, tx = 0, sx = 1, startx = 0,
    ny = 1, dy = 1, ty = 0, sy = 1, starty = 0,

    samples      = { },
    list         = { },
    connect      = false,
    list         = [ close = false ],
    samplecolors = { "" },
    axiscolor    = "",
    textcolor    = "",
] ;

vardef lmt_do_axis =
    image (

        pushparameters "axis" ;
            save nx, ny, dx, dy, tx, ty ;
            save c, startx, starty ; string c ;
            nx := getparameter "nx" ;
            ny := getparameter "ny" ;
            dx := getparameter "dx" ;
            dy := getparameter "dy" ;
            tx := getparameter "tx" ;
            ty := getparameter "ty" ;
            c := getparameter "axiscolor" ;
            startx := getparameter "startx" ;
            starty := getparameter "starty" ;
            draw (startx,starty) -- (startx,ny) withcolor c ;
            draw (startx,starty) -- (nx,starty) withcolor c ;
            for i = startx step dx until nx :
                if (i > startx) or (startx = 0) :
                    draw ((0,0) -- (0,-2)) shifted (i,starty) withcolor c ;
                fi ;
            endfor ;
            for i = starty step dy until ny :
                if (i > starty) or (starty = 0) :
                    draw ((0,0) -- (-2,0)) shifted (startx,i) withcolor c ;
                fi ;
            endfor ;
            if tx <> 0 :
                c := getparameter "textcolor" ;
                for i = startx step tx until nx :
                    if (i > startx) or (startx = 0) :
                        draw
                            textext("\strut " & decimal (i)) ysized 2 shifted (i,-4+starty)
                            withcolor c;
                    fi ;
                endfor ;
            fi ;
            if ty <> 0 :
                c := getparameter "textcolor" ;
                for i = starty step ty until ny :
                    if (i > starty) or (starty = 0) :
                        draw
                            textext.lft("\strut " & decimal (i)) ysized 2 shifted (-3+startx,i)
                            withcolor c;
                    fi ;
                endfor ;
            fi ;

            if (getparametercount "samples") > 0 :
                if getparameter "connect" :
                    for s = 1 upto getparametercount "samples" :
                        c := getparameter "samplecolors" s ;
                        draw for i = 1 upto getparametercount "samples" s :
                            if (i > 1) : -- fi (i, getparameter "samples" s i)
                        endfor
                        withcolor c ;
                    endfor ;
                else :
                    for s = 1 upto getparametercount "samples" :
                        c := getparameter "samplecolors" s ;
                        for i = 1 upto getparametercount "samples" s :
                            draw (i, getparameter "samples" s i)
                            withcolor c ;
                        endfor ;
                    endfor ;
                fi ;
            fi ;

            if (getparametercount "list") > 0 :

                save p, ts, a, d ; path p ; numeric ts ; pair a, d ;

                ts := (getparameter "sy") / 20 ;

                pushparameters "list" ;
                    for s = 1 upto getparametercount :
                        pushparameters s ;

                            c := getparameter "color" ;

                            if (getparameterdefault "close" false) :
                                p := getparameterpath "points" "close" ;
                            else :
                                p := getparameterpath "points" ;
                            fi

                            draw p withcolor c ;

                            pushparameters "labels" ;
                                if (getparametercount) > 0 :
                                    for i = 1 upto getparametercount:
                                        n := i - 1 ;
                                        a := point n of p ;
                                        d := direction n of p ;
                                        draw
                                            textext(getparametertext i true)
                                            ysized ts
                                            shifted (a + .5 * unitvector(d) rotated 90) ;
                                    endfor ;
                                fi ;
                            popparameters ;

                            pushparameters "texts" ;
                                if (getparametercount) > 0 :
                                    for i = 1 upto getparametercount :
                                        n := i + 0.5 ;
                                        a := point n of p ;
                                        d := direction n of p ;
                                        draw textext.d(getparametertext i true)
                                            if d < left : rotated 180 shifted (0,-5) else : shifted (0,5) fi
                                            ysized ts
                                            shifted a
                                            if d <> origin :
                                                rotatedaround(a,angle(d))
                                            fi ;
                                    endfor ;
                                fi ;
                            popparameters ;

                        popparameters ;
                    endfor ;
                popparameters ;
            fi ;

        popparameters ;

    )
        xyscaled(getparameter "axis" "sx",getparameter "axis" "sy")
enddef ;

presetparameters "outline" [
    text          = "",
    kind          = "draw",
    fillcolor     = "",
    drawcolor     = "",
    rulethickness = 1/10,
    align         = "",
    style         = "",
    width         = 0,
] ;

def lmt_outline = applyparameters "outline" "lmt_do_outline" enddef ;

vardef lmt_do_outline =
    save kind  ; string kind   ; kind  := getparameter "outline" "kind"  ;
    save align ; string align  ; align := getparameter "outline" "align" ;
    save style ; string style  ; style := getparameter "outline" "style" ;
    save width ; numeric width ; width := getparameter "outline" "width" ;
    save isol  ; boolean isol  ; isol  := (kind == "outline") ;
    if isol :
        kind := "p" ;
        save ol ; picture ol ; ol :=
    fi
    image ( normaldraw image (
        if kind = "draw" :
            kind := "d" ;
        elseif kind = "fill" :
            kind := "f" ;
        elseif kind = "both" :
            kind := "b" ;
        elseif kind = "reverse" :
            kind := "r" ;
        elseif kind = "fillup" :
            kind := "u" ;
        elseif kind = "path" :
            kind := "p" ;
        fi ;
        currentoutlinetext := currentoutlinetext + 1 ;
        lua.mp.mf_outline_text(
            currentoutlinetext,
            if align = "" :
                getparameter "outline" "text",
            else :
                "\framed[align={" & align & "}"
                if width > 0 :
                    & ",width=" & decimal width & "bp"
                fi
                if style <> "" :
                    & ",foregroundstyle={" & style & "}"
                fi
                & ",offset=none,frame=off]{"
                & (getparameter "outline" "text")
                & "}",
            fi,
            kind
        ) ;
        save currentpen; pen currentpen ;
        pickup pencircle scaled getparameter "outline" "rulethickness"  ;
        if kind = "f" :
            mfun_do_outline_text_set_f (
                withcolor getparameter "outline" "fillcolor"
            );
        elseif kind = "d" :
            mfun_do_outline_text_set_d (
                withcolor getparameter "outline" "drawcolor"
            );
        elseif kind = "b" :
            mfun_do_outline_text_set_b (
                withcolor getparameter "outline" "fillcolor"
            ) (
                withcolor getparameter "outline" "drawcolor"
            );
        elseif kind = "u" :
            mfun_do_outline_text_set_u (
                withcolor getparameter "outline" "fillcolor"
            );
        elseif kind = "r" :
            mfun_do_outline_text_set_r (
                withcolor getparameter "outline" "drawcolor"
            ) (
                withcolor getparameter "outline" "fillcolor"
            ) ;
        elseif kind = "p" :
            mfun_do_outline_text_set_p ;
        else :
            mfun_do_outline_text_set_n (
                % what to use here
            );
        fi ;
        lua.mp.mf_get_outline_text(currentoutlinetext) ;
    ) )
    if isol :
        ; for i within ol : pathpart i && endfor cycle
    fi
enddef ;

presetparameters "followtext" [
    text          = "",
    spread        = true,
    trace         = false,
    reverse       = false,
    autoscaleup   = "no",
    autoscaledown = "no",
    path          = (fullcircle),
] ;

def lmt_followtext = applyparameters "followtext" "lmt_do_followtext" enddef ;

vardef lmt_do_followtext =
    image (
        pushparameters "followtext" ;
        save scale_up   ; string scale_up   ; scale_up   := getparameter "autoscaleup" ;
        save scale_down ; string scale_down ; scale_down := getparameter "autoscaledown" ;
        save followtextalternative   ; followtextalternative   := if getparameter "spread" : 1 else : 0 fi ;
        save autoscaleupfollowtext   ; autoscaleupfollowtext   := if scale_up   = "yes" : 1 elseif scale_up   = "max" : 2 else : 0 fi ;
        save autoscaledownfollowtext ; autoscaledownfollowtext := if scale_down = "yes" : 1 elseif scale_down = "max" : 2 else : 0 fi ;
      % save tracingfollowtext       ; tracingfollowtext          := if getparameter "trace"  : 1 else : 0 fi ;
        interim tracingfollowtext := if getparameter "trace" : 1 else : 0 fi ;
        draw followtext (
            if (getparameter "reverse") : reverse fi (getparameter "path"),
            (getparameter "text")
        ) ;
        popparameters ;
    )
enddef ;

presetparameters "arrow" [
    path        = origin,
  % pen         = ...,
    kind        = "fill",
    dimple      = 1/5,
    scale       = 3/4,
    penscale    = 3,
    length      = 4,
    angle       = 45,
    location    = "end",    % middle both
    alternative = "normal", % dimpled curved
    percentage  = 50,
    headonly    = false,
] ;

def lmt_arrow = applyparameters "arrow" "lmt_do_arrow" enddef ;

vardef lmt_do_arrow =
    image (
        pushparameters "arrow" ;
        save a ; string a ; a := getparameter "alternative" ;
        save l ; string l ; l := getparameter "location" ;
        save k ; string k ; k := getparameter "kind" ;
        save p ; path   p ; p := getparameter "path" ;
        interim ahvariant := if a = "dimpled" : 1 elseif a = "curved" : 2 else : 0 fi ;
        interim ahdimple  := getparameter "dimple" ;
        interim ahscale   := getparameter "scale" ;
        interim ahangle   := getparameter "angle" ;
        interim ahlength  := getparameter "length" ;
        if not getparameter "headonly" :
            draw p ;
        fi ;
        if hasparameter "pen" :
            % a cheat: we should have a type check in lua
            if hasoption "pen" "auto" :
                ahlength := (getparameter "penscale") * boundingradius(currentpen) ;
            else :
                ahlength := (getparameter "penscale") * boundingradius(getparameterpen "pen") ;
            fi ;
        fi ;
        if k = "draw" : draw elseif k = "both" : filldraw else : fill fi
        if l = "middle" :
            midarrowhead p ;
        elseif l = "percentage" :
            arrowheadonpath (p, (getparameter "percentage")/100) ;
        elseif l = "both" :
            arrowhead p ;
            if k = "draw" : draw elseif k = "both" : filldraw else : fill fi
            arrowhead reverse p ;
        else :
            arrowhead p ;
        fi ;
        popparameters ;
    )
enddef ;

% from dum

presetparameters "placeholder" [
    color       = "red",
    width       = 1,
    height      = 1,
    reduction   = 0,
    alternative = "circle",
] ;

def lmt_placeholder = applyparameters "placeholder" "lmt_do_placeholder" enddef ;

def lmt_do_placeholder =
    begingroup ;
    pushparameters "placeholder" ;
    save w, h, d, r, p, c, b, s, q, a ;
    numeric w, h, d, r ; path p ; string s, a ;
    s := getparameter "color" ;
    w := getparameter "width" ;
    h := getparameter "height" ;
    r := getparameter "reduction" ;
    a := getparameter "alternative" ;
    d := max(w,h) ;
    if cmykcolor resolvedcolor(s) :
        cmykcolor c, b ; b := (0,0,0,0)
    else :
        color c, b ; b := (1,1,1)
    fi ;
    c := resolvedcolor(s) ;
    p := unitsquare xyscaled (w,h) ;
    fill p withcolor r[.5c,b] ;
    if a = "square" :
        vardef q = fullsquare enddef ;
    elseif a = "triangle" :
        vardef q = fulltriangle rotated (90 * round(uniformdeviate(4))) enddef ;
    else :
        vardef q = fullcircle enddef ;
    fi ;
    for i := 1 upto 60 :
        fill q
            scaled (d/5 randomized (d/5))
            shifted (center p randomized (d))
            withcolor r[c randomized(.3,.9),b] ;
    endfor ;
    clip currentpicture to p ;
    popparameters ;
    endgroup ;
enddef ;

% maybe:

vardef lmt_connected(text t) =
    save p ; path p ;
    p := origin t ;
    subpath (1,length(p)) of p
enddef ;

def lmt_connection expr t =
    -- t
enddef ;

% also (todo)

% % draw lmt_path [
% %     points   = [ color = "darkred",    size  = 6 ],
% %     controls = [ color = "darkgreen",  size  = 4 ],
% %     lines    = [ color = "darkgray",   size  = 1 ],
% %     shape    = [ color = "middlegray", size  = 8 ],
% %     labels   = [ ],
% %     path     = ((1cm,1cm) -- (1.5cm,1.5cm) .. (2cm,0cm) .. cycle)
% % ] ;
%
% presetparameters "path" [
%     labels    = [
%         color = "",
%         size  = 1
%     ],
%     controls  = [
%         color = "black",
%         size  = 2.5
%     ],
%     lines  = [
%         color = "middlegray",
%         size  = 1
%     ],
%     points    = [
%         color = "black",
%         size  = 4
%     ],
%     path      = [
%         color = "lightgray",
%         size  = 5,
%         path  = origin
%     ]
% ] ;
%
% def lmt_path = applyparameters "path" "lmt_do_path" enddef ;
%
% vardef lmt_do_path =
%     image (
%         % This one is not that efficient ... we can better inline the drawing routines here, but
%         % it's just an interfacing test after all.
%             if hasparameter "path" "path" :
%             save p ; path p ; p := getparameter "path" "path" ;
%             drawpath p
%                 withpen pencircle scaled (drawoptionsfactor * getparameterdefault "path" "shape" "size" "*")
%                 withcolor getparameterdefault "path" "shape" "color" "*"
%             ;
%             if hasparameter "path" "controls" :
%                 drawcontrollines  p
%                     withpen pencircle scaled (drawoptionsfactor * getparameterdefault "path" "lines" "size" "*" )
%                     withcolor getparameterdefault "path" "lines" "color" "*"
%                 ;
%                 drawcontrolpoints p
%                     withpen pencircle scaled (drawoptionsfactor * getparameterdefault "path" "controls" "size" "*")
%                     withcolor getparameterdefault "path" "controls" "color" "*"
%                 ;
%             fi ;
%             if hasparameter "path" "points" :
%                 drawpoints p
%                     withpen pencircle scaled (drawoptionsfactor * getparameterdefault "path" "points" "size" "*")
%                     withcolor getparameterdefault "path" "points" "color" "*"
%                 ;
%                 if hasparameter "path" "labels" :
%                     drawpointlabels p
%                         withcolor getparameterdefault "path" "labels" "color" "*"
%                     ;
%                 fi ;
%             fi ;
%         fi ;
%     )
% enddef ;

% Here we use nodraw and dodraw to create efficient axis ticks. Yet another demo
% of coding.

presetparameters "function" [
    sx          = 1mm,
    sy          = 1mm,
    offset      = 0,
    xmin        = 1,
    xmax        = 1,
    xstep       = 1,
    xsmall      = 0,
    xlarge      = 0,
    xlabels     = "no",
    xticks      = "bottom", % top bottom middle
    xcaption    = "",
    ymin        = 1,
    ymax        = 1,
    ystep       = 1,
    ysmall      = 0,
    ylarge      = 0,
  % xfirst      = 0,
  % xlast       = 0,
  % yfirst      = 0,
  % ylast       = 0,
    ylabels     = "no",
    yticks      = "left", % left right middle
    ycaption    = "",
    code        = "",
    close       = false,
    shape       = "curve",
    fillcolor   = "",
    drawsize    = 1,
    drawcolor   = "",
    frame       = "",     % yes ticks
    linewidth   = .05mm,
    pointsymbol = "",
    pointsize   = 2,
    pointcolor  = "",
    xarrow      = "",
    yarrow      = "",
    reverse     = false,
  % function    : metatable is parent
    axis        = "both",
] ;

def lmt_function = applyparameters "function" "lmt_do_function" enddef ;

vardef lmt_do_function_p(expr xmin, xmax, xstep, code, shape, close, fcolor, dsize, dcolor, psymbol, psize, pcolor) =
    save p, q ; path p, q ;
    p := lua.mp.lmt_function_x(xmin,xmax,xstep,code,shape) ;
    if close :
        q := (xmin,0) -- p -- (xmax,0) -- cycle ;
        fill q withcolor fcolor ;
    else :
        draw p withpen currentpen scaled dsize withcolor dcolor ;
    fi ;
    if psize > 0 :
        if psymbol = "dot" :
            draw image (
                for i = 0 upto length(p) :
                    draw point i of p ;
                endfor ;
            ) withpen currentpen scaled psize withcolor pcolor ;
        fi ;
    fi ;
enddef ;

vardef lmt_do_function =
    image (
        pushparameters "function" ;
        save sx, sy, lw, tl, tr, ts, tt, currentpen ; transform tr, tt ; pen currentpen ;
        sx := getparameter "sx" ;
        sy := getparameter "sy" ;
        lw := getparameter "linewidth" ;
        tl := 1/20 ; % tick length
        ts := 1/10 ; % text scale
        tr := identity xyscaled(10/sx,10/sy) ;
        tt := identity xyscaled(ts/sx,ts/sy) ;
        pickup pencircle xyscaled(lw/sx,lw/sy) ;
        draw image (
            save xmin, xmax, xstep, xsmall, xlarge, ymin, ymax, ystep, ysmall, ylarge, p ;
            save code, option, txl, txs, tyl, tys, swap, axis ;
            string code, option, shape, axis ;
            path txl, txs, tyl, tys ; boolean swap, close ;
            picture p ;

            xmin    := getparameter "xmin" ;
            xmax    := getparameter "xmax" ;
            xstep   := getparameter "xstep" ;
            xsmall  := getparameter "xsmall" ;
            xlarge  := getparameter "xlarge" ;
            ymin    := getparameter "ymin" ;
            ymax    := getparameter "ymax" ;
            ystep   := getparameter "ystep" ;
            ysmall  := getparameter "ysmall" ;
            ylarge  := getparameter "ylarge" ;
            code    := getparameter "code" ;
            swap    := getparameter "reverse" ;
            shape   := getparameter "shape" ;
            close   := getparameter "close" ;
            axis    := getparameter "axis" ;
            p := image (
                if (getparametercount "functions") > 0 :
                    for s = 1 upto getparametercount "functions" :
                        % todo: pushparameters with a metatable, here parent
                        pushparameters "functions" [s] ;
                        lmt_do_function_p (
                            (getparameterdefault "xmin"        xmin),
                            (getparameterdefault "xmax"        xmax),
                            (getparameterdefault "xstep"       xstep),
                            (getparameterdefault "code"        code),
                            (getparameterdefault "shape"       shape),
                            (getparameterdefault "close"       close),
                            (getparameterdefault "fillcolor"   (getparameter "fillcolor")),
                            (getparameterdefault "drawsize"    (getparameter "drawsize")),
                            (getparameterdefault "drawcolor"   (getparameter "drawcolor")),
                            (getparameterdefault "pointsymbol" (getparameter "pointsymbol")),
                            (getparameterdefault "pointsize"   (getparameter "pointsize")),
                            (getparameterdefault "pointcolor"  (getparameter "pointcolor"))
                        ) ;
                        popparameters ;
                    endfor ;
                elseif code <> "" :
                    lmt_do_function_p (
                        xmin,
                        xmax,
                        xstep,
                        code,
                        shape,
                        close,
                        getparameter "fillcolor",
                        getparameter "drawsize",
                        getparameter "drawcolor",
                        getparameter "pointsymbol",
                        getparameter "pointsize",
                        getparameter "pointcolor"
                    ) ;
                fi ;
            ) ;

            if not swap : draw p fi ;

if (axis = "") or (axis = "no") :
    % nothing
else :

    % todo: x y both

            option := getparameter "xticks" ;
            if option = "top" :
                txs := (0,0) -- (0,tl) ;
            elseif option = "bottom" :
                txs := (0,-tl) -- (0,0) ;
            else :
                txs := (0,-tl) -- (0,tl) ;
            fi ;

            option := getparameter "yticks" ;
            if option = "left" :
                tys := (-tl,0) -- (0,0) ;
            elseif option = "right" :
                tys := (0,0) -- (tl,0) ;
            else :
                tys := (-tl,0) -- (tl,0) ;
            fi ;

            txs := txs transformed tr ;
            tys := tys transformed tr ;
            txl := txs scaled 2 ;
            tyl := tys scaled 2 ;

            % this arrow head scaling is for Alan to sort out ...

            xmin := getparameterdefault "xfirst" xmin ;
            xmax := getparameterdefault "xlast"  xmax ;
            ymin := getparameterdefault "yfirst" ymin ;
            ymax := getparameterdefault "ylast"  ymax ;

            if hasoption "frame" "ticks,sticks" :
                if xsmall > 0 :
                    if hasoption "frame" "horizontal" :
                        for i = ymin step ((ymax-ymin)/ysmall) until ymax :
                            draw (xmin,i) -- (xmax,i) ;
                        endfor ;
                        dodraw (xmin,ymin) ; % flush snippets
                    fi ;
                fi ;
                if ysmall > 0 :
                    if hasoption "frame" "vertical" :
                        for i = xmin step ((xmax-xmin)/xsmall) until xmax :
                            draw (i,ymin) -- (i,ymax) ;
                        endfor ;
                        dodraw (xmin,ymin) ; % flush snippets
                    fi ;
                fi ;
            fi ;

            option := getparameter "xarrow" ;
            if option = "yes" :
                save ahlength ; ahlength  := tl ;
                % save ahangle  ; ahangle   := 100/sy ;
                drawarrow (xmin,0) -- (xmax,0) ;
            else :
                draw (xmin,0) -- (xmax,0) ;
            fi ;

            option := getparameter "yarrow" ;
            if option = "yes" :
                save ahlength ; ahlength := tl ;
                % save ahangle  ; ahangle  := 100/sx ;
                drawarrow (xmin,ymin) -- (xmin,ymax) ;
            else :
                draw (xmin,ymin) -- (xmin,ymax) ;
            fi ;

            if hasoption "frame" "yes" :
                draw (xmin,ymin) -- (xmax,ymin) -- (xmax,ymax) -- (xmin,ymax) -- cycle ;
            fi ;

            if hasoption "frame" "ticks,sticks" :
                if xsmall > 0 :
                    if hasoption "frame" "horizontal" :
                        for i = ymin step ((ymax-ymin)/ysmall) until ymax :
                            draw (xmin,i) -- (xmax,i) ;
                        endfor ;
                    fi ;
                    if hasoption "frame" "bottom" :
                        txs := ((0,0) -- (0,tl)) if hasoption "frame" "sticks" : rotated 180 fi ;
                        txs := txs transformed tr ;
                        for i = xmin step ((xmax-xmin)/xsmall) until xmax :
                            nodraw txs shifted (i,ymin) ;
                        endfor ;
                    fi ;
                    if hasoption "frame" "top" :
                        txs := (0,0) -- (0,-tl) if hasoption "frame" "sticks" : rotated 180 fi ;
                        txs := txs transformed tr ;
                        for i = xmin step ((xmax-xmin)/xsmall) until xmax :
                            nodraw txs shifted (i,ymax) ;
                        endfor ;
                    fi ;
                    dodraw (xmin,ymin) ; % flush snippets
                fi ;
                if ysmall > 0 :
                    if hasoption "frame" "vertical" :
                        for i = xmin step ((xmax-xmin)/xsmall) until xmax :
                            draw (i,ymin) -- (i,ymax) ;
                        endfor ;
                    fi ;
                    if hasoption "frame" "left" :
                        tys := (0,0) -- (tl,0) if hasoption "frame" "sticks" : rotated 180 fi ;
                        tys := tys transformed tr ;
                        for i = ymin step ((ymax-ymin)/ysmall) until ymax :
                            nodraw tys shifted (xmin,i) ;
                        endfor ;
                    fi ;
                    if hasoption "frame" "right" :
                        tys := (0,0) -- (-tl,0) if hasoption "frame" "sticks" : rotated 180 fi ;
                        tys := tys transformed tr ;
                        for i = ymin step ((ymax-ymin)/ysmall) until ymax :
                            nodraw tys shifted (xmax,i) ;
                        endfor ;
                    fi ;
                    dodraw (xmin,ymin) ; % flush snippets
                fi ;
            fi ;

            if xsmall > 0 :
                for i = xmin step xsmall until xmax :
                    nodraw txs shifted (i,0) ;
                endfor ;
            fi ;

            if xlarge > 0 :
                for i = xmin step xlarge until xmax :
                    nodraw txl shifted (i,0) ;
                endfor ;
                dodraw (xmin,0) ; % flush snippets
            elseif xsmall > 0 :
                dodraw (xmin,0) ; % flush snippets
            fi ;

            if ysmall > 0 :
                for i = ymin step ysmall until ymax :
                    nodraw tys shifted (xmin,i) ;
                endfor ;
            fi ;

            if ylarge > 0 :
                for i = ymin step ylarge until ymax :
                    nodraw tyl shifted (xmin,i) ;
                endfor ;
                dodraw (xmin,ymin) ; % flush snippets
            elseif ysmall > 0 :
                dodraw (xmin,ymin) ; % flush snippets
            fi ;

            if swap : draw p fi ;

            if xlarge > 0 :
                option := getparameter "xlabels" ;
                if option <> "no" :
                    for i = xmin step xlarge until xmax :
                        if ((i <> 0) and ((option <> "nolimits") or ((i > xmin) and (i < xmax)))) :
                            draw textext.bot(decimal i) transformed tt
                                shifted (i,1.25*(ypart point 0 of txl)) ;
                        fi ;
                    endfor ;
                fi ;
            fi ;

            if ylarge > 0 :
                option := getparameter "ylabels" ;
                if option <> "no" :
                    for i = ymin step ylarge until ymax :
                        if ((i <> 0) and ((option <> "nolimits") or ((i > ymin) and (i < ymax)))) :
                            draw textext.lft(decimal i) transformed tt
                                shifted (xmin+1.25*(xpart point 0 of tyl),i) ;
                        fi ;
                    endfor ;
                fi ;
            fi ;

            option := getparameter "xcaption" ;
            if (option <> "") :
                draw textext.bot(option) transformed tt
                    shifted (xmin,-tl)
                    shifted center bottomboundary currentpicture ;
            fi ;

            option := getparameter "ycaption" ;
            if (option <> "") :
                draw textext.lft(option) transformed tt
                    shifted (xmin-tl,0)
                    shifted center leftboundary currentpicture ;
            fi ;

fi ;
        )

        xyscaled(sx,sy) ;

        setbounds currentpicture to
            boundingbox currentpicture
            enlarged (getparameter "offset") ;

        popparameters ;
    )
enddef ;

% Don't use this one!

presetparameters "mesh" [
    trace = false,
    auto  = false,
    step  = 0.05,
  % box   = ...
  % paths = { ..., ..., ... }
] ;

def lmt_mesh = applyparameters "mesh" "lmt_do_mesh" enddef ;

vardef lmt_do_mesh =
    image (
        save p, b ; path p, b ;
        pushparameters "mesh" ;
        if getparameter "auto" :
            b := if hasparameter "box" : getparameter "box" else : OverlayBox fi ;
            for i=1 upto getparametercount "paths" :
                p := getparameter "paths" i ;
                p := meshed(p if not cycle p : -- cycle fi,b,getparameter "step") ;
                if getparameter "trace" :
                    draw p ;
                fi ;
                runscript("mp.lmt_mesh_update()") i p ;
            endfor ;
        elseif getparameter "trace" :
            for i=1 upto getparametercount "paths" :
                p := getparameter "paths" i ;
                draw p if not cycle p : -- cycle fi ;
            endfor ;
        fi ;
        popparameters ;
        runscript("mp.lmt_mesh_set()") ;
    )
enddef ;

vardef mfun_meshed_clipped(expr pat, box, pct) =
    pp := point (arctime pct of pat) of pat ;
    if (ypart pp <= lly) or (ypart pp >= ury) or (xpart pp <= llx) or (xpart pp >= urx) :
        (cp -- pp) intersection_point bb
    else :
        pp
    fi
enddef ;

vardef mfun_meshed_clipped(expr pat, box, pct) =
    pp := point (arctime pct of pat) of pat ;
    if     ypart pp <= lly :
        if xpart pp <= llx :
            (llx, lly)
        elseif xpart pp >= urx :
            (urx, lly)
        else :
            (xpart pp, lly)
        fi
    elseif ypart pp >= ury :
        if xpart pp <= llx :
            (llx, ury)
        elseif xpart pp >= urx :
            (urx, ury)
        else :
            (xpart pp, ury)
        fi
    elseif xpart pp <= llx :
        (llx, ypart pp)
    elseif xpart pp >= urx :
        (urx, ypart pp)
    else :
        pp
    fi
enddef ;

vardef meshed(expr pth, box, stp) =
    begingroup
    save cb, cp, llx, lly, urx, ury, pp, lp, bb ; pair cb, cp, pp ; path bb ;
    bb := box enlarged -1/10;
    cb := center bb ;
    cp := center pth ;
    llx := xpart llcorner bb;
    lly := ypart llcorner bb;
    urx := xpart urcorner bb;
    ury := ypart urcorner bb;
    lp := arclength pth ;
    for i=stp step stp until 1+stp/2 :
        cp --
        mfun_meshed_clipped(pth,bb,lp*(i-stp)) --
        mfun_meshed_clipped(pth,bb,lp*(i    )) --
        cp --
    endfor cycle
    endgroup
enddef ;

vardef OverlayMesh(expr p, s) =
    lmt_mesh [ paths = { meshed(p,OverlayBox,s) } ]
enddef ;

permanent meshed, OverlayMesh ;

% charts

presetparameters "chart" [
    originsize      = 1mm,
    trace           = false,
    showlabels      = true,
    showlegend      = true,
    showvalues      = false,
    showaxis        = false,
    center          = false,

    samples         = { },

    cumulative      = false,
    percentage      = false,
    maximum         = 0,
    distance        = 1mm,
    threshold       = eps,

  % labels          = { },
    labelstyle      = "",
    labelformat     = "",
  % labelstrut      = "auto",
  % labelanchor     = "",
  % labeloffset     = 0,
    labelfraction   = 0.8,
    labelcolor      = "",

    axisstyle       = "",
    axiscolor       = "",
    axisformat      = "",
    axislinewidth   = mm/5,
    axislinecolor   = "",

    valuestyle      = "",
    valuecolor      = "",
    valueformat     = "",

    backgroundcolor = "",
    drawcolor       = "white",
    fillcolors      = { % use color palet
        "darkred", "darkgreen", "darkblue",
        "darkyellow", "darkmagenta", "darkcyan",
        "darkgray"
    },
    linecolors      = { },
    colormode       = "global",

    linewidth       = .25mm,
  % linegap         = 0,

    legendcolor     = "",
    legendstyle     = "",
    legend          = { },
] ;

presetparameters "chart:circle" "chart" [
    height       = 5cm,
    width        = 5mm,
    innerradius  = 0,
    initialangle = 0, % -90 == top
    labelanchor  = "",
    labeloffset  = 0,
    labelstrut   = "no",
] ;

presetparameters "chart:histogram" "chart" [
    height      = 5cm,
    width       = 5mm,
    labelanchor = "bot",
    labeloffset = 1mm,
    labelstrut  = "auto",
] ;

presetparameters "chart:bar" "chart" [
    height      = 5mm,
    width       = 5cm,
    labelanchor = "lft",
    labeloffset = 1mm,
    labelstrut  = "no",
] ;

def lmt_chart_circle    = applyparameters "chart:circle"    "lmt_do_chart_circle"    enddef ;
def lmt_chart_histogram = applyparameters "chart:histogram" "lmt_do_chart_histogram" enddef ;
def lmt_chart_bar       = applyparameters "chart:bar"       "lmt_do_chart_bar"       enddef ;

def lmt_do_chart_start (expr what) =
    pushparameters what ;
    save width, height, depth, distance,
        threshold,
        linewidth, linegap,
        value, nofsamples, nofsamplesets,
        fillcolor, linecolor, drawcolor,
        labelcolor, labelstyle, labelformat, labelgap, labelfraction, labelstrut, labelanchor,
        axiscolor, axisstyle, axisformat, axisgap, axislinewidth, axislinecolor,
        valuecolor, valuestyle, valueformat, valuegap,
        colormode ;
    string fillcolor, linecolor, drawcolor,
        labelcolor, labelstyle, labelformat, labelstrut, labelanchor,
        axiscolor, axisstyle, axisformat, axislinecolor,
        valuecolor, valuestyle, valueformat,
        colormode ;
    if hasparameter "sampleset" :
        setluaparameter what "samples" (getparameter "sampleset") ;
    fi ;

    threshold     := getparameter "threshold" ;
    colormode     := getparameter "colormode" ;

    linewidth     := getparameter "linewidth" ;
    linegap       := getparameterdefault "linegap" linewidth ;

    height        := getparameter "height" ;
    depth         := max(getparameter "originsize", (getparameter "innerradius"), 8*linewidth) ;
    width         := getparameter "width" ;
    distance      := getparameter "distance" ;

    drawcolor     := getparameter "drawcolor" ;

    labelcolor    := getparameter "labelcolor" ;
    labelstyle    := getparameter "labelstyle" ;
    labelformat   := getparameter "labelformat" ;
    labelgap      := getparameter "labeloffset" ;
    labelstrut    := getparameter "labelstrut" ;
    labelanchor   := getparameter "labelanchor" ;
    labelfraction := getparameter "labelfraction" ;

    axiscolor     := getparameter "axiscolor" ;
    axisstyle     := getparameter "axisstyle" ;
    axisformat    := getparameter "axisformat" ;
    axisgap       := getparameter "axisoffset" ;
    axislinewidth := getparameter "axislinewidth" ;
    axislinecolor := getparameter "axislinecolor" ;

    valuecolor    := getparameter "valuecolor" ;
    valuestyle    := getparameter "valuestyle" ;
    valueformat   := getparameter "valueformat" ;
    valuegap      := getparameter "valueoffset" ;

    nofsamplesets := getparametercount "samples" ;
    nofsamples    := getmaxparametercount "samples" ;
enddef ;

def lmt_do_chart_stop =
    if getparameter "center" :
        currentpicture := currentpicture shifted - center currentpicture ;
    fi
    if (getparameter "backgroundcolor") <> "" :
        addbackground withcolor getparameter "backgroundcolor" ;
    fi
    if getparameter "trace" :
        save b ; path b ; b := boundingbox currentpicture ;
        draw image (
            draw fullcircle scaled 1mm ;
            draw b
        )
        dashed evenly scaled 1/4
        withpen pencircle scaled .125mm
        withcolor "darkgray" ;
    fi
    popparameters ;
enddef ;

vardef lmt_do_chart_text(expr s, i, value) =
    lmt_text [
        style      = labelstyle,
        format     = labelformat,
        strut      = labelstrut,
        anchor     = labelanchor,
        offset     = labelgap,
        color      = labelcolor,
        text       = (getparameterdefault "labels" s i (decimal value))
        background = "",
    ]
enddef ;

def lmt_do_chart_legend =
    if getparameter "showlegend" :
        n := getparametercount "legend" ;
        if n > 0 :
            save dx, dy, p, l, w, o, d, ddy ; picture l ;
            dx := xpart urcorner currentpicture + EmWidth ;
            dy := ypart urcorner currentpicture ;
            labelcolor := getparameter "legendcolor" ;
            labelstyle := getparameter "legendstyle" ;
            w := 2EmWidth ;
            o := .25EmWidth ;
            d := ExHeight ;
            ddy := .8LineHeight ;
            for i=1 upto n :
                dy := dy - ddy ;
                l := lmt_text [
                    text       = getparameter "legend" i,
                    anchor     = "rt"
                    style      = labelstyle,
                    color      = labelcolor,
                    background = "",
                ] ;
                fill leftboundary l rightenlarged w
                    shifted (dx,dy+d)
                    withcolor getparameter "fillcolors" i ;
                draw l
                    shifted (dx+w+o,dy+d) ;
            endfor ;
        fi ;
    fi ;
enddef ;

% draw lmt_chart_circle [
%     height       = 4cm,
%     innerradius  = 2.0cm,
%     samples      = { { 10, 20, 30, 40, 50 } },
%     percentage   = false,
%     initialangle = 90,
%     linewidth    = .125mm,
%     originsize   = 0,
%     showlabels   = false,
%     drawcolor    = "white",
%     fillcolors   = { "red",     "green",  "blue",     "",       "cyan" },
%     linecolors   = { "magenta", "orange", "darkgray", "orange", "darkgray" }
%     linecolors   = { "",        "orange", "",         "orange", "" }
% ] ;

vardef lmt_do_chart_circle =
    image (
        lmt_do_chart_start("chart:circle") ;
        if (nofsamplesets > 0) and (nofsamples > 0) :
            nofsamplesets := 1 ;
            save p, q, r, s, t, pl, ql, first, last, total, factor, n, percentage, initial, clockwise ;
            path p, q, r, s[], t[] ; boolean percentage, clockwise ;
            save value, v;
            clockwise := true ;
            percentage := getparameter "percentage" ;
            initial := if not clockwise : - fi getparameter "initialangle" ; % watch sign
            total := 0 ;
            for i = 1 upto nofsamples :
                value := getparameter "samples" (1) i ;
                if value > threshold :
                    total := total + value ;
                fi ;
            endfor ;
            if total = 0 :
                message("zero total in circular chart");
            else :
                factor := 100/total ;
                first := initial ;
                if clockwise :
                    p := (reverse fullcircle rotated first) ysized (height) ;
                    q := (reverse fullcircle rotated first) ysized (depth) ;
                else :
                    p := fullcircle ysized (height) ;
                    q := fullcircle ysized (depth) ;
                fi ;
                r := origin -- (2*height,0) ;
                pl := ((linewidth + linegap) / (arclength p)) * 360;
                ql := ((linewidth + linegap) / (arclength q)) * 360;
                v := 0 ;
                for i = 1 upto nofsamples :
                    value := getparameter "samples" (1) i ;
                    if value > threshold :
                        v := v + 1 ;
                        fillcolor := getparameter "fillcolors" i ;
                        linecolor := getparameterdefault "linecolors" i "" ;
                        if linecolor = "" :
                            linecolor := fillcolor ;
                        fi ;
                        value := value * factor ;
                        last := first if clockwise : - else : + fi (360/100) * value ;
                        s[v] :=         ((p cutbefore (r rotated first)) cutafter (r rotated (last + pl))) ;
                        t[v] := reverse ((q cutbefore (r rotated first)) cutafter (r rotated (last + ql))) ;
                        path piece ; piece := s[v] -- t[v] -- cycle ;
                        if fillcolor <> "" :
                            fill piece
                                withpen pencircle scaled linewidth
                                withcolor fillcolor
                            ;
                        fi ;
                        if linecolor <> "" :
                            if linewidth > 0 :
                                interim linecap := butt ;
                                draw piece
                                    withpen pencircle scaled linewidth
                                    withcolor if linecolor <> "" : linecolor else drawcolor : fi
                                ;
                            fi ;
                        fi ;
                        first := last ;
                    fi ;
                endfor ;
                if linewidth > 0 :
                    clip currentpicture to p enlarged linewidth ;
                fi ;
                if getparameter "showlabels" :
                    first := initial ;
                    v := 0 ;
                    for i = 1 upto nofsamples :
                        value := getparameter "samples" (1) i ;
                        if value > threshold :
                            v := v + 1 ;
                            last := first if clockwise : - else : + fi (360/100) * value * factor ;
                            draw lmt_do_chart_text (s,i,value)
                                shifted ((labelfraction*(height/2),0) rotated ((first+last)/2)) ;
                            first := last ;
                        fi
                    endfor ;
                fi ;
                lmt_do_chart_legend ;
            fi ;
        fi ;
        lmt_do_chart_stop ;
    )
enddef ;

vardef lmt_do_chart_histogram =
    image (
        lmt_do_chart_start("chart:histogram") ;
        if (nofsamplesets > 0) and (nofsamples > 0) :
            save value, maximum, cumulative, maxwidth ; boolean cumulative ;
            maximum := getparameter "maximum" ;
            cumulative := getparameter "cumulative" ;
            if labelanchor = "center" :
                labelanchor := "vcenter" ;
            fi ;
            if maximum = 0 :
                for s = 1 upto nofsamplesets :
                    for i = 1 upto nofsamples :
                        value := getparameter "samples" s i ;
                        maximum := if cumulative :
                            maximum + value ;
                        else :
                            max(maximum,value) ;
                        fi ;
                    endfor ;
                endfor ;
            fi ;
            if nofsamplesets = 1 :
                distance := 0 ;
            fi ;
            maxwidth := nofsamplesets * nofsamples * width + (nofsamples - 1)* distance ;
            value := 0 ;
            for s = 1 upto nofsamplesets :
                for i = 1 upto nofsamples :
                    value := if cumulative : value + fi (getparameter "samples" s i) * height / maximum ;
                    fill unitsquare xyscaled (width,value)
                        if linewidth > 0 :
                            if i > 1          : leftenlarged  (-linewidth/2) fi
                            if i < nofsamples : rightenlarged (-linewidth/2) fi
                        fi
                        shifted (nofsamplesets*(i-1)*width+(s-1)*width+(i-1)*distance,0)
                        withcolor getparameter "fillcolors" if colormode = "local" : s else : i fi ;
                endfor ;
            endfor ;
            setbounds currentpicture to unitsquare xyscaled (maxwidth,height) ;
            if getparameter "showlabels" :
                for s = 1 upto nofsamplesets :
                    for i = 1 upto nofsamples :
                        draw lmt_do_chart_text (s,i,getparameter "samples" s i)
                            shifted (nofsamplesets*((i-1)*width)+width/2+(s-1)*width+(i-1)*distance,0) ;
                    endfor ;
                endfor ;
            fi ;
            lmt_do_chart_legend ;
        fi ;
        lmt_do_chart_stop ;
    )
enddef ;

vardef lmt_do_chart_bar =

    image (
        lmt_do_chart_start("chart:bar") ;
        if (nofsamplesets > 0) and (nofsamples > 0) :
            save value, maximum, cumulative, maxheight ; boolean cumulative ;
            maximum := getparameter "maximum" ;
            cumulative := getparameter "cumulative" ;
            if labelanchor = "center" :
                labelanchor := "hcenter" ;
            fi ;
            if maximum = 0 :
                for s = 1 upto nofsamplesets :
                    for i = 1 upto nofsamples :
                        value := getparameter "samples" s i ;
                        maximum := if cumulative : maximum + value else : max(maximum,value) fi ;
                    endfor ;
                endfor ;
            fi ;
            if nofsamplesets = 1 :
                distance := 0 ;
            fi ;
            maxheight := nofsamplesets * nofsamples * height + (nofsamples - 1)* distance ;
            for s = 1 upto nofsamplesets :
                value := 0 ;
                for i = 1 upto nofsamples :
                    value := if cumulative : value + fi (getparameter "samples" s i) * width / maximum ;
                    fill unitsquare xyscaled (value,height)
                        if linewidth > 0 :
                            if i > 1          : topenlarged    (-linewidth/2) fi
                            if i < nofsamples : bottomenlarged (-linewidth/2) fi
                        fi
                        shifted (0,maxheight-nofsamplesets*i*height+(s-1)*height-(i-1)*distance)
                        withcolor getparameter "fillcolors" if colormode = "local" : s else : i fi ;
                endfor ;
            endfor ;
            setbounds currentpicture to unitsquare xyscaled (width,maxheight) ;
            if getparameter "showlabels" :
                for s = 1 upto nofsamplesets :
                    for i = 1 upto nofsamples :
                        draw lmt_do_chart_text (s,i,getparameter "samples" s i)
                            shifted (0,maxheight-nofsamplesets*(i*height)+height/2+(s-1)*height-(i-1)*distance) ;
                    endfor ;
                endfor ;
            fi ;
            lmt_do_chart_legend ;
        fi ;
        lmt_do_chart_stop ;
    )
enddef ;

%D This one is more complex than needed but I want to trace so I need all those
%D variables.

presetparameters "shade" [
    alternative = "circular",
    path        = origin -- cycle,
    trace       = false

 %  alternative = "circular" | "linear"
 %  domain      = { a, b }
 %  radius      = a | { a, b }
 %  factor      = a
 %  origin      = (a,b) | { (a,b), {c, d) }
 %  vector      = { a, b }
 %  colors      = { a, b }
 %  center      = a | { a, b }
 %  direction   = "up" | "down" | "left" | "right" | { a, b }

] ;

% TODO: pass colors as strings

def lmt_shade = applyparameters "shade" "lmt_do_shade" enddef ;

vardef lmt_do_shade =
    image (
        pushparameters "shade" ;

        save domain_min, domain_max, radius_a, radius_b, factor ;
        save color_a, color_b, center_a, center_b, alternative, s ;
        string color_a, color_b, alternative, s ; pair center_a, center_b ;

        alternative := getparameter "alternative" ;

        mfun_with_shade_method_analyze(getparameter "path") ;

        domain_min := 0 ;
        domain_max := 1 ;

        color_a := "white" ;
        color_b := "black" ;

        if alternative = "circular" :
            center_a := center mfun_shade_path ;
            center_b := center_a ;
            radius_a := 0 ;
            radius_b := mfun_max_radius(mfun_shade_path) ;
            factor   := 1.2 ;
        else :
            center_a := llcorner mfun_shade_path ;
            center_b := urcorner mfun_shade_path ;
            radius_a := 0 ;
            radius_b := 0 ;
            factor   := 0;
        fi ;

        if hasparameter "domain" :
            domain_min := getparameter "domain" 1 ;
            domain_max := getparameter "domain" 2 ;
        fi
        if hasparameter "radius" :
            if numeric getparameter "radius" :
                radius_a := 0 ;
                radius_b := getparameter "radius" ;
            elseif string getparameter "radius" :
                if (getparameter "radius") = "auto" :
                    radius_a := 0 ;
                    radius_b := (max(bbwidth(mfun_shade_path),bbheight(mfun_shade_path))/2)/sqrt(2) ;
                fi
            else :
                radius_a := getparameter "radius" 1 ;
                radius_b := getparameter "radius" 2 ;
            fi ;
            factor := 1 ;
        fi
        if hasparameter "factor" :
            factor := getparameter "factor" ;
        fi
        if hasparameter "origin" :
            if pair getparameter "origin" :
                center_a := getparameter "origin" ;
                center_b := center_b ;
            else :
                center_a := getparameter "origin" 1 ;
                center_b := getparameter "origin" 2 ;
            fi ;
        fi
        if hasparameter "colors" :
            color_a := getparameter "colors" 1 ;
            color_b := getparameter "colors" 2 ;
        fi
        if hasparameter "direction" :
            save a, b, bb, temp_x, temp_y ; path bb ;
            temp_x := temp_y := 0 ;
            bb := boundingbox(mfun_shade_path) ;
            a := b := -1 ;
            if string getparameter "direction" :
                s := getparameter "direction" ;
                if     s = "up"    :
                    temp_x := xpart shadedup ;
                    temp_y := ypart shadedup ;
                elseif s = "down"  :
                    temp_x := xpart shadeddown ;
                    temp_y := ypart shadeddown ;
                elseif s = "left"  :
                    temp_x := xpart shadedleft ;
                    temp_y := ypart shadedleft ;
                elseif s = "right" :
                    temp_x := xpart shadedright ;
                    temp_y := ypart shadedright ;
                fi
            else :
                temp_x := getparameter "direction" 1 ;
                temp_y := getparameter "direction" 2 ;
            fi
            if temp_x >= 0 :
                center_a := point temp_x of bb ;
            fi
            if temp_y >= 0 :
                center_b := point temp_y of bb ;
            fi
        fi ;
        if hasparameter "center" :
            save cx, cy ;
            if numeric getparameter "center" :
                cx := getparameter "center" ;
                cx := cy ;
          % elseif pair getparameter "center" :
          %     cx := xpart getparameter "center" ;
          %     cy := ypart getparameter "center" ;
            else :
                cx := getparameter "center" 1 ;
                cy := getparameter "center" 2 ;
            fi
            % we can use a bbox instead and save a calculation
            center_a := center mfun_shade_path shifted (
                cx * bbwidth (mfun_shade_path)/2,
                cy * bbheight(mfun_shade_path)/2
            ) ;
        elseif hasparameter "vector" :
            center_a := point (getparameter "vector" 1) of mfun_shade_path ;
            center_b := point (getparameter "vector" 2) of mfun_shade_path ;
        fi
        fill mfun_shade_path
            withprescript "sh_domain=" & decimal domain_min & " " & decimal domain_max
            withprescript "sh_transform=yes"
            withprescript "sh_color=into"
            withprescript "sh_color_a=" & colordecimals color_a
            withprescript "sh_color_b=" & colordecimals color_b
            withprescript "sh_first=" & ddecimal point 0 of mfun_shade_path % used for support scaling
            withprescript "sh_set_x=" & ddecimal (mfun_shade_nx,mfun_shade_lx) %
            withprescript "sh_set_y=" & ddecimal (mfun_shade_ny,mfun_shade_ly) %
            if alternative = "linear" :
                withprescript "sh_type=linear"
             %  withprescript "sh_factor=1"
                withprescript "sh_factor=" & decimal factor
                withprescript "sh_center_a=" & ddecimal center_a
                withprescript "sh_center_b=" & ddecimal center_b
            else :
                withprescript "sh_type=circular"
              % withprescript "sh_factor=1.2"
                withprescript "sh_factor=" & decimal factor
                withprescript "sh_center_a=" & ddecimal center_a
                withprescript "sh_center_b=" & ddecimal center_b
                withprescript "sh_radius_a=" & decimal radius_a
                withprescript "sh_radius_b=" & decimal radius_b
            fi ;
        if getparameter "trace" :
            draw fullcircle scaled 1mm shifted center_a ;
            draw fullsquare scaled 2mm shifted center_b ;
            draw textext.top("\strut\ttx center a") ysized LineHeight shifted center_a shifted (0, 2mm) ;
            draw textext.bot("\strut\ttx center b") ysized LineHeight shifted center_b shifted (0,-2mm) ;
            if alternative = "circular" :
%                 draw fullcircle scaled (         radius_a * 2) shifted  center_a dashed evenly ;
%                 draw fullcircle scaled (factor * radius_b * 2) shifted -center_b dashed evenly ;
                draw fullcircle scaled (         radius_a) shifted  center_a dashed evenly ;
                draw fullcircle scaled (factor * radius_b) shifted -center_b dashed evenly ;
            fi
        fi
        popparameters ;
    )
enddef ;

% This is very experimental and will first be tested by a few users who
% are interested in this.

presetparameters "contour" [
    xmin             = 0,
    xmax             = 0,
    ymin             = 0,
    ymax             = 0,
    xstep            = 0,
    ystep            = 0,
    levels           = 10,
  % colors           = { },          % used when set
    preamble         = "",
    function         = "x + y",
    color            = "lin(l)",     % l/n
    background       = "bitmap",     % bitmap | shape | band
    foreground       = "auto",       % cell| edge | shape | auto: bitmap/edge shape/shape
    linewidth        = .25,
    backgroundcolor  = "black",
    linecolor        = "gray",
    xformat          = "@0.2N",
    yformat          = "@0.2N",
    zformat          = "@0.2N",
    xstyle           = "",
    ystyle           = "",
    zstyle           = "",

    width            = 0,            % auto when 0
    height           = 0,            % auto when 0

    trace            = false,
    checkresult      = false,
    defaultnan       = 0,
    defaultinf       = 0,

    legend           = "all",  % x | y | z | function | range | all (but range)
    legendheight     = LineHeight,
    legendwidth      = LineHeight,
    legendgap        = 0,
    legenddistance   = EmWidth,
    textdistance     = 2EmWidth/3,
    functiondistance = ExHeight,
    functionstyle    = "",

    level            = 4096,        % for selecting one (can't be too large for scaled)

    axisdistance     = ExHeight,
    axislinewidth    = .25,
    axisoffset       = ExHeight/4,
    axiscolor        = "black",
    ticklength       = ExHeight,

    xtick            = 5,
    ytick            = 5,
    xlabel           = 5,
    ylabel           = 5,

] ;

% we can as well push ...

def lmt_contour = applyparameters "contour" "lmt_do_contour" enddef ;

def mfun_only_draw          = addto currentpicture doublepath enddef ;
def mfun_only_fill          = addto currentpicture contour    enddef ;
def mfun_only_fillup text t = addto currentpicture doublepath t withpostscript "both"    enddef ;
def mfun_only_nodraw text t = addto currentpicture doublepath t withpostscript "collect" enddef ;
def mfun_only_nofill text t = addto currentpicture contour    t withpostscript "evenodd" enddef ;
def mfun_only_eofill text t = addto currentpicture contour    t withpostscript "collect" enddef ;

def lmt_do_contour_shortcuts =
    save D ; let D = mfun_only_draw   ;
    save E ; let E = mfun_only_eofill ;
    save F ; let F = mfun_only_fill   ;
    save U ; let U = mfun_only_fillup ;
    save d ; let d = mfun_only_nodraw ;
    save e ; let f = mfun_only_eofill ;
    save f ; let f = mfun_only_nofill ;
    save C ; let C = cycle ;
    save B ; let B = controls ;
    save A ; let A = and ;
enddef ;

def lmt_do_contour_band =
    lua.mp.lmt_contours_edge_set_by_band() ;
    for v=1 upto lua.mp.lmt_contours_nofvalues() :
        draw image (
            lua.mp.lmt_contours_edge_get_band(v) ;
        )
            withcolor lua.mp.lmt_contours_color(v) ;
    endfor ;
enddef;

def lmt_do_contour_cell(expr dx,dy) =
    lua.mp.lmt_contours_edge_set_by_cell() ;
    draw image (
        if level = 4096 :
            for v=1+1 upto lua.mp.lmt_contours_nofvalues() :
                lua.mp.lmt_contours_edge_get_cell(v) ;
            endfor ;
        else :
            lua.mp.lmt_contours_edge_get_cell(level) ;
        fi
    )
        if (dx <>0) or (dy <> 0) : shifted (dx,dy) fi
        withcolor getparameter "linecolor"
        withpen pencircle scaled getparameter "linewidth" ;
enddef ;

def lmt_do_contour_edge(expr dx, dy) =
    lua.mp.lmt_contours_edge_set() ;
    draw image (
        if level = 4096 :
            for v=1+1 upto lua.mp.lmt_contours_nofvalues() :
                lua.mp.lmt_contours_edge_paths(v);
            endfor ;
        else :
            lua.mp.lmt_contours_edge_paths(level);
        fi
    )
        if (dx <>0) or (dy <> 0) : shifted (dx,dy) fi
        withcolor getparameter "linecolor"
        withpen pencircle scaled getparameter "linewidth" ;
enddef ;

def lmt_do_contour_edges(expr dx, dy) =
    lua.mp.lmt_contours_edge_set() ;
    if level = 4096 :
        for v=1+1 upto lua.mp.lmt_contours_nofvalues() :
            draw image (
                lua.mp.lmt_contours_edge_paths(v);
            )
            if (dx <>0) or (dy <> 0) : shifted (dx,dy) fi
            withpen pencircle scaled getparameter "linewidth"
            withcolor lua.mp.lmt_contours_color(v) ;
        endfor ;
    else :
        draw image (
            lua.mp.lmt_contours_edge_paths(level);
        )
        if (dx <>0) or (dy <> 0) : shifted (dx,dy) fi
        withpen pencircle scaled getparameter "linewidth"
        withcolor lua.mp.lmt_contours_color(level) ;
    fi ;
enddef ;

def lmt_do_contour_cells(expr dx, dy) =
    lua.mp.lmt_contours_edge_set_by_cell() ;
    if level = 4096 :
        for v=1+1 upto lua.mp.lmt_contours_nofvalues() :
            draw image (
                lua.mp.lmt_contours_edge_get_cell(v) ;
            )
        if (dx <>0) or (dy <> 0) : shifted (dx,dy) fi
            withpen pencircle scaled getparameter "linewidth"
            withcolor lua.mp.lmt_contours_color(v) ;
        endfor ;
    else :
        draw image (
            lua.mp.lmt_contours_edge_get_cell(level) ;
        )
        if offset : shifted (-1/2,-1/2) fi
        withpen pencircle scaled getparameter "linewidth"
        withcolor lua.mp.lmt_contours_color(v) ;
    fi ;
enddef ;

def lmt_do_contour_shape(expr dx, dy) =
    draw image (
        if level = 4096 :
            for v=1+1 upto lua.mp.lmt_contours_nofvalues() :
                lua.mp.lmt_contours_shape_paths(v);
            endfor ;
        else :
            lua.mp.lmt_contours_shape_paths(level);
            lua.mp.lmt_contours_shape_paths(1);
        fi
    )
        if (dx <>0) or (dy <> 0) : shifted (dx,dy) fi
        withcolor getparameter "linecolor"
        withpen pencircle scaled getparameter "linewidth" ;
enddef ;

def lmt_do_contour_bitmap =
    lua.mp.lmt_contours_bitmap_set() ;
    lua.mp.lmt_contours_bitmap_get() ;
enddef ;

def lmt_do_contour_shades(expr outlines) =
    lua.mp.lmt_contours_shade_set(outlines) ;
    if level = 4096 :
        for v=1 upto lua.mp.lmt_contours_nofvalues() : % no + 1 here
            draw image (
                lua.mp.lmt_contours_shade_paths(v) ;
            )
            withpen pencircle scaled 0
            withcolor lua.mp.lmt_contours_color(v) ;
        endfor ;
    else :
        draw image (
            lua.mp.lmt_contours_shade_paths(level);
        )
        withpen pencircle scaled 0
        withcolor lua.mp.lmt_contours_color(level) ;
    fi ;
enddef ;

def lmt_load_mlib_cnt =
    runscript("lua.registercode('mlib-cnt')");
    extra_beginfig := extra_beginfig & % todo: use different hook
        "runscript(" & ditto & "mp.lmt_contours_cleanup()" & ditto & ")" ;
    let lmt_load_mlib_cnt = relax ;
enddef ;

vardef lmt_do_contour =
    image (

        lmt_load_mlib_cnt ;

        pushparameters "contour" ;

        lua.mp.lmt_contours_start() ;

        % graphic

        save bg, fg, nx, ny, trace, level, b, done ; string bg, fg ; boolean trace, done ; path b ;

        bg    := getparameter "background" ;
        fg    := getparameter "foreground" ;
        nx    := lua.mp.lmt_contours_nx() ;
        ny    := lua.mp.lmt_contours_ny() ;
        trace := getparameter "trace" ;
        level := getparameter "level" ;
        done  := true ;

        begingroup ;

            lmt_do_contour_shortcuts ;

            if bg = "band" :
                lmt_do_contour_band ;
                b := boundingbox currentpicture ;
                if (fg = "auto") or (fg = "cell") :
                    lmt_do_contour_cell(0,0) ;
                elseif (fg = "edge") :
                    lmt_do_contour_edge(0,0) ; % true ?
                fi ;

            elseif bg = "bitmap" :

                lmt_do_contour_bitmap ;
                b := boundingbox currentpicture ;
                if (fg = "auto") or (fg = "cell") :
                    lmt_do_contour_cell(-1/2,-1/2) ;
                elseif (fg = "edge") :
                    lmt_do_contour_edge(-1/2,-1/2) ;
                fi ;

            elseif bg = "shape" :

                lmt_do_contour_shades((fg = "auto") or (fg = "shape")) ;
                b := boundingbox currentpicture ;
                if (fg == "auto") or (fg = "shape") :
                    lmt_do_contour_shape(0,0) ;
                elseif fg == "cell" :
                    lmt_do_contour_cell(-1,-1) ;
                elseif fg == "edge" :
                    lmt_do_contour_edge(-1,-1) ;
                fi ;

                % currentpicture := currentpicture reflectedabout ( (0, ny/2), (nx,ny/2) ) ;

            elseif fg = "cell" :

                lmt_do_contour_shortcuts ;
                lmt_do_contour_cells(0,0) ;
                b := boundingbox currentpicture ;

            elseif fg = "edge" :

                lmt_do_contour_shortcuts ;
                lmt_do_contour_edges(0,0) ;
                b := boundingbox currentpicture ;

            else :

                done := false ;

            fi ;

        endgroup ;

        if done :

            save w, h, cx, cy ;

            cx := - bbwidth (b)/(nx - 1) ;
            cy := - bbheight(b)/(ny - 1) ;
            clip currentpicture to b
                leftenlarged cx rightenlarged  cx
                topenlarged  cy bottomenlarged cy ;
            currentpicture := currentpicture
                shifted (cx,cy) ;

            w := getparameter "width" ;
            h := getparameter "height" ;

            % axis

            save xtic, ytic, auto ; boolean auto ;

            xtic   := getparameter "xtick" ;
            ytic   := getparameter "ytick" ;
            auto   := (w = 0) and (h = 0) ;

            % resize

            if w <> 0 :
                if h <> 0 :
                    currentpicture := currentpicture xysized (w,h) ;
                else :
                    currentpicture := currentpicture xsized w ;
                fi ;
            elseif h <> 0 :
                currentpicture := currentpicture ysized h ;
            fi ;
            if w = 0 :
                w := bbwidth(currentpicture) ;
            fi ;
            if h = 0 :
                h := bbheight(currentpicture) ;
            fi ;

            % legend

            if hasoption "legend" "all,x,y,z,range" :

                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 ;

                % move some in the ifs

                if hasoption "legend" "all,z" :

                    % colorbar

                    fmt  := lua.mp.lmt_contours_format() ;
                    pmin := lmt_text [ format = fmt, text = decimal lua.mp.lmt_contours_minmean() ] ;
                    pmax := lmt_text [ format = fmt, text = decimal lua.mp.lmt_contours_maxmean() ] ;
                    wx   := max(bbwidth(pmin),bbwidth(pmax)) ;
                    hx   := bbheight(pmin) ;

                else :

                    hx   := 0;

                fi ;

                if auto :
                  % u  := 1 ;
                    u := lua.mp.lmt_contours_ny() / 100 ;
                    ry := 4u ;
                    sy := 5u ;
                    sx := 5u ;
                    lg := 0 ;
                    ox := 5u ;
                    oy := - sy/2 + ry/2 ;
                    tx := 2u ;
                    ty := 1u ;
                    ax := 1u ;
                    ay := 1u ;
                    ao := u ;
                    al := u/8 ;
                    at := 3u/2 ;
                    al := u/4 ;
                else :
                    ry := 0 ;
                    sy := getparameter "legendheight" ;
                    sx := getparameter "legendwidth" ;
                    lg := getparameter "legendgap" ;
                    ox := getparameter "legenddistance" ;
                    oy := - sy/2 + hx/2 ;
                    tx := getparameter "textdistance" ;
                    ty := getparameter "functiondistance" ;
                    ax := getparameter "axisdistance" ;
                    ay := ax ;
                    ao := getparameter "axisoffset" ;
                    at := getparameter "ticklength" ;
                    al := getparameter "axislinewidth" ;
                fi ;

                if hasoption "legend" "all,z" :

                    save dy ; dy := h ;

                    for v=1 upto lua.mp.lmt_contours_nofvalues() :
                        dy := dy - sy ;
                        fill unitsquare xyscaled (sx,sy)
                            shifted (w+ox,dy)
                            withcolor lua.mp.lmt_contours_color(v) ;
                        draw
                            lmt_text [
                                trace      = trace,
                                anchor     = "llft",
                                format     = fmt,
                                text       = decimal lua.mp.lmt_contours_value(v),
                                style      = getparameter "zstyle",
                                position   = (wx,0),
                                background = "",
                            ]
                            if ry <> 0 : ysized (ry) fi
                            shifted (w+ox+tx+sx,dy+sy+oy)
                        ;
                        dy := dy - lg ;
                    endfor ;

                fi ;

                if hasoption "legend" "x,all" :

                    save n, d, s, xmin, xmax, xlab ;

                    xmin := getparameter "xmin" ;
                    xmax := getparameter "xmax" ;
                    xlab := getparameter "xlabel" ;

                    draw image (
                        interim linecap := butt ;
                        draw ((0,0) -- (w,0)) ;
                        n := al/2 ; s := (w - al) / xtic ; d := (xmax - xmin) / xtic ;
                        for i=xmin step d until xmax :
                            draw (n,0) -- (n,-at) ;
                            n := n + s ;
                        endfor ;
                    )  shifted (0,-ay)
                        withpen pencircle scaled al
                        withcolor getparameter "axiscolor"
                    ;

                    if hasoption "legend" "label,all" :

                        draw image (
                            n := al/2 ; s := (w - al) / xlab ; d := (xmax - xmin) / xlab ;
                            for i=xmin step d until xmax :
                                draw lmt_text [
                                    trace      = trace,
                                    anchor     = "bot",
                                    format     = getparameter "xformat",
                                    style      = getparameter "xstyle",
                                    text       = decimal i
                                    background = "",
                                ]
                                    if ry <> 0 : ysized (ry) fi
                                    shifted (n,-at-ao)
                                ;
                                n := n + s ;
                            endfor ;
                        )  shifted (0,-ay) ;

                    fi ;

                fi ;

                if hasoption "legend" "y,all" :

                    save n, d, s, ymin, ymax, ylab ;

                    ymin := getparameter "ymin" ;
                    ymax := getparameter "ymax" ;
                    ylab := getparameter "ylabel" ;

                    draw image (
                        interim linecap := butt ;
                        draw ((0,0) -- (0,h)) ;
                        n := al/2 ; s := (h - al) / ytic ; d := (ymax - ymin) / ytic ;
                        for i=ymin step d until ymax :
                            draw (0,n) -- (-at,n) ;
                            n := n + s ;
                        endfor ;
                    )  shifted (-ax,0)
                        withpen pencircle scaled al
                        withcolor getparameter "axiscolor" ;
                    ;

                    if hasoption "legend" "label,all" :

                        draw image (
                            n := al/2 ; s := (h - al) / ylab ; d := (ymax - ymin) / ylab ;
                            for i=ymin step d until ymax :
                                draw lmt_text [
                                    trace      = trace,
                                    anchor     = "lft",
                                    format     = getparameter "yformat",
                                    style      = getparameter "ystyle",
                                    text       = decimal i
                                    background = "",
                                ]
                                    if ry <> 0 : ysized (ry) fi
                                    shifted (-at-ao,n)
                                ;
                                n := n + s ;
                            endfor ;
                        )  shifted (-ax,0) ;

                    fi ;

                fi ;

                if hasoption "legend" "range,all" :

                    % range

                    save d ; d := ypart llcorner currentpicture ;

                    draw
                        lmt_text [
                            trace      = trace,
                            anchor     = "bot",
                            text       = lua.mp.lmt_contours_range()
                            background = "",
                        ]
                        if ry <> 0 : ysized (ry) fi
                        shifted (w/2,d-ty)
                    ;

                    % minmax

                    draw
                        lmt_text [
                            trace      = trace,
                            anchor     = "lrt",
                            text       = lua.mp.lmt_contours_xrange()
                            background = "",
                        ]
                        if ry <> 0 : ysized (ry) fi
                        shifted (0,d-ty)
                    ;

                    draw
                        lmt_text [
                            trace      = trace,
                            anchor     = "llft",
                            text       = lua.mp.lmt_contours_yrange()
                            background = "",
                        ]
                        if ry <> 0 : ysized (ry) fi
                        shifted (w,d-ty)
                    ;

                fi ;

                if hasoption "legend" "function,all" :

                    % formula

                    draw
                        lmt_text [
                            trace      = trace,
                            anchor     = "bot",
                            style      = getparameter "functionstyle",
                            text       = lua.mp.lmt_contours_function()
                            background = "",
                        ]
                        if ry <> 0 : ysized (ry) fi
                        shifted (w/2,ypart llcorner currentpicture - ty)
                    ;

                fi ;

                if trace :
                    draw boundingbox currentpicture
                        dashed evenly
                        withpen pencircle scaled al ;
                fi ;

            fi ;

        fi ;

        lua.mp.lmt_contours_stop() ;

        popparameters ;
    )
enddef ;

newinternal svgforcecmyk ; svgforcecmyk := 0 ;

vardef svgcolor(expr r, g, b) =
    if svgforcecmyk > 0 :
        (1-r,1-g,1-b,0) % simple: no black component, kind of ok for emoji
    else :
        (r,g,b)
    fi
enddef ;

vardef svgcmyk(expr c, m, y, k) =
    (c,m,y,k)
enddef ;

vardef svggray(expr s) =
    s
enddef ;

permanent svgforcecmyk, svgcolor, svgcmyk, svggray ;

presetparameters "svg" [
    filename = "",
    fontname = "",
    colormap = "",
  % unicode  = 0,
    width    = 0,
    height   = 0,
    origin   = false,
    offset   = 0,
] ;

def lmt_svg = applyparameters "svg" "lmt_do_svg" enddef ;

vardef lmt_do_svg =
    save w, h, o;
    image (
        pushparameters "svg" ;
        w := getparameter "width" ;
        h := getparameter "height" ;
        o := getparameter "offset" ;
        lua.mp.lmt_svg_include() ; % textext runs twice .. maybe force once here
        if getparameter "origin" :
            currentpicture := currentpicture shifted -llcorner currentpicture ;
        fi ;
        popparameters ;
        if o <> 0 :
            setbounds currentpicture to boundingbox currentpicture enlarged o ;
        fi ;
    )
    if w > 0 :
        if h > 0 : xysized(w,h) else : xsized(w) fi
    else :
        if h > 0 :                     ysized(h) fi
    fi
enddef ;

% Another experiment. Parameters might change pending a discussion between Alan
% and me.

presetparameters "surface" [
    code          = "x + y",
    color         = "f, 0, 0",
    linecolor     = 1,
    xmin          = -1,
    xmax          =  1,
    ymin          = -1,
    ymax          =  1,
    xstep         = .1,
    ystep         = .1,
    snap          = .01,
    xvector       = { -0.7, -0.7 },
    yvector       = { 1, 0 },
    zvector       = { 0, 1 },
    light         = { 3, 3, 10 },
    bright        = 100,
    clip          = false,
    lines         = true,
    linecolor     = 1,
  % axis          = { }
  % clipaxis      = false
    axiscolor     = "gray"
    axislinewidth = 1/2,
] ;

def lmt_surface = applyparameters "surface" "lmt_do_surface" enddef ;

vardef lmt_do_surface =
    image (

        lmt_load_mlib_cnt ;

        pushparameters "surface" ;

        save currentpen; pen currentpen ;
        currentpen := pencircle scaled .25 ;

        interim linejoin := butt ;

        lmt_do_contour_shortcuts ;

        lua.mp.lmt_surface_do() ;

        currentpicture := currentpicture ysized getparameter "height" ;

        if hasparameter "axis" :

            save p ; picture p ; p := image (
                if hasparameter "axis" 1 :
                    draw ((origin) -- unitvector(getparameter "xvector")) scaled (getparameter "axis" 1) ;
                fi ;
                if hasparameter "axis" 2 :
                    draw ((origin) -- unitvector(getparameter "yvector")) scaled (getparameter "axis" 2) ;
                fi ;
                if hasparameter "axis" 3 :
                    draw ((origin) -- unitvector(getparameter "zvector")) scaled (getparameter "axis" 3) ;
                fi ;
            ) ;

            if getparameterdefault "clipaxis" false :
                clip p to boundingbox currentpicture ;
            fi ;

            draw p
                withpen pencircle scaled getparameter "axislinewidth"
                withcolor getparameter "axiscolor"
            ;

        fi ;

        popparameters ;
    )
enddef ;

% I can make a variant that avoids the lmt_do ... and does an immediate function
% call instead.

presetparameters "mpsglyphs" [
    name  = "dummy",
    units = 1000,
] ;

presetparameters "mpsglyph" [
    category = "dummy",
    unicode  = 0,
  % unichar  = ""
] ;

def lmt_registerglyphs = applyparameters "mpsglyphs" "lmt_do_registerglyphs" enddef ;
def lmt_registerglyph  = applyparameters "mpsglyph"  "lmt_do_registerglyph"  enddef ;

newscriptindex mfid_registerglyphs ; mfid_registerglyphs := scriptindex "registerglyphs" ; def lmt_do_registerglyphs = runscript mfid_registerglyphs enddef ;
newscriptindex mfid_registerglyph  ; mfid_registerglyph  := scriptindex "registerglyph"  ; def lmt_do_registerglyph  = runscript mfid_registerglyph  enddef ;

% An experimental macro:

vardef registercomposedglyph (expr u) (suffix snippets) =
    save s ; s := getparameterdefault "mpsfont" "scale" 1 ;
    save llx, lly, urx, ury ;
    llx := xpart llcorner snippets[u] ;
    if llx <> 0 :
        % this should be an option or we need a lsb
        snippets[u] := snippets[u] shifted (-llx, 0) ;
        llx := 0;
    fi ;
    lly := ypart llcorner snippets[u] / s ;
    urx := xpart urcorner snippets[u] / s ;
    ury := ypart urcorner snippets[u] / s ;
    lmt_registerglyph [
        category    = getparameter "mpsfont" "category",
        unicode     = u,
        code        = "draw " & str snippets & "[" & decimal u & "]",
        height      =   ury,
        depth       = - lly,
        width       =   urx - llx,
        boundingbox = { llx, lly, urx, ury }
    ] ;
enddef ;

vardef composeglyph (suffix snippets) =
    save u ; u := getparameter "mpsfont" "unicode" ;
    save s ; s := getparameterdefault "mpsfont" "scale" 1 ;
    snippets[u] := image (
        for i=1 upto getparametercount "mpsfont" "shapes" :
            draw scantokens ( getparameter "mpsfont" "shapes" i "shape" )
                if hasparameter "mpsfont" "shapes" i "color" :
                    withcolor getparameter "mpsfont" "shapes" i "color"
                fi ;
        endfor ;
    ) scaled s ;
    registercomposedglyph(u, snippets) ;
enddef ;

permanent registercomposeglyph, composeglyph ;

% Again an experiment (todo: the faster method):

% watch the ; that we scan!

newscriptindex mfid_remaptext ; mfid_remaptext := scriptindex "remaptext" ; def lmt_remaptext = runscript mfid_remaptext ; enddef ;

triplet mfun_tt_s ;

vardef rawmaptext(expr s) =
    mfun_tt_n := mfun_tt_n + 1 ;
    mfun_tt_c := nullpicture ;
    mfun_tt_o := nullpicture ;
    addto mfun_tt_o doublepath origin base_draw_options ;
    mfun_tt_r := lua.mp.mf_map_text(mfun_tt_n,s,catcoderegime) ; % can become mfid_maptext
    mfun_tt_s := lua.mp.mf_map_move(mfun_tt_n) ;                 % can become mfid_mapmove
    addto mfun_tt_c doublepath unitsquare
        xscaled wdpart mfun_tt_r
        yscaled (htpart mfun_tt_r + dppart mfun_tt_r)
        shifted (0,-dppart mfun_tt_r)
        withprescript "mf_object=text"
        withprescript "tx_index=" & decimal mfun_tt_n
        withprescript "tx_color=" & colordecimals colorpart mfun_tt_o
    ;
    mfun_tt_c
enddef ;

vardef svgtext(expr t) =
    save p ; picture p ;
  % mfun_tt_s := (0,0,0) ;
  % mfun_tt_r := (0,0,0) ;
    p := rawmaptext(t) ;
    p
    if (mfun_labtype.drt >= 10) : % drt etc
        shifted (0,ypart center p)
    fi
    shifted (
        - mfun_labshift.drt(p)
        - (redpart mfun_tt_s,0)
        + (greenpart mfun_tt_s,bluepart mfun_tt_s)
    )
enddef ;

vardef svg expr c = lmt_svg [ code = c ] enddef ;

% Fun stuff:

presetparameters "poisson" [
    width     = 50,
    height    = 50,
    initialx  =  0,
    initialy  =  0,
    distance  =  1,
    count     = 20,
    macro     = "draw",
    arguments = 2
] ;

def lmt_poisson = applyparameters "poisson" "lmt_do_poisson" enddef ;

vardef lmt_do_poisson =
    image (
        pushparameters "poisson" ;
            lua.mp.lmt_poisson_generate();
        popparameters ;
    )
enddef ;

permanent
    lmt_text, lmt_grid, lmt_axis, lmt_outline, lmt_followtext,
    lmt_arrow, lmt_placeholder, % lmt_path,
    lmt_function, lmt_poisson, lmt_mesh,
    lmt_chart_circle, lmt_chart_histogram, lmt_chart_bar,
    lmt_shade, lmt_contour, lmt_svg, lmt_surface,
    lmt_registerglyphs, lmt_registerglyph,
    lmt_remaptext, rawmaptext, svgtext, svg,
    OverlayMesh ;

% nice hack

newscriptindex mfid_scrutinized ; mfid_scrutinized := scriptindex "scrutinized" ;
newscriptindex mfid_recycled    ; mfid_recycled    := scriptindex "recycled" ;

primarydef p scrutinized n = runscript mfid_scrutinized p n enddef ;
primarydef p recycled    n = runscript mfid_recycled    p n enddef ;

permanent scrutinized, recycled ;

% for now here

% newscriptindex mfid_mpv_numeric   ; mfid_mpv_numeric   := scriptindex "mpv_numeric" ;
% newscriptindex mfid_mpv_dimension ; mfid_mpv_dimension := scriptindex "mpv_dimension" ;
% newscriptindex mfid_mpv_string    ; mfid_mpv_string    := scriptindex "mpv_string" ;
%
% def mpv_numeric   = runscript mfid_mpv_numeric   enddef ;
% def mpv_dimension = runscript mfid_mpv_dimension enddef ;
% def mpv_string    = runscript mfid_mpv_string    enddef ;
%
% permanent mpv_numeric, mpv_dimension, mpv_string ;

% newscriptindex mfid_mpvar ; mfid_mpvar := scriptindex "mpvar" ;
%
% def mpvar = runscript mfid_mpvar enddef ;

% d(imension) n(umber) s(tring) b(oolean) <heuristic>

newscriptindex mfid_mpvard ; mfid_mpvard := scriptindex "mpvard" ; def mpvard = runscript mfid_mpvard enddef ; % dimension
newscriptindex mfid_mpvarn ; mfid_mpvarn := scriptindex "mpvarn" ; def mpvarn = runscript mfid_mpvarn enddef ; % numeric
newscriptindex mfid_mpvars ; mfid_mpvars := scriptindex "mpvars" ; def mpvars = runscript mfid_mpvars enddef ; % string
newscriptindex mfid_mpvarb ; mfid_mpvarb := scriptindex "mpvarb" ; def mpvarb = runscript mfid_mpvarb enddef ; % string
newscriptindex mfid_mpvar  ; mfid_mpvar  := scriptindex "mpvar"  ; def mpvar  = runscript mfid_mpvar  enddef ; % automatic

permanent mpvard, mpvarn, mpvars, mpvarb, mpvar ;

% for old times sake (metafun manual)

vardef textual primary p = false enddef ;

% also for the menafun manual:

newscriptindex mfid_labtorgb ; mfid_labtorgb := scriptindex "labtorgb" ;
newscriptindex mfid_xyztorgb ; mfid_xyztorgb := scriptindex "xyztorgb" ;
newscriptindex mfid_lchtorgb ; mfid_lchtorgb := scriptindex "lchtorgb" ;
newscriptindex mfid_hsvtorgb ; mfid_hsvtorgb := scriptindex "hsvtorgb" ;
newscriptindex mfid_hwbtorgb ; mfid_hwbtorgb := scriptindex "hwbtorgb" ;

def labtorgb(expr l, a, b) = runscript mfid_labtorgb l a b enddef ;
def xyztorgb(expr x, y, z) = runscript mfid_xyztorgb x y z enddef ;
def lchtorgb(expr l, c, h) = runscript mfid_lchtorgb l c h enddef ;
def hsvtorgb(expr h, s, v) = runscript mfid_hsvtorgb h s v enddef ;
def hwbtorgb(expr h, w, b) = runscript mfid_hwbtorgb h w b enddef ;

permanent labtorgb, xyztorgb, lchtorgb, hsvtorgb, hwbtorgb ;

presetparameters "labtorgb" [
    mina = -100,
    maxa =  100,
    minb = -100,
    maxb =  100,
    step =    5,
    l    =   50,
] ;

def lmt_labtorgb = applyparameters "labtorgb" "lmt_do_labtorgb" enddef ;

vardef lmt_do_labtorgb =
    image (
        pushparameters "labtorgb" ;
            save l ; l := getparameter "l" ;
            for a = getparameter "mina" step getparameter "step" until getparameter "maxa" :
                for b = getparameter "minb" step getparameter "step" until getparameter "maxb" :
                  % draw (a,b) withcolor labtorgb(l,a,b) ;
                    draw (a,b) withcolor runscript mfid_labtorgb l a b ;
                endfor ;
            endfor ;
        popparameters ;
    )
enddef ;

presetparameters "lchcircle" [
  steps  =  24,
  labels = true,
  l      = 100,
  c      = 100,
] ;

def lmt_lchcircle = applyparameters "lchcircle" "lmt_do_lchcircle" enddef ;

vardef lmt_do_lchcircle =
  image (
    pushparameters "lchcircle" ;
    save p, l, c, h, n, b ;
    path p ; numeric l, c, h, n ; boolean b ;
    l := getparameter "l" ;
    c := getparameter "c" ;
    n := getparameter "steps" ;
    b := getparameter "labels" ;
    p := arcpointlist n of fullcircle ;
    for i within p :
      h := i*360/n ;
      draw
        pathpoint scaled 50
        withpen pencircle scaled (120/n)
        withcolor lchtorgb(l,c,h) ;
      if b :
        draw
          textext ("\tt\bf" & decimal h)
          scaled .4
          shifted (pathpoint scaled 50)
          withcolor white ;
      fi ;
    endfor ;
    popparameters ;
  )
enddef ;

% For now we collect all lmt namespace extensions here, so also this one:

presetparameters "matrix" [
  % cell    = (1, 1),
  % from    = (1, 1),
  % to      = (1, 1),
  % shape   = { "circle", "square" },
    connect = { "center", "center" },
  % text    = "",
] ;

def lmt_matrix = applyparameters "matrix" "lmt_do_matrix" enddef ;

vardef mfun_lmt_matrix_cell (expr p) =
  % anchorbox ("matrix", xpart p, ypart p) ("matrix", xpart p + 1, ypart p)
    matrixcell (xpart p, ypart p)
enddef ;

% todo: lft rt etc but then we need to push/pop the linewidth too

def mfun_lmt_matrix_connect (expr h, p, r, l, u, d, gap) =
    if     h == "right"  : center rightboundary   (p enlarged gap) { r }
    elseif h == "left"   : center leftboundary    (p enlarged gap) { l }
    elseif h == "top"    : center topboundary     (p enlarged gap) { u }
    elseif h == "bottom" : center bottomboundary  (p enlarged gap) { d }
    else                 : center                 (p enlarged gap)
    fi
enddef ;

def mfun_lmt_matrix_source (expr p, h, gap) =
    mfun_lmt_matrix_connect(h, p, right, left, up, down, gap)
enddef ;

def mfun_lmt_matrix_target (expr p, h, gap) =
    mfun_lmt_matrix_connect(h, p, left, right, down, up, gap)
enddef ;

vardef mfun_lmt_matrix_enhance (expr p, h) =
    if h = "circle" :
        fullcircle xysized (bbwidth p, bbheight p) shifted center p
    elseif h = "round" :
        (p smoothed getparameterdefault "radius" ExHeight) xysized (bbwidth p, bbheight p)
    elseif h = "path" :
        (getparameterpath "path") shifted center p
    elseif h = "scaledpath" :
        (getparameterpath "path") xysized (bbwidth p, bbheight p) shifted center p
    else :
        p
    fi
enddef ;

vardef lmt_do_matrix =
    image (
        pushparameters "matrix" ;
        draw image (
            save a, b, c, o, g ; path a, b, c ; numeric o, g ;
            if (hasparameter "arrowoffset") :
                g := getparameter "arrowoffset" ;
            elseif (hasparameter "linewidth") :
                g := getparameter "linewidth" ;
            else :
                g := 0;
            fi ;
            if (hasparameter "from") and (hasparameter "to") :
                a := mfun_lmt_matrix_cell(getparameter "from") ;
                b := mfun_lmt_matrix_cell(getparameter "to") ;
                if hasparameter "offset" :
                    o := getparameter "offset" ;
                    a := a enlarged o ;
                    b := b enlarged o ;
                fi ;
                if hasparameter "shapes" :
                    a := mfun_lmt_matrix_enhance(a, getparameter "shapes" 1) ;
                    b := mfun_lmt_matrix_enhance(b, getparameter "shapes" 2) ;
                fi ;
                draw a
                    if (hasparameter "colors") :
                        withcolor (getparameter "colors" 1)
                    elseif (hasparameter "color") :
                        withcolor (getparameter "color")
                    fi
                ;
                draw b
                    if (hasparameter "colors") :
                        withcolor (getparameter "colors" 2)
                    elseif (hasparameter "color") :
                        withcolor (getparameter "color")
                    fi
                ;
                c :=
                    mfun_lmt_matrix_source(a, getparameter "connect" 1, g) ..
                    mfun_lmt_matrix_target(b, getparameter "connect" 2, g) ;
                drawarrow c
                    if (hasparameter "arrowcolor") :
                        withcolor (getparameter "arrowcolor")
                    elseif (hasparameter "color") :
                        withcolor (getparameter "color")
                    fi
                ;
                if hasparameter "label" :
                    pushparameters "label" ;
                    draw lmt_text [
                        text     = getparameter "text",
                        position = point (getparameterdefault "fraction" 1/2) of c,
                        offset   = if hasparameter "offset" : getparameter "offset" fi,
                        color    = if hasparameter "color"  : getparameter "color"  fi,
                        anchor   = if hasparameter "anchor" : getparameter "anchor" fi,
                      % strut style format background backgroundcolor
                    ] ;
                    popparameters ;
                fi ;
            elseif (hasparameter "cell") :
                a := mfun_lmt_matrix_cell(getparameter "cell") ;
                if hasparameter "offset" :
                    o := getparameter "offset" ;
                    a := a enlarged o ;
                fi ;
                if hasparameter "shape" :
                    a := mfun_lmt_matrix_enhance(a, getparameter "shape") ;
                fi ;
                draw a
                    if (hasparameter "color") :
                        withcolor (getparameter "color")
                    fi
                ;
            fi;
        )
        if (hasparameter "linewidth") :
            withpen pencircle scaled (getparameter "linewidth")
        fi
        popparameters
    )
enddef ;

% This might move to its own module if we add more:

presetparameters "glyphshape" [
  % id        = "",
  % character = "",
    shape       = true,
    boundingbox = false,
    baseline    = false,
    usedline    = true,
    usedbox     = true,
    italic      = false,
    accent      = false,
    dimensions  = false,
] ;

def lmt_glyphshape = applyparameters "glyphshape" "lmt_do_glyphshape" enddef ;

vardef glyphshape_start(expr id, character) =
    lua.mp.lmt_glyphshape_start(id, character) ;
enddef ;

vardef glyphshape_stop         = lua.mp.lmt_glyphshape_stop() ;      enddef ;
vardef glyphshape_n            = lua.mp.lmt_glyphshape_n()           enddef ;
vardef glyphshape_path(expr i) = lua.mp.lmt_glyphshape_path(i)       enddef ;
vardef glyphshape_boundingbox  = lua.mp.lmt_glyphshape_boundingbox() enddef ;
vardef glyphshape_baseline     = lua.mp.lmt_glyphshape_baseline()    enddef ;
vardef glyphshape_usedbox      = lua.mp.lmt_glyphshape_usedbox()     enddef ;
vardef glyphshape_usedline     = lua.mp.lmt_glyphshape_usedline()    enddef ;
vardef glyphshape_width        = lua.mp.lmt_glyphshape_width()       enddef ;
vardef glyphshape_height       = lua.mp.lmt_glyphshape_height()      enddef ;
vardef glyphshape_depth        = lua.mp.lmt_glyphshape_depth()       enddef ;
vardef glyphshape_italic       = lua.mp.lmt_glyphshape_italic()      enddef ;
vardef glyphshape_accent       = lua.mp.lmt_glyphshape_accent()      enddef ;
vardef glyphshape_llx          = lua.mp.lmt_glyphshape_llx()         enddef ;

% vardef glyphshape_dimensions =
%     unitsquare
%         xscaled glyphshape_width
%         yscaled (glyphshape_height - glyphshape_depth)
%         shifted (glyphshape_llx,glyphshape_depth)
% enddef ;

vardef glyphshape_usedaccent =
    (glyphshape_llx+glyphshape_accent,0.8*glyphshape_height) --
    (glyphshape_llx+glyphshape_accent,1.2*glyphshape_height)
enddef ;

vardef glyphshape_useditalic =
    (glyphshape_llx+glyphshape_width + glyphshape_italic,glyphshape_depth) --
    (glyphshape_llx+glyphshape_width + glyphshape_italic,glyphshape_height)
enddef ;

vardef lmt_do_glyphshape =
    image (
        pushparameters "glyphshape" ;
            glyphshape_start(getparameter "id", getparameter "character") ;
            if getparameter "shape" :
                draw for i=1 upto glyphshape_n :
                    glyphshape_path(i) &&
                endfor cycle ;
            fi ;
%             if getparameter "dimensions" :
%                 draw
%                     glyphshape_dimensions
%                     withcolor red;
%             ;
            if getparameter "boundingbox" :
                draw
                    glyphshape_boundingbox
                    withcolor red
                ;
            fi ;
            if getparameter "usedbox" :
                draw
                    glyphshape_usedbox
                    withcolor blue
                ;
                if getparameter "usedline" :
                    draw
                        glyphshape_usedline
                        withcolor blue
                    ;
                fi ;
            fi ;
            if (getparameter "accent") and (glyphshape_accent <> 0) :
                draw glyphshape_usedaccent
                    withcolor green
                ;
            fi ;
            if (getparameter "italic") and (glyphshape_italic <> 0) :
                draw glyphshape_useditalic
                    withcolor green
                ;
            fi ;
% drawdot (glyphshape_width,0) ;
% drawdot (glyphshape_llx,0) ;
            glyphshape_stop ;
        popparameters ;
    )
enddef ;

% experimental:

numeric last_potraced_count   ;
numeric last_potraced_width   ;
numeric last_potraced_height  ;
numeric last_potraced_xsize   ;
numeric last_potraced_ysize   ;
numeric last_potraced_xoffset ;
numeric last_potraced_yoffset ;

path    last_potraced_bounds  ; last_potraced_bounds := origin -- cycle ;
path    last_potraced_sized   ; last_potraced_sized  := origin -- cycle ;

pair    last_potraced_offset  ; last_potraced_offset := origin;

presetparameters "potraced" [
    bytes       = "",
    width       = 0,
    height      = 0,
    nx          = 1,
    ny          = 1,
    explode     = false,
    swap        = false,
    value       = "1",
    optimize    = false,      % opticurve
    threshold   = 1,          % alphamax
    policy      = "minority", % turnpolicy
    tolerance   = 0.2,        % opttolerance
    size        = 2,          % turdsize
  % stringname  = "",
  % filename    = "",
    criterium   = 127,
    alternative = "path", % draw fill -> picture
    polygon     = false,
] ;

numeric n_lmt_potraced ; n_lmt_potraced := 0 ;

def lmt_potraced = applyparameters "potraced" "lmt_do_potraced" enddef ;

vardef lmt_do_potraced =
    if n_lmt_potraced = 0 :
        lmt_do_startpotraced ;
        lua.mp.lmt_step_potrace()
        hide (
            lmt_do_steppotraced ;
            lmt_do_stoppotraced ;
        )
    else :
        lua.mp.lmt_step_potrace()
        hide (
            lmt_do_steppotraced ;
        )
    fi
enddef ;

def lmt_startpotraced = applyparameters "potraced" "lmt_do_startpotraced" enddef ;
def lmt_stoppotraced  =                             lmt_do_stoppotraced   enddef ;

def lmt_do_startpotraced =
    if n_lmt_potraced = 0 :
        n_lmt_potraced := n_lmt_potraced + 1 ;
        pushparameters "potraced" ;
        lua.mp.lmt_start_potrace() ;
    fi
enddef ;

def lmt_do_stoppotraced =
    if n_lmt_potraced = 1 :
        n_lmt_potraced := n_lmt_potraced - 1 ;
        lua.mp.lmt_stop_potrace() ;
        popparameters ;
    fi
enddef ;

vardef lmt_do_steppotraced =
    last_potraced_count   := getparameter("count") ;
    last_potraced_width   := getparameter("width") ;
    last_potraced_height  := getparameter("height") ;
    last_potraced_xsize   := getparameter("xsize");
    last_potraced_ysize   := getparameter("ysize");
    last_potraced_xoffset := getparameter("xoffset");
    last_potraced_yoffset := getparameter("yoffset");
    last_potraced_bounds  := unitsquare xscaled last_potraced_width yscaled last_potraced_height ;
    last_potraced_sized   := unitsquare xscaled last_potraced_xsize yscaled last_potraced_ysize ;
    last_potraced_offset  := (last_potraced_xoffset,-(last_potraced_ysize - last_potraced_yoffset)) ;
enddef ;

def lmt_showrivers(expr stepsize, width, height, showpolygon) =
    picture q ; q := image (
        lmt_startpotraced [
            stringname = "profile",
            threshold  = .5,
        ] ;
      % draw lmt_potraced [
      %     size       = 1,
      %     index      = 1,
      % ] withcolor "middleyellow" ;
      % draw lmt_potraced [
      %     size       = 1,
      %     index      = 2,
      % ] withcolor "middlegray" ;
        fill lmt_potraced [
            size       = 1,
            first      = 3,
            polygon    = showpolygon,
        ] withcolor "middlegreen" ;
        fill lmt_potraced [
            size       = 3,
            first      = 3,
            polygon    = showpolygon,
        ] withcolor "middleblue" ;
        fill lmt_potraced [
            size       = stepsize,
            first      = 3,
            polygon    = showpolygon,
        ] withcolor "middlered" ;
        lmt_stoppotraced ;
    ) ;

    setbounds q to last_potraced_bounds enlarged (-2,-2) ;
    draw q xysized (width,height) ;
enddef;

% Sampled Functions

% draw lmt_samplefunction [
%     preamble = "local pi, sin, cos,  tan = math.pi, math.sin, math.cos, math.tan"
%   % code     = "return sin(x*x)",
%   % code     = "return acos(sin(10*x))",
%   % code     = "return math.max(0,sin(x))",
%   % code     = "return sin(1/x)",
%   % code     = "return sin(x)/x",
%   % code     = "return x/abs(x)",
%   % code     = "return 1/x",
%   % code     = "return tan(x)",
%   % code     = "return x > 0 and (1 + x) or 0",
%   % code     = "if x > 0 then return cos(x) else return 0 end",
%   % code     = "return x % 1",
%   % code     = "return math.floor(x)",
%   % code     = "return x*x*x/(2*x*x - 6)",
%     code     = "return sin(x) % 1",
%   % code     = "return math.acos(sin(10*x))",
%   % code     = "return x/sin(x)",
%     %
%     xmin     = -5*pi,
%     xmax     =  5*pi,
%     ymin     =   -pi,
%     ymax     =  5*pi,
% ]

presetparameters "samplefunction" [
    preamble   = "",
  % code       = "1/x",
  % xmin       =   -1,
  % xmax       =    1,
  % ymin       =   -1,
  % ymax       =    1,
  % dmin       =    3,
  % dmax       =   50,
  % smax       = 5000,
  % eps        =    0.001,
  % curvature  =    0.4,
] ;

def lmt_samplefunction = applyparameters "samplefunction" "lmt_do_samplefunction" enddef ;

def lmt_load_mlib_fnc =
    runscript("lua.registercode('mlib-fnc')");
    extra_beginfig := extra_beginfig & % todo: use different hook
        "runscript(" & ditto & "mp.lmt_samplefunctions_cleanup()" & ditto & ")" ;
    let lmt_load_mlib_fnc = relax ;
enddef ;

vardef lmt_do_samplefunction =
    lmt_load_mlib_fnc ;

    pushparameters "samplefunction" ;

    lua.mp.lmt_samplefunction_do()

    popparameters ;

    lua.mp.lmt_samplefunction_flush()
enddef ;

% Parametric plots

% path p ; p := lmt_parametricplot [
%     preamble  = "local sin, cos = math.sin, math.cos",
%     xcode     = "return 0.1*t*cos(t)",
%     ycode     = "return 0.1*t*sin(t)",
%     tmin      =  -4pi,
%     tmax      =   4pi,
%     tolerance = 0.0001,
% ] scaled 10 ;
%
% draw p ; drawdot p withcolor red ;

presetparameters "parametricplot" [
    preamble  = "",
  % xcode     = "t",
  % ycode     = "t",
  % tmin      = -1,
  % tmax      =  1,
  % tolerance =  0.0001,
] ;

def lmt_parametricplot = applyparameters "parametricplot" "lmt_do_parametricplot" enddef ;

vardef lmt_do_parametricplot =
    lmt_load_mlib_fnc ;

    pushparameters "parametricplot" ;

    lua.mp.lmt_parametricplot_do()

    popparameters ;

    lua.mp.lmt_parametricplot_flush()
enddef ;

% meshes

% newscriptindex mfid_meshcontour ; mfid_meshcontour  := scriptindex("meshcontour")  ;
%
% def meshcontour(expr name) = runscript mfid_meshcontour name ; enddef ; % just combine with the next one
%
% vardef meshexperiment(expr name, kind) =
%     image (
%         save p ; path p ; p := meshcontour(name) ;
%         addto currentpicture doublepath p
%             withprescript "ms_name=" & name
%             withprescript "ms_kind=" & kind
%         ;
%     )
% enddef ;

presetparameters "vectorplot" [
    preamble  = "",
    kind      = "both",
    name      = "",
  % xcode     = "t",
  % ycode     = "t",
  % tmin      = -1,
  % tmax      =  1,
  % tolerance =  0.0001,
    bytemap   =  1,
] ;

def lmt_vectorplot = applyparameters "vectorplot" "lmt_do_vectorplot" enddef ;

% We can use functione before we load so this is a no-go:
%
% def lmt_load_mlib_msh =
%     runscript("lua.registercode('mlib-msh')");
%     let lmt_load_mlib_msh = relax ;
% enddef ;

vardef lmt_do_vectorplot =
  % lmt_load_mlib_msh ;

    image (

        pushparameters "vectorplot" ;

        save p ; path p ; p := meshcontour(getparameter "name",getparameter "kind") ;
%         if (getparameter "kind") = "bytemap" :
%             addto currentpicture doublepath unitsquare
%                 withbytemap getparameter "bytemap"
%         else :
            addto currentpicture doublepath p
                withprescript "ms_name=" & (getparameter "name")
                withprescript "ms_kind=" & (getparameter "kind")
%         fi ;

        popparameters ;
    )

enddef ;

%D For Keith McKay:

newscriptindex mfid_perlinnoise   ; mfid_perlinnoise   := scriptindex "perlinnoise" ;
newscriptindex mfid_simplexnoise  ; mfid_simplexnoise  := scriptindex "simplexnoise" ;
newscriptindex mfid_perlinoctave  ; mfid_perlinoctave  := scriptindex "perlinoctave" ;
newscriptindex mfid_simplexoctave ; mfid_simplexoctave := scriptindex "simplexoctave" ;

vardef perlinnoise (expr p, q, r) = runscript mfid_perlinnoise  p q r enddef ;
vardef simplexnoise(expr p, q, r) = runscript mfid_simplexnoise p q r enddef ;

vardef perlinoctave (expr        iterations, amplitude, frequency, persistence, lacunarity, ang, minimum, maximum, x, y) =
    runscript mfid_perlinoctave  iterations  amplitude  frequency  persistence  lacunarity  ang  minimum  maximum  x  y
enddef ;
vardef simplexoctave(expr        iterations, amplitude, frequency, persistence, lacunarity, ang, minimum, maximum, x, y) =
    runscript mfid_simplexoctave iterations  amplitude  frequency  persistence  lacunarity  ang  minimum  maximum  x  y
enddef ;

presetparameters "noise" [
    bytemap     = 1,
    nx          = 10,
    ny          = 10,
    nz          = 1,
    iteration   = 2,
    persistence = 128,
    scale       = 0.01,
    low         = 0,
    high        = 255,
    colorcode   = "",
    angle       = 0,
    method      = "perlin", % simplex angle detail
] ;

def lmt_noise = applyparameters "noise" "lmt_do_noise" enddef ;

def lmt_load_mlib_eff =
    runscript("lua.registercode('mlib-eff')");
    let lmt_load_mlib_eff = relax ;
enddef ;

vardef lmt_do_noise =
    lmt_load_mlib_eff ;
    image (
        pushparameters "noise" ;
        lua.mp.lmt_noise_do() ;
        draw unitsquare
            withbytemap (getparameterdefault "bytemap" 1)
            withpen pencircle scaled 0 ;
        popparameters ;
    )
enddef ;

% bytemaps

presetparameters "bytemap" [
    bytemap   = 1,
    colorcode = "",
] ;

def lmt_bytemap = applyparameters "bytemap" "lmt_do_bytemap" enddef ;

def lmt_load_mlib_bmp =
    runscript("lua.registercode('mlib-bmp')");
    let lmt_load_mlib_bmp = relax ;
enddef ;

vardef lmt_do_bytemap =
    lmt_load_mlib_bmp ;
    image (
        pushparameters "bytemap" ;
        lua.mp.lmt_bytemap_do() ;
        draw unitsquare
            withbytemap (getparameterdefault "bytemap" 1)
            withpen pencircle scaled 0 ;
        popparameters ;
    )
enddef ;

% A variant:

presetparameters "domainmap" [
    bytemap     = 1,
    colorcode   = "",
    xmin        = -10,
    xmax        =  10,
    ymin        = -10,
    ymax        =  10,
    xresolution = 1000,
    yresolution = 1000,
] ;

def lmt_domainmap = applyparameters "domainmap" "lmt_do_domainmap" enddef ;

vardef lmt_do_domainmap =
    lmt_load_mlib_bmp ;
    image (
        pushparameters "domainmap" ;
        lua.mp.lmt_domainmap_do() ;
        draw unitsquare
            withbytemap (getparameterdefault "bytemap" 1)
            withpen pencircle scaled 0 ;
        popparameters ;
    )
enddef ;

% We need a vardef instead of def here in order to prevents expansion
% of the suffix!

vardef downsamplebytemap(expr source, target, n) =
    lua.mp.downsamplebytemap(source,target,n);
enddef ;

vardef downgradebytemap(expr source, target, n) =
    lua.mp.downgradebytemap(source,target,n);
enddef ;

permanent downsamplebytemap, downgradebytemap ;

% Handy as otherwise we forget the withpen:

vardef bytemap primary n =
    image (
        draw unitsquare
            bytemapscaled n
            withbytemap n
            withpen pencircle scaled 0
        ;
    )
enddef ;

def withreduction expr t =
    if string t :
        withprescript ("bytereduce=" & t)
    fi
enddef ;

def withpalette expr t =
    if string t :
        withprescript ("bytepalette=" & t)
    fi
enddef ;

permanent bytemap, withreduction, withpalette ;

% outlined text on a curve

newscriptindex mfid_outlineposition   ; mfid_outlineposition   := scriptindex "outlineposition" ;
newscriptindex mfid_outlinedimensions ; mfid_outlinedimensions := scriptindex "outlinedimensions" ;

vardef outlineposition (expr n) =
    runscript mfid_outlineposition n
enddef ;

vardef outlinedimensions =
    runscript mfid_outlinedimensions
enddef ;

% Optimized for as less as possible parameter passing and copying variables as
% well as avoiding using hide. For now we keep the a, b and c here but they might
% to to a module. It all depends on if we need them for an article.

numeric mfun_oscillate_depth, mfun_oscillate_resolution, mfun_oscillate_ratio, mfun_oscillate_stepsize ;
path mfun_oscillate_shape, mfun_oscillate_path ;
picture mfun_oscillate_outline ;

def mfun_oscilatedsteps_a(expr p) =
    for i within arcpointlist mfun_oscillate_resolution of p :
        unitvector (
            direction
                (arctime pathxpart of mfun_oscillate_shape)
            of mfun_oscillate_shape
        )
        rotated 90
        scaled (pathypart - mfun_oscillate_depth)
        shifted (arcpoint pathxpart of mfun_oscillate_shape)
        --
    endfor
enddef ;

vardef mfun_oscilatedstep_a(expr p) =
    for i = 0 step 1 until length p - 1 :
        mfun_oscilatedsteps_a(subpath(i,i + 1) of p)
    endfor cycle
enddef ;

def mfun_oscilatedstep_b(expr p) =
    for i within arcpointlist (length(p)*mfun_oscillate_resolution) of p :
        unitvector (
            direction
                (arctime pathxpart of mfun_oscillate_shape)
            of mfun_oscillate_shape
        )
        rotated 90
        scaled (pathypart - mfun_oscillate_depth)
        shifted (arcpoint pathxpart of mfun_oscillate_shape)
        --
    endfor cycle
enddef ;

def mfun_oscilatedsteps_c(expr p) =
    for i within arcpointlist (arclength(p)/mfun_oscillate_stepsize) of p :
        unitvector (
            direction
                (arctime pathxpart of mfun_oscillate_shape)
            of mfun_oscillate_shape
        )
        rotated 90
        scaled (pathypart - mfun_oscillate_depth)
        shifted (arcpoint pathxpart of mfun_oscillate_shape)
        --
    endfor
enddef ;

vardef mfun_oscilatedstep_c(expr p) =
    for i = 0 step 1 until length p - 1 :
        mfun_oscilatedsteps_c(subpath(i,i + 1) of p)
    endfor cycle
enddef ;

def mfun_oscilatedsteps_d(expr p,n) =
    for i within arcpointlist n of p :
        unitvector (
            direction
                (arctime pathxpart of mfun_oscillate_shape)
            of mfun_oscillate_shape
        )
        rotated 90
        scaled (pathypart - mfun_oscillate_depth)
        shifted (arcpoint pathxpart of mfun_oscillate_shape)
        --
    endfor
enddef ;

vardef mfun_oscilatedstep_d(expr p) =
    for i = 0 step 1 until length p - 1 :
        hide(mfun_oscillate_path := subpath(i,i + 1) of p)
        mfun_oscilatedsteps_d(
            mfun_oscillate_path,
            ceiling(arclength(mfun_oscillate_path)/mfun_oscillate_stepsize)
        )
    endfor cycle
enddef ;

presetparameters "oscillated" [
    path       = fullcircle scaled 100,
    text       = "test",
    yoffset    =  0,
    stepsize   =  0, % a dimension, but zero will auto set it
  % resolution = 20,
    resolution = 15,
  % resolution = 10,
  % method     =  1,
  % method     =  2,
  % method     =  3,
    method     =  4,
    scale      =  0,
] ;

def lmt_oscillated = applyparameters "oscillated" "lmt_do_oscillated" enddef ;

vardef lmt_do_oscillated =
    hide (
        pushparameters "oscillated" ;
        save result ; path result ;
        mfun_oscillate_outline := lmt_outline [
            text = getparameter "text",
            kind = "path",
        ] ;
        mfun_oscillate_shape      := getparameter "path" ;
        mfun_oscillate_resolution := getparameter "resolution" ;
        mfun_oscillate_outline    := mfun_oscillate_outline xshifted - xpart llcorner mfun_oscillate_outline ;
        mfun_oscillate_ratio      := getparameter "scale" ;
        if mfun_oscillate_ratio = 0 :
          mfun_oscillate_ratio := arclength(mfun_oscillate_shape) / bbwidth(mfun_oscillate_outline) ;
        fi
        mfun_oscillate_depth      := (zpart outlinedimensions) * mfun_oscillate_ratio - getparameter "yoffset" ;
        mfun_oscillate_stepsize   := getparameter "stepsize" ;
        if mfun_oscillate_stepsize = 0 :
            mfun_oscillate_stepsize := mfun_oscillate_ratio * (ypart outlinedimensions) / mfun_oscillate_resolution ;
        fi
    )
    if (getparameter "method") == 4 :
        for i within mfun_oscillate_outline scaled mfun_oscillate_ratio :
            mfun_oscilatedstep_d(pathpart i) &&
        endfor cycle
    elseif (getparameter "method") == 3 :
        for i within mfun_oscillate_outline scaled mfun_oscillate_ratio :
            mfun_oscilatedstep_c(pathpart i) &&
        endfor cycle
    elseif (getparameter "method") == 3 :
        for i within mfun_oscillate_outline scaled mfun_oscillate_ratio :
            mfun_oscilatedstep_b(pathpart i) &&
        endfor cycle
    else :
        for i within mfun_oscillate_outline scaled mfun_oscillate_ratio :
            mfun_oscilatedstep_a(pathpart i) &&
        endfor cycle
    fi
    hide (
        mfun_oscillate_shape := origin ;
        mfun_oscillate_outline := nullpicture ;
        popparameters ;
    )
enddef ;

%D For the moment here:

newinternal defaultpruneoptions ;

defaultpruneoptions := 0
    +  1 % collapse_regular_regular_prune 0x01
    +  2 % collapse_begin_regular_prune   0x02
    +  4 % collapse_regular_end_prune     0x03
    +  8 % collapse_begin_end_prune       0x04
;

permanent defaultpruneoptions ;

pruneoptions := defaultpruneoptions ;

%D Experimental l-system code (Mikael, Keith, Hans), don't use this yet!

numeric mfun_lsystem_angle_p ;
numeric mfun_lsystem_angle_m ;
numeric mfun_lsystem_angle   ;

boolean mfun_lsystem_busy    ; mfun_lsystem_busy  := false ;
boolean mfun_lsystem_image   ; mfun_lsystem_image := false ;
numeric mfun_lsystem_s_level ; mfun_lsystem_level := 0 ;

numeric mfun_lsystem_x ; mfun_lsystem_x := 0 ;
numeric mfun_lsystem_y ; mfun_lsystem_y := 0 ;
boolean mfun_lsystem_b ; mfun_lsystem_b := false ;

transform mfun_lsystem_s_cache[] ;
transform mfun_lsystem_s_cache ;

def mfun_lsystem_check_busy_no_l =
%     if previousxy <> lastxy :
%         -- lastxy
%     fi
enddef ;
def mfun_lsystem_check_busy_no_c =
    % curious :
%     if previousxy <> lastxy : .. lastxy fi
enddef ;
def mfun_lsystem_check_busy_do =
    if not mfun_lsystem_busy :
        hide(mfun_lsystem_busy := true)
        ;
        draw lastxy
    fi
enddef ;

def mfun_lsystem_draw_l =
    mfun_lsystem_check_busy
    if mfun_lsystem_b :
        hide(mfun_lsystem_b := false)
        && xyrelative (
            mfun_lsystem_x,
            mfun_lsystem_y
        )
    fi
        --
        xyrelative (
             cosd(mfun_lsystem_angle) * sx,
           - sind(mfun_lsystem_angle) * sy
        )
enddef ;
def mfun_lsystem_draw_c =
    mfun_lsystem_check_busy
    if mfun_lsystem_b :
        hide(mfun_lsystem_b := false)
        && xyrelative (
            mfun_lsystem_x,
            mfun_lsystem_y
        )
    fi
    ..
    xyrelative (
         cosd(mfun_lsystem_angle) * sx,
       - sind(mfun_lsystem_angle) * sy
    )
enddef ;

def mfun_lsystem_minus_do =
    mfun_lsystem_angle := (mfun_lsystem_angle - mfun_lsystem_angle_m) mod 360 ;
enddef ;
def mfun_lsystem_plus_do =
    mfun_lsystem_angle := (mfun_lsystem_angle - mfun_lsystem_angle_p) mod 360 ;
enddef;
def mfun_lsystem_minus = hide(mfun_lsystem_minus_do) enddef ;
def mfun_lsystem_plus  = hide(mfun_lsystem_plus_do ) enddef ;

def mfun_lsystem_move_do =
    if mfun_lsystem_b :
        mfun_lsystem_x := mfun_lsystem_x + cosd(mfun_lsystem_angle) * sx ;
        mfun_lsystem_y := mfun_lsystem_y - sind(mfun_lsystem_angle) * sy ;
    else :
        mfun_lsystem_x :=   cosd(mfun_lsystem_angle) * sx ;
        mfun_lsystem_y := - sind(mfun_lsystem_angle) * sy ;
        mfun_lsystem_b := true ;
    fi
enddef ;
def mfun_lsystem_move  = hide(mfun_lsystem_move_do) enddef ;

vardef mfun_lsystem_push_do =
    mfun_lsystem_level := mfun_lsystem_level + 1 ;
  % message("PUSH " & decimal mfun_lsystem_level);
    mfun_lsystem_s_cache[mfun_lsystem_level] := ( sx, sy, mfun_lsystem_angle, lw, lastx, lasty ) ;
    lastxy
enddef ;
% vardef mfun_lsystem_pop_do =
%     mfun_lsystem_s_cache := mfun_lsystem_s_cache[mfun_lsystem_level] ; % xx xy yx yy x y
%     sx := xxpart mfun_lsystem_s_cache ;
%     sy := xypart mfun_lsystem_s_cache ;
%     mfun_lsystem_angle := yxpart mfun_lsystem_s_cache ;
%     lw := yypart mfun_lsystem_s_cache ;
%   % message("POP  " & decimal mfun_lsystem_level);
%     mfun_lsystem_level := mfun_lsystem_level - 1 ;
%     (xpart mfun_lsystem_s_cache, ypart mfun_lsystem_s_cache)
% enddef ;
vardef mfun_lsystem_pop_do =
    mfun_lsystem_s_cache := mfun_lsystem_s_cache[mfun_lsystem_level] ;
    sx := partone mfun_lsystem_s_cache ;
    sy := parttwo mfun_lsystem_s_cache ;
    mfun_lsystem_angle := partthree mfun_lsystem_s_cache ;
    lw := partfour mfun_lsystem_s_cache ;
  % message("POP  " & decimal mfun_lsystem_level);
    mfun_lsystem_level := mfun_lsystem_level - 1 ;
    (partfive mfun_lsystem_s_cache, partsix mfun_lsystem_s_cache)
enddef ;
def mfun_lsystem_push =
    mfun_lsystem_check_busy
    --
    mfun_lsystem_push_do
enddef ;
def mfun_lsystem_pop =
    mfun_lsystem_check_busy
if previousxy <> lastxy  :
        -- lastxy
fi
    && mfun_lsystem_pop_do
enddef ;

def mfun_lsystem_close =
    mfun_lsystem_check_busy && cycle
enddef ;

def mfun_lsystem_options(text t) =
    if mfun_lsystem_busy :
        mfun_lsystem_draw_options
        ;
        hide(def mfun_lsystem_draw_options = t enddef ; mfun_lsystem_busy := false)
    else :
        hide(def mfun_lsystem_draw_options = t enddef)
    fi
enddef ;

def mfun_lsystem_expression(text t) =
    hide(t)
enddef ;

presetparameters "lsystem" [
    angle     = 0,
    rotation  = -90,
    start     = "start",
    curved    = false,
    iteration = 2,
    scale     = 1,
    isimage   = false,
    linewidth = 0.1,
    prune     = false,
    syntax    = [
        start = "R",
        R     = "L",
        L     = "R",
    ]
] ;

def lmt_lsystem = applyparameters "lsystem" "lmt_do_lsystem" enddef ;

def lmt_load_mlib_lsy =
    runscript("lua.registercode('mlib-lsy.lmt')");
    let lmt_load_mlib_lsy = relax ;
enddef ;

vardef lmt_do_lsystem =
    save sx, sy, lw, prune ; boolean prune ;
    lmt_load_mlib_lsy ;
    % ready
    pushparameters "lsystem" ;
    % prepare
    lua.mp.lsystem_prepare() ;
    % apply
    def mfun_lsystem_draw_options =
        % dummy
    enddef ;
    sx := 1 ;
    sy := 1 ;
    lw := getparameter("linewidth") ;
    prune := getparameter("prune") ;
    if prune :
        message("pruning lsystem") ;
    fi
    mfun_lsystem_b       := false ;
    mfun_lsystem_busy    := false ;
    mfun_lsystem_image   := getparameter("isimage") ;
    mfun_lsystem_angle_p := getparameterdefault "rightangle" (getparameterdefault "angle") ;
    mfun_lsystem_angle_m := getparameterdefault "leftangle"  (-mfun_lsystem_angle_p) ;
    mfun_lsystem_angle   := if mfun_lsystem_angle_p <> 0 : (getparameter "rotation") else : 0 fi ;
    if (getparameter("curved")) :
        let mfun_lsystem_draw = mfun_lsystem_draw_c ;
        let mfun_lsystem_check_busy = mfun_lsystem_check_busy_no_c ;
    else :
        let mfun_lsystem_draw = mfun_lsystem_draw_l ;
        let mfun_lsystem_check_busy = mfun_lsystem_check_busy_no_l ;
    fi ;
    if mfun_lsystem_image :
        let mfun_lsystem_check_busy = mfun_lsystem_check_busy_do ;
if prune : prunesingularities fi
        image (
            def mfun_lsystem_draw_options = enddef ;
            mfun_lsystem_start(getparameter "iteration")
            if mfun_lsystem_busy :
                mfun_lsystem_draw_options
                ;
            fi
        )
    else :
        let mfun_lsystem_check_busy = relax ;
if prune : prunesingularities fi
        (origin mfun_lsystem_start(getparameter "iteration"))

    fi
    if (getparameter "scale") <> 1 :
        scaled (getparameter "scale")
    fi
    hide(popparameters)
enddef ;
