Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Are These Dots Spinning?
#1
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...
b = b + ...
Reply
#2
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!
Of all the places on Earth, and all the planets in the Universe, I'd rather live here (Perth, W.A.) Big Grin
Please visit my Website at: http://oldendayskids.blogspot.com/
Reply
#3
Thanks Phil. Made my day!
b = b + ...
Reply
#4
Interesting optical shenanigans.
Reply
#5
if all points are connected by lines in pairs:

what would visualization look like ?

[Image: komb88.png]
Write name of program in 1st line to copy & paste & save filename.bas
Insert program pictures: press print-screen-shot button
Open paint & Paste & Save as PNG
Add picture file to program topic

Russia looks world from future. Big data is peace data.
I never recommend anything & always write only about myself
Reply
#6
(02-15-2023, 08:38 PM)bplus Wrote:
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.
Reply
#7
Thumbs Up 
Looking good! Charlie Smile
b = b + ...
Reply




Users browsing this thread: 6 Guest(s)