[source] 3d Particle Engine

[Catalyst]

Based on the 2d engine i posted not too long ago this one is 3d. The code is nearly the same as with the class interfaces, enjoy

heres the code:

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 class ParticleSysRec3D     export Init, resetX, resetY, resetZ, forceX, forceY, forceZ     var resetX, resetY, resetZ, forceX, forceY, forceZ : real     proc Init (rx, ry, rz, fx, fy, fz : real)         resetX := rx         resetY := ry         resetZ := rz         forceX := fx         forceY := fy         forceZ := fz     end Init end ParticleSysRec3D class Particle3D     import ParticleSysRec3D     export Init, DrawParticle, Run, LoadSystemVars, ReInit, GetLife     var x, y, z, xv, yv, zv, radius, mass, maxLife, life : real     var xD, yD, c : int     var picFlag : boolean := false     var pWidth, pHeight : int     var resetX, resetY, resetZ, forceX, forceY, forceZ, inter : real     var totalV, Vx, Vy, Vz : real     var Camx, Camy, Camz : real := maxx div 2     var CamzFrame : real := 0     function GetLife : real         result life     end GetLife     proc LoadSystemVars (s : ^ParticleSysRec3D)         resetX := s -> resetX         resetY := s -> resetX         resetZ := s -> resetZ         forceX := s -> forceX         forceY := s -> forceY         forceZ := s -> forceZ     end LoadSystemVars     proc Init (X, Y, Z, XV, YV, ZV, RAD, MASS, LIFE, MLIFE, INT : real, C : int, PIC : boolean)         x := X         y := Y         z := Z         xv := XV         yv := YV         zv := ZV         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, Z, XV, YV, ZV, LIFE, MLIFE : real)         x := X         y := Y         z := Z         xv := XV         yv := YV         zv := ZV         maxLife := MLIFE         life := LIFE     end ReInit     var hold : real     const a:=2     proc DrawParticle         if z < Camz then             xD := round ((CamzFrame - (z - (((z - Camz) / ((x - Camx) + 0.001)) * x))                 / ((z - Camz) / ((x - Camx) + 0.001))))             yD := round ((CamzFrame * ((y - Camy) / ((z - Camz) + 0.001))) + (y -                 (((y - Camy) / ((z - Camz) + 0.001)) * z)))             hold := ((Camx - x) ** 2 + (Camy - y) ** 2 + (Camz - z) ** 2) ** 0.5             drawfilloval (xD, yD, round (radius / hold * 640 / a), round (radius / hold * 640 / a), round (((life / maxLife) * 255) + 255))         end if     end DrawParticle     proc CalcVect         totalV := (xv ** 2 + yv ** 2 + zv ** 2) ** 0.5         Vx := xv / totalV         Vy := yv / totalV         Vz := zv / totalV     end CalcVect     proc ReCalcVect         xv := totalV * Vx         yv := totalV * Vy         zv := totalV * Vz     end ReCalcVect     proc Run         CalcVect         xv += forceX         yv += forceY         zv += forceZ         x += xv         y += yv         z += zv         life -= inter     end Run end Particle3D class ParticleSystem3D     import Particle3D, ParticleSysRec3D     export Default, InitSystem, InitVectRand, InitBaseVect, InitPosRand, Update, DrawSystem,         SetReset     var Default : ^ParticleSysRec3D     new Default     var maxParticles, LifeC : int := 2     var sourceX, sourceY, sourceZ, forceX, forceY, forceZ, maxLife, baseXv, baseYv, baseZv, baseXv0, baseYv0, baseZv0 : real     var rpRealModX, rpRealModY, rpRealModZ, rvMinX, rvMinY, rvMinZ, rvMaxX, rvMaxY, rvMaxZ, rvRealModX, rvRealModY, rvRealModZ, rpMinX, rpMinY, rpMinZ, rpMaxX, rpMaxY, rpMaxZ : real     var ParticleSys : flexible array 1 .. 1 of ^Particle3D     proc InitVectRand (rrmx, rrmy, rrmz, rminx, rmaxx, rminy, rmaxy, rminz, rmaxz : real)         rvRealModX := rrmx         rvRealModY := rrmy         rvRealModZ := rrmz         rvMinX := rminx         rvMaxX := rmaxx         rvMinY := rminy         rvMaxY := rmaxy         rvMinZ := rminz         rvMaxZ := rmaxz     end InitVectRand     proc InitPosRand (rrmx, rrmy, rrmz, rminx, rmaxx, rminy, rmaxy, rminz, rmaxz : real)         rpRealModX := rrmx         rpRealModY := rrmy         rpRealModZ := rrmz         rpMinX := rminx         rpMaxX := rmaxx         rpMinY := rminy         rpMaxY := rmaxy         rpMinZ := rminz         rpMaxZ := rmaxz     end InitPosRand     proc InitBaseVect (X, Y, Z : real)         baseXv := X         baseYv := Y         baseZv := Z     end InitBaseVect     proc InitSystem (maxP : int, sx, sy, sz, fx, fy, fz, mas, rad, mLife, Int : real, c : int, pf : boolean)         Default -> Init (sx, sy, sz, fx, fy, fz)         sourceX := sx         sourceY := sy         sourceZ := sz         forceX := fx         forceY := fy         forceZ := fz         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)))),                 ((sourceZ + ((Rand.Real * rpRealModZ)) * Rand.Int (round (rpMinZ), round (rpMaxZ)))),                 ((baseXv + ((Rand.Real * rvRealModX)) * Rand.Int (round (rvMinX), round (rvMaxX)))),                 ((baseYv + ((Rand.Real * rvRealModY)) * Rand.Int (round (rvMinY), round (rvMaxY)))),                 ((baseZv + ((Rand.Real * rvRealModZ)) * Rand.Int (round (rvMinZ), round (rvMaxZ)))),                 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)))),                     ((sourceZ + ((Rand.Real * rpRealModZ)) * Rand.Int (round (rpMinZ), round (rpMaxZ)))),                     ((baseXv + ((Rand.Real * rvRealModX)) * Rand.Int (round (rvMinX), round (rvMaxX)))),                     ((baseYv + ((Rand.Real * rvRealModY)) * Rand.Int (round (rvMinY), round (rvMaxY)))),                     ((baseZv + ((Rand.Real * rvRealModZ)) * Rand.Int (round (rvMinZ), round (rvMaxZ)))),                     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, Z : real)         sourceX := X         sourceY := Y         sourceZ := Z     end SetReset end ParticleSystem3D

