+- QB64 Phoenix Edition (https://qb64phoenix.com/forum)
+-- Forum: QB64 Rising (https://qb64phoenix.com/forum/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://qb64phoenix.com/forum/forumdisplay.php?fid=3)
+---- Forum: Programs (https://qb64phoenix.com/forum/forumdisplay.php?fid=7)
+---- Thread: Fan Dance (/showthread.php?tid=3263)
Fan Dance - bplus - 12-09-2024
b+ Mod of Aurel's thingy from VB
Code: (Select All)
_Title "Fan Dance" '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
Do
Cls
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))
PSet (cx + x, cy + y)
angle = angle + .5
Wend
scale = scale + .5
Wend
_Display
_Limit 30
xfactor = xfactor + .01
yfactor = yfactor - .01
Loop Until _KeyDown(27)
RE: Fan Dance - bplus - 12-11-2024
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
RE: Fan Dance - SierraKen - 12-11-2024
That's AWESOME B+! The more you watch, the more it becomes life-like. Like a creature in the ocean.
RE: Fan Dance - bplus - 12-11-2024
Yeah, it is like those jelly fish that light up
RE: Fan Dance - bplus - 12-11-2024
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 SubRE: Fan Dance - SierraKen - 12-12-2024
Totally rad! Stuff people see in music clubs.