Here is a standard 2D particle system
If you have any questions on how to use it look at the demo or post the questions here
note: if the particle count goes too high it become very unsuable (i recommend <4000 particles total)
| code: | class ParticleSysRec
export Init, resetX, resetY, forceX, forceY
var resetX, resetY, forceX, forceY : real
proc Init (rx, ry, fx, fy : real)
resetX := rx
resetY := ry
forceX := fx
forceY := fy
end Init
end ParticleSysRec
class Particle
import ParticleSysRec
export Init, DrawParticle, Run, LoadSystemVars, ReInit, GetLife
var x, y, xv, yv, radius, mass, maxLife, life : real
var c : int
var picFlag : boolean := false
var pWidth, pHeight : int
var resetX, resetY, forceX, forceY, ixv, iyv, inter : real
function GetLife : real
result life
end GetLife
proc LoadSystemVars (s : ^ParticleSysRec)
resetX := s -> resetX
resetY := s -> resetX
forceX := s -> forceX
forceY := s -> forceY
end LoadSystemVars
proc Init (X, Y, XV, YV, RAD, MASS, LIFE, MLIFE, INT : real, C : int, PIC : boolean)
x := X
y := Y
xv := XV
yv := YV
radius := RAD
mass := MASS
life := LIFE
maxLife := MLIFE
c := C
inter := INT
picFlag := PIC
if picFlag then
pWidth := Pic.Width (c) div 2
pHeight := Pic.Height (c) div 2
end if
end Init
proc ReInit (X, Y, XV, YV, LIFE, MLIFE : real)
x := X
y := Y
xv := XV
yv := YV
maxLife := MLIFE
life := LIFE
end ReInit
proc DrawParticle
if picFlag then
Pic.Draw (c, round (x - pWidth), round (y - pHeight), picMerge)
else
if radius < 1 then
drawdot (round (x), round (y), round (((life / maxLife) * 255) + 255))
else
drawfilloval (round (x), round (y), round (radius), round (radius), round (((life / maxLife) * 255) + 255))
end if
end if
end DrawParticle
proc Run
xv += forceX
yv += forceY
x += xv
y += yv
life -= inter
end Run
end Particle
class ParticleSystem
import Particle, ParticleSysRec
export Default, InitSystem, InitVectRand, InitBaseVect, InitPosRand, Update, DrawSystem,
SetReset
var Default : ^ParticleSysRec
new Default
var maxParticles, LifeC : int := 2
var sourceX, sourceY, forceX, forceY, maxLife, baseXv, baseYv : real
var rpRealModX, rpRealModY, rvMinX, rvMinY, rvMaxX, rvMaxY, rvRealModX, rvRealModY, rpMinX, rpMinY, rpMaxX, rpMaxY : real
var ParticleSys : flexible array 1 .. 1 of ^Particle
proc InitVectRand (rrmx, rrmy, rminx, rmaxx, rminy, rmaxy : real)
rvRealModX := rrmx
rvRealModY := rrmy
rvMinX := rminx
rvMaxX := rmaxx
rvMinY := rminy
rvMaxY := rmaxy
end InitVectRand
proc InitPosRand (rrmx, rrmy, rminx, rmaxx, rminy, rmaxy : real)
rpRealModX := rrmx
rpRealModY := rrmy
rpMinX := rminx
rpMaxX := rmaxx
rpMinY := rminy
rpMaxY := rmaxy
end InitPosRand
proc InitBaseVect (X, Y : real)
baseXv := X
baseYv := Y
end InitBaseVect
proc InitSystem (maxP : int, sx, sy, fx, fy, mas, rad, mLife, Int : real,c:int, pf : boolean)
Default -> Init (sx, sy, fx, fy)
sourceX := sx
sourceY := sy
forceX := fx
forceY := fy
maxLife := mLife
maxParticles := maxP
new ParticleSys, maxParticles
for i : 1 .. maxParticles
new ParticleSys (i)
ParticleSys (i) -> LoadSystemVars (Default)
ParticleSys (i) -> Init (
((sourceX + ((Rand.Real * rpRealModX)) * Rand.Int (round (rpMinX), round (rpMaxX)))),
((sourceY + ((Rand.Real * rpRealModY)) * Rand.Int (round (rpMinY), round (rpMaxY)))),
((baseXv + ((Rand.Real * rvRealModX)) * Rand.Int (round (rvMinX), round (rvMaxX)))),
((baseYv + ((Rand.Real * rvRealModY)) * Rand.Int (round (rvMinY), round (rvMaxY)))),
rad, mas, maxLife - Rand.Int (0, maxLife div LifeC), mLife, Int, c, pf)
end for
end InitSystem
proc Update
for i : 1 .. maxParticles
ParticleSys (i) -> Run
if ParticleSys (i) -> GetLife <= 0 then
ParticleSys (i) -> ReInit (
((sourceX + ((Rand.Real * rpRealModX)) * Rand.Int (round (rpMinX), round (rpMaxX)))),
((sourceY + ((Rand.Real * rpRealModY)) * Rand.Int (round (rpMinY), round (rpMaxY)))),
((baseXv + ((Rand.Real * rvRealModX)) * Rand.Int (round (rvMinX), round (rvMaxX)))),
((baseYv + ((Rand.Real * rvRealModY)) * Rand.Int (round (rvMinY), round (rvMaxY)))),
maxLife - Rand.Int (0, maxLife div LifeC), maxLife)
end if
end for
end Update
proc DrawSystem
for i : 1 .. maxParticles
ParticleSys (i) -> DrawParticle
end for
end DrawSystem
proc SetReset (X, Y : real)
sourceX := X
sourceY := Y
end SetReset
end ParticleSystem |
Now heres a demo using it:
| code: | proc AddGradient (c1, c2, n : int)
var clr : int
var r1, g1, b1, r2, g2, b2, p, p0 : real
RGB.GetColor (c1, r1, g1, b1)
RGB.GetColor (c2, r2, g2, b2)
const a := 50
for i : 1 .. n
p := (i / n) * 100
p0 := 100 - p
clr := RGB.AddColor ((((r1 * p) + (r2 * p0)) / 2) / a, (((g1 * p) + (g2 * p0)) / 2) / a, (((b1 * p) + (b2 * p0)) / 2) / a)
end for
end AddGradient
View.Set ("graphics:640;640,position:300;300,offscreenonly,nobuttonbar")
AddGradient (9, 7, 28)
AddGradient (12, 9, 100)
AddGradient (14, 12, 118)
AddGradient (0, 14, 10)
var Spray : ^ParticleSystem
new Spray
var Spray2 : ^ParticleSystem
new Spray2
var x, y, z, x0, y0 : int := maxx div 2
var angle, angle2, sinC : real := 0
sinC := 0
angle2 := 0
Spray -> InitVectRand (1, 1, -1, 1, 1, 1)
Spray -> InitPosRand (1, 1, -1, 1, -1, 1)
Spray -> InitBaseVect (5, 5)
Spray -> InitSystem (1000, maxx div 2, maxy div 2, -0.15, -0.1, 1, 0, 80, 1.5,1,false)
Spray2 -> InitVectRand (1, 1, -1, 1, 1, 1)
Spray2 -> InitPosRand (1, 1, -1, 1, -1, 1)
Spray2 -> InitBaseVect (-5, -5)
Spray2 -> InitSystem (1000, maxx div 2, maxy div 2, 0.15, 0.1, 1, 0, 80, 1.5,1, false)
loop
sinC += 0.5
mousewhere (x, y, z)
Spray2 -> InitBaseVect (-cosd (angle) * 5, -sind (angle) * 5)
Spray -> InitBaseVect (cosd (angle) * 5, sind (angle) * 5)
Spray -> SetReset (x0 + cosd (angle2) * 50, y0 + sind (angle2) * 50)
Spray2 -> SetReset (x0 - cosd (angle2) * 50, y0 - sind (angle2) * 50)
if sind (sinC) * 10 < 0 then
angle -= sind (sinC) * 10
else
angle += sind (sinC) * 10
end if
if cosd (sinC) * 10 < 0 then
angle2 -= cosd (sinC) * 10
else
angle2 += cosd (sinC) * 10
end if
if z = 1 then
Spray -> SetReset (x + cosd (angle2) * 50, y + sind (angle2) * 50)
Spray2 -> SetReset (x - cosd (angle2) * 50, y - sind (angle2) * 50)
x0 := x
y0 := y
end if
Spray -> Update
Spray -> DrawSystem
Spray2 -> Update
Spray2 -> DrawSystem
View.Update
drawfillbox (0, 0, maxx, maxy, 7)
end loop |
|
