Qbasicnews.com

Qbasicnews.com > General > General/Misc > Pure QB4.5 3D particle explosion simulator
Full Version: Pure QB4.5 3D particle explosion simulator
You're currently viewing a stripped down version of our content. View the full version with proper formatting.
Pages: 1 2

TheBlueKeyboard

06-04-2005, 12:22 AM
This is my 3D particle explosion simulator...
Uses some of my PQBLib routines
See what u think 8)
(Arrow keys to rotate, Enter to explode particles, ESC to exit)

Code:
'$DYNAMIC
DECLARE SUB CreateParticleEffect (NParticles%, X%, Y%, Z%)
DECLARE SUB HandleParticles3D ()
DECLARE SUB PQB.BufferCopy (Array%())
DECLARE SUB PQB.Init (Array%())
DECLARE SUB PQB.Pset (X%, Y%, C%, DestSeg%, DestOff%)
DECLARE SUB PQB.ClearBuffer (Array%())

DIM SHARED Gravity!, ExMagnitude!, Particles%
'==================================================
Gravity! = 0                     'Gravity
ExMagnitude! = .7                'Explosion magnitude
Particles% = 1000                'Max particles, I wouldn't go over 1750
'==================================================





CONST False = 0, True = NOT False
SCREEN 13
DIM SHARED Buffer(32001) AS INTEGER
DIM SHARED Pause%, NoFade%, PlotX!, PlotY!
PQB.Init Buffer()
RANDOMIZE TIMER

TYPE Particles
A AS INTEGER
X AS SINGLE
Y AS SINGLE
Z AS SINGLE
YV AS SINGLE
XV AS SINGLE
ZV AS SINGLE
Gravity AS SINGLE
C AS SINGLE
END TYPE

TYPE Engine
XCenter AS INTEGER
YCenter AS INTEGER
ZCenter AS INTEGER
Theta AS INTEGER
Phi AS INTEGER
END TYPE

DIM SHARED C!(359), S!(359)
DIM SHARED Engine AS Engine
CONST PI = 3.141593

FOR Angle% = 0 TO 359
C!(Angle%) = COS(Angle% * PI / 180)
S!(Angle%) = SIN(Angle% * PI / 180)
NEXT
DIM SHARED Particle(Particles% - 1) AS Particles
Engine.XCenter = 160
Engine.YCenter = 100
Engine.ZCenter = 256
Engine.Phi = 0
Engine.Theta = 0
DO
Keypress% = INP(&H60)
SELECT CASE Keypress%
CASE 77
Engine.Theta = Engine.Theta + 5
CASE 75
Engine.Theta = Engine.Theta - 5
CASE 72
Engine.Phi = Engine.Phi - 5
CASE 80
Engine.Phi = Engine.Phi + 5
CASE 28
CreateParticleEffect 100, 0, 0, 0
CASE &H1
END
END SELECT
IF Engine.Theta > 359 THEN Engine.Theta = 0
IF Engine.Phi > 359 THEN Engine.Phi = 0
IF Engine.Theta < 0 THEN Engine.Theta = 359
IF Engine.Phi < 0 THEN Engine.Phi = 359


PQB.ClearBuffer Buffer()
HandleParticles3D
PQB.BufferCopy Buffer()
ParticlesActive% = 0
FOR V% = 0 TO Particles% - 1
IF Particle(V%).A THEN ParticlesActive% = ParticlesActive% + 1
NEXT
IF TIMER - ST! >= 1 THEN
     ST! = TIMER
     FramesPer = Frames
     Frames = 0
    END IF
    Frames = Frames + 1

DEF SEG = 0: POKE &H41A, PEEK(&H41C)
LOCATE 23, 1: PRINT "Active Particles:"; ParticlesActive%; "FPS:"; FramesPer
LOOP

REM $STATIC
SUB CreateParticleEffect (NParticles%, X%, Y%, Z%)
IF NParticles% <= 0 THEN EXIT SUB
XMin! = ExMagnitude!
XMax! = ExMagnitude!
YMin! = ExMagnitude!
YMax! = ExMagnitude!
ZMin! = ExMagnitude!
ZMax! = ExMagnitude!
FOR V% = 0 TO Particles% - 1
IF NOT Particle(V%).A THEN
Particle(V%).A = True
Particle(V%).X = X%
Particle(V%).Y = Y%
Particle(V%).Z = Z%
Particle(V%).XV = (RND * XMin!) - (RND * XMax!)
Particle(V%).YV = (RND * YMin!) - (RND * YMax!)
Particle(V%).ZV = (RND * ZMin!) - (RND * ZMax!)
Particle(V%).Gravity = Gravity!
Particle(V%).C = 31
ParticlesAdded% = ParticlesAdded% + 1
END IF
IF ParticlesAdded% = NParticles% OR V% = Particles% - 1 THEN EXIT SUB
NEXT
END SUB

