+- QB64 Phoenix Edition (https://qb64phoenix.com/forum)
+-- Forum: QB64 Rising (https://qb64phoenix.com/forum/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://qb64phoenix.com/forum/forumdisplay.php?fid=3)
+---- Forum: Programs (https://qb64phoenix.com/forum/forumdisplay.php?fid=7)
+---- Thread: Another small filled circe sub (not as fast as fcirc) (/showthread.php?tid=2989)
RE: Another small filled circe sub (not as fast as fcirc) - SierraKen - 08-31-2024
(08-31-2024, 08:10 AM)Thanks Bplus, I was wondering why it wasn't being used. I still have the original one, I'll try to use that, or Dav's. bplus Wrote: Thats really slow and doesn't work for transparent colors
Code: (Select All)Screen _NewImage(800, 600, 32)
diameter = 200
Circle (400, 300), diameter, _RGB32(0, 255, 0)
Locate 1, 1: Input "Press Enter To Fill Circle", a$
For sz = .1 To diameter Step .1
Circle (400, 300), sz, _RGB32(255, 0, 0, 10)
Next sz
This old way is slow and leaves border and does not work with transparent borders
Code: (Select All)Screen _NewImage(800, 600, 32)
diameter = 200
Circle (400, 300), diameter, _RGB32(0, 255, 0)
Locate 1, 1: Input "Press Enter To Fill Circle", a$
Paint (400, 300), _RGB32(0, 0, 255, 40), _RGB32(0, 255, 0)
RE: Another small filled circe sub (not as fast as fcirc) - Pete - 08-31-2024
(08-31-2024, 03:00 AM)bplus Wrote: here's where it gets "fun"
I changed the order of tests and did them on fullscreen because no way I have a screen as wide as you used!
Gold run first, Dav 2nd and finish with Vince = completely different race
Code: (Select All)_Define A-Z As LONG
Option _Explicit
Const CCOLOR~& = _RGBA32(0, 100, 0, 100)
_Title "Sam Circle Fill speed tests"
Screen _NewImage(1830, 680, 32)
_FullScreen
' Dry run
Sleep 1
_PrintString (0, 0), "Dry run..."
Run_Test 10000
' Showdown
Sleep 5
Cls
_PrintString (0, 0), "Showdown..."
Run_Test 200000
End
Sub Run_Test (iterations As Long)
Static As Double start, finish
Static i As Long
_Display
start = Timer
For i = 1 To iterations
FC_Gold 1525, 305, 300, CCOLOR
Next
finish = Timer(0.001!) - start
_AutoDisplay
_PrintString (1300, 615), "Time for" + Str$(iterations) + " Gold Standard Circle Fills:" + Str$(finish)
_Display
start = Timer(0.001!)
For i = 1 To iterations
FC_Dav 305, 305, 300, CCOLOR
Next
finish = Timer(0.001!) - start
_AutoDisplay
_PrintString (100, 615), "Time for" + Str$(iterations) + " Contender Fills (Dav):" + Str$(finish)
_Display
start = Timer
For i = 1 To iterations
FC_Vince 915, 305, 300, CCOLOR
Next
finish = Timer(0.001!) - start
_AutoDisplay
_PrintString (700, 615), "Time for" + Str$(iterations) + " Contender Fills (Vince):" + Str$(finish)
'_DISPLAY
'start = TIMER
'FOR i = 1 TO iterations
' FC_Gold 1525, 305, 300, CCOLOR
'NEXT
'finish = TIMER(0.001!) - start
'_AUTODISPLAY
'_PRINTSTRING (1300, 615), "Time for" + STR$(iterations) + " Gold Standard Circle Fills:" + STR$(finish)
End Sub
Sub FC_Gold (cx As Long, cy As Long, r As Long, c As _Unsigned Long)
$Checking:Off
Dim radius As Long: radius = Abs(r)
Dim radiusError As Long: radiusError = -radius
Dim x As Long: x = radius
Dim y As Long
If radius = 0 Then
PSet (cx, cy), c
Exit Sub
End If
Line (cx - x, cy)-(cx + x, cy), c, BF
Do While x > y
radiusError = radiusError + _ShL(y, 1) + 1
If radiusError >= 0 Then
If x <> y + 1 Then
Line (cx - y, cy - x)-(cx + y, cy - x), c, BF
Line (cx - y, cy + x)-(cx + y, cy + x), c, BF
End If
x = x - 1
radiusError = radiusError - _ShL(x, 1)
End If
y = y + 1
Line (cx - x, cy - y)-(cx + x, cy - y), c, BF
Line (cx - x, cy + y)-(cx + x, cy + y), c, BF
Loop
$Checking:On
End Sub
Sub FC_Dav (cx As Long, cy As Long, r As Long, c As _Unsigned Long)
$Checking:Off
Dim r2 As Long: r2 = r * r
Dim As Long x, y
Line (cx - r, cy)-(cx + r, cy), c, BF
Do While y < r
y = y + 1
x = Sqr(r2 - y * y)
Line (cx - x, cy + y)-(cx + x, cy + y), c, BF
Line (cx - x, cy - y)-(cx + x, cy - y), c, BF
Loop
$Checking:On
End Sub
Sub FC_Vince (cx As Long, cy As Long, r As Long, c As _Unsigned Long)
$Checking:Off
Dim e As Long: e = -r
Dim x As Long: x = r
Dim y As Long
Do While y < x
If e <= 0 Then
y = y + 1
Line (cx - x, cy + y)-(cx + x, cy + y), c, BF
Line (cx - x, cy - y)-(cx + x, cy - y), c, BF
e = e + _ShL(y, 1)
Else
Line (cx - y, cy - x)-(cx + y, cy - x), c, BF
Line (cx - y, cy + x)-(cx + y, cy + x), c, BF
x = x - 1
e = e - _ShL(x, 1)
End If
Loop
Line (cx - r, cy)-(cx + r, cy), c, BF
$Checking:On
End Sub
Here are results:
A 2nd run and Gold Standard proves itself
So I ran Mark's code on my Merlin 1200 and got the opposite results...
As far as While/Wend goes, absolutely nothing against it or any other iteration loops in our tool box. I was pointing out some subtle differences between entry and exit types, While/Wend vs Do While/Loop, and postulating that there may be a speed difference.
Fun thread...
Pete
RE: Another small filled circe sub (not as fast as fcirc) - bplus - 08-31-2024
Looks like FC_Dav* came in first, like my first screen shot test of Samuels' code after modifying the order of the tests.
FC_Dav* came in 2nd in my 2nd screen shot. * FC_Dav is Samuels name system, I prefer FC3.
What is opposite? You are opposite Samuel's screen shots because you used my code and ran Gold first in the sequence and for some reason that is the unlucky position. Put any of them in first run position and they will likely do the worse. Don't ask me why the first run is so handicapped but I find it over and over!
These subs are so close that anything in background like browser or running IDE in background or move your mouse or fart and the results will be different.
I think any of these versions including the Square Filled Circle fill are fast enough to serve the circle fill function, so at this point I'd say it's a matter of which appeals to you.
The Gold Standard and the Square filled are definitely the most insteresting and vince version is not far from the Gold Standard, so ???
If I want to save on LOC I will go with FC3.
RE: Another small filled circe sub (not as fast as fcirc) - Pete - 08-31-2024
I like FC3 modified this way...
Code: (Select All)
Sub fc3 (cx, cy, r, clr~&)
Line (cx - r, cy)-(cx + r, cy), clr~&, BF
r2 = r * r
Do
x = Sqr(r2 - y * y)
Line (cx - x, cy + y)-(cx + x, cy + y), clr~&, BF
Line (cx - x, cy - y)-(cx + x, cy - y), clr~&, BF
y = y + 1
Loop Until y = r
End SubI favor the SQR() method as it was what I ran with in the flat ellipse project. I did have to use _INTEGER64 for the non-x and non-y variables to get uniform results with various ellipse sizes. I don't know if a circle fill would have similar/same size issues. I also recall something a bit off with QB64 SQR() while doing string math, where complex calculations differed a bit from online calculator sources. I'm not quite sure where that info was documented. The flat ellipse stuff in in the thread: https://qb64forum.alephc.xyz/index.php?topic=1044.0
BTW - I've speed tested my modification. It won twice and lost once. There is no definitive way of knowing, so I'm going with what I consider the best looping process, unless otherwise proven definitively incorrect. I can picture Steve wringing his
hands as I speak!
Pete
RE: Another small filled circe sub (not as fast as fcirc) - bplus - 08-31-2024
(08-31-2024, 09:01 PM)Pete Wrote: I like FC3 modified this way...
Code: (Select All)Sub fc3 (cx, cy, r, clr~&)
Line (cx - r, cy)-(cx + r, cy), clr~&, BF
r2 = r * r
Do
x = Sqr(r2 - y * y)
Line (cx - x, cy + y)-(cx + x, cy + y), clr~&, BF
Line (cx - x, cy - y)-(cx + x, cy - y), clr~&, BF
y = y + 1
Loop Until y = r
End Sub
I favor the SQR() method as it was what I ran with in the flat ellipse project. I did have to use _INTEGER64 for the non-x and non-y variables to get uniform results with various ellipse sizes. I don't know if a circle fill would have similar/same size issues. I also recall something a bit off with QB64 SQR() while doing string math, where complex calculations differed a bit from online calculator sources. I'm not quite sure where that info was documented. The flat ellipse stuff in in the thread: https://qb64forum.alephc.xyz/index.php?topic=1044.0
BTW - I've speed tested my modification. It won twice and lost once. There is no definitive way of knowing, so I'm going with what I consider the best looping process, unless otherwise proven definitively incorrect. I can picture Steve wringing his
hands as I speak!
Pete
2 problems with your code:
1) overlapping lines, 3 are drawn actually, at the equator y = 0
2) you exit before y gets drawn with 2 lines at the r value
All is fixed by this!
Code: (Select All)
Screen _NewImage(800, 600, 32)
_ScreenMove 200, 50
fc3 400, 300, 290, _RGB32(0, 0, 255, 100) ' <<<< shows no overlapping lines at equator NOW
Sleep
Sub fc3 (cx, cy, r, clr~&)
Line (cx - r, cy)-(cx + r, cy), clr~&, BF ' this line gets y = 0
r2 = r * r
Do
' you would do y = 0 2 more times unless you increase y first thing into loop
y = y + 1 ' do y + 1 first!!! so y reaches r and draws 2 lines, then quits!
x = Sqr(r2 - y * y)
Line (cx - x, cy + y)-(cx + x, cy + y), clr~&, BF
Line (cx - x, cy - y)-(cx + x, cy - y), clr~&, BF
Loop Until y = r
End SubRE: Another small filled circe sub (not as fast as fcirc) - Pete - 08-31-2024
That works, + 1.
Pete
RE: Another small filled circe sub (not as fast as fcirc) - bplus - 08-31-2024
Thanks!
Preparing FC3 for my toolbox I ran into a little snag, when r = 0 the SQR bombs so we have to exit if r < 1.
If r < 1 Then Exit Sub or Pset(cx, cy), clr~& and then exit sub
Here is a little demo of FC3 working off Old Moses demo of square filled circle fills:
Code: (Select All)
_Title "FC3 best version yet" ' b+ 2024-08-31
Option _Explicit
Screen _NewImage(1200, 640, 32)
_ScreenMove 50, 40
Dim x%, r
For x% = 0 To 49
FC3 (x% Mod 10) * 120 + 60, (x% \ 10) * 120 + 60, x% + 10, _RGB32(0, 128, 0, 100)
Next x%
For r = 290 To 35 Step -2
FC3 600, 320, r, _RGB32(0, 0, 255, 2) ' <<<< show no overlapping lines at equator or else where
Next
Sleep
Sub FC3 (cx, cy, r, clr~&) ' no suffix punctuation use the Global Default Type as Long or Single or Double
Dim r2, x, y ' for Option _Explicit
If r < 1 Then Exit Sub
Line (cx - r, cy)-(cx + r, cy), clr~&, BF
r2 = r * r
Do
y = y + 1
x = Sqr(r2 - y * y)
Line (cx - x, cy + y)-(cx + x, cy + y), clr~&, BF
Line (cx - x, cy - y)-(cx + x, cy - y), clr~&, BF
Loop Until y = r
End SubRE: Another small filled circe sub (not as fast as fcirc) - Dav - 09-01-2024
That looks pretty solid, bplus. I don't think it can be further optimized. The DIM line added for option explicit doesn't seem to slow it down at all for me here.
- Dav
RE: Another small filled circe sub (not as fast as fcirc) - bplus - 09-01-2024
Yes and I don't expect the Loop Until to change anything with speeds either.
I like how allot of people have a little piece of this small routine
Still need to run speed tests with this version. I'll let you all know if something unexpected comes up.
RE: Another small filled circe sub (not as fast as fcirc) - a740g - 09-01-2024
Ok. So, I did some research and figured out that the FC_Gold (a.k.a. FC0) performs well because it avoids the branching (ELSE part) inside the main loop. I made some modifications to optimize it even further. It avoids some unnecessary things keeping in mind not to overdraw pixels and hence not screwing up alpha blending.
Code: (Select All)
SUB DrawFilledCircle (cx AS LONG, cy AS LONG, r AS LONG, c AS _UNSIGNED LONG)
$CHECKING:OFF
IF r <= 0 THEN
PSET (cx, cy), c
EXIT SUB
END IF
DIM e AS LONG: e = -r
DIM x AS LONG: x = r
DIM y AS LONG
LINE (cx - x, cy)-(cx + x, cy), c, BF
DO WHILE x > y
y = y + 1
e = e + y * 2
IF e >= 0 THEN
IF x <> y THEN
LINE (cx - y, cy - x)-(cx + y, cy - x), c, BF
LINE (cx - y, cy + x)-(cx + y, cy + x), c, BF
END IF
x = x - 1
e = e - x * 2
END IF
LINE (cx - x, cy - y)-(cx + x, cy - y), c, BF
LINE (cx - x, cy + y)-(cx + x, cy + y), c, BF
LOOP
$CHECKING:ON
END SUB