pst-optexp update (28jul08)

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

1 files changed, 77 insertions, 9 deletions

diff --git a/Master/texmf-dist/dvips/pst-optexp/pst-optexp.pro b/Master/texmf-dist/dvips/pst-optexp/pst-optexp.pro
index dc59ceba9a3..83cd176af12 100644
--- a/Master/texmf-dist/dvips/pst-optexp/pst-optexp.pro
+++ b/Master/texmf-dist/dvips/pst-optexp/pst-optexp.pro
@@ -1,25 +1,35 @@
 %
 % PostScript prologue for pst-optexp.tex.
-% version 0.1 2008-06-17 (cb)
+% version 0.2 2008-07-27 (cb)
 % For distribution, see pstricks.tex.
 %
 /tx@OptexpDict 20 dict def
 tx@OptexpDict begin
 %
+% str1 str2 append str1str2
+/strcat {
+    exch 2 copy
+    length exch length add
+    string dup dup 5 2 roll
+    copy length exch
+    putinterval
+} bind def
 %
 % expects: XB YB  XA YA XG YG
 /calcNodes {% def
-    /YG ED /XG ED
+    /YG exch def /XG exch def
     /ay YG 3 -1 roll sub def
     /ax XG 3 -1 roll sub def
     /by exch YG sub def
     /bx exch XG sub def
     /a ax ay Pyth def
+    /modA a def % for external use
     /b bx by Pyth def
     /cx ax a div bx b div add def
     /cy ay a div by b div add def
     /c@tmp cx cy Pyth def
     /c ax bx add ay by add Pyth def
+    /OEangle c dup mul a dup mul sub b dup mul sub -2 a b mul mul div Acos def
     %
     % if c=0, then set the coordinates of the vector manually
     % depending on the dotproduct (and thus, if 'a' and 'b'
@@ -44,18 +54,19 @@ tx@OptexpDict begin
         % doesn't really make sens.
         % So if 'chir' <= 0 exchange the calculated coordinates of 
         % A and B and otherwise leave it as is
-	ax by mul ay bx mul sub 0 le
+	/chirality ax by mul ay bx mul sub def
+	chirality 0 le
           {Y@A X@A 
            /X@A X@B def
            /Y@A Y@B def
-           /X@B ED
-           /Y@B ED}if
+           /X@B exch def
+           /Y@B exch def}if
 } bind def
 %
 % called with:  height R1
 % leaves on stack: y |R1| alpha_bottom alpha_top R1
 /leftConvex {% def
-   /R1 ED /h ED
+   /R1 exch def /h exch def
    /a1 R1 dup dup mul h dup mul sub sqrt sub def
    0 R1 abs
    R1 a1 sub neg dup
@@ -68,7 +79,7 @@ tx@OptexpDict begin
 % called with: height R1
 % leaves on stack: y |R1| alpha_bottom alpha_top R1
 /leftConcave {% def
-   /R1 ED /h ED
+   /R1 exch def /h exch def
    /a1 R1 abs dup dup mul h dup mul sub sqrt sub def
    0 R1 abs
    R1 neg a1 sub dup
@@ -82,7 +93,7 @@ tx@OptexpDict begin
 % called with: height R2
 % leaves on stack: y |R2| alpha_bottom alpha_top R2
 /rightConvex {%def
-   /R2 ED /h ED
+   /R2 exch def /h exch def
    /a2 R2 abs dup dup mul h dup mul sub sqrt sub def
    0 R2 abs
    R2 a2 sub dup
@@ -95,7 +106,7 @@ tx@OptexpDict begin
 % called with: height R2
 % leaves on stack: y |R2| alpha_bottom alpha_top R2
 /rightConcave {%def
-   /R2 ED /h ED
+   /R2 exch def /h exch def
    /a2 R2 abs dup dup mul h dup mul sub sqrt sub def
    0 R2 abs
    R2 a2 add dup
@@ -106,4 +117,61 @@ tx@OptexpDict begin
    R2
 } bind def
 %
+/mwNode {%def
+    exch 3 1 roll add 2 div 3 1 roll add 2 div exch
+} bind def
+%
+/FiberAngleB {%
+    N@tempNode@A GetCenter N@tempNode@B GetCenter exch 3 1 roll sub 3 1 roll sub atan
+} bind def
+%
+/FiberAngleA {%
+    FiberAngleB 180 add
+} bind def
+%
+/ExtNode {%
+    @@x0 @xref @@x mul add 
+    @@y0 @yref @@y mul add 
+} bind def
+% basicnodename reverse GetInternalNodeNames
+/GetInternalNodeNames {% def
+    /reverse exch def
+    (N@) exch strcat 
+    1 % counter
+    {% counter and name on stack
+	2 copy dup 3 string cvs 3 -1 roll exch strcat dup
+	tx@NodeDict exch known {%
+	    reverse { 4 1 roll pop } { exch 2 add 1 roll } ifelse
+	} {
+	    reverse { pop pop pop (N) strcat } { pop pop exch (N) strcat exch 1 roll } ifelse
+	    exit
+	} ifelse
+	1 add
+    } loop
+} bind def
+%
+% basicnodename reverse GetInternalBeamNodes x_n y_n ... x_1 y_1 (if reverse = false)
+/GetInternalBeamNodes {% def
+    [ 3 1 roll GetInternalNodeNames ]
+    { cvn tx@NodeDict begin load GetCenter end } forall
+} bind def
+%
+%
+/InitOptexpComp {%
+    tx@Dict begin
+	/@@x 0 def
+	/@@y 0 def
+	/@@x0 0 def
+	/@@y0 0 def
+        /@xref 0 def
+        /@yref 0 def
+    end
+} bind def
+%
+% defaultbasicnodename basicnodename CloseOptexpComp
+/CloseOptexpComp {% def
+    2 copy eq {
+	exch pop [ exch false GetInternalNodeNames ] { tx@NodeDict exch undef } forall
+    } { pop pop } ifelse
+} bind def
 end % tx@OptexpDict