Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Hocus Pocus Hardware Version
#1
I modified my Hocus Pocus particle fountain to use a hardware surface and hardware images only. I also made a few optimizations to the code to make it faster. I originally wrote this back in 2014 and have learned a few tricks since then. I'll be including this in Lesson 22 of the tutorial as an example program.

The background music file is included below in a ZIP file. You really need the music to make the program pop.

Simply move the mouse around and watch the magic happen. ESC to exit.

Ugh - never fails - had a bug - it's fixed in the code below.

Code: (Select All)
'*
'* Hocus Pocus V2.3 by Terry Ritchie 09/17/23
'* Original 01/24/14
'* Updated  08/18/22 to reflect the new tutorial
'* Updated  09/17/23 to use hardware images for Lesson 22
'* Open source code - freely share and modify
'*
'* Use the mouse to create magic. Press ESC to leave this magical place.
'*

OPTION _EXPLICIT '         declare those variables son!

'--------------------------------
'- Variable Declaration Section -
'--------------------------------

CONST FALSE = 0 '          truth detector
CONST TRUE = NOT FALSE '   truth detector
CONST SWIDTH = 640 '       screen width
CONST SHEIGHT = 480 '      screen height
CONST BLOOMAMOUNT = 5 '    number of blooms per mouse movement (don't go too high!)
CONST MAXSIZE = 64 '       maximum size of blooms (don't go too high!)
CONST MAXLIFE = 32 '       maximum life time on screen
CONST MAXXSPEED = 6 '      maximum horizontal speed at bloom creation
CONST MAXYSPEED = 10 '     maximum vertical speed at bloom creation
CONST BOUNCE = FALSE '     set to TRUE to have blooms bounce off bottom of screen
CONST FLUFFY = FALSE '     set to TRUE to have blooms fluffier in appearance

TYPE CADABRA '             image properties
    lifespan AS INTEGER '  life span of bloom on screen
    x AS SINGLE '          x location of bloom
    y AS SINGLE '          y location of bloom
    size AS SINGLE '       size of bloom
    xdir AS SINGLE '       horizontal direction of bloom
    ydir AS SINGLE '       vertical direction of bloom
    xspeed AS SINGLE '     horizontal speed of bloom
    yspeed AS SINGLE '     vertical speed of bloom
    image AS LONG '        bloom hardware image handle
END TYPE

REDIM Abra(0) AS CADABRA ' dynamic array to hold properties
DIM x AS INTEGER '         current x position of mouse
DIM y AS INTEGER '         current y position of mouse
DIM Oldx AS INTEGER '      previous x position of mouse
DIM Oldy AS INTEGER '      previous y position of mouse
DIM Blooms AS INTEGER '    bloom counter
DIM sa AS LONG '           Sorcerer's Apprentice sound file

'----------------------------
'- Main Program Begins Here -
'----------------------------

_DISPLAYORDER _HARDWARE
SCREEN _NEWIMAGE(SWIDTH, SHEIGHT, 32) '              create 32 bit graphics screen
_SCREENMOVE _MIDDLE '                                move window to center of desktop
sa = _SNDOPEN("apprentice.ogg") '                    load sound file into RAM
_SNDLOOP sa '                                        play music in continuous loop
_MOUSEHIDE '                                         hide the mouse pointer
_MOUSEMOVE SWIDTH * .5, SHEIGHT * .5 '               move mouse pointer to middle of screen
WHILE _MOUSEINPUT: WEND '                            get latest mouse information
Oldx = _MOUSEX '                                     remember mouse x position
Oldy = _MOUSEY '                                     remember mouse y position
RANDOMIZE TIMER '                                    seed random number generator
DO '                                                 begin main loop
    _LIMIT 60 '                                      60 frames per second
    WHILE _MOUSEINPUT: WEND '                        get latest mouse information
    x = _MOUSEX '                                    get current mouse x position
    y = _MOUSEY '                                    get current mouse y position
    IF (Oldx <> x) OR (Oldy <> y) THEN '             has mouse moved since last loop?
        Blooms = BLOOMAMOUNT '                       yes, get number of blooms to make
        WHILE Blooms > 0 '                           begin bloom creation loop
            HOCUS x, y '                             create bloom at current mouse location
            Blooms = Blooms - 1 '                    decrement bloom counter
        WEND
        Oldx = x '                                   remember mouse x position
        Oldy = y '                                   remember mouse y position
    END IF
    POCUS '                                          draw active blooms
    _DISPLAY '                                       update screen with changes
LOOP UNTIL _KEYDOWN(27) '                            leave when ESC pressed
_SNDSTOP sa '                                        stop background music
_SNDCLOSE sa '                                       remove music from RAM
SYSTEM '                                             return to operating system

'----------------------------------------------------------------------------------------------------------------------

