diff options
Diffstat (limited to 'Master/texmf-dist/metapost/context/base/mpxl/mp-lmtx.mpxl')
-rw-r--r-- | Master/texmf-dist/metapost/context/base/mpxl/mp-lmtx.mpxl | 2403 |
1 files changed, 2403 insertions, 0 deletions
diff --git a/Master/texmf-dist/metapost/context/base/mpxl/mp-lmtx.mpxl b/Master/texmf-dist/metapost/context/base/mpxl/mp-lmtx.mpxl new file mode 100644 index 00000000000..ec21b150afd --- /dev/null +++ b/Master/texmf-dist/metapost/context/base/mpxl/mp-lmtx.mpxl @@ -0,0 +1,2403 @@ +%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 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" ; + + % 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 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, +] ; + +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" ; + + p := image ( + + 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 not swap : draw p 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 ; + + 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 ; + ) + + 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, + 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)) + background = "", + ] +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, + background = "", + ] ; + 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, 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 + 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() ; + 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): + +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_scrutenized ; mfid_scrutenized := scriptindex "scrutenized" ; + +primarydef p scrutenized n = + runscript mfid_scrutenized p n +enddef ; + +permanent scrutenized ; + +% 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 ; + +permanent 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" ; + +def labtorgb(expr l, a, b) = runscript mfid_labtorgb l a b enddef ; + +permanent labtorgb ; + +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 ; |