aUCBLogo Demos and Tests / molecules3


be molecules3
   
max_   =   400
   
min_   =   1
   
maxb   =   6

   
dopt   =   25
   
dbind   =   trunc 2*dopt

   
ffein   =   100
   
Temperature=300
   
cfein   =   160000/Temperature
;   dopf   =   dopt*ffein
   
dopf   =   dopt*ffein*0.7      ;calibration
   
dopf2   =   dopt*ffein*1.2
   
maxf   =   ffein*dbind

   
tE      =   1.1
   
anfE   =   0.4

   
expo   =   5
   
ep      =   1
   
ep2      =   0.2

   
fac   =   0.25   ;0.5
   
fac2=   fac*0.1
   
gravV=-0.01*fac
   
mov   =   10*fac
   
vfac=100

   
cmin   =   20
   
deltaTFac   =   1.5
   
sqrDeltaTFac   =   deltaTFac ;*deltaTFac

   
radx=4
   
rady=3

   
ox=FloatArray max_
   
oy=FloatArray max_
   
c=IntArray max_
   
x=FloatArray max_
   
y=FloatArray max_
   
rx=IntArray max_
   
ry=IntArray max_
   
vx=FloatArray max_
   
vy=FloatArray max_
   
ax=FloatArray max_
   
ay=FloatArray max_
   
banz=IntArray max_
   
b=Array max_
   
for [max_]
   
[   b.i=[]
   
]
   
   
f=(FloatArray maxf+1 0)
   
f2=(FloatArray maxf+1 0)
   
   
sizehx=Int 400/dopt+1
   
sizex=2*sizehx+1
   
sizehy=Int 300/dopt+1
   
sizey=2*sizehy+1
   
m=(Array sizex -sizehx)
   
for [mi -sizehx sizehx]
   
[   mx=(Array  sizey -sizehy)
      
for [mj -sizehy sizehy]
      
[   mx.mj=[]
      
]
      
m.mi=mx
   
]

   
onePoint=true
   
gravity   =false

   
tooSlow   false
   
tooFast   false

   
topteil 0
   
disposalY=   0

   
col=[]
   
lineColor=RGB 1 0 1
   
bindColor=RGB 1 1 1
   
setScreenColor 0
   
norefresh
   
setUpdateGraph false
   
disableRoundLineEnds
   
setPenSize [0 0]
   
hideTurtle
   
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 [maxf]
         
[   f.i=fac*( -((i/dopf)^(-expo))+(i/dopf)^(-expo-ep))
         
]
         
for [0 3]
         
[   f.i=0
         
]

         
for [maxf]
         
[   f2.i=fac2*( -((i/dopf2)^(-expo))+(i/dopf2)^(-expo-ep2))
         
]
         
for [0 3]
         
[   f2.i=0
         
]
      
end
   
      
be square side x_ y_ angle v vangle
          
angleangle
         
vangle=vangle

         
vx_=v*Cos vangle
         
vy_=v*Sin vangle

         
vxxdopt*Cos angle 
         
vxydopt*Sin angle
         
vyxdopt*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)

         
local [i]
         
i=1
         
for [yi side]
         
[   for [xi side]
            
[   kx=xi+(mod yi 2)/2
               
ky=yi*(Sqrt 3)/2
               
x.ix_+vxx*kx+vyx*ky
               
y.iy_+vxy*kx+vyy*ky
               
rx.i=round x.i/dopt
               
ry.i=round y.i/dopt
               
vx.i=vx_
               
vy.i=vy_
               
banz.i=0
               
ifElse <= max_
               
[   i=i+1
               
][   print [Too many parts!]
               
]
            
]
         
]
         
topteil=i
      
end
   
      
square 10 0 0 30 0 90
      
topteil=topteil-1
   
      
initforcetable
   
      
setXY -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 [topteil]
         
[   vx.k=vx.k*deltaTFac
            
vy.k=vy.k*deltaTFac
         
]
         
for [maxf]
         
[   f.k=f.k*sqrDeltaTFac
            
f2.k=f2.k*sqrDeltaTFac
         
]
         
gravV:gravV*sqrDeltaTFac
      
end
   
      
be slower
         
local [k]
         
for [topteil]
         
[   vx.k=vx.k/deltaTFac
            
vy.k=vy.k/deltaTFac
         
]
         
for [maxf]
         
[   f.k=f.k/sqrDeltaTFac
            
f2.k=f2.k/sqrDeltaTFac
         
]
         
gravV:gravV/sqrDeltaTFac
      
end

      
be preparevars
         
local [i]
         
if tooSlow [faster]
         
if tooFast [slower]
   
         
tooSlow=true
         
tooFast=false
   
         
for [topteil]
         
