Exploding Ascii Diamonds

[bplus]

Exploding Ascii Circles

Again pure Screen 0

Code: (Select All)

_Title "Exploding Ascii Circles" 'b+ 2025-11-16

' mod Exploding Ascii Diamonds to Circles

' from PM conversations with AsciiHole



Randomize Timer

_FullScreen

Type Circles

    As Integer xc, yc, c, life, active

End Type



Const NCircles = 3

Dim Shared C(1 To NCircles) As Circles



For i = 1 To NCircles ' initialize at random activation and life

    C(i).xc = Int(Rnd * _Width - 1) + 1

    C(i).yc = Int(Rnd * _Height - 1) + 1

    C(i).c = Int(Rnd * 9) + 7

    C(i).life = Int(Rnd * 15)

    C(i).active = Int(Rnd * 2)

Next



While _KeyDown(27) = 0

    Cls

    ExplodeCircles

    _Limit 10

Wend



Sub NewCircles (i)

    C(i).xc = Int(Rnd * _Width - 1) + 1

    C(i).yc = Int(Rnd * _Height - 1) + 1

    C(i).c = Int(Rnd * 9) + 7

    C(i).life = 0

    C(i).active = 1

End Sub



Sub ExplodeCircles

    For i = 1 To NCircles

        If C(i).active Then

            For dot = 0 To 3

                drawCircles C(i).xc, C(i).yc, C(i).life + dot, ".", C(i).c

            Next

            drawCircles C(i).xc, C(i).yc, C(i).life + 4, "+", C(i).c

            drawCircles C(i).xc, C(i).yc, C(i).life + 5, "*", C(i).c

            C(i).life = C(i).life + 1

            If C(i).life > 15 Then C(i).active = 0: C(i).life = 0

        Else

            If Rnd > .75 Then NewCircles i

        End If

    Next

End Sub



Sub drawCircles (xc, yc, r, s$, c)

    Color c

    For a = 0 To _Pi(2) - .001 Step _Pi(1 / 12)

        x = Int(xc + 2 * r * Cos(a))

        If x > 0 And x <= _Width - 1 Then

            y = Int(yc + r * Sin(a))

            If y > 0 And y <= _Height - 1 Then

                Locate y, x: Print s$;

            End If

        End If

    Next

End Sub

   

Thanks Pete, Petr for encouragement and AsciiHole for the challenge.