Qbasicnews.com
December 08, 2019, 05:30:34 PM *
Welcome, Guest. Please login or register.

Login with username, password and session length
News: Back to Qbasicnews.com | QB Online Help | FAQ | Chat | All Basic Code | QB Knowledge Base
 
   Home   Help Search Login Register  
Pages: [1]
  Print  
Author Topic: my particle engine  (Read 1796 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



WWW
« 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 Smiley
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


WWW
« 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



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

I downloaded it and didn't see any particles...

::EDIT::
Ok, I got the updated version and WHOA! I gotta learn how to do that.
Logged

am an asshole. Get used to it.
Pages: [1]
  Print  
 
Jump to:  

Powered by MySQL Powered by PHP Powered by SMF 1.1.21 | SMF © 2015, Simple Machines Valid XHTML 1.0! Valid CSS!