Posts: 3,987
Threads: 178
Joined: Apr 2022
Reputation:
222
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: 653
Threads: 96
Joined: Apr 2022
Reputation:
22
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!
Posts: 3,987
Threads: 178
Joined: Apr 2022
Reputation:
222
Thanks Phil. Made my day!
b = b + ...
Posts: 660
Threads: 142
Joined: Apr 2022
Reputation:
58
Interesting optical shenanigans.
Posts: 88
Threads: 8
Joined: May 2022
Reputation:
3
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: 597
Threads: 110
Joined: Apr 2022
Reputation:
34
(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: 3,987
Threads: 178
Joined: Apr 2022
Reputation:
222
02-18-2023, 04:14 PM
Looking good! Charlie 
b = b + ...
|
