aUCBLogo Demos and Tests / create_organic_molecules
setCaseIgnored false
to create_organic_molecules
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.2
drfactor=1.02
rrandom=1
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
myframe=(Frame [][ChemFrame]
wxdefault_frame_style+wxstay_on_top+wxframe_tool_window
[0 650][200 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
])
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
transparency=0
comment[ sltrans=(Slider myframe [Transparency]
0 Int transparency*100 100
[ transparency=SliderValue/100
broken=true
] wxhorizontal)
]
slrfactor=(Slider myframe [R factor]
0 Int rfactor*100 100
[ rfactor=SliderValue/100
broken=true
] wxhorizontal)
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 bshowTensor 100 wxexpand 0
BoxSizerAdd bsv bshowBox 100 wxexpand 0
BoxSizerAdd bsv bshowAxes 100 wxexpand 0
BoxSizerAdd bsv bshowGrid 100 wxexpand 0
; BoxSizerAdd bsv sltrans 300 wxexpand 0
BoxSizerAdd bsv bshadows 100 wxexpand 0
BoxSizerAdd bsv slrfactor 100 wxexpand 0
BoxSizerAdd bsv bquit 100 wxexpand 0
BoxSizerAdd bsh bsv 100 wxexpand 0
FrameSetSizer myframe bsh
FrameSetClientSize myframe 200 300
foreach molnames
[ ListBoxAppend mylistbox ?
]
ConsoleSetFocus
demoNr=1
odemoNr=0
running=true
broken=false
catch "stopping
[ while [running]
[ ready=false
catch "nextDemo
[ clearScreen
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
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
computeChargeCenters qs ps
drawDipol
if showTensor
[ computeMassCenter ms ps
computeInertialTensor ms ps
m=toMatrix I_tensor
I_eigenvecs=Array Eigenvectors m
v=Array Eigenvalues m
v=FloatArray Array (list v.(1).1 v.(2).2 v.(3).3)
I_eigenvals=v
drawMassCenter
]
if shadows [castShadows]
broken=false
ready=true
rotatescene3
]
]
]
setUpdateGraph true
FrameDestroy myframe
updateGraph
end
to 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
end
to store
p0=PosXYZ
o0=Orientation
end
to restore
PenUp setPosXYZ p0 setOrientation o0
if not penAlwaysUp [PenDown]
end
to 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
to 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
to 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
to 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
to 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
to 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
to delta i j
ifelse i==j [output 1][output 0]
end
to 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.l.k=I.l.k-m*r.k*r.l
]
I.k.k=I.k.k+m*(0+r*r)
]
]
I_tensor=I
end
to drawMassCenter
; local [evals evecs]
evecs=I_eigenvecs*200
evals=(I_eigenvals/(Norm I_eigenvals))+0.01
setPenColor "lightgreen
; Arrow pmass pmass+evecs.1
; Arrow pmass pmass+evecs.2
; Arrow pmass pmass+evecs.3
PenUp Home PenDown setPosXYZ evecs.1
PenUp Home PenDown setPosXYZ evecs.2
PenUp Home PenDown setPosXYZ evecs.3
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
setOrientation towardsXYZ pmass+I_eigenvecs.1
PenDown
setPenColor HSBA 120 0.6 0.2 0.5
; Home
; setPosXYZ pmass
; disableDepthTest
; (Ellipsoid 100/evals.1 100/evals.2 100/evals.3)
; enableDepthTest
end
to 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
end
to drawDipol
setPenColor "lightblue
if (Norm pplus-pminus) > 1
[ Arrow pminus pplus
Wire pminus pplus
]
PenDown
end
to 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
to 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=2000
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
to 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
to 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=0
dphi=1
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
Home
down 90
center=FloatArray PosXYZ
ori=Orientation
]
comment
[ mouseActive=false
dispatchMessages
OnMouseLeftDown
[ if not mouseActive
[ p0=MousePos
phi0=phi
theta0=theta
mouseActive=true
]
]
OnMouseMotion
[ if mouseActive
[ mp=MousePos-p0
x= ((mp.1*(cos phi)-mp.3*sin phi)*cos theta)
+(mp.1*(cos phi)-mp.2*sin phi)*sin theta
y=mp.2
theta=theta0-y/5
phi=phi0-x/5
]
]
OnMouseLeftUp
[ mp=MousePos-p0
x= ((mp.1*(cos phi)-mp.3*sin phi)*cos theta)
+(mp.1*(cos phi)-mp.2*sin phi)*sin theta
y=mp.2
theta=theta0-y/5
phi=phi0-x/5
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
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