Qbasicnews.com
October 01, 2020, 12:04:46 PM
 Pages: [1]
 Author Topic: my particle engine  (Read 1929 times)
citpes
Guru

Posts: 254

 « on: April 12, 2003, 04:17:13 PM »

While it wont help me pass my science exam, i thought if im gonna goof off programming (when i should be studying for science) it might as well be somewhat to do with with science.  so here is my particle engine.  its the first one ive ever done so im pretty pleased with it...

(almost) no comments, i think im alergic to them or something  :lol: !
you can play with the const's at the top to do with max particles and x/y velocitys!

Code:

CLS
SCREEN 13
RANDOMIZE TIMER

CONST  cX = 160, cY = 100

CONST GRAVITY = .1
CONST FRICTION = .01
CONST MAX.X.VELOCITY = 5, MAX.Y.VELOCITY = 5, MAX.PARTICLES = 99

TYPE ParticleType
x AS SINGLE                  'x position
y AS SINGLE                  'y position
og AS SINGLE                 'its own gravity, increased with each loop
xvel AS SINGLE               'x velocity
yvel AS SINGLE               'y velocity
END TYPE
DIM SHARED part(MAX.PARTICLES) AS ParticleType

FOR i = 0 TO MAX.PARTICLES
part(i).x = cX
part(i).y = cY
part(i).xvel = RND * MAX.X.VELOCITY
part(i).yvel = RND * MAX.Y.VELOCITY

part(i).og = RND * 1

dir = INT(RND * 2) + 1
IF dir = 2 THEN part(i).xvel = part(i).xvel * -1
dir2 = INT(RND * 2) + 1
IF dir2 = 2 THEN part(i).yvel = part(i).yvel * -1

NEXT

PSET (cX, cY), 14
SLEEP 1
SOUND 100, .5

DO
WAIT &H3DA, 8

FOR i = 0 TO MAX.PARTICLES
PSET (part(i).x, part(i).y), 0' INT(RND * 256)
IF part(i).xvel >= 0 THEN
part(i).y = part(i).y + part(i).yvel
IF part(i).yvel < 0 THEN part(i).yvel = part(i).yvel + .1
part(i).y = part(i).y + GRAVITY + part(i).og
part(i).x = part(i).x + part(i).xvel
part(i).xvel = part(i).xvel - FRICTION
IF part(i).xvel < 0 THEN part(i).xvel = 0
PSET (part(i).x, part(i).y), 14
END IF

IF part(i).xvel < 0 THEN
part(i).y = part(i).y + part(i).yvel
IF part(i).yvel < 0 THEN part(i).yvel = part(i).yvel + .1
part(i).y = part(i).y + GRAVITY + part(i).og
part(i).x = part(i).x + part(i).xvel
part(i).xvel = part(i).xvel + FRICTION
IF part(i).xvel > 0 THEN part(i).xvel = 0
PSET (part(i).x, part(i).y), 14
END IF
part(i).og = part(i).og + .01
NEXT
LOOP UNTIL INKEY\$ <> ""

 Logged
Ninkazu
Been there, done that

Posts: 1169

 « Reply #1 on: April 12, 2003, 04:40:54 PM »

Hey, that's pretty neat. I love explosions. You can learn about particle blurring from my particle engine I derived from shippysite.com

Pure Qb, I get about 102 fps
Code:
DEFINT A-Z
'\$DYNAMIC
DIM buffer(32001) AS INTEGER

CONST MaxStars = 700
DIM starfield(MaxStars, 4) AS SINGLE

'\$STATIC
DIM precalcy(199) AS LONG, div(1023)
DIM KeyBoardKey AS STRING

RANDOMIZE TIMER

FOR I& = 0 TO 199
precalcy(I&) = 320 * I& + 4
NEXT
FOR n = 0 TO 1023
div(n) = n \ 4.025
NEXT