And a demo of it in action

code:

View.Set ("graphics:640;640,position:300;300,offscreenonly,nobuttonbar") const mx := maxx div 2 const my := maxy div 2 var x, y, z, x0, y0 : int := mx AddGradient (9, 7, 28) AddGradient (12, 9, 100) AddGradient (14, 12, 118) AddGradient (0, 14, 10) var Spray : ^ParticleSystem3D new Spray var angle, angle2, sinC : real := 0 sinC := 0 Spray -> InitVectRand (1, 1, 1, -1, 1, 1, 1, -1, 1) Spray -> InitPosRand (1, 1, 1, -1, 1, -1, 1, -1, 1) Spray -> InitBaseVect (0, 0, 25) Spray -> InitSystem (500, maxx div 2, maxy div 2, -50, 0, 0, -1, 1, 1, 80, 1.5, 1, false) var Z0 : real := -50 var time1, time2, fram : int loop     clock (time1)     mousewhere (x, y, z)     Spray -> InitBaseVect (cosd (angle) * 5, 0, 25)  %sind (angle) * 5)     Spray -> SetReset (x0 + cosd (angle2) * 50, y0 + sind (angle2) * 50, Z0)     if z = 1 then         x0 := x         y0 := y     end if     sinC += 0.5     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     Spray -> Update     Spray -> DrawSystem     View.Update     drawfillbox (0, 0, maxx, maxy, 7)     clock (time2)     fram := 1000 div (time2 - time1)     locate (1, 1)     color (0)     colorback (7)     put "FPS: ", fram end loop

[Tony]

looks awesome +25Bits

Sorry if I'll be posting this message all over the forum for a little while. I'd just like people to submit their programs (even if just source code) as an attached file. Since I (and other mods) look over all the posts I'll probably end up download the above post (the whole program) 10+ times and thats where I think we loose a lot of our bandwidth. thx

[Catalyst]

i was going to do that but had no add attachment in tutorials/source

[Atma Weapon]

I sit in awe of this, this work is quite inspiring.

I never thought Turing could pull off such a sweet display of graphics...

[Tony]

yes... well... turing is not suppost to really. I think speed slows down exponensionally with addition of polygons, but Catalyst is indeed a geneous

[LovelyCrap]

Catalyst, your mad skillz both amaze and frighten me.

Kudos

[Mazer]

we all know that catalyst is 1337 and stuff, but more interesting is what the heck is up with this thread? maybe it's just me, but the formatting is all messed up. here's a screenshot to show what i'm talking about

[AsianSensation]

I noticed this too, well, this and a couple of other threads. Well, at least it's nothing serious. Actually, we could just always blame Dan if anything goes wrong

[Tony]

AsianSensation wrote:

always blame Dan if anything goes wrong

and that's exactly what we will do It's all Dan's fault

[Dan]

yep it is messed up, but it seems to only hapen in a few posts that where coverted from the compsci.ca V1 to V2. odd, if any one knows what is up with this and how to fix it plz let me know.

[Artimes]

Very nice, you gotta teach me some day your ways. I want to blow my programming teacher away!!

If you wana chat, my MSN is Sparx_26@hotmail.com

[Andy]

dont we all want to find a usb port on the back of catalyst's brain and dl his mad skillz?

[thoughtful]

AMEN!

[Dan]

well i tryed to put a firewire one in his ear but he did not like that

[BPhelmet]

that is beautiful