SUB HandleParticles3D
FOR V% = 0 TO Particles% - 1
IF Particle(V%).A = True THEN
Particle(V%).YV = Particle(V%).YV + Particle(V%).Gravity
Particle(V%).X = Particle(V%).X + Particle(V%).XV
Particle(V%).Y = Particle(V%).Y + Particle(V%).YV
Particle(V%).Z = Particle(V%).Z + Particle(V%).ZV
Particle(V%).C = Particle(V%).C - .05
IF INT(Particle(V%).C) = 16 THEN Particle(V%).A = False
RX = -Particle(V%).Z * S!(Engine.Theta) + Particle(V%).X * C!(Engine.Theta)
RY = -Particle(V%).Z * C!(Engine.Theta) * S!(Engine.Phi) - Particle(V%).X * S!(Engine.Theta) * S!(Engine.Phi) - Particle(V%).Y * C!(Engine.Phi)
RZ = -Particle(V%).Z * C!(Engine.Theta) * C!(Engine.Phi) - Particle(V%).X * S!(Engine.Theta) * C!(Engine.Phi) + Particle(V%).Y * S!(Engine.Phi)
PlotX! = 256 * (RX / (RZ + Engine.ZCenter)) + Engine.XCenter
PlotY! = 256 * (RY / (RZ + Engine.ZCenter)) + Engine.YCenter
IF NoFade% THEN
C% = 1
ELSE
C% = Particle(V%).C
END IF
IF PlotX! > 639 THEN Particle(V%).A = False
IF PlotX! < -319 THEN Particle(V%).A = False
IF PlotY! > 399 THEN Particle(V%).A = False
IF PlotY! < -199 THEN Particle(V%).A = False
PQB.Pset INT(PlotX!), INT(PlotY!), C%, VARSEG(Buffer(0)), VARPTR(Buffer(2))
END IF
NEXT
END SUB

SUB PQB.BufferCopy (Array%())
PUT (0, 0), Array%, PSET
END SUB

SUB PQB.ClearBuffer (Array%())
REDIM Array%(32001)
Array%(0) = 2560
Array%(1) = 200
END SUB

SUB PQB.Init (Array%())
Array%(0) = 2560
Array%(1) = 200
END SUB

SUB PQB.Pset (X%, Y%, C%, DestSeg%, DestOff%)
DEF SEG = DestSeg%
IF X% > 0 AND X% < 319 AND Y% > 0 AND Y% < 199 THEN POKE DestOff% + (Y% * 320&) + X%, C%
END SUB

Torahteen

06-04-2005, 01:18 AM
b= Big Grin =d Very cool!

One request, Put an exit button in there Wink

TheBlueKeyboard

06-04-2005, 01:21 AM
Yeah exit button good idea :oops: :lol:.
I'll edit so ESC exits.

barok

06-07-2005, 08:49 AM
nice... any chance on a fb version? Wink

Anonymous

06-07-2005, 02:33 PM
(ported to fb)

Code:
'$DYNAMIC
DECLARE SUB CreateParticleEffect (NParticles%, X%, Y%, Z%)
DECLARE SUB HandleParticles3D ()

#include "fbgfx.bi"

DIM SHARED Gravity!, ExMagnitude!, Particles%
'==================================================
Gravity! = 0                     'Gravity
ExMagnitude! = 2                'Explosion magnitude
Particles% = 5000                'Max particles, I wouldn't go over 1750 (lol ^^)
'==================================================





CONST False = 0, True = NOT False
Screen 18,,2
ScreenSet 0, 1
DIM SHARED Buffer(32001) AS Integer
DIM SHARED Pause%, NoFade%, PlotX!, PlotY!
RANDOMIZE Timer

TYPE Particles
A AS INTEGER
X AS SINGLE
Y AS SINGLE
Z AS SINGLE
YV AS SINGLE
XV AS SINGLE
ZV AS SINGLE
Gravity AS SINGLE
C AS SINGLE
END Type

TYPE Engine
XCenter AS INTEGER
YCenter AS INTEGER
ZCenter AS INTEGER
Theta AS INTEGER
Phi AS INTEGER
END Type
reDim Shared buffer(32001) As integer
DIM SHARED C!(359), S!(359)
DIM SHARED Engine AS Engine
CONST PI = 3.141593

FOR Angle% = 0 TO 359
C!(Angle%) = COS(Angle% * PI / 180)
S!(Angle%) = SIN(Angle% * PI / 180)
NEXT
DIM SHARED Particle(Particles% - 1) AS Particles
Engine.XCenter = 319
Engine.YCenter = 239
Engine.ZCenter = 256
Engine.Phi = 0
Engine.Theta = 0
DO
Keypress$ = Inkey$

If multikey(77) Then Engine.Theta = Engine.Theta + 5
If multikey(75) Then Engine.Theta = Engine.Theta - 5
If Multikey(72) Then Engine.Phi = Engine.Phi - 5
If Multikey(80) Then Engine.Phi = Engine.Phi + 5
clflag = 0
If Multikey(sc_c) Then clflag = -1
If Multikey(&h1c) Then CreateParticleEffect 100, 0, 0, 0
If Multikey(1) Then End