SUB HOCUS (hx AS INTEGER, hy AS INTEGER)

    '*
    '* Maintains the bloom array by creating bloom properties for a new bloom.
    '* If no array indexes are free a new one is added to the end of the array to
    '* hold the new bloom. If an unused index is available the new bloom will occupy
    '* that free index position.
    '*
    '* hx - x location of new bloom
    '* hy - y location of new bloom
    '*

    SHARED Abra() AS CADABRA ' need access to bloom array
    DIM Radius AS INTEGER '    radius value when drawing blooms
    DIM Index AS INTEGER '     array index to create new bloom in
    DIM Red AS INTEGER '       red color component of bloom
    DIM Green AS INTEGER '     green color component of bloom
    DIM Blue AS INTEGER '      blue color component of bloom
    DIM RedStep AS INTEGER '   red fade amount
    DIM GreenStep AS INTEGER ' green fade amount
    DIM BlueStep AS INTEGER '  blue fade amount
    DIM AlphaStep AS INTEGER ' alpha fade amount
    DIM Alpha AS INTEGER '     alpha amount at current radius
    DIM TempImage AS LONG '    temporary software image

    Index = 0 '                                                             reset index counter
    DO '                                                                    begin free index search
        IF Abra(Index).lifespan = 0 THEN EXIT DO '                          leave loop if index is free
        Index = Index + 1 '                                                 increment index counter
    LOOP UNTIL Index > UBOUND(Abra) '                                       leave loop when all indexes checked
    IF Index > UBOUND(Abra) THEN REDIM _PRESERVE Abra(Index) AS CADABRA '   increase array size by 1 if no index free
    Abra(Index).lifespan = RND * MAXLIFE + 16 '                             length of time to live (frames)
    Abra(Index).x = hx '                                                    bloom x location
    Abra(Index).y = hy '                                                    bloom y location
    Abra(Index).size = RND * MAXSIZE + 5 '                                  size of bloom
    Abra(Index).xdir = (RND - RND) * 3 '                                    horizontal direction of bloom
    Abra(Index).ydir = -RND '                                               vertical direction of bloom (up)
    Abra(Index).xspeed = RND * MAXXSPEED '                                  horizontal speed of bloom
    Abra(Index).yspeed = RND * MAXYSPEED '                                  vertical speed of bloom
    Red = RND * 256 '                                                       red component value
    Green = RND * 256 '                                                     green compoenent value
    Blue = RND * 256 '                                                      blue component value
    RedStep = (255 - Red) \ Abra(Index).size '                              fade of red component
    GreenStep = (255 - Green) \ Abra(Index).size '                          fade of green component
    BlueStep = (255 - Blue) \ Abra(Index).size '                            fade of blue component
    AlphaStep = 255 \ Abra(Index).size '                                    fade of alpha channel
    Alpha = 0 '                                                             start alpha channel transparent
    TempImage = _NEWIMAGE(Abra(Index).size * 2, Abra(Index).size * 2, 32) ' create temporary software image
    _DEST TempImage '                                                       draw on temporary image
    Radius = Abra(Index).size '                                             start from outside of bloom working in
    DO WHILE Radius > 0 '                                                   start bloom drawing loop
        CIRCLE (Abra(Index).size, Abra(Index).size), Radius, _RGB32(Red, Green, Blue)
        IF FLUFFY THEN PAINT (Abra(Index).size, Abra(Index).size), _RGB32(Red, Green, Blue), _RGB32(Red, Green, Blue)
        _SETALPHA Alpha, _RGB32(Red, Green, Blue) '                         set transparency level of current color
        Red = Red + RedStep '                                               increase red component
        Green = Green + GreenStep '                                         increase green component
        Blue = Blue + BlueStep '                                            increase blue component
        Alpha = Alpha + AlphaStep '                                         increase opacity level of alpha channel
        Radius = Radius - 1 '                                               decrease size of circle
    LOOP '                                                                  leave loop when smallest circle drawn
    Abra(Index).image = _COPYIMAGE(TempImage, 33) '                         create a hardware image
    _DEST 0 '                                                               leave temp image so it can be freed
    _FREEIMAGE TempImage '                                                  temporary software image no longer needed

END SUB

'----------------------------------------------------------------------------------------------------------------------

SUB POCUS ()

    '*
    '* places active blooms onto the hardware screen and updates their
    '* position, size and speed
    '*

    SHARED Abra() AS CADABRA ' need access to bloom array
    DIM Index AS INTEGER '     array index counter

    Index = UBOUND(Abra) '                                                          start at top of array
    WHILE Index > -1 '                                                              is index > -1?
        IF Abra(Index).lifespan THEN '                                              yes, is this bloom active?
            Abra(Index).lifespan = Abra(Index).lifespan - 1 '                       yes, decrement lifespan of bloom
            Abra(Index).size = Abra(Index).size * .98 '                             decrease size of bloom slightly
            Abra(Index).x = Abra(Index).x + Abra(Index).xdir * Abra(Index).xspeed ' update x position of bloom
            Abra(Index).y = Abra(Index).y + Abra(Index).ydir * Abra(Index).yspeed ' update y position of bloom
            Abra(Index).xspeed = Abra(Index).xspeed * .9 '                          decrease x velocity slightly
            Abra(Index).yspeed = Abra(Index).yspeed - .5 '                          decrease y velocity (gravity)
            IF Abra(Index).y > SHEIGHT THEN '                                       has bloom left bottom of screen?
                IF BOUNCE THEN '                                                    yes, should bloom bounce?
                    Abra(Index).yspeed = -Abra(Index).yspeed '                      yes, reverse y velocity
                ELSE '                                                              no
                    Abra(Index).lifespan = 0 '                                      bloom is no longer needed
                END IF
            END IF
            _PUTIMAGE (Abra(Index).x - Abra(Index).size, Abra(Index).y - Abra(Index).size)-_
                      (Abra(Index).x + Abra(Index).size, Abra(Index).y + Abra(Index).size), Abra(Index).image
            IF Abra(Index).lifespan = 0 THEN _FREEIMAGE Abra(Index).image '         free image if life of bloom has ended
        END IF
        Index = Index - 1 '                                                         decrement array index counter
    WEND

END SUB


Attached Files
.zip   apprentice.zip (Size: 2.12 MB / Downloads: 35)
New to QB64pe? Visit the QB64 tutorial to get started.
QB64 Tutorial
Reply


Messages In This Thread
Hocus Pocus Hardware Version - by TerryRitchie - 09-18-2023, 04:32 PM
RE: Hocus Pocus Hardware Version - by Dav - 09-18-2023, 05:50 PM
RE: Hocus Pocus Hardware Version - by bplus - 09-18-2023, 06:24 PM



Users browsing this thread: 1 Guest(s)