New Years Eve Fireworks!

[bplus]

Better?

Can perfection be improved? mayb+

Code: (Select All)

'Fireworks 3 by SierraKen mod b+ 2024-12-29 Ken inspires me too!
'Firework sound from https://pixabay.com/sound-effects/search/fireworks/

'Thanks B+ for the inspiration.

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  ' <<< best Type for RGB colors

_Title "Fireworks"

file$ = "firework_single.mp3"
file2$ = "firework_single_small.mp3"
Song = _SndOpen(file$)
song2 = _SndOpen(file2$)
If Song < 1 Or song2 < 1 Then '  <<< for some reason not getting 2nd sound, oh my mistake later maybe make sure both loaded here
    Print "Failed to load a 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 * 200) + 55: green = (Rnd * 200) + 55: blue = (Rnd * 200) + 55

    ' vvvv why?  <<<<
    'If red > green And red > blue And red < 200 Then red = 255
    'If green > red And green > blue And green < 200 Then green = 255
    'If blue > red And blue > green And blue < 200 Then blue = 255
    'If blue < 150 Then blue = 255
    'If green < 150 Then green = 255
    'If red < 150 Then red = 255

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

    If booms < 11 Then _SndPlay Song Else _SndPlay song2
    'If booms > 10 Then _SndPlay song2 ' <<< combine lines above
    If booms < 11 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 < 11 Then _Limit (300 - b) + 60  ' <<< here I slow blast down as airs out
        'If booms < 30 Then _Delay .005  ' <<< see above
        'If booms > 29 Then _Limit 500  ' <<< see above
        Line (0, 0)-(800, 600), _RGB32(0, 0, 0, 10), BF
    Next b
    t = 1
    GoSub more

    booms = booms + 1
    _Title "Fireworks Boom:" + Str$(booms)  ' <<< to watch count to 10 not previous 40? Ken had
    If booms = 10 Then
        _SndStop Song
    End If
    If booms = 20 Then
        _SndStop song2
        Cls
        End
    End If

Loop Until InKey$ = Chr$(27)
End

more:
For t = 1 To 200
    r = Rnd * 2 '  <<< from 4 to 2 to contain spread a little more??
    a = Rnd * _Pi(2) ' <<<< (2) = pi times 2, does whole circle not half so angle is from 0 to 360 in degrees equivalent
    x(t) = r * Cos(a)
    y(t) = r * Sin(a)
    'If t < 50 Then xx(t) = r * Cos(a)
    'If t < 50 Then xx(t) = r * Cos(a) ' <<< this is error !!! , never mind I must of screwed up this line??? It's good in Ken's zip
    'If t > 49 Then xx(t) = r * -Cos(a)
    'If t > 49 Then yy(t) = r * -Sin(a)
    xx(t) = r * Cos(a): yy(t) = r * Sin(a) '<<<  (2) does whole circle not half
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
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

note: my changes marked with ' <<<