Fan Dance

[bplus]

Here is smaller beads at the ends of fans

Code: (Select All)

_Title "Fan Dance 3, press spacebar for new colors " 'b+ 2024-12-10 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, 2, 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))
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