FOR CreateRandom% = 0 TO MaxStars
starfield(CreateRandom%, 1) = 160 + (((40 * RND) * (3 * RND - 1)))
starfield(CreateRandom%, 2) = 20 * RND + 1
velx = INT(3 * RND - 1): IF velx = 0 THEN velx = RND + 1
vely = INT(3 * RND - 1): IF vely = 0 THEN vely = RND + 1
starfield(updateprocess%, 3) = velx * ((6 * RND + 1) * SIN(360 * RND))
starfield(updateprocess%, 4) = vely * ((6 * RND + 1) * COS(360 * RND))
NEXT

SCREEN 13
buffer(0) = 2560: buffer(1) = 200

FOR I = 0 TO 63
OUT &H3C9, I \ 4
OUT &H3C9, 0
OUT &H3C9, 0
NEXT
FOR I = 0 TO 63
OUT &H3C9, (I + 64) \ 4
OUT &H3C9, I \ 4
OUT &H3C9, 0
NEXT
FOR I = 0 TO 63
OUT &H3C9, (I + 128) \ 4
OUT &H3C9, (I + 64) \ 4
OUT &H3C9, I \ 4
NEXT
FOR I = 0 TO 63
OUT &H3C9, (I + 192) \ 4
OUT &H3C9, (I + 128) \ 4
OUT &H3C9, (I + 64) \ 4
NEXT

t# = TIMER
frames& = 0
DEF SEG = VARSEG(buffer(0))
Offset = VARPTR(buffer(0))
DO
frames& = frames& + 1
KeyBoardKey = ""
KeyBoardKey = INKEY\$
FOR updateprocess% = 0 TO MaxStars
beginupdate:
checklocationx = starfield(updateprocess%, 1) + starfield(updateprocess%, 4)
checklocationy = starfield(updateprocess%, 2) + starfield(updateprocess%, 3)

IF checklocationx < 1 OR checklocationx > 318 THEN starfield(updateprocess%, 4) = -starfield(updateprocess%, 4): checklocationx = starfield(updateprocess%, 1) + starfield(updateprocess%, 4)
IF checklocationy < 1 THEN starfield(updateprocess%, 3) = -starfield(updateprocess%, 3): checklocationy = starfield(updateprocess%, 2) + starfield(updateprocess%, 3)
IF checklocationy > 198 THEN
starfield(updateprocess%, 1) = 160 + (((40 * RND) * (3 * RND - 1)))
starfield(updateprocess%, 2) = 20 * RND + 1
velx = INT(3 * RND - 1): IF velx = 0 THEN velx = RND + 1
vely = INT(3 * RND - 1): IF vely = 0 THEN vely = RND + 1
starfield(updateprocess%, 3) = velx * ((6 * RND + 1) * SIN(360 * RND))
starfield(updateprocess%, 4) = vely * ((6 * RND + 1) * COS(360 * RND))
GOTO beginupdate
END IF

starfield(updateprocess%, 1) = checklocationx
starfield(updateprocess%, 2) = checklocationy
starfield(updateprocess%, 3) = starfield(updateprocess%, 3) + .28
POKE Offset + (precalcy(starfield(updateprocess%, 2)) + starfield(updateprocess%, 1)), 255
NEXT

offs& = precalcy(1)
FOR y = 1 TO 198
FOR x = 1 TO 318
offs2& = offs& + x
c = div(PEEK(offs2& + 1) + PEEK(offs2& - 1) + PEEK(offs2& + 320) + PEEK(offs2& - 320))
POKE offs2&, c
NEXT
offs& = offs& + 320
NEXT

PUT (0, 0), buffer, PSET
LOOP UNTIL KeyBoardKey = CHR\$(27)

COLOR 255
PRINT frames& / (TIMER - t#)
DO: LOOP UNTIL LEN(INKEY\$)
 Logged

am an asshole. Get used to it.
wizardlife
Na_th_an

Posts: 1456

 « Reply #2 on: April 12, 2003, 06:03:13 PM »

Nice... I finally broke down and did an array-based particle engine in QB for Microrush. I resisted, tho. The linked list is so much more elegant -- and confusing. Have you seen the translucent particles in Earmark?
 Logged

Ninkazu
Been there, done that

Posts: 1169

 « Reply #3 on: April 12, 2003, 06:21:25 PM »