summaryrefslogtreecommitdiff
path: root/Master/texmf-dist/dvips/pst-optexp/pst-optexp.pro
blob: baf32e374730676516490922200925b289e8ea14 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
%%
%% 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: 4.7 (2014/01/12)
%% 
%% Copyright (C) 2007-2014 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 pst-optexp: ) exch strcat ==
} bind def
/CompUnknownWarning {
  (Component ') exch strcat (' unknown) strcat Warning
} bind def
/OneFiberCompWarning {
  (Found only one unsupported component in beam path, drawing no beam) Warning
} bind def
/FiberCompWarning {
  (Found an unsupported component in beam path, stopping beam path) Warning
} 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
  /by exch YG sub def
  /bx exch XG sub def
  /ay YG 3 -1 roll sub def
  /ax XG 3 -1 roll sub def
  ax ay NormalizeVec bx by NormalizeVec VecAdd
  2 copy Pyth abs 1e-4 lt {
    pop pop ax ay -90 matrix rotate dtransform
  } if
  /cy ED /cx ED
  /c ax bx add ay by add Pyth 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
  } if
  cx cy NormalizeVec 2 copy
  XG YG VecAdd /Y@A ED /X@A ED
  XG YG 4 2 roll VecSub /Y@B ED /X@B ED
  true
  ax by mul ay bx mul sub 0 le {
    pop false
    Y@A X@A
    /X@A X@B def
    /Y@A Y@B def
    /X@B exch def
    /Y@B 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
/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 /refltrans 3 def /undefined -1 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 dup /N ED
  1 eq { /draw true def } if
  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 {
      firstPlane name
      name firstPlane GetIfcMode
      connectifc { bgRefIndex }{ name GetRefIndex } ifelse
      CurrTmp CurrVecTmp
      10 dict begin HandleInterface end pop
      ToVec /CurrVecTmp ED ToVec /CurrTmp ED
      [ firstPlane name
      connectifc {
        bgRefIndex
      }{
        name GetRefIndex
      } ifelse
      name firstPlane GetIfcMode
      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
      dup 6 1 roll
      IfcCntTmp IfcCnt eq { true }{ draw } ifelse
      ] cvx
      (C) name 4 -1 roll
      connectifc { bgRefIndex }{ name GetRefIndex } ifelse
      CurrTmp CurrVecTmp
      10 dict begin HandleInterface end pop
      ToVec /CurrVecTmp ED ToVec /CurrTmp ED
      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 ToVec /Vec 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 Vec 4 2 roll NormalVec
      Vec DotProd dup sprod lt 5 2 roll
      GetIfcCenter 3 -1 roll exec GetIfcCenter @ABDist
      centerDist lt and
      centerDist -1 eq { pop dup 0 gt } if
      { /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
  } {
    counttomark 2 ge beamalign relative eq 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
    beampathcount 0 eq {
      cleartomark mark exit
    } if
    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
    CompName cvn load begin
      currentdict /adjustRel known aligntovector and {
        IfcNum IfcName load begin
          currentdict /RX known not {
            2 copy neg exch CM dtransform CompMtrx idtransform
            /DY ED /DX ED
          } if
        end
      } if
    end
    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 beampathskip 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
      beampathcount 1 add PN eq {
        IfcCnt PN sub {pop} repeat
        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
    beampathcount 0 eq {
      cleartomark mark exit
    } if
    dup xcheck not {
      PushAmbCompPlanesOnStack
    } if
    exec
    PN beampathskip 1 add gt and /draw ED
    /Mode ED /n2 ED 2 copy /CompName ED /IfcNum ED
    GetIfcCenter ToVec /CurrPCenter ED
    /oldn1 n1 def
    CompName cvn load /adjustRel known aligntovector and {
      connectifc PrevCorrect PN 2 gt and PN 2 eq or and {
        CurrVecUp CurrVecUp CurrPCenter PrevPCenter PrevMode
        currentdict /relAngleUp known { relAngleUp } { 0 } ifelse
        connectInterfaces pop
        CurrVecLow CurrVecLow CurrPCenter PrevPCenter PrevMode
        currentdict /relAngleLow known { relAngleLow } { 0 } ifelse
        connectInterfaces pop
      } {
        CurrVecUp CurrVecLow
      } ifelse
      VecAdd NormalizeVec
      CompName cvn load begin
        IfcNum IfcName load begin
          currentdict /RX known not {
            CM dtransform CompMtrx idtransform
            /DX ED neg /DY ED
          } {
            pop pop
          } ifelse
        end
      end
    } if
    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
    beampathcount 1 add PN eq or {
      DrawnSegm 0 gt currentdict /fillBeam known and {
        fillBeam newpath
        /DrawnSegm 0 def
      } if
      IfcCnt PN sub {pop} repeat
      ret tir eq {
        (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 {
    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
    /lastVecTmpUp load /lastVecTmpLow load
    /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
} bind def
/compIsKnown {
  dup type /stringtype eq { cvn } if
  tx@OptexpDict exch known
} bind def
/PrearrangePlanes {
  (PrearrangePlanes) DebugBegin
  counttomark dup 2 lt {
    dup 0 eq {
      (Found no component on stack, drawing no beam) PrintWarning
    }{
      exch dup
      compIsKnown {
        dup isFreeray {
          asc exch 3 -1 roll
        }{
          OneFiberCompWarning
          pop
        } ifelse
      }{
        CompUnknownWarning
      } ifelse
    } ifelse
    /N 0 def
  }{
    /N ED
    /CompA ED dup /CompB ED
    CompA compIsKnown CompB compIsKnown and {
      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
      }{
        FiberCompWarning
        counttomark 1 sub { pop } repeat
        /N 0 def
      } ifelse
    }{
      /N 0 def
      CompA compIsKnown not {CompA}{CompB} ifelse
      CompUnknownWarning
    } ifelse
  } ifelse
  2 1 N {
    /i ED exch /CompB ED
    CompB compIsKnown not {
      counttomark i 1 sub 2 mul 1 add sub { pop } repeat
      CompB CompUnknownWarning
      exit
    } if
    CompB isFreeray not {
      counttomark i 1 sub 2 mul 1 add sub { pop } repeat
      FiberCompWarning
      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
    } {
      i 2 eq {
        CompB amb CompA desc AdjustRelRot
      } if
      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 aligntovector not and {
    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 {
            5 -2 roll
            pop pop
            2 copy 5 2 roll
          } {
            startinsidecount 0 gt N startinsidecount sub 1 gt and {
              3 -1 roll dup 4 1 roll
              N 1 sub startinsidecount sub mul
              6 -2 roll pop add dup 5 2 roll
            } if
          } ifelse
        } if
        last stopinsidecount 0 gt N stopinsidecount sub 1 gt and and {
          % 1 1 1 N N
          3 -1 roll dup 4 1 roll stopinsidecount mul
          6 -1 roll dup 7 1 roll add 3 1 roll pop pop dup
        } 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
  counttomark 1 eq { pop } if
} bind def
/IfcName {
  dup dup 1 eq not exch N eq and {
    pop (N)
  } {
    inttostr
  } ifelse
  (P@) exch strcat cvn
} bind def
/GetIfcMode {
  exch cvn load begin
    IfcName load /mode get
  end
} 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
/VecSub {
    neg 3 -1 roll add 3 1 roll neg 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 {
  3 -1 roll exch sub 3 1 roll sub exch
} bind def
/@ABDist {
  3 -1 roll sub dup mul 3 1 roll sub dup mul add sqrt
} 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
    mode refltrans eq {
      neg exch NormalVec ReflectVec ok
    } {
      NormalVec
      mode trans eq {
        n1 n2 RefractVec
        2 copy 0 eq exch 0 eq and { tir } { ok } ifelse
      } {
        ReflectVec ok
      } ifelse
    } 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
/RelConnAngle {
  (RelConnAngle) 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 {
        RelConnAngle@center
      }{
        3 1 roll pop pop
        RelConnAngle@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 {
      RelConnAngle@center
    }{
      3 1 roll pop pop
      RelConnAngle@tref
    } ifelse
    2 copy exch atan
    5 1 roll DotProd 0 gt { 180 add } if
  } ifelse
  DebugEnd
} bind def
/RelConnAngle@ref {
  dup (A) NodeName exch (B) NodeName
  @GetCenter 3 -1 roll @GetCenter @ABVect
} bind def
/RelConnAngle@tref {
  dup (TrefA) NodeName exch (TrefB) NodeName
  @GetCenter 3 -1 roll @GetCenter @ABVect
} bind def
/RelConnAngle@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 mymax -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 mymax 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
/ClipFadeValue {
  dup 0 lt { pop 0 }{ dup 1 gt { pop 1 } if } ifelse
} bind def
/fadeto@white {
  FadeFunc ClipFadeValue @S mul @H exch @B sethsbcolor
} bind def
/fadeto@black {
  FadeFunc ClipFadeValue @B mul @H exch @S exch sethsbcolor
} bind def
/fadeto@transparency {
  FadeFunc ClipFadeValue @T mul .setopacityalpha
} bind def
/fadefunc@linear {
  neg 1 add
} bind def
/fadefunc@squared {
  dup mul neg 1 add
} bind def
/fadefunc@gauss {
  0.4 div dup mul neg Euler exch exp
} bind def
/fadefunc@exp {
  -6 mul Euler exch exp
} bind def
/FadeStroke {
  /FadeFunc ED /FadeToColor ED /@T ED
  PathLength dup /@L ED exch div /@dl ED
  mark
  { false counttomark 3 roll }
  { true counttomark 3 roll }
  {} {} pathforall
  currenthsbcolor /@B ED /@S ED /@H ED
  newpath /currL 0 def
  counttomark 3 idiv 1 1 3 -1 roll {
    pop
    { % lineto
      /y2 ED /x2 ED  x2 x1 sub y2 y1 sub 2 copy
      dup mul exch dup mul add sqrt dup  @L div exch
      @dl div 1 add floor dup dup
      4 2 roll div 5 1 roll
      1 1 3 -1 roll {
        5 copy 4 copy 2 copy eq not { fadecorrect add } if exch div VecScale
        6 2 roll 1 sub dup 0 eq not { fadecorrect sub } if exch div VecScale
        x1 y1 VecAdd moveto x1 y1 VecAdd lineto
        mul currL add FadeToColor
        stroke
      } for
      4 1 roll pop pop mul currL add /currL ED
      /y1 y2 def /x1 x2 def
    } { % moveto
      /y1 ED /x1 ED
    } ifelse
  } for
  pop
} def
/mymax {
  2 copy lt { exch } if pop
} 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