Fan Dance

[bplus]

Charlie gave me an idea or two:

Fan Dance 2:

Code: (Select All)

_Title "Fan Dance 2" 'b+ 2024-12-09 inspired and mod of Aurel Thingy

Screen _NewImage(900, 640, 32)

_ScreenMove 240, 60

xradius = 170: yradius = 150

cx = 450: cy = 320

scale = 1

xfactor = 10

yfactor = 7

Dim Shared PR, PB, PG, CN, cnStart

resetPlasma

Do

    Cls

    'cnStart = cnStart - 151

    CN = cnsrtart

    If _KeyDown(32) Then resetPlasma

    scale = 1

    While scale <= 150

        angle = 1

        While angle < 720

            x = (xradius + scale * Sin(_D2R(xfactor * angle))) * Cos(_D2R(angle))

            y = (yradius + scale * Sin(_D2R(yfactor * angle))) * Sin(_D2R(angle))

            If scale = 150 Then

                FC3 cx + x, cy + y, 8, Plasma~&

            Else

                PSet (cx + x, cy + y), &H229999FF

            End If

            angle = angle + .5

        Wend

        scale = scale + 1

    Wend

    _Display

    _Limit 200

    xfactor = xfactor + .005

    yfactor = yfactor - .005

Loop Until _KeyDown(27)



Function Plasma~& ()

    CN = CN + 1 'dim shared cN as _Integer64, pR as long, pG as long, pB as long

    Plasma~& = _RGB32(127 + 127 * Sin(PR * CN), 127 + 127 * Sin(PG * CN), 127 + 127 * Sin(PB * CN), 100)

End Function



Sub resetPlasma ()

    PR = Rnd ^ 2: PG = Rnd ^ 2: PB = Rnd ^ 2

End Sub



Sub FC3 (cx As Long, cy As Long, r As Long, clr~&) ' no suffix punctuation use the Global Default Type as Long or Single or Double

    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