summaryrefslogtreecommitdiff
path: root/Master/texmf-dist/metafont/mfpic
diff options
context:
space:
mode:
authorKarl Berry <karl@freefriends.org>2009-10-03 14:58:41 +0000
committerKarl Berry <karl@freefriends.org>2009-10-03 14:58:41 +0000
commit556ccc6a2633ddbc27a22319d2e16e8a5d7483d1 (patch)
tree6f0b1301fabae1e14d1c00703e774efd67543d16 /Master/texmf-dist/metafont/mfpic
parent4d18074405a67946d5505fd5e0836e115d220541 (diff)
mfpic 1.00 (30sep09)
git-svn-id: svn://tug.org/texlive/trunk@15602 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/texmf-dist/metafont/mfpic')
-rw-r--r--Master/texmf-dist/metafont/mfpic/grafbase.mf376
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;