summaryrefslogtreecommitdiff
path: root/Master/texmf-dist/dvips/pst-optexp/pst-optexp.pro
diff options
context:
space:
mode:
authorKarl Berry <karl@freefriends.org>2012-07-11 00:23:38 +0000
committerKarl Berry <karl@freefriends.org>2012-07-11 00:23:38 +0000
commit098bf061faf05059dd90a3b9ee89bb5d85abebda (patch)
tree376bc695a21802678e76ef4afafd299929681376 /Master/texmf-dist/dvips/pst-optexp/pst-optexp.pro
parentc353e13397245a2ace91c7d3ce5eed2e590447d0 (diff)
pst-optexp (10jul12)
git-svn-id: svn://tug.org/texlive/trunk@26992 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/texmf-dist/dvips/pst-optexp/pst-optexp.pro')
-rw-r--r--Master/texmf-dist/dvips/pst-optexp/pst-optexp.pro1618
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