'================

'EXPLODEIMAGE.BAS

'================

'Explodes a small image on the screen, fading out screen.

'It does this loading all image pixel data into arrays,

'and changing the x/y position of pixels on the screen.

'Alpha transparecy is used for screen fading effect.

'Tested & Working under Windows/Linux QB64-PE 3.8.0.

'Coded by Dav, SEP/2023





_ICON 'NEED THIS. Using Phoenix ICON in this example as the image



RANDOMIZE TIMER



SCREEN _NEWIMAGE(800, 600, 32)



'Get a bird& image from the built-in ICON

bird& = _NEWIMAGE(192, 192, 32): _DEST bird&

_PUTIMAGE (0, 0)-(192, 192), -11: _DEST 0



'draw a background for to show fading better

FOR x = 1 TO _WIDTH STEP 20

    FOR y = 1 TO _HEIGHT STEP 20

        LINE (x, y)-STEP(10, 10), _RGBA(RND * 255, RND * 255, RND * 255, RND * 255), BF

    NEXT

NEXT



'compute center spot for placing image on screen

cx = _WIDTH / 2 - (_WIDTH(bird&) / 2) 'x center image on screen

cy = _HEIGHT / 2 - (_HEIGHT(bird&) / 2) 'y center image on screen



'Show and Explode the image

ExplodeImage bird&, cx, cy



END



SUB ExplodeImage (image&, x, y)



    _PUTIMAGE (x, y), image&

    PRINT "Press any key to Explode the image..."

    _DISPLAY

    SLEEP



    pixels& = _WIDTH(image&) * _HEIGHT(image&)



    REDIM PixX(pixels&), PixY(pixels&)

    REDIM PixXDir(pixels&), PixYDir(pixels&)

    REDIM PixClr&(pixels&)



    'Read all pixels from image& into arrays,

    'and generate x/y movement values

    _SOURCE image&

    pix& = 0

    FOR x2 = 0 TO _WIDTH(image&) - 1

        FOR y2 = 0 TO _HEIGHT(image&) - 1

            PixClr&(pix&) = POINT(x2, y2) 'pixel color

            PixX(pix&) = x + x2 'pixel x pos

            PixY(pix&) = y + y2 'pixel y pos

            'generate random x/y dir movement values

            DO

                'assign a random x/y dir value (from range -8 to 8)

                PixXDir(pix&) = RND * 8 - RND * 8 'go random +/- x pixels

                PixYDir(pix&) = RND * 8 - RND * 8 'go random +/- y pixels

                'Keep looping until both directions have non-zero values

                IF PixXDir(pix&) <> 0 AND PixYDir(pix&) <> 0 THEN EXIT DO

            LOOP

            pix& = pix& + 1 'goto next pixels

        NEXT

    NEXT

    _SOURCE 0



    'Explode image and Fade out screen

    FOR alpha = 0 TO 225 STEP .8

        'display all pixels

        FOR pix& = 0 TO pixels& - 1

            'pixel x pos, +/- dir value

            PixX(pix&) = PixX(pix&) + PixXDir(pix&)

            'pixel y pos, +/- dir value

            PixY(pix&) = PixY(pix&) + PixYDir(pix&)

            PSET (PixX(pix&), PixY(pix&)), PixClr&(pix&)

        NEXT

        'the fade out trick

        LINE (0, 0)-(_WIDTH, _HEIGHT), _RGBA(0, 0, 0, alpha), BF

        _LIMIT 30

        _DISPLAY

    NEXT



END SUB

(09-07-2023, 11:55 AM)Dav Wrote: Hey thanks, @grymmjack.  Yeah a big boom would help.

I was trying to get this to work in QBJS, ran into a little problem.  Took it out of the SUB, but I can't seem to PUTIMAGE the starting image.  Here is what I have so far, it's an exploding planet.  

@dbox, can you see whatever I'm missing here?  Line #37 doesn't seem to work for me.

- Dav

(09-07-2023, 03:21 PM)Dav Wrote: Thank you all for the fix & tips.  Here's an updated version that gives the explosion some more depth and 3D look - some pixels will grow as they move away, making them look like they are coming towards you.  Also changed it so it doesn't do EVERY pixel, but in steps of 8.  Skipping some pixels isn't very noticeable, and it runs a bit faster on my slow machine.

- Dav

'=================

