New Years Eve Fireworks!

[SierraKen]

I fixed it! Now it's not square anymore. I also doubled the sparks for each explosion.

Code: (Select All)

'Fireworks 2 by SierraKen



'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)



_Title "Fireworks"



GoSub more



Randomize Timer

Do

    ce = ce + 1

    If ce > 200 Then ce = 1

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

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

    red = (Rnd * 200) + 55: green = (Rnd * 200) + 55: blue = (Rnd * 200) + 55

    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



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



    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

        _Delay .005

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

    Next b

    t = 1

    GoSub more

Loop Until InKey$ = Chr$(27)

End



more:

For t = 1 To 200

    r = Rnd * 4

    a = Rnd * _Pi

    x(t) = r * Cos(a)

    y(t) = r * Sin(a)

    If t < 50 Then xx(t) = r * Cos(a)

    If t < 50 Then yy(t) = r * Sin(a)

    If t > 49 Then xx(t) = r * -Cos(a)

    If t > 49 Then 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

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