path: root/Master/texmf-dist/dvips/pst-optexp/pst-optexp.pro

%%
%% 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.3 (2012/08/17)
%% 
%% 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
/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
    string dup dup 5 2 roll
    copy length exch
    putinterval
} bind 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
/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 {%
  /@@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
    /forcebeaminside 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
  /forcebeaminside 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
      IfcCntTmp IfcCnt eq { true }{ draw } ifelse
      ] 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
    currentdict /lastVecTmp known {
      /prevVecTmp /lastVecTmp load def
      /lastVecTmp /CurrVec load def
    } {
      /CurrVec load dup /lastVecTmp ED /prevVecTmp ED
    } ifelse
    /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
/Chirality {
  4 -1 roll mul 3 1 roll mul sub sign
} 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
    loadbeam not beamdiv 0 eq not and {
      CurrVecLow CurrVecUp Chirality
      CurrLow CurrUp @ABVect CurrVecLow CurrVecUp VecAdd Chirality 0 lt { neg } if
      beamdiv sign eq not {
        /CurrVecLow load /CurrVecUp load /CurrVecLow ED /CurrVecUp ED
      } if
    } if
  } {
    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
  /PrevVecUp /CurrVecUp load def
  /PrevVecLow /CurrVecLow load def
  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
    /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
    /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
    /PrevVecUp /CurrVecUp load def
    /PrevVecLow /CurrVecLow load 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 {
    currentdict /lastVecTmpUp known currentdict /lastVecTmpLow known and dup {
      /lastVecTmpUp load /lastVecTmpLow load 3 -1 roll
    } if
    CurrLow CurrUp @ABVect % from Low to Up
    PrevVecUp PrevVecLow VecAdd
    2 copy 6 2 roll
    Chirality 0 lt
    3 1 roll 2 copy pop -1e-5 lt
    3 1 roll exch 1e-5 lt exch 0 lt and or xor {
      /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
    not {
      /lastVecTmpUp load /lastVecTmpLow load
    } if
    /prevVecLow ED /prevVecUp ED
  } 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
    /forcebeaminside get {
      3 -1 roll pop true
    } {
      dup /allowbeaminside get 4 -1 roll and
    } ifelse
    /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
/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
      }{
        3 1 roll pop pop
        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
    }{
      3 1 roll pop pop
      RelFiberAngle@tref
    } ifelse
    2 copy exch atan
    5 1 roll DotProd 0 gt { 180 add } if
  } ifelse
  DebugEnd
} bind def
/RelFiberAngle@ref {
  dup (A) NodeName exch (B) NodeName
  @GetCenter 3 -1 roll @GetCenter @ABVect
} bind def
/RelFiberAngle@tref {
  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
/GetIfcOrNodeCoord {
  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