mfpic 1.00 (30sep09)

git-svn-id: svn://tug.org/texlive/trunk@15602 c570f23f-e606-0410-a88d-b1316a301751

1 files changed, 276 insertions, 100 deletions

diff --git a/Master/texmf-dist/metafont/mfpic/grafbase.mf b/Master/texmf-dist/metafont/mfpic/grafbase.mf
index 470e3e7f346..2532e17cc3c 100644
--- a/Master/texmf-dist/metafont/mfpic/grafbase.mf
+++ b/Master/texmf-dist/metafont/mfpic/grafbase.mf
@@ -8,19 +8,22 @@
 %% 
 %% -------------------------------------------------------------------
 %% 
-%% Copyright 2002--2006, Daniel H. Luecking
+%% Copyright 2002--2009, Daniel H. Luecking
 %% 
 %% Mfpic may be distributed and/or modified under the conditions of the
-%% LaTeX Project Public License, either version 1.3b of this license or (at
+%% LaTeX Project Public License, either version 1.3c of this license or (at
 %% your option) any later version. The latest version of this license is in
 %%    <http://www.latex-project.org/lppl.txt>
-%% and version 1.3b or later is part of all distributions of LaTeX version
-%% 2005/12/01 or later.
+%% and version 1.3c or later is part of all distributions of LaTeX version
+%% 2008/12/01 or later.
 %% 
 %% Mfpic has maintenance status "author-maintained". The Current Maintainer
 %% is Daniel H. Luecking. There are several Base Interpreters associated
 %% with mfpic: plain TeX, LaTeX, plain Metafont and plain MetaPost.
 %% 
+%%% File: grafbase.dtx
+%%% A part of mfpic 1.00 2009/09/22
+%%%
 if (known grafbaseversion) or (known grafbase):
   message "Grafbase (" & jobname & "): You have loaded grafbase more "
     & "than once! Please make sure that it is loaded only once.";
@@ -29,7 +32,7 @@ fi
 boolean grafbase; grafbase := true;
 
 string fileversion, filedate;
-fileversion := "0.9";  filedate := "2006/05/26";
+fileversion := "1.00";  filedate := "2009/09/22";
 
 message " Loading grafbase macros, version " & fileversion & " " &
    filedate & ".";
@@ -56,7 +59,7 @@ def checkversions (expr g)=
   fi
 enddef;
 
-checkversions (90);
+checkversions (100);
 
 if unknown base_name       :  input plain;
 elseif not string base_name:  input plain;
@@ -64,17 +67,14 @@ elseif base_name <> "plain":  input plain;
 fi
 
 boolean METAPOST;
-
-if known color Geamparalele din Babadag:
-  METAPOST := true;
-else:
-  METAPOST := false;
-fi
+METAPOST := known color Geamparalele din Babadag;
+numeric metapostversion;
 
 if METAPOST:
   GBerrmsg ("wrong compiler.")
     "This file is for Metafont. For Metapost use grafbase.mp.";
 fi
+metapostversion := 0;
 
 if not boolean debug:  boolean debug;  debug := false;  fi
 
@@ -174,6 +174,8 @@ enddef;
 boolean showbbox;  showbbox := false;
 
 let color = numeric;  color black, white;
+let rgbcolor = numeric;
+let cmykcolor = numeric;
 black := 0;  white := 1;
 def withcolor text t =  enddef;
 def _wc_ =  withcolor  enddef;
@@ -185,54 +187,77 @@ currentcolor := fillcolor := drawcolor := hatchcolor :=
 background := white;
 
 vardef snapto expr t =
-  if unknown t:            0
-  elseif not (numeric t):  0
-  elseif t < 0:            0
-  elseif t > 1:            1
-  else:                    t
+  if numeric t:
+    if unknown t:  0
+    elseif t < 0:  0
+    elseif t > 1:  1
+    else:          t
+    fi
+  else:
+    GBerrmsg ("Improper expression type.")
+      "The argument to `snapto' must be a numeric.";
   fi
+
 enddef;
 
-vardef gray (expr g) =  (snapto g)*white  enddef;
+vardef rgbgray  (expr g) =  (snapto g) * white  enddef;
+vardef cmykgray (expr g) =  cmyk(0,0,0,1 - snapto g)  enddef;
 
-vardef makeclr (expr r, g, b) =
-  gray (sqrt((2r*r + 4g*g + b*b)/7))
+vardef knowncolor expr clr =  (known clr) and (iscolor clr)  enddef;
+
+vardef grayscalegray (expr g) =  snapto g  enddef;
+vardef gray (expr g) =  grayscalegray (g)  enddef;
+vardef cmyk (expr c, m, y, k) =  rgb (1-c-k, 1-m-k, 1-y-k) enddef;
+vardef makegray  primary clr =
+  if knowncolor clr:  clr  else:  black  fi
 enddef;
+def makergb  =  makegray  enddef;
+def makecmyk =  makegray  enddef;
+vardef iscolor expr clr =  color clr enddef;
 
-vardef rgb (expr r, g, b) =
-  makeclr (snapto r, snapto g, snapto b)
+vardef forceclr (expr c) =
+  if unknown c :
+    if numeric c:  grayscaleblack
+    elseif rgbcolor c:   rgbblack
+    elseif cmykcolor c: cmykblack
+    else: black
+    fi
+  elseif numeric c:  gray (c)
+  elseif iscolor c:  c
+  else:  black
+  fi
 enddef;
+vardef named (suffix c) =  forceclr (c)  enddef;
 
-vardef cmyk (expr c, m, y, k) =
-  rgb (1-c-k, 1-m-k, 1-y-k)
+vardef togray (expr r, g, b) =
+  gray (sqrt((2r*r + 4g*g + b*b)/7))
 enddef;
 
-vardef RGB (expr R, G, B) =
-  rgb (R/255, G/255, B/255)
+vardef rgbtogray (expr r, g, b) =
+  togray(snapto r, snapto g, snapto b)
+enddef;
+vardef cmyktogray (expr c, m, y, k) =
+  rgbtogray (1-c-k,1-m-k,1-y-k)
 enddef;
 
-vardef named (suffix c) =
-  if unknown c:  black  else:  forceclr (c)  fi
+vardef cmyktorgb (expr c,m,y,k) =
+  rgb(1-c-k,1-m-k,1-y-k)
 enddef;
-vardef forceclr (expr c) =
-  if numeric c:    gray (c)
-  elseif color c:  c
-  else:            black
-  fi
+vardef rgbtocmyk (expr r,g,b) =
+  cmyk(1-r,1-g,1-b,0)
 enddef;
 
-color red, green, blue, cyan, magenta, yellow;
-red     := rgb (1, 0, 0);
-green   := rgb (0, 1, 0);
-blue    := rgb (0, 0, 1);
-cyan    := rgb (0, 1, 1);
-magenta := rgb (1, 0, 1);
-yellow  := rgb (1, 1, 0);
+vardef rgb (expr r, g, b) =
+  togray (snapto r, snapto g, snapto b)
+enddef;
+vardef RGB (expr R, G, B) =
+  rgb (R/255, G/255, B/255)
+enddef;
 
 def list (suffix v) (text lst) =
   v := 0;  for _itm = lst:  v[incr v] := _itm;  endfor
   if v = 0:
-    GBerrmsg ("no list to process!")
+    GBerrmsg ("No list to process!")
       "An attempt was made to produce an array from a "
     & "list of expressions having no valid entries.";
   fi
@@ -420,8 +445,10 @@ def setnumeric (suffix name) =  save name;  name :=  enddef;
 def setboolean   =  setvariable (boolean)  enddef;
 def setpair      =  setvariable (pair)  enddef;
 def setpath      =  setvariable (path)  enddef;
-def setcolor     =  setvariable (color)  enddef;
 def setpicture   =  setvariable (picture)  enddef;
+def setstring    =  setvariable (string)  enddef;
+def settransform =  setvariable (transform)  enddef;
+def setpen       =  setvariable (pen)  enddef;
 def settension (suffix tn) expr tens =
   setnumeric (tn) if tens > 0:  tens  else:  default_tension  fi;
 enddef;
@@ -447,6 +474,64 @@ def setsplit (suffix s) expr ss =
   setnumeric (s) emax (1, ceiling ss);
 enddef;
 
+def setrgbcolor  =  setcolor  enddef;
+def setcmykcolor =  setcolor  enddef;
+def setcolor = setvariable (color) enddef;
+def gsetcolor = gsetvariable (color) enddef;
+
+setcolor(rgbblack) rgb(0,0,0);
+setcolor(red)      rgb(1,0,0);
+setcolor(green)    rgb(0,1,0);
+setcolor(blue)     rgb(0,0,1);
+setcolor(rgbwhite) rgb(1,1,1);
+setcolor(cmykwhite) cmyk(0,0,0,0);
+setcolor(cyan)      cmyk(1,0,0,0); % Maybe these should
+setcolor(magenta)   cmyk(0,1,0,0); % be rbg for backward
+setcolor(yellow)    cmyk(0,0,1,0); % compatibility?
+setcolor(cmykblack) cmyk(0,0,0,1);
+setcolor(grayscaleblack) gray(0);
+setcolor(grayscalewhite) gray(1);
+
+def setoutputtemplate text garbage = enddef;
+
+def romannumeral =  _romannumeral (true)  enddef;
+vardef _romannumeral (expr prefix, X) =
+  save Y, _tmp, U; string U;
+
+  Y.m := X div 1000;        % thousands digit
+    _tmp := X - 1000Y.m;    % hundreds digits and lower
+  Y.c := _tmp div 100;      % hundreds
+    _tmp := _tmp - 100Y.c;  % tens and units
+  Y.x := _tmp div 10;       % tens
+  Y.i := _tmp - 10Y.x;      % units
+
+  strrepeat("m", Y.m) &
+  romandigit(prefix, "c", "d", "m", Y.c) &
+  romandigit(prefix, "x", "l", "c", Y.x) &
+  romandigit(prefix, "i", "v", "x", Y.i)
+enddef;
+
+vardef romandigit (expr prefix, bot, mid, top, n) =
+  if n > 9 :    top & strrepeat(bot, n-10)   % shouldn't happen
+  elseif n > 8 :
+    if prefix:  bot & top                    % "ix"
+    else:       mid & bot & bot & bot & bot  % "viiii"
+    fi
+  elseif n > 4 :  mid & strrepeat (bot, n-5) % "v"--"viii"
+  elseif n > 3 :
+    if prefix:  bot & mid                    % "iv"
+    else:       bot & bot & bot & bot        % "iiii"
+    fi
+  else:         strrepeat (bot, n)           % ""--"iii" for 0--3
+  fi
+enddef;
+
+vardef strrepeat (expr st, rep) =
+  setstring (_sr) "";
+  for i = 1 upto rep:  _sr := _sr & st;  endfor
+  _sr
+enddef;
+
 transform ztr, vtr;
 def setztr =
   if debug:
@@ -552,7 +637,6 @@ numeric label_sep, labelpath_sep ;
 label_sep :=  0;  labelpath_sep := 0;
 def verbatimtex text t =  enddef;
 
-
 vardef newgblabel (expr hf, vf, BL, r) (text s) (text pts) =
 enddef;
 
@@ -703,6 +787,7 @@ vardef csc primary X =  cscd (X*radian)  enddef;
 
 vardef degrees (expr t) =  t*radian  enddef;
 vardef radians (expr t) =  t/radian  enddef;
+
 vardef invcos primary X =  (acos X)/radian  enddef;
 vardef invsin primary X =  (asin X)/radian  enddef;
 vardef invtan primary X =  (atan X)/radian  enddef;
@@ -714,12 +799,6 @@ vardef logbase (expr B) primary X =  (mlog X)/(mlog B)  enddef;
 def logtwo =  logbase( 2)  enddef;
 def logten =  logbase(10)  enddef;
 
-vardef Arg primary Z =  (angle Z)/radian  enddef;
-vardef Log primary Z =  (ln (abs Z), Arg Z)  enddef;
-vardef cis primary T =  dir (T*radian)  enddef;
-vardef zexp primary Z =  (exp (xpart Z)) * cis (ypart Z)  enddef;
-vardef sgn primary Z =  if not (Z = origin):  unitvector  fi  Z  enddef;
-
 vardef cosh primary X =
   setnumeric (temp) 2 exp (-abs(X));
   if temp < reallysmall:
@@ -787,6 +866,20 @@ vardef atanh primary y =
   fi
 enddef;
 
+vardef Arg primary Z =  (angle Z)/radian  enddef;
+vardef Log primary Z =  (ln (abs Z), Arg Z)  enddef;
+vardef cis primary T =  dir (T*radian)  enddef;
+vardef zexp primary Z =  (exp (xpart Z)) * cis (ypart Z)  enddef;
+vardef sgn primary Z =  if not (Z = origin):  unitvector  fi  Z  enddef;
+vardef conj primary Z = (xpart Z, -ypart Z) enddef;
+
+vardef Moebius (expr A) primary Z =
+  save _D; pair _D;
+  _D := (1, 0) + (Z zscaled (conj A));
+  (Z + A)/(abs _D) rotated (- angle _D)
+enddef;
+vardef pshdist (expr Z,W) =  abs(Moebius(-W)(Z))  enddef;
+
 vardef polar primary p =  (xpart p) * dir (ypart p)  enddef;
 def id (expr x) =  x  enddef;
 
@@ -798,8 +891,10 @@ primarydef x**y =
   fi
 enddef;
 let ^ = **;
+
 transform T_stack[];
 numeric T_stack;  T_stack := 0;
+
 def T_push (expr T) =  T_stack[incr T_stack] := T;  enddef;
 def T_pop (suffix $) =
   if T_stack > 0:
@@ -1221,7 +1316,7 @@ enddef;
 def store (suffix fs) expr f =
 hide (
   if (not path f) and (not pair f):
-    GBerrmsg ("improper expression type.")
+    GBerrmsg ("Improper expression type.")
       "The second argument to `store' must be a path or pair.";
   fi
   if not path fs:  path fs;  fi
@@ -1510,7 +1605,6 @@ vardef gendashed (suffix pat) expr f =
         picture _v;  _v := nullpicture;
         _d0 := 0;  _t0 := 0;
         dashit (_dpat.start) (_v);
-
         if _n > 0:
           save _m;  _m := ceiling sqrt(_n);
           for _j = 0 step _m until _n - 1:
@@ -1778,6 +1872,7 @@ vardef axis@# (expr len) =  headpath (len, 0, 0) axisline@#  enddef;
 vardef borderrect =
   rect((xneg+laxis,yneg+baxis),(xpos-raxis,ypos-taxis))
 enddef;
+
 numeric inside, outside, centered, onleft, onright, ontop, onbottom;
 inside   := -2;
 outside  := -1;
@@ -2080,12 +2175,27 @@ enddef;
 
 vardef turtle (text t) =
   setnumeric (_tu) 0;
-  pair _tu[];  _tu0 := origin;
-  for _a = t:  _tu[incr _tu] := _tu[_tu - 1] + _a;  endfor
+  setpair (_tmp) origin;
+  pair _tu[];
+  for _a = t:
+    _tmp := _tmp + _a;
+    _tu[incr _tu] := _tmp;
+  endfor
   if _tu = 0:  NoPoints("turtle", _tu);  fi
   mkpoly (false, _tu)
 enddef;
 
+vardef brownianpath (expr start, num, sc) =
+  setnumeric (_brp) 1;
+  setpair (_tmp) start;
+  pair _brp[];  _brp1 := _tmp;
+  for _idx := 1 upto num:
+    _tmp := _tmp + sc/(sqrt 2)*(normaldeviate,normaldeviate);
+    _brp[incr _brp] := _tmp;
+  endfor
+  mkpoly (false, _brp)
+enddef;
+
 vardef mksmooth (expr tens, cyclic) (suffix pts) =
   if pts = 1:  onepointpath (cyclic, pts1)
   else:
@@ -2190,7 +2300,7 @@ enddef;
 
 vardef mkqbezier (expr cyclic) (suffix pts) =
   pts1
-  if pts=1:  {0,0}
+  if pts=1: {0,0}
   else:
     for _i = 2 step 2 until pts - 1:
       ..controls 1/3[pts[_i], pts[_i-1] ] and 1/3[pts[_i], pts[_i+1] ]..
@@ -2205,8 +2315,7 @@ enddef;
 
 vardef qbezier (expr cyclic) (text t) =
   setpairs (_qbz) (t);
-  if _qbz=0:  NoPoints ("qbezier", _qbz);  fi
-  if _qbz=1:  onepointpath (cyclic, _qbz1)
+  if _qbz=0:  NoPoints ("qbezier", _qbz);
   else:
     if (cyclic and odd _qbz) or (not cyclic and even _qbz):
       _qbz[incr _qbz] := _qbz[_qbz-1];
@@ -2215,6 +2324,45 @@ vardef qbezier (expr cyclic) (text t) =
   fi
 enddef;
 
+vardef mkcbezier (expr cyclic) (suffix pts) =
+  pts1
+  if pts=1:  {0,0}
+  else:
+    for _i = 1 step 3 until pts - 3:
+      ..controls pts[_i+1] and pts[_i+2] .. pts[_i+3]
+    endfor
+    if cyclic:
+      ..controls  pts[pts - 1] and pts[pts]..cycle
+    fi
+  fi
+enddef;
+
+vardef cbezier (expr cyclic) (text t) =
+  setpairs (_cbz) (t);
+  if _cbz=0:  NoPoints ("qbezier", _cbz);
+  else:
+    % Need 0 mod 3 for cyclic, otherwise 1 mod 3
+    setnumeric (_mdt) _cbz mod 3;
+    if cyclic:
+      if _mdt <> 0:  _cbz[incr _cbz] := _cbz[_cbz-1];  fi
+      if _mdt = 1 :  _cbz[incr _cbz] := _cbz1;  fi
+    else: % need 1 more, duplicate next to last
+      if _mdt = 0:
+        _cbz := _cbz + 1;
+        _cbz[_cbz]   := _cbz[_cbz-1];
+        _cbz[_cbz-1] := _cbz[_cbz-2];
+      fi
+      if _mdt = 2: % need 2 more, duplicate last 2.
+        _cbz := _cbz + 2; % add 2 slots
+        _cbz[_cbz]   := _cbz[_cbz-2]; % fill them
+        _cbz[_cbz-1] := _cbz[_cbz-2]; % with last node
+        _cbz[_cbz-2] := _cbz[_cbz-3]; % orig last slot = orig previous.
+      fi
+    fi
+    mkcbezier (cyclic) (_cbz)
+  fi
+enddef;
+
 vardef fcncontrol (expr ftens, X, Y, Z) =
   Y if (xpart(Z-Y) <> 0) and (xpart(Y-X) <> 0):
       + xpart(Z-Y)/3/xpart(Z-X)*(Z - X)/ftens  fi
@@ -2262,6 +2410,7 @@ vardef qspline (expr cyclic) (text t) =
   fi
   mkqbs (_qs) if cyclic:  & cycle  fi
 enddef;
+
 vardef mkcbs (suffix b) =
   (b[1]+4b[2]+b[3])/6
   if b < 4:  {0,0}
@@ -2290,6 +2439,7 @@ vardef cspline (expr cyclic) (text t) =
   fi
   mkcbs (_cs) if cyclic:  & cycle  fi
 enddef;
+
 def init_spline_eqns (suffix pts) =
   save _spl_pre, _spl_post;
   pair _spl_pre[], _spl_post[];
@@ -2434,9 +2584,12 @@ vardef arcpps (expr begpt, endpt, sweep) =
 enddef;
 
 vardef arcpp (expr small, begpt, endpt, rad) =
-  save full, ang;  full := signof (rad) 360;
-  if 2*abs(rad) > abs(begpt - endpt):
-    ang := if not small:  full -  fi  2*asin (abs(begpt-endpt)/(2rad));
+  save full, diam, chord, ang;
+  full := signof (rad) 360;
+  diam  := 2rad;
+  chord := abs(endpt-begpt);
+  if chord < abs(diam):
+    ang := if not small:  full -  fi  2*asin (chord/diam);
   else:  ang := signof (rad) 180;
   fi
   arcpps (begpt, endpt, ang)
@@ -2466,30 +2619,37 @@ vardef ellipse (expr center, radx, rady, angle) =
   fullcircle xscaled (2*radx) yscaled (2*rady) rotated angle
     shifted center
 enddef;
+
 vardef circle (expr center, rad) =
   fullcircle scaled (2*rad) shifted center
 enddef;
+
 vardef circlecp (expr center, point) =
   mkarc (center, point, point, 360) & cycle
 enddef;
+
 vardef circleppp (expr one, two, three) =
   arcpps (one, two, 2*cornerangle (three, one, two))
     & arcpps (two, three, 2*cornerangle (one, two, three))
     & arcpps (three, one, 2*cornerangle (two, three, one))
     & cycle
 enddef;
+
 vardef circlepps (expr one, two, sweep) =
   save ang, full;
   full := signof (sweep) 360;
   ang := sweep mod full;
   arcpps (one, two, ang) & arcpps (two, one, full - ang) & cycle
 enddef;
+
 vardef circlepp (expr small, one, two, rad) =
  arcpp (small, one, two, rad) & arcpp (not small, two, one, rad) & cycle
 enddef;
+
 def circleppr (expr one, two, rad, small) =
   circleppr (one, two, rad, small)
 enddef;
+
 vardef pathcenter expr p =
   save a, cntr, n;  pair cntr, a[];
   n := length p;
@@ -2539,6 +2699,54 @@ vardef ninepointcircle expr t =
   circleppp (medianpt 0 of t, medianpt 1 of t, medianpt 2 of t)
 enddef;
 
+vardef pshcircle (expr disk, ctr, rad) =
+  if disk:
+    if rad >= 1 :
+      if rad > 1:
+        GBerrmsg ("Impossible pseudohyperbolic circle.")
+          "The radius of a pseudohyperbolic circle can be at most 1.";
+      fi
+      circle ((0,0),1)
+    elseif abs(ctr) >= 1 :
+      if abs(ctr) > 1:
+        GBerrmsg ("Impossible pseudohyperbolic circle.")
+          "The center of a pseudohyperbolic circle must be in"
+          & "the unit disk.";
+      fi
+      onepointpath (true,ctr)
+    else:
+      % compute Euclidean center and radius (and a denominator used twice
+      % in calculations).
+      save _r, _dnm;
+      _r := abs(ctr);
+      _dnm := 1 - _r*_r*rad*rad;
+      circle ( (1 - rad*rad)/_dnm*ctr, rad*(1 - _r*_r)/_dnm)
+    fi
+  else:
+    if rad >= 1 :
+      GBerrmsg ("Impossible pseudohyperbolic circle.")
+        "The radius of a pseudohyperbolic circle must be less than 1.";
+      onepointpath (true,ctr)
+    elseif ypart ctr <= 0:
+      if ypart ctr < 0:
+        GBerrmsg ("Impossible pseudohyperbolic circle.")
+          "The center of a pseudohyperbolic circle must be in"
+          & "the upper half-plane.";
+      fi
+      onepointpath (true,ctr)
+    else:
+      % compute Euclidean center and radius (and a denominator used twice
+      % in calculations).
+      % Euclidean center at  xpart ctr + (1 + R^2)/(1 - R^2)*ypart ctr
+      % Euclidean radius  4R/(1 - R^2)*ypart ctr
+      save _y, _dnm;
+      _y := ypart ctr;
+      _dnm := 1 - rad*rad;
+      circle ( (xpart ctr, (1 + rad*rad)/_dnm * _y), 2rad/_dnm*_y)
+    fi
+  fi
+enddef;
+
 vardef barycenter expr t =
   save m;  m := length t if not cycle t:  + 1 fi;
   pnt0(t)/m  for k = 1 upto m - 1:  + pnt[k](t)/m  endfor
@@ -2613,8 +2821,10 @@ def plrregion (expr sm) =  tplrregion (sm, default_tension)  enddef;
 vardef tplrregion (expr sm, tn, tlo, thi, st) (text _ft) =
   (0,0)--tplrfcn (sm, tn, tlo, thi, st ) (_ft)--cycle
 enddef;
+
 numeric tolerancefactor;
 tolerancefactor := .02;
+
 vardef mklevelset (expr sm, tens, X, Y, t, a, b, c, d) =
   save _inside_;
   vardef _inside_ (expr U, V) =
@@ -2741,6 +2951,7 @@ vardef qbclosed expr f =
 enddef;
 
 vardef makesector expr p =  (pathcenter p)--p--cycle  enddef;
+
 vardef arccomplement expr p =
   if cycle p:  onepointpath (false, pnt0(p))
   else:
@@ -2899,6 +3110,8 @@ vardef colorGheadpath
   f
 enddef;
 
+path cut_path;  cut_path := (.5,0)--(.5,.71)--(-.5,.71)--(-.5,0)--cycle;
+
 def tailpath (suffix sh) =  colortailpath (sh) (headcolor)  enddef;
 vardef colortailpath (suffix sh) (expr clr, sc, rot, pos) expr f =
   if (sc <> 0) and (known sh) and (path sh):
@@ -3014,6 +3227,7 @@ vardef randomlines (expr maxshift) expr f =
       fi
   fi
 enddef;
+
 vardef parasegment (expr d, segs, f) =
   if d = 0:  f
   else:
@@ -3149,7 +3363,7 @@ def setdatasymbols (text lst) =
       __type[__type] := _itm;
       next __type;
     else:
-      GBwarn "Improper path in setdatasymbols().";
+      GBwarn "Improper symbol in setdatasymbols().";
     fi
   endfor
   if __type > 1:
@@ -3253,6 +3467,7 @@ forsuffixes S =
  SolidDiamond, SolidStar :
   S.tip := point 0 of S;
 endfor
+
 vardef gcd (expr n, m) =
   save a, b, r;
   a := emax (abs(m), abs(n));
@@ -3270,11 +3485,9 @@ vardef gcd (expr n, m) =
 enddef;
 
 vardef lcm (expr n, m) =
-  n*m/gcd(n, m)
+  n/gcd(n, m)*m
 enddef;
 
-path cut_path;  cut_path := (.5,0)--(.5,.71)--(-.5,.71)--(-.5,0)--cycle;
-
 numeric pointtype;  path pointtype[];
 def defaultsymbols =
   setdatasymbols( Circle, Cross, SolidDiamond, Square, Plus,
@@ -3282,43 +3495,6 @@ def defaultsymbols =
 enddef;
 defaultsymbols;
 
-def setdatacolors (text lst) =
-  save __type;  color __type[];
-  __type := 0;
-  for _itm = lst:
-    if (known _itm) and (color _itm):
-      __type[__type] := _itm;
-      next __type;
-    else:  GBwarn "Improper color in setdatacolors().";
-    fi
-  endfor
-  if __type > 1:
-    save colortype;  colortype := __type;
-    color colortype[];
-    for _j = 0 upto colortype - 1:
-      colortype[_j] := __type[_j];
-    endfor
-  else:
-    SetdataWarn "colors";
-  fi
-enddef;
-def getcolor expr n =  colortype[n mod colortype]  enddef;
-
-color dBlue, dOrange, dGreen, dMagenta, dCyan, dYellow;
-dBlue := 0.80blue + .2white;
-dOrange := 0.66yellow + .34red;
-dGreen := 0.80green;
-dMagenta := 0.85magenta;
-dCyan := 0.85cyan;
-dYellow := 0.85yellow;
-
-numeric colortype;  color colortype[];
-def defaultcolors =
-  setdatacolors(black, red, dBlue, dOrange, dGreen,
-    dMagenta, dCyan, dYellow);
-enddef;
-defaultcolors;
-
 def computepie (suffix dat) (expr sign, ang, cent, rad) (text data) =
 begingroup
   save _tot, _max, _toobig;