#1
05-10-2024, 10:43 PM (This post was last modified: 05-10-2024, 10:46 PM by TerryRitchie.)
I thought I would take a day off from creating new tutorial material and update some old. In lesson 18 there is a spark particle physics generator that I wrote way back in 2012 when I was still relatively new to QB64. I plan to eventually go through all the old code I wrote in the tutorial and update it with new (and better) techniques I have learned over the years.
Here is the new spark particle physics generator. Have fun.
WHY when I post code using the Export As Forum Codebox does the spacing get messed up as seen below?? Am I doing something wrong or is their a bug somewhere?
Code: (Select All)
'+---------------------------------------------+
'| Sparks! 2.0 |
'| by |
'| Terry Ritchie |
'| 05/10/24 |
'| |
'| Updated for Lesson 18 of the QB64 tutorial |
'| https://www.qb64tutorial.com |
'| |
'| Sparks! 1.0 was written back in 2012 when I |
'| was still relatively new to QB64. This new |
'| version incorporates coding techniques I |
'| have learned since then. |
'| |
'| This version of Sparks! uses an image of a |
'| spark instead of drawing the sparks using |
'| multiple PSET statements. Other speed |
'| enhancements were also implemented. |
'+---------------------------------------------+OPTION _EXPLICIT ' declare all variables
TYPE SPARK ' SPARK PROPERTIES
x AS SINGLE ' x location of spark
y AS SINGLE ' y location of spark
xVec AS SINGLE ' x vector of spark
yVec AS SINGLE ' y vector of spark
xVel AS SINGLE ' x velocity of spark
yVel AS SINGLE ' y velocity of spark
Fade AS SINGLE ' spark brightness
Fader AS SINGLE ' spark brightness fader
Alive AS INTEGER ' spark life countdown timer
Image AS LONG ' spark image
END TYPE
REDIM Spark(0) AS SPARK ' create spark array
DIM x AS INTEGER ' x location of new spark(s)
DIM y AS INTEGER ' y location of new spark(s)
DIM xv AS SINGLE ' x vector to add to spark(s)
DIM yv AS SINGLE ' y vector to add to spark(s)
DIM Hyp AS SINGLE ' length between mouse x,y and spark(s) x,y
'+-------------------------+
'| Begin main demo program |
'+-------------------------+
SCREEN _NEWIMAGE(640, 480, 32) ' enter graphics screen
_MOUSEHIDE ' hide the mouse pointer
DO ' begin main program loop
_LIMIT 60 ' 60 frames per second
CLS ' clear screen
LOCATE 2, 28: PRINT "SPACEBAR TO SHOOT SPARKS" ' display instructions
LOCATE 4, 27: PRINT "USE MOUSE TO MOVE REPULSER"
LOCATE 6, 26: PRINT "LEFT MOUSE BUTTON TO REPULSE"
LOCATE 8, 30: PRINT "ESC TO LEAVE PROGRAM"
WHILE _MOUSEINPUT: WEND ' get latest mouse update
CIRCLE (_MOUSEX, _MOUSEY), 10 ' draw repulser
IF _KEYDOWN(32) THEN ' is spacebar down?
x = RND * 640 ' yes, x location of new spark(s)
y = RND * 480 ' y location of new spark(s)
IF _MOUSEBUTTON(1) THEN ' left mouse button down?
Hyp = _HYPOT(_MOUSEX - x, _MOUSEY - y) ' yes, get distance from mouse to spark(s)
xv = (x - _MOUSEX) / Hyp ' create normalized x vector to add
yv = (y - _MOUSEY) / Hyp ' create normalized y vector to add
ELSE ' no, left mouse button is not down
xv = 0 ' no x vector will be added
yv = 0 ' no y vector will be added
END IF
MakeSpark 50, 60, xv, yv, x, y ' create the spark(s)
END IF
UpdateSpark ' update any live spark(s)
_DISPLAY ' update the screen with changes
LOOP UNTIL _KEYDOWN(27) ' leave when ESC key pressed
SYSTEM ' return to the operating system
'+-----------------------+
'| End main demo program |
'+-----------------------+
'------------------------------------------------------------------------------------------------------------
SUB UpdateSpark () ' spark maintainer
'+-------------------------------------------------------------------------------------------------+
'| Scans the spark array for active sparks and updates their properties. Will also reset the spark |
'| array when no active sparks are found. |
'+-------------------------------------------------------------------------------------------------+
CONST WHITE~& = _RGBA32(255, 255, 255, 255) ' full opaque white
SHARED Spark() AS SPARK ' need access to spark array
DIM Index AS LONG ' array index counter
DIM NoLife AS INTEGER ' flag to reset array when dead
IF UBOUND(Spark) = 0 THEN EXIT SUB ' leave if array empty
NoLife = -1 ' assume array has no life
DO ' begin spark update loop
Index = Index + 1 ' increment index counter
IF Spark(Index).Alive THEN ' is this spark alive?
NoLife = 0 ' yes, array has life
_PUTIMAGE (Spark(Index).x - 1, Spark(Index).y - 1), Spark(Index).Image ' draw spark image
Spark(Index).Alive = Spark(Index).Alive - 1 ' decrement spark life
IF Spark(Index).Alive THEN ' is spark still alive?
Spark(Index).Fade = Spark(Index).Fade - Spark(Index).Fader ' yes, update brightness
Spark(Index).x = Spark(Index).x + Spark(Index).xVec * Spark(Index).xVel ' update x location
Spark(Index).y = Spark(Index).y + Spark(Index).yVec * Spark(Index).yVel ' update y location
Spark(Index).xVel = Spark(Index).xVel * .95 ' update spark x velocity
Spark(Index).yVel = Spark(Index).yVel * .95 ' update spark y velocity
_SETALPHA INT(Spark(Index).Fade), 0 TO WHITE, Spark(Index).Image ' set image brightness
ELSE ' no, spark is now dead
_FREEIMAGE Spark(Index).Image ' free image from RAM
END IF
END IF
LOOP UNTIL Index = UBOUND(Spark) ' leave at top of array
IF NoLife THEN REDIM Spark(0) AS SPARK ' reset array if no life
END SUB
'------------------------------------------------------------------------------------------------------------
SUB MakeSpark (num AS INTEGER, ttl AS INTEGER, xv AS SINGLE, yv AS SINGLE, x AS INTEGER, y AS INTEGER)
'+--------------------------------------------------+
'| Enters sparks into the spark array. |
'| |
'| num - number of sparks to create |
'| ttl - spark time to live |
'| xv - x vector to be added to spark (0 for none) |
'| xy - y vector to be added to spark (0 for none) |
'| x - x location of spark(s) |
'| y - y location of spark(s) |
'+--------------------------------------------------+
SHARED Spark() AS SPARK ' need access to spark array
STATIC Image AS LONG ' persistent spark image
DIM Index AS LONG ' array index counter
DIM Dest AS LONG ' current destination image
'+------------------------------------------------------+
'| Draw spark image the first time subroutine is called |
'+------------------------------------------------------+
IF Image > -2 THEN ' has spark image been created?
Image = _NEWIMAGE(3, 3, 32) ' no, create spark image canvas +---+---+---+
Dest = _DEST ' get current destination image | G | W | G |
_DEST Image ' draw on spark image canvas +---+---+---+
CLS , _RGB32(64, 64, 64) ' gray corners | W |BW | W |
LINE (1, 0)-(1, 2), _RGB32(128, 128, 128) ' white outer vertical centers +---+---+---+
LINE (0, 1)-(2, 1), _RGB32(128, 128, 128) ' white outer horizontal centers | G | W | G |
PSET (1, 1), _RGB32(255, 255, 255) ' bright white center +---+---+---+
_DEST Dest ' restore destination image
END IF
'+-------------------------------+
'| Add sparks to the spark array |
'+-------------------------------+
Index = UBOUND(Spark) ' get last index of array
REDIM _PRESERVE Spark(Index + num) AS SPARK ' add new sparks to top of array
RANDOMIZE TIMER ' seed random number generator
DO ' begin spark addition loop
Index = Index + 1 ' increment index counter
Spark(Index).Alive = ttl ' spark time to live
Spark(Index).x = x ' x location of spark
Spark(Index).y = y ' y location of spark
Spark(Index).Fade = 255 ' initial brightness
Spark(Index).Fader = 255 / ttl ' brightness fader value
Spark(Index).xVel = 9 + RND * 6 ' random x velocity
Spark(Index).yVel = 6 + RND * 6 ' random y velocity
Spark(Index).xVec = RND - RND + xv ' random x vector plus passed in x vector
Spark(Index).yVec = RND - RND + yv ' random y vector plus passed in y vector
Spark(Index).Image = _COPYIMAGE(Image, 32) ' copy the spark image
LOOP UNTIL Index = UBOUND(Spark) ' leave when top of array reached
END SUB
There are two ways to write error-free programs; only the third one works.
QB64 Tutorial
