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