----------------------------------- PaddyLong Mon Dec 08, 2003 1:53 am my particle engine ----------------------------------- k so here's my particle engine... I had written this back in the summer or something, but I decided to work on it again for some reason and made it better. it's object oriented and stuff so it's pretty easy to use. also the direction the system moves is based on the angle range you set (or to have it not move, set velocity to 0 obviously :P) any way, here it is.... /******************************************************************* Particle Engine by Paddy Long Written Summer 2003 - Revised Winter 2003 Requirements var colrs : flexible array 0 .. 0 of int --before using colrs must set size to maximum life new colrs, highLife --colrs must be turned into gradient array... Gradient.make (colrs, colour1, colour2, highLife) particleSystem -> make (x, y, howMany, Velocity, lowLife, highLife, lowAngle, highAngle, lowVelocity, highVelocity : int, newColours : array 1 .. * of string) parameters x - starting x location of system y - starting y location of system howMany - how many particles Velocity - the speed the system moves lowLife - the minimum life of individual particles highLife - the maximum life of individual particles lowAngle - the angle of individual particles from the system's angle of movement highAngle - the angle of individual particles from the system's angle of movement lowVelocity - the minimum speed of individual particles highVelocity - the maximum speed of individual newColours - an array of any size (lower bound of 1) of RGB colour strings in format "RRR,GGG,BBB" (numbers don't have to be 3 digits) *******************************************************************/ class particle export make, update var loc : array 1 .. 2 of int var age, lifeSpan, angle, velocity : int var colrs : flexible array 0 .. 0 of int function random (value1, value2 : int) : int if value2 > value1 then result Rand.Int (value1, value2) else result Rand.Int (value2, value1) end if end random procedure stringRGB2realRGB (stringRGB : string, var realRGB : array 1 .. 3 of real) var RGBstring : string := "" var RGBselect : int := 1 for q : 1 .. length (stringRGB) if stringRGB (q) not= "," then RGBstring += stringRGB (q) elsif stringRGB (q) = "," then realRGB (RGBselect) := strreal (RGBstring) / 255 RGBselect += 1 RGBstring := "" end if end for realRGB (RGBselect) := strreal (RGBstring) / 255 end stringRGB2realRGB procedure makeGradient (var colrs : array 0 .. * of int, colours : array 1 .. * of string) type real3array : array 1 .. 3 of real var colrsPer : int := ceil (upper (colrs) / (upper (colours) - 1)) var numGrads : int := upper (colours) - 1 var rColours : array 1 .. upper (colours) of real3array var increments : array 1 .. numGrads, 1 .. 3 of real var colrArrays : array 1 .. numGrads, 1 .. colrsPer of int var currColr : real3array var currColrCount : int := 0 for q : 1 .. upper (colours) stringRGB2realRGB (colours (q), rColours (q)) end for for q : 1 .. numGrads for w : 1 .. 3 increments (q, w) := (rColours (q + 1) (w) - rColours (q) (w)) / colrsPer end for for w : 1 .. colrsPer for e : 1 .. 3 currColr (e) := rColours (q) (e) + (increments (q, e) * w) end for colrArrays (q, w) := RGB.AddColor (currColr (1), currColr (2), currColr (3)) end for end for for q : 1 .. numGrads for w : 1 .. colrsPer exit when currColrCount > upper (colrs) colrs (currColrCount) := colrArrays (q, w) currColrCount += 1 end for exit when currColrCount > upper (colrs) end for for q : 256 .. upper (colrs) by 256 colrs (q) := colrs (q - 1) end for colrs (0) := RGB.AddColor (rColours (1) (1), rColours (1) (2), rColours (1) (3)) colrs (upper (colrs)) := RGB.AddColor (rColours (upper (rColours)) (1), rColours (upper (rColours)) (2), rColours (upper (rColours)) (3)) end makeGradient procedure make (orig, lifeRange, angleRange, velocityRange : array 1 .. 2 of int, colours : array 1 .. * of string) angle := random (angleRange (1), angleRange (2)) velocity := random (velocityRange (1), velocityRange (2)) lifeSpan := random (lifeRange (1), lifeRange (2)) age := 0 new colrs, lifeSpan makeGradient (colrs, colours) loc (1) := orig (1) loc (2) := orig (2) drawdot (loc (1), loc (2), colrs (age)) end make procedure update (orig, lifeRange, angleRange, velocityRange : array 1 .. 2 of int, colours : array 1 .. * of string) drawdot (loc (1), loc (2), whatcolourback) if age < lifeSpan then loc (1) += round (velocity * cosd (angle)) loc (2) += round (velocity * sind (angle)) drawdot (loc (1), loc (2), colrs (age)) age += 1 else make (orig, lifeRange, angleRange, velocityRange, colours) end if end update end particle class particleSystem import particle export make, start, stop, getAngleRange, setAngleRange, getVelRange, setVelRange, getLifeRange, setLifeRange, getOrig, setOrig, getVelocity, setVelocity, setColours var orig, angleRange, velRange, lifeRange : array 1 .. 2 of int var particles : flexible array 1 .. 1 of ^particle var partCount, velocity : int var colours : flexible array 1 .. 1 of string var going : boolean function random (value1, value2 : int) : int if value2 > value1 then result Rand.Int (value1, value2) else result Rand.Int (value2, value1) end if end random procedure make (x, y, howMany, Velocity, lowLife, highLife, lowAngle, highAngle, lowVelocity, highVelocity : int, newColours : array 1 .. * of string) var currAngle, currVel : int orig (1) := x orig (2) := y partCount := howMany velocity := Velocity angleRange (1) := lowAngle angleRange (2) := highAngle velRange (1) := lowVelocity velRange (2) := highVelocity lifeRange (1) := lowLife lifeRange (2) := highLife new colours, upper (newColours) for q : 1 .. upper (newColours) colours (q) := newColours (q) end for new particles, howMany for q : 1 .. howMany new particles (q) particles (q) -> make (orig, lifeRange, angleRange, velRange, colours) end for end make function getAngleRange : array 1 .. 2 of int result angleRange end getAngleRange procedure setAngleRange (newLow, newHigh : int) angleRange (1) := newLow angleRange (2) := newHigh end setAngleRange function getVelRange : array 1 .. 2 of int result velRange end getVelRange procedure setVelRange (newLow, newHigh : int) velRange (1) := newLow velRange (1) := newHigh end setVelRange function getLifeRange : array 1 .. 2 of int result lifeRange end getLifeRange procedure setLifeRange (newLow, newHigh : int) lifeRange (1) := newLow lifeRange (2) := newHigh end setLifeRange function getOrig : array 1 .. 2 of int result orig end getOrig procedure setOrig (newX, newY : int) orig (1) := newX orig (2) := newY end setOrig function getVelocity : int result velocity end getVelocity procedure setVelocity (newVel : int) velocity := newVel end setVelocity procedure setColours (newColours : array 1 .. * of string) new colours, upper (newColours) for q : 1 .. upper (newColours) colours (q) := newColours (q) end for end setColours process go var currAngle, currVel : int loop currAngle := (angleRange (1) + angleRange (2)) div 2 orig (1) -= round (cosd (currAngle)) * velocity orig (2) -= round (sind (currAngle)) * velocity if orig (1) >= maxx then orig (1) := maxx elsif orig (1) = maxy then orig (2) := maxy elsif orig (2) update (orig, lifeRange, angleRange, velRange, colours) end for View.Update exit when going = false delay (25) end loop end go procedure start going := true fork go end start procedure stop going := false end stop end particleSystem ...and a demo program... in this demo the system moves towards the mouse cursor. when you click the mouse, the system changes colour and size (particle life...) var window : int := Window.Open ("graphics:1000;1000,title:Particle Engine by Paddy Long - 2003,offscreenonly") var debug : boolean := true color (0) colorback (7) cls var mx, my, button, clickCount : int var pSys : ^particleSystem var x, y, howMany, Velocity, lowLife, highLife, lowAngle, highAngle, lowVelocity, highVelocity : int var colours : flexible array 1 .. 2 of string x := maxx div 2 y := maxy div 2 howMany := 500 Velocity := 2 lowLife := 10 highLife := 20 lowAngle := 1 highAngle := 45 lowVelocity := 5 highVelocity := 10 colours (1) := "255,255,255" colours (2) := "0,0,0" clickCount := 0 procedure goTo (x, y : int) var angle : int if x > pSys -> getOrig () (1) then angle := 180 + round (arctand ((y - pSys -> getOrig () (2)) / (x - pSys -> getOrig () (1)))) elsif x < pSys -> getOrig () (1) then angle := round (arctand ((y - pSys -> getOrig () (2)) / (x - pSys -> getOrig () (1)))) elsif x = pSys -> getOrig () (1) or y = pSys -> getOrig () (2) then angle := 0 end if pSys -> setAngleRange (angle - 10, angle + 10) end goTo new pSys pSys -> make (x, y, howMany, Velocity, lowLife, highLife, lowAngle, highAngle, lowVelocity, highVelocity, colours) pSys -> start loop Mouse.Where (mx, my, button) if debug = true then locate (1, 1) put intstr (mx) + "/" + intstr (my) + "/" + intstr (button) + "//" + intstr (clickCount) end if goTo (mx, my) if button = 1 then clickCount += 1 if clickCount = 1 then new colours, 3 colours (1) := "255,0,0" colours (2) := "255,255,255" colours (3) := "0,0,0" pSys -> setLifeRange (20, 30) elsif clickCount = 2 then new colours, 4 colours (1) := "0,255,0" colours (2) := "255,0,0" colours (3) := "255,255,255" colours (4) := "0,0,0" pSys -> setLifeRange (30, 40) elsif clickCount = 3 then new colours, 5 colours (1) := "0,0,255" colours (2) := "0,255,0" colours (3) := "255,0,0" colours (4) := "255,255,255" colours (5) := "0,0,0" pSys -> setLifeRange (40, 50) elsif clickCount = 4 then new colours, 2 colours (1) := "255,255,255" colours (2) := "0,0,0" clickCount := 0 pSys -> setLifeRange (10, 20) end if pSys -> setColours (colours) end if delay (100) end loop