Glow Bug

[bplus]

here s'more!

Code: (Select All)

Option _Explicit

_Title "More Glow Bugs" 'b+ 2025-01-18

Dim As Long i, nBugs: nBugs = 250

Dim Shared As Long x(1 To nBugs), y(1 To nBugs), sz(1 To nBugs), r(1 To nBugs)

Dim Shared As Single dx(1 To nBugs), dy(1 To nBugs), a(1 To nBugs), da(1 To nBugs)

Dim Shared c(1 To nBugs) As _Unsigned Long



Screen _NewImage(1000, 600, 32): _ScreenMove 150, 60

For i = 1 To nBugs

    newBug (i)

Next

Do

    Line (0, 0)-(_Width, _Height), &H15000000, BF

    For i = 1 To nBugs

        FC3 x(i) + r(i) * Cos(a(i)), y(i) + r(i) * Sin(a(i)), sz(i), c(i)

        FC3 x(i) + r(i) * Cos(a(i)), y(i) + r(i) * Sin(a(i)), sz(i) * 2, &H15FFFF00

        x(i) = x(i) + dx(i)

        y(i) = y(i) + dy(i)

        a(i) = a(i) + da(i)

        If x(i) < -5 Or x(i) > _Width + 5 Or y(i) < -5 Or y(i) > _Height + 5 Then newBug (i)

    Next

    _Display

    _Limit 60

Loop Until _KeyDown(27)



Sub newBug (i As Long)

    Dim As Long dir, red

    Select Case Int(Rnd * 4)

        Case 0: x(i) = 0: y(i) = Rnd * (_Height - 100) + 50: dx(i) = Rnd * 3: dy(i) = Rnd * 6 - 3

        Case 1: x(i) = _Width: y(i) = Rnd * (_Height - 100) + 50: dx(i) = Rnd * -3: dy(i) = Rnd * 6 - 3

        Case 2: x(i) = Rnd * (_Width - 100) + 50: y(i) = 0: dx(i) = Rnd * 6 - 3: dy(i) = Rnd * 3

        Case 3: x(i) = Rnd * (_Width - 100) + 50: y(i) = _Height: dx(i) = Rnd * 6 - 3: dy(i) = Rnd * -3

    End Select

    dir = _IIf(Rnd < .5, -1, 1): da(i) = dir * (Rnd * _Pi(1 / 60) + _Pi(1 / 180))

    sz(i) = Rnd * 5 + 1: a(i) = dir * Rnd * _Pi(2): r(i) = Rnd * 30 + 20

    red = Rnd * 100 + 50

    c(i) = _RGB32(red, red + Rnd * 100, 0)

End Sub



Sub FC3 (cx As Long, cy As Long, r As Long, clr~&)

    Dim As Long r2, x, y ' for Option _Explicit

    If r < 1 Then Exit Sub

    Line (cx - r, cy)-(cx + r, cy), clr~&, BF

    r2 = r * r

    Do

        y = y + 1

        x = Sqr(r2 - y * y)

        Line (cx - x, cy + y)-(cx + x, cy + y), clr~&, BF

        Line (cx - x, cy - y)-(cx + x, cy - y), clr~&, BF

    Loop Until y = r

End Sub

Edit: a little fix with da() added