pst-bspline (31jul11)

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

1 files changed, 68 insertions, 0 deletions

diff --git a/Master/texmf-dist/dvips/pst-bspline/pst-bspline.pro b/Master/texmf-dist/dvips/pst-bspline/pst-bspline.pro
new file mode 100644
index 00000000000..03cefb849ef
--- /dev/null
+++ b/Master/texmf-dist/dvips/pst-bspline/pst-bspline.pro
@@ -0,0 +1,68 @@
+% $Id: pst-bspline.pro 2011-07-30 23:45:00Z michael $
+%%
+%% PostScript prologue for pst-bspline.tex.
+%% Version 1.00, 2011/07/30.
+%%
+%% This program can be redistributed and/or modified under the terms
+%% of the LaTeX Project Public License Distributed from CTAN archives
+%% in directory macros/latex/base/lppl.txt.
+%
+%
+%
+tx@Dict begin
+%
+% numerically stable cubic root finding
+%
+/cubic_roots {% solve c3*t^3+c2*t^2+c1*t+c0==0
+% call with c3 c2 c1 c0 cubic_root, return solution array roots, numroots, zroot on stack
+% zroot is either (a) 2, if no solution in [0,1], or 
+% (b) a solution in [0,1].
+  15 dict begin % all variables are local
+  /numroots 0 def /roots 3 array def /zroot 2 def /epsilon 1e-6 def %
+  /c0 ED /c1 ED /c2 ED /c3 ED %
+  c3 abs epsilon lt { %quadratic case
+    c2 abs epsilon le { c1 abs epsilon ge { %
+   roots 0 c0 c1 div neg put /numroots 1 def} if }%
+   { %c2 neq 0
+   /bb c1 dup mul def %
+   /q bb 4 c0 c2 mul mul sub def %
+   q abs epsilon lt {  roots 0 c1 c2 -2 mul div put /numroots 1 def } %
+     { q 0.0 gt { % in fact, q>= epsilon
+       /q q sqrt def %
+       c1 0.0 lt { /q q neg def } if %
+       /q c1 q add -2 div def %
+       roots 0 q c2 div put /numroots 1 def % know |c2|>=epsilon
+       q abs epsilon ge { roots numroots c0 q div put /numroots numroots 1 add def } if %
+     } if %
+      } ifelse } ifelse } %
+  {% true cubic
+  /c2 c2 c3 div def /c1 c1 c3 div def /c0 c0 c3 div def % normalize
+  /Q c2 dup mul 3 c1 mul sub 9 div def /QQQ Q dup dup mul mul def %
+  /R c2 dup dup mul mul 2 mul c2 c1 9 mul mul sub 27 c0 mul add 54 div def %
+  /RR R dup mul def %
+  /c2 c2 3 div def %
+  RR QQQ lt {%
+    /theta R QQQ sqrt div Acos 3 div def % in degrees
+    /numroots 3 def %
+    /r2 Q sqrt -2 mul def %
+    roots 0 r2 theta cos mul c2 sub put %
+    roots 1 r2 theta 120 add cos mul c2 sub put %
+    roots 2 r2 theta 120 sub cos mul c2 sub put %
+  }{% One or two real roots
+    /r0 0 def %
+    /A R abs RR QQQ sub sqrt add 1 3 div exp neg def %
+    A abs epsilon gt { %
+      R 0.0 lt { /A A neg def } if %
+      /r0 A Q A div add def } if %
+    roots 0 r0 c2 sub put /numroots 1 def %
+    A dup mul Q sub abs A abs epsilon mul lt {%
+     roots numroots A c2 add neg put /numroots numroots 1 add def } if %
+    } ifelse %
+  } ifelse %
+  0 1 numroots 1 sub {/j ED roots j get dup 2 mul 1 sub abs 1 le { /zroot ED } if } for %
+  roots numroots zroot %leave these three items on stack
+  end } def %
+%
+end % tx@Dict
+%
+% END pst-bspline.pro