Are These Dots Spinning?

[bplus]

Code: (Select All)

_Title "Do the dots in disk look like they are spinning?" ' B+ 2019-01-12
'try an optical illusion saw on Internet

Const xmax = 600
Const ymax = 600
Screen _NewImage(xmax, ymax, 32)
_ScreenMove 300, 60

x0 = xmax / 2: y0 = ymax / 2: a24 = _Pi(2 / 24): r = 240
While _KeyHit <> 27
    If loopcnt < 2 Then stopit = 11
    If loopcnt = 2 Then stopit = 0
    If loopcnt > 2 Then
        If stopit < 11 Then stopit = stopit + 1
    End If
    For a = 0 To _Pi(2) Step _Pi / 180
        Color _RGB32(128, 0, 0): fcirc x0, y0, 251
        For i = 0 To stopit
            If loopcnt > 1 Then
                xs = x0 + r * Cos(a24 * i)
                ys = y0 + r * Sin(a24 * i)
                xe = x0 + r * Cos(a24 * i + _Pi)
                ye = y0 + r * Sin(a24 * i + _Pi)
                Line (xs, ys)-(xe, ye), _RGB32(255, 255, 255)
            End If
            x = x0 + Cos(a + _Pi(i / 12)) * r * Cos(a24 * i)
            y = y0 + Cos(a + _Pi(i / 12)) * r * Sin(a24 * i)
            Color _RGB32(255, 255, 255)
            fcirc x, y, 10
        Next
        _Display
        _Limit 90
    Next
    loopcnt = loopcnt + 1
Wend

'Steve McNeil's  copied from his forum   note: Radius is too common a name
Sub fcirc (CX As Long, CY As Long, R As Long)
    Dim subRadius As Long, RadiusError As Long
    Dim X As Long, Y As Long

    subRadius = Abs(R)
    RadiusError = -subRadius
    X = subRadius
    Y = 0

    If subRadius = 0 Then PSet (CX, CY): Exit Sub

    ' Draw the middle span here so we don't draw it twice in the main loop,
    ' which would be a problem with blending turned on.
    Line (CX - X, CY)-(CX + X, CY), , 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), , BF
                Line (CX - Y, CY + X)-(CX + Y, CY + X), , BF
            End If
            X = X - 1
            RadiusError = RadiusError - X * 2
        End If
        Y = Y + 1
        Line (CX - X, CY - Y)-(CX + X, CY - Y), , BF
        Line (CX - X, CY + Y)-(CX + X, CY + Y), , BF
    Wend
End Sub

No...

[PhilOfPerth]

Fascinating!
I liked the second part better, when I fully expected some collisions to occur between the increasing number of balls.
Faultless programming, as usual, Well done!

[bplus]

Thanks Phil. Made my day!

[James D Jarvis]

Interesting optical shenanigans.

[DANILIN]

if all points are connected by lines in pairs:

what would visualization look like ?

[CharlieJV]

Code: (Select All)

_Title "Do the dots in disk look like they are spinning?" ' B+ 2019-01-12
'try an optical illusion saw on Internet

Const xmax = 600
Const ymax = 600
Screen _NewImage(xmax, ymax, 32)
_ScreenMove 300, 60

x0 = xmax / 2: y0 = ymax / 2: a24 = _Pi(2 / 24): r = 240
While _KeyHit <> 27
    If loopcnt < 2 Then stopit = 11
    If loopcnt = 2 Then stopit = 0
    If loopcnt > 2 Then
        If stopit < 11 Then stopit = stopit + 1
    End If
    For a = 0 To _Pi(2) Step _Pi / 180
        Color _RGB32(128, 0, 0): fcirc x0, y0, 251
        For i = 0 To stopit
            If loopcnt > 1 Then
                xs = x0 + r * Cos(a24 * i)
                ys = y0 + r * Sin(a24 * i)
                xe = x0 + r * Cos(a24 * i + _Pi)
                ye = y0 + r * Sin(a24 * i + _Pi)
                Line (xs, ys)-(xe, ye), _RGB32(255, 255, 255)
            End If
            x = x0 + Cos(a + _Pi(i / 12)) * r * Cos(a24 * i)
            y = y0 + Cos(a + _Pi(i / 12)) * r * Sin(a24 * i)
            Color _RGB32(255, 255, 255)
            fcirc x, y, 10
        Next
        _Display
        _Limit 90
    Next
    loopcnt = loopcnt + 1
Wend

'Steve McNeil's  copied from his forum   note: Radius is too common a name
Sub fcirc (CX As Long, CY As Long, R As Long)
    Dim subRadius As Long, RadiusError As Long
    Dim X As Long, Y As Long

    subRadius = Abs(R)
    RadiusError = -subRadius
    X = subRadius
    Y = 0

    If subRadius = 0 Then PSet (CX, CY): Exit Sub

    ' Draw the middle span here so we don't draw it twice in the main loop,
    ' which would be a problem with blending turned on.
    Line (CX - X, CY)-(CX + X, CY), , 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), , BF
                Line (CX - Y, CY + X)-(CX + Y, CY + X), , BF
            End If
            X = X - 1
            RadiusError = RadiusError - X * 2
        End If
        Y = Y + 1
        Line (CX - X, CY - Y)-(CX + X, CY - Y), , BF
        Line (CX - X, CY + Y)-(CX + X, CY + Y), , BF
    Wend
End Sub

No...

That is very awesome.  Thanks for sharing !

BAM version, slight mod for my needs: https://basicanywheremachine.neocities.o...s_illusion

Scroll down the page to view source code.

[bplus]

Looking good! Charlie