new package cmarrows (with doc source from author)

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

1 files changed, 240 insertions, 0 deletions

diff --git a/Master/texmf-dist/metapost/cmarrows/sgbx0010.mp b/Master/texmf-dist/metapost/cmarrows/sgbx0010.mp
new file mode 100644
index 00000000000..e9e3cf9b490
--- /dev/null
+++ b/Master/texmf-dist/metapost/cmarrows/sgbx0010.mp
@@ -0,0 +1,240 @@
+%% sgbx0010.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_twowayarrow (expr source_file, cmdname) =
+
+  scantokens ("input tgbx0000");
+
+  scantokens ("input " & source_file);
+
+  expandafter def scantokens cmdname expr p =
+    scantokens (cmdname & "__sgbxww")(p)
+  enddef;
+
+  expandafter vardef scantokens (cmdname & "__sgbxww " & "(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(rule_thickness#,  0); penpos4(rule_thickness#,  0);
+    y0=y1=y2=math_axis#; x1-.5rule_thickness#=u#; rt x0=w-u#;
+    y3-y0=y0-y4=.36asc_height#+eps;
+    x3=x4=x0-4u#-eps;
+    penpos5(rule_thickness#, angle(z4-z0)); z5l=z0;
+    penpos6(rule_thickness#, angle(z3-z0)); z6l=z0;
+    z9=.2[.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;
+  
+    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;
+  
+    save T;   transform T;
+    save tt;  numeric tt;  tt  = arctime(arclength apth - (x0-x9)) of apth;
+    save ttt; numeric ttt; ttt = arctime(arclength apth - (x0-x2)) of apth;
+    save ss;  numeric ss;  ss  = arctime x0-x9 of apth;
+    save sss; numeric sss; sss = arctime x0-x2 of apth;
+
+    % Draw the right half of the arrow head
+
+    save right_texarrowhead, pa;
+    vardef right_texarrowhead(expr T,s) =
+      (subpath(0, xpart ((z0..{z4-z9}z4r) intersectiontimes
+	              (point s of pp -- point s of pp + (2rule_thickness#,0))))
+	of (z0..{z4-z9}z4r)--subpath(s,t) of pp--z2l) transformed T
+    enddef;
+    
+    if   arclength apth = 0:
+      T:=identity shifted (point (length apth) of apth - z0);
+    elseif arclength apth < x0-x3l:
+      T:=identity rotatedaround(z0,angle (direction (length apth) of apth))
+                  shifted (point (length apth) of apth - z0);
+    else:
+      T:=mapto(z0,
+               point (length apth) of apth,
+               z2,
+               point ttt of apth,
+               z9-(0,3rule_thickness#),
+               point tt of apth - 3rule_thickness#
+                                   *(unitvector (direction tt of apth) 
+                                   rotated 90));
+    fi
+
+    save f,s;
+    vardef f(expr s) =
+      length(point s of (pp transformed T) - point tt of apth)
+      < length(point 0 of pp - z9)
+    enddef;
+
+    if f(0) or (arclength apth < x0-x3l): s := 0;
+    else:    s := solve f(length pp, 0);
+    fi
+
+    path pa;
+    pa := right_texarrowhead(T,s);		     
+
+    if     arclength apth = 0:
+      T:=identity reflectedabout ((x0,y3),(x0,y4))
+                  shifted (point (length 0) of apth -z0);
+    elseif arclength apth < x0-x3l:
+      T:=identity reflectedabout ((x0,y3),(x0,y4))
+                  rotatedaround(z0, angle direction (length 0) of apth)
+                  shifted (point (length 0) of apth - z0);
+    else:
+      T:=mapto(z0,
+    	       point 0 of apth,
+               z2,
+               point sss of apth,
+               z9-(0,3rule_thickness#),
+               point ss of apth - 3rule_thickness#
+                                  *(unitvector (direction ss of apth)
+                                  rotated 90));
+    fi
+
+    vardef f(expr s) =
+      length(point s of (pp transformed T) - point ss of apth)
+      < length(point 0 of pp - z9)
+    enddef;
+
+    if f(0) or (arclength apth < x0-x3l): s := 0;
+    else:    s := solve f(length pp, 0);
+    fi
+
+    save pc; path pc;
+    pc := right_texarrowhead(T,s);		     
+    
+    % Draw the left part of the arrow head
+
+    pp := (z3l{z9-z3}..z5r);
+    save pq; path pq; pq := (z3r{z9-z3}..z0);
+    
+    save left_texarrowhead, pb;
+    vardef left_texarrowhead(expr T, s) =
+      (z2r--subpath(t,s) of pp
+	--subpath(xpart ( pq intersectiontimes
+	            (point s of pp -- point s of pp + (2rule_thickness#,0)))
+	          ,length pq) of pq) transformed T
+    enddef;
+    
+    if   arclength apth = 0:
+      T:=identity shifted (point (length apth) of apth - z0);
+    elseif arclength apth < x0-x3l:
+      T:=identity rotatedaround(z0,angle (direction (length apth) of apth))
+                  shifted (point (length apth) of apth - z0);
+    else:
+      T:=mapto(z0,
+               point (length apth) of apth,
+               z2,
+               point ttt of apth,
+               z9+(0,3rule_thickness#),
+               point tt of apth + 3rule_thickness#
+                                   *(unitvector (direction tt of apth) 
+                                   rotated 90));
+    fi
+
+    vardef f(expr s) =
+      length(point s of (pp transformed T) - point tt of apth)
+      < length(point 0 of pp - z9)
+    enddef;
+
+    if f(0) or (arclength apth < x0-x3l): s := 0;
+    else:    s := solve f(length pp, 0);
+    fi
+
+    path pb;
+    pb := left_texarrowhead(T,s);
+
+    if     arclength apth = 0:
+      T:=identity reflectedabout ((x0,y3),(x0,y4))
+                  shifted (point (length 0) of apth -z0);
+    elseif arclength apth < x0-x3l:
+      T:=identity reflectedabout ((x0,y3),(x0,y4))
+                  rotatedaround(z0, angle direction (length 0) of apth)
+                  shifted (point (length 0) of apth - z0);
+    else:
+      T:=mapto(z0,
+    	       point 0 of apth,
+               z2,
+               point sss of apth,
+               z9+(0,3rule_thickness#),
+               point ss of apth + 3rule_thickness#
+                                  *(unitvector (direction ss of apth)
+                                  rotated 90));
+    fi
+
+    vardef f(expr s) =
+      length(point s of (pp transformed T) - point ss of apth)
+      < length(point 0 of pp - z9)
+    enddef;
+
+    if f(0) or (arclength apth < x0-x3l): s := 0;
+    else:    s := solve f(length pp, 0);
+    fi
+
+    save pd; path pd;
+    pd := left_texarrowhead(T,s);		     
+
+    filldraw pa--pb--cycle text_;
+    filldraw pc--pd--cycle text_;
+
+    if arclength apth > 2(x0-x2):
+      draw subpath(sss,ttt) of apth withpen pencircle scaled rule_thickness#
+           text_;
+    fi
+	 
+    pickup prevpen;
+
+  enddef;
+
+enddef;
\ No newline at end of file