New Years Eve Fireworks!

[SierraKen]

LOL yep Bplus, well, I like it.

[bplus]

Totally reworked to show background and seperate the trails.

Code: (Select All)

Option _Explicit

'Fireworks 4 with background by SierraKen and Bplus

'December 31, 2024 bplus Major Mod



'Firework sounds from https://pixabay.com/sound-effects/search/fireworks/



_Title "Fireworks 4 with background by SierraKen and bplus"

Screen _NewImage(800, 600, 32): _ScreenMove 300, 60

Dim As Long whistle, pop, sky, i, popX, popY, red, green, blue, booms, life, j

Dim q(25) ' quarters

Dim trailA(200), trailL(200), x1, y1, x2, y2, dist, dx, dy, x, y

q(1) = .15

For i = 2 To 25

    q(i) = q(i - 1) + .085 * q(i - 1)

Next

whistle = _SndOpen("firework_single.mp3")

pop = _SndOpen("firework_single_small.mp3")

If whistle < 1 Or pop < 1 Then Print "firework_single.mp3 or firework_single_small.mp3 failed to load.": End

sky = _LoadImage("sky.jpg", 32)

If sky = -1 Then Print "sky.jpg failed to load.": End

Randomize Timer

Do

    popX = Rnd * 400 + 200

    popY = Rnd * 250 + 150



    ''' Get rid of those greens !!!

    red = (Rnd * 95) + 160: green = (Rnd < .5) * -1 * ((Rnd * 155) + 100): blue = (Rnd * 155) + 100



    '    Still not enough Reds !!!

    If Rnd < .3 Then red = (Rnd * 95) + 160: green = 0: blue = 0



    For i = 1 To 200

        trailA(i) = _Pi(2) * Rnd

        trailL(i) = Rnd * 200

    Next

    If booms < 20 Then _SndPlay whistle

    If booms > 19 Then _SndPlay pop

    If booms < 20 Then GoSub trajectile

    For life = 1 To 25

        _PutImage , sky, 0

        For i = 1 To 200

            x1 = popX + q(life - 1) * trailL(i) * Cos(trailA(i))

            y1 = popY + q(life - 1) * trailL(i) * Sin(trailA(i))

            x2 = popX + q(life) * trailL(i) * Cos(trailA(i))

            y2 = popY + q(life) * trailL(i) * Sin(trailA(i))

            dist = _Hypot(x1 - x2, y1 - y2)

            dx = (x2 - x1) / dist: dy = (y2 - y1) / dist

            For j = 0 To dist Step 2

                x = x1 + 2 * dx * j: y = y1 + 2 * dy * j

                FC3 x, y, 3, midInk~&(.5 * red, .5 * green, .5 * blue, red, green, blue, j / dist)

            Next

            FC3 x, y, 1, _RGB32(220, 220, 220)

        Next

        _Display

        If booms < 20 Then _Limit (27 - life) * 5 Else _Limit 10 + Rnd * 50

    Next

    booms = booms + 1

    _Title "Fireworks 4 with background, Explosions: " + Str$(booms)

    If booms < 20 Then _Delay .5 Else _Delay .2

    If booms = 19 Then _SndStop whistle

    If booms = 40 Then _SndStop pop: End

    _Display

Loop Until InKey$ = Chr$(27)

End

trajectile:

For i = 600 To popY Step -1

    _PutImage , sky, 0

    Line (popX, i)-Step(1, 14), _RGB32(255, 255, 255), BF

    _Limit 300

    _Display

Next

Return



Function midInk~& (r1%, g1%, b1%, r2%, g2%, b2%, fr##)

    midInk~& = _RGB32(r1% + (r2% - r1%) * fr##, g1% + (g2% - g1%) * fr##, b1% + (b2% - b1%) * fr##)

End Function



Sub FC3 (cx As Long, cy As Long, r As Long, clr~&) 

    Dim As Long r2, x, y ' for Option _Explicit

    If r < 1 Then Exit Sub

    Line (cx - r, cy)-(cx + r, cy), clr~&, BF

    r2 = r * r

    Do

        y = y + 1

        x = Sqr(r2 - y * y)

        Line (cx - x, cy + y)-(cx + x, cy + y), clr~&, BF

        Line (cx - x, cy - y)-(cx + x, cy - y), clr~&, BF

    Loop Until y = r

End Sub

   

[SierraKen]

GREAT Job B+!!!! Thank you and Happy New Year!!!!!!!!!!! They look GREAT!

[bplus]

Thanks, Happy New Year to you as well! That's about the 4th way I now know to do fireworks.