summaryrefslogtreecommitdiff
path: root/graphics/fig2mfpic/graphbase.mf
diff options
context:
space:
mode:
authorNorbert Preining <norbert@preining.info>2019-09-02 13:46:59 +0900
committerNorbert Preining <norbert@preining.info>2019-09-02 13:46:59 +0900
commite0c6872cf40896c7be36b11dcc744620f10adf1d (patch)
tree60335e10d2f4354b0674ec22d7b53f0f8abee672 /graphics/fig2mfpic/graphbase.mf
Initial commit
Diffstat (limited to 'graphics/fig2mfpic/graphbase.mf')
-rw-r--r--graphics/fig2mfpic/graphbase.mf1228
1 files changed, 1228 insertions, 0 deletions
diff --git a/graphics/fig2mfpic/graphbase.mf b/graphics/fig2mfpic/graphbase.mf
new file mode 100644
index 0000000000..3fe370a944
--- /dev/null
+++ b/graphics/fig2mfpic/graphbase.mf
@@ -0,0 +1,1228 @@
+%%% Author: Geoffrey Tobin.
+%%% Address: G.Tobin@ee.latrobe.edu.au
+%%%
+%%% File: graphbase.mf
+%%%
+
+mode_setup;
+message "graphbase 0.2 fig 2a - 13:32 GMT +10 Thu 16 June 1994";
+
+% 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;
+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;
+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) =
+ pair p,q;
+ path f;
+ if sweep=0: f:=from
+ else:
+ n:=floor(abs(sweep)/45)+1;
+ if n<3: n:=3; fi;
+ theta:=sweep/(n-1);
+ f:=p:=from;
+ for i:=2 upto n:
+ p:=p rotatedabout (center,theta);
+ q:=p-center; q:=q rotated 90;
+ if theta<0: q:=-q; fi;
+ f:=f..p{unitvector q};
+ endfor;
+ fi;
+ f
+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)=
+ if from=to:
+ from
+ else:
+ pair midpt;
+ midpt:=(0.5)[from,to];
+ if (sweep mod 360)=0:
+ midpt
+ else:
+ disp:=cosd(sweep/2)/sind(sweep/2);
+ midpt+(disp*((to-from) rotated 90)/2)
+ fi
+ fi
+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) =
+ pair center;
+ center:=arccenter(from,to,sweep);
+ (mkarc(center, from, sweep))
+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, second, third) =
+ sweep:=2*(angle(third-second)-angle(second-first));
+ sweep:=sweep mod 720;
+ if sweep > 360: sweep:=sweep-720; fi
+ critical:=5;
+ if abs(sweep) <= critical: % center may blow out
+ pair p[]; p1:=first; p2:=second; p3:=third;
+ mkpath(true,false,3,p)
+ else:
+ pair m[], d[], center;
+ m1:=(0.5)[first,second]; d1:=(second-first) rotated 90;
+ m2:=(0.5)[second,third]; d2:=(third-second) rotated 90;
+ center = m1+whatever*d1 = m2+whatever*d2;
+ mkarc(center,first,sweep)
+ fi
+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;
+
+
+% end graphbase.mf