Posts: 184
Threads: 22
Joined: Mar 2023
Reputation:
12
09-11-2024, 06:19 PM
(This post was last modified: 09-11-2024, 07:11 PM by NakedApe.)
(09-11-2024, 01:18 PM)bplus Wrote: Ah fresh morning, fresh mind!
@NakedApe I hope you find this as good as I do! I mod my mod of your code:
Code: (Select All)
Option _Explicit
_Title " A Spinning Circle: bplus mod 2 of NakedApe"
Screen _NewImage(600, 400, 32)
Dim As Integer i, x, start, fini, stepper, top ' Playing with Aspects
Dim As _Unsigned Long col
$Color:32
Dim asp(1 To 90)
i = 1: asp(1) = 1 ' make an array of aspect values Note: asp(i) = Cos(_D2R(i)) will spin on the other axis
While i < 90
i = i + 1: asp(i) = 1 / Cos(_D2R(i))
Wend
top = i: col = Red: start = 1: fini = top: stepper = 1
Do
For i = start To fini Step stepper
Cls
Circle (_Width / 2, _Height / 2), 100, White, , , asp(i)
Paint (_Width / 2, _Height / 2), col, White
_Limit 60
_Display
Next
If start = 1 Then
start = top: fini = 1: stepper = -1
If col = Red Then col = Green Else col = Red ' flip colors on odd cycles
Else
start = 1: fini = top: stepper = 1
End If
Loop Until _KeyDown(27)
All smoothed out nicely.
By George, @bplus, you've done it. Nice morning thinking! I got my version down to one loop, but without the smoothness of assigning aspect values! +1 EDIT: And since you're on a roll, how would you mod it to work horizontally? Aspect values from 0.000001 to 1? Thnx! EDIT2: Nevermind. I see you already added a note about that! You're way ahead of me.
Posts: 184
Threads: 22
Joined: Mar 2023
Reputation:
12
And in case you're not looking for normalized, buttery-smooth spinning like the above by @bplus, here's a wobbly version that I boiled down from my original post.
Code: (Select All)
Screen _NewImage(600, 400, 32) '
Dim As Integer b, c, count, sign ' Playing with Aspects
Dim As Single aspect, steps ' ** ROTATING CIRCLE - ASYMETRICAL MOTION **
Dim As _Unsigned Long col
$Color:32
count = 0: col = Red: sign = 1: aspect = 1: steps = .015
Do
For c = 1 To 9
For b = 1 To 10
Cls
aspect = aspect + (steps * sign)
If aspect <= 1 Then sign = 1: steps = .015
Circle (_Width / 2, _Height / 2), 100, White, , , aspect
Paint (_Width / 2, _Height / 2), col, White
_Limit 75
_Display
Next b
If aspect >= 70 Then sign = -1: Exit For ' Max aspect = ~77.5
If sign = 1 Then steps = steps * 2 Else steps = steps / 2
Next c
count = count + 1
If count Mod 2 <> 0 Then If col = Red Then col = Green Else col = Red
If count = 4 Then count = 0
If _KeyDown(27) Then System
Loop
System
Posts: 3,932
Threads: 175
Joined: Apr 2022
Reputation:
215
09-12-2024, 07:04 PM
(This post was last modified: 09-12-2024, 07:12 PM by bplus.)
+1 @NakedApe less LOC than bplus, I wonder if Steve will give it a go?
Thanks to the guys adding coin flipping, I made a little game instigated by this thread
The genius who finally tried out Rotozoom had some fun!
https://qb64phoenix.com/forum/showthread...1#pid28301
b = b + ...
Posts: 2,695
Threads: 326
Joined: Apr 2022
Reputation:
217
Posts: 3,932
Threads: 175
Joined: Apr 2022
Reputation:
215
excuses excuses I think you will be gaining an hour this fall.
@NakedApe this can be combined to one line:
Code: (Select All) If _KeyDown(27) Then System
Loop
System
Loop Until _keydown(27) ' don't need system when trying to beat Steve in less LOC
b = b + ...
Posts: 2,695
Threads: 326
Joined: Apr 2022
Reputation:
217
09-12-2024, 07:26 PM
(This post was last modified: 09-12-2024, 07:27 PM by SMcNeill.)
(09-12-2024, 07:15 PM)bplus Wrote: excuses excuses I think you will be gaining an hour this fall.
@NakedApe this can be combined to one line:
Code: (Select All) If _KeyDown(27) Then System
Loop
System
Loop Until _keydown(27) ' don't need system when trying to beat Steve in less LOC
I can drop it down to 22 LOC, without much effort. How's this look for you:
Code: (Select All)
Screen _NewImage(600, 400, 32) '** ROTATING CIRCLE - ASYMETRICAL MOTION **
Dim As Integer b, c, count, sign ' Playing with Aspects
Dim col As _Unsigned Long, aspect As Single, steps As Single
count = 0: col = &HFFFF0000~&: sign = 1: aspect = 1: steps = .015
Do
For c = 1 To 9
For b = 1 To 10
Cls
aspect = aspect + (steps * sign)
If aspect <= 1 Then sign = 1: steps = .015
Circle (_Width / 2, _Height / 2), 100, &HFFFFFFFF~&, , , aspect
Paint (_Width / 2, _Height / 2), col, &HFFFFFFFF~&
_Limit 75
_Display
Next b
If aspect >= 70 Then sign = -1: Exit For ' Max aspect = ~77.5
If sign = 1 Then steps = steps * 2 Else steps = steps / 2
Next c
count = (count + 1) Mod 4
If count Mod 2 <> 0 Then If col = &HFFFF0000~& Then col = &HFF00FF00~& Else col = &HFFFF0000~&
If _KeyDown(27) Then System
Loop
Posts: 2,695
Threads: 326
Joined: Apr 2022
Reputation:
217
How about this version, if we're shooting for Lines of Code:
Code: (Select All)
Screen _NewImage(600, 400, 32) 'A Spinning Circle: bplus mod 2 of NakedApe, tweaked by Steve for LOC
Dim As Integer i, x, start, fini, stepper, top, col ' Playing with Aspects
Dim As _Unsigned Long col(-1 To 0): col(0) = &HFFFF0000~&: col(-1) = &HFF00FF00~&
Dim asp(1 To 90)
i = 1: asp(1) = 1: start = 1: fini = 90: stepper = 1 ' make an array of aspect values
For i = 2 To fini: asp(i) = 1 / Cos(_D2R(i)): Next
Do 'Note: asp(i) = Cos(_D2R(i)) will spin on the other axis
For i = start To fini Step stepper
Cls
Circle (_Width / 2, _Height / 2), 100, -1~&, , , asp(i)
Paint (_Width / 2, _Height / 2), col(col), -1~&
_Limit 60
_Display
Next
Swap start, fini: stepper = -stepper: If start = 90 Then col = Not col ' flip colors on odd cycles
Loop Until _KeyDown(27)
Posts: 3,932
Threads: 175
Joined: Apr 2022
Reputation:
215
09-12-2024, 07:54 PM
(This post was last modified: 09-12-2024, 07:56 PM by bplus.)
+1 @SMcNeill See you have time must have barrowed on that xtra hour coming up.
b = b + ...
Posts: 2,695
Threads: 326
Joined: Apr 2022
Reputation:
217
(09-12-2024, 07:54 PM)bplus Wrote: +1 @SMcNeill See you have time must have barrowed on that xtra hour c0oming up.
Aye, just doing some quick messing around to keep the brain sharp while my food is baking in the oven.
Posts: 184
Threads: 22
Joined: Mar 2023
Reputation:
12
Dang, nice work @SMcNeill and @bplus... Now I'm scared I'm actually learning things from you guys.
|