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

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