[   ax.i=0
            
ay.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.RGB 0 0 1
         
hx=(vx.i+vx.j)/2
         
hy=(vy.i+vy.j)/2
   
         
if >= min_
         
[   vx.i=hx
            
vy.i=hy
         
]
         
banz.i=banz.i+1
         
b.i=fput j b.i
         
vx.j=hx
         
vy.j=hy
         
banz.j=banz.j+1
         
b.j=fput i b.j
   
         
setPC 0
         
Line List List x.i y.i  List x.j y.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
(pr "i i j)
         
]
      
end
   
      
be draw i
         
setXY x.i y.i
         
setFC col.(c.i+2)
         
fillCircle dopt/4
         
PenDown
         
Line List 
            
List x.i y.i 
            
List x.i+vx.i*vfac y.i+vy.i*vfac lineColor
         
PenUp
      
end
   
      
be del x y
         
setXY x y
         
setFC 0
      
;   fillCircle dopt/2
      
end
   
      
be unboundf i j
         
output not member? j b.i
      
end
   
      
local [i j bi di
         
d dx dy
         
fx fy f0 force _c nomml]

      
unbound_=true
      
tag "nomml
      
preparevars
      
for [topteil]
      
[   for [ix rx.i-rx.i+1]
         
[   for [iy ry.i-ry.i+1]
            
[   l=m.ix.iy
               
while [not empty? l]
               
[   j=first l
                  
l=butFirst l
                  
dxx.i-x.j
               
;   if (abs dx) > dbind [continueLoop]
                  
dyy.i-y.j
               
;   if (abs dy) > dbind [continueLoop]
                  
dSqrt (Sqr dx)+(Sqr dy)
   
                  
if dopt*1.3
                  
[
                     
ionize
                  
]
                  
if dopt*1.1
                  
[
                     
unbound=unboundf i j
                     
if unbound 
                     
and2 (banz.maxb) 
                     
and2 (banz.maxb)
                     
[   ;if not yet bound & free
                        
if (abs d-dopt)/dopt 0.5
                        
[   ;and d around dopt
                           
energyloss   ;then "emitt a Photon"
(pr "e i j)
                        
]
                     
]   
                  
]
                  
if dbind
                  
[
                     
continueLoop
                  
]
                  
d=d*ffein
                  
di=Int d
                  
if di >= maxf-[di=maxf-1]
                  
ifelse unbound
                  
[   f0=f2.di
                  
][   f0=f.di
                  
]                  
                  
force=f0 ;+(d-Int d)*(f.(di+1)-f0)

                  
fx=dx*force
                  
fy=dy*force
                  
ax.i=ax.i+fx
                  
ay.i=ay.i+fy
;                  ax.j=ax.j-fx
;                  ay.j=ay.j-fy
               
]
            
]
         
]
      
]

      
for [i min_ topteil]
      
[   c.i=Int (sqrt (sqr ax.i)+(sqr ay.i))*cfein
         
if c.250 
         
[
            
tooFast=true
            
tooSlow=false
            
goto "nomml
         
]
         
if c.cmin
         
[   tooSlow=false
         
]
      
]
      
clearScreen
      
for [min_-1 1]
      
[   draw i
      
]   
      
for [i min_ topteil]
      
[   vx.i=vx.i+ax.i
         
vy.i=vy.i+ay.i
   
         
if gravity
         
[   vy.i=vy.i+gravV
         
]
         
rxi=rx.i
         
ryi=ry.i
         
m.rxi.ryi=remove i m.rxi.ryi
         
x.i=x.i+vx.i
         
y.i=y.i+vy.i
   
         
if x.< -400+radx or2 x.400-radx
         
[   vx.i=-vx.i
            
x.i=x.i+vx.i
         
]
         
if y.< -300+rady or2 y.300-rady
         
[   vy.i=-vy.i
            
y.i=y.i+vy.i
         
]
         
rx.i=round x.i/dopt
         
ry.i=round y.i/dopt
         
rxi=rx.i
         
ryi=ry.i
         
m.rxi.ryi=fPut i m.rxi.ryi
         
         
ifElse onePoint
         
[   draw i
            
l=b.i
            
while [not empty? l]
            
[   j=first l
               
l=butFirst l
               
if 0
               
[   setXY 
                     
x.i 
                     
y.i 
                  
setPC bindColor
                  
PenDown
                  
setXY 
                     
x.j 
                     
y.j 
                  
PenUp
               
]
            
]
         
][   setPixelXY x.i y.i c.i+1
         
]
      
]
   
end

   
be cooling
      
local [i]
      
for [topteil]
      
[   vx.i=vx.i/tE
         
vy.i=vy.i/tE
      
]
   
end
   
   
be heating
      
local [i]
      
for [topteil]
      
[   vx.i=vx.i*tE
         
vy.i=vy.i*tE
      
]
   
end
   
   
be findnearest hx hy
      
local [i j dmin d]
      
dmin=IntMax
      
for [topteil]
      
[   d=trunc Sqrt (Sqr hx-x.i)+(Sqr hy-y.i)
         
if 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=;(vx+mov*(mx-x)/d)/te
      
vy.i=;(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=radx
      
y.i=rady+dopt*disposalY
      
disposalYMod (disposalY+16
      
while [MouseButtons!=0]
      
[   dispatchMessages
      
]
   
end


   
init
   
setPixelXY rSeqFA -400 400 maxf+1  f*1000 15
   
setPixelXY rSeqFA -400 400 maxf+1  f2*1000 4
;stop
   
forever
   
[   movethem
;updateVars
      
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]
      
]
      
ifElse MouseButtons==1 
      
[   mousepulling
      
][   ifElse MouseButtons==2 
         
[   mousespecials
         
][   clicked=false
         
]
      
]
   
]
   
pr [End]
end