Particle Fountain

I know. I know. What's this obsession with particles you say? Particles are Cool.

Here is a modified Particle Fountain that was originally created by bplus...


xmax = 1200
ymax = 600
title$ = "Particle Fountain"
'
' Based on bplus's fountain
'
WindowOpen(1,title$,0,0,xmax,ymax,0)
CanvasOpen(1,xmax,ymax,0,0,xmax,ymax,0)

randomize(timer)

numParticles = 15000
lp = 0

Dim particleX[numParticles]
Dim particleY[numParticles]
Dim particleDX[numParticles]
Dim particleDY[numParticles]
Dim particleR[numParticles]
Dim particleC[numParticles]

'=======================================================
' X - Particle Xpos
' Y - Particle Ypos
' DX - Particle X velocity
' DY - Particle Y velocity
' R - Particle radius
' C - Particle colour
Sub Create(i)
particleX[i] = (xmax / 2) + (rand(20) - 10)
particleY[i] = ymax + rand(5)
particleDX[i] = (rand(200) / 100) - (rand(200) / 100)
particleDY[i] = -10
particleR[i] = rand(2) + 1
particleC[i] = rgb(rand(50) + 165, rand(5) + 165, 255)
End Sub
'=======================================================

' Initialise Particles
'
for i = 1 to numParticles
Create(i)
next


' Main loop
'
do
ClearCanvas

if lp < numParticles then
lp = lp + 1
end if

for i = 1 to lp
'
' Get the particle moving...
particleDY[i] = particleDY[i] + 0.1
particleX[i] = particleX[i] + particleDX[i]
particleY[i] = particleY[i] + particleDY[i]
'
' Particle off screen? Make a new particle...
if particleX[i] < 0 or particleX[i] > xmax then
Create(i)
end if
'
' Shall we "splash"?
if particleY[i] > ymax and particleDY[i] > 0 then
tmp = rand(800) / 1000
particleDY[i] = (particleDY[i] * -0.3) - tmp
particleY[i] = ymax - 2 + rand(4)
end if
'
' "Fill" the particle if radius is greater than 1 pixel
setColor(particleC[i])
if particleR[i] > 1 then
circleFill(particleX[i], particleY[i], particleR[i])
else
circle(particleX[i], particleY[i], particleR[i])
end if
next
Update()
loop until key(27) = 1