summaryrefslogtreecommitdiff
path: root/Master/texmf-dist/metapost/cmarrows/rgbx0025.mp
diff options
context:
space:
mode:
authorKarl Berry <karl@freefriends.org>2006-12-25 00:31:15 +0000
committerKarl Berry <karl@freefriends.org>2006-12-25 00:31:15 +0000
commit70bdd05d833a7a0fce0b77bc00a3c34b797034f4 (patch)
tree6fafee091dda38cf22a820b5fe8cced16ae02cf3 /Master/texmf-dist/metapost/cmarrows/rgbx0025.mp
parent67e67c030aec293b6ac01045a9aabd3184315fbf (diff)
new package cmarrows (with doc source from author)
git-svn-id: svn://tug.org/texlive/trunk@2890 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/texmf-dist/metapost/cmarrows/rgbx0025.mp')
-rw-r--r--Master/texmf-dist/metapost/cmarrows/rgbx0025.mp236
1 files changed, 236 insertions, 0 deletions
diff --git a/Master/texmf-dist/metapost/cmarrows/rgbx0025.mp b/Master/texmf-dist/metapost/cmarrows/rgbx0025.mp
new file mode 100644
index 00000000000..1fc45976513
--- /dev/null
+++ b/Master/texmf-dist/metapost/cmarrows/rgbx0025.mp
@@ -0,0 +1,236 @@
+%% rgbx0025.mp
+%% Copyright 2006 Tommy Ekola <tek@kth.se>
+%
+% This work may be distributed and/or modified under the conditions of
+% the LaTeX Project Public License, either version 1.3 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
+%
+% This work has the LPPL maintenance status `maintained'. The Current
+% Maintainer of this work is Tommy Ekola. The Base Interpreter is
+% MetaPost.
+
+vardef setup_paralleloppositerightarrows (expr source_file, cmdname) =
+
+ scantokens ("input tgbx0000");
+
+ scantokens ("input " & source_file);
+
+ expandafter def scantokens cmdname expr p =
+ scantokens (cmdname & "__rgbxww")(p)
+ enddef;
+
+ expandafter vardef scantokens (cmdname & "__rgbxww " & "(expr apth) " &
+ "text text_ = " &
+
+ "save math_spread, x_height, u, rule_thickness, bar, math_axis," &
+ " asc_height, eps, fudge, crisp, hair;" &
+
+ "math_spread :=" & decimal math_spread & ";" &
+ "x_height# :=" & decimal x_height# & ";" &
+ "u# :=" & decimal u# & ";" &
+ "rule_thickness# :=" & decimal rule_thickness# & ";" &
+ "bar# :=" & decimal bar# & ";" &
+ "math_axis# :=" & decimal math_axis# & ";" &
+ "asc_height# :=" & decimal asc_height# & ";" &
+ "eps :=" & decimal eps & ";" &
+ "fudge :=" & decimal fudge & ";" &
+ "crisp# :=" & decimal crisp# & ";" &
+ "hair# :=" & decimal hair# & ";")
+
+ save prevpen;
+ prevpen:=savepen;
+
+ save x,y;
+ numeric x[], x[]', x[]l, x[]'l, x[]r, x[]'r,
+ y[], y[]', y[]l, y[]'l, y[]r, y[]'r;
+ save spread, w;
+ numeric spread, w;
+
+ if crisp#>fudge*hair#:
+ crisp#:=fudge*hair#;
+ fi
+ pickup if crisp#=0: nullpen else: pencircle scaled crisp# fi;
+
+ spread = math_spread[.45x_height#, .55x_height#];
+ w = 18u#;
+
+ penpos1(rule_thickness#, 90); penpos2(rule_thickness#, 90);
+ penpos3(bar#, 0); penpos4(bar#, 0);
+ y0=y1=y2=math_axis#; x1-.5rule_thickness#=u#; rt x0=w-u#;
+ y3-y0=y0-y4=.24asc_height#+eps;
+ x3=x4=x0-3u#-eps;
+ penpos5(bar#, angle(z4-z0)); z5l=z0;
+ penpos6(bar#, angle(z3-z0)); z6l=z0;
+ z9=.381966[.5[z3,z4],z0];
+
+ save pp; path pp; pp = z4l{z9-z4}..z6r;
+ save t; numeric t; t = xpart(pp intersectiontimes ((0,y2l)--(w,y2l)));
+ x2=xpart point t of pp;
+
+ % Path macros
+
+ save parallellineright;
+ vardef parallellineright expr pppp =
+ save s, stp;
+ numeric s, stp; stp:=(arclength pppp) div 5pt;
+ if stp=0: stp:=1; fi
+ stp:=(arclength pppp)/stp;
+
+ if stp>0:
+ for s=0 step stp until arclength pppp - stp:
+ point (arctime s of pppp) of pppp +
+ (.24asc_height#+eps)*(unitvector direction (arctime s of pppp)
+ of pppp rotated 90)
+ {direction (arctime s of pppp) of pppp}..
+ endfor
+ {direction (length pppp) of pppp}
+ point (length pppp) of pppp +
+ (.24asc_height#+eps)*(unitvector direction (length pppp)
+ of pppp rotated 90)
+ fi
+ enddef;
+
+ save parallellineleft;
+ vardef parallellineleft expr pppp =
+ save s, stp;
+ numeric s, stp; stp:=(arclength pppp) div 5pt;
+ if stp=0: stp:=1; fi
+ stp:=(arclength pppp)/stp;
+
+ if stp>0:
+ for s=0 step stp until arclength pppp - stp:
+ point (arctime s of pppp) of pppp -
+ (.24asc_height#+eps)*(unitvector direction (arctime s of pppp)
+ of pppp rotated 90)
+ {direction (arctime s of pppp) of pppp}..
+ endfor
+ {direction (length pppp) of pppp}
+ point (length pppp) of pppp -
+ (.24asc_height#+eps)*(unitvector direction (length pppp)
+ of pppp rotated 90)
+ fi
+ enddef;
+
+ save mapto, n;
+ vardef mapto(text t) =
+ hide(numeric n; n:=0;
+ numeric x,x_[],y,y_[];
+ for z=t: z_[incr n]:=z; endfor;
+ transform T;
+ z_2 = z_1 transformed T;
+ z_4 = z_3 transformed T;
+ z_6 = z_5 transformed T;)
+ T
+ enddef;
+
+ % Macros for drawing the arrow head
+
+ save pp; path pp; pp = z4l{z9-z4}..z6r;
+ save pq; path pq; pq = z0..{z4-z9}z4r;
+ save right_texarrowhead;
+ vardef right_texarrowhead(expr T,s) =
+ (subpath(0, xpart (pq intersectiontimes
+ (point s of pp -- point s of pp + (2rule_thickness#,0))))
+ of pq--subpath(s,t) of pp--z2l) transformed T
+ enddef;
+
+ save qq; path qq; qq = z3l{z9-z3}..z5r;
+ save qp; path qp; qp = z3r{z9-z3}..z0;
+ save left_texarrowhead;
+ vardef left_texarrowhead(expr T, s) =
+ (z2r--subpath(t,s) of qq
+ --subpath(xpart ( qp intersectiontimes
+ (point s of qq -- point s of qq + (2rule_thickness#,0)))
+ ,length qp) of qp) transformed T
+ enddef;
+
+ % Draw the arrows. First the left arrow and then the right arrow
+
+ save pa, pb, T, tt, ttt;
+ save f,s;
+
+ save p_left; path p_left; p_left := parallellineleft apth;
+ save p_right; path p_right; p_right := parallellineright apth;
+
+ for ppp = p_left, reverse p_right:
+ transform T;
+ numeric tt; tt := arctime(arclength ppp - (x0-x9)) of ppp;
+ numeric ttt; ttt := arctime(arclength ppp - (x0-x2)) of ppp;
+
+ % Draw the right half of the arrow head
+
+ if arclength ppp = 0:
+ T:=identity shifted (point (length ppp) of ppp - z0);
+ elseif arclength ppp < x0-x3l:
+ T:=identity rotatedaround(z0,angle (direction (length ppp) of ppp))
+ shifted (point (length ppp) of ppp - z0);
+ else:
+ T:=mapto(z0,
+ point (length ppp) of ppp,
+ z2,
+ point ttt of ppp,
+ z9-(0,3rule_thickness#),
+ point tt of ppp - 3rule_thickness#
+ *(unitvector (direction tt of ppp)
+ rotated 90));
+ fi
+
+ vardef f(expr s) =
+ length(point s of (pp transformed T) - point tt of ppp)
+ < length(point 0 of pp - z9)
+ enddef;
+
+ if f(0) or (arclength ppp < x0-x3l): s := 0;
+ else: s := solve f(length pp, 0);
+ fi
+
+ path pa;
+ pa := right_texarrowhead(T,s);
+
+ % Draw the left part of the arrow head
+
+ if arclength ppp = 0:
+ T:=identity shifted (point (length ppp) of ppp - z0);
+ elseif arclength ppp < x0-x3l:
+ T:=identity rotatedaround(z0,angle (direction (length ppp) of ppp))
+ shifted (point (length ppp) of ppp - z0);
+ else:
+ T:=mapto(z0,
+ point (length ppp) of ppp,
+ z2,
+ point ttt of ppp,
+ z9+(0,3rule_thickness#),
+ point tt of ppp + 3rule_thickness#
+ *(unitvector (direction tt of ppp)
+ rotated 90));
+ fi
+
+ vardef f(expr s) =
+ length(point s of (qq transformed T) - point tt of ppp)
+ < length(point 0 of qq - z9)
+ enddef;
+
+ if f(0) or (arclength ppp < x0-x3l): s := 0;
+ else: s := solve f(length qq, 0);
+ fi
+
+ path pb;
+ pb := left_texarrowhead(T,s);
+
+ filldraw pa--pb--cycle text_;
+
+ % Draw the path
+
+ if arclength ppp > x0-x2:
+ draw subpath(0,ttt) of ppp withpen pencircle scaled rule_thickness#
+ text_;
+ fi
+
+ endfor
+
+ pickup prevpen;
+
+ enddef;
+
+enddef;