From e0c6872cf40896c7be36b11dcc744620f10adf1d Mon Sep 17 00:00:00 2001 From: Norbert Preining Date: Mon, 2 Sep 2019 13:46:59 +0900 Subject: Initial commit --- graphics/fig2mf/graphbase.mf | 1277 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 1277 insertions(+) create mode 100644 graphics/fig2mf/graphbase.mf (limited to 'graphics/fig2mf/graphbase.mf') diff --git a/graphics/fig2mf/graphbase.mf b/graphics/fig2mf/graphbase.mf new file mode 100644 index 0000000000..f3a4917c20 --- /dev/null +++ b/graphics/fig2mf/graphbase.mf @@ -0,0 +1,1277 @@ +%%% Date: Mon, 12 Oct 92 22:32:32 EST +%%% Message-Id: <9210121232.AA18641@ee.latrobe.edu.au> +%%% To: ajs@msdrl.com +%%% Subject: graphbase.mf 0.2 gt mod 1 Mon 12 Oct 1992. +%%% Cc: ecsgrt@ee.latrobe.edu.au +%%% Status: OR +%%% +%%% 12:10 GMT Mon 12 Oct 1992 - Geoffrey Tobin. +%%% +%%% Dear Anthony, +%%% +%%% Latest mod of "graphbase.mf". +%%% +%%% This is still a long way from what it ought to be for Fig 2.1, but +%%% maybe you can use some of the new code. Much of it is comments! +%%% +%%% I've modified onedot based on Knuth's "drawdot", written a hatchpath +%%% macro to complement shadepath, attempted a gray level formula to match +%%% human light sensitivity, some macros to draw as well as shade or +%%% hatch, and an arrowpath macro to draw an arrow for arbitrary path and +%%% to draw that path. +%%% +%%% THe 3-point arc code is included, with arcthreearrow to draw an arrow +%%% as well. +%%% +%%% Some code for drawing Interpolated Splines is included. The macros to +%%% test are ispline, isplinearrow, and isplineshade. +%%% +%%% Backward arrows are on my agenda. +%%% +%%% All the Best! +%%% Geoffrey Tobin +%%% +%%% +%%% File: graphbase.mf +%%% + +mode_setup; +message "mfpic version 0.2 graphbase - gt mod 1 - 10:16 GMT Mon 12 Oct 1992"; + +% set up local environment + +def mfpicenv = +begingroup + +% miscellaneous utilities + +% gt - op_pair operates with "op" +% on both parts of a pair p. + +save op_pair; + +vardef op_pair (text op) (expr p) = + (op (xpart p), op (ypart p)) +enddef; + +save floorpair, ceilingpair; + +def floorpair = op_pair (floor) enddef; +def ceilingpair = op_pair (ceiling) enddef; + +% gt - Should there be more error-checking, +% eg of types, in these utility routines? +% That would slow them down. + +% gt - textpairs converts the text t into the +% array of n pairs, pts, that it contains. + +save textpairs; + +def textpairs (text t) (suffix pairs_, n_) = + n_ := 0; + for q=t: + pairs_[incr n_] := q; + endfor; +enddef; + +% gt - Watch out! Need to ensure that "p_", etc., +% don't clash with any name in the passed text "t". +% That's a nasty error to trace! +% +% A name conflict between local variables and variables +% in a text parameter is especially likely in low-level +% utility macros, such as minpair, maxpair and corner. +% +% Unfortunately, we can't *ensure* it won't happen. +% So I appended the underscore to reduce the +% probability of that happening. +% +% Evidently that's why Knuth uses "u_" in "max" and +% "min" in "plain.mf". + +% gt - corner may be used for finding +% a corner of the bounding box of the +% set of points listed in u and t. +% Other uses may be imaginable. (?) + +save corner; + +vardef corner (text xop) (text yop) + (expr u)(text t) = + save p_; + pair p_; + p_ := u; + for q=t: + p_ := (xop (xpart p_, xpart q), + yop (ypart p_, ypart q)); + endfor; + p_ +enddef; + +% gt - bottom right, bottom right, +% top left, top right corners. + +save blpair, brpair, tlpair, trpair; + +def blpair = corner (min) (min) enddef; +def brpair = corner (max) (min) enddef; +def tlpair = corner (min) (max) enddef; +def trpair = corner (max) (max) enddef; + +def minpair = blpair enddef; +def maxpair = trpair enddef; + +% setup +% gt - sets the graphics coordinates. + +save bounds, + xneg,xpos,yneg,ypos; + +def bounds(expr a,b,c,d) = + xneg:=a; + xpos:=b; + yneg:=c; + ypos:=d; +enddef; + +% conversion + +save xconv; + +def xconv(expr xvalue) = + ((xvalue-xneg)/(xpos-xneg))*w +enddef; + +save unxconv; + +def unxconv(expr pvalue) = + ((pvalue/w)*(xpos-xneg)+xneg) +enddef; + +save yconv; + +def yconv(expr yvalue) = + ((yvalue-yneg)/(ypos-yneg))*h +enddef; + +save ztr; + +transform ztr; + +save setztr; + +def setztr = + ztr:=identity + shifted -(xneg,yneg) + xscaled (w/(xpos-xneg)) + yscaled (h/(ypos-yneg)); +enddef; + +% pen width +% in pixel coordinates + +save penwd; + +newinternal penwd; + +% gt - initial value of penwd. + +interim penwd := 0.5pt; + +% arrowheads +% in pixel coordinates + +% hdwdr = arrowhead's ratio of width to length, +% hdten = tension used in drawing its barbs. + +save hdwdr, hdten; + +newinternal hdwdr, hdten; + +% gt - initial values of hdwdr, hdten. + +interim hdwdr := 1; +interim hdten := 1; + +% draw an arrowhead. + +save head, p,side; + +def head(expr front, back, width, t) = + pair p[], side; + side := (width/2) * + ((front-back) rotated 90); + p1 := back + side; + p2 := back - side; + draw front{back-front}..tension t..p1; + draw front{back-front}..tension t..p2; +enddef; + +% draw an arrowhead of length hlen +% for a path f. + +save headpath, p; + +def headpath(expr f,hlen) = + pair p[]; + p2:=point infinity of f; + p1:=direction infinity of f; + if p1<>(0,0): + head(p2,p2-(hlen*unitvector(p1)), + hdwdr,hdten); + fi; +enddef; + +% shading and hatching routines +% in pixel coordinates + +% gt - modified onedot based on +% plain metafont's "drawdot". +% Used in stipple shading. +% +% Note: +% currentpen_path, def_pen_path_, +% t_, and penspeck are defined +% in plain metafont ("plain.mf" +% or "plain.base"). + +save onedot; + +def onedot(expr p)(suffix v) = + if unknown currentpen_path: + def_pen_path_ + fi; + addto v + contour currentpen_path + shifted p.t_ + withpen penspeck +enddef; + +% gt - draw path f in picture v. +% ("onepath" is the old "onedot", +% but f is intended to be a general path.) +% Used, eg, in hatching and in drawpaths. + +save onepath; + +def onepath (expr f) (suffix v) = + addto v doublepath f + withpen currentpen; +enddef; + +% gt - Paths must be continuous - I think +% - but using suffix, we can pass arrays +% of paths. +% +% My eventual goal is to do as much as +% feasible, and memory-affordable, in +% graphics coordinates, so we can rotate +% and otherwise transform sets of paths +% before drawing. + +% gt - draw the n paths f[] in picture v. + +save drawpaths; + +def drawpaths (expr n) (suffix f, v) = + for i=1 upto n: + onepath (f[i], v); + endfor; +enddef; + +% clip picture v to interior of path f. + +save clip; + +vardef clip(expr f)(suffix v) = + save vt; + picture vt; + vt:=v; + cull vt keeping (1,infinity); + addto vt contour f; + cull vt keeping (2,infinity); + vt +enddef; + +% gt - find bounding box of path f. + +save boundingbox, p; + +def boundingbox (expr f) (suffix ll, ur) = + ur := ll := point 0 of f; + pair p[]; + for i=0 upto length f: + p0 := point i of f; + p1 := precontrol i of f; + p2 := postcontrol i of f; + ll := minpair (ll, p0, p1, p2); + ur := maxpair (ur, p0, p1, p2); + endfor; +enddef; + +% gt - shading. + +% gt - I'm not so happy with dot densities +% over a uniform range. +% Here's code to approximate what may +% be the human eye's light sensitivity. +% +% Mind you, this sort of stuff is done much +% faster in C. + +save exp; + +vardef exp (expr x) = + mexp (256 * x) +enddef; + +% graya scales the spacing sp; +% grayb scales the graylevel g. + +save graya, grayb; + +newinternal graya, grayb; + +% initial values of gray parameters. + +interim graya := 0.5 pt; +interim grayb := 3/20; + +% setgraypars sets gray parameters. +% experimentation is recommended. + +save setgraypars; + +def setgraypars (expr a, b) = + graya := a; + grayb := b; +enddef; + +% gt - grayspace gives the dot spacing +% for graylevel g. +% +% Not sure how this model performs. + +save grayspace; + +vardef grayspace (expr g) = + if g <= 1: % white + infinity + elseif g >= 21: % black + 0 + else: % gray + graya / (1 - exp (-g * grayb)) + fi +enddef; + +% gt - stipple upright box with lower left +% at ll, upper right at ur, in picture v; +% 2sp is dot spacing (rows offset by sp). +% +% NB: "stipple" means "shade with dots", +% if I understand my English dictionary. +% +% Thomas Leathrum devised the trick whereby +% the dots are arranged on a regular grid +% of mesh size sp by sp with the pixel +% origin as one crosspoint. This ensures +% that objects shaded with the same stipple +% density may be cleanly overlaid. + +save shadebox, sll, mn, m, n, twosp, p; + +def shadebox (expr sp, ll, ur) (suffix v) = + pair sll; + sll:=sp*(ceilingpair(ll/sp)); + pair mn; + mn:=floorpair((ur-sll)/sp); + m:=xpart mn; + n:=ypart mn; + twosp:=2sp; + v:=nullpicture; + pair p[]; + p2:=sll; + for i=0 upto m: + p3:=p2 if odd i: +(0,sp) fi; + for j=0 upto n: + if (not odd (i+j)): + onedot (p3, v); + p3:=p3+(0,twosp); + fi; + endfor; + p2:=p2+(sp,0); + endfor; +enddef; + +% stipple interior of closed path f; +% if spacing not positive, fill. + +save shadepath, ll, ur, v; + +def shadepath (expr sp, f) = + if not cycle f: ; + elseif sp<=0: + fill f; + elseif sp < infinity: + pair ll, ur; + boundingbox (f, ll, ur); + picture v; + shadebox (sp, ll, ur, v); + addto currentpicture + also clip(f,v); + fi; +enddef; + +% gt - hatch an upright box in picture v, +% with line separation sep x sep. +% +% Notice the similarity to shadebox. + +save hatchbox, llx, lly, urx, ury, sll, + mn, m, n, f; + +def hatchbox (expr sep, ll, ur) (suffix v) = + llx := xpart ll; + lly := ypart ll; + urx := xpart ur; + ury := ypart ur; + pair sll; + sll := sep * ceilingpair (ll/sep); + pair mn; + mn := floorpair ((ur-sll)/sep); + m := xpart mn; + n := ypart mn; + v := nullpicture; + path f; + f := (xpart sll, lly)--(xpart sll, ury); + for i=0 upto m: + onepath (f, v); + f := f translated (sep, 0); + endfor; + f := (llx, ypart sll)--(urx, ypart sll); + for j=0 upto n: + onepath (f, v); + f := f translated (0, sep); + endfor; +enddef; + +save hatchpath, ll, ur, v; + +def hatchpath (expr sep, f) = + if not cycle f: ; + elseif sep<=0: + fill f; + elseif sep < infinity: + pair ll, ur; + boundingbox (f, ll, ur); + picture v; + hatchbox (sep, ll, ur, v); + addto currentpicture + also clip (f, v); + fi; +enddef; + +% gt - shading & hatching macros +% with a syntax like draw, fill, +% unfill and erase. +% sp, sep are in pixel coords, +% f in graphics coordinates; +% f is transformed transparently. + +save shade; + +def shade (expr sp) expr f = + shadepath (sp, f transformed ztr); +enddef; + +save hatch; + +def hatch (expr sep) expr f = + hatchpath (sep, f transformed ztr); +enddef; + +% gt - common combinations. + +save drawshade; + +def drawshade (expr sp) expr f = + draw f transformed ztr; + shade (sp) f; +enddef; + +save drawhatch; + +def drawhatch (expr sep) expr f = + draw f transformed ztr; + hatch (sep) f; +enddef; + +% * rest of macros start in graphing +% coordinates but convert to pixel +% to draw +% * variables ending in "_px" +% converted to pixel +% * exceptions are the TeX dimensions +% here called: +% ptwd, hlen, dlen, slen, len, sp, sep +% all of which are in pixel coordinates +% * macros beginning with "mk" operate +% entirely in graphing coordinates + +% general path construction + +save mkpath; + +vardef mkpath(expr smooth, cyclic, n) + (suffix pts) = + if smooth: + if cyclic: + pts[1]{pts[2]-pts[n]} + else: + pts[1] + fi + for i=2 upto n-1: + ..pts[i]{pts[i+1]-pts[i-1]} + endfor + if cyclic: + ..pts[n]{pts[1]-pts[n-1]}..cycle + else: + ..pts[n] + fi + else: + for i=1 upto n-1: + pts[i] -- + endfor + pts[n] + if cyclic: + -- cycle + fi + fi +enddef; + +% points, lines, and arrows + +save pointd, p; + +def pointd(expr a,ptwd) = + pair p_px; + p_px:=a transformed ztr; + fill fullcircle scaled ptwd shifted p_px; +enddef; + +save line; + +def line(expr a,b) = + draw (a..b) transformed ztr; +enddef; + +% gt - arrowpath draws path f +% with an arrowhead; +% hlen is in pixel coordinates; +% f is in graphics coords; +% f is transformed transparently. +% Compare shade, hatch, etc., +% and contrast shadepath. + +save arrowpath, f_px; + +def arrowpath (expr hlen) expr f = + path f_px; + f_px := f transformed ztr; + draw f_px; + headpath (f_px, hlen); +enddef; + +% gt - arrow now uses arrowpath. + +save arrow; + +def arrow(expr tl,hd,hlen) = + arrowpath (hlen) tl..hd ; +enddef; + +% gt - "px" was too frequent +% in dottedline, and made the code +% hard to read, so I've deleted it. +% Only a and b are in graphics coords. + +save dottedline, + p, v, l, delta, n; + +def dottedline (expr a, b, dlen, slen) = + pair p[]; + p1 := a transformed ztr; + p3 := b transformed ztr; + l := length (p3-p1); + if (l > 2dlen) and + (dlen >= 0) and (slen >= 0): + else: + pair v; + v := unitvector (p3-p1); + n := floor ((l+slen-dlen) / (dlen+slen)); + delta := (l-dlen) / n - (dlen+slen); + for i=1 upto n: + p2 := p1 + dlen * v; + draw p1..p2; + p1 := p2 + (slen+delta) * v; + endfor; + fi; + draw p1..p3; +enddef; + +save dottedarrow; + +def dottedarrow(expr tl,hd,dlen, + slen,hlen) = + dottedline(tl,hd,dlen,slen); + headpath((tl..hd) transformed ztr,hlen); +enddef; + +% axes and axis marks + +save axes; + +def axes(expr hlen) = + arrow((0,yneg),(0,ypos),hlen); + arrow((xneg,0),(xpos,0),hlen); +enddef; + +save xmarks; + +def xmarks(expr len)(text t) = + for a=t: + draw (xconv(a),yconv(0)-(len/2)).. + (xconv(a),yconv(0)+(len/2)); + endfor; +enddef; + +save ymarks; + +def ymarks(expr len)(text t) = + for a=t: + draw (xconv(0)-(len/2),yconv(a)).. + (xconv(0)+(len/2),yconv(a)); + endfor; +enddef; + +% upright rectangles + +save mkrect; + +vardef mkrect(expr ll,ur) = + ll--(xpart ll,ypart ur)-- + ur--(xpart ur,ypart ll)--cycle +enddef; + +save rect; + +def rect(expr ll,ur) = + draw mkrect(ll,ur) transformed ztr; +enddef; + +save dottedrect; + +def dottedrect(expr ll,ur,dlen,slen) = + dottedline(ll,(xpart ll,ypart ur), + dlen,slen); + dottedline((xpart ll,ypart ur),ur, + dlen,slen); + dottedline(ur,(xpart ur,ypart ll), + dlen,slen); + dottedline((xpart ur,ypart ll),ll, + dlen,slen); +enddef; + +save block; + +def block(expr ll,ur) = + fill mkrect(ll,ur) transformed ztr; +enddef; + +% gt - rectshade now uses shade. + +save rectshade; + +def rectshade(expr sp,ll,ur) = + shade (sp) mkrect (ll, ur); +enddef; + +% circles and ellipses + +save mkellipse; + +vardef mkellipse(expr center,radx,rady, + angle) = + save t; + transform t; + t := identity + xscaled (2 * radx) + yscaled (2 * rady) + rotated angle + shifted center; + fullcircle transformed t +enddef; + +save ellipse; + +def ellipse(expr center,radx,rady, + angle) = + draw + mkellipse(center,radx,rady,angle) + transformed ztr; +enddef; + +save circle; + +def circle(expr center,rad) = + ellipse(center,rad,rad,0); +enddef; + +% gt - ellshade now uses shade. + +save ellshade; + +def ellshade (expr sp, center, + radx, rady, angle) = + shade (sp) + mkellipse (center, radx, rady, angle); +enddef; + +save circshade; + +def circshade(expr sp, center,rad) = + ellshade(sp,center,rad,rad,0); +enddef; + +% circular arcs + +% gt - mkarc now calculates +% n using ceiling, not floor; +% and saves theta, not i. + +save mkarc; + +vardef mkarc(expr center,from,sweep) = + if sweep=0: + from + else: + begingroup + save n, theta, p; + n := 1 + ceiling (abs (sweep) / 45); + if n<3: n:=3; fi; + theta:=sweep/(n-1); + pair p[]; + p1:=from; + for i=2 upto n: + p[i]:=p[i-1] + rotatedabout (center,theta); + endfor; + mkpath(true,false,n,p) + endgroup + fi +enddef; + +% gt - note that when sweep is a multiple +% of 360 degrees, disp is logically +% infinite, not zero; then the center is +% at infinity. In practice, arccenter +% ought not to be called in that case. + +save arccenter; + +vardef arccenter(expr from,to,sweep) = + save midpt, disp; + pair midpt; + midpt:=(0.5)[from,to]; + disp:= + if ((sweep mod 360)=0): + 0 + else: + cosd(sweep/2)/sind(sweep/2) + fi; + midpt+(disp*((to-from) rotated 90)/2) +enddef; + +% gt - mkarcto makes an arc given two points +% on the arc and the sweep angle. +% If sweep is a multiple of 360 degrees, +% then the arc is a straight line; +% if sweep is also nonzero, then that +% line should be infinite, but I use +% from--to instead. + +save mkarcto; + +vardef mkarcto (expr from, to, sweep) = + if from = to: + from + elseif (sweep mod 360) = 0: + from--to + else + begingroup + save center; + pair center; + center:=arccenter (from, to, sweep); + mkarc (center, from, sweep) + endgroup + fi +enddef; + +% gt - arc now uses mkarcto. + +save arc; + +def arc(expr from,to,sweep) = + draw mkarcto (from, to, sweep) + transformed ztr; +enddef; + +% gt - arcarrow now uses mkarcto +% and arrowpath. + +save arcarrow; + +def arcarrow(expr hlen,from,to,sweep) = + arrowpath (hlen) mkarcto (from, to, sweep); +enddef; + +% gt - mkchordto makes a cyclic path from +% the arc from "from" to "to" with a sweep +% angle of "sweep", and its chord from +% "to" to "from". + +save mkchordto; + +vardef mkchordto (expr from, to, sweep) = + mkarcto (from, to, sweep) -- cycle +enddef; + +% gt - arcshade now uses mkchordto +% and shade. + +save arcshade; + +def arcshade(expr sp,from,to,sweep) = + shade (sp) mkchordto (from, to, sweep); +enddef; + +% gt - three-point arcs. + +save mkarcthree; + +vardef mkarcthree (expr first, mid, last) = + save p, sweep, n, theta, center; + pair p[]; + p1 := first; + sweep := 2 (angle (last-mid) - angle (mid-first)); + if abs (sweep) <= 90: + n := 3; + p2 := mid; + p3 := last; + else: + n := 1 + ceiling (abs (sweep) / 45); + theta := sweep / (n-1); + pair center; + center := arcthreecenter (first, mid, last); + for i=2 upto n: + p[i] := p[i-1] rotatedabout (center, theta); + endfor; + fi; + mkpath (true, false, n, p) +enddef; + +save arcthreecenter; + +vardef arcthreecenter (expr first, mid, last) = + save c, m, d; + pair c, m[], d[]; + d1 := (mid - first) rotated 90; + d2 := (last - mid) rotated 90; + m1 := 0.5 [first, mid]; + m2 := 0.5 [mid, last]; + c = m1 + whatever * d1 = m2 + whatever * d2; + c +enddef; + +save arcthree; + +def arcthree (expr first, mid, last) = + draw mkarcthree (first, mid, last) transformed ztr; +enddef; + +save arcthreearrow; + +def arcthreearrow (expr hlen, first, mid, last) = + arrowpath (hlen) mkarcthree (first, mid, last); +enddef; + +% modified polar coordinates + +% gt - mklinedir makes a path from point "a" +% to a point displaced "len" in direction "theta" +% from "a". + +save mklinedir; + +vardef mklinedir (expr a, theta, len) = + a -- (a + len * (dir theta)) +enddef; + +% gt - linedir now uses mklinedir. + +save linedir; + +def linedir(expr a,theta,len) = + draw mklinedir (a, theta, len) + transformed ztr; +enddef; + +% gt - arrowdir now uses mklinedir +% and arrowpath. + +save arrowdir; + +def arrowdir(expr hlen,a,theta,len) = + arrowpath (hlen) + mklinedir (a, theta, len); +enddef; + +% gt - mkarcth makes an arc path with +% given center, radius "rad", initial +% angle "frtheta", and final angle +% "totheta". + +save mkarcth; + +vardef mkarcth (expr center, + frtheta, totheta, rad) = + save from; + pair from; + from := center + rad * (dir frtheta); + mkarc (center, from, totheta-frtheta) +enddef; + +% gt - arcth now uses mkarcth. + +save arcth; + +def arcth(expr center, + frtheta,totheta,rad) = + draw mkarcth (center, frtheta, + totheta, rad) + transformed ztr; +enddef; + +% gt - arcth now uses mkarcth +% and arrowpath. + +save arctharrow; + +def arctharrow(expr hlen,center, + frtheta,totheta,rad) = + arrowpath (hlen) + mkarcth (center, frtheta, + totheta, rad); +enddef; + +% gt - mkwedge makes a wedge-shaped path +% with apex at "center", radius "rad", +% initial angle "frtheta", and final angle +% "totheta". + +save mkwedge; + +vardef mkwedge (expr center, frtheta, totheta, rad) = + center -- mkarcth (from, frtheta, totheta, rad) + -- cycle +enddef; + +% gt - wedge draws a sector of a circle. + +save wedge; + +def wedge (expr center, frtheta, totheta, rad) = + draw mkwedge (center, frtheta, totheta, rad) + transformed ztr; +enddef; + +% gt - wedgeshade now uses mkwedge and shade. + +save wedgeshade; + +def wedgeshade (expr sp, center, + frtheta, totheta, rad) = + shade (sp) mkwedge (center, frtheta, totheta, rad); +enddef; + +% gt - drawshadewedge draws and shades a wedge. + +save drawshadewedge; + +def drawshadewedge (expr sp, center, + frtheta, totheta, rad) = + draw mkwedge (center, frtheta, totheta, rad) + transformed ztr; + shade (sp) mkwedge (center, frtheta, totheta, rad); +enddef; + +% curves + +% gt - watch out for that "text containing a local +% variable's name" conflict! I dearly wish that +% weren't a danger. +% Perhaps it's not so likely at the level of "mkcurve", +% as the "mk" macros are often fed numeric constants. + +save mkcurve; + +vardef mkcurve(expr smooth,cyclic) + (text t) = + save n_, p_; + pair p_[]; + textpairs (t) (p_, n_); + mkpath(smooth,cyclic,n_,p_) +enddef; + +save curve; + +def curve(expr smooth,cyclic) + (text t) = + draw mkcurve(smooth,cyclic,t) + transformed ztr; +enddef; + +% gt - curvedarrow now uses arrowpath. + +save curvedarrow; + +def curvedarrow(expr smooth,hlen) + (text t) = + arrowpath (hlen) + mkcurve (smooth, false, t); +enddef; + +% shading of cyclic curves + +% gt - cycleshade now uses shade. + +save cycleshade; + +def cycleshade(expr sp,smooth)(text t) = + shade (sp) mkcurve (smooth,true,t); +enddef; + +% gt - interpolated splines with controls. + +% gt - mkipath uses the interpolation points, +% p[], and the left and right control points, +% l[] and r[]. +% Observe that for cyclic I-splines, l[n] is +% used, not l1, though they are equal; this +% simplifies the algorithm. + +save mkipath; + +vardef mkipath (expr closed, n) + (suffix p, l, r) = + for i=1 upto n-1: + p[i]..controls r[i] and l[i+1].. + endfor + if closed: + cycle + else: + p[n] + fi +enddef; + +% gt - mkisplineA uses the I-spline data, +% in the order that Fig 2.1 gives them, +% points line pl and control line cl, +% stores them in p[], l[] and r[], +% then calls mkipath. +% +% pl should have the form: +% (x1,y1) ... (xn,yn) +% and cl the form: +% (lx1,ly1) (rx1,ry1) ... (lxn,lyn) (rxn,ryn) +% which reflect how Fig outputs its data. +% +% Don't feed it the "9999 9999", please! +% +% Perhaps the input should be massaged by a +% preprocessor program (e.g. in C), to separate +% the initially interleaved left and right control +% points, before being given to graphbase? +% That would simplify mkisplineA, and run faster. + +save mkisplineA; + +vardef mkisplineA (expr closed) + (text pl) (text cl) = + save p, l, r, n, i, isleft; + pair p[], l[], r[]; + boolean isleft; + textpairs (pl) (p, n); + i := 1; + isleft := true; + for b=cl: + if isleft: + l[i] := b; + isleft := false; + else: + r[i] := b; + i := i+1; + isleft := true; + fi; + endfor; + mkipath (closed, n, p, l, r) +enddef; + +% gt - mkisplineB uses the points line, +% and the separated left and right controls. +% +% See how much simpler this is than +% mkisplineA. + +save mkisplineB; + +vardef mkisplineB (expr closed) + (text pl) (text lc) (text rc) = + save p, l, r, n, i; + pair p[], l[], r[]; + textpairs (pl) (p, n); + textpairs (lc) (l, i); + textpairs (rc) (r, i); + mkipath (closed, n, p, l, r) +enddef; + +% gt - the usual variations. +% +% These use mkisplineA. I'd prefer +% mkisplineB. + +% draw an interpolated spline, +% with points line pl and interleaved +% control line cl. + +save ispline; + +def ispline (expr closed) + (text pl) (text cl) = + draw mkisplineA (closed) (pl) (cl) + transformed ztr; +enddef; + +save isplinearrow; + +def isplinearrow (expr hlen, closed) + (text pl) (text cl) = + arrowpath (hlen) + mkisplineA (closed) (pl) (cl); +enddef; + +% gt - isplineshade assumes that the +% I-spline is closed. + +save isplineshade; + +def isplineshade (expr sp) + (text pl) (text cl) = + shade (sp) + mkisplineA (true) (pl) (cl); +enddef; + +% functions + +% gt - better be on the safe side with +% the function text, so use "_" on local +% variables in "mkfcn". + +save mkfcn; + +vardef mkfcn(expr smooth,bmin,bmax,bst) + (suffix bv)(text fcnpr) = + save p_, i_; + pair p_[]; + i_ := 0; + for bv=bmin step bst + until bmax+(bst/2): + p_[incr i_] := fcnpr; + endfor; + mkpath (smooth, false, i_ , p_) +enddef; + +save function; + +def function(expr smooth,xmin,xmax,st) + (text fx) = + draw mkfcn (smooth, xmin, xmax, st, + x, (x,fx)) + transformed ztr; +enddef; + +save parafcn; + +def parafcn(expr smooth,tmin,tmax,st) + (text ft) = + draw mkfcn (smooth, tmin, tmax, st, + t, ft) + transformed ztr; +enddef; + +% gt - mksfn constructs a path from +% two functions and the verticals +% at either side. +% +% mksfn is used by shadefcn. + +save mksfn; + +vardef mksfn (expr smooth, xmin, xmax, st) + (text fcni) (text fcnii) = + mkfcn(smooth,xmin,xmax,st,x,(x,fcni)) + -- + reverse + mkfcn(smooth,xmin,xmax,st,x,(x,fcnii)) + -- cycle +enddef; + +% gt - description: +% shadefcn shades between two functions over +% the range xmin to xmax, stepping by st, +% with dot spacing sp. +% it does not draw the functions. + +% gt - shadefcn now uses mksfn. +% I don't see the connection between the dot +% spacing sp and the function step size st. + +save shadefcn, st; + +def shadefcn(expr sp, xmin, xmax) + (text fcni)(text fcnii) = + st := unxconv (sp); + shade (sp) + mksfn (false, xmin, xmax, st) (fcni) (fcnii); +enddef; + +% gt - drawshadefcn draws both functions fcni +% and fcnii, and shades between them. + +save drawshadefcn; + +def drawshadefcn (expr sp, smooth, xmin, xmax, st) + (text fcni) (text fcnii) = + function (smooth, xmin, xmax, st) (fcni); + function (smooth, xmin, xmax, st) (fcnii); + shadefcn (sp, xmin, xmax) (fcni) (fcnii); +enddef; + +enddef; % mfpicenv + +def endmfpicenv = + endgroup; +enddef; + + -- cgit v1.2.3