Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
Diffuse Limited Aggregation
| Uploader: |  psygate |
| Datum/Zeit: | 05.07.2006 15:09:55 |
'DLA - Diffuse Limited Aggregation
'Simulation by psygate
'Comments on my source will follow within the next days.
'05. July 2006
'use as you like
'just leave some credits ^_^
'
'To-Do:
'Let the user draw the Attraktor
'Color improvements (8 bits are very poor BUT enough!)
'hide mouse (DONE)
option explicit
randomize timer
type particle
x as double
y as double
dx as double
dy as double
ox as double
oy as double
end type
dim as uinteger num,xmax,ymax
print "Use current resolution? (1)"
input num
print
if num=1 then
screeninfo xmax,ymax
else
print "X-Screen-Width?"
input xmax
print
print "Y-Screen-Width?"
input ymax
print
end if
print "Number of particles?"
input num
dim as integer pointer ascreen,buffer
dim as integer a,b,p,q,g,t,s,win,ag
dim as string key
dim as particle dot(num)
screenres xmax,ymax,8,,1
setmouse xmax-1,ymax-1,0
new:
for a=0 to num
with dot(a)
.x=int(rnd*xmax)
.y=int(rnd*ymax)
.dx=rnd*(-1)^int(rnd*2)
.dy=rnd*(-1)^int(rnd*2)
end with
next
ascreen=imagecreate(xmax,ymax,0)
buffer=imagecreate(xmax,ymax,0)
q=int(rnd*5)+1
if q=1 then
circle ascreen,(xmax/2,ymax/2),ymax/2,3
elseif q=2 then
line ascreen,(xmax/3,ymax/2)-(xmax/3*2,ymax/2),3
elseif q=3 then
pset ascreen,(xmax/2,ymax/2),3
elseif q=4 then
line ascreen,(0,ymax-1)-(xmax-1,ymax-1),3
elseif q=5 then
pset ascreen,(xmax/3,ymax/2),3
pset ascreen,(xmax/3*2,ymax/2),3
end if
put (0,0),ascreen,pset
while key<>chr(27)
screenlock
put (0,0),ascreen,pset
for a=0 to num
with dot(a)
.x+=.dx
.y+=.dy
if .x>=xmax-1 and .dx>0 then .x=xmax-1:.dx-=1
if .x<=0 and .dx<0 then .x=0:.dx+=1
if .y>=ymax-1 and .dy>0 then .y=ymax-1:.dy-=1
if .y<=0 and .dy<0 then .y=0:.dy+=1
if point(.x-1,.y,ascreen)=3 or point(.x,.y,ascreen)=3 or point(.x+1,.y,ascreen)=3 or _
point(.x-1,.y-1,ascreen)=3 or point(.x,.y-1,ascreen)=3 or point(.x+1,.y-1,ascreen)=3 or _
point(.x-1,.y+1,ascreen)=3 or point(.x,.y+1,ascreen)=3 or point(.x+1,.y+1,ascreen)=3 then
pset ascreen,(.x,.y),3
.x=int(rnd*xmax)
.y=int(rnd*ymax)
.dx=rnd*(-1)^int(rnd*2)
.dy=rnd*(-1)^int(rnd*2)
g+=1
end if
pset(.x,.y),1
end with
next
if ag=1 then locate 1,1:print "Aggregated Particles:";g
screenunlock
key=inkey$
if key="n" then goto new
if key="s" then bsave "C:\DLA_"+str(s)+".bmp",0:s+=1
if key="a" then
if ag=1 then ag=0
if ag=0 then ag=1
end if
if key="w" then
if win=0 then
put screenptr,(0,0),buffer,pset
screenres xmax,ymax,8,,
put (0,0),buffer,pset
win=1
elseif win=1 then
put screenptr,(0,0),buffer,pset
screenres xmax,ymax,8,,1
put (0,0),buffer,pset
win=0
end if
end if
if key<>chr(27) and key<>"n" and key<>"s" and key<>"a" and key<>"w" and key<>"" or key="h" then
put screenptr,(0,0),buffer,pset
cls
locate 1,1
print "HELP-LINES:"
print "------------"
print
print "Key | Effect"
print "-----------------------------------------------------------"
print " a | Show/Don't show number of aggregated particles"
print " n | Start new aggregation (Change Attraktor by luck)"
print " s | Save a picture (.bmp) of current state of aggregation"
print " w | Change between window or full-window mode"
print
print
print "Please use lowercase characters! If you don't use them"
print "you'll just get here into the help menu ;-)"
print
print "-----------------------------------------------------------"
print "About (Scientific Background):"
print "------------------------------"
print "This program was written by psygate to simulate the aggregation of "
print "Many attractive images and life-like structures can be generated"
print "using models of physical processes from areas of chemistry and physics."
print "One such example is diffusion limited aggregation or DLA which describes,"
print "among other things, the diffusion and aggregation of zinc ions in an"
print "electrolytic solution onto electrodes. 'Diffusion' because the particles"
print "forming the structure wander around randomly before attaching themselves"
print "('Aggregating') to the structure."
print "Source: http://astronomy.swin.edu.au/~pbourke/fractals/dla/"v
print
getkey
cls
put (0,0),buffer,pset
key=""
end if
wend
end