'zapa_boom

' a varaintion of

'EXPLODEPLANET.BAS

'=================

'Explodes a small planet on the screen, fading out screen.

'It does this loading all image pixel data into arrays,

'and changing the x/y position of pixels on the screen.

'----Alpha transparecy is used for screen fading effect. <<< changed to fade of particles

'Tested & Working under QBJS & Windows/Linux QB64-PE 3.8.

'Coded by Dav, SEP/2023

'rearranged some of the drawing order, added a few additional features and have the particles fade out instead of whole screen fading



Randomize Timer



Screen _NewImage(800, 600, 32)

_FullScreen _SquarePixels



Dim star&

star& = _NewImage(800, 600, 32)



Dim planet&, x, y, x2, y2, r, g, b, a, c, n '<-- for qbjs to use

Dim pixels&, pix&, alpha

Dim zapa(30), zapx(30), zapy(30), zapds(30), zapde(30), zapl(30)

Dim zapk(30) As _Unsigned Long

'show some stars

For x = 1 To 1000

    c = Rnd * 4

    Line (Rnd * _Width, Rnd * _Height)-Step(c, c), _RGBA(200, 200, 200, 25 + Rnd * 200), BF

Next

_PutImage (0, 0), 0, star&

'make a planet image

planet& = _NewImage(200, 200, 32): _Dest planet&

x = 100: y = 100: r = Int(100 + Rnd * 100): g = Int(50 + Rnd * 100): b = Int(50 + Rnd * 100): a = 255

perb1 = Int(1 + Rnd * 30): perb2 = Int(1 + Rnd * 12): perb3 = Int(30 + Rnd * 70)

fcirc 100, 100, 97, _RGBA32(r * .9, g * .9, b * .9, a)

fcirc 100, 100, 95, _RGBA32(r, g, b, a)

fcirc 102, 98, 90, _RGBA32(r + 3, g + 3, b + 3, a)

fcirc 104, 96, 80, _RGBA32(r + 8, g + 8, b + 8, a)

For y2 = y - 100 To y + 100

    For x2 = x - 100 To x + 100

        If Sqr((x2 - x) ^ 2 + (y2 - y) ^ 2) <= 100 Then

            c = (100 - (Sqr((x2 - x) * (x2 - x) + (y2 - y) * (y2 - y)))) / perb3

            n = 20 * Sin((x2 + y2) / perb1) + 10 * Sin((x2 + y2) / perb2)

            PSet (x2, y2), _RGBA(Int(Rnd * (c * r - n)), c * g - n * .8, c * b - n, (c * a - n))

        End If

    Next

Next



Line (-1, -1)-(0, 0), _RGB(0, 0, 0) 'a qbjs fix



_Dest 0



'compute center spot for placing image on screen

x = _Width / 2 - (_Width(planet&) / 2) 'x center image on screen

y = _Height / 2 - (_Height(planet&) / 2) 'y center image on screen





'====================================================================

_PutImage (x, y), planet& '<<-- why won't this show in qbjs?

'====================================================================



Print "Press any key to Explode the planet..."

_Display

Sleep 3



pixels& = _Width(planet&) * _Height(planet&)

Dim PixX(pixels&), PixY(pixels&)

Dim PixXDir(pixels&), PixYDir(pixels&)

Dim PixClr~&(pixels&), PixGro(pixels&)

'Read all pixels from image into arrays,

'and generate x/y movement values

_Source planet&

_Dest planet&

pix& = 0

For x2 = 0 To _Width(planet&) - 1

    For y2 = 0 To _Height(planet&) - 1

        PSet (x2, y2), burn~&(Point(x2, y2)) 'let's set that planet on fire

        PixClr~&(pix&) = Point(x2, y2) 'pixel color

        PixX(pix&) = x + x2 'pixel x pos

        PixY(pix&) = y + y2 'pixel y pos

        'generate random x/y dir movement values

        Do

            'assign a random x/y dir value (from range -8 to 8)

            PixXDir(pix&) = Rnd * 8 - Rnd * 8 'go random +/- x pixels

            PixYDir(pix&) = Rnd * 8 - Rnd * 8 'go random +/- y pixels

            'Keep looping until both directions have non-zero values

            If PixXDir(pix&) <> 0 And PixYDir(pix&) <> 0 Then Exit Do

        Loop

        'make some pixels get larger as they explode (3d effect)

        If Int(Rnd * 200) = 2 Then

            PixGro(pix&) = 2

        Else

            PixGro(pix&) = 1

        End If

        pix& = pix& + 1 'goto next pixels

    Next

