-----------------------------------

Catalyst

Thu May 01, 2003 1:54 pm


[source] 3d Particle Engine

-----------------------------------

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 :D 

heres the 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  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


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

Thu May 01, 2003 5:21 pm



-----------------------------------

looks awesome  :D +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

Thu May 01, 2003 5:57 pm



-----------------------------------

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


-----------------------------------

Atma Weapon

Mon Oct 27, 2003 2:05 pm



-----------------------------------

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

Mon Oct 27, 2003 6:00 pm



-----------------------------------

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


-----------------------------------

LovelyCrap

Mon Oct 27, 2003 8:38 pm



-----------------------------------

Catalyst, your mad skillz both amaze and frighten me. 

Kudos  :clap: :clap: :clap:


-----------------------------------

Mazer

Mon Oct 27, 2003 9:45 pm



-----------------------------------

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

Mon Oct 27, 2003 10:03 pm



-----------------------------------

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  :twisted:


-----------------------------------

Tony

Mon Oct 27, 2003 11:00 pm



-----------------------------------

always blame Dan if anything goes wrong  :twisted:

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


-----------------------------------

Dan

Mon Oct 27, 2003 11:02 pm



-----------------------------------

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

Fri Nov 07, 2003 5:29 pm



-----------------------------------

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

Sun Nov 09, 2003 5:26 pm



-----------------------------------

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


-----------------------------------

thoughtful

Mon Nov 10, 2003 10:37 pm



-----------------------------------

AMEN! :twisted:  :twisted:  :twisted:  :twisted:


-----------------------------------

Dan

Tue Nov 11, 2003 7:26 pm



-----------------------------------

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


-----------------------------------

BPhelmet

Thu Dec 16, 2004 4:34 pm



-----------------------------------

that is beautiful