%D \module %D [ file=mp-lmtx.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 if d <> origin : rotatedaround(a,angle(d)) fi ; endfor ; fi ; popparameters ; popparameters ; endfor ; popparameters ; fi ; popparameters ; ) xyscaled(getparameter "axis" "sx",getparameter "axis" "sy") enddef ; presetparameters "outline" [ text = "", kind = "draw", fillcolor = "", drawcolor = "", rulethickness = 1/10, align = "", style = "", width = 0, ] ; def lmt_outline = applyparameters "outline" "lmt_do_outline" enddef ; vardef lmt_do_outline = 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" ; elseif kind = "path" : kind := "p" ; fi ; currentoutlinetext := currentoutlinetext + 1 ; lua.mp.mf_outline_text( currentoutlinetext, if align = "" : getparameter "outline" "text", else : "\framed[align={" & align & "}" if width > 0 : & ",width=" & decimal width & "bp" fi if style <> "" : & ",foregroundstyle={" & style & "}" fi & ",offset=none,frame=off]{" & (getparameter "outline" "text") & "}", fi, kind ) ; save currentpen; pen currentpen ; pickup pencircle scaled getparameter "outline" "rulethickness" ; if kind = "f" : mfun_do_outline_text_set_f ( withcolor getparameter "outline" "fillcolor" ); elseif kind = "d" : mfun_do_outline_text_set_d ( withcolor getparameter "outline" "drawcolor" ); elseif kind = "b" : mfun_do_outline_text_set_b ( withcolor getparameter "outline" "fillcolor" ) ( withcolor getparameter "outline" "drawcolor" ); elseif kind = "u" : mfun_do_outline_text_set_u ( withcolor getparameter "outline" "fillcolor" ); elseif kind = "r" : mfun_do_outline_text_set_r ( withcolor getparameter "outline" "drawcolor" ) ( withcolor getparameter "outline" "fillcolor" ) ; elseif kind = "p" : mfun_do_outline_text_set_p ; else : mfun_do_outline_text_set_n ( % what to use here ); fi ; lua.mp.mf_get_outline_text(currentoutlinetext) ; ) ) enddef ; presetparameters "followtext" [ text = "", spread = true, trace = false, reverse = false, autoscaleup = "no", autoscaledown = "no", path = (fullcircle), ] ; def lmt_followtext = applyparameters "followtext" "lmt_do_followtext" enddef ; vardef lmt_do_followtext = image ( pushparameters "followtext" ; save scale_up ; string scale_up ; scale_up := getparameter "autoscaleup" ; save scale_down ; string scale_down ; scale_down := getparameter "autoscaledown" ; save followtextalternative ; followtextalternative := if getparameter "spread" : 1 else : 0 fi ; save autoscaleupfollowtext ; autoscaleupfollowtext := if scale_up = "yes" : 1 elseif scale_up = "max" : 2 else : 0 fi ; save autoscaledownfollowtext ; autoscaledownfollowtext := if scale_down = "yes" : 1 elseif scale_down = "max" : 2 else : 0 fi ; % save tracingfollowtext ; tracingfollowtext := if getparameter "trace" : 1 else : 0 fi ; interim tracingfollowtext := if getparameter "trace" : 1 else : 0 fi ; draw followtext ( if (getparameter "reverse") : reverse fi (getparameter "path"), (getparameter "text") ) ; popparameters ; ) enddef ; presetparameters "arrow" [ path = origin, % pen = ..., kind = "fill", dimple = 1/5, scale = 3/4, penscale = 3, length = 4, angle = 45, location = "end", % middle both alternative = "normal", % dimpled curved percentage = 50, headonly = false, ] ; def lmt_arrow = applyparameters "arrow" "lmt_do_arrow" enddef ; vardef lmt_do_arrow = image ( pushparameters "arrow" ; save a ; string a ; a := getparameter "alternative" ; save l ; string l ; l := getparameter "location" ; save k ; string k ; k := getparameter "kind" ; save p ; path p ; p := getparameter "path" ; interim ahvariant := if a = "dimpled" : 1 elseif a = "curved" : 2 else : 0 fi ; interim ahdimple := getparameter "dimple" ; interim ahscale := getparameter "scale" ; interim ahangle := getparameter "angle" ; interim ahlength := getparameter "length" ; if not getparameter "headonly" : draw p ; fi ; if hasparameter "pen" : % a cheat: we should have a type check in lua if hasoption "pen" "auto" : ahlength := (getparameter "penscale") * boundingradius(currentpen) ; else : ahlength := (getparameter "penscale") * boundingradius(getparameterpen "pen") ; fi ; fi ; if k = "draw" : draw elseif k = "both" : filldraw else : fill fi if l = "middle" : midarrowhead p ; elseif l = "percentage" : arrowheadonpath (p, (getparameter "percentage")/100) ; elseif l = "both" : arrowhead p ; if k = "draw" : draw elseif k = "both" : filldraw else : fill fi arrowhead reverse p ; else : arrowhead p ; fi ; popparameters ; ) enddef ; % from dum presetparameters "placeholder" [ color = "red", width = 1, height = 1, reduction = 0, alternative = "circle", ] ; def lmt_placeholder = applyparameters "placeholder" "lmt_do_placeholder" enddef ; def lmt_do_placeholder = begingroup ; pushparameters "placeholder" ; save w, h, d, r, p, c, b, s, q, a ; numeric w, h, d, r ; path p ; string s, a ; s := getparameter "color" ; w := getparameter "width" ; h := getparameter "height" ; r := getparameter "reduction" ; a := getparameter "alternative" ; d := max(w,h) ; if cmykcolor resolvedcolor(s) : cmykcolor c, b ; b := (0,0,0,0) else : color c, b ; b := (1,1,1) fi ; c := resolvedcolor(s) ; p := unitsquare xyscaled (w,h) ; fill p withcolor r[.5c,b] ; if a = "square" : vardef q = fullsquare enddef ; elseif a = "triangle" : vardef q = fulltriangle rotated (90 * round(uniformdeviate(4))) enddef ; else : vardef q = fullcircle enddef ; fi ; for i := 1 upto 60 : fill q scaled (d/5 randomized (d/5)) shifted (center p randomized (d)) withcolor r[c randomized(.3,.9),b] ; endfor ; clip currentpicture to p ; popparameters ; endgroup ; enddef ; % maybe: vardef lmt_connected(text t) = save p ; path p ; p := origin t ; subpath (1,length(p)) of p enddef ; def lmt_connection expr t = -- t enddef ; % also (todo) % % draw lmt_path [ % % points = [ color = "darkred", size = 6 ], % % controls = [ color = "darkgreen", size = 4 ], % % lines = [ color = "darkgray", size = 1 ], % % shape = [ color = "middlegray", size = 8 ], % % labels = [ ], % % path = ((1cm,1cm) -- (1.5cm,1.5cm) .. (2cm,0cm) .. cycle) % % ] ; % % presetparameters "path" [ % labels = [ % color = "", % size = 1 % ], % controls = [ % color = "black", % size = 2.5 % ], % lines = [ % color = "middlegray", % size = 1 % ], % points = [ % color = "black", % size = 4 % ], % path = [ % color = "lightgray", % size = 5, % path = origin % ] % ] ; % % def lmt_path = applyparameters "path" "lmt_do_path" enddef ; % % vardef lmt_do_path = % image ( % % This one is not that efficient ... we can better inline the drawing routines here, but % % it's just an interfacing test after all. % if hasparameter "path" "path" : % save p ; path p ; p := getparameter "path" "path" ; % drawpath p % withpen pencircle scaled (drawoptionsfactor * getparameterdefault "path" "shape" "size" "*") % withcolor getparameterdefault "path" "shape" "color" "*" % ; % if hasparameter "path" "controls" : % drawcontrollines p % withpen pencircle scaled (drawoptionsfactor * getparameterdefault "path" "lines" "size" "*" ) % withcolor getparameterdefault "path" "lines" "color" "*" % ; % drawcontrolpoints p % withpen pencircle scaled (drawoptionsfactor * getparameterdefault "path" "controls" "size" "*") % withcolor getparameterdefault "path" "controls" "color" "*" % ; % fi ; % if hasparameter "path" "points" : % drawpoints p % withpen pencircle scaled (drawoptionsfactor * getparameterdefault "path" "points" "size" "*") % withcolor getparameterdefault "path" "points" "color" "*" % ; % if hasparameter "path" "labels" : % drawpointlabels p % withcolor getparameterdefault "path" "labels" "color" "*" % ; % fi ; % fi ; % fi ; % ) % enddef ; % Here we use nodraw and dodraw to create efficient axis ticks. Yet another demo % of coding. presetparameters "function" [ sx = 1mm, sy = 1mm, offset = 0, xmin = 1, xmax = 1, xstep = 1, xsmall = 0, xlarge = 0, xlabels = "no", xticks = "bottom", % top bottom middle xcaption = "", ymin = 1, ymax = 1, ystep = 1, ysmall = 0, ylarge = 0, % xfirst = 0, % xlast = 0, % yfirst = 0, % ylast = 0, ylabels = "no", yticks = "left", % left right middle ycaption = "", code = "", close = false, shape = "curve", fillcolor = "", drawsize = 1, drawcolor = "", frame = "", % yes ticks linewidth = .05mm, pointsymbol = "", pointsize = 2, pointcolor = "", xarrow = "", yarrow = "", reverse = false, % function : metatable is parent axis = "both", ] ; def lmt_function = applyparameters "function" "lmt_do_function" enddef ; vardef lmt_do_function_p(expr xmin, xmax, xstep, code, shape, close, fcolor, dsize, dcolor, psymbol, psize, pcolor) = save p, q ; path p, q ; p := lua.mp.lmt_function_x(xmin,xmax,xstep,code,shape) ; if close : q := (xmin,0) -- p -- (xmax,0) -- cycle ; fill q withcolor fcolor ; else : draw p withpen currentpen scaled dsize withcolor dcolor ; fi ; if psize > 0 : if psymbol = "dot" : draw image ( for i = 0 upto length(p) : draw point i of p ; endfor ; ) withpen currentpen scaled psize withcolor pcolor ; fi ; fi ; enddef ; vardef lmt_do_function = image ( pushparameters "function" ; save sx, sy, lw, tl, tr, ts, tt, currentpen ; transform tr, tt ; pen currentpen ; sx := getparameter "sx" ; sy := getparameter "sy" ; lw := getparameter "linewidth" ; tl := 1/20 ; % tick length ts := 1/10 ; % text scale tr := identity xyscaled(10/sx,10/sy) ; tt := identity xyscaled(ts/sx,ts/sy) ; pickup pencircle xyscaled(lw/sx,lw/sy) ; draw image ( save xmin, xmax, xstep, xsmall, xlarge, ymin, ymax, ystep, ysmall, ylarge, p ; save code, option, txl, txs, tyl, tys, swap, axis ; string code, option, shape, axis ; path txl, txs, tyl, tys ; boolean swap, close ; picture p ; xmin := getparameter "xmin" ; xmax := getparameter "xmax" ; xstep := getparameter "xstep" ; xsmall := getparameter "xsmall" ; xlarge := getparameter "xlarge" ; ymin := getparameter "ymin" ; ymax := getparameter "ymax" ; ystep := getparameter "ystep" ; ysmall := getparameter "ysmall" ; ylarge := getparameter "ylarge" ; code := getparameter "code" ; swap := getparameter "reverse" ; shape := getparameter "shape" ; close := getparameter "close" ; axis := getparameter "axis" ; p := image ( if (getparametercount "functions") > 0 : for s = 1 upto getparametercount "functions" : % todo: pushparameters with a metatable, here parent pushparameters "functions" [s] ; lmt_do_function_p ( (getparameterdefault "xmin" xmin), (getparameterdefault "xmax" xmax), (getparameterdefault "xstep" xstep), (getparameterdefault "code" code), (getparameterdefault "shape" shape), (getparameterdefault "close" close), (getparameterdefault "fillcolor" (getparameter "fillcolor")), (getparameterdefault "drawsize" (getparameter "drawsize")), (getparameterdefault "drawcolor" (getparameter "drawcolor")), (getparameterdefault "pointsymbol" (getparameter "pointsymbol")), (getparameterdefault "pointsize" (getparameter "pointsize")), (getparameterdefault "pointcolor" (getparameter "pointcolor")) ) ; popparameters ; endfor ; elseif code <> "" : lmt_do_function_p ( xmin, xmax, xstep, code, shape, close, getparameter "fillcolor", getparameter "drawsize", getparameter "drawcolor", getparameter "pointsymbol", getparameter "pointsize", getparameter "pointcolor" ) ; fi ; ) ; if not swap : draw p fi ; if (axis = "") or (axis = "no") : % nothing else : % todo: x y both option := getparameter "xticks" ; if option = "top" : txs := (0,0) -- (0,tl) ; elseif option = "bottom" : txs := (0,-tl) -- (0,0) ; else : txs := (0,-tl) -- (0,tl) ; fi ; option := getparameter "yticks" ; if option = "left" : tys := (-tl,0) -- (0,0) ; elseif option = "right" : tys := (0,0) -- (tl,0) ; else : tys := (-tl,0) -- (tl,0) ; fi ; txs := txs transformed tr ; tys := tys transformed tr ; txl := txs scaled 2 ; tyl := tys scaled 2 ; % this arrow head scaling is for Alan to sort out ... xmin := getparameterdefault "xfirst" xmin ; xmax := getparameterdefault "xlast" xmax ; ymin := getparameterdefault "yfirst" ymin ; ymax := getparameterdefault "ylast" ymax ; if hasoption "frame" "ticks,sticks" : if xsmall > 0 : if hasoption "frame" "horizontal" : for i = ymin step ((ymax-ymin)/ysmall) until ymax : draw (xmin,i) -- (xmax,i) ; endfor ; dodraw (xmin,ymin) ; % flush snippets fi ; fi ; if ysmall > 0 : if hasoption "frame" "vertical" : for i = xmin step ((xmax-xmin)/xsmall) until xmax : draw (i,ymin) -- (i,ymax) ; endfor ; dodraw (xmin,ymin) ; % flush snippets fi ; fi ; fi ; option := getparameter "xarrow" ; if option = "yes" : save ahlength ; ahlength := tl ; % save ahangle ; ahangle := 100/sy ; drawarrow (xmin,0) -- (xmax,0) ; else : draw (xmin,0) -- (xmax,0) ; fi ; option := getparameter "yarrow" ; if option = "yes" : save ahlength ; ahlength := tl ; % save ahangle ; ahangle := 100/sx ; drawarrow (xmin,ymin) -- (xmin,ymax) ; else : draw (xmin,ymin) -- (xmin,ymax) ; fi ; if hasoption "frame" "yes" : draw (xmin,ymin) -- (xmax,ymin) -- (xmax,ymax) -- (xmin,ymax) -- cycle ; fi ; if hasoption "frame" "ticks,sticks" : if xsmall > 0 : if hasoption "frame" "horizontal" : for i = ymin step ((ymax-ymin)/ysmall) until ymax : draw (xmin,i) -- (xmax,i) ; endfor ; fi ; if hasoption "frame" "bottom" : txs := ((0,0) -- (0,tl)) if hasoption "frame" "sticks" : rotated 180 fi ; txs := txs transformed tr ; for i = xmin step ((xmax-xmin)/xsmall) until xmax : nodraw txs shifted (i,ymin) ; endfor ; fi ; if hasoption "frame" "top" : txs := (0,0) -- (0,-tl) if hasoption "frame" "sticks" : rotated 180 fi ; txs := txs transformed tr ; for i = xmin step ((xmax-xmin)/xsmall) until xmax : nodraw txs shifted (i,ymax) ; endfor ; fi ; dodraw (xmin,ymin) ; % flush snippets fi ; if ysmall > 0 : if hasoption "frame" "vertical" : for i = xmin step ((xmax-xmin)/xsmall) until xmax : draw (i,ymin) -- (i,ymax) ; endfor ; fi ; if hasoption "frame" "left" : tys := (0,0) -- (tl,0) if hasoption "frame" "sticks" : rotated 180 fi ; tys := tys transformed tr ; for i = ymin step ((ymax-ymin)/ysmall) until ymax : nodraw tys shifted (xmin,i) ; endfor ; fi ; if hasoption "frame" "right" : tys := (0,0) -- (-tl,0) if hasoption "frame" "sticks" : rotated 180 fi ; tys := tys transformed tr ; for i = ymin step ((ymax-ymin)/ysmall) until ymax : nodraw tys shifted (xmax,i) ; endfor ; fi ; dodraw (xmin,ymin) ; % flush snippets fi ; fi ; if xsmall > 0 : for i = xmin step xsmall until xmax : nodraw txs shifted (i,0) ; endfor ; fi ; if xlarge > 0 : for i = xmin step xlarge until xmax : nodraw txl shifted (i,0) ; endfor ; dodraw (xmin,0) ; % flush snippets elseif xsmall > 0 : dodraw (xmin,0) ; % flush snippets fi ; if ysmall > 0 : for i = ymin step ysmall until ymax : nodraw tys shifted (xmin,i) ; endfor ; fi ; if ylarge > 0 : for i = ymin step ylarge until ymax : nodraw tyl shifted (xmin,i) ; endfor ; dodraw (xmin,ymin) ; % flush snippets elseif ysmall > 0 : dodraw (xmin,ymin) ; % flush snippets fi ; if swap : draw p fi ; if xlarge > 0 : option := getparameter "xlabels" ; if option <> "no" : for i = xmin step xlarge until xmax : if ((i <> 0) and ((option <> "nolimits") or ((i > xmin) and (i < xmax)))) : draw textext.bot(decimal i) transformed tt shifted (i,1.25*(ypart point 0 of txl)) ; fi ; endfor ; fi ; fi ; if ylarge > 0 : option := getparameter "ylabels" ; if option <> "no" : for i = ymin step ylarge until ymax : if ((i <> 0) and ((option <> "nolimits") or ((i > ymin) and (i < ymax)))) : draw textext.lft(decimal i) transformed tt shifted (xmin+1.25*(xpart point 0 of tyl),i) ; fi ; endfor ; fi ; fi ; option := getparameter "xcaption" ; if (option <> "") : draw textext.bot(option) transformed tt shifted (xmin,-tl) shifted center bottomboundary currentpicture ; fi ; option := getparameter "ycaption" ; if (option <> "") : draw textext.lft(option) transformed tt shifted (xmin-tl,0) shifted center leftboundary currentpicture ; fi ; fi ; ) xyscaled(sx,sy) ; setbounds currentpicture to boundingbox currentpicture enlarged (getparameter "offset") ; popparameters ; ) enddef ; % Don't use this one! presetparameters "mesh" [ trace = false, auto = false, step = 0.05, % box = ... % paths = { ..., ..., ... } ] ; def lmt_mesh = applyparameters "mesh" "lmt_do_mesh" enddef ; vardef lmt_do_mesh = image ( save p, b ; path p, b ; pushparameters "mesh" ; if getparameter "auto" : b := if hasparameter "box" : getparameter "box" else : OverlayBox fi ; for i=1 upto getparametercount "paths" : p := getparameter "paths" i ; p := meshed(p if not cycle p : -- cycle fi,b,getparameter "step") ; if getparameter "trace" : draw p ; fi ; runscript("mp.lmt_mesh_update()") i p ; endfor ; elseif getparameter "trace" : for i=1 upto getparametercount "paths" : p := getparameter "paths" i ; draw p if not cycle p : -- cycle fi ; endfor ; fi ; popparameters ; runscript("mp.lmt_mesh_set()") ; ) enddef ; vardef mfun_meshed_clipped(expr pat, box, pct) = pp := point (arctime pct of pat) of pat ; if (ypart pp <= lly) or (ypart pp >= ury) or (xpart pp <= llx) or (xpart pp >= urx) : (cp -- pp) intersection_point bb else : pp fi enddef ; vardef mfun_meshed_clipped(expr pat, box, pct) = pp := point (arctime pct of pat) of pat ; if ypart pp <= lly : if xpart pp <= llx : (llx, lly) elseif xpart pp >= urx : (urx, lly) else : (xpart pp, lly) fi elseif ypart pp >= ury : if xpart pp <= llx : (llx, ury) elseif xpart pp >= urx : (urx, ury) else : (xpart pp, ury) fi elseif xpart pp <= llx : (llx, ypart pp) elseif xpart pp >= urx : (urx, ypart pp) else : pp fi enddef ; vardef meshed(expr pth, box, stp) = begingroup save cb, cp, llx, lly, urx, ury, pp, lp, bb ; pair cb, cp, pp ; path bb ; bb := box enlarged -1/10; cb := center bb ; cp := center pth ; llx := xpart llcorner bb; lly := ypart llcorner bb; urx := xpart urcorner bb; ury := ypart urcorner bb; lp := arclength pth ; for i=stp step stp until 1+stp/2 : cp -- mfun_meshed_clipped(pth,bb,lp*(i-stp)) -- mfun_meshed_clipped(pth,bb,lp*(i )) -- cp -- endfor cycle endgroup enddef ; vardef OverlayMesh(expr p, s) = lmt_mesh [ paths = { meshed(p,OverlayBox,s) } ] enddef ; permanent meshed, OverlayMesh ; % charts presetparameters "chart" [ originsize = 1mm, trace = false, showlabels = true, showlegend = true, showvalues = false, showaxis = false, center = false, samples = { }, cumulative = false, percentage = false, maximum = 0, distance = 1mm, threshold = eps, % labels = { }, labelstyle = "", labelformat = "", % labelstrut = "auto", % labelanchor = "", % labeloffset = 0, labelfraction = 0.8, labelcolor = "", axisstyle = "", axiscolor = "", axisformat = "", axislinewidth = mm/5, axislinecolor = "", valuestyle = "", valuecolor = "", valueformat = "", backgroundcolor = "", drawcolor = "white", fillcolors = { % use color palet "darkred", "darkgreen", "darkblue", "darkyellow", "darkmagenta", "darkcyan", "darkgray" }, linecolors = { }, colormode = "global", linewidth = .25mm, % linegap = 0, legendcolor = "", legendstyle = "", legend = { }, ] ; presetparameters "chart:circle" "chart" [ height = 5cm, width = 5mm, innerradius = 0, initialangle = 0, % -90 == top labelanchor = "", labeloffset = 0, labelstrut = "no", ] ; presetparameters "chart:histogram" "chart" [ height = 5cm, width = 5mm, labelanchor = "bot", labeloffset = 1mm, labelstrut = "auto", ] ; presetparameters "chart:bar" "chart" [ height = 5mm, width = 5cm, labelanchor = "lft", labeloffset = 1mm, labelstrut = "no", ] ; def lmt_chart_circle = applyparameters "chart:circle" "lmt_do_chart_circle" enddef ; def lmt_chart_histogram = applyparameters "chart:histogram" "lmt_do_chart_histogram" enddef ; def lmt_chart_bar = applyparameters "chart:bar" "lmt_do_chart_bar" enddef ; def lmt_do_chart_start (expr what) = pushparameters what ; save width, height, depth, distance, threshold, linewidth, linegap, value, nofsamples, nofsamplesets, fillcolor, linecolor, drawcolor, labelcolor, labelstyle, labelformat, labelgap, labelfraction, labelstrut, labelanchor, axiscolor, axisstyle, axisformat, axisgap, axislinewidth, axislinecolor, valuecolor, valuestyle, valueformat, valuegap, colormode ; string fillcolor, linecolor, drawcolor, labelcolor, labelstyle, labelformat, labelstrut, labelanchor, axiscolor, axisstyle, axisformat, axislinecolor, valuecolor, valuestyle, valueformat, colormode ; if hasparameter "sampleset" : setluaparameter what "samples" (getparameter "sampleset") ; fi ; threshold := getparameter "threshold" ; colormode := getparameter "colormode" ; linewidth := getparameter "linewidth" ; linegap := getparameterdefault "linegap" linewidth ; height := getparameter "height" ; depth := max(getparameter "originsize", (getparameter "innerradius"), 8*linewidth) ; width := getparameter "width" ; distance := getparameter "distance" ; drawcolor := getparameter "drawcolor" ; labelcolor := getparameter "labelcolor" ; labelstyle := getparameter "labelstyle" ; labelformat := getparameter "labelformat" ; labelgap := getparameter "labeloffset" ; labelstrut := getparameter "labelstrut" ; labelanchor := getparameter "labelanchor" ; labelfraction := getparameter "labelfraction" ; axiscolor := getparameter "axiscolor" ; axisstyle := getparameter "axisstyle" ; axisformat := getparameter "axisformat" ; axisgap := getparameter "axisoffset" ; axislinewidth := getparameter "axislinewidth" ; axislinecolor := getparameter "axislinecolor" ; valuecolor := getparameter "valuecolor" ; valuestyle := getparameter "valuestyle" ; valueformat := getparameter "valueformat" ; valuegap := getparameter "valueoffset" ; nofsamplesets := getparametercount "samples" ; nofsamples := getmaxparametercount "samples" ; enddef ; def lmt_do_chart_stop = if getparameter "center" : currentpicture := currentpicture shifted - center currentpicture ; fi if (getparameter "backgroundcolor") <> "" : addbackground withcolor getparameter "backgroundcolor" ; fi if getparameter "trace" : save b ; path b ; b := boundingbox currentpicture ; draw image ( draw fullcircle scaled 1mm ; draw b ) dashed evenly scaled 1/4 withpen pencircle scaled .125mm withcolor "darkgray" ; fi popparameters ; enddef ; vardef lmt_do_chart_text(expr s, i, value) = lmt_text [ style = labelstyle, format = labelformat, strut = labelstrut, anchor = labelanchor, offset = labelgap, color = labelcolor, text = (getparameterdefault "labels" s i (decimal value)) background = "", ] enddef ; def lmt_do_chart_legend = if getparameter "showlegend" : n := getparametercount "legend" ; if n > 0 : save dx, dy, p, l, w, o, d, ddy ; picture l ; dx := xpart urcorner currentpicture + EmWidth ; dy := ypart urcorner currentpicture ; labelcolor := getparameter "legendcolor" ; labelstyle := getparameter "legendstyle" ; w := 2EmWidth ; o := .25EmWidth ; d := ExHeight ; ddy := .8LineHeight ; for i=1 upto n : dy := dy - ddy ; l := lmt_text [ text = getparameter "legend" i, anchor = "rt" style = labelstyle, color = labelcolor, background = "", ] ; fill leftboundary l rightenlarged w shifted (dx,dy+d) withcolor getparameter "fillcolors" i ; draw l shifted (dx+w+o,dy+d) ; endfor ; fi ; fi ; enddef ; % draw lmt_chart_circle [ % height = 4cm, % innerradius = 2.0cm, % samples = { { 10, 20, 30, 40, 50 } }, % percentage = false, % initialangle = 90, % linewidth = .125mm, % originsize = 0, % showlabels = false, % drawcolor = "white", % fillcolors = { "red", "green", "blue", "", "cyan" }, % linecolors = { "magenta", "orange", "darkgray", "orange", "darkgray" } % linecolors = { "", "orange", "", "orange", "" } % ] ; vardef lmt_do_chart_circle = image ( lmt_do_chart_start("chart:circle") ; if (nofsamplesets > 0) and (nofsamples > 0) : nofsamplesets := 1 ; save p, q, r, s, t, pl, ql, first, last, total, factor, n, percentage, initial, clockwise ; path p, q, r, s[], t[] ; boolean percentage, clockwise ; save value, v; clockwise := true ; percentage := getparameter "percentage" ; initial := if not clockwise : - fi getparameter "initialangle" ; % watch sign total := 0 ; for i = 1 upto nofsamples : value := getparameter "samples" (1) i ; if value > threshold : total := total + value ; fi ; endfor ; if total = 0 : message("zero total in circular chart"); else : factor := 100/total ; first := initial ; if clockwise : p := (reverse fullcircle rotated first) ysized (height) ; q := (reverse fullcircle rotated first) ysized (depth) ; else : p := fullcircle ysized (height) ; q := fullcircle ysized (depth) ; fi ; r := origin -- (2*height,0) ; pl := ((linewidth + linegap) / (arclength p)) * 360; ql := ((linewidth + linegap) / (arclength q)) * 360; v := 0 ; for i = 1 upto nofsamples : value := getparameter "samples" (1) i ; if value > threshold : v := v + 1 ; fillcolor := getparameter "fillcolors" i ; linecolor := getparameterdefault "linecolors" i "" ; if linecolor = "" : linecolor := fillcolor ; fi ; value := value * factor ; last := first if clockwise : - else : + fi (360/100) * value ; s[v] := ((p cutbefore (r rotated first)) cutafter (r rotated (last + pl))) ; t[v] := reverse ((q cutbefore (r rotated first)) cutafter (r rotated (last + ql))) ; path piece ; piece := s[v] -- t[v] -- cycle ; if fillcolor <> "" : fill piece withpen pencircle scaled linewidth withcolor fillcolor ; fi ; if linecolor <> "" : if linewidth > 0 : interim linecap := butt ; draw piece withpen pencircle scaled linewidth withcolor if linecolor <> "" : linecolor else drawcolor : fi ; fi ; fi ; first := last ; fi ; endfor ; if linewidth > 0 : clip currentpicture to p enlarged linewidth ; fi ; if getparameter "showlabels" : first := initial ; v := 0 ; for i = 1 upto nofsamples : value := getparameter "samples" (1) i ; if value > threshold : v := v + 1 ; last := first if clockwise : - else : + fi (360/100) * value * factor ; draw lmt_do_chart_text (s,i,value) shifted ((labelfraction*(height/2),0) rotated ((first+last)/2)) ; first := last ; fi endfor ; fi ; lmt_do_chart_legend ; fi ; fi ; lmt_do_chart_stop ; ) enddef ; vardef lmt_do_chart_histogram = image ( lmt_do_chart_start("chart:histogram") ; if (nofsamplesets > 0) and (nofsamples > 0) : save value, maximum, cumulative, maxwidth ; boolean cumulative ; maximum := getparameter "maximum" ; cumulative := getparameter "cumulative" ; if labelanchor = "center" : labelanchor := "vcenter" ; fi ; if maximum = 0 : for s = 1 upto nofsamplesets : for i = 1 upto nofsamples : value := getparameter "samples" s i ; maximum := if cumulative : maximum + value ; else : max(maximum,value) ; fi ; endfor ; endfor ; fi ; if nofsamplesets = 1 : distance := 0 ; fi ; maxwidth := nofsamplesets * nofsamples * width + (nofsamples - 1)* distance ; value := 0 ; for s = 1 upto nofsamplesets : for i = 1 upto nofsamples : value := if cumulative : value + fi (getparameter "samples" s i) * height / maximum ; fill unitsquare xyscaled (width,value) if linewidth > 0 : if i > 1 : leftenlarged (-linewidth/2) fi if i < nofsamples : rightenlarged (-linewidth/2) fi fi shifted (nofsamplesets*(i-1)*width+(s-1)*width+(i-1)*distance,0) withcolor getparameter "fillcolors" if colormode = "local" : s else : i fi ; endfor ; endfor ; setbounds currentpicture to unitsquare xyscaled (maxwidth,height) ; if getparameter "showlabels" : for s = 1 upto nofsamplesets : for i = 1 upto nofsamples : draw lmt_do_chart_text (s,i,getparameter "samples" s i) shifted (nofsamplesets*((i-1)*width)+width/2+(s-1)*width+(i-1)*distance,0) ; endfor ; endfor ; fi ; lmt_do_chart_legend ; fi ; lmt_do_chart_stop ; ) enddef ; vardef lmt_do_chart_bar = image ( lmt_do_chart_start("chart:bar") ; if (nofsamplesets > 0) and (nofsamples > 0) : save value, maximum, cumulative, maxheight ; boolean cumulative ; maximum := getparameter "maximum" ; cumulative := getparameter "cumulative" ; if labelanchor = "center" : labelanchor := "hcenter" ; fi ; if maximum = 0 : for s = 1 upto nofsamplesets : for i = 1 upto nofsamples : value := getparameter "samples" s i ; maximum := if cumulative : maximum + value else : max(maximum,value) fi ; endfor ; endfor ; fi ; if nofsamplesets = 1 : distance := 0 ; fi ; maxheight := nofsamplesets * nofsamples * height + (nofsamples - 1)* distance ; for s = 1 upto nofsamplesets : value := 0 ; for i = 1 upto nofsamples : value := if cumulative : value + fi (getparameter "samples" s i) * width / maximum ; fill unitsquare xyscaled (value,height) if linewidth > 0 : if i > 1 : topenlarged (-linewidth/2) fi if i < nofsamples : bottomenlarged (-linewidth/2) fi fi shifted (0,maxheight-nofsamplesets*i*height+(s-1)*height-(i-1)*distance) withcolor getparameter "fillcolors" if colormode = "local" : s else : i fi ; endfor ; endfor ; setbounds currentpicture to unitsquare xyscaled (width,maxheight) ; if getparameter "showlabels" : for s = 1 upto nofsamplesets : for i = 1 upto nofsamples : draw lmt_do_chart_text (s,i,getparameter "samples" s i) shifted (0,maxheight-nofsamplesets*(i*height)+height/2+(s-1)*height-(i-1)*distance) ; endfor ; endfor ; fi ; lmt_do_chart_legend ; fi ; lmt_do_chart_stop ; ) enddef ; %D This one is more complex than needed but I want to trace so I need all those %D variables. presetparameters "shade" [ alternative = "circular", path = origin -- cycle, trace = false % alternative = "circular" | "linear" % domain = { a, b } % radius = a | { a, b } % factor = a % origin = (a,b) | { (a,b), {c, d) } % vector = { a, b } % colors = { a, b } % center = a | { a, b } % direction = "up" | "down" | "left" | "right" | { a, b } ] ; % TODO: pass colors as strings def lmt_shade = applyparameters "shade" "lmt_do_shade" enddef ; vardef lmt_do_shade = image ( pushparameters "shade" ; save domain_min, domain_max, radius_a, radius_b, factor ; save color_a, color_b, center_a, center_b, alternative, s ; string color_a, color_b, alternative, s ; pair center_a, center_b ; alternative := getparameter "alternative" ; mfun_with_shade_method_analyze(getparameter "path") ; domain_min := 0 ; domain_max := 1 ; color_a := "white" ; color_b := "black" ; if alternative = "circular" : center_a := center mfun_shade_path ; center_b := center_a ; radius_a := 0 ; radius_b := mfun_max_radius(mfun_shade_path) ; factor := 1.2 ; else : center_a := llcorner mfun_shade_path ; center_b := urcorner mfun_shade_path ; radius_a := 0 ; radius_b := 0 ; factor := 0; fi ; if hasparameter "domain" : domain_min := getparameter "domain" 1 ; domain_max := getparameter "domain" 2 ; fi if hasparameter "radius" : if numeric getparameter "radius" : radius_a := 0 ; radius_b := getparameter "radius" ; 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() ; % textext runs twice .. maybe force once here if getparameter "origin" : currentpicture := currentpicture shifted -llcorner currentpicture ; fi ; popparameters ; if o <> 0 : setbounds currentpicture to boundingbox currentpicture enlarged o ; fi ; ) if w > 0 : if h > 0 : xysized(w,h) else : xsized(w) fi else : if h > 0 : ysized(h) fi fi enddef ; % Another experiment. Parameters might change pending a discussion between Alan % and me. presetparameters "surface" [ code = "x + y", color = "f, 0, 0", linecolor = 1, xmin = -1, xmax = 1, ymin = -1, ymax = 1, xstep = .1, ystep = .1, snap = .01, xvector = { -0.7, -0.7 }, yvector = { 1, 0 }, zvector = { 0, 1 }, light = { 3, 3, 10 }, bright = 100, clip = false, lines = true, linecolor = 1, % axis = { } % clipaxis = false axiscolor = "gray" axislinewidth = 1/2, ] ; def lmt_surface = applyparameters "surface" "lmt_do_surface" enddef ; vardef lmt_do_surface = image ( lmt_load_mlib_cnt ; pushparameters "surface" ; save currentpen; pen currentpen ; currentpen := pencircle scaled .25 ; interim linejoin := butt ; lmt_do_contour_shortcuts ; lua.mp.lmt_surface_do() ; currentpicture := currentpicture ysized getparameter "height" ; if hasparameter "axis" : save p ; picture p ; p := image ( if hasparameter "axis" 1 : draw ((origin) -- unitvector(getparameter "xvector")) scaled (getparameter "axis" 1) ; fi ; if hasparameter "axis" 2 : draw ((origin) -- unitvector(getparameter "yvector")) scaled (getparameter "axis" 2) ; fi ; if hasparameter "axis" 3 : draw ((origin) -- unitvector(getparameter "zvector")) scaled (getparameter "axis" 3) ; fi ; ) ; if getparameterdefault "clipaxis" false : clip p to boundingbox currentpicture ; fi ; draw p withpen pencircle scaled getparameter "axislinewidth" withcolor getparameter "axiscolor" ; fi ; popparameters ; ) enddef ; % I can make a variant that avoids the lmt_do ... and does an immediate function % call instead. presetparameters "mpsglyphs" [ name = "dummy", units = 1000, ] ; presetparameters "mpsglyph" [ category = "dummy", unicode = 0, % unichar = "" ] ; def lmt_registerglyphs = applyparameters "mpsglyphs" "lmt_do_registerglyphs" enddef ; def lmt_registerglyph = applyparameters "mpsglyph" "lmt_do_registerglyph" enddef ; newscriptindex mfid_registerglyphs ; mfid_registerglyphs := scriptindex "registerglyphs" ; def lmt_do_registerglyphs = runscript mfid_registerglyphs enddef ; newscriptindex mfid_registerglyph ; mfid_registerglyph := scriptindex "registerglyph" ; def lmt_do_registerglyph = runscript mfid_registerglyph enddef ; % An experimental macro: vardef registercomposedglyph (expr u) (suffix snippets) = save s ; s := getparameterdefault "mpsfont" "scale" 1 ; save llx, lly, urx, ury ; llx := xpart llcorner snippets[u] ; if llx <> 0 : % this should be an option or we need a lsb snippets[u] := snippets[u] shifted (-llx, 0) ; llx := 0; fi ; lly := ypart llcorner snippets[u] / s ; urx := xpart urcorner snippets[u] / s ; ury := ypart urcorner snippets[u] / s ; lmt_registerglyph [ category = getparameter "mpsfont" "category", unicode = u, code = "draw " & str snippets & "[" & decimal u & "]", height = ury, depth = - lly, width = urx - llx, boundingbox = { llx, lly, urx, ury } ] ; enddef ; vardef composeglyph (suffix snippets) = save u ; u := getparameter "mpsfont" "unicode" ; save s ; s := getparameterdefault "mpsfont" "scale" 1 ; snippets[u] := image ( for i=1 upto getparametercount "mpsfont" "shapes" : draw scantokens ( getparameter "mpsfont" "shapes" i "shape" ) if hasparameter "mpsfont" "shapes" i "color" : withcolor getparameter "mpsfont" "shapes" i "color" fi ; endfor ; ) scaled s ; registercomposedglyph(u, snippets) ; enddef ; permanent registercomposeglyph, composeglyph ; % Again an experiment (todo: the faster method): % watch the ; that we scan! newscriptindex mfid_remaptext ; mfid_remaptext := scriptindex "remaptext" ; def lmt_remaptext = runscript mfid_remaptext ; enddef ; triplet mfun_tt_s ; vardef rawmaptext(expr s) = mfun_tt_n := mfun_tt_n + 1 ; mfun_tt_c := nullpicture ; mfun_tt_o := nullpicture ; addto mfun_tt_o doublepath origin base_draw_options ; mfun_tt_r := lua.mp.mf_map_text(mfun_tt_n,s,catcoderegime) ; % can become mfid_maptext mfun_tt_s := lua.mp.mf_map_move(mfun_tt_n) ; % can become mfid_mapmove addto mfun_tt_c doublepath unitsquare xscaled wdpart mfun_tt_r yscaled (htpart mfun_tt_r + dppart mfun_tt_r) shifted (0,-dppart mfun_tt_r) withprescript "mf_object=text" withprescript "tx_index=" & decimal mfun_tt_n withprescript "tx_color=" & colordecimals colorpart mfun_tt_o ; mfun_tt_c enddef ; vardef svgtext(expr t) = save p ; picture p ; % mfun_tt_s := (0,0,0) ; % mfun_tt_r := (0,0,0) ; p := rawmaptext(t) ; p if (mfun_labtype.drt >= 10) : % drt etc shifted (0,ypart center p) fi shifted ( - mfun_labshift.drt(p) - (redpart mfun_tt_s,0) + (greenpart mfun_tt_s,bluepart mfun_tt_s) ) enddef ; vardef svg expr c = lmt_svg [ code = c ] enddef ; % Fun stuff: presetparameters "poisson" [ width = 50, height = 50, initialx = 0, initialy = 0, distance = 1, count = 20, macro = "draw", arguments = 2 ] ; def lmt_poisson = applyparameters "poisson" "lmt_do_poisson" enddef ; vardef lmt_do_poisson = image ( pushparameters "poisson" ; lua.mp.lmt_poisson_generate(); popparameters ; ) enddef ; permanent lmt_text, lmt_grid, lmt_axis, lmt_outline, lmt_followtext, lmt_arrow, lmt_placeholder, % lmt_path, lmt_function, lmt_poisson, lmt_mesh, lmt_chart_circle, lmt_chart_histogram, lmt_chart_bar, lmt_shade, lmt_contour, lmt_svg, lmt_surface, lmt_registerglyphs, lmt_registerglyph, lmt_remaptext, rawmaptext, svgtext, svg, OverlayMesh ; % nice hack newscriptindex mfid_scrutinized ; mfid_scrutinized := scriptindex "scrutinized" ; primarydef p scrutinized n = runscript mfid_scrutinized p n enddef ; permanent scrutinized ; % for now here % newscriptindex mfid_mpv_numeric ; mfid_mpv_numeric := scriptindex "mpv_numeric" ; % newscriptindex mfid_mpv_dimension ; mfid_mpv_dimension := scriptindex "mpv_dimension" ; % newscriptindex mfid_mpv_string ; mfid_mpv_string := scriptindex "mpv_string" ; % % def mpv_numeric = runscript mfid_mpv_numeric enddef ; % def mpv_dimension = runscript mfid_mpv_dimension enddef ; % def mpv_string = runscript mfid_mpv_string enddef ; % % permanent mpv_numeric, mpv_dimension, mpv_string ; % newscriptindex mfid_mpvar ; mfid_mpvar := scriptindex "mpvar" ; % % def mpvar = runscript mfid_mpvar enddef ; % d(imension) n(umber) s(tring) b(oolean) newscriptindex mfid_mpvard ; mfid_mpvard := scriptindex "mpvard" ; def mpvard = runscript mfid_mpvard enddef ; % dimension newscriptindex mfid_mpvarn ; mfid_mpvarn := scriptindex "mpvarn" ; def mpvarn = runscript mfid_mpvarn enddef ; % numeric newscriptindex mfid_mpvars ; mfid_mpvars := scriptindex "mpvars" ; def mpvars = runscript mfid_mpvars enddef ; % string newscriptindex mfid_mpvarb ; mfid_mpvarb := scriptindex "mpvarb" ; def mpvarb = runscript mfid_mpvarb enddef ; % string newscriptindex mfid_mpvar ; mfid_mpvar := scriptindex "mpvar" ; def mpvar = runscript mfid_mpvar enddef ; % automatic permanent mpvard, mpvarn, mpvars, mpvarb, mpvar ; % for old times sake (metafun manual) vardef textual primary p = false enddef ; % also for the menafun manual: newscriptindex mfid_labtorgb ; mfid_labtorgb := scriptindex "labtorgb" ; 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 ; % For now we collect all lmt namespace extensions here, so also this one: presetparameters "matrix" [ % cell = (1, 1), % from = (1, 1), % to = (1, 1), % shape = { "circle", "square" }, connect = { "center", "center" }, % text = "", ] ; def lmt_matrix = applyparameters "matrix" "lmt_do_matrix" enddef ; vardef mfun_lmt_matrix_cell (expr p) = % anchorbox ("matrix", xpart p, ypart p) ("matrix", xpart p + 1, ypart p) matrixcell (xpart p, ypart p) enddef ; % todo: lft rt etc but then we need to push/pop the linewidth too def mfun_lmt_matrix_connect (expr h, p, r, l, u, d, gap) = if h == "right" : center rightboundary (p enlarged gap) { r } elseif h == "left" : center leftboundary (p enlarged gap) { l } elseif h == "top" : center topboundary (p enlarged gap) { u } elseif h == "bottom" : center bottomboundary (p enlarged gap) { d } else : center (p enlarged gap) fi enddef ; def mfun_lmt_matrix_source (expr p, h, gap) = mfun_lmt_matrix_connect(h, p, right, left, up, down, gap) enddef ; def mfun_lmt_matrix_target (expr p, h, gap) = mfun_lmt_matrix_connect(h, p, left, right, down, up, gap) enddef ; vardef mfun_lmt_matrix_enhance (expr p, h) = if h = "circle" : fullcircle xysized (bbwidth p, bbheight p) shifted center p elseif h = "round" : (p smoothed getparameterdefault "radius" ExHeight) xysized (bbwidth p, bbheight p) elseif h = "path" : (getparameterpath "path") shifted center p elseif h = "scaledpath" : (getparameterpath "path") xysized (bbwidth p, bbheight p) shifted center p else : p fi enddef ; vardef lmt_do_matrix = image ( pushparameters "matrix" ; draw image ( save a, b, c, o, g ; path a, b, c ; numeric o, g ; if (hasparameter "arrowoffset") : g := getparameter "arrowoffset" ; elseif (hasparameter "linewidth") : g := getparameter "linewidth" ; else : g := 0; fi ; if (hasparameter "from") and (hasparameter "to") : a := mfun_lmt_matrix_cell(getparameter "from") ; b := mfun_lmt_matrix_cell(getparameter "to") ; if hasparameter "offset" : o := getparameter "offset" ; a := a enlarged o ; b := b enlarged o ; fi ; if hasparameter "shapes" : a := mfun_lmt_matrix_enhance(a, getparameter "shapes" 1) ; b := mfun_lmt_matrix_enhance(b, getparameter "shapes" 2) ; fi ; draw a if (hasparameter "colors") : withcolor (getparameter "colors" 1) elseif (hasparameter "color") : withcolor (getparameter "color") fi ; draw b if (hasparameter "colors") : withcolor (getparameter "colors" 2) elseif (hasparameter "color") : withcolor (getparameter "color") fi ; c := mfun_lmt_matrix_source(a, getparameter "connect" 1, g) .. mfun_lmt_matrix_target(b, getparameter "connect" 2, g) ; drawarrow c if (hasparameter "arrowcolor") : withcolor (getparameter "arrowcolor") elseif (hasparameter "color") : withcolor (getparameter "color") fi ; if hasparameter "label" : pushparameters "label" ; draw lmt_text [ text = getparameter "text", position = point (getparameterdefault "fraction" 1/2) of c, offset = if hasparameter "offset" : getparameter "offset" fi, color = if hasparameter "color" : getparameter "color" fi, anchor = if hasparameter "anchor" : getparameter "anchor" fi, % strut style format background backgroundcolor ] ; popparameters ; fi ; elseif (hasparameter "cell") : a := mfun_lmt_matrix_cell(getparameter "cell") ; if hasparameter "offset" : o := getparameter "offset" ; a := a enlarged o ; fi ; if hasparameter "shape" : a := mfun_lmt_matrix_enhance(a, getparameter "shape") ; fi ; draw a if (hasparameter "color") : withcolor (getparameter "color") fi ; fi; ) if (hasparameter "linewidth") : withpen pencircle scaled (getparameter "linewidth") fi popparameters ) enddef ; % This might move to its own module if we add more: presetparameters "glyphshape" [ % id = "", % character = "", shape = true, boundingbox = false, baseline = false, usedline = true, usedbox = true, italic = false, accent = false, dimensions = false, ] ; def lmt_glyphshape = applyparameters "glyphshape" "lmt_do_glyphshape" enddef ; vardef glyphshape_start(expr id, character) = lua.mp.lmt_glyphshape_start(id, character) ; enddef ; vardef glyphshape_stop = lua.mp.lmt_glyphshape_stop() ; enddef ; vardef glyphshape_n = lua.mp.lmt_glyphshape_n() enddef ; vardef glyphshape_path(expr i) = lua.mp.lmt_glyphshape_path(i) enddef ; vardef glyphshape_boundingbox = lua.mp.lmt_glyphshape_boundingbox() enddef ; vardef glyphshape_baseline = lua.mp.lmt_glyphshape_baseline() enddef ; vardef glyphshape_usedbox = lua.mp.lmt_glyphshape_usedbox() enddef ; vardef glyphshape_usedline = lua.mp.lmt_glyphshape_usedline() enddef ; vardef glyphshape_width = lua.mp.lmt_glyphshape_width() enddef ; vardef glyphshape_height = lua.mp.lmt_glyphshape_height() enddef ; vardef glyphshape_depth = lua.mp.lmt_glyphshape_depth() enddef ; vardef glyphshape_italic = lua.mp.lmt_glyphshape_italic() enddef ; vardef glyphshape_accent = lua.mp.lmt_glyphshape_accent() enddef ; vardef glyphshape_llx = lua.mp.lmt_glyphshape_llx() enddef ; % vardef glyphshape_dimensions = % unitsquare % xscaled glyphshape_width % yscaled (glyphshape_height - glyphshape_depth) % shifted (glyphshape_llx,glyphshape_depth) % enddef ; vardef glyphshape_usedaccent = (glyphshape_llx+glyphshape_accent,0.8*glyphshape_height) -- (glyphshape_llx+glyphshape_accent,1.2*glyphshape_height) enddef ; vardef glyphshape_useditalic = (glyphshape_llx+glyphshape_width + glyphshape_italic,glyphshape_depth) -- (glyphshape_llx+glyphshape_width + glyphshape_italic,glyphshape_height) enddef ; vardef lmt_do_glyphshape = image ( pushparameters "glyphshape" ; glyphshape_start(getparameter "id", getparameter "character") ; if getparameter "shape" : draw for i=1 upto glyphshape_n : glyphshape_path(i) && endfor cycle ; fi ; % if getparameter "dimensions" : % draw % glyphshape_dimensions % withcolor red; % ; if getparameter "boundingbox" : draw glyphshape_boundingbox withcolor red ; fi ; if getparameter "usedbox" : draw glyphshape_usedbox withcolor blue ; if getparameter "usedline" : draw glyphshape_usedline withcolor blue ; fi ; fi ; if (getparameter "accent") and (glyphshape_accent <> 0) : draw glyphshape_usedaccent withcolor green ; fi ; if (getparameter "italic") and (glyphshape_italic <> 0) : draw glyphshape_useditalic withcolor green ; fi ; % drawdot (glyphshape_width,0) ; % drawdot (glyphshape_llx,0) ; glyphshape_stop ; popparameters ; ) enddef ; % experimental: numeric last_potraced_count ; numeric last_potraced_width ; numeric last_potraced_height ; numeric last_potraced_xsize ; numeric last_potraced_ysize ; numeric last_potraced_xoffset ; numeric last_potraced_yoffset ; path last_potraced_bounds ; last_potraced_bounds := origin -- cycle ; path last_potraced_sized ; last_potraced_sized := origin -- cycle ; pair last_potraced_offset ; last_potraced_offset := origin; presetparameters "potraced" [ bytes = "", width = 0, height = 0, nx = 1, ny = 1, explode = false, swap = false, value = "1", optimize = false, % opticurve threshold = 1, % alphamax policy = "minority", % turnpolicy tolerance = 0.2, % opttolerance size = 2, % turdsize % stringname = "", % filename = "", criterium = 127, alternative = "path", % draw fill -> picture polygon = false, ] ; numeric n_lmt_potraced ; n_lmt_potraced := 0 ; def lmt_potraced = applyparameters "potraced" "lmt_do_potraced" enddef ; vardef lmt_do_potraced = if n_lmt_potraced = 0 : lmt_do_startpotraced ; lua.mp.lmt_step_potrace() hide ( lmt_do_steppotraced ; lmt_do_stoppotraced ; ) else : lua.mp.lmt_step_potrace() hide ( lmt_do_steppotraced ; ) fi enddef ; def lmt_startpotraced = applyparameters "potraced" "lmt_do_startpotraced" enddef ; def lmt_stoppotraced = lmt_do_stoppotraced enddef ; def lmt_do_startpotraced = if n_lmt_potraced = 0 : n_lmt_potraced := n_lmt_potraced + 1 ; pushparameters "potraced" ; lua.mp.lmt_start_potrace() ; fi enddef ; def lmt_do_stoppotraced = if n_lmt_potraced = 1 : n_lmt_potraced := n_lmt_potraced - 1 ; lua.mp.lmt_stop_potrace() ; popparameters ; fi enddef ; vardef lmt_do_steppotraced = last_potraced_count := getparameter("count") ; last_potraced_width := getparameter("width") ; last_potraced_height := getparameter("height") ; last_potraced_xsize := getparameter("xsize"); last_potraced_ysize := getparameter("ysize"); last_potraced_xoffset := getparameter("xoffset"); last_potraced_yoffset := getparameter("yoffset"); last_potraced_bounds := unitsquare xscaled last_potraced_width yscaled last_potraced_height ; last_potraced_sized := unitsquare xscaled last_potraced_xsize yscaled last_potraced_ysize ; last_potraced_offset := (last_potraced_xoffset,-(last_potraced_ysize - last_potraced_yoffset)) ; enddef ; def lmt_showrivers(expr stepsize, width, height, showpolygon) = picture q ; q := image ( lmt_startpotraced [ stringname = "profile", threshold = .5, ] ; % draw lmt_potraced [ % size = 1, % index = 1, % ] withcolor "middleyellow" ; % draw lmt_potraced [ % size = 1, % index = 2, % ] withcolor "middlegray" ; fill lmt_potraced [ size = 1, first = 3, polygon = showpolygon, ] withcolor "middlegreen" ; fill lmt_potraced [ size = 3, first = 3, polygon = showpolygon, ] withcolor "middleblue" ; fill lmt_potraced [ size = stepsize, first = 3, polygon = showpolygon, ] withcolor "middlered" ; lmt_stoppotraced ; ) ; setbounds q to last_potraced_bounds enlarged (-2,-2) ; draw q xysized (width,height) ; enddef;