%D \module
%D   [       file=mp-luas.lmtx,
%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 context_lmtx : endinput ; fi ;

boolean context_lmtx ; context_lmtx := true ;

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

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 ;
        interim textextoffset := getparameter "offset" ;
        style := getparameter "style" ;
        anchor := getparameter "anchor" ;
        strt := getparameter "strut" ;
        fmt := getparameter "format" ;
        txt := getparameter "text" ;
        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" ;
        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" ;

                            % p := for i = 1 upto getparametercount "points":
                            %     if (i > 1) : -- fi (getparameter "points" i)
                            % endfor
                            % if (getparameterdefault "close" false) : -- cycle fi ;

                            % this can become:

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

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

                            p := getparameterpath "points" (getparameterdefault "close" false) ;
                          % p := getparameterpath "points" getparameterdefault "close" false ;

                            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
                                            rotatedaround(a,angle(d)) ;
                                    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 =
    image ( normaldraw image (
        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" ;
        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" ;
        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) ;
    ) )
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 s_u ; string s_u ; s_u := getparameter "autoscaleup" ;
        save s_d ; string s_d ; s_d := getparameter "autoscaledown" ;
        save followtextalternative   ; followtextalternative   := if getparameter "spread" : 1 else : 0 fi ;
        save tracingfollowtext       ; tracingfollowtext       := if getparameter "trace"  : 1 else : 0 fi ;
        save autoscaleupfollowtext   ; autoscaleupfollowtext   := if s_u = "yes" : 1 elseif s_u = "max" : 2 else : 0 fi ;
        save autoscaledownfollowtext ; autoscaledownfollowtext := if s_d = "yes" : 1 elseif s_d = "max" : 2 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" ;
        save ahvariant ; ahvariant := if a = "dimpled" : 1 elseif a = "curved" : 2 else : 0 fi ;
        save ahdimple  ; ahdimple  := getparameter "dimple" ;
        save ahscale   ; ahscale   := getparameter "scale" ;
        save ahangle   ; ahangle   := getparameter "angle" ;
        save ahlength  ; 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,
] ;

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 ;
            string code, option ;
            path txl, txs, tyl, tys ; boolean swap ;
            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" ;

            if swap : p := image ( fi

            if (getparametercount "functions") > 0 :
                for s = 1 upto getparametercount "functions" :
                    pushparameters "functions" s ;
                    lmt_do_function_p (
                        getparameterdefault "xmin",
                        getparameterdefault "xmax",
                        getparameterdefault "xstep",
                        getparameterdefault "code",
                        getparameterdefault "shape",
                        getparameterdefault "close",
                        getparameterdefault "fillcolor",
                        getparameterdefault "drawsize",
                        getparameterdefault "drawcolor",
                        getparameterdefault "pointsymbol",
                        getparameterdefault "pointsize",
                        getparameterdefault "pointcolor"
                    ) ;
                    popparameters ;
                endfor ;
            elseif code <> "" :
                lmt_do_function_p (
                    getparameter "xmin",
                    getparameter "xmax",
                    getparameter "xstep",
                    getparameter "code",
                    getparameter "shape",
                    getparameter "close",
                    getparameter "fillcolor",
                    getparameter "drawsize",
                    getparameter "drawcolor",
                    getparameter "pointsymbol",
                    getparameter "pointsize",
                    getparameter "pointcolor"
                ) ;
            fi ;

            if swap : ) ; fi

            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 ;

            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 ;

            option := getparameter "frame" ;
            if option = "yes" :
                draw (xmin,ymin) -- (xmax,ymin) -- (xmax,ymax) -- (xmin,ymax) -- cycle ;
            elseif (option = "ticks") or (option = "sticks") :
                draw (xmin,ymin) -- (xmax,ymin) -- (xmax,ymax) -- (xmin,ymax) -- cycle ;
                if xsmall > 0 :
                    txs := ((0,0) -- (0,tl)) if option = "sticks" : rotated 180 fi ;
                    txs := txs transformed tr ;
                    for i = xmin step ((xmax-xmin)/xsmall) until xmax :
                        nodraw txs shifted (i,ymin) ;
                    endfor ;
                    txs := (0,0) -- (0,-tl) if option = "sticks" : rotated 180 fi ;
                    txs := txs transformed tr ;
                    for i = xmin step ((xmax-xmin)/xsmall) until xmax :
                        nodraw txs shifted (i,ymax) ;
                    endfor ;
                    dodraw (xmin,ymin) ; % flush snippets
                fi ;
                if ysmall > 0 :
                    tys := (0,0) -- (tl,0) if option = "sticks" : rotated 180 fi ;
                    tys := tys transformed tr ;
                    for i = ymin step ysmall until ymax :
                        nodraw tys shifted (xmin,i) ;
                    endfor ;
                    tys := (0,0) -- (-tl,0) if option = "sticks" : rotated 180 fi ;
                    tys := tys transformed tr ;
                    for i = ymin step ysmall until ymax :
                        nodraw tys shifted (xmax,i) ;
                    endfor ;
                    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 ;
        )

        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 ;

% charts

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

    samples         = { },

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

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

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

    linewidth       = .25mm,

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

