pst-optexp (10jul12)

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

1 files changed, 1437 insertions, 181 deletions

diff --git a/Master/texmf-dist/dvips/pst-optexp/pst-optexp.pro b/Master/texmf-dist/dvips/pst-optexp/pst-optexp.pro
index 2aff67a4521..991a54f9652 100644
--- a/Master/texmf-dist/dvips/pst-optexp/pst-optexp.pro
+++ b/Master/texmf-dist/dvips/pst-optexp/pst-optexp.pro
@@ -1,12 +1,79 @@
-%
-% PostScript prologue for pst-optexp.tex.
-% version 0.3 2009-11-05 (cb)
-% For distribution, see pstricks.tex.
-%
-/tx@OptexpDict 20 dict def
+%%
+%% This is file `pst-optexp.pro',
+%% generated with the docstrip utility.
+%%
+%% The original source files were:
+%%
+%% pst-optexp.dtx  (with options: `prolog')
+%% 
+%% This is a generated file.
+%% 
+%% Project: pst-optexp
+%% Version: 3.0 (2012/07/09)
+%% 
+%% Copyright (C) 2007-2012 by Christoph Bersch <usenet@bersch.net>
+%% 
+%% This work may be distributed and/or modified under the
+%% conditions of the 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.3c or later is part of all distributions of LaTeX
+%% version 2008/05/04 or later.
+%% 
+%% This work has the LPPL maintenance status "maintained".
+%% 
+%% The current maintainer of this work is Christoph Bersch.
+%% 
+%% This work consists of the files pst-optexp.dtx and pst-optexp.ins
+%% and the derived files
+%%     pst-optexp.sty, pst-optexp.pro.
+%% 
+/tx@OptexpDict 200 dict def
 tx@OptexpDict begin
-%
-% str1 str2 append str1str2
+/DebugOE false def
+/DebugDepth 0 def
+/DebugBegin {
+  DebugOE {
+    /DebugProcName ED
+    DebugDepth 2 mul string
+    0 1 DebugDepth 2 mul 1 sub {
+      dup 2 mod 0 eq { (|) }{( )} ifelse
+      3 -1 roll dup 4 2 roll
+      putinterval
+    } for
+    DebugProcName strcat ==
+    /DebugDepth DebugDepth 1 add def
+  }{
+    pop
+  } ifelse
+} bind def
+/DebugEnd {
+  DebugOE {
+    /DebugDepth DebugDepth 1 sub def
+    DebugDepth 2 mul 2 add string
+    0 1 DebugDepth 2 mul 1 sub {
+      dup 2 mod 0 eq { (|) }{ ( ) } ifelse
+      3 -1 roll dup 4 2 roll
+      putinterval
+    } for
+    dup DebugDepth 2 mul (+-) putinterval
+    ( done) strcat ==
+  } if
+} bind def
+/DebugMsg {
+  DebugOE {
+    DebugDepth 1 add 2 mul string
+    0 1 DebugDepth 2 mul 1 add {
+      dup 2 mod 0 eq { (|) }{( )} ifelse
+      3 -1 roll dup 4 2 roll
+      putinterval
+    } for
+    exch strcat ==
+  }{
+    pop
+  } ifelse
+} bind def
 /strcat {
     exch 2 copy
     length exch length add
@@ -14,184 +81,1373 @@ tx@OptexpDict begin
     copy length exch
     putinterval
 } bind def