Next

_Source 0

_Dest 0

rays = 10 + Int(1 + Rnd * 20)

For a = 1 To rays 'build boom zaps

    zapa(a) = Int(Rnd * 360)

    zapx(a) = x + (_Width(planet&)) / 2

    zapy(a) = y + (_Height(planet&)) / 2

    zapds(a) = Int(1 + Rnd * 2)

    zapde(a) = Int(zapds(a) + Rnd * (2 * (zapds(a))))

    zapl(a) = Int(3 + Rnd * 6) * 50

    zr = 240 + Int(Rnd * 10)

    zapk(a) = _RGBA32(zr + Int(Rnd * 6), zr, 255 - zr, Int(12 + Rnd * 40))

Next a



'Explode palnet and fade out particles

z = 1

boomit = Int(5 + Rnd * 15)

For alpha = 0 To 225 Step .8

    _Limit 30

    Cls

    _PutImage (0, 0), star&, 0 'lets keep the stars in place

    If alpha < boomit Then 'oh no she's a gona blow!!!  Lets show planet heating and "swelling"

        _PutImage (x - alpha * 3, y - alpha * 3)-(x + _Width(planet&) + alpha * 3, y + _Height(planet&) + alpha * 3), planet&, 0, (0, 0)-(_Width(planet&) - 1, _Height(planet&) - 1)

    End If

    'bright flash makes this explosion more visually substanitial and improves the transsiton from planet to no planet

    If alpha > boomit - 3 And alpha < boomit + 3 Then Line (0, 0)-(_Width - 1, _Height - 1), _RGBA32(255, 255, 255, 255 - alpha * 5), BF

    If z < 31 Then 'update boom zaps

        For n = 1 To rays

            zz = Int(z + Rnd(31 - z))

            zzz = 30 - Int(Rnd * 3)

            zap_line zapx(n), zapy(n), zapl(n), zapa(n), zapds(n), zapde(n), zz, zzz, aklr~&(zapk(n), alpha)

        Next n

        z = z + .7

        If rays > 2 And z > 5 Then rays = rays - 1

    End If

    'display all pixels

    For pix& = 0 To pixels& - 1 Step 8

        'pixel x pos, +/- dir value

        PixX(pix&) = PixX(pix&) + PixXDir(pix&)

        'pixel y pos, +/- dir value

        PixY(pix&) = PixY(pix&) + PixYDir(pix&)

        If PixX(pix&) > 0 And PixX(pix&) < _Width Then

            If PixY(pix&) > 0 And PixY(pix&) < _Height Then

                Line (PixX(pix&), PixY(pix&))-Step(PixGro(pix&), PixGro(pix&)), aklr~&(PixClr~&(pix&), 255 - alpha), BF

            End If

        End If

        If PixGro(pix&) > 1 Then

            PixGro(pix&) = PixGro(pix&) + .05

            If PixGro(pix&) > 10 Then PixGro(pix&) = 10

        End If

    Next

    _Display

Next

_PutImage (0, 0), star&, 0

End

Function aklr~& (klr As _Unsigned Long, alpha)

    'let's make the debris  flicker out and fade away

    al = alpha

    If al > 0 Then al = Int(al / 5 + Rnd * (al))

    aklr~& = _RGBA32(_Red32(klr), _Green32(klr), _Blue32(klr), al)

End Function







Function burn~& (klr As _Unsigned Long)

    rr = (_Red32(klr)) * (1.0 + (Rnd * .4))

    If rr > 255 Then rr = 255

    gg = (_Green32(klr)) * 1.1

    If gg > 255 Then gg = 255

    If bb > 0 Then bb = _Blue32(klr) * .7

    If bb < 1 Then bb = 0



    '  aa = _Alpha32(klr) - Int(1 + Rnd * 20)

    aa = _Alpha32(klr)

    If aa > 255 Then aa = 255

    burn~& = _RGBA32(rr, gg, bb, aa)

End Function

