summaryrefslogtreecommitdiff
path: root/Master/texmf-dist/metapost/context/base/mpxl/mp-lmtx.mpxl
diff options
context:
space:
mode:
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.mpxl2403
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 ;