aUCBLogo Demos and Tests / molecules3d
be molecules3d
max_ = 1000
min_ = 1
maxb = 6
dopt = 25
dbind = trunc 2*dopt
ffein = 100
Temperature=300
cfein = 160000/Temperature
dopf = dopt*ffein
maxf = ffein*dbind
tE = 1.1
anfE = 0.4
expo = 5
ep = 1
fac = 0.5
gravV=-0.01*fac
mov = 1*fac
vfac=100
cmin = 20
deltaTFac = 1.5
sqrDeltaTFac = deltaTFac*deltaTFac
radx=dopt/2
rady=dopt/2
radz=dopt/2
sizeX=2
sizeY=2
ox=FloatArray max_
oy=FloatArray max_
oz=FloatArray max_
c=IntArray max_
x=FloatArray max_
y=FloatArray max_
z=FloatArray max_
rx=IntArray max_
ry=IntArray max_
rz=IntArray max_
vx=FloatArray max_
vy=FloatArray max_
vz=FloatArray max_
ax=FloatArray max_
ay=FloatArray max_
az=FloatArray max_
banz=IntArray max_
b=Array max_
for [i 1 max_]
[ b.i=[]
]
f=(FloatArray maxf+1 0)
sizehx=Int 400/dopt+1
sizex=2*sizehx+1
sizehy=Int 300/dopt+1
sizey=2*sizehy+1
sizehz=Int 300/dopt+1
sizez=2*sizehz+1
m=(Array sizex -sizehx)
for [mi -sizehx sizehx]
[ mx=(Array sizey -sizehy)
for [mj -sizehy sizehy]
[ my=(Array sizez -sizehz)
for [mk -sizehz sizehz]
[ my.mk=[]
]
mx.mj=my
]
m.mi=mx
]
onePoint=true
gravity =true
tooSlow = false
tooFast = false
topteil = 0
disposalY= 0
col=[]
lineColor=RGB 1 0 1
eye=array 3
phi=0
theta=30
dtheta=5
center={0 0 0}
upvector={0 1 0}
dphi=10
ddphi=dphi/3
rotatescene_r=800
dr=1.1
setScreenColor 0
refresh
setUpdateGraph false
setPenSize [0 0]
hideTurtle
perspective
PenUp
be init
be initforcetable
; setItems 0 f (rSeqFA 1 0 int maxf/2)^2/2
; setItems int maxf/2 f (rSeqFA 0 1 int maxf/2)^2/100* -1
; stop
for [i 4 maxf]
[ f.i=fac*( -((i/dopf)^(-expo))+(i/dopf)^(-expo-ep))
]
for [i 0 3]
[ f.i=0
]
end
be cube side x_ y_ z_ angle v vangle
angle= angle
vangle=vangle
vx_=v*Cos vangle
vy_=v*Sin vangle
vxx= dopt*Cos angle
vxy= dopt*Sin angle
vyx= dopt*Sin angle
vyy=-dopt*Cos angle
kx=side/2+(mod trunc side/2 2)/2
ky=side/2*(Sqrt 3)/2
x_= x_-(vxx*kx+vyx*ky)
y_= y_-(vxy*kx+vyy*ky)
z_= z_-dopt
local [i]
i=1
for [yi 1 side]
[ for [xi 1 side]
[ for [zi 1 side]
[ kx=xi+(mod yi 2)/2-(mod zi 2)/2
ky=yi*(Sqrt 3)/2-(mod zi 2)*(Sqrt 3)/4
kz=zi
x.i= x_+vxx*kx+vyx*ky
y.i= y_+vxy*kx+vyy*ky
z.i= z_+dopt*kz
rx.i=round x.i/dopt
ry.i=round y.i/dopt
rz.i=round z.i/dopt
vx.i=vx_
vy.i=vy_
vz.i=0
banz.i=0
ifElse i <= max_
[ i=i+1
][ print [Too many parts!]
]
]
]
]
topteil=i
end
cube 10 0 0 0 30 0 90
topteil=topteil-1
initforcetable
setXY 0 -270 setH 90
Label [[RETURN]=splines [+]=heat [-]=cool
[G]=gravity [other Key]=cS Mouse: L=pull R=del]
col=loadpalette "TEILE.PAL
end
be movethem
be faster
local [k]
for [k 1 topteil]
[ vx.k=vx.k*deltaTFac
vy.k=vy.k*deltaTFac
vz.k=vz.k*deltaTFac
]
for [k 0 maxf]
[ f.k=f.k*sqrDeltaTFac
]
gravV:= gravV*sqrDeltaTFac
end
be slower
local [k]
for [k 1 topteil]
[ vx.k=vx.k/deltaTFac
vy.k=vy.k/deltaTFac
vz.k=vz.k/deltaTFac
]
for [k 0 maxf]
[ f.k=f.k/sqrDeltaTFac
]
gravV:= gravV/sqrDeltaTFac
end
be preparevars
local [i]
if tooSlow [faster]
if tooFast [slower]
tooSlow=true
tooFast=false
for [i 1 topteil]
[ ax.i=0
ay.i=0
az.i=0
c.i=0
]
end
be energyloss
local [hx hy]
setPC RGB 1 1 1
Line List List x.i y.i List x.j y.j RGB 0 0 1
hx=(vx.i+vx.j)/2
hy=(vy.i+vy.j)/2
hz=(vz.i+vz.j)/2
if i >= min_
[ vx.i=hx
vy.i=hy
vz.i=hz
]
banz.i=banz.i+1
b.i=fput j b.i
vx.j=hx
vy.j=hy
vz.j=hz
banz.j=banz.j+1
b.j=fput i b.j
setPC 0
Line List List x.i y.i List x.j y.j RGB 0 0 1
end
be ionize
if member? j b.i
[ b.i=remove j b.i
banz.i=banz.i-1
b.j=remove i b.j
banz.j=banz.j-1
]
end
be draw i
setXYZ x.i y.i z.i
setPC BitXor col.(c.i+2) int 2130706432
; setPC col.(c.i+2)
Sphere dopt/4
setPC lineColor
PenDown
setXYZ x.i+vx.i*vfac y.i+vy.i*vfac z.i+vz.i*vfac
PenUp
end
be del i
setXYZ x.i y.i z.i
setPC 0
Sphere dopt/2
end
be unboundf i j
output not member? j b.i
end
local [i j bi di
d dx dy dz
fx fy f0 force _c nomml]
unbound=true
Tag "nomml
preparevars
for [i 1 topteil-1]
[ for [ix rx.i-1 rx.i+1]
[ for [iy ry.i-1 ry.i+1]
[ for [iz rz.i-1 rz.i+1]
[ l=m.ix.iy.iz
while [not empty? l]
[ j=first l
l=butFirst l
dx= x.i-x.j
if (abs dx) > dbind [continueLoop]
dy= y.i-y.j
if (abs dy) > dbind [continueLoop]
dz= z.i-z.j
if (abs dz) > dbind [continueLoop]
d= Sqrt (Sqr dx)+(Sqr dy)+(Sqr dz)
if d > dbind
[
ionize
]
if d < dbind
[ unbound=unboundf i j
if unbound
and2 (banz.i < maxb)
and2 (banz.j < maxb)
[ ;if not yet bound & free
if (abs d-dopt) < 0.01
[ ;and d around dopt
energyloss ;then "emitt a Photon"
]
]
]
if unbound and2 (d > dopt)
[
continueLoop
]
d=d*ffein
di=Int d
if di >= maxf-1 [di=maxf-1]
f0=f.di
force=f0 ;+(d-Int d)*(f.(di+1)-f0)
fx=dx*force
fy=dy*force
fz=dz*force
ax.i=ax.i+fx
ay.i=ay.i+fy
az.i=az.i+fz
]
]
]
]
]
for [i min_ topteil]
[ c.i=Int (sqrt (sqr ax.i)+(sqr ay.i)+(sqr az.i))*cfein
if c.i > 250
[
tooFast=true
tooSlow=false
goto "nomml
]
if c.i > cmin
[ tooSlow=false
]
]
cs
for [i 1 min_-1 1]
[ draw i
]
for [i min_ topteil]
[ vx.i=vx.i+ax.i
vy.i=vy.i+ay.i
vz.i=vz.i+az.i
if gravity
[ vy.i=vy.i+gravV
]
rxi=rx.i
ryi=ry.i
rzi=rz.i
m.rxi.ryi.rzi=remove i m.rxi.ryi.rzi
x.i=x.i+vx.i
y.i=y.i+vy.i
z.i=z.i+vz.i
if x.i < -400+radx or2 x.i > 400-radx
[ vx.i=-vx.i
x.i=x.i+vx.i
]
if y.i < -300+rady or2 y.i > 300-rady
[ vy.i=-vy.i
y.i=y.i+vy.i
]
if z.i < -300+radz or2 z.i > 300-radz
[ vz.i=-vz.i
z.i=z.i+vz.i
]
rx.i=round x.i/dopt
ry.i=round y.i/dopt
rz.i=round z.i/dopt
rxi=rx.i
ryi=ry.i
rzi=rz.i
m.rxi.ryi.rzi=fPut i m.rxi.ryi.rzi
ifElse onePoint
[ draw i
][ setPixelXYZ x.i y.i z.i c.i+1
]
]
end
be cooling
local [i]
for [i 1 topteil]
[ vx.i=vx.i/tE
vy.i=vy.i/tE
vz.i=vz.i/tE
]
end
be heating
local [i]
for [i 1 topteil]
[ vx.i=vx.i*tE
vy.i=vy.i*tE
vz.i=vz.i*tE
]
end
be findnearest hx hy
local [i j dmin d]
dmin=IntMax
for [i 1 topteil]
[ d=trunc Sqrt (Sqr hx-x.i)+(Sqr hy-y.i)
if d < dmin
[ dmin=d
j=i
]
]
output j
end
be showmark x y
setPC 12
setXY x y
circle dopt/4
setPixelXY x y 0
updateGraph
setPC 0
setXY x y
circle dopt/4
end
be mousepulling
mx=MouseX
my=MouseY
if not clicked
[ clicki=findnearest mx my
clicked=true
]
i=clicki
; showmark(ox,oy);
d=((Sqr mx-x)+Sqr my-y)^0.3
vx.i=0 ;(vx+mov*(mx-x)/d)/te
vy.i=0 ;(vy+mov*(my-y)/d)/te
x.i=x.i+mov*(mx-x.i)/d
y.i=y.i+mov*(my-y.i)/d
end
be mousespecials
local [i mx my]
mx=MouseX
my=MouseY
i=findnearest mx my
showmark ox.i oy.i
vx.i=0
vy.i=0
x.i=rx
y.i=ry+dopt*disposalY
disposalY= Mod (disposalY+1) 6
while [MouseButtons!=0]
[ dispatchMessages
]
end
init
setPixelXY rSeqFA -400 400 maxf+1 f*1000 15
;stop
t0=0
forever
[ eye.1=rotatescene_r*(cos theta)*sin phi
eye.2=rotatescene_r* sin theta
eye.3=rotatescene_r*(cos theta)*cos phi
setEye eye center upvector
setLightPos {1000 1000 1000}
ifelse not Key?
[ movethem
][ redraw
]
;updateVars
setXYZ -350 -250 0
setPC RGB 1 1 1
PenDown
setHeading 90
t=TimeMilli
Label list 1000/(t-t0) "fps
t0=TimeMilli
PenUp
updateGraph
dispatchMessages
if Key?
[ ch=lowerCase readChar
if ch==Char 27 [break]
if ch==Char 13 [onePoint=not onePoint]
if ch=="- [cooling]
if ch=="+ [heating]
if ch=="g [gravity=not gravity]
if ch==" [clearScreen]
if ch==char 255
[ ch=readCharExt
if ch==WXK_RIGHT [phi=phi+dphi]
if ch==WXK_LEFT [phi=phi-dphi]
if ch==WXK_UP [theta=theta+dtheta]
if ch==WXK_DOWN [theta=theta-dtheta]
if ch==WXK_PRIOR [rotatescene_r=rotatescene_r/dr]
if ch==WXK_NEXT [rotatescene_r=rotatescene_r*dr]
]
waitMS Int 1000/30
]
ifElse MouseButtons==1
[ mousepulling
][ ifElse MouseButtons==2
[ mousespecials
][ clicked=false
]
]
]
pr [End]
end