Bright Circle Colors

[bplus]

My very first proggie posted here:

Code: (Select All)

_Title "Light up your balls" 'b+ 2022-04-24

Screen _NewImage(800, 600, 32)

_ScreenMove 300, 40

Randomize Timer

balls = 25

Dim r(balls), x(balls), y(balls), c~&(balls)

For i = 1 To balls

    r(i) = Rnd * 80 + 15

    x(i) = Rnd * _Width

    y(i) = Rnd * _Height

    c~&(i) = _RGB32(Rnd * 100, Rnd * 100, Rnd * 100)

Next

For f## = 0 To 1 Step .01

    Cls

    For b = 0 To balls

        rr = _Red32(c~&(b)): gg = _Green32(c~&(b)): bb = _Blue32(c~&(b))

        m~& = midInk~&(rr, gg, bb, 255, 255, 255, f##)

        drawBall x(b), y(b), r(b), m~&

    Next

    Print f##

    _Display

    _Limit 10

Next



Function midInk~& (r1%, g1%, b1%, r2%, g2%, b2%, fr##)

    midInk~& = _RGB32(r1% + (r2% - r1%) * fr##, g1% + (g2% - g1%) * fr##, b1% + (b2% - b1%) * fr##)

End Function



Sub drawBall (x, y, r, c As _Unsigned Long)

    Dim rred As Long, grn As Long, blu As Long, rr As Long, f

    rred = _Red32(c): grn = _Green32(c): blu = _Blue32(c)

    For rr = r To 0 Step -1

        f = .5 * (1 - rr / r) + .5

        fcirc x, y, rr, _RGB32(rred * f, grn * f, blu * f)

    Next

End Sub



'from Steve Gold standard

Sub fcirc (CX As Long, CY As Long, R As Long, C As _Unsigned Long)

    Dim Radius As Long, RadiusError As Long

    Dim X As Long, Y As Long

    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

Ah the memories