aUCBLogo Demos and Tests / create_organic_molecules3
setCaseIgnored false
be create_organic_molecules3
molecules=Table
[ water [O H H]
methan [C H H H H]
ethan [C H H H
[C H H H]]
propan [C H H H
[C H H
[C H H H]]]
butan [C H H H
[C H H
[C H H
[C H H H]]]]
pentan [C H H H
[C H H
[C H H
[C H H
[C H H H]]]]]
hexan [C H H H
[C H H
[C H H
[C H H
[C H H
[C H H H]]]]]]
methanol [C [O H]H H H]
ethanol [C [O H]H H
[C H H H]]
propanol [C [O H]H H
[C H H
[C H H H]]]
isopropanol
[C H [O H]H
[C H H
[C H H[O H]]]]
glycerol [C H[O H]H
[C [O H]H
[C H H[O H]]]]
sorbitol [C H[O H]H
[C[O H]H
[C H[O H]
[C[O H]H
[C[O H]H
[C[O H]H H]]]]]]
benzol [Cbenz H
[Cbenz H
[Cbenz H
[Cbenz H
[Cbenz H
[Cbenz H
[Cbenz0]]]]]]]
salol [Cbenz H
[Cbenz H
[Cbenz H
[Cbenz H
[Cbenz H
[Cbenz [O
[Ccarboxyl O2
[Cbenz
[Cbenz [O H]
[Cbenz H
[Cbenz H
[Cbenz H
[Cbenz H
[Cbenz ]]]]]]]]]
[Cbenz0]]]]]]]
]
bindings=
[ C C 154
C Cbenz 154
Cbenz Cbenz 139
Cbenz Cbenz0 139
Cbenz H 108
Cbenz O 143
Cbenz 0 154
Ccarboxyl Cbenz 154 ;?
Ccarboxyl O2 140 ;?
C H 107
C O 143
C O2 140 ;?
O H 96
O C 143
O Ccarboxyl 143 ;?
]
masses=Table
[ C 12.011
Cbenz 12.011
Cbenz0 12.011
Ccarboxyl 12.011
O 15.999
O2 15.999
H 1.0079
]
radi=Table
[ C 77.2
Cbenz 77.2
Cbenz0 0
Ccarboxyl 77.2
O 60.4
O2 60.4
H 37.3
]
cols=Table
[ C grey
Cbenz grey
Cbenz0 black
Ccarboxyl grey
O red
O2 red
H white
]
elng=Table
[ C 2.55
Cbenz 2.55 ;?
Cbenz0 0
Ccarboxyl 2.55 ;?
O 3.44
O2 3.44 ;?
H 2.2
]
rfactor=0.5
drfactor=1.02
rrandom=1
dt=0.0001
damping=0.99
bind=generateBindings
charges=computeChargesTable
tau=109.47
tau1=180-tau
molarray=Array toList :molecules
molnames=firsts molarray
perspective
; setScreenColor "black
setScreenColor RGB 0 0 .2
WindowMode
enableCylinderLines
disableShadows
; enableShadows
clearShadows
setShadowColor "black
setLightSpecular RGB .6 .6 .6
setMaterialSpecular "grey
setMaterialShininess 100
setUpdateGraph false
setProcessIdleInterleaving intmax
myframe=(Frame [][ChemFrame]
wxdefault_frame_style+wxstay_on_top+wxframe_tool_window
[0 650][300 300])
mylistbox=(ListBox myframe [Chem Demos][]
[ odemoNr=demoNr
demoNr=(first ListBoxSelections)+1
OnMouseLeftDown []
OnMouseLeftUp []
OnMouseMotion []
ConsoleSetFocus
throw "nextDemo
])
video=false
bvideo=(CheckBox myframe [&Video]
[ ifelse video
[ VideoEnd
video=false
][ (VideoStart Word molnames.demoNr ".divx 25)
video=true
]
ConsoleSetFocus
])
applyE_Field=true
bapplyE_Field=(CheckBox myframe [&Apply E Field]
[ applyE_Field=not applyE_Field
ConsoleSetFocus
throw "nextDemo
])
CheckBoxSet bapplyE_Field applyE_Field
showDipol=true
bshowDipol=(CheckBox myframe [&Show Dipol]
[ showDipol=not showDipol
ConsoleSetFocus
throw "nextDemo
])
CheckBoxSet bshowDipol showDipol
showTensor=true
bshowTensor=(CheckBox myframe [&Show Tensor]
[ showTensor=not showTensor
ConsoleSetFocus
throw "nextDemo
])
CheckBoxSet bshowTensor showTensor
showBox=true
bshowBox=(CheckBox myframe [&Show Box]
[ showBox=not showBox
ConsoleSetFocus
throw "nextDemo
])
CheckBoxSet bshowBox showBox
showAxes=false
bshowAxes=(CheckBox myframe [&Show Axes]
[ showAxes=not showAxes
ConsoleSetFocus
throw "nextDemo
])
CheckBoxSet bshowAxes showAxes
showGrid=false
bshowGrid=(CheckBox myframe [&Show Grid]
[ showGrid=not showGrid
ConsoleSetFocus
throw "nextDemo
])
CheckBoxSet bshowGrid showGrid
shadows=false
ifelse shadows [enableShadows][clearShadows disableShadows]
bshadows=(CheckBox myframe [&Draw Shadows]
[ shadows=not shadows
ifelse shadows [enableShadows][clearShadows disableShadows]
ConsoleSetFocus
throw "nextDemo
])
CheckBoxSet bshadows shadows
slrfactor=(Slider myframe [R factor]
0 Int rfactor*100 100
[ rfactor=SliderValue/100
broken=true
ConsoleSetFocus
] wxhorizontal)
transparency=0
sltrans=(Slider myframe [Transparency]
0 Int transparency*100 100
[ transparency=SliderValue/100
broken=true
ConsoleSetFocus
] wxhorizontal)
w1=0
w2=0
w3=0
W_1=toMatrix
(list
(list cos w1 -sin w1 0)
(list sin w1 cos w1 0)
(list 0 0 1)
)
W_2=toMatrix
(list
(list 1 0 0 )
(list 0 cos w2 -sin w2)
(list 0 sin w2 cos w2)
)
W_3=toMatrix
(list
(list cos w3 0 sin w3)
(list 0 1 0 )
(list -sin w3 0 cos w3)
)
W=W_1*W_2*W_3
slw1=(Slider myframe [w1] -10 Int w1*2 10
[ w1=SliderValue/2
W_1=toMatrix
(list
(list cos w1 -sin w1 0)
(list sin w1 cos w1 0)
(list 0 0 1)
)
W=W_1*W_2*W_3
ConsoleSetFocus
] wxhorizontal)
slw2=(Slider myframe [w2] -10 Int w2*2 10
[ w2=SliderValue/2
W_2=toMatrix
(list
(list 1 0 0 )
(list 0 cos w2 -sin w2)
(list 0 sin w2 cos w2)
)
W=W_1*W_2*W_3
ConsoleSetFocus
] wxhorizontal)
slw3=(Slider myframe [w3] -10 Int w3*2 10
[ w3=SliderValue/2
W_3=toMatrix
(list
(list cos w3 0 sin w3)
(list 0 1 0 )
(list -sin w3 0 cos w3)
)
W=W_1*W_2*W_3
ConsoleSetFocus
] wxhorizontal)
slowdown=false
bslowdown=(Button myframe [&Break]
[ slowdown=true
ConsoleSetFocus
])
bquit=(Button myframe [&Quit][throw "stopping])
bsh=BoxSizer wxhorizontal
bsv=StaticBoxSizer wxvertical myframe [Options]
BoxSizerAdd bsh mylistbox 100 wxexpand 0
BoxSizerAdd bsv bvideo 100 wxexpand 0
BoxSizerAdd bsv bapplyE_Field 100 wxexpand 0
BoxSizerAdd bsv bshowDipol 100 wxexpand 0
BoxSizerAdd bsv bshowTensor 100 wxexpand 0
BoxSizerAdd bsv bshowBox 100 wxexpand 0
BoxSizerAdd bsv bshowAxes 100 wxexpand 0
BoxSizerAdd bsv bshowGrid 100 wxexpand 0
BoxSizerAdd bsv bshadows 100 wxexpand 0
BoxSizerAdd bsv bslowdown 100 wxexpand 0
BoxSizerAdd bsv bquit 100 wxexpand 0
BoxSizerAdd bsh bsv 100 0 0
bsw=StaticBoxSizer wxvertical myframe [Parameters]
BoxSizerAdd bsw slrfactor 150 wxexpand 0
BoxSizerAdd bsw sltrans 150 wxexpand 0
BoxSizerAdd bsw slw1 150 wxexpand 0
BoxSizerAdd bsw slw2 150 wxexpand 0
BoxSizerAdd bsw slw3 150 wxexpand 0
BoxSizerAdd bsh bsw 100 0 0
FrameSetSizer myframe bsh
FrameSetClientSize myframe 300 300
foreach molnames
[ ListBoxAppend mylistbox ?
]
ConsoleSetFocus
pplus=FloatArray {0 0 0}
pminus=FloatArray {0 0 0}
qplus=0
qminus=0
mtotal=0
dipolmoment=0
Mm=FloatArray {0 0 0}
ow1=0
ow2=0
ow3=0
dw1=0
dw2=0
dw3=0
demoNr=1
odemoNr=0
mat=ModelviewMatrix
mcenter=FloatArray last mat
R=toMatrix butLast mat
running=true
broken=false
catch "stopping
[ while [running]
[ ready=false
catch "nextDemo
[ clearScreen
grOutside=Graphic
[ if shadows [clearShadows]
if showBox [drawBox]
if showAxes [drawAxes]
if showGrid [drawGrid]
setPenSize 7
enableBlend
setLightModelTwoSide 1
Home
]
if (demoNr != odemoNr) or2 broken
[ pmass=FloatArray {0 0 0}
positions=(list FloatArray pmass)
charge=(list 0)
mass=(list 0)
penAlwaysUp=true
construct (molarray.(Int demoNr)).2
&positions &charge &mass 0
penAlwaysUp=false
qs=[]
ps=[]
ms=[]
flatten charge &qs positions &ps mass &ms
qs=Array qs
ps=Array ps
ms=Array ms
computeMassCenter ms ps
pmass0=pmass
]
Home
grMolecule=Graphic
[ PenUp setPosXYZ -pmass0 PenDown
positions=(list FloatArray {0 0 0})
charge=(list 0)
mass=(list 0)
construct (molarray.(Int demoNr)).2
&positions &charge &mass 0
qs=[]
ps=[]
ms=[]
flatten charge &qs positions &ps mass &ms
qs=Array qs
ps=Array ps
ms=Array ms
if showDipol
[ computeChargeCenters qs ps
drawDipol
]
computeMassCenter ms ps
computeInertialTensor ms ps
m=toMatrix I_tensor
I_eigenvecs=Eigenvectors m
v=Array Eigenvalues m
v=FloatArray Array (list v.(1).1 v.(2).2 v.(3).3)
I_eigenvals=v
;pr I_eigenvals
;pr I_eigenvecs
if showTensor
[ drawMassCenter
]
]
if shadows [castShadows]
broken=false
ready=true
T1=I_eigenvecs
T=invertMatrix I_eigenvecs
rotatescene3
]
]
]
setUpdateGraph true
FrameDestroy myframe
updateGraph
OnMouseLeftDown []
OnMouseLeftUp []
OnMouseMotion []
ConsoleSetFocus
be construct mol &positions &charge &mass prev
local [p0 o0 p cb q m c]
p0=FloatArray PosXYZ
p=(list p0)
cb=-chargebind prev mol.1
ifelse cb != []
[ q=(list cb)
][ q=(list 0)
]
;(pr q prev mol.1)
;if q==[[]] [pause]
if (count charge) > 0 and2 (prev != 0)
[ charge.1=charge.1-q.1
;(show charge.1 prev mol.1)
]
m=masses.(mol.1)
if empty? m [m=0 pr 5]
m=(list m)
setPenColor cols.(mol.1)
if transparency != 0
[ c=reRGBA PenColor
c.4=c.4*(1-transparency)
setPenColor c
]
; disableDepthTest
if not penAlwaysUp
[ Sphere radi.(mol.1)*rfactor
]
; (Sphere radi.(mol.1) 10 10)
; enableDepthTest
setPenColor "white
if not List? mol
[ positions=lput p positions
charge=lput q charge
mass=lput m mass
stop
]
ifelse mol.1=="C
[ if (count mol) > 1
[ mol=butFirst mol
rightRoll 180
store
leftRoll 60
downPitch tau1 fd binding "C mol.1
construct mol.1 &p &q &m "C
restore
if (count mol) > 1
[ rightRoll 60
downPitch tau1 fd binding "C mol.2
construct mol.2 &p &q &m "C
restore
if (count mol) > 2
[ upPitch tau1 fd binding "C mol.3
construct mol.3 &p &q &m "C
restore
if (count mol) > 3
[ right 180 rightRoll tau fd binding "C mol.4
construct mol.4 &p &q &m "C
restore
]
]
]
]
][
ifelse mol.1=="Cbenz
[ if (count mol) > 1
[ mol=butFirst mol
store
left 60 fd binding "Cbenz mol.1
construct mol.1 &p &q &m "Cbenz
restore
if (count mol) > 1
[ right 60 fd binding "Cbenz mol.2
construct mol.2 &p &q &m "Cbenz
restore
if (count mol) > 2
[ right 180 fd binding "Cbenz mol.3
construct mol.3 &p &q &m "Cbenz
restore
]
]
]
][
ifelse mol.1=="Ccarboxyl
[ if (count mol) > 1
[ mol=butFirst mol
store
left 60 fd binding "Ccarboxyl mol.1 rightRoll 90
construct mol.1 &p &q &m "Ccarboxyl
restore
if (count mol) > 1
[ right 60 fd binding "Ccarboxyl mol.2 rightRoll 90
construct mol.2 &p &q &m "Ccarboxyl
restore
if (count mol) > 2
[ right 180 fd binding "Ccarboxyl mol.3 rightRoll 90
construct mol.3 &p &q &m "Ccarboxyl
restore
]
]
]
][
ifelse mol.1=="O2
[][
ifelse mol.1=="O
[
if (count mol) > 1
[ mol=butFirst mol
store
downPitch tau1 fd binding "O mol.1
construct mol.1 &p &q &m "O
restore
if (count mol) > 1
[ store
upPitch tau1 fd binding "O mol.1
construct mol.1 &p &q &m "O
restore
]
]
][
ifelse mol.1=="Cbenz0
[ stop
][]]]]]]
positions=lput p positions
charge=lput q charge
mass=lput m mass
be store
p0=PosXYZ
o0=Orientation
end
be restore
PenUp setPosXYZ p0 setOrientation o0
if not penAlwaysUp [PenDown]
end
end
be binding a b
while [List? a][a=a.1]
while [List? b][b=b.1]
local [w]
w=(word a "_ b)
;pr w
output bind.w
end
be chargebind a b
while [List? a][a=a.1]
while [List? b][b=b.1]
local [w c]
w=(word a "_ b)
c=charges.w
;(pr w c)
output c
end
be generateBindings
local [l b]
l=bindings
b=Table 31
while [not empty? l]
[ setItem (word l.1 "_ l.2) b l.3
setItem (word l.2 "_ l.1) b l.3
l=bf bf bf l
]
output b
end
be computeChargesTable
local [l b]
l=bindings
c=Table 31
while [not empty? l]
[ ifelse (last l.2)==0
[ setItem (word l.1 "_ l.2) c 0
setItem (word l.2 "_ l.1) c 0
][ setItem (word l.1 "_ l.2) c elng.(l.2)-elng.(l.1)
setItem (word l.2 "_ l.1) c elng.(l.1)-elng.(l.2)
]
l=bf bf bf l
]
output c
end
be flatten l &out l2 &out2 l3 &out3
ifelse list? l
[ while [not empty? l]
[ flatten l.1 &out l2.1 &out2 l3.1 &out3
l=bf l
l2=bf l2
l3=bf l3
]
][ out=lput l out
out2=lput l2 out2
out3=lput l3 out3
]
end
be computeMassCenter ms ps
pmass=FloatArray {0 0 0}
mtotal=0
repeat count ms
[ i=repCount
mtotal=mtotal+ms.i
pmass=pmass+ps.i*ms.i
]
pmass=pmass/mtotal
end
be delta i j
ifelse i==j [output 1][output 0]
end
be computeInertialTensor ms ps
I=Array 3
I.1=FloatArray {0 0 0}
I.2=FloatArray {0 0 0}
I.3=FloatArray {0 0 0}
repeat count ms
[ j=repCount
m=ms.j
r=ps.j-pmass
for [k 1 3]
[ for [l 1 3]
[ I.k.l=I.k.l-m*(r.k*r.l)
]
I.k.k=I.k.k+m*(0+r*r)
]
]
;pr I
I_tensor=I
end
be drawMassCenter
; local [evals evecs]
evecs=Array I_eigenvecs
evals=I_eigenvals/(Norm I_eigenvals)
setPenColor "lightgreen
; Arrow pmass pmass+evecs.1
; Arrow pmass pmass+evecs.2
; Arrow pmass pmass+evecs.3
PenUp Home PenDown setPosXYZ evecs.1*200
PenUp Home PenDown setPosXYZ evecs.2*200
PenUp Home PenDown setPosXYZ evecs.3*200
setPenColor "blue
setPenSize 2
; PenUp Home PenDown setPosXYZ evecs.1/evals.1
; PenUp Home PenDown setPosXYZ evecs.2/evals.2
; PenUp Home PenDown setPosXYZ evecs.3/evals.2
PenUp Home setPosXYZ pmass Sphere 3
setTowardsXYZup pmass+evecs.1 evecs.3
PenDown
setPenColor HSBA 120 0.6 0.2 0.5
; Home
; setPosXYZ pmass
; disableDepthTest
(Ellipsoid
50/((abs evals.2)+0.01)
50/((abs evals.1)+0.01)
50/((abs evals.3)+0.01))
; enableDepthTest
end
be computeChargeCenters qs ps
pplus=FloatArray {0 0 0}
pminus=FloatArray {0 0 0}
qplus=0
qminus=0
repeat count qs
[ i=repCount
if qs.i > 0
[ qplus=qplus+qs.i
pplus=pplus+ps.i*qs.i
]
if qs.i < 0
[ qminus=qminus+qs.i
pminus=pminus+ps.i*qs.i
]
]
pplus=pplus/qplus
pminus=pminus/qminus
dipolmoment=(pplus-pminus)*(qplus-qminus)
end
be drawDipol
setPenColor "lightblue
if (Norm pplus-pminus) > 1
[ Arrow pminus pplus
Wire pminus pplus
]
PenDown
end
be Arrow a b
local [l lSpitze p ori]
PenUp
setPosXYZ a
setOrientation towardsXYZ b
l=Norm b-a
lSpitze=l/3
p=PosXYZ
ori=Orientation
PD fd l-lSpitze*0.8
PU back lSpitze*0.2
(Cylinder lSpitze PenSize.1 0)
setPosXYZ p
setOrientation ori
end
be Wire a b
local [l p ori ps]
PenUp
setPosXYZ a
setOrientation towardsXYZ b
l=Norm b-a
p=PosXYZ
ori=Orientation
ps=PenSize
setPenSize 4
back l*4
PenDown forward l*9
PenUp
setPenSize ps
setPosXYZ p
setOrientation ori
end
be drawBox
local [size]
size=3000
pu setY -size
setPenColor RGB 0 0 0.2
PolyStart
setX -size pd setZ size setX size setZ -size setX -size pu
PolyEnd
setPenColor RGB 0.2 0 0
PolyStart
pd setY size setZ size setY -size setZ -size pu
PolyEnd
setPenColor RGB 0 0.2 0
PolyStart
setY -size pd setX size setY size setX -size setY -size pu
PolyEnd
setX size
setPenColor RGB 0.2 0.2 0
PolyStart
pd setY size setZ size setY -size setZ -size pu
PolyEnd
setY size
setPenColor RGB 0 0.2 0.2
PolyStart
setX -size pd setZ size setX size setZ -size setX -size pu
PolyEnd
Home
end
be drawAxes
local [ps size]
size=2000
ps=PenSize
setPenSize 2
pu setX -size pd setX size
pu setXY 0 -size pd setY size
pu setXYZ 0 0 -size pd setZ size
pu
setPenSize ps
Home
end
be drawGrid
if showGrid
[ local [ps gridcolor size z]
ps=PenSize
setPenSize 2
gridcolor=RGB 0.5 0.5 0.5
size=300
z=size
for [x -size size 100]
[ for [y -size size 100]
[ PenUp
setXYZ x y -z
PenDown
setXYZ x y z
PenUp
setXYZ x -z y
PenDown
setXYZ x z y
PenUp
setXYZ -z x y
PenDown
setXYZ z x y
]
]
pu
setPenSize ps
Home
]
end
be rotatescene3
; local [eye r dr ddphi theta center upvector]
singleshot=Name? "framenr
if singleshot [phi=framenr*10]
if not Name? "ddphi
[ eye=array 3
light=array 3
eyecenter=500
phi=10
dphi=0 ;0.5
ddphi=0.2
theta=30
dtheta=0
ddtheta=0.2
dpsi=0
ddpsi=0.2
l=eyecenter ;200
deyecenter=1
ddeyecenter=1.003
dcenterx=0
dcentery=0
dcenterz=0
dx=1
ophi=phi
otheta=theta
oldeyecenter=eyecenter
center=FloatArray {0 0 0}
upvector=FloatArray {0 1 0}
upv=upvector
slowdown=false
slower=0.9
mind=0.005
PenUp
Home
down 90
center=FloatArray PosXYZ
ori=Orientation
]
;comment[
mouseActive=false
p0=MouseWindowPos
mp=MouseWindowPos-p0
dispatchMessages
OnMouseLeftDown
[ if not mouseActive
[ p0=MouseWindowPos
mouseActive=true
]
ConsoleSetFocus
]
OnMouseMotion
[ if mouseActive
[ mp=MouseWindowPos-p0
dphi=0
dtheta=0
if mp.1 > 5 [dphi=-mp.1/100]
if mp.1 <-5 [dphi=-mp.1/100]
if mp.2 > 5 [dtheta=mp.2/100]
if mp.2 <-5 [dtheta=mp.2/100]
]
]
OnMouseLeftUp
[ mp=MouseWindowPos-p0
dphi=0
dtheta=0
if mp.1 > 5 [dphi=-mp.1/100]
if mp.1 <-5 [dphi=-mp.1/100]
if mp.2 > 5 [dtheta=mp.2/100]
if mp.2 <-5 [dtheta=mp.2/100]
mouseActive=false
]
WindowOnLeaveWindow GraphCurrent [mouseActive=false]
forever
[ PenUp
setPosXYZ center
setOrientation ori
back eyecenter
eye=FloatArray PosXYZ
up 90
forward 1
upv=(FloatArray PosXYZ)-eye
back 1
down 90
forward eyecenter
setEye eye center upv
left dphi
downPitch dtheta
leftRoll dpsi
forward dcenterz
up 90
forward dcentery
down 90
right 90
forward dcenterx
left 90
center=FloatArray PosXYZ
ori=Orientation
; setLightPos light
; redraw
clearScreen
drawGraphic grOutside
MM=ModelviewMatrix
M=toMatrix butlast MM
M1=invertMatrix M
mcenter=FloatArray last MM
pushMatrix
R=T1*W*T*R
(setModelviewMatrix R*M mcenter)
drawGraphic grMolecule
popMatrix
if applyE_Field
[
; for [j 1 1]
; [
oM=Mm
MI=transposeMatrix toMatrix (list tolist dipolmoment)
Mm=Array T1*MI
Mm=cross Mm.1 FloatArray {0 1 0}
dM=(Mm-oM)/dt
I=I_eigenvals/200000
dw1=(Mm.1+(I.2-I.3)*w2*w3)/I.1
dw2=(Mm.2+(I.3-I.1)*w3*w1)/I.2
dw3=(Mm.3+(I.1-I.2)*w1*w2)/I.3
ddw1=(dM.1+(I.2-I.3)*(dw2*w3+w2*dw3))/I.1
ddw2=(dM.2+(I.3-I.1)*(dw3*w1+w3*dw1))/I.2
ddw3=(dM.3+(I.1-I.2)*(dw1*w2+w1*dw2))/I.3
; ow1=w1
; ow2=w2
; ow3=w3
w1=(w1+dw1*dt+ddw1/2*sqr dt)*damping
w2=(w2+dw2*dt+ddw2/2*sqr dt)*damping
w3=(w3+dw3*dt+ddw3/2*sqr dt)*damping
; dw1=(w1-ow1)/dt
; dw2=(w2-ow2)/dt
; dw3=(w3-ow3)/dt
W_1=toMatrix
(list
(list cos w1 -sin w1 0)
(list sin w1 cos w1 0)
(list 0 0 1)
)
W_2=toMatrix
(list
(list 1 0 0 )
(list 0 cos w2 -sin w2)
(list 0 sin w2 cos w2)
)
W_3=toMatrix
(list
(list cos w3 0 sin w3)
(list 0 1 0 )
(list -sin w3 0 cos w3)
)
W=W_1*W_2*W_3
; R=T1*W*T*R
; ]
]
updateGraph
if video [VideoFrame]
if singleshot [break]
eyecenter=eyecenter*deyecenter
; while [(and dphi==0 dpsi==0 dtheta==0 deyecenter==1 (not Key?)
; dcenterx==0 dcentery==0 dcenterz==0)]
; [ dispatchMessages
; waitMS 20
; ]
dispatchMessages
ophi=phi
otheta=theta
oldeyecenter=eyecenter
if slowdown
[ dphi=dphi*slower
dtheta=dtheta*slower
dpsi=dpsi*slower
dcenterx=dcenterx*slower
dcentery=dcentery*slower
dcenterz=dcenterz*slower
deyecenter=(deyecenter-1)*slower+1
if (abs dphi) < mind [dphi=0]
if (abs dtheta) < mind [dtheta=0]
if (abs dpsi) < mind [dpsi=0]
if (abs dcenterx) < mind [dcenterx=0]
if (abs dcentery) < mind [dcentery=0]
if (abs dcenterz) < mind [dcenterz=0]
if (abs deyecenter-1) < mind [deyecenter=1]
]
if key?
[ slowdown=false
local [ch]
ch=readChar
ifelse ch>=char 255
[ ch=readCharExt
ifElse (BitAnd MouseButtons 16)==16
[ if ch==wxk_right [dcenterx=dcenterx+dx]
if ch==wxk_left [dcenterx=dcenterx-dx]
if ch==wxk_up [dcentery=dcentery+dx]
if ch==wxk_down [dcentery=dcentery-dx]
if ch==wxk_prior [dcenterz=dcenterz+dx]
if ch==wxk_next [dcenterz=dcenterz-dx]
][
if ch==wxk_right [dphi=dphi+ddphi]
if ch==wxk_left [dphi=dphi-ddphi]
if ch==wxk_up [dtheta=dtheta+ddtheta]
if ch==wxk_down [dtheta=dtheta-ddtheta]
if ch==wxk_prior [deyecenter=deyecenter/ddeyecenter]
if ch==wxk_next [deyecenter=deyecenter*ddeyecenter]
]
][
if ch==char 27
[ OnMouseLeftDown []
OnMouseLeftUp []
OnMouseMotion []
throw "stopping
]
if ch=="x [dpsi=dpsi+ddpsi]
if ch=="y [dpsi=dpsi-ddpsi]
if ch=="+
[ if demoNr < count molnames
[ demoNr=demoNr+1
ListBoxSetSelections mylistbox (list demoNr-1)
throw "nextDemo
]
]
if ch=="-
[ if demoNr > 1
[ demoNr=demoNr-1
ListBoxSetSelections mylistbox (list demoNr-1)
throw "nextDemo
]
]
if ch=="
[ slowdown=true
]
if ch=="r
[ rfactor=rfactor/drfactor
throw "nextDemo
]
if ch=="R
[ rfactor=rfactor*drfactor
throw "nextDemo
]
if ch=="t
[ if transparency >= 0.05
[ transparency=transparency-0.05
]
throw "nextDemo
]
if ch=="T
[ if transparency <= 1-0.05
[ transparency=transparency+0.05
]
throw "nextDemo
]
]
]
yield
if broken [stop]
]
end
end