-%
-% expects: XB YB  XA YA XG YG
-/calcNodes {% def
-    /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'
-    % are parallel or antiparallel
-    c 0 eq
-	{ax bx mul ay by mul add 0 gt
-            % if dotprod > 0 then a and b are parallel
-		{/cx ax def
-              /cy ay def}
-             % else a and b are antiparallel
-             {/cx ay def
-              /cy ax neg def} ifelse
-           /c@tmp a def
-          } if
-        /X@A XG cx c@tmp div add def
-        /Y@A YG cy c@tmp div add def
-        /X@B XG cx c@tmp div sub def
-        /Y@B YG cy c@tmp div sub def
-        %
-        % chirality:
-        % test the order of the input points as a input angle > 90°
-        % doesn't really make sens.
-        % So if 'chir' <= 0 exchange the calculated coordinates of 
-        % A and B and otherwise leave it as is
-	/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 exch def
-           /Y@B exch def}if
-} bind def
-%
-% called with: R1 height
-% leaves on stack: a1
-/segLen {% def
+/nametostr {
+    dup length string cvs
+} bind def
+/PrintWarning {
+  (Warning: ) exch strcat ==
+} bind def
+/inttostr {
+  dup type /integertype eq {
+    dup log 1 add floor cvi string cvs
+  } if
+} bind def
+/IfcCopy {
+  2 copy IfcName exch IfcName load dup
+  length dict copy def
+  name exch NodeName name 3 -1 roll NodeName
+  tx@NodeDict begin
+    load dup length dict copy def
+  end
+} bind def
+/calcNodes {
+  (calcNode) DebugBegin
+  /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
+  /b bx by Pyth def
+  /modB b 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
+  c 0 eq {
+    ax ay bx by DotProd 0 gt {
+      /cx ax def
+      /cy ay def
+    }{
+      /cx ay def
+      /cy ax neg def
+    } ifelse
+    /c@tmp a def
+  } if
+  /X@A XG cx c@tmp div add def
+  /Y@A YG cy c@tmp div add def
+  /X@B XG cx c@tmp div sub def
+  /Y@B YG cy c@tmp div sub def
+  ax by mul ay bx mul sub 0 le {
+    Y@A X@A
+    /X@A X@B def
+    /Y@A Y@B def
+    /X@B exch def
+    /Y@B exch def
+    modA modB /modA exch def /modB exch def
+  } if
+  DebugEnd
+} bind def
+/capHeight {
     dup mul neg exch abs dup 3 1 roll dup mul add sqrt sub
 } bind def
-%
-% called with:  height R1
-% leaves on stack: y |R1| alpha_bottom alpha_top R1
-/leftConvex {% def
-   /R1 exch def /h exch def
-   /a1  R1 h segLen def
-   0 R1 abs
-   R1 a1 sub neg dup
-   h exch atan exch
-   h neg exch atan
-   /ArcL /arc load def
-   R1
-} bind def
-%
-% called with: height R1
-% leaves on stack: y |R1| alpha_bottom alpha_top R1
-/leftConcave {% def
-   /R1 exch def /h exch def
-   /a1 R1 h segLen def
-   0 R1 abs
-   R1 neg a1 sub dup
-   h exch atan exch
-   h neg exch atan
-   /ArcL /arcn load def
-   /a1 0.5 a1 mul def
-   R1
-} bind def
-%
-% called with: height R2
-% leaves on stack: y |R2| alpha_bottom alpha_top R2
-/rightConvex {%def
-   /R2 exch def /h exch def
-   /a2 R2 h segLen def
-   0 R2 abs
-   R2 a2 sub dup
-   h neg exch atan exch
-   h exch atan
-   R2
-   /ArcR /arc load def
-} bind def
-%
-% called with: height R2
-% leaves on stack: y |R2| alpha_bottom alpha_top R2
-/rightConcave {%def
-   /R2 exch def /h exch def
-   /a2 R2 h segLen def
-   0 R2 abs
-   R2 a2 add dup
-   h neg exch atan exch
-   h exch atan
-   /ArcR /arcn load def
-   /a2 0.5 a2 mul def
-   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
-%
-%
+/leftCurvedIfc {
+  /R1 exch def /h exch def
+  0 R1 abs dup R1 h capHeight exch sub R1 sign mul dup
+  h exch atan exch
+  h neg exch atan
+  R1 0 lt {
+    /ArcL /arcn load def
+  } {
+    /ArcL /arc load def
+  } ifelse
+  R1
+} bind def
+/rightCurvedIfc {
+  /R2 exch def /h exch def
+  0 R2 abs dup R2 h capHeight sub R2 sign mul dup
+  h neg exch atan exch
+  h exch atan
+  R2 0 lt {
+    /ArcR /arcn load def
+  } {
+    /ArcR /arc load def
+  } ifelse
+  R2
+} bind def
+/SlopeAngle {
+  (SlopeAngle) DebugBegin
+  @GetCenter 3 -1 roll @GetCenter @ABVect exch atan
+  DebugEnd
+} bind def
+/DefineExtNode {%
+  (DefineExtNode) DebugBegin
+  @@y mul RefFac mul @@y0 add
+  exch @@x mul RefFac mul @@x0 add exch
+  DebugEnd
+} bind def
+/GetInternalNodeNames {
+  (GetInternalNodeNames) DebugBegin
+  /reverse ED
+  dup cvn load /N get dup
+  reverse { -1 1 } { 1 1 3 -1 roll } ifelse
+  { 2 copy eq { pop (N) } { inttostr } ifelse
+    3 -1 roll dup 4 1 roll exch NodeName 3 1 roll
+  } for
+  pop pop
+  DebugEnd
+} bind def
+/GetInternalBeamNodes {
+  (GetInternalBeamNodes) DebugBegin
+  [ 3 1 roll GetInternalNodeNames ]
+  { @GetCenter } forall
+  DebugEnd
+} bind def
+/GetInternalBeamNodesCompat {
+  exch dup 3 1 roll (C) NodeName dup tx@NodeDict exch known {
+    @GetCenter ToVec
+    3 1 roll pop pop
+  } {
+    pop GetInternalBeamNodes
+  } ifelse
+} bind def
+/GetInternalBeamNodeCompat {
+  exch dup 3 1 roll (C) NodeName dup tx@NodeDict exch known {
+    @GetCenter ToVec
+    3 1 roll pop pop
+  } {
+    pop NodeName @GetCenter ToVec
+  } ifelse
+} bind def
 /InitOptexpComp {%
-    tx@Dict begin
-	/@@x 0 def
-	/@@y 0 def
-	/@@x0 0 def
-	/@@y0 0 def
-        /@xref 0 def
-        /@yref 0 def
+  /@@x 0 def
+  /@@y 0 def
+  /@@x0 0 def
+  /@@y0 0 def
+  /@xref 0 def
+  /@yref 0 def
+  /RefFac 1 def
+} bind def
+/NewTempNodeComp {
+  (NewTempNodeComp) DebugBegin
+  /sc ED
+  dup cvn
+  6 dict dup 3 1 roll def begin
+    /ambiguous false def
+    /allowbeaminside false def
+    /name ED
+    /correct false def
+    {0 0} exch 3 -1 roll exec
+    gsave
+      translate
+      /CompMtrx CM def
+    grestore
+    /N 1 def
+    /n bgRefIndex def
+    5 dict dup dup /P@1 ED /P@N ED
+    begin
+      /mode trans def
+      {} 0 0 PlainIfc
+    end
+  /adjustRel true def
+  end
+  DebugEnd
+} bind def
+/CurvedIfc {
+  5 2 roll
+  2 copy 5 3 roll exec 3 -1 roll exec VecAdd
+  5 -1 roll exec /Y ED /X ED
+  exch exec 3 -1 roll 3 copy exec /RY ED /RX ED
+  3 1 roll NormalizeVec 3 -1 roll exec
+  tx@Dict begin Pyth end dup
+  3 1 roll mul 1.00001 mul /NAup ED
+  mul 1.00001 mul /NAlow ED
+} bind def
+/PlainIfc {
+  5 2 roll
+  dup 3 -1 roll exec NormalizeVec 3 -1 roll exec 2 copy /DY ED /DX ED
+  tx@Dict begin Pyth end dup 4 2 roll
+  exch exec 3 -1 roll exec /Y ED /X ED
+  3 1 roll mul 1.00001 mul /NAup ED
+  mul 1.00001 mul /NAlow ED
+} bind def
+/NewCompIfc {
+  /scl ED
+  /next ED
+  dup (P@) exch strcat cvn
+  6 dict dup
+  3 1 roll def
+  begin
+    3 -1 roll
+    /mode ED
+    6 -1 roll dup 7 -1 roll
+    {scl} 8 -2 roll next
+  end
+  exec scl ToVec 3 1 roll NodeName @NewNode
+} bind def
+/relative 0 def /absolute 1 def /center 2 def
+/refl 0 def /trans 1 def /absorb 2 def
+/desc 0 def /asc 1 def /amb 2 def
+/ok 0 def /tir 1 def /missed 2 def
+/bgRefIndex 0 def
+/NewOptexpComp {
+  (NewOptexpComp) DebugBegin
+  /sc ED dup cvn
+  gsave
+  12 dict dup 3 1 roll def begin
+  /name ED
+  /allowbeaminside ED
+  /ambiguous ED
+  dup type /booleantype eq not { false } if /correct ED
+  tx@Dict begin
+    STV {CP T} stopped pop
+  end
+  /CompMtrx CM def
+  grestore
+  counttomark dup 6 idiv dup /N ED 6 mul eq { 1 } if
+  cvx 1 EvalRefIndex /n ED
+  ambiguous {
+    /ambIfc ED
+  }{
+    /ambIfc 0 def
+  } ifelse
+  1 N eq {
+      name (1) 3 -1 roll {sc} NewCompIfc
+      (1) (N) IfcCopy
+  }{
+    N -1 1 { %
+      dup N eq { pop (N) }{inttostr} ifelse
+      exch name 3 1 roll {sc} NewCompIfc
+    } for
+  } ifelse
+  ambiguous ambIfc 0 gt and {
+    ambIfc N eq { (N) }{ ambIfc inttostr } ifelse (C) IfcCopy
+  } if
+  end
+  pop
+  DebugEnd
+} bind def
+/NewOptexpFiberComp {
+  (NewOptexpFiberComp) DebugBegin
+  /sc ED dup cvn
+  gsave
+  12 dict dup 3 1 roll def begin
+  /name ED
+  tx@Dict begin
+    STV {CP T} stopped pop
+  end
+  /CompMtrx CM def
+  grestore
+  counttomark /N ED
+  1 N eq {
+    {0 1} 0 0 trans name (1) {PlainIfc} {sc} NewCompIfc
+    (1) (N) IfcCopy
+  }{
+    N -1 1 {
+      dup N eq { pop (N) }{inttostr} ifelse
+      {0 1} 0 0 absorb name 6 -1 roll {PlainIfc} {sc} NewCompIfc
+    } for
+  } ifelse
+  end
+  pop
+  DebugEnd
+} bind def
+/IfcAlias {
+  2 copy IfcName exch IfcName load def
+  tx@NodeDict begin
+    name exch NodeName name 3 -1 roll NodeName load def
+  end
+} bind def
+/GetPlaneVec {
+  (GetPlaneVec) DebugBegin
+  cvn load begin
+    IfcName load begin
+      currentdict /RX known {
+        RX RY CompMtrx dtransform CM idtransform
+        neg exch
+      } {
+        DX DY CompMtrx dtransform CM idtransform
+      } ifelse
+    end
+  end
+  DebugEnd
+} bind def
+/GetIfcCenter {
+  (GetIfcCenter) DebugBegin
+  dup type /stringtype eq not {
+    dup xcheck not {
+      0 get (C) exch
+    } {
+      exec pop pop pop
+    } ifelse
+  } if
+  cvn load begin
+    IfcName load begin
+      currentdict /RX known {
+        X RX sub Y RY sub
+      } {
+        X Y
+      } ifelse
+      CompMtrx transform CM itransform
+    end
+  end
+  DebugEnd
+} bind def
+/GetIfcCenter {
+  (GetIfcCenter) DebugBegin
+  dup type /stringtype eq not {
+    dup xcheck not {
+      0 get (C) exch
+    } {
+      exec pop pop pop
+    } ifelse
+  } if
+  cvn load begin
+    IfcName load begin
+      currentdict /RX known {
+        X RX sub Y RY sub
+      } {
+        X Y
+      } ifelse
+      CompMtrx transform CM itransform
+    end
+  end
+  DebugEnd
+} bind def
+/GetIfcCenterCorr {
+  (GetIfcCenterCorr) DebugBegin
+  cvn load begin
+    IfcName load begin
+      currentdict /XCorr known {
+        XCorr YCorr
+      }{
+        X Y
+      } ifelse
+      currentdict /RX known {
+        RX neg RY neg VecAdd
+      } if
+      CompMtrx transform CM itransform
+    end
+  end
+  DebugEnd
+} bind def
+/TransformInVec {
+  (TransformInVec) DebugBegin
+  3 1 roll
+  GetIfcCenter 4 2 roll
+  GetIfcCenter 5 -2 roll
+  @ABVect
+  3 -1 roll exec 2 copy 6 2 roll
+  0 eq exch 0 eq and not {
+    exch atan matrix rotate dtransform
+  } {
+    4 2 roll pop pop
+  } ifelse
+  ToVec
+  DebugEnd
+} bind def
+/TransformStartPos {
+  (TransformStartPos) DebugBegin
+  exec 2 copy 6 2 roll 0 eq exch 0 eq and not
+  3 1 roll GetIfcCenter 4 2 roll
+  GetIfcCenter 5 2 roll {
+    2 copy 8 2 roll
+    @ABVect exch atan matrix rotate dtransform
+    VecAdd
+  } {
+    6 2 roll pop pop pop pop
+  } ifelse
+  ToVec
+  DebugEnd
+} bind def
+/GetNearestPlane {
+  (GetNearestPlane) DebugBegin
+  3 copy 1 exch GetIfcCenter @ABDist /dist ED /nearestPlane 1 def
+  dup cvn load /N get 2 1 3 -1 roll {
+    4 copy exch GetIfcCenter @ABDist dup dist lt {
+      /dist ED /nearestPlane ED
+    } {
+      pop pop
+    } ifelse
+  } for
+  pop pop pop nearestPlane
+  DebugEnd
+} bind def
+/PushAmbCompPlanesOnStack {
+ (PushAmbCompPlanesOnStack) DebugBegin
+  currentdict /outToPlane undef
+  PN IfcCnt eq not {
+    exch dup 3 1 roll % nextifc ambcomp nextifc
+    dup xcheck not {
+      0 get (C) exch
+    } {
+      exec pop pop pop
+    } ifelse
+    [ 3 1 roll ] cvx /outToPlane ED
+  } if
+  /IfcCntTmp IfcCnt def
+  aload pop /draw ED /name ED
+  name cvn load /N get /N ED
+  currentdict /Curr known {
+    /CurrTmp /Curr load def
+    /CurrVecTmp /CurrVec load def
+  } {
+    /CurrTmp /CurrLow load def
+    /CurrVecTmp /CurrVecLow load def
+  } ifelse
+  PN 1 eq {
+    [ (C) name name GetRefIndex trans draw] cvx
+    name /outToPlane load GetNextPlane
+    dup 0 eq not {
+      [ exch name bgRefIndex trans draw ] cvx exch
+      /IfcCntTmp IfcCntTmp 1 add def
+    } {
+      pop
+    } ifelse
+  }{
+    CurrTmp name GetNearestPlane dup /firstPlane ED
+    name isAmbiguousIfc not {
+      CurrVecTmp firstPlane name GetPlaneVec NormalVec
+      (C) name GetIfcCenter firstPlane name GetIfcCenter
+      @ABVect 2 copy 6 2 roll DotProd
+      0 lt { trans }{ refl } ifelse
+      3 1 roll ToVec /CurrVecTmp ED
+      [ firstPlane name
+      connectifc {
+        bgRefIndex
+      }{
+        name GetRefIndex
+      } ifelse
+      5 -1 roll true ] cvx
+      /IfcCntTmp IfcCntTmp 1 add def
+    } if
+    PN IfcCnt eq {
+      [ (C) name
+      name GetRefIndex
+      trans draw ] cvx
+      IfcCntTmp IfcCnt gt { exch } if
+    } {
+      [ (C) name
+      name GetRefIndex
+      CurrVecTmp (C) name GetPlaneVec NormalVec outToPlane
+      GetIfcCenter (C) name GetIfcCenter @ABVect DotProd
+      0 lt { trans } { refl } ifelse % mode
+      draw ] cvx
+      name /outToPlane load GetNextPlane
+      dup dup name isAmbiguousIfc exch 0 eq or not {
+        [ exch name bgRefIndex trans draw ] cvx exch
+        firstPlane name isAmbiguousIfc not { 3 -1 roll } if
+        /IfcCntTmp IfcCntTmp 1 add def
+      } {
+        pop
+        exec 3 -1 roll pop bgRefIndex 3 1 roll [ 6 1 roll ] cvx
+        firstPlane name isAmbiguousIfc not { exch } if
+      } ifelse
+    } ifelse
+  } ifelse
+  /IfcCnt IfcCntTmp def
+  DebugEnd
+} bind def
+/GetNextPlane {
+  (GetNextPlane) DebugBegin
+  2 copy (C) 3 -1 roll
+  GetIfcCenter 3 -1 roll exec GetIfcCenter
+  4 2 roll 4 copy @ABVect /VecY ED /VecX ED
+  @ABDist /centerDist ED
+  /sprod 1 def
+  /nextPlane 0 def
+  exch dup 3 1 roll
+  cvn load dup /ambIfc get /ambIfc ED /N get 1 1 3 -1 roll {
+   dup ambIfc eq not {
+      3 copy 3 -1 roll 2 copy
+      GetPlaneVec VecX VecY 4 2 roll NormalVec
+      VecX VecY DotProd dup sprod lt 5 2 roll
+      GetIfcCenter 3 -1 roll exec GetIfcCenter @ABDist
+      centerDist lt and
+      { /sprod ED /nextPlane ED } { pop pop } ifelse
+    } {
+      pop
+    } ifelse
+  } for
+  pop pop nextPlane
+  DebugEnd
+} bind def
+/TraceBeam {
+  (Tracebeam) DebugBegin
+  AngToVec /InVec ED /StartPoint ED
+  /oldbeaminsidelast currentdict /beaminsidelast known {
+    beaminsidelast
+  } {
+    false
+  } ifelse def
+  exec
+  connectifc {
+    /nbeam bgRefIndex def
+  } if
+  /startinside startinside beaminsidefirst or def
+  /stopinside stopinside beaminsidelast or def
+  /PrevCorrect false def
+  PrearrangePlanes
+  PushAllPlanesOnStack
+  currentdict /lastVecTmp known {
+    lastVecTmp beamangle matrix rotate dtransform ToVec
+  } {
+    beamalign relative eq counttomark 2 ge and {
+      2 copy /InVec load TransformInVec
+    } {
+      /InVec load
+    } ifelse
+  } ifelse
+  /CurrVec ED
+  currentdict /lastBeamPointTmp known {
+    /lastBeamPointTmp load /Curr ED
+  }{
+    counttomark 2 ge {
+      2 copy /StartPoint load  TransformStartPos
+    } {
+      /StartPoint load
+    } ifelse
+    /Curr ED
+  } ifelse
+  counttomark /IfcCnt ED
+  /n1 bgRefIndex def
+  /PN 1 def
+  (start looping) DebugMsg
+  {
+    PN IfcCnt gt {
+      exit
+    } if
+    (checked) DebugMsg
+    dup xcheck not {
+      PushAmbCompPlanesOnStack
+    } if
+    exec
+    /draw ED /Mode ED /n2 ED 2 copy /CompName ED /IfcNum ED
+    GetIfcCenter ToVec /CurrCenter ED
+    Curr CurrVec
+    connectifc PrevCorrect PN 2 gt and PN 2 eq or and {
+      CurrVec CurrCenter PrevCenter PrevMode
+      currentdict /relAngle known
+      { relAngle } { 0 } ifelse connectInterfaces
+      /relAngle ED
+    } if
+    IfcNum CompName Mode n2 8 4 roll HandleInterface
+    missed eq {
+      counttomark PN 1 sub 3 mul sub {pop} repeat
+      (The beam missed an interface) Warning exit
+      exit
+    } if
+    PN 1 eq {
+      pop pop
+      /draw beaminsidefirst oldbeaminsidelast xor def
+    } {
+      ToVec /CurrVec ED
+    } ifelse
+    2 copy
+    ToVec /Curr ED
+    draw PN skipconn 1 add gt and
+    counttomark 3 roll
+    /PrevCenter /CurrCenter load def
+    /lastBeamPointTmp /Curr load def
+    /lastVecTmp /CurrVec load def
+    /PrevMode Mode def
+    CompName cvn load /correct get /PrevCorrect ED
+    PN IfcCnt eq {
+      exit
+    } {
+      CurrVec 0 eq exch 0 eq and {
+        IfcCnt PN sub {pop} repeat
+        (Total internal reflection occured, this is not supported)
+        Warning
+        exit
+      } if
+      /PN PN 1 add def
+    } ifelse
+  } loop
+  DebugEnd
+} bind def
+/sign {
+    0 ge { 1 } { -1 } ifelse
+} bind def
+/TraceAndFillWideBeam {
+  (TraceAndFillWideBeam) DebugBegin
+  AngToVec /InvecLow ED /StartLow ED
+  AngToVec /InvecUp ED /StartUp ED
+  exec
+  connectifc {
+    /nbeam bgRefIndex def
+  } if
+  /startinside startinside beaminsidefirst or def
+  /stopinside stopinside beaminsidelast or def
+  /DrawnSegm 0 def
+  /PrevCorrect false def
+  PrearrangePlanes
+  PushAllPlanesOnStack
+  currentdict /lastVecTmpUp known
+  currentdict /lastVecTmpLow known and {
+    /CurrVecLow lastVecTmpLow beamangle matrix rotate dtransform ToVec def
+    /CurrVecUp lastVecTmpUp beamangle matrix rotate dtransform ToVec def
+  }{
+    beamalign relative eq counttomark 2 ge and {
+      2 copy /InvecLow load TransformInVec /CurrVecLow ED
+      2 copy /InvecUp load TransformInVec /CurrVecUp ED
+    } {
+      /CurrVecLow /InvecLow load def
+      /CurrVecUp /InvecUp load def
+    } ifelse
+  } ifelse
+  currentdict /lastBeamPointTmpLow known
+  currentdict /lastBeamPointTmpUp known and {
+    /lastBeamPointTmpLow load /CurrLow ED
+    /lastBeamPointTmpUp load /CurrUp ED
+  } {
+    counttomark 2 ge {
+      2 copy /StartLow load TransformStartPos /CurrLow ED
+      2 copy /StartUp load TransformStartPos /CurrUp ED
+    } {
+      /StartLow load /CurrLow ED
+      /StartUp load /CurrUp ED
+    } ifelse
+  } ifelse
+  counttomark /IfcCnt ED
+  /n1 bgRefIndex def
+  /CurrR false def
+  /ret missed def
+  /PN 1 def
+  {
+    PN IfcCnt gt {
+      exit
+    } if
+    dup xcheck not {
+      PushAmbCompPlanesOnStack
+    } if
+    exec
+    PN skipconn 1 add gt and /draw ED
+    /Mode ED /n2 ED 2 copy /CompName ED /IfcNum ED
+    GetIfcCenter ToVec /CurrPCenter ED
+    /oldn1 n1 def
+    CurrUp CurrVecUp
+    connectifc PrevCorrect PN 2 gt and PN 2 eq or and {
+      CurrVecUp CurrPCenter PrevPCenter PrevMode
+      currentdict /relAngleUp known { relAngleUp } { 0 } ifelse
+      connectInterfaces /relAngleUp ED
+    } if
+    /CurrVecUp load /PrevVecUp ED
+    /CurrUp load /PrevUp ED
+    IfcNum CompName Mode n2 8 4 roll HandleInterface
+    dup /ret ED
+    missed eq {
+      counttomark {pop} repeat
+      (The upper beam missed an interface) Warning exit
+    } if
+    ToVec /CurrVecUp ED
+    ToVec /CurrUp ED
+    /n1 oldn1 def
+    /CurrVecLow load /PrevVecLow ED
+    /CurrLow load /PrevLow ED
+    CurrLow CurrVecLow
+    connectifc PrevCorrect PN 2 gt and PN 2 eq or and  {
+      CurrVecLow CurrPCenter PrevPCenter PrevMode
+      currentdict /relAngleLow known { relAngleLow } { 0 } ifelse
+      connectInterfaces /relAngleLow ED
+    } if
+    IfcNum CompName Mode n2 8 4 roll HandleInterface
+    dup missed eq {
+      /ret ED
+      (The lower beam missed an interface) Warning
+      counttomark {pop} repeat exit
+    } if
+    tir eq ret tir eq or {
+      /ret tir def
+    } {
+      /ret ok def
+    } ifelse
+    ToVec /CurrVecLow ED
+    ToVec /CurrLow ED
+    /PrevR CurrR def
+    PrevR type /realtype eq {
+      /CurrCenter load /PrevCenter ED
+    } if
+    IfcNum CompName isCurved {
+      IfcNum CompName LoadIfc
+      tx@Dict begin Pyth end /CurrR ED
+      ToVec /CurrCenter ED
+    } {
+      /CurrR false def
+      /CurrCenter false def
+    } ifelse
+    PN 1 gt currentdict /fillBeam known and {
+      draw {
+        /DrawnSegm DrawnSegm 1 add def
+        PrevUp moveto CurrUp lineto
+        IfcNum CompName isCurved {
+          CurrCenter CurrUp CurrLow
+          4 copy 3 -1 roll eq 3 1 roll eq and {
+            6 {pop} repeat
+          } {
+            TangentCrosspoint
+            CurrLow CurrR arct
+          } ifelse
+        } {
+          CurrLow lineto
+        } ifelse
+        PrevLow lineto
+        PrevR type /booleantype eq not {
+          PrevCenter PrevLow PrevUp
+          4 copy 3 -1 roll eq 3 1 roll eq and {
+            6 {pop} repeat
+          } {
+            TangentCrosspoint
+            PrevUp PrevR arct
+          } ifelse
+        } {
+          PrevUp lineto
+        } ifelse
+      } if
+      Mode refl eq draw and
+      draw not DrawnSegm 0 gt and or {
+        fillBeam newpath
+        /DrawnSegm 0 def
+      } if
+    } if
+    PN 1 eq {
+      /CurrVecUp /PrevVecUp load def
+      /CurrVecLow /PrevVecLow load def
+    } if
+    strokeBeam {
+      CurrUp draw CurrLow draw counttomark 1 add 6 roll
+    } if
+    PN IfcCnt eq ret tir eq or {
+      DrawnSegm 0 gt currentdict /fillBeam known and {
+        fillBeam newpath
+        /DrawnSegm 0 def
+      } if
+      ret tir eq {
+        IfcCnt PN sub {pop} repeat
+        (Total internal reflection occured, this is not supported)
+        Warning
+      } if
+      exit
+    } if
+    /PN PN 1 add def
+    /PrevPCenter /CurrPCenter load def
+    /PrevMode Mode def
+    CompName cvn load /correct get /PrevCorrect ED
+  } loop
+  DrawnSegm 0 gt currentdict /fillBeam known and {
+    fillBeam newpath
+    /DrawnSegm 0 def
+  } if
+  ret missed eq not {
+    CurrUp CurrLow @ABVect
+    CurrVecUp CurrVecLow 3 -1 roll add 3 1 roll add exch
+    4 -1 roll mul 3 1 roll mul sub 0 gt {
+      /lastBeamPointTmpUp /CurrLow load def
+      /lastBeamPointTmpLow /CurrUp load def
+      /lastVecTmpUp /CurrVecLow load def
+      /lastVecTmpLow /CurrVecUp load def
+    } {
+      /lastBeamPointTmpLow /CurrLow load def
+      /lastBeamPointTmpUp /CurrUp load def
+      /lastVecTmpUp /CurrVecUp load def
+      /lastVecTmpLow /CurrVecLow load def
+    } ifelse
+  } if
+  DebugEnd
+} bind def
+/isAmbiguous {
+  cvn load dup /ambiguous known {
+    /ambiguous get
+  } {
+    pop false
+  } ifelse
+} bind def
+/isAmbiguousIfc {
+  cvn load dup /ambiguous known {
+    /ambIfc get eq
+  } {
+    pop pop false
+  } ifelse
+} bind def
+/isCurved {
+  cvn load begin
+    IfcName load /RX known
+  end
+} bind def
+/HandleInterface {
+  (HandleInterface) DebugBegin
+  /Yin ED /Xin ED /Y0 ED /X0 ED /n2 ED /mode ED
+  2 copy 2 copy LoadIfc
+  6 -2 roll isCurved { CurvedInterface }{ PlainInterface } ifelse
+  dup missed eq not useNA connectifc not and and {
+    7 3 roll 2 copy 9 2 roll
+    4 2 roll 2 copy
+    %% X0' Y0' Xout Yout status X0' Y0' IfcNum CompName IfcNum CompName
+    cvn load begin IfcName load dup /NAlow get exch /NAup get end
+    2 copy lt {
+      4 2 roll 2 copy LoadIfc NormalizeVec
+      6 -2 roll isCurved {
+        neg exch
+      } if
+      %% ... X0' Y0' NAlow NAup X Y dXp dYp
+      8 -2 roll 6 -2 roll
+      %% ... NAlow NAup dXp dYp X0' Y0' X Y
+      @ABVect DotProd
+      dup 4 -1 roll ge 3 1 roll ge and not
+      {
+        pop missed
+      } if
+    }{
+      6 {pop} repeat
+    } ifelse
+  } {
+    7 -2 roll pop pop
+  } ifelse
+  DebugEnd
+} bind def
+/LoadIfc {
+  (LoadIfc) DebugBegin
+  cvn load begin
+    IfcName load begin
+      X Y
+      CompMtrx transform CM itransform
+      currentdict /RX known { RX RY }{ DX DY } ifelse
+      CompMtrx dtransform CM idtransform
+    end
+  end
+  DebugEnd
+} bind def
+/isFreeray {
+  cvn load /n known
+  dup not {
+    (Encountered fiber component in beam path) Warning
+  } if
+} bind def
+/PrearrangePlanes {
+  (PrearrangePlanes) DebugBegin
+  counttomark /N ED
+  /CompA ED dup /CompB ED
+  CompA isFreeray {
+    CompA isAmbiguous {
+      amb dup CompA
+    } {
+      CompB isAmbiguous {
+        1 CompA GetIfcCenter (C) CompB GetIfcCenter @ABDist
+        (N) CompA GetIfcCenter (C) CompB GetIfcCenter @ABDist
+      } {
+        1 CompA GetIfcCenter
+        1 CompB GetIfcCenter
+        (N) CompB GetIfcCenter
+        true OrderNodes exch pop
+        (N) CompA GetIfcCenter
+        1 CompB GetIfcCenter
+        (N) CompB GetIfcCenter
+        true OrderNodes exch pop
+      } ifelse
+      le { desc } { asc } ifelse dup CompA
+    } ifelse
+    counttomark 2 roll
+  } {
+    counttomark 1 sub { pop } repeat
+    /N 0 def
+  } ifelse
+  2 1 N {
+    /i ED exch /CompB ED
+    CompB isFreeray not {
+      counttomark i 1 sub 2 mul 1 add sub { pop } repeat
+      exit
+    } if
+    CompB isAmbiguous not {
+      dup desc eq { 1 } { dup amb eq { (C) }{ (N) } ifelse } ifelse
+      CompA GetIfcCenter
+      1 CompB GetIfcCenter
+      (N) CompB GetIfcCenter false OrderNodes dup dup
+      4 -1 roll CompA exch 5 -1 roll CompB exch
+      i 2 eq {
+        4 copy 4 2 roll AdjustRelRot
+      } if
+      AdjustRelRot
+    } {
+      pop amb dup
+    } ifelse
+    CompB /CompA CompB def
+    counttomark 2 roll
+  } for pop
+  DebugEnd
+} bind def
+/AdjustRelRot {
+  (AdjustRelRot) DebugBegin
+  exch dup cvn load /adjustRel known {
+    dup dup 4 2 roll isAmbiguous {
+      exch pop (C)
+    }{
+      desc eq { (N) }{ 1 } ifelse
+    } ifelse
+    exch GetIfcCenter 5 3 roll
+    exch dup 3 1 roll isAmbiguous {
+      pop (C)
+    }{
+      desc eq { 1 }{ (N) } ifelse
+    } ifelse
+    exch GetIfcCenter
+    @ABVect exch atan exch
+    cvn load begin
+      adjustRel {
+        matrix rotate CompMtrx matrix concatmatrix /CompMtrx ED
+        /adjustRel false def
+      } {
+        pop
+      } ifelse
+    end
+  } {
+    pop pop pop pop
+  } ifelse
+  DebugEnd
+} bind def
+/PushAllPlanesOnStack {
+  (PushAllPlanesOnStack) DebugBegin
+  counttomark 2 div cvi /@N ED
+  1 1 @N {
+    /last false def
+    /first false def
+    dup 1 eq {
+      /first true def pop beaminsidefirst
+    } {
+      @N eq {
+        beaminsidelast
+        /last true def
+      } {
+        beaminside
+      } ifelse
+    } ifelse
+    exch load dup dup /allowbeaminside get 4 -1 roll and
+    /drawinside ED
+    /ambiguous get {
+      /name get drawinside [ 3 1 roll ]
+      counttomark 1 roll pop
+    } {
+      begin
+        desc eq {
+          N N -1 1 1
+        } {
+          1 1 1 N N
+        } ifelse
+        first startinside not and {
+          5 -2 roll
+          pop pop
+          2 copy 5 2 roll
+        } if
+        5 1 roll
+        {
+          3 1 roll 2 copy 5 -1 roll
+          dup 3 1 roll
+          eq first not and {
+            true
+          } {
+            drawinside
+          } ifelse
+          exch dup 4 -1 roll eq {
+            bgRefIndex
+          }{
+            name GetRefIndex
+          } ifelse
+          exch dup N eq {
+            pop (N)
+          } {
+            inttostr
+          } ifelse exch
+          3 1 roll name
+          4 1 roll
+          dup IfcName load /mode get
+          3 1 roll 5 1 roll
+          [ 6 1 roll ] cvx counttomark 1 roll
+          last {
+            savebeampoints 1 ge stopinside not and
+            savebeampoints 1 lt beaminsidelast not and or {
+              exit
+            } if
+          } if
+        } for pop pop
+      end
+    } ifelse
+  } for
+  DebugEnd
+} bind def
+/IfcName {
+  dup dup 1 eq not exch N eq and {
+    pop (N)
+  } {
+    inttostr
+  } ifelse
+  (P@) exch strcat cvn
+} bind def
+/NodeName {
+  dup /stringtype eq not { inttostr } if
+  strcat (N@) exch strcat cvn
+} bind def
+/OrderNodes {
+   7 1 roll 6 -2 roll 2 copy 8 2 roll
+   @ABDist 5 1 roll @ABDist 2 copy gt {
+       pop asc exch
+   } {
+       exch pop desc exch
+   } ifelse
+   3 -1 roll not {
+       pop
+   } if
+} bind def
+/NormalVec {
+  neg exch 2 copy 6 2 roll DotProd 0 gt {
+    -1 mul exch -1 mul exch
+  } if
+  NormalizeVec
+} bind def
+/DotProd {
+    3 -1 roll mul 3 1 roll mul add
+} bind def
+/VecAngle {
+  4 copy 4 copy DotProd 5 1 roll
+  tx@Dict begin
+    Pyth 3 1 roll Pyth
+  end mul
+  div Acos
+  5 2 roll mul 4 1 roll 3 -1 roll mul 3 -1 roll sub
+  0 le { -1 }{ 1 } ifelse mul
+} bind def
+/VecAdd {
+    3 -1 roll add 3 1 roll add exch
+} bind def
+/VecScale {
+  dup 4 -1 roll mul 3 1 roll mul
+} bind def
+/ToVec {
+    [ 3 1 roll ] cvx
+} bind def
+/AngToVec {
+    dup cos exch sin ToVec
+} bind def
+/NormalizeVec {
+  2 copy
+  tx@Dict begin
+    Pyth
+  end
+  dup 3 1 roll div 3 1 roll div exch
+} bind def
+/@ABVect {
+  tx@EcldDict begin ABVect end
+} bind def
+/@ABDist {
+  tx@EcldDict begin ABDist end
+} bind def
+/@InterLines {
+  tx@EcldDict begin
+    EqDr /D1c exch def /D1b exch def /D1a exch def
+    EqDr /D2c exch def /D2b exch def /D2a exch def
+    D1a D2b mul D1b D2a mul sub dup
+    ZeroEq { % parallel lines
+      pop 0 0 missed
+    }{
+      /Det exch def
+      D1b D2c mul D1c D2b mul sub Det div
+      D1a D2c mul D2a D1c mul sub Det div
+      ok
+    } ifelse
+  end
+} bind def
+/@GetCenter {
+  tx@NodeDict begin load GetCenter end
+} bind def
+/@NewNode {
+  tx@NodeDict begin
+    false exch 10 {InitPnode } NewNode
+  end
+} bind def
+/RefractVec {
+  (RefractVec) DebugBegin
+  TransformRefIndex exch TransformRefIndex exch div /n ED
+  /Ynorm ED /Xnorm ED
+  NormalizeVec /Yin ED /Xin ED
+  n abs 1 eq {
+    Xin Yin
+  }{
+    /costheta1 Xnorm Ynorm Xin neg Yin neg DotProd def
+    1 n dup mul 1 costheta1 dup mul sub mul sub
+    dup 0 lt {
+      pop 0 0
+    } {
+      sqrt /costheta2 ED
+      n Xin mul n Yin mul
+      n costheta1 mul costheta2 sub dup
+      Xnorm mul exch Ynorm mul VecAdd
+    } ifelse
+  } ifelse
+  DebugEnd
+} bind def
+/ReflectVec {
+  (ReflectVec) DebugBegin
+  /Ynorm ED /Xnorm ED NormalizeVec /Yin ED /Xin ED
+  /costheta1 Xnorm Ynorm Xin neg Yin neg DotProd def
+  Xin Yin 2 costheta1 mul dup Xnorm mul exch Ynorm mul VecAdd
+  DebugEnd
+} bind def
+/CurvedInterface {
+  (CurvedInterface) DebugBegin
+  2 copy /Yr ED /Xr ED
+  tx@Dict begin Pyth end /radius ED /Yp ED /Xp ED
+  /X0n X0 Xp sub def /Y0n Y0 Yp sub def
+  tx@EcldDict begin
+    X0n Y0n 2 copy 2 copy Xin 3 -1 roll add Yin 3 -1 roll add
+    2 copy 6 2 roll EqDr radius InterLineCircle
+  end
+  4 copy
+  0 eq 3 {exch 0 eq and} repeat {
+    missed
+  } {
+    4 copy
+    Xr neg Yr neg 2 copy
+    8 -2 roll @ABDist
+    5 1 roll @ABDist
+    gt {
+      4 2 roll
+    } if pop pop
+    Xp Yp VecAdd
+    2 copy Xp Yp 4 2 roll @ABVect exch neg Xin Yin 4 2 roll NormalVec
+    Xin Yin 4 2 roll
+    mode trans eq {
+      n1 n2 RefractVec
+      2 copy 0 eq exch 0 eq and { tir } { ok } ifelse
+    } {
+      ReflectVec ok
+    } ifelse /n1 n2 def
+    5 -2 roll 2 copy 7 2 roll X0 Y0 @ABVect Xin Yin DotProd 0 lt
+    PN 1 gt and {
+      pop missed
+    } if
+  } ifelse
+  DebugEnd
+} bind def
+/PlainInterface {%
+  (PlainInterface) DebugBegin
+  /dYp ED /dXp ED /Yp ED /Xp ED
+  Xp Yp Xp dXp add Yp dYp add X0 Y0 X0 Xin add Y0 Yin add
+  @InterLines missed eq {
+    0 0 missed
+  } {
+    Xin Yin Xin Yin dXp dYp NormalVec
+    mode trans eq {
+      n1 n2 RefractVec
+      2 copy 0 eq exch 0 eq and { tir } { ok } ifelse
+    } {
+      ReflectVec ok
+    } ifelse /n1 n2 def
+    5 -2 roll 2 copy 7 2 roll X0 Y0 @ABVect Xin Yin DotProd 0 lt
+    PN 1 gt and {
+      pop missed
+    } if
+  } ifelse
+  DebugEnd
+} bind def
+/TransformRefIndex {
+  dup bgRefIndex eq { pop 1 } if
+} bind def
+/GetRefIndex {
+  cvn load /n get /nbeam load exch
+  EvalRefIndex
+} bind def
+/EvalRefIndex {
+  dup bgRefIndex eq not {
+    1 dict begin
+      /n ED
+      exec
     end
+  } if
+} bind def
+/Sellmaier {
+  dup mul
+  dup dup 1.03961212 mul exch 6000.69867 sub div
+  exch dup dup 0.231792344 mul exch 20017.9144 sub div
+  exch dup 1.01046945 mul exch 103.560653e6 sub div
+  add add 1 add sqrt
+} bind def
+/TangentCrosspoint {
+    4 copy 4 copy 14 -2 roll 2 copy
+    6 2 roll @ABVect neg exch
+    6 2 roll @ABVect neg exch
+    8 -2 roll VecAdd 10 2 roll VecAdd
+    @InterLines pop
+} bind def
+/NearestNodeTmp {
+  exch /NodeB ED
+  /dist -1 def
+  dup cvn load /N get dup 1 eq {
+    [ exch (N) ]
+  } {
+    [ exch 1 1 3 -1 roll { } for ]
+  } ifelse
+  {
+    2 copy pop
+    GetIfcCenterCorr 2 copy
+    NodeB @ABDist
+    dist 0 lt {
+      /dist ED
+      ToVec /node ED
+    } {
+      dup dist lt {
+        /dist ED
+        ToVec /node ED
+      } {
+        pop pop pop
+      } ifelse
+    } ifelse
+  } forall
+  pop dist /node load
+} bind def
+/NearestNode {
+  (NearestNode) DebugBegin
+  dup xcheck not { nametostr } if /CompB ED
+  dup xcheck not {
+    nametostr /CompA ED
+    /CompB load dup xcheck not {
+      /mindist -1 def
+      [ exch false GetInternalNodeNames ]
+      { @GetCenter ToVec
+        CompA NearestNodeTmp
+        exch dup mindist ge mindist 0 ge and {
+          pop pop
+        }{
+          /mindist ED /minnodeA ED
+        } ifelse
+      } forall
+      minnodeA
+    } {
+      CompA NearestNodeTmp exch pop exec
+    } ifelse
+  } {
+    exec
+  } ifelse
+  DebugEnd
 } 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
-%
-% xa ya xb yb ExchCoor true|false
-/ExchCoor {% def
-    exch 4 -1 roll% ya yb xb xa
-    2 copy % ya yb xb xa
-    gt 
-    { pop pop pop pop false } % xB > xA
-    { eq % xA == xB
-	3 1 roll gt % yA < yB
-	and
-        { false } 
-        { true } ifelse
+/RelFiberAngle {
+  (RelFiberAngle) DebugBegin
+  /fiberalign ED
+  dup xcheck not { nametostr } if /CompB ED
+  dup xcheck not { nametostr } if /CompA ED
+  /CompA load xcheck {
+    /CompB load xcheck {
+      @ABVect exch atan
+    } {
+      4 copy @ABVect 6 2 roll pop pop 2 copy
+      CompB (Center) NodeName @GetCenter
+      4 2 roll @ABVect 4 2 roll
+      CompB
+      fiberalign center eq {
+        RelFiberAngle@center
+      }{
+        RelFiberAngle@ref
+      } ifelse
+      2 copy exch atan
+      7 3 roll 2 copy 9 -2 roll
+      DotProd 0 gt 5 1 roll DotProd 0 gt xor { 180 add } if
     } ifelse
+  } {
+    4 2 roll pop pop 2 copy
+    CompA (Center) NodeName @GetCenter
+    4 2 roll @ABVect 4 2 roll
+    CompA fiberalign center eq {
+      RelFiberAngle@center
+    }{
+      RelFiberAngle@tref
+    } ifelse
+    2 copy exch atan
+    5 1 roll DotProd 0 gt { 180 add } if
+  } ifelse
+  DebugEnd
+} bind def
+/RelFiberAngle@ref {
+  3 1 roll pop pop
+  dup (A) NodeName exch (B) NodeName
+  @GetCenter 3 -1 roll @GetCenter @ABVect
+} bind def
+/RelFiberAngle@tref {
+  3 1 roll pop pop
+  dup (TrefA) NodeName exch (TrefB) NodeName
+  @GetCenter 3 -1 roll @GetCenter @ABVect
+} bind def
+/RelFiberAngle@center {
+  (Center) NodeName @GetCenter 4 2 roll @ABVect
+} bind def
+/getsubnode {
+  dup xcheck {
+    exch pop exec
+  } {
+    nametostr exch nametostr exch GetIfcCenter
+  } ifelse
+} bind def
+/connectInterfaces {
+  /relAngleTmp ED
+  PN 2 eq {
+    pop @ABVect NormalizeVec 4 2 roll VecAngle /relAngleTmp ED
+  } if
+  PN 3 ge {
+    trans eq {
+      @ABVect NormalizeVec 4 2 roll pop pop % remove Vec from stack
+      relAngleTmp matrix rotate dtransform
+      4 2 roll pop pop
+    } {
+      @ABVect NormalizeVec 4 2 roll VecAngle /relAngleTmp ED
+    } ifelse
+  } if
+  relAngleTmp
+} bind def
+/GetCompRange {
+  2 copy gt { 1 }{ -1 } ifelse 3 -1 roll
+  { exch dup 3 -1 roll inttostr strcat exch} for
+  pop
+} bind def
+/CorrectDipoleIfc {
+  (CorrectDipoleIfc) DebugBegin
+  dup dup 3 copy
+  8 -1 roll dup 9 1 roll NodeName exch 7 -1 roll dup 7 1 roll NodeName
+  gsave
+    tx@Dict begin
+      STV CP T
+      exch @GetCenter 3 -1 roll @GetCenter
+    end
+  grestore
+  4 copy @ABDist 1e-7 lt {
+    6 -1 roll
+    gsave
+      tx@Dict begin
+        STV CP T
+        (TrefA) NodeName @GetCenter 7 -1 roll
+        (TrefB) NodeName @GetCenter
+      end
+    grestore
+    @ABVect NormalizeVec 2 copy
+    8 -2 roll abs exch abs max -1e-6 mul VecScale
+    8 -2 roll cvn load begin
+      IfcName load begin
+        X Y VecAdd /YCorr exch def /XCorr exch def
+      end
+    end
+    4 2 roll abs exch abs max 1e-6 mul VecScale
+    4 2 roll cvn load begin
+      IfcName load begin
+        X Y VecAdd /YCorr exch def /XCorr exch def
+      end
+    end
+  } {
+    10 { pop } repeat
+  } ifelse
+  DebugEnd
+} bind def
+/debug {
+  /@N ED count dup @N gt @N 0 ge and { pop @N } if
+  copy @N { == } repeat
+} bind def
+/debugComp {
+  dup (debug comp ") exch strcat ("===============) strcat ==
+  cvn load {
+    dup type /dicttype eq {
+      (plane----------------) ==
+      { == == } forall
+      (-----------done) ==
+      } { == } ifelse
+      ==
+  } forall
+  (================== done) ==
 } bind def
 end % tx@OptexpDict