Sub zap_line (x, y, Lnth, ang, thks, thke, ss, es, klr As _Unsigned Long)

    Dim zseg(30, 2)

    Dim thk(30)

    thk(1) = thks

    tc = (thke - thks) / 30



    zseg(1, 1) = x: zseg(1, 2) = y

    st = ss: If st = 1 Then st = 2

    For s = 2 To 30

        zseg(s, 1) = zseg(s - 1, 1) + (Lnth / 30) * Cos(0.01745329 * ang)

        zseg(s, 2) = zseg(s - 1, 2) + (Lnth / 30) * Sin(0.01745329 * ang)

        thk(s) = thk(s - 1) + tc

    Next s

    For s = st To es

        If Int(Rnd * 10) < 8 Then fatline zseg(s - 1, 1), zseg(s - 1, 2), zseg(s, 1), zseg(s, 2), thk(s), klr

        If Int(Rnd * 10) < 7 Then fatline zseg(s - 1, 1), zseg(s - 1, 2), zseg(s, 1), zseg(s, 2), thk(s) + thk(2) / 5, klr

    Next s

End Sub

Sub angle_line (x, y, Lnth, ang, thk, klr As _Unsigned Long)

    'draw a line from x,y lnth units long (from center of line) at angle ang of radial thickness thk in color klr

    ox = x: oy = y

    nx = ox + Lnth * Cos(0.01745329 * ang)

    ny = oy + Lnth * Sin(0.01745329 * ang)

    fatline ox, oy, nx, ny, thk, klr

End Sub

Sub fcirc (CX As Long, CY As Long, R, klr As _Unsigned Long)

    'draw a filled circle with the quickest filled circle routine in qb64, not my development

    Dim subRadius As Long, RadiusError As Long

    Dim X As Long, Y As Long

    subRadius = Abs(R)

    RadiusError = -subRadius

    X = subRadius

    Y = 0

    If subRadius = 0 Then PSet (CX, CY): Exit Sub

    Line (CX - X, CY)-(CX + X, CY), klr, BF

    While X > Y

        RadiusError = RadiusError + Y * 2 + 1

        If RadiusError >= 0 Then

            If X <> Y + 1 Then

                Line (CX - Y, CY - X)-(CX + Y, CY - X), klr, BF

                Line (CX - Y, CY + X)-(CX + Y, CY + X), klr, BF

            End If

            X = X - 1

            RadiusError = RadiusError - X * 2

        End If

        Y = Y + 1

        Line (CX - X, CY - Y)-(CX + X, CY - Y), klr, BF

        Line (CX - X, CY + Y)-(CX + X, CY + Y), klr, BF

    Wend

End Sub



Sub fatline (x0, y0, x1, y1, r, klr As _Unsigned Long)

    'draw a line with dots with a radial thickness of r    from x0,y0 to x1,y1 in color klr

    If r > 0.5 Then

        If Abs(y1 - y0) < Abs(x1 - x0) Then

            If x0 > x1 Then

                lineLow x1, y1, x0, y0, r, klr

            Else

                lineLow x0, y0, x1, y1, r, klr

            End If

        Else

            If y0 > y1 Then

                lineHigh x1, y1, x0, y0, r, klr

            Else

                lineHigh x0, y0, x1, y1, r, klr

            End If

        End If

    Else

        Line (x0, y0)-(x1, y1), klr 'line with r of <= 0.5 don't render properly so we force them to be 1 pixel wide on screen

    End If

End Sub

Sub lineLow (x0, y0, x1, y1, r, klr As _Unsigned Long)

    dx = x1 - x0: dy = y1 - y0: yi = 1

    If dy < 0 Then

        yi = -1: dy = -dy

    End If

    d = (dy + dy) - dx: y = y0

    For x = x0 To x1

        fcirc x, y, r, klr

        If d > 0 Then

            y = y + yi: d = d + ((dy - dx) + (dy - dx))

        Else

            d = d + dy + dy

        End If

    Next x

End Sub

Sub lineHigh (x0, y0, x1, y1, r, klr As _Unsigned Long)

    dx = x1 - x0: dy = y1 - y0: xi = 1

    If dx < 0 Then

        xi = -1: dx = -dx

    End If

    D = (dx + dx) - dy: x = x0

    For y = y0 To y1

        fcirc x, y, r, klr

        If D > 0 Then

            x = x + xi: D = D + ((dx - dy) + (dx - dy))

        Else

            D = D + dx + dx

        End If

    Next y

End Sub