New Years Eve Fireworks!

[SierraKen]

OK, I didn't see your DIM C() _Unsigned Long so I added that. I wondered where all the colors were.  
I reduced it down to around the amount of explosions you had. 
CLS after trajectile doesn't seem to clear the shadows, but that's OK, they are cleared when a new one starts anyway. 
I also edited the booms numbers to the amount used. Here is the code. A background image would be cool! 

Code: (Select All)

'Fireworks by SierraKen and Bplus

'December 29, 2024



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



'Thanks B+ for the inspiration and help.





Screen _NewImage(800, 600, 32)

Dim x(200), y(200), xx(200), yy(200)

Dim centerx(200), centery(200)

Dim c(200) As _Unsigned Long



_Title "Fireworks by SierraKen and Bplus"



file$ = "firework_single.mp3"

file2$ = "firework_single_small.mp3"

Song = _SndOpen(file$)

song2 = _SndOpen(file2$)

If Song < 1 Then

    Print "Failed to load sound file!"

    End

End If



GoSub more



Randomize Timer

Do

    ce = ce + 1

    If ce > 200 Then ce = 1

    centerx(ce) = (Rnd * 400) + 200

    centery(ce) = (Rnd * 100) + 300

    red = (Rnd * 155) + 100: green = (Rnd * 155) + 100: blue = (Rnd * 155) + 100



    c(ce) = _RGB32(red, green, blue)



    If booms < 20 Then _SndPlay Song

    If booms > 19 Then _SndPlay song2

    If booms < 20 Then GoSub trajectile

    For b = 1 To 300

        For e = 1 To 200

            x(e) = x(e) + xx(e)

            y(e) = y(e) + yy(e)

            cx = x(e) + centerx(ce)

            cy = y(e) + centery(ce)

            fillCircle cx, cy, 2, c(ce)

        Next e

        If booms < 10 Then _Limit (300 - b) + 60 Else _Limit 500

        Line (0, 0)-(800, 600), _RGB32(0, 0, 0, 10), BF

    Next b

    booms = booms + 1

    _Title "Explosions: " + Str$(booms)

    t = 1

    GoSub more

    If booms = 19 Then

        _SndStop Song

    End If

    If booms = 40 Then

        For ending = 1 To 8

            Line (0, 0)-(800, 600), _RGB32(0, 0, 0, 60), BF

            _Delay .1

        Next ending

        _SndStop song2

        End

    End If



Loop Until InKey$ = Chr$(27)

End



more:

For t = 1 To 200

    r = Rnd * 2

    a = Rnd * _Pi(2)

    x(t) = r * Cos(a)

    y(t) = r * Sin(a)

    xx(t) = r * Cos(a): yy(t) = r * Sin(a)

Next t

Return



trajectile:

For ty = 600 To centery(ce) Step -1

    fillCircle centerx(ce), ty, 2, _RGB32(255, 255, 255)

    _Delay .002

    Line (0, 0)-(800, 600), _RGB32(0, 0, 0, 10), BF

Next ty

Cls

Return



'from Steve Gold standard

Sub fillCircle (CX As Integer, CY As Integer, R As Integer, C As _Unsigned Long)

    Dim Radius As Integer, RadiusError As Integer

    Dim X As Integer, Y As Integer

    Radius = Abs(R): RadiusError = -Radius: X = Radius: Y = 0

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

    Line (CX - X, CY)-(CX + X, CY), C, 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), C, BF

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

            End If

            X = X - 1

            RadiusError = RadiusError - X * 2

        End If

        Y = Y + 1

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

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

    Wend

End Sub