Posts: 2,700
Threads: 124
Joined: Apr 2022
Reputation:
134
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 + ...
Posts: 456
Threads: 63
Joined: Apr 2022
Reputation:
10
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.) 
Posts: 2,700
Threads: 124
Joined: Apr 2022
Reputation:
134
Thanks Phil. Made my day!
b = b + ...
Posts: 545
Threads: 116
Joined: Apr 2022
Reputation:
39
Interesting optical shenanigans.
Posts: 56
Threads: 6
Joined: May 2022
Reputation:
1
02-17-2023, 01:26 AM
(This post was last modified: 02-17-2023, 06:58 AM by DANILIN.)
if all points are connected by lines in pairs:
what would visualization look like ?
![[Image: komb88.png]](http://kenokeno.ucoz.ru/white/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
Posts: 490
Threads: 95
Joined: Apr 2022
Reputation:
23
(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.
Posts: 2,700
Threads: 124
Joined: Apr 2022
Reputation:
134
02-18-2023, 04:14 PM
Looking good! Charlie 
b = b + ...
|
