Posts: 184
Threads: 22
Joined: Mar 2023
Reputation:
12
Can anyone make this program shorter and smoother? I played with it for a while and it's pretty good, but I'm wondering if there's a simpler, better approach to using the ASPECT value. (bplus, I'm looking at you.  )
Code: (Select All)
Option _Explicit ' A Spinning Circle
Screen _NewImage(600, 400, 32)
Dim As Integer b, c, counter ' Playing with Aspects
Dim As Single aspect, adder
Dim As _Unsigned Long col
$Color:32
counter = 0: col = Red
Do
aspect = 1: adder = .015 ' initial values
' ASPECTS 1 TO 70
For c = 1 To 9
For b = 1 To 10 ' redraw circle 10 times adding to the aspect each loop
Cls
aspect = aspect + adder ' increase the aspect by adder
Circle (_Width / 2, _Height / 2), 100, White, , , aspect
Paint (_Width / 2, _Height / 2), col, White
_Limit 110
_Display
Next b
If aspect >= 70 Then Exit For ' @ ~90 degrees drop thru to reverse loops
adder = adder * 2 ' adder amounts have to double after each 10-loop cycle to look right-ish
Next c
' * now reverse the process *
counter = counter + 1
If counter Mod 2 <> 0 Then If col = Red Then col = Green Else col = Red ' flip colors on odd cycles
For c = 1 To 9 ' ASPECTS 70 TO 1
For b = 1 To 10
Cls
aspect = aspect - adder
Circle (_Width / 2, _Height / 2), 100, White, , , aspect
If aspect <= 1 Then Exit For
Paint (_Width / 2, _Height / 2), col, White
_Limit 110
_Display
Next b
adder = adder / 2 '
Next c
counter = counter + 1
If counter = 4 Then counter = 0
If _KeyDown(27) Then System
Loop
System
Posts: 3,932
Threads: 175
Joined: Apr 2022
Reputation:
215
09-10-2024, 11:59 PM
(This post was last modified: 09-11-2024, 01:26 AM by bplus.)
Yours is nice I think you can cut it in half by eliminating the 2nd loop, seems like you might be able to change aspect like I change xr below.
here is a different approach:
Code: (Select All)
_Title "Spinning Circle" ' b+ 2024-09-10 highlight front edge
Screen _NewImage(620, 620, 32)
_ScreenMove 300, 60
cx = 308: cy = 308: xr = 0: dxr = 1: dyr = 1: yr = 300: c1~& = &HFFFF0000
Do
Cls
FEllipse cx, cy, xr, 300, &HFFFFFFFF
FEllipse 310, 310, xr, 300, c1~&
xr = xr + dxr
If xr > 300 Then dxr = -dxr: xr = 299: cx = 312: cy = 312: _Delay .1
If xr < 0 Then
dxr = -dxr: xr = 1: cx = 308: cy = 308
If c1~& = &HFFFF0000 Then c1~& = &HFF008800 Else c1~& = &HFFFF0000
End If
_Display
_Limit 120
Loop Until _KeyDown(27)
Sub FEllipse (CX As Long, CY As Long, xr As Long, yr As Long, C As _Unsigned Long)
If xr = 0 Or yr = 0 Then Exit Sub
Dim h2 As _Integer64, w2 As _Integer64, h2w2 As _Integer64
Dim x As Long, y As Long
w2 = xr * xr: h2 = yr * yr: h2w2 = h2 * w2
Line (CX - xr, CY)-(CX + xr, CY), C, BF
Do While y < yr
y = y + 1
x = Sqr((h2w2 - y * y * w2) \ h2)
Line (CX - x, CY + y)-(CX + x, CY + y), C, BF
Line (CX - x, CY - y)-(CX + x, CY - y), C, BF
Loop
End Sub
Edit Correction: I was flipping colors too often sorry, should be OK now!
b = b + ...
Posts: 2,694
Threads: 326
Joined: Apr 2022
Reputation:
217
Can't you just draw your circles, and then use _PutImage to flip them in/out? I swear, that's how somebody did it on here, or over at the old forums, for a coin toss, and the number of lines there were completely minimal.
Posts: 2,694
Threads: 326
Joined: Apr 2022
Reputation:
217
09-11-2024, 01:20 AM
(This post was last modified: 09-11-2024, 01:22 AM by SMcNeill.)
'Coin Obverse & Reverse
Code: (Select All) _MAPTRIANGLE (Radius%, Radius%)-(MapFrom!(N%, 0), MapFrom!(N%, 1))-(MapFrom!(N%, 2), MapFrom!(N%, 3)), Obverse& TO(SpinMeRound!(0, 0, 0), SpinMeRound!(0, 0, 1), SpinMeRound!(0, 0, 2) + Offset%)-(SpinMeRound!(0, 1, 0), SpinMeRound!(0, 1, 1), ZTemp!)-(SpinMeRound!(0, 2, 0), SpinMeRound!(0, 2, 1), ZTemp2!)
_MAPTRIANGLE (Radius%, Radius%)-(MapFrom!(N%, 4), MapFrom!(N%, 5))-(MapFrom!(N%, 6), MapFrom!(N%, 7)), Reverse& TO(SpinMeRound!(1, 0, 0), SpinMeRound!(1, 0, 1), SpinMeRound!(1, 0, 2) + Offset%)-(SpinMeRound!(1, 1, 0), SpinMeRound!(1, 1, 1), ZTemp1!)-(SpinMeRound!(1, 2, 0), SpinMeRound!(1, 2, 1), ZTemp3!)
'Coin Edge
_MAPTRIANGLE (0, 0)-(0, EdgeLess1%)-(EdgingLess1%, EdgeLess1%), EdgePart& TO(SpinMeRound!(0, 1, 0), SpinMeRound!(0, 1, 1), ZTemp!)-(SpinMeRound!(1, 1, 0), SpinMeRound!(1, 1, 1), ZTemp1!)-(SpinMeRound!(1, 2, 0), SpinMeRound!(1, 2, 1), ZTemp3!)
_MAPTRIANGLE (0, 0)-(EdgingLess1%, 0)-(EdgingLess1%, EdgeLess1%), EdgePart& TO(SpinMeRound!(0, 1, 0), SpinMeRound!(0, 1, 1), ZTemp!)-(SpinMeRound!(0, 2, 0), SpinMeRound!(0, 2, 1), ZTemp2!)-(SpinMeRound!(1, 2, 0), SpinMeRound!(1, 2, 1), ZTemp3!)
Most of the program has disappeared into the ether (it was saved as a dropbox file and deleted in the passing of time), but this is basically the main flip process that was discussed.
Might ask Richard Notley aka QWERKY if he still has a copy of that coin toss demo.
Posts: 2,694
Threads: 326
Joined: Apr 2022
Reputation:
217
And here's another flip the coin type demo I dug up:
Code: (Select All) 'Flip The Coin - By SierraKen
'Made on July 16, 2020.
'Thanks to Dav for the ring around the coin idea.
Screen _NewImage(800, 600, 32)
_Title "Left Click the coin to flip it in the air. Right Click the coin to spin it."
_Limit 100
Cls
x = 400: y = 450
For sz = .25 To 40 Step .25
Circle (x, y), sz, _RGB32(0, 100, 0)
Next sz
Circle (x, y), 41, _RGB32(0, 255, 0)
'Building
Line (380, 440)-(420, 455), _RGB32(0, 255, 0), B
Line (380, 455)-(370, 465), _RGB32(0, 255, 0)
Line (420, 455)-(430, 465), _RGB32(0, 255, 0)
'Stairs
For sty = 455 To 465 Step 2
For stx = 369 To 381
If Point(stx, sty) = _RGB32(0, 255, 0) Then
For stx2 = stx To 430
PSet (stx2, sty), _RGB32(0, 255, 0)
If Point(stx2 + 1, sty) = _RGB32(0, 255, 0) Then GoTo nex:
Next stx2
End If
Next stx
nex:
Next sty
Line (370, 465)-(430, 465), _RGB32(0, 255, 0)
Line (385, 440)-(415, 435), _RGB32(0, 255, 0), B
'Columns
xc = 380
For columns = 1 To 12
xc = xc + 3.33
Line (xc, 440)-(xc, 455), _RGB32(0, 255, 0)
Next columns
start:
Do
Do While _MouseInput
mouseX = _MouseX
mouseY = _MouseY
mouseLeftButton = _MouseButton(1)
mouseRightButton = _MouseButton(2)
Loop
If mouseRightButton Then
If Point(mouseX, mouseY) <> _RGB32(0, 0, 0) Then mouseRightButton = 0: GoTo spin:
End If
If mouseLeftButton Then
If Point(mouseX, mouseY) <> _RGB32(0, 0, 0) Then mouseLeftButton = 0: GoTo throw:
End If
Loop
spin:
Cls
x = 400: y = 450
tt = 1
yy = 10
For cc = 1 To 2
For c = 1 To 25
t = t + tt
If t > 2 Then tt = -.2
If t < 1 Then tt = .2
For sz = .25 To 40 Step .25
Circle (x, y), sz, _RGB32(0, 100, 0), , , t
Next sz
Circle (x, y), 41, _RGB32(0, 255, 0), , , t
x = x - yy
_Delay .02
Cls
Next c
yy = -10
Next cc
For cc = 1 To 2
For c = 1 To 25
t = t + tt
If t > 2 Then tt = -.2
If t < 1 Then tt = .2
For sz = .25 To 40 Step .25
Circle (x, y), sz, _RGB32(0, 100, 0), , , t
Next sz
Circle (x, y), 41, _RGB32(0, 255, 0), , , t
x = x - yy
_Delay .02
Cls
Next c
yy = 10
Next cc
GoTo outcome:
throw:
Cls
x = 400: y = 450
tt = .2
yy = 10
yy2 = 1
For cc = 1 To 2
For c = 1 To 30
t = t + tt
If t > 1 Then tt = -.3
If t < .2 Then tt = .3
For sz = .25 To 40 Step .25
Circle (x, y), sz, _RGB32(0, 100, 0), , , t
Next sz
Circle (x, y), 41, _RGB32(0, 255, 0), , , t
y = y - yy
yy = yy + yy2
_Delay .02
Cls
Next c
yy2 = -1
yy = -10
Next cc
'-------------- Draw the outcome -----------------
outcome:
Randomize Timer
side = Int(Rnd * 2) + 1
If side = 1 Then
For sz = .25 To 40 Step .25
Circle (x, y), sz, _RGB32(0, 100, 0)
Next sz
Circle (x, y), 41, _RGB32(0, 255, 0)
'Head
For sz = .25 To 20 Step .25
Circle (400, 450), sz, _RGB32(0, 255, 0), , , 1.25
Next sz
'Eye
For sz = .25 To 3 Step .25
Circle (390, 445), sz, _RGB32(0, 100, 0)
Next sz
'Nose
For sz = .25 To 5 Step .25
Circle (382, 450), sz, _RGB32(0, 255, 0), , , .5
Next sz
'Mouth
For sz = .25 To 5 Step .25
Circle (388, 457), sz, _RGB32(0, 100, 0), , , .5
Next sz
'Hair
For hy = 433 To 455 Step 3
For hx = 400 To 420 Step 3
If Point(hx, hy) = _RGB32(0, 255, 0) Then Circle (hx, hy), 2, _RGB32(0, 175, 0)
Next hx
Next hy
End If
If side = 2 Then
For sz = .25 To 40 Step .25
Circle (x, y), sz, _RGB32(0, 100, 0)
Next sz
Circle (x, y), 41, _RGB32(0, 255, 0)
'Building
Line (380, 440)-(420, 455), _RGB32(0, 255, 0), B
Line (380, 455)-(370, 465), _RGB32(0, 255, 0)
Line (420, 455)-(430, 465), _RGB32(0, 255, 0)
'Stairs
For sty = 455 To 465 Step 2
For stx = 369 To 381
If Point(stx, sty) = _RGB32(0, 255, 0) Then
For stx2 = stx To 430
PSet (stx2, sty), _RGB32(0, 255, 0)
If Point(stx2 + 1, sty) = _RGB32(0, 255, 0) Then GoTo nex2:
Next stx2
End If
Next stx
nex2:
Next sty
Line (370, 465)-(430, 465), _RGB32(0, 255, 0)
Line (385, 440)-(415, 435), _RGB32(0, 255, 0), B
'Columns
xc = 380
For columns = 1 To 12
xc = xc + 3.33
Line (xc, 440)-(xc, 455), _RGB32(0, 255, 0)
Next columns
End If
GoTo start:
Posts: 3,932
Threads: 175
Joined: Apr 2022
Reputation:
215
09-11-2024, 01:36 AM
(This post was last modified: 09-11-2024, 01:38 AM by bplus.)
@NakedApe I modified your code but don't think it runs as smoothly:
Code: (Select All)
Option _Explicit
_Title " A Spinning Circle: bplus mod of NakedApe"
Screen _NewImage(600, 400, 32)
Dim As Integer i, x, start, fini, stepper ' Playing with Aspects
Dim As Single aspect
Dim As _Unsigned Long col
$Color:32
Dim asp(1 To 8)
i = 1: x = 1: asp(1) = 1 ' make an array of aspect values that double from 1
While x < 70
i = i + 1: x = x * 2: asp(i) = x
Wend
col = Red: start = 1: fini = 8: 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 5
_Display
Next
If start = 1 Then
start = 8: fini = 1: stepper = -1
If col = Red Then col = Green Else col = Red ' flip colors on odd cycles
Else
start = 1: fini = 8: stepper = 1
End If
Loop Until _KeyDown(27)
b = b + ...
Posts: 3,932
Threads: 175
Joined: Apr 2022
Reputation:
215
Yeah a Rotozoom can spin a disk in all kinds of directions.
It's getting late, I leave that to another genius 
b = b + ...
Posts: 3,932
Threads: 175
Joined: Apr 2022
Reputation:
215
09-11-2024, 01:18 PM
(This post was last modified: 09-11-2024, 01:22 PM by bplus.)
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.
b = b + ...
Posts: 73
Threads: 3
Joined: Apr 2022
Reputation:
14
(09-11-2024, 01:20 AM)SMcNeill Wrote: 'Coin Obverse & Reverse
Code: (Select All) _MAPTRIANGLE (Radius%, Radius%)-(MapFrom!(N%, 0), MapFrom!(N%, 1))-(MapFrom!(N%, 2), MapFrom!(N%, 3)), Obverse& TO(SpinMeRound!(0, 0, 0), SpinMeRound!(0, 0, 1), SpinMeRound!(0, 0, 2) + Offset%)-(SpinMeRound!(0, 1, 0), SpinMeRound!(0, 1, 1), ZTemp!)-(SpinMeRound!(0, 2, 0), SpinMeRound!(0, 2, 1), ZTemp2!)
_MAPTRIANGLE (Radius%, Radius%)-(MapFrom!(N%, 4), MapFrom!(N%, 5))-(MapFrom!(N%, 6), MapFrom!(N%, 7)), Reverse& TO(SpinMeRound!(1, 0, 0), SpinMeRound!(1, 0, 1), SpinMeRound!(1, 0, 2) + Offset%)-(SpinMeRound!(1, 1, 0), SpinMeRound!(1, 1, 1), ZTemp1!)-(SpinMeRound!(1, 2, 0), SpinMeRound!(1, 2, 1), ZTemp3!)
'Coin Edge
_MAPTRIANGLE (0, 0)-(0, EdgeLess1%)-(EdgingLess1%, EdgeLess1%), EdgePart& TO(SpinMeRound!(0, 1, 0), SpinMeRound!(0, 1, 1), ZTemp!)-(SpinMeRound!(1, 1, 0), SpinMeRound!(1, 1, 1), ZTemp1!)-(SpinMeRound!(1, 2, 0), SpinMeRound!(1, 2, 1), ZTemp3!)
_MAPTRIANGLE (0, 0)-(EdgingLess1%, 0)-(EdgingLess1%, EdgeLess1%), EdgePart& TO(SpinMeRound!(0, 1, 0), SpinMeRound!(0, 1, 1), ZTemp!)-(SpinMeRound!(0, 2, 0), SpinMeRound!(0, 2, 1), ZTemp2!)-(SpinMeRound!(1, 2, 0), SpinMeRound!(1, 2, 1), ZTemp3!)
Most of the program has disappeared into the ether (it was saved as a dropbox file and deleted in the passing of time), but this is basically the main flip process that was discussed.
Might ask Richard Notley aka QWERKY if he still has a copy of that coin toss demo. I still found it on my computer. 
Flippin' Coin.zip (Size: 2.77 MB / Downloads: 31)
Posts: 3,932
Threads: 175
Joined: Apr 2022
Reputation:
215
09-11-2024, 05:45 PM
(This post was last modified: 09-11-2024, 05:50 PM by bplus.)
Re:Coin flip Update: "Crikey$" over 400 LOC and 0 subroutines Crikey indeed!
I wonder if Qwerky still looking in on us? last I heard he was quite ill, awile ago...
b = b + ...
|
