aUCBLogo Demos and Tests / molecules



be molecules
   
max_   =   100
   
min_   =   1
   
maxb   =   6

   
dopt   =   25
   
dbind   =   trunc 2*dopt

   
ffein   =   100
   
Temperature=300
   
cfein   =   80000/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   =   10*fac
   
vfac=100

   
cmin   =   20
   
deltaTFac   =   1.5
   
sqrDeltaTFac   =   deltaTFac*deltaTFac

   
rx=4
   
ry=3

   
sizeX=2
   
sizeY=2

   
ox=FloatArray max_
   
oy=FloatArray max_
   
c=IntArray max_
   
x=FloatArray max_
   
y=FloatArray 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)

   
onePoint=true
   
gravity   =false

   
tooSlow   false
   
tooFast   false

   
topteil 0
   
disposalY=   0

   
col=[]
   
lineColor=RGB 1 0 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
         
]
      
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
               
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
         
]
         
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
         
]
         
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
         
]
      
end
   
      
be draw i
         
setXY x.i y.i
         
setFC col.(c.i+2)
         
fillCircle dopt/2
         
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]

      
unboundv=true
      
tag "nomml
         
preparevars
         
for [topteil-1]
         
[   for [j topteil i+1]
            
[   dxx.i-x.j
               
if (abs dx) > dbind [continueLoop]
               
dyy.i-y.j
               
if (abs dy) > dbind [continueLoop]
               
dSqrt (Sqr dx)+(Sqr dy)

               
if dbind
               
[
                  
ionize
               
]
               
if dbind
               
[   unboundv=unboundf i j
                  
if unboundv 
                  
and2 (banz.maxb) 
                  
and2 (banz.maxb)
                  
[   ;if not yet bound & free
                     
if (abs d-dopt) < 0.01
                     
[   ;and d around dopt
                        
energyloss   ;then "emitt a Photon"
                     
]
                  
]   
               
]
               
if unboundv and2 (dopt)
               
[
                  
continueLoop
               
]
               
d=d*ffein
               
di=Int d
               
if di >= maxf-[di=maxf-1]
               
f0=f.di
               
force=f0 ;+(d-Int d)*(f.(di+1)-f0)
ignore[
               
_c=abs force*cfein
               
if _c 255 
               
[
                  
tooFast=true
                  
tooSlow=false
                  
goto "nomml
               
]
               
c.i=c.i+trunc _c
               
if c.250 [c.i=250]
]      
               
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
ignore[
               
c.j=c.j+trunc _c
               
if c.250 [c.j=250]
               
               
if tooSlow
               
[   if c.cmin
                  
[   tooSlow=false
                  
]
               
]
]
            
]
         
]

      
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
         
]
         
x.i=x.i+vx.i
         
y.i=y.i+vy.i
   
         
if x.< -400+rx or2 x.400-rx
         
[   vx.i=-vx.i
            
x.i=x.i+vx.i
         
]
         
if y.< -300+ry or2 y.300-ry
         
[   vy.i=-vy.i
            
y.i=y.i+vy.i
         
]
         
ifElse onePoint
         
[   draw i
         
][   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=rx
      
y.i=ry+dopt*disposalY
      
disposalYMod (disposalY+16
      
while [MouseButtons!=0]
      
[   dispatchMessages
      
]
   
end


   
init
   
setPixelXY rSeqFA -400 400 maxf+1  f*1000 15
;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