presetparameters "chart:circle" "chart" [
    height      = 5cm,
    width       = 5mm,
    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, distance, linewidth, labelgap, labelfraction, value, nofsamples, nofsamplesets ;
    save fillcolor, drawcolor, labelcolor, labelstyle, labelformat, labelstrut, labelanchor, colormode ;
    string fillcolor, drawcolor, labelcolor, labelstyle, labelformat, labelstrut, labelanchor, colormode ;
    height := getparameter "height" ;
    width := getparameter "width" ;
    distance := getparameter "distance" ;
    linewidth := getparameter "linewidth" ;
    drawcolor := getparameter "drawcolor" ;
    colormode :=  getparameter "colormode" ;
    labelcolor := getparameter "labelcolor" ;
    labelgap := getparameter "labeloffset" ;
    labelstyle := getparameter "labelstyle" ;
    labelformat := getparameter "labelformat" ;
    labelstrut := getparameter "labelstrut" ;
    labelanchor := getparameter "labelanchor" ;
    labelfraction := getparameter "labelfraction" ;
    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))
    ]
enddef ;

def lmt_do_chart_legend =
    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,
            ] ;
            fill leftboundary l rightenlarged w
                shifted (dx,dy+d)
                withcolor getparameter "fillcolors" i ;
            draw l
                shifted (dx+w+o,dy+d) ;
        endfor ;
    fi ;
enddef ;

vardef lmt_do_chart_circle =
    image (
        lmt_do_chart_start("chart:circle") ;
        if (nofsamplesets > 0) and (nofsamples > 0) :
            nofsamplesets := 1 ;
            save p, r, s, first, last, total, factor, n, percentage ;
            path p, r, s[] ; boolean percentage ;
            percentage := getparameter "percentage" ;
            total := 0 ;
            for i = 1 upto nofsamples :
                total := total + getparameter "samples" (1) i ; % () is needed else 1i
            endfor ;
            factor := 100/total ;
            first := 0 ;
            p := fullcircle ysized (height) ;
            r := origin -- (2*height,0) ;
            for i = 1 upto nofsamples :
                fillcolor := getparameter "fillcolors" i ;
                value := (getparameter "samples" (1) i) * factor ;
                last := first + (360 / 100) * value ;
                s[i] := ((p cutbefore (r rotated first)) cutafter (r rotated last)) ;
                fill origin -- s[i] -- cycle withcolor fillcolor ;
                first := last ;
            endfor ;
            if linewidth > 0 :
                if drawcolor = "" :
                    drawcolor := backgroundcolor ;
                fi ;
                for i = 1 upto nofsamples :
                    interim linecap := butt ;
                    draw origin -- (point 0            of s[i]) withpen pencircle scaled linewidth withcolor drawcolor ;
                    draw origin -- (point length(s[i]) of s[i]) withpen pencircle scaled linewidth withcolor drawcolor ;
                endfor ;
            fi ;
            if getparameter "showlabels" :
                first := 0 ;
                for i = 1 upto nofsamples :
                    value := getparameter "samples" (1) i ;
                    last := first + (360/100) * value * factor ;
                    draw lmt_do_chart_text (s,i,value)
                        shifted ((labelfraction*(height/2),0) rotated ((first+last)/2)) ;
                    first := last ;
                endfor ;
            fi ;
            lmt_do_chart_legend ;
            n := getparameter "originsize" ;
            if n > 0 :
                fill fullcircle scaled n withcolor "white"  ;
            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) ;
            for s = 1 upto nofsamplesets :
                if getparameter "showlabels" :
                    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 ;
                fi ;
            endfor ;
            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" ;
            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 ; path bb ;
            bb := boundingbox(mfun_shade_path) ;
            a := b := -1 ;
            if string getparameter "direction" :
                s := getparameter "direction" ;
                if     s = "up"    :
                    p_a := xpart shadedup ;
                    p_b := ypart shadedup ;
                elseif s = "down"  :
                    p_a := xpart shadeddown ;
                    p_b := ypart shadeddown ;
                elseif s = "left"  :
                    p_a := xpart shadedleft ;
                    p_b := ypart shadedleft ;
                elseif s = "right" :
                    p_a := xpart shadedright ;
                    p_b := ypart shadedright ;
                fi
            else :
                p_a := getparameter "direction" 1 ;
                p_a := getparameter "direction" 2 ;
            fi
            if p_a >= 0 :
                center_a := point p_a of bb ;
            fi
            if p_b >= 0 :
                center_b := point p_b 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
            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)
                            ]
                            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
                                ]
                                    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
                                ]
                                    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()
                        ]
                        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()
                        ]
                        if ry <> 0 : ysized (ry) fi
                        shifted (0,d-ty)
                    ;

                    draw
                        lmt_text [
                            trace  = trace,
                            anchor = "llft",
                            text   = lua.mp.lmt_contours_yrange()
                        ]
                        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()
                        ]
                        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 ;

presetparameters "svg" [
    filename = "",
    width    = 0,
    height   = 0,
] ;

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

vardef lmt_do_svg =
    save w, h ;
    w := getparameter "svg" "width" ;
    h := getparameter "svg" "height" ;
    image (
        lua.mp.lmt_svg_include()
    )
    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 ;