Clouds? for 100 Lines or Less Challenge

[bplus]

+1 @ahenry3068 for being first!

OK I will try to assimulate your hints, thanks! I do insist on animation, I should have mentioned.

Code: (Select All)

Option _Explicit

_Title "2025-10-26-5 Clouds" 'b+ mod with filled circles

Randomize Timer

Const xmax = 600, ymax = 600, pi = _Pi, nb = 1500, blue = _RGB32(0, 0, 220)

Dim As Long i, j, testx, testy, lc

Dim As Single s, dist

Dim As Single bx(nb), by(nb), br(nb), ba(nb), da(nb, nb) ' new  da = distance array

Dim As _Unsigned Long bc(nb)

Dim As Single oldbx(nb), oldby(nb)

Screen _NewImage(xmax, ymax, 32)

_ScreenMove 100, 20

For i = 1 To nb

    bx(i) = Rnd * xmax ' start random screen x, y away from borders

    by(i) = Rnd * ymax

    br(i) = rand(1, 15)

    bc(i) = _RGB32(Rnd * 75 + 180)

    ba(i) = Rnd * 2 * pi

Next

Color , blue

Cls

_Display

While _KeyDown(27) = 0

    lc = lc + 1

    Line (0, 0)-(_Width, _Height), _RGB32(0, 0, 200, 140), BF

    For i = 1 To nb - 1 ' find all the distances between birds

        For j = i + 1 To nb ' fix bonehead error of doing this 2x's! thanks tsh73 for catch!

            da(i, j) = distance(bx(i), by(i), bx(j), by(j))

            da(j, i) = da(i, j) ' symetric relationship

        Next

    Next

    For i = 1 To nb 'draw then update positions of birds

        FC3 bx(i), by(i), br(i), bc(i) ' &HFFFFFFFF '

        s = rand(3, 5) ' get some bird separation here?

        bx(i) = bx(i) + s * Cos(ba(i))

        by(i) = by(i) + s * Sin(ba(i))

        ' JB&LB have better Mod function! tsh73 pointed it to me

        bx(i) = Mod2(bx(i) + xmax, xmax)

        by(i) = Mod2(by(i) + ymax, ymax)

        For j = i + 1 To nb

            dist = da(i, j)

            If dist < 20 Then ' birds are close enough to influence each other by visual

                'sway the neighbors headings towards each other

                ba(i) = AngleAve(ba(i), AngleAve(ba(i), ba(j)))

                ba(j) = AngleAve(ba(j), AngleAve(ba(i), ba(j)))

            End If

            'If dist > 5 And dist < 50 Then

            '    'stickiness stay close to neighbors, close distance between

            '    If Rnd < 1 Then

            '        bx(i) = bx(i) - .1 * (bx(i) - bx(j))

            '        bx(j) = bx(j) + .1 * (bx(i) - bx(j))

            '        by(i) = by(i) - .1 * (by(i) - by(j))

            '        by(j) = by(j) + .1 * (by(i) - by(j))

            '    End If

            'End If

            If dist < 5 Then ' too close!!!

                bx(i) = bx(i) + .1 * (bx(i) - bx(j))

                bx(j) = bx(j) - .1 * (bx(i) - bx(j))

                by(i) = by(i) + .1 * (by(i) - by(j))

                by(j) = by(j) - .1 * (by(i) - by(j))

            End If

        Next 'j

    Next ' i

    If lc > 15 Then _Display: _Limit 30

Wend

Function rand& (lo As Long, hi As Long) 'rand integer between lo and hi iclusive

    rand& = Int((hi - lo + 1) * Rnd + lo)

End Function

Function distance (x1, y1, x2, y2) ' default single OK

    distance = Sqr((x1 - x2) * (x1 - x2) + (y1 - y2) * (y1 - y2))

End Function

Function AngleAve (ra1, ra2) ' default single OK

    Dim twoPi, ray1, ray2, rtn

    twoPi = pi * 2

    ray1 = Mod2(ra1 + twoPi, twoPi)

    ray2 = Mod2(ra2 + twoPi, twoPi)

    rtn = (ray1 + ray2) / 2

    If Abs(ray1 - ray2) > pi Then rtn = Mod2(rtn - pi + twoPi, twoPi)

    AngleAve = rtn

End Function

Function Mod2# (n As Double, modulus As Double) ' this allows us to do floats including negative floats

    Dim rtn As Double

    rtn = modulus * (Abs(n) / modulus - Int(Abs(n) / modulus))

    If n < 0 Then rtn = -rtn

    Mod2# = rtn

End Function

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

I am ready for bubble bath

Edit: Oh remove : to separate statements on a like. 
Note: Even though 

Code: (Select All)

If lc > 15 Then _Display: _Limit 30

has colon in it, it is still one statement in my QB64 code challenge book anyway