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
#2
This is a great effect, Terry.  Always liked it since you first posted it.  Music fits.  I thought wouldn't it be cool if it was dancing to the music somehow - so I played around with that.  

I set BLOOMAMOUNT to 20, and put a TIMER thing that changes the x/y position randomly on the screen every .46 seconds (instead of mouse movement) and it looks like it's popping to the music on time, on my slow laptop.  If would neat it it could really respond to the music somehow.

- Dav

Code: (Select All)

Dim t As Single: t = Timer
Do
    _Limit 60
    If Timer - t > .46 Then
        t = Timer
        Blooms = BLOOMAMOUNT
        While Blooms > 0
            HOCUS Rnd * _Width, Rnd * _Height '  a one-a , and-a...
            HOCUS Rnd * _Width, Rnd * _Height '  ...two-a...
            Blooms = Blooms - 1
        Wend
    End If
    POCUS
    _Display
Loop Until _KeyDown(27) '                            leave when ESC pressed

Find my programs here in Dav's QB64 Corner
Reply
#3
Thumbs Up 
Nice one Terry, I am a sucker for lot's of color!
b = b + ...
Reply
#4
(09-18-2023, 05:50 PM)Dav Wrote: This is a great effect, Terry.  Always liked it since you first posted it.  Music fits.  I thought wouldn't it be cool if it was dancing to the music somehow - so I played around with that.  

I set BLOOMAMOUNT to 20, and put a TIMER thing that changes the x/y position randomly on the screen every .46 seconds (instead of mouse movement) and it looks like it's popping to the music on time, on my slow laptop.  If would neat it it could really respond to the music somehow.

- Dav
 
Ha! I was thinking the same thing while reworking it. I thought perhaps a Perlin Noise generator could somehow be fashioned and timed to the beat of the music.
New to QB64pe? Visit the QB64 tutorial to get started.
QB64 Tutorial
Reply




Users browsing this thread: 1 Guest(s)