%%% Date: Mon, 12 Oct 92 22:32:32 EST
%%% Message-Id: <[email protected]>
%%% To: [email protected]
%%% Subject: graphbase.mf 0.2 gt mod 1 Mon 12 Oct 1992.
%%% Cc: [email protected]
%%% 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;

You are viewing proxied material from ftp.icm.edu.pl. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.