IF Engine.Theta > 359 THEN Engine.Theta = 0
IF Engine.Phi > 359 THEN Engine.Phi = 0
IF Engine.Theta < 0 THEN Engine.Theta = 359
IF Engine.Phi < 0 THEN Engine.Phi = 359

HandleParticles3D

ParticlesActive% = 0
FOR V% = 0 TO Particles% - 1
IF Particle(V%).A THEN ParticlesActive% = ParticlesActive% + 1
NEXT
IF TIMER - ST! >= 1 THEN
     ST! = TIMER
     FramesPer = Frames
     Frames = 0
    END IF
    Frames = Frames + 1


LOCATE 23, 1: PRINT "Active Particles:"; ParticlesActive%, "FPS:"; FramesPer, Particle(0).C
ScreenCopy:If Not clflag Then cls
Loop


Sub CreateParticleEffect (NParticles%, X%, Y%, Z%) static
IF NParticles% <= 0 THEN EXIT SUB
XMin! = ExMagnitude!
XMax! = ExMagnitude!
YMin! = ExMagnitude!
YMax! = ExMagnitude!
ZMin! = ExMagnitude!
ZMax! = ExMagnitude!
FOR V% = 0 TO Particles% - 1
IF NOT Particle(V%).A THEN
Particle(V%).A = True
Particle(V%).X = X%
Particle(V%).Y = Y%
Particle(V%).Z = Z%
Particle(V%).XV = (RND * XMin!) - (RND * XMax!)
Particle(V%).YV = (RND * YMin!) - (RND * YMax!)
Particle(V%).ZV = (RND * ZMin!) - (RND * ZMax!)
Particle(V%).Gravity = Gravity!
Particle(V%).C = 31
ParticlesAdded% = ParticlesAdded% + 1
END IF
IF ParticlesAdded% = NParticles% OR V% = Particles% - 1 THEN EXIT SUB
Next
END SUB

SUB HandleParticles3D
FOR V% = 0 TO Particles% - 1
IF Particle(V%).A = True THEN
Particle(V%).YV = Particle(V%).YV + Particle(V%).Gravity
Particle(V%).X = Particle(V%).X + Particle(V%).XV
Particle(V%).Y = Particle(V%).Y + Particle(V%).YV
Particle(V%).Z = Particle(V%).Z + Particle(V%).ZV
Particle(V%).C = Particle(V%).C - .05
IF INT(Particle(V%).C) = 16 THEN Particle(V%).A = False
RX = -Particle(V%).Z * S!(Engine.Theta) + Particle(V%).X * C!(Engine.Theta)
RY = -Particle(V%).Z * C!(Engine.Theta) * S!(Engine.Phi) - Particle(V%).X * S!(Engine.Theta) * S!(Engine.Phi) - Particle(V%).Y * C!(Engine.Phi)
RZ = -Particle(V%).Z * C!(Engine.Theta) * C!(Engine.Phi) - Particle(V%).X * S!(Engine.Theta) * C!(Engine.Phi) + Particle(V%).Y * S!(Engine.Phi)
PlotX! = 256 * (RX / (RZ + Engine.ZCenter)) + Engine.XCenter
PlotY! = 256 * (RY / (RZ + Engine.ZCenter)) + Engine.YCenter
IF NoFade% THEN
C% = 1
ELSE
C% = Particle(V%).C
END If
IF PlotX! > 639 THEN Particle(V%).A = False
IF PlotX! < -1 THEN Particle(V%).A = False
IF PlotY! > 479 THEN Particle(V%).A = False
IF PlotY! < -1 THEN Particle(V%).A = False
Pset( Int(PlotX!), Int(PlotY!) ), C%
END IF
NEXT
END SUB


i made some slight mods to the code, mostly to make fb run it but also a coupl of optimizations that i came acros..


i wish i wouldve noticed this before now =) its really cool (btw in fb handles 5000 particles easily, what its set at)

edit: added a 'feature' too, if you hold c while its exploding the traces wont erase, a prtty neat effect

edit 2: and an exe for all those poor, lost souls that don't have fb: http://members.aol.com/rubentbstk/expl.exe

(dunno why but aol seems to be restricting downloads to brasil, (and maybe other countries) ...bastards)

Dio

06-08-2005, 12:33 AM
thats pretty neat TheBlueKeyboard.
it's fun to watch and i have no freaking clue how it works! Tongue

barok

06-08-2005, 02:08 AM
read rel's 3d tuts, then you might have a clue. Wink

Neo

06-08-2005, 06:21 PM
Wow it was such a long time ago BK visited...

I'm happy to see you again Big Grin

barok

06-08-2005, 07:30 PM
bluekeyboard... the name sounds familiar, but i don't think i got here early enough to remember from where.

Sumo Jo

06-09-2005, 01:27 AM
Quote:Wow it was such a long time ago BK visited...

I'm happy to see you again Big Grin

I miss his floating monitor Sad

[Image: computer_surfing.gif]
Pages: 1 2
Qbasicnews.com > General > General/Misc > Pure QB4.5 3D particle explosion simulator