%% psMath.pro (c) Aug 28, 1996 Matthias T. Kromann %% version 0.02 2009/11/08 changes to knot subroutines %% (hv) /tx@KnotDict 11 dict def tx@KnotDict begin /PSMsysd 200 dict def /PSMusrd 200 dict def /PSMtexd 200 dict def /PSMinit { PSMtexd begin PSMsysd begin PSMusrd begin line-std Times setfontfamily 10 setfontsize 0 setfontstyle setupfont -1 0 TeXsetfill } def /PSMclose { end end end } def /PSMreload { PSMclose (psm.pro) run PSMinit } def /PSMni { (not implemented) = } def % ----------------------------------------------------------------- PSMsysd begin /bdef {bind def} bind def /xdef {exch def} bdef /lidef { 0 begin /ini xdef /vars xdef cvlit dup /value xdef length 3 add array /obj xdef /obj load 0 vars dict begin ini currentdict end put /obj load 1 {begin} putinterval /obj load 2 /value load putinterval /obj load dup length 1 sub {end} putinterval /obj load cvx end def } def /lidef load 0 4 dict put /ldef { {} lidef } def /pt {1 mul} def /mm {2.845 mul} def /cm {28.45 mul} def /inch {72.27 mul} def /un {1 mm mul} def /black { 0 setgray } def /white { 1 setgray } def /gray { 0.5 setgray } def /darkgray { 0.25 setgray } def /lightgray { 0.75 setgray } def /red { 1 0 0 setrgbcolor } def /green { 0 1 0 setrgbcolor } def /blue { 0 0 1 setrgbcolor } def /cyan { 0 1 1 setrgbcolor } def /magenta { 1 0 1 setrgbcolor } def /yellow { 1 1 0 setrgbcolor } def /gold { 0.93 0.93 0.4 setrgbcolor } def /thin { 0.5 setlinewidth } def /medium { 1 setlinewidth } def /thick { 2 setlinewidth } def /lw-std { thin } def /lw-dec { currentlinewidth 2 div setlinewidth } def /lw-inc { currentlinewidth 2 mul setlinewidth } def /nodash { [] 0 setdash } def /dash { [2 2] 0 setdash } def /line-std { lw-std nodash 0 setgray } def % ----------------------------------------------------------------- PSMtexd begin /ISOfont { % font ISOfont /isofont xdef /font xdef font findfont dup length dict begin { 1 index /FID ne {def} {pop pop} ifelse } forall /Encoding ISOLatin1Encoding def currentdict end isofont exch definefont pop } 2 ldef /Times-Roman /Times-Roman-ISOLatin1 ISOfont /Times-Bold /Times-Bold-ISOLatin1 ISOfont /Times-Italic /Times-Italic-ISOLatin1 ISOfont /Times-BoldItalic /Times-BoldItalic-ISOLatin1 ISOfont /Times [(ptm) /Times-Roman-ISOLatin1 /Times-Bold-ISOLatin1 /Times-Italic-ISOLatin1 /Times-BoldItalic-ISOLatin1] def /Helvetica /Helvetica-ISOLatin1 ISOfont /Helvetica-Bold /Helvetica-Bold-ISOLatin1 ISOfont /Helvetica-Oblique /Helvetica-Oblique-ISOLatin1 ISOfont /Helvetica-BoldOblique /Helvetica-BoldOblique-ISOLatin1 ISOfont /Helvetica [(phv) /Helvetica-ISOLatin1 /Helvetica-Bold-ISOLatin1 /Helvetica-Oblique-ISOLatin1 /Helvetica-BoldOblique-ISOLatin1] def /Symbol [(psy) /Symbol /Symbol /Symbol /Symbol] def /getfontfamily {PSMtexd /fontfamily get} def /setfontfamily {PSMtexd /fontfamily 3 -1 roll put} def /getfontsize {PSMtexd /fontsize get} def /setfontsize {PSMtexd /fontsize 3 -1 roll put} def /getfontstyle {PSMtexd /fontstyle get} def /setfontstyle {PSMtexd /fontstyle 3 -1 roll put} def /setupfont { font 0 getfontfamily 0 get putinterval font 3 getfontstyle 1 add 1000 mul fontsize cvi add fontext cvs putinterval PSMtexd font cvn known not { PSMtexd font cvn getfontfamily getfontstyle 1 add get findfont getfontsize scalefont put } if font cvn cvx exec setfont } 2 { /font 7 string def /fontext 4 string def } lidef end % ----------------------------------------------------------------- /pi 3.1415926535 def /sqr {dup mul} def /sgn {dup 0 gt {pop 1} {0 lt {-1} {0} ifelse} ifelse} def /min { /B xdef /A xdef A type /arraytype eq {/a A 0 get def} {/a A def} ifelse B type /arraytype eq {/b B 0 get def} {/b B def} ifelse a b gt {B} {A} ifelse } 4 ldef /max { /B xdef /A xdef A type /arraytype eq {/a A 0 get def} {/a A def} ifelse B type /arraytype eq {/b B 0 get def} {/b B def} ifelse a b gt {A} {B} ifelse } 4 ldef /acos {dup sqr 1 exch sub sqrt exch atan} def /asin {dup sqr 1 exch sub sqrt atan} def /extrema { /fct xdef /t2 xdef /t1 xdef /t t1 def /ft t1 fct def 1/T t1 def /fT t1 fct def t1 t2 t1 sub 200 div t2 { /x xdef /fx x fct def fx ft lt {/t x def /ft fx def} if fx fT gt {/T x def /fT fx def} if } for t T } 9 ldef /p2r* { /v xdef aload pop /phi xdef /r xdef phi cos r mul phi sin r mul v astore } 3 ldef /p2r {2 array p2r*} def /r2p* { /v xdef aload pop /y xdef /x xdef x x mul y y mul add sqrt y x atan v astore } 3 ldef /r2p {2 array r2p*} def /rotpnt* { /v xdef /angle xdef aload pop /y xdef /x xdef angle cos x mul angle sin y mul sub angle sin x mul angle cos y mul add v astore } 4 ldef /rotpnt {2 array rotpnt*} def /p2l* { /v xdef aload pop /qy xdef /qx xdef aload pop /py xdef /px xdef /a py qy sub def /b qx px sub def a b a qx mul b qy mul add v astore } 7 ldef /p2l {3 array p2l*} def /l2p* { /v xdef aload pop /c2 xdef /b2 xdef /a2 xdef aload pop /c1 xdef /b1 xdef /a1 xdef /det a1 b2 mul a2 b1 mul sub def c1 b2 mul c2 b1 mul sub det div a1 c2 mul a2 c1 mul sub det div v astore } 8 ldef /l2p {2 array l2p*} def /altitude* { /r xdef /C xdef /B xdef /A xdef A B l p2l* pop A B v vsub* 90 v rotpnt* C v vadd* C m p2l* pop l m r l2p* } 7 {/v 2 array def /l 3 array def /m 3 array def} lidef /altitude {2 array altitude*} def /angle { pnt2num /qy exch def /qx exch def pnt2num /py exch def /px exch def qy py sub qx px sub 2 copy abs exch abs add 0 eq {pop pop -360} {atan} ifelse } 4 ldef /vaddsub* { /addsub xdef /uv xdef /v xdef /u xdef /i 0 def u {v i get addsub /i i 1 add def} forall uv astore } 5 ldef /vadd* {{add} vaddsub*} def /vadd {dup length array {add} vaddsub*} def /vsub* {{sub} vaddsub*} def /vsub {dup length array {sub} vaddsub*} def /smuldiv* { /muldiv xdef /As xdef /A xdef /s xdef A {s muldiv} forall As astore } 4 ldef /smul* { 3 1 roll dup type /arraytype eq not {exch} if 3 -1 roll {mul} smuldiv*} def /smul { dup type /arraytype eq not {exch} if dup length array {mul} smuldiv*} def /sdiv* { 3 1 roll dup type /arraytype eq not {exch} if 3 -1 roll {div} smuldiv*} def /sdiv { dup type /arraytype eq not {exch} if dup length array {div} smuldiv*} def /norm {0 exch {dup mul add} forall sqrt} def /ip { /B xdef /A xdef /i 0 def 0 A {B i get mul add /i i 1 add def} forall } 3 ldef /v2u* {exch dup norm 3 -1 roll sdiv*} def /v2u {dup norm sdiv} def /dist { /B xdef /A xdef /i 0 def 0 A {B i get sub dup mul add /i i 1 add def} forall sqrt } 3 ldef /cp* { /AxB xdef aload pop /b3 xdef /b2 xdef /b1 xdef aload pop /a3 xdef /a2 xdef /a1 xdef a2 b3 mul a3 b2 mul sub a3 b1 mul a1 b3 mul sub a1 b2 mul a2 b1 mul sub AxB astore } 7 ldef /cp {3 array cp*} def /tvec* { /C xdef /B xdef /A xdef /t xdef /i 0 def A { dup B i get exch sub t mul add /i i 1 add def } forall C astore } 5 ldef /tvec {dup length array tvec*} def /nullmatrix {/n xdef /m xdef n {m array} repeat n array astore } 2 ldef /mget {exch 3 1 roll get exch get} bdef /mput {4 1 roll exch 4 1 roll get 3 1 roll put} bdef /mstore { /M xdef /i M length 1 sub def M length {M i get astore pop /i i 1 sub def} repeat } 2 ldef /madd* { /AB xdef /B xdef /A xdef 0 1 A length 1 sub {/i xdef A i get B i get AB i get vadd* pop} for AB } 4 ldef /madd { /B xdef /A xdef A B A 0 get length B length nullmatrix madd* } 2 ldef /msub* { /AB xdef /B xdef /A xdef 0 1 A length 1 sub {/i xdef A i get B i get AB i get vsub* pop} for AB } 4 ldef /msub { /B xdef /A xdef A B A 0 get length B length nullmatrix msub* } 2 ldef /msmul* { /Ms xdef dup type /arraytype eq {exch} if /s xdef /M xdef /i 0 def M {s Ms i get smul* pop /i i 1 add def} forall Ms } 5 ldef /msmul { dup type /arraytype eq not {exch} if /M xdef M M 0 get length M length nullmatrix msmul* } 1 ldef /msdiv* { /Ms xdef dup type /arraytype eq {exch} if /s xdef /M xdef /i 0 def M {s Ms i get sdiv* pop /i i 1 add def} forall Ms } 5 ldef /msdiv { dup type /arraytype eq not {exch} if /M xdef M M 0 get length M length nullmatrix msdiv* } 1 ldef /mmul* { /AB xdef /B xdef /A xdef /m A 0 get length def /n A length def /r B length def 0 1 r 1 sub { /j xdef 0 1 m 1 sub { /i xdef 0 0 1 n 1 sub { /k xdef A i k mget B k j mget mul add} for } for } for AB mstore AB } 9 ldef /mmul { /B xdef /A xdef A B A 0 get length B length nullmatrix mmul* } 2 ldef /mvmul* { /Mv xdef /v xdef /M xdef /m M 0 get length def /n M length def 0 1 m 1 sub { /i xdef 0 0 1 n 1 sub { /j xdef M i j mget v j get mul add } for } for Mv astore } 7 ldef /mvmul {exch dup 0 get length array exch 3 1 roll mvmul*} def /minv {PSMni} def /minvmul {PSMni} def /mtrace { /M xdef /i 0 def 0 M {i get add /i i 1 add def} forall } 2 ldef /mtrans* { /TM xdef /M xdef /m M 0 get length def /n M length def 0 1 m 1 sub { /i xdef 0 1 n 1 sub {M i 3 -1 roll mget} for } for TM mstore TM } 5 ldef /mtrans {/M xdef M M length M 0 get length nullmatrix mtrans*} 1 ldef /m2v {/M xdef [M {aload pop} forall]} 1 ldef /v2mc {1 array astore} def /v2mr { dup length /n xdef {1 array astore} forall n array astore } 1 ldef /dot-size 1.5 def /pnt2numx { /n xdef n 1 sub index type exec } 5 { /integertype {} def /realtype {} def /arraytype { n -1 roll dup 0 get type /arraytype eq { 0 get aload pop} { dup length 2 eq { aload pop} { p 3D* aload pop} ifelse } ifelse n 1 add 2 roll } def /p 2 array def } lidef /pnt2num {1 pnt2numx} def /pnt2vctx* { /p xdef /n xdef n 1 sub index type exec } 5 { /integertype {n 1 add -2 roll p astore n 1 roll} def /realtype {integertype} def /arraytype { n -1 roll dup 0 get type /arraytype eq { 0 get } { dup length 2 eq {} {p 3D*} ifelse } ifelse aload pop p astore n 1 roll } def } lidef /pnt2vctx {2 array pnt2vctx*} def /pnt2vct* {1 exch pnt2vctx*} def /pnt2vct {1 pnt2vctx} def /-moveto /moveto load def /-rmoveto /rmoveto load def /-lineto /lineto load def /-rlineto /rlineto load def /-arc /arc load def /-arcn /arcn load def /-arcto /arcto load def /-curveto /curveto load def /-rcurveto /rcurveto load def /Moveto {aload pop -moveto} def /rMoveto {aload pop -rmoveto} def /Lineto {aload pop -lineto} def /rLineto {aload pop -rlineto} def /moveto {pnt2num -moveto} def /rmoveto {pnt2num -rmoveto} bdef /lineto {pnt2num -lineto} bdef /rlineto {pnt2num -rlineto} bdef /line {pnt2num 3 pnt2numx 4 2 roll -moveto -lineto} def /lines {dup 0 get moveto {lineto} forall} def /xline { /dB xdef /dA xdef B pnt2vct* pop A pnt2vct* pop B A BA vsub* BA v2u* dA neg A' smul* A A' vadd* Moveto BA dB B' smul* B B' vadd* Lineto } 9 { /A 2 array def /B 2 array def /BA 2 array def /A' 2 array def /B' 2 array def } lidef /arc {4 pnt2numx -arc} def /arcn {4 pnt2numx -arcn} def /curve { 1 pnt2numx 3 pnt2numx 5 pnt2numx 7 pnt2numx 8 -2 roll -moveto -curveto} def /curveto {1 pnt2numx 3 pnt2numx 5 pnt2numx -curveto} def /dotx {newpath pnt2num dot-size 0 360 -arc} def /dot-bullet {gsave dotx fill grestore} def /dot-circ {gsave dotx stroke grestore} def /dot {dot-bullet} def /perpsign { /rsize xdef /B xdef /A xdef B A v vsub* v v2u* rsize v smul* pop v 90 h rotpnt* rsize sgn h smul* pop A Moveto h rlineto v rlineto h -1 smul rlineto closepath B lineto } 5 {/v 2 array def /h 2 array def} lidef /turtle-init {PSMsysd /turtle-angle 3 -1 roll put Moveto pendown} def /pendown {PSMsysd /turtle-state {rlineto} put} def /penup {PSMsysd /turtle-state {rmoveto} put} def /fwd { dup PSMsysd /turtle-angle get dup 3 1 roll cos mul 3 1 roll sin mul PSMsysd /turtle-state get exec } def /bwd {neg fwd} def /lht { PSMsysd /turtle-angle get add PSMsysd /turtle-angle 3 -1 roll put } def /rht {neg lht} def /box { pnt2num /by xdef /bx xdef pnt2num /ay xdef /ax xdef ax ay -moveto ax by -lineto bx by -lineto bx ay -lineto closepath } 4 ldef /circle {newpath 2 pnt2numx 0 360 -arc closepath} def /ellipsearc { newpath /a2 xdef /a1 xdef /yr xdef /xr xdef pnt2num /oy xdef /ox xdef /mtrx matrix currentmatrix def ox oy translate xr yr scale 0 0 1 a1 a2 -arc mtrx setmatrix } 7 ldef /ellipse {0 360 ellipsearc closepath} def /arrow {currentlinewidth 3.5 mm 40 0.7 arrowx} def /varrow {currentlinewidth 2.5 mm 40 1 arrowx} def /arcarrow {currentlinewidth 3.5 mm 45 0.7 arcarrowx} def /varcarrow {currentlinewidth 2.5 mm 40 1 arcarrowx} def /sarcarrow {currentlinewidth 2 mm 45 0.7 arcarrowx} def /arrowx { /rhead xdef 2 div /a xdef /hlen xdef 2 div /lw xdef head pnt2vct* pop tail pnt2vct* pop head tail vsub r2p aload pop /dir xdef /shaftl exch hlen rhead mul sub def /wingsz hlen a cos div def /lwing [wingsz dir 180 sub a sub] p2r head vadd def /rwing [wingsz dir 180 sub a add] p2r head vadd def /ltail [lw dir 90 add] p2r tail vadd def /rtail [lw dir 90 sub] p2r tail vadd def /lshaft [shaftl dir] p2r ltail vadd def /rshaft [shaftl dir] p2r rtail vadd def head Moveto lwing Lineto lshaft Lineto ltail Lineto rtail Lineto rshaft Lineto rwing Lineto closepath } 16 {/head 2 array def /tail 2 array def} lidef /arcarrowx { /rhead xdef 2 div /a xdef /hlen xdef 2 div /lw xdef /ha xdef /ta xdef /r xdef O pnt2vct* pop ta ha gt /clockw xdef clockw {/hlen hlen neg def /lw lw neg def} if /head [r ha] p2r O vadd def /rheada 1 rhead add 0.5 mul def /ang 90 hlen rheada mul r div 28.6479 mul add def /wingsz hlen a cos div def /iwing [wingsz ha ang sub a sub] p2r head vadd def /owing [wingsz ha ang sub a add] p2r head vadd def /shafta ha hlen rhead mul r div 57.29578 mul sub def head Moveto iwing Lineto O aload pop r lw sub shafta ta clockw {-arc} {-arcn} ifelse O aload pop r lw add ta shafta clockw {-arcn} {-arc} ifelse owing Lineto closepath } 16 {/O 2 array def} lidef /bboxray2p { /phi xdef /P xdef aload pop /ury xdef /urx xdef /lly xdef /llx xdef /ray P [1 phi] p2r vadd P p2l def /P' P def phi cos 0.05 gt {/P' ray [1 0 urx] l2p def} if phi cos -0.05 lt {/P' ray [1 0 llx] l2p def} if phi sin 0.05 gt {/P' P' ray [0 1 ury] l2p P closestne def} if phi sin -0.05 lt {/P' P' ray [0 1 lly] l2p P closestne def} if P' } 9 ldef /closestne { /P xdef /P2 xdef /P1 xdef /d1 P1 P dist def /d2 P2 P dist def d1 0 eq { P2 } { d2 0 eq {P1} {d1 d2 lt {P1} {P2} ifelse} ifelse } ifelse } 5 ldef /cdbbox { /cd xdef /pnt cd 0 get def /lbl cd 1 get def /bbox [lbl TeXbbox] def /dy 3 def /dhx 5 def /dhy 3 def /x pnt 0 get bbox 0 get bbox 2 get add 2 div sub def /y pnt 1 get dy sub def /bbox bbox [x dhx sub y dhy sub x dhx add y dhy add] vadd def bbox [x y] } 9 ldef /cdarrowpts { /cd2 xdef /cd1 xdef /pnt1 cd1 0 get def /lbl1 cd1 1 get def /pnt2 cd2 0 get def /lbl2 cd2 1 get def /bbox1 cd1 cdbbox pop def /bbox2 cd2 cdbbox pop def /angle pnt2 pnt1 vsub r2p 1 get def /tail bbox1 pnt1 angle bboxray2p def /head bbox2 pnt2 angle 180 add bboxray2p def tail head PSMsysd begin /cdarrowhead xdef /cdarrowtail xdef end tail head } 11 ldef /cdarrow-lw 0.3 def /cdarrow {cdarrowpts cdarrow-std} def /cdarrow-std { /head xdef /tail xdef /u head tail vsub v2u 2.5 smul def /up u 90 rotpnt def gsave newpath cdarrow-lw setlinewidth tail head u cdarrow-lw smul 0.5 smul vsub line stroke nodash [head u vsub up vadd head head u vsub up vsub] lines stroke grestore head moveto } 4 ldef /cdarrow-eq { cdarrowpts /head xdef /tail xdef /orth head tail vsub 90 rotpnt v2u def tail orth vadd head orth vadd line stroke tail orth vsub head orth vsub line stroke head Moveto head Moveto } 2 ldef /cdarrow-surj { cdarrowpts /head xdef /tail xdef gsave newpath cdarrow-lw setlinewidth tail head cdarrow-std stroke tail tail head dist dup 1.5 sub exch div tail head tvec cdarrow-std stroke grestore head Moveto } 2 ldef /cdarrow-incl { cdarrowpts /head xdef /tail xdef /u head tail vsub v2u 2 smul def /up u 90 rotpnt def gsave newpath cdarrow-lw setlinewidth tail u vadd up vadd tail up vadd tail tail u vadd curve tail u vadd head cdarrow-std stroke grestore head Moveto } 4 ldef /cdarrow-line { cdarrowpts dup 3 1 roll gsave newpath line stroke grestore Moveto } def /cdarrow-down {cdarrow-up} def /cdarrow-up { cdarrowpts /head xdef /tail xdef /u head tail vsub v2u def /v [u aload pop exch neg] def tail v 2 smul vadd head v 2 smul vadd cdarrow-std } 4 ldef /cdentry {2 array astore dup cdlbl} def /cdlbl { /cd xdef /lbl cd 1 get def cd cdbbox Moveto pop lbl TeX } 3 ldef /cdarrowlbl { /ypos xdef /xpos xdef /lbl xdef lbl 0.5 cdarrowtail cdarrowhead tvec xpos ypos label } 3 ldef /cdpnt { dup type dup /integertype eq exch /realtype eq or not {0.5} if cdarrowtail cdarrowhead tvec } def /cdlist % ListOfWords cdentry dx dy => ListOfCDentry { 0 begin /dy xdef /dx xdef 0 get [0 dy neg] vadd /P xdef /L xdef /n L length def /N n array def /width 0 L {stringwidth pop add} forall n 1 sub dx mul add def /x width 2 div neg def 0 1 n 1 sub { /i xdef /w L i get stringwidth pop def N i [P [w 2 div x add 0] vadd L i get] put /x x w add dx add def } for N end { dup 1 get cvn exch dup cdlbl def } forall } def /cdlist load 0 12 dict put /cdsuper % [cdpnt1 cdpnt2 ... cdpntn] => pnt { /list xdef % Find initial xmin, xmax, ymin /pnt list 0 get 0 get def /xmin pnt 0 get def /xmax pnt 0 get def /ymax pnt 1 get def % Find xmin, xmax, ymin list { 0 get /pnt xdef /x pnt 0 get def /y pnt 1 get def x xmin lt {/xmin x def} if x xmax gt {/xmax x def} if y ymax gt {/ymax y def} if } forall % Return super point [xmin xmax add 2 div ymax vspace add] } 8 ldef /3Dinit { PSMsysd begin /3Ddist xdef /3Dcenter xdef /3Dfocal xdef /3Dnormal 3Dfocal 3Dcenter vsub v2u def /3Dorigo 3Ddist 3Dnormal smul 3Dcenter vadd def /3Dex 3Dnormal [0 0 1] cp def 3Dex norm 1e-8 lt {/3Dex [1 0 0] def} {/3Dex 3Dex v2u def} ifelse /3Dey 3Dex 3Dnormal cp def /3Dmatrix [3Dex 3Dey 3Dnormal] mtrans def end } def /3D* { /p' xdef /p xdef PSMsysd begin p 3Dcenter p" vsub* dup 3Dnormal ip p" sdiv* 3Dnormal p" vsub* 3Ddist p" smul* 3Dmatrix exch p" mvmul* aload pop pop p' astore end } 3 {/p" 3 array def} lidef /3D {2 array 3D*} def /P2L* { /line xdef /p' xdef /p xdef p' p p" vsub* aload pop p aload pop line astore } 4 {/p" 3 array def} lidef /P2L {6 array P2L*} def /LP2P* { /p xdef aload pop /d xdef n astore pop aload pop p0 astore pop r astore pop /s d n p0 ip sub n r ip div def r s r smul* p0 p vadd* } 6 {/n 3 array def /r 3 array def /p0 3 array def} lidef /LP2P {3 array LP2P*} def /PL2P* { /pi xdef aload pop p0 astore pop r astore pop /p xdef r p p0 n vsub* n cp* aload pop n p0 ip pi astore } 6 {/n 3 array def /r 3 array def /p0 3 array def} lidef /PL2P {4 array PL2P*} def /s2r* { /p xdef aload pop /theta xdef /phi xdef /r xdef r theta sin mul phi cos mul r theta sin mul phi sin mul r theta cos mul p astore } 4 ldef /s2r {3 array s2r*} def /r2s* { /p xdef aload pop /z xdef /y xdef /x xdef x sqr y sqr add z sqr add sqrt y x atan dup y exch sin z mul atan p astore } 4 ldef /r2s {3 array r2s*} def /3Dpoints2gcircle* { /C xdef /ey xdef /ex xdef /ex' C 0 get def /ey' C 1 get def /ez' C 2 get def ex ey ez cp* ez v2u* pop ez ex ey' cp* pop ex aload pop ex' astore pop ez aload pop ez' astore pop C } 7 {/ez 3 array def} lidef /3Dpoints2gcircle {3 3 nullmatrix 3Dpoints2gcircle*} def /3Dgcircle-t2p* { /p xdef /t xdef t cos t sin 0 p' astore p mvmul* } 3 {/p' 3 array def} lidef /3Dgcircle-t2p {3 array 3Dgcircle-t2p*} def /3Dgcircle-p2t { exch M mtrans* exch v mvmul* aload pop pop exch atan } 2 {/M 3 3 nullmatrix def /v 3 array def} lidef /3Dgcircle-draw { /tmax xdef /tmin xdef /M xdef M tmin v 3Dgcircle-t2p* moveto tmin tmax { M exch v 3Dgcircle-t2p*} plot } 5 {/v 3 array def} lidef PSMtexd begin /TeX-mm false def /TeX-script 0.65 def /TeX-lower 0.2 def /TeX-raise 0.25 def /TeXshow {show} def /TeX-tok { /s xdef s length 0 eq { () () } { /s0 s 0 get def 47 s0 eq 123 s0 eq or { s0 47 eq { /n 1 def s { /sn xdef sn 64 gt sn 91 lt and sn 96 gt sn 123 lt and or {/n n 1 add def} {n 1 ne {exit} if} ifelse } forall s n s length n sub getinterval /S xdef S length 0 eq not { S 0 get 32 eq {/S S 1 S length 1 sub getinterval def} if } if S s 0 n getinterval } if s0 123 eq { /n 0 def /bl 0 def s { dup 123 eq {/bl bl 1 add def} if 125 eq {/bl bl 1 sub def} if /n n 1 add def bl 0 eq {exit} if } forall s n s length n sub getinterval s 1 n 2 sub getinterval } if } { s 1 s length 1 sub getinterval s 0 1 getinterval } ifelse } ifelse } 5 ldef /PSMtexld 3 dict def PSMtexld begin /TeXnest 0 def end /TeX { /TeXnest where {pop} {PSMtexld begin} ifelse /TeXnest TeXnest 1 add def TeX-tok /tok xdef /tail xdef tok length dup 0 eq exch 1 gt or { tok length 0 eq { tail length 0 eq not {{tail TeX}} {{}} ifelse} { tok 0 get 47 eq {{tail tok 1 tok length 1 sub getinterval cvn cvx PSMtexd exch get exec TeX}} {{tail tok TeX TeX}} ifelse } ifelse } { % Both text and math mode ($) tok eq {{tail PSMtexd begin /TeX-mm TeX-mm not def getfontstyle 2 xor setfontstyle setupfont end TeX}} if (_) tok eq {{tail subscript TeX}} if (^) tok eq {{tail supscript TeX}} if % Math mode only TeX-mm { ( ) tok eq {{tail TeX}} if (=) tok eq {{tail spc tok romanshow spc TeX}} if (+) tok eq {{tail spc tok romanshow spc TeX}} if (-) tok eq {{tail spc (\261) romanshow spc TeX}} if (()0123456789[]:) tok search {pop pop pop {tok romanshow tail TeX}} {pop} ifelse (_^$ =+-()0123456789[]:) tok search {pop pop pop} {pop {tail tok TeXshow TeX}} ifelse } { (_$^) tok search {pop pop pop} {pop {tail tok TeXshow TeX}} ifelse } ifelse } ifelse bind exec /TeXnest TeXnest 1 sub def TeXnest 0 eq {end} if } def /romanshow { getfontstyle 0 setfontstyle setupfont exch TeXshow setfontstyle setupfont } def /subsup {gsave 0 -1 rmoveto subscript grestore supscript} def /lit {TeX-tok show} def /subscript { 0 getfontsize PSMtexd /TeX-lower get mul neg rmoveto script 0 getfontsize PSMtexd /TeX-lower get mul rmoveto } def /supscript { 0 getfontsize PSMtexd /TeX-raise get mul rmoveto script 0 getfontsize PSMtexd /TeX-raise get mul neg rmoveto } def /script { getfontsize PSMtexd /TeX-script get mul setfontsize setupfont TeX-tok TeX getfontsize TeX-script div setfontsize setupfont } def /overline { TeX-tok dup TeXbbox /ury xdef /urx xdef pop /llx xdef gsave llx ury 1 add rmoveto urx llx sub 0 rlineto 0.5 setlinewidth stroke grestore TeX } 3 ldef /spc {getfontsize 0.2 mul 0 rmoveto} bdef /nspc {getfontsize -0.2 mul 0 rmoveto} bdef /phantom {TeX-tok gsave TeX grestore} def /roman { TeX-tok {TeX 1 setfontstyle setupfont} dup 1 PSMtexd /fontstyle get put 0 setfontstyle setupfont exec } def /bold { TeX-tok {TeX 1 setfontstyle setupfont} dup 1 PSMtexd /fontstyle get put getfontstyle 1 or setfontstyle setupfont exec } def /italic { TeX-tok {TeX 1 setfontstyle setupfont} dup 1 PSMtexd /fontstyle get put getfontstyle 2 or setfontstyle setupfont exec } def /symbol { TeX-tok {TeX 1 setfontfamily getfontsize 0.825 div setfontsize setupfont} dup 1 PSMtexd /fontfamily get put Symbol setfontfamily getfontsize 0.825 mul setfontsize setupfont exec } def /symbol-show { TeX-tok {show 1 setfontfamily getfontsize 0.825 div setfontsize setupfont} dup 1 PSMtexd /fontfamily get put Symbol setfontfamily getfontsize 0.825 mul setfontsize setupfont exec } def /xlabel { /vpos xdef /hpos xdef /dy xdef /dx xdef pnt2vct /pnt xdef /lbl xdef lbl () ne { lbl TeXbbox /ury xdef /urx xdef /lly xdef /llx xdef pnt Moveto dx dy rmoveto hpos 0 eq not {llx neg 0 rmoveto hpos 1 sub urx llx sub 2 div mul neg 0 rmoveto} if vpos 0 eq not {0 lly neg rmoveto 0 vpos 1 sub ury lly sub 2 div mul neg rmoveto} if fill? { gsave currentpoint newpath moveto llx filldist sub lly filldist sub rmoveto urx llx sub filldist 2 mul add 0 rlineto 0 ury lly sub filldist 2 mul add rlineto llx urx sub filldist 2 mul sub 0 rlineto closepath fillcol setgray fill grestore } if lbl TeX } if } 13 {/fill? false def /fillcol 1 def /filldist 3 def} lidef /label { /vpos xdef /hpos xdef /dx [1 1 0 -1] hpos get def /dy [1 1 0 -1] vpos get def /dabs dx abs dy abs add sqrt def dabs 0 eq not {/dabs 4 dabs div def} if dx dabs mul dy dabs mul hpos vpos xlabel } 5 ldef /TeXsetfill { /xlabel load 0 get begin /filldist xdef dup 0 lt {pop /fill? false def} {/fillcol xdef /fill? true def} ifelse end } def /TeXbbox { TeXbbdict begin /llx 1e30 def /lly 1e30 def /urx -1e30 def /ury -1e30 def gsave newpath 0 0 moveto TeX grestore llx lly itransform urx ury itransform /ury xdef /urx xdef /lly xdef /llx xdef llx urx gt {llx urx /llx xdef /urx xdef} if lly ury gt {lly ury /lly xdef /ury xdef} if llx lly urx ury end } def /TeXbbdict 14 dict def TeXbbdict begin /show {false charpath currentpoint maxbbox moveto} def /stroke {maxbbox} def /fill {maxbbox} def /maxbbox { gsave TeXbbdict begin flattenpath pathbbox transform /ury' xdef /urx' xdef transform /lly' xdef /llx' xdef /llx llx' urx' min llx min def /lly lly' ury' min lly min def /urx urx' llx' max urx max def /ury ury' lly' max ury max def end grestore newpath } def end /alpha {(a) symbol pop} def /Alpha {(A) symbol pop} def /beta {(b) symbol pop} def /Beta {(B) symbol pop} def /chi {(c) symbol pop} def /Chi {(C) symbol pop} def /delta {(d) symbol pop} def /Delta {(D) symbol pop} def /epsilon{(e) symbol pop} def /Epsilon{(E) symbol pop} def /phi {(f) symbol pop} def /Phi {(F) symbol pop} def /gamma {(g) symbol pop} def /Gamma {(G) symbol pop} def /eta {(h) symbol pop} def /Eta {(H) symbol pop} def /iota {(i) symbol pop} def /Iota {(I) symbol pop} def /phi1 {(j) symbol pop} def /theta1 {(J) symbol pop} def /kappa {(k) symbol pop} def /Kappa {(K) symbol pop} def /lambda {(l) symbol pop} def /Lambda {(L) symbol pop} def /mu {(m) symbol pop} def /Mu {(M) symbol pop} def /nu {(n) symbol pop} def /Nu {(N) symbol pop} def /omicron{(o) symbol pop} def /Omicron{(O) symbol pop} def /pi {(p) symbol pop} def /Pi {(P) symbol pop} def /theta {(q) symbol pop} def /Theta {(Q) symbol pop} def /rho {(r) symbol pop} def /Rho {(R) symbol pop} def /sigma {(s) symbol pop} def /Sigma {(S) symbol pop} def /tau {(t) symbol pop} def /Tau {(T) symbol pop} def /upsilon{(u) symbol pop} def /Upsilon{(U) symbol pop} def /omega1 {(v) symbol pop} def /sigma1 {(V) symbol pop} def /omega {(w) symbol pop} def /Omega {(W) symbol pop} def /xi {(x) symbol pop} def /Xi {(X) symbol pop} def /psi {(y) symbol pop} def /Psi {(Y) symbol pop} def /zeta {(z) symbol pop} def /Zeta {(Z) symbol pop} def /do {TeX-tok cvx exec} def /prime {(\242) symbol pop} def /dprime {(\262) symbol pop} def /tensor {(\304) symbol pop} def /oplus {(\305) symbol pop} def /isom {(\100) symbol pop} def /in {(\316) symbol pop} def /times {(\264) symbol pop} def /union {(\310) symbol pop} def /intsct {(\307) symbol pop} def /into {(\256) symbol pop} def /slash {(/) show} def /ul {(_) show} def /lbr {({) show} def /rbr {(}) show} def /exists {(\044) symbol-show pop} def /all {(\042) symbol pop} def /lnot {(\330) symbol pop} def /land {(\331) symbol pop} def /lor {(\332) symbol pop} def /iff {(\333) symbol pop} def /implies {(\336) symbol pop} def /perp {(\136) symbol pop} def /prod { gsave currentpoint translate [0.2 -0.57] getfontsize smul Moveto (P) symbol pop grestore 0.9 getfontsize mul 0 rmoveto } def /Prod { getfontsize dup 1.5 mul setfontsize setupfont prod setfontsize setupfont } def /dlim { getfontstyle 0 setfontstyle setupfont /P1 [currentpoint] def (lim) show /P2 [currentpoint] def /un {getfontsize mul} def gsave newpath P1 [0 -0.2 un] vadd P2 [-0.2 un -0.2 un] vadd 0.05 un setlinewidth 0 0.12 un 90 0 xArrow stroke grestore setfontstyle setupfont } 3 ldef /ilim { getfontstyle 0 setfontstyle setupfont /P1 [currentpoint] def (lim) show /P2 [currentpoint] def /un {getfontsize mul} def gsave newpath P1 [0 -0.2 un] vadd P2 [-0.2 un -0.2 un] vadd exch 0.05 un setlinewidth 0 0.12 un 90 0 xArrow stroke grestore setfontstyle setupfont } 3 ldef /coprod { gsave currentpoint translate 1 -1 scale [0.2 -0.57] getfontsize smul Moveto (P) symbol pop grestore 0.9 getfontsize mul 0 rmoveto } def /Coprod { getfontsize dup 1.5 mul setfontsize setupfont coprod setfontsize setupfont } def /ell { gsave currentpoint translate newpath getfontsize 1000 div dup scale 35 112 moveto 101 173 245 319 299 474 curveto 363 652 271 735 160 295 curveto 130 178 95 -87 263 59 curveto 342 127 357 100 301 49 curveto 134 -81 35 57 112 346 curveto 215 726 429 718 317 440 curveto 251 277 124 165 58 101 curveto 11 58 -3 78 35 112 curveto closepath fill grestore 0.5 getfontsize mul 0 rmoveto } def end /CSmaxplots 20000 def /CSminplots 20 def /CSmaxdev 5 def /CSplot0 {moveto} def /CSplot {lineto} def %/CSpnt0 2 array def %/CSplot0 {2 copy moveto CSpnt0 astore pop gsave CSpnt0 dot grestore} def %/CSplot {2 copy lineto CSpnt0 astore pop gsave CSpnt0 dot grestore} def /CS-xmarks 20 def /CS-ymarks 15 def /CS-xbase 1 def /CS-ybase 1 def /CS-axismarklen 4 def /CSxlabel {CS-xun div cvi CS-xmul mul s cvs exch 2 3 label} def /CSylabel {CS-yun div cvi CS-ymul mul s cvs exch 1 2 label} def /CS-xunitname () def /CS-yunitname () def /CS-labelfontsize 6 def /CS-dimsfontsize 8 def /CS-axismarklen 4 def /CSunits { /base xdef /idealn xdef /tmax xdef /tmin xdef % Make the first, rough guess -- probably too small /unit tmax tmin sub abs base div log 3 div floor 1 sub 1000 exch exp base mul def % Now multiply unit by 2,5,10,... until too big, and pick best /best 1 rating def 0 1 idealn dup add log floor 3 add { 10 exch exp /e xdef /best best [ 2 e mul dup rating exch] max [ 5 e mul dup rating exch] max [10 e mul dup rating exch] max def best 1 get 10 e mul ne {exit} if } for % OK, now find the best unit, and new tmin and tmax /unit best 1 get unit mul tmax tmin sub sgn mul def /tmin tmin unit div floor unit mul def /tmax tmax unit div ceiling 1 add unit mul def /origo tmax tmin mul 0 gt {tmin} {0} ifelse def /mult best 1 get dup 500 gt {1000 div} if cvi def tmin tmax unit origo mult } 12 { % How good is the choice of unit? This routine measures it! /rating % k => n(2*idealn-n) where n=dt/(unit*k) { tmax tmin sub abs exch div unit div dup idealn dup add exch sub mul } def } lidef /CSframe % [xmin ymin] [xmax ymax] => - { PSMsysd begin aload pop /CS-fymax xdef /CS-fxmax xdef aload pop /CS-fymin xdef /CS-fxmin xdef end } def [0 mm 0 mm] [80 mm 50 mm] CSframe /CSinit % xmin xmax ymin ymax => - { CS-ymarks CS-ybase CSunits PSMsysd begin /CS-ymul xdef /CS-yorigo xdef /CS-yun xdef /CS-ymax xdef /CS-ymin xdef end CS-xmarks CS-xbase CSunits PSMsysd begin /CS-xmul xdef /CS-xorigo xdef /CS-xun xdef /CS-xmax xdef /CS-xmin xdef /CS-sx CS-fxmax CS-fxmin sub CS-xmax CS-xmin sub div def /CS-sy CS-fymax CS-fymin sub CS-ymax CS-ymin sub div def /CS-tx CS-fxmin CS-sx CS-xmin mul sub def /CS-ty CS-fymin CS-sy CS-ymin mul sub def /CS-xaxis [CS-xmax CS-yorigo cs] def /CS-yaxis [CS-xorigo CS-ymax cs] def end } def /cs {pnt2num CS-sy mul CS-ty add exch CS-sx mul CS-tx add exch} def /CSaxes { gsave [CS-xorigo CS-ymin cs] [CS-xorigo CS-ymax cs] arrow fill [CS-xmin CS-yorigo cs] [CS-xmax CS-yorigo cs] arrow fill grestore } def /CSaxismarks { CS-xmin CS-xun dup CS-xmax exch sub { gsave 0 cs moveto CS-axismarklen dup -2 div 0 exch rmoveto 0 exch rlineto stroke grestore } for CS-ymin CS-yun dup CS-ymax exch sub { gsave 0 exch cs moveto CS-axismarklen dup -2 div 0 rmoveto 0 rlineto stroke grestore } for } def /sconcat % s1 s2 => s { /s2 xdef /s1 xdef s1 length s2 length add string dup 0 s1 putinterval dup s1 length s2 putinterval } 2 ldef /CSaxislabels % - => - { /fs getfontsize def CS-labelfontsize setfontsize setupfont /dx (-9999) stringwidth pop CS-sx CS-xun mul div 1.5 mul def /dy CS-labelfontsize CS-sy CS-yun mul div 1.5 mul def /dx [1 2 5 10 20] {dup dx lt {pop} {exit} ifelse} forall CS-xun mul def /dy [1 2 5 10 20] {dup dy lt {pop} {exit} ifelse} forall CS-yun mul def CS-xorigo dx add dx CS-xmax dx 0.6 mul sub {/x xdef [x 0 cs] x CSxlabel} for CS-xorigo dx sub dx neg CS-xmin dx 0.1 mul sub {/x xdef [x 0 cs] x CSxlabel} for CS-yorigo dy add dy CS-ymax dy 0.6 mul sub {/y xdef [0 y cs] y CSylabel} for CS-yorigo dy sub dy neg CS-ymin dy 0.1 mul sub {/y xdef [0 y cs] y CSylabel} for /xexp CS-xun CS-xbase div CS-xmul div log round cvi def /yexp CS-yun CS-ybase div CS-ymul div log round cvi def CS-dimsfontsize setfontsize setupfont xexp 0 eq {()} {($\26410^{) xexp s cvs sconcat (}$ ) sconcat} ifelse CS-xunitname sconcat CS-xaxis -8 -6 1 3 xlabel yexp 0 eq {()} {($\26410^{) yexp s cvs sconcat (}$ ) sconcat} ifelse CS-yunitname sconcat CS-yaxis 6 -2 1 3 xlabel fs setfontsize setupfont } 7 {/s 20 string def} lidef /plot { /fct xdef /tmax xdef /tmin xdef /dtmin tmax tmin sub CSmaxplots div def /dtmax tmax tmin sub CSminplots div def /t tmin def /dt dtmax def % Initialize t fct pnt2num /y xdef /x xdef x y CSplot0 /dev x y t dtmin 10 div add fct pnt2num angle def % Start plotting { % Predicted point /tp t dt add dup tmax sub dt mul 0 lt not {pop tmax} if def tp fct pnt2num /yp xdef /xp xdef /devp x y xp yp angle def % Test for correct change in dev devp dev sub abs CSmaxdev lt dt abs dtmin abs lt or { /x xp def /y yp def /t tp def /dev devp def /dt dt 1.2 mul def x y CSplot tp tmax eq {exit} if } { /dt dt 2 div def } ifelse } loop } 15 ldef /plimits { /pfct xdef /tmax xdef /tmin xdef /xmin 1e36 def /xmax -1e36 def /ymin 1e36 def /ymax -1e36 def tmin tmax tmin sub cs-plots div tmax { /t xdef t pfct aload pop /y xdef /x xdef x xmin lt {/xmin x def} {x xmax gt {/xmax x def} if } ifelse y ymin lt {/ymin y def} {y ymax gt {/ymax y def} if } ifelse } for xmin xmax ymin ymax } 7 ldef % /knot-bgcolour { 1 setgray } def /knot-bgline {currentlinewidth 5 mul setlinewidth} def /knot-line {1 setlinewidth} def /chequer-line 0 def /chequer-bg 1 def /chequer-fill 0 def /braid-dx 20 def /braid-v 0 def /braid-angle 0 def /braid-dot {pop} def /spline{ /spline xdef spline 0 get dup 0 get exch 1 get moveto spline {aload pop 8 -2 roll pop pop curveto} forall } 1 ldef /splinestroke {spline stroke} def /msplinestroke{ /spline xdef /n spline length def 0 2 n 1 sub { /i xdef spline i get aload pop 8 -2 roll moveto curveto spline i 1 add n mod get aload pop 8 -2 roll pop pop curveto } for stroke } 3 ldef /splinesplit { aload pop /y3 xdef /x3 xdef /y2 xdef /x2 xdef /y1 xdef /x1 xdef /y0 xdef /x0 xdef [ x0 y0 x1 x0 add 2 div y1 y0 add 2 div x2 x1 add x1 add x0 add 4 div y2 y1 add y1 add y0 add 4 div x2 x1 add 3 mul x3 add x0 add 8 div y2 y1 add 3 mul y3 add y0 add 8 div ] [ x2 x1 add 3 mul x3 add x0 add 8 div y2 y1 add 3 mul y3 add y0 add 8 div x3 x2 x2 add add x1 add 4 div y3 y2 y2 add add y1 add 4 div x3 x2 add 2 div y3 y2 add 2 div x3 y3 ] } 8 ldef /crossings2spline { aload pop pop /v2 xdef /a2 xdef aload pop /y2 xdef /x2 xdef aload pop pop /v1 xdef /a1 xdef aload pop /y1 xdef /x1 xdef [ x1 y1 x1 a1 cos v1 mul add y1 a1 sin v1 mul add x2 a2 cos v1 mul sub y2 a2 sin v1 mul sub x2 y2 ] } 8 ldef /countsplines { /C xdef /upper 0 def /lower 0 def C { 3 get 0 lt {/lower lower 2 add def} {/upper upper 2 add def} ifelse } forall C 0 get 3 get 0 lt {/lower lower 1 sub def} {/upper upper 1 sub def} ifelse C dup length 1 sub get 3 get 0 lt {/lower lower 1 sub def} {/upper upper 1 sub def} ifelse lower upper } 3 ldef /crossings2layer { /C xdef C countsplines array /upperlayer xdef array /lowerlayer xdef /upper 0 def /lower 0 def /first true def [ C { first { /prev xdef /first false def } { /curr xdef prev curr crossings2spline /spline xdef spline splinesplit /currspline xdef /prevspline xdef prev 3 get 0 lt { lowerlayer lower prevspline put /lower lower 1 add def } { upperlayer upper prevspline put /upper upper 1 add def } ifelse curr 3 get 0 lt { lowerlayer lower currspline put /lower lower 1 add def } { upperlayer upper currspline put /upper upper 1 add def } ifelse /prev curr def spline } ifelse } forall ] /layer xdef C 0 get 3 get 0 lt { lowerlayer aload length 1 roll lowerlayer astore pop } { upperlayer aload length 1 roll upperlayer astore pop } ifelse layer lowerlayer upperlayer } 12 ldef % /drawcrossings{ crossings2layer /upperlayer xdef /lowerlayer xdef /layer xdef layer splinestroke gsave knot-bgcolour knot-bgline upperlayer msplinestroke grestore upperlayer msplinestroke } 3 ldef /knot{ /crossings xdef [ crossings aload 0 get ] drawcrossings } 1 ldef /chequerboard { /crossings xdef [ crossings aload 0 get ] crossings2layer /upperlayer xdef /lowerlayer xdef spline closepath gsave chequer-fill 0 lt not {chequer-fill setgray eofill} if grestore gsave chequer-bg setgray knot-bgline stroke grestore chequer-line setgray stroke gsave chequer-bg setgray knot-bgline upperlayer msplinestroke grestore chequer-line setgray upperlayer msplinestroke } 3 ldef /string-s2angle { /s2 xdef /s1 xdef s1 -2 eq {/s1 -1 def} if s1 2 eq {/s1 1 def} if s2 -2 eq {/s2 -1 def} if s2 2 eq {/s2 1 def} if s1 s2 eq {45 s1 mul neg} { s1 s2 neg eq {0} {s1 s2 add braid-angle mul neg} ifelse } ifelse } 2 ldef /stroke-string { /s xdef /i xdef /n s length def /j 0 def /angle1 0 def /s [s aload pop 0] def /x1 i braid-dx mul def /y1 j braid-dx mul def x1 y1 moveto [ 0 1 n 1 sub { /j xdef /s1 s j get def /s2 s j 1 add get def /angle2 s1 s2 string-s2angle def s1 0 gt {/i i 1 add def} if s1 0 lt {/i i 1 sub def} if /x4 i braid-dx mul def /y4 j 1 add braid-dx mul def [x1 y1] [braid-v braid-dx mul angle1 90 add] p2r vadd aload pop /y2 xdef /x2 xdef [x4 y4] [braid-v braid-dx mul angle2 270 add] p2r vadd aload pop /y3 xdef /x3 xdef x2 y2 x3 y3 x4 y4 curveto s1 abs 2 eq {[x2 y2 x3 y3 x4 y4 x1 y1]} if /x1 x4 def /y1 y4 def /angle1 angle2 def } for ] knot-line stroke } 16 ldef /braid2string { /braid xdef /i xdef [ braid { /j xdef /s 0 def /ii i def i j abs eq {/ii i 1 add def /s j 0 gt { 2} { 1} ifelse def} if i j abs 1 add eq j abs 0 gt and {/ii i 1 sub def /s j 0 gt {-1} {-2} ifelse def} if /i ii def s } forall ] } 5 ldef /braid { /braid xdef /n xdef [ 1 1 n { dup braid braid2string stroke-string } for ] { { aload pop moveto curveto gsave knot-bgline 1 setgray stroke grestore stroke } forall } forall /y1 0 def /y2 braid length braid-dx mul def 1 1 n { braid-dx mul /x xdef [x y1] braid-dot [x y2] braid-dot } for } 5 ldef /knot-0-1 {[currentpoint] 12.5 mm circle stroke} def /hopf-link { /cpoint [currentpoint] def /angle 60 def /radius 10 mm def /A cpoint [angle cos radius mul neg 0] vadd def /B cpoint [angle cos radius mul 0] vadd def /dtheta gsave knot-bgline currentlinewidth grestore radius div 57.2958 mul def /theta1 angle dtheta add def /theta2 angle dtheta sub def A Moveto [radius theta1] p2r rMoveto A radius theta1 theta2 Arc B Moveto [radius theta1 180 sub] p2r rMoveto B radius theta1 180 sub theta2 180 sub Arc } 8 ldef /knot-3-1 { /A [10 mm -90] p2r [currentpoint] vadd def /B [10 mm 30] p2r [currentpoint] vadd def /C [10 mm 150] p2r [currentpoint] vadd def /v 5 mm def /w 15 mm def [ [A 45 v -1] [B 75 w 1] [C 285 v -1] [A -45 w 1] [B 165 v -1] [C 195 w 1] ] } 5 ldef /knot-4-1 { /A [currentpoint] def /B A [12 mm 90] p2r vadd def /C A [12 mm 240] p2r vadd def /D A [12 mm 300] p2r vadd def /u 4 mm def /v 8 mm def /w 12 mm def [ [A 45 u -1] [B 135 w 1] [C -30 u -1] [D 40 w 1] [B 225 u -1] [A -45 u 1] [D -90 v -1] [C 90 u 1] ] } 7 ldef /knot-5-1 { /O [currentpoint] def /A O [10 mm -90] p2r vadd def /B O [10 mm -18] p2r vadd def /C O [10 mm 54] p2r vadd def /D O [10 mm 126] p2r vadd def /E O [10 mm 198] p2r vadd def /v 5 mm def /w 10 mm def [ [A 36 v 1] [B 36 w -1] [C 180 v 1] [D 180 w -1] [E 324 v 1] [A 324 w -1] [B 468 v 1] [C 468 w -1] [D 612 v 1] [E 612 w -1] ] } 8 ldef /knot-5-2 { /A [currentpoint] def /B A [13 mm 90] p2r vadd def /C A [9 mm 225] p2r vadd def /D A [13 mm -90] p2r vadd def /E A [9 mm -45] p2r vadd def /u 4 mm def /v 9 mm def /w 13 mm def [ [A 45 v -1] [B 135 w 1] [C -45 u -1] [D -45 v 1] [E 135 u -1] [A 135 v 1] [B 45 w -1] [E 225 u 1] [D 225 v -1] [C 45 u 1] ] } 8 ldef /knot-6-1 { /A [currentpoint] def /B A [13 mm 90] p2r vadd def /C A [13 mm 210] p2r vadd def /D C [10 mm -45] p2r vadd def /F A [13 mm -30] p2r vadd def /E F [10 mm 225] p2r vadd def /u 4 mm def /v 10 mm def /w 13 mm def [ [A 45 u -1] [B 135 w 1] [C -45 u -1] [D -45 u 1] [E 45 u -1] [F 45 w 1] [B 225 u -1] [A -45 u 1] [F -45 v -1] [E 135 u 1] [D 225 v -1] [C 45 u 1] ] } 9 ldef /knot-6-2 { /A [currentpoint] def /B A [10 mm 45] p2r vadd def /C A [10 mm 135] p2r vadd def /D A [10 mm -45] p2r vadd def /E D [10 mm 225] p2r vadd def /F A [10 mm 225] p2r vadd def /u 3 mm def /v 7 mm def /w 10 mm def [ [A 45 u 1] [B 90 v -1] [C -90 u 1] [A -45 u -1] [D -45 v 1] [E 135 u -1] [F 135 w 1] [C 0 u -1] [B 0 w 1] [D 225 u -1] [E 225 v 1] [F 45 u -1] ] } 9 ldef /knot-6-3 { /A [currentpoint] def /B A [10 mm 150] p2r vadd def /C A [10 mm 30] p2r vadd def /D A [ 7 mm -90] p2r vadd def /E D [10 mm 225] p2r vadd def /F D [10 mm -45] p2r vadd def /u 4 mm def /v 7 mm def /w 10 mm def [ [A 180 u 1] [B 90 v -1] [C -90 u 1] [D 225 u -1] [E -90 v 1] [F 90 u -1] [D 135 u 1] [A 90 u -1] [B 200 v 1] [E 0 u -1] [F 0 v 1] [C 180 u -1] ] } 9 ldef /knot-7-1 { /O [currentpoint] def /da 360 7 div def /A O [11 mm da 0 mul 90 sub] p2r vadd def /B O [11 mm da 1 mul 90 sub] p2r vadd def /C O [11 mm da 2 mul 90 sub] p2r vadd def /D O [11 mm da 3 mul 90 sub] p2r vadd def /E O [11 mm da 4 mul 90 sub] p2r vadd def /F O [11 mm da 5 mul 90 sub] p2r vadd def /G O [11 mm da 6 mul 90 sub] p2r vadd def /u 4 mm def /v 8 mm def [ [A 25.7 u 1] [B 25.7 v -1] [C 128.6 u 1] [D 128.6 v -1] [E 231.4 u 1] [F 231.4 v -1] [G 334.3 u 1] [A 334.3 v -1] [B 437.1 u 1] [C 437.1 v -1] [D 540.0 u 1] [E 540.0 v -1] [F 643.9 u 1] [G 643.9 v -1] ] } 11 ldef /knot-7-2 { /A [currentpoint] def /B A [8 mm 90] p2r vadd def /O A [8 mm -90] p2r vadd def /C O [8 mm 30] p2r vadd def /D O [8 mm -30] p2r vadd def /E O [8 mm -90] p2r vadd def /F O [8 mm 210] p2r vadd def /G O [8 mm 150] p2r vadd def /u 3 mm def /v 8 mm def /w 12 mm def [ [A 150 u 1] [B 30 w -1] [C 250 u 1] [D -70 v -1] [E 130 u 1] [F 170 v -1] [G 10 u 1] [A 50 u -1] [B 150 w 1] [G -70 u -1] [F 250 v 1] [E 50 u -1] [D 10 v 1] [C 170 u -1] ] } 11 ldef /knot-7-3 { /A [currentpoint] def /B A [ 7 mm 90] p2r vadd def /C B [ 7 mm 90] p2r vadd def /D A [10 mm -30] p2r vadd def /E D [ 7 mm 225] p2r vadd def /G A [10 mm 210] p2r vadd def /F G [ 7 mm -45] p2r vadd def /u 4 mm def /v 10 mm def /w 13 mm def [ [A 45 u -1] [B 135 u 1] [C 45 w -1] [D 225 u 1] [E 225 u -1] [F 135 u 1] [G 135 w -1] [C -45 u 1] [B 225 u -1] [A -45 u 1] [D -45 v -1] [E 135 u 1] [F 225 v -1] [G 45 u 1] ] } 10 ldef /knot-7-4 { /A [currentpoint] def /B A [10 mm 120] p2r vadd def /C A [10 mm 180] p2r vadd def /D A [10 mm 240] p2r vadd def /E A [10 mm 300] p2r vadd def /F A [10 mm 360] p2r vadd def /G A [10 mm 420] p2r vadd def /u 4 mm def /v 7 mm def /w 10 mm def [ [A 120 u 1] [B 120 w -1] [C -60 u 1] [D -60 v -1] [E 60 u 1] [F 60 w -1] [G 240 u 1] [A 240 u -1] [D 240 w 1] [C 60 u -1] [B 60 v 1] [G -60 u -1] [F -60 w 1] [E 120 u -1] ] } 10 ldef /knot-7-5 { /A [currentpoint] def /B A [ 7 mm 90] p2r vadd def /C B [ 7 mm 120] p2r vadd def /D B [ 7 mm 60] p2r vadd def /E A [ 7 mm -45] p2r vadd def /F E [ 7 mm 225] p2r vadd def /G A [ 7 mm 225] p2r vadd def /u 5 mm def /v 10 mm def /w 15 mm def [ [A 45 u 1] [B 135 u -1] [C 90 u 1] [D -90 u -1] [B 225 u 1] [A -45 u -1] [E -45 v 1] [F 135 u -1] [G 135 w 1] [C 5 u -1] [D -5 w 1] [E 225 u -1] [F 225 v 1] [G 45 u -1] ] } 10 ldef /knot-7-6 { /A [currentpoint] def /B A [ 7 mm 75] p2r vadd def /C B [ 7 mm 105] p2r vadd def /D A [10 mm 180] p2r vadd def /E A [10 mm 240] p2r vadd def /F A [10 mm -60] p2r vadd def /G A [10 mm 0] p2r vadd def /u 5 mm def /v 10 mm def /w 15 mm def [ [A 60 u -1] [B 90 u 1] [C 135 w -1] [D -60 u 1] [E -60 u -1] [F 60 u 1] [G 60 w -1] [C 225 u 1] [B 0 u -1] [G -60 v 1] [F 120 u -1] [A 120 u 1] [D 240 v -1] [E 60 u 1] ] } 10 ldef /knot-7-7 { /O [currentpoint] def /A O [ 4 mm 180] p2r vadd def /B A [ 8 mm 60] p2r vadd def /C O [12 mm 0] p2r vadd def /D C [ 8 mm 240] p2r vadd def /E A [ 8 mm 240] p2r vadd def /F O [12 mm 180] p2r vadd def /G O [ 4 mm 0] p2r vadd def /u 5 mm def /v 8 mm def /w 12 mm def [ [A 60 u -1] [B 60 w 1] [C 240 u -1] [D 240 v 1] [E 120 u -1] [F 120 w 1] [B -60 u -1] [G -60 u 1] [D -60 v -1] [C 180 u 1] [G 180 u -1] [A 180 u 1] [F 180 v -1] [E 60 u 1] ] } 11 ldef /art { /A [currentpoint] def /B A [ 8 mm 90] p2r vadd def /C B [ 8 mm 90] p2r vadd def /D A [13 mm 210] p2r vadd def /E D [10 mm -45] p2r vadd def /F A [13 mm -30] p2r vadd def /G F [10 mm 225] p2r vadd def /u 4 mm def /v 10 mm def /w 13 mm def A dot B dot C dot D dot E dot F dot G dot [ [A 45 u -1] [B 135 u 1] [C 45 w -1] [D -45 u 1] [E -45 u -1] [F 135 u 1] [G 135 w -1] [C -45 u 1] [B 225 u -1] [A -45 u 1] [D -45 v -1] [E 45 u 1] [F 225 v -1] [G 45 u 1] ] } 10 ldef /chemdist 6 mm def /chempoints 20 array def /chemlabels 50 array def % general procedures /cheminit % pnt angle => - { /chemangle xdef /chempoint xdef chempoints 0 0 put chemlabels 0 0 put 1 1 TeXsetfill } def /chemclose { chemlabels 1 chemlabels 0 get getinterval {aload pop exch 2 2 label} forall } def /atom % label { /lbl xdef chemlabels [chempoint lbl] spush } def /bondlines % pnta pntb n => - { gsave newpath /n xdef line /c 0 def /lw currentlinewidth def n 2 mul 1 sub -2 0 { gsave lw mul setlinewidth c setgray stroke /c 1 c sub def grestore } for grestore } 3 ldef /spush % stack any => - { /a xdef /s xdef /n s 0 get 1 add def s 0 n put s n a put } 3 ldef /spop % stack => top element { /s xdef /n s 0 get def s n get s 0 n 1 sub put } 2 ldef /xbond % angle n length => - { /l xdef /n xdef /a xdef chempoint /chemangle chemangle a add def /chempoint chempoint [l chemangle] p2r vadd def chempoint n bondlines } def /chempush {chempoints [chempoint chemangle] spush} def /single {1 chemdist xbond} def /double {2 chemdist xbond} def /triple {3 chemdist xbond} def /single* {chempush single} def /double* {chempush double} def /triple* {chempush triple} def /back { chempoints spop aload pop /chemangle xdef /chempoint xdef } def /benzene { chempoint [chemdist chemangle] p2r vadd chemdist 3 sqrt 2 div mul 2 sub circle stroke -60 single* 5 {60 single*} repeat } def % DATA TYPES % % label: string % node: [xcenter ybaseline label] % leaf: [label] % branch: [label node1 ... noden] % tree: leaf | node | [label tree1 ... treen] % ctree: a tree, but not a branch, leaf or node % % METHOD % % The program takes a tree and returns its top node. % a tree as above. The program applies the following rules to % the tree: % % 1 a) It is a label; leave it. % b) It is a node; leave it. % % 2 a) It is a leaf; draw it and return node. % b) It is a branch; draw it and return top node. % % 3 It is a tree; process each entry separately and % astore the tree into a branch; then reprocess it. % MAIN /tree % tree => node { dup treetype % tree treetype cvx exec } def % TREETYPE CASES /TeXstringwidth {TeXbbox pop exch pop exch sub 0} def /treelabel { } def /node { } def /leaf % [string] => node { aload pop % string currentpoint pop % string x1 1 index TeX currentpoint % string x1 x2 y 3 1 roll add 2 div exch % string x y 3 -1 roll 3 array astore % [x y string] hspace 0 rmoveto } def /branch % [string node1 node2 ... noden] => node { dup length 1 sub /n exch def % branch dup aload pop % branch string node1 ... noden 1 get n 1 sub % branch string node1 ... noden-1 yn n-1 { exch 1 get max } repeat vspace add % branch string y 2 index dup % branch string y branch branch 1 get 0 get exch n get 0 get % branch string y x1 xn add 2 div exch 3 -1 roll % branch string x y 3 array astore exch % node branch dup 0 1 index 1 get put % node [node1 node1 ... noden] { 1 index nodeline } forall dup aload pop 3 1 roll % node string x y 2 index TeXstringwidth pop 2 div % node string x y sw/2 3 -1 roll exch sub exch % node string x y gsave moveto TeX grestore % node } def /ctree % [string tree1 ... treen] => node { dup length 1 sub 1 1 3 -1 roll % ctree 1 1 n { 1 index exch dup 2 index % ctree ctree i i ctree exch get % ctree ctree i treei tree % ctree ctree i nodei put % ctree } for branch } def /nodeline % node1 node => - { gsave aload pop pop vspace- sub moveto aload pop pop vspace+ add lineto stroke grestore } def % TREETYPE TESTS: tree => bool /node? { dup type /arraytype eq { 0 get type dup /integertype eq exch /realtype eq or } { pop false } ifelse } def /treetype { dup type /stringtype eq % tree bool { pop /treelabel % /treelabel } { dup 0 get dup type /stringtype eq % tree tree_0 bool { pop dup length % tree length dup 1 eq % tree length bool { pop pop /leaf % /leaf } { 1 sub 1 1 % tree length-1 1 1 3 -1 roll true % tree 1 1 length-1 true 4 1 roll % tree true 1 1 length-1 { 2 index % tree bool i tree exch get % tree bool tree_i node? and % tree bool } for {pop /branch} {pop /ctree} ifelse } ifelse } { pop pop /node % /node } ifelse } ifelse } def % CREATE AN ISO-LATIN1 ENCODED TIMES FONT %/TimesRoman findfont %dup length dict begin % {1 index /FID ne {def} {pop pop} ifelse} forall % /Encoding ISOLatin1Encoding def % currentdict %end %/TimesRoman-ISOLatin1 exch definefont pop %/TimesRoman-ISOLatin1 findfont fontsize scalefont setfont % DEFAULTS /hspace 10 def /vspace 20 def /vspace+ 10 def /vspace- 3.33 def % Define procedures /yxline % P Q { aload pop /y2 xdef /x2 xdef aload pop /y1 xdef /x1 xdef x1 y1 moveto x1 y2 lineto x2 y2 lineto } 4 ldef /nextline {/nextpnt nextpnt [0 -15] vadd def} def /Root % Label Pnt { 10 dict begin /rootpnt xdef /rootlabel xdef rootlabel rootpnt 2 -3 1 0 xlabel /nextpnt rootpnt [20 0] vadd def /rootpnt nextpnt [-5 -5] vadd def nextline } def /Subtree % Label { rootpnt nextpnt yxline stroke nextpnt Root } def /Endtree { nextpnt 1 get end nextpnt 0 get exch 2 array astore /nextpnt xdef } def /Endroot { end nextline } def /Node % Label { rootpnt nextpnt yxline stroke nextpnt 2 -3 1 0 xlabel nextline } def %% Trees /words {[0 0] ( ) cdentry hspace vspace cdlist} def /cat {dup type /stringtype eq {[0 0]} {[0 vspace] smul} ifelse 3 -1 roll cdsuper vadd exch cdentry def} def /trans {/vspace -10 def exch cdsuper exch cdentry} 1 ldef /lex {gsave 2 setlinewidth cdarrow-line grestore} def /head {gsave 2 setlinewidth cdarrow-line grestore} def /comp {cdarrow-line} def /adj {[3 1] 0 setdash cdarrow-line nodash} def /landing {[1 3] 0 setdash cdarrow-line nodash} def /filler {landing (_{fill}) 0.5 cdpnt 2 2 label} def end end