+- 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)
Another small filled circe sub (not as fast as fcirc) - Dav - 08-28-2024
Here's yet another filled circle SUB. I make a lot program using balls. A personal challenge I've had for some time - trying to get a faster filled circle routine than the awesome fcirc SUB. This came close, but fcirc still reigns supreme. So I will finally yield to the champ (fcirc), posting the final attempt here. On my laptop fcirc edges out the victory everytime. I find it rather surprising - fcirc has many more lines of code, but it's still so fast.
- Dav
Code: (Select All)
'FC.BAS
'Dav, AUG/2024
'fc & fcirc circle fill test.
'testing two filled circle SUB's for the fastest one.
'draws 100,000 circles and compares speed.
'fcirc still reigns as fastest on my laptop, by a little.
Screen _NewImage(1000, 700, 32)
'time the fc sub
t# = Timer
For c = 1 To 100000
fc Rnd * _Width, Rnd * _Height, 35, _RGB(Rnd * 255, Rnd * 255, Rnd * 255)
Next
t1# = Timer - t#
'time the fcirc sub
t# = Timer
For c = 1 To 100000
fcirc Rnd * _Width, Rnd * _Height, 35, _RGB(Rnd * 255, Rnd * 255, Rnd * 255)
Next
t2# = Timer - t#
Print
Print "fc ="; t1#
Print "fcirc ="; t2#
Print
If t2# < t1# Then
Print "fcirc wins!"
Else
Print "fc wins!"
End If
Sub fc (cx, cy, r, clr&)
For y = -r To r
x = Int(Sqr(r * r - y * y))
Line (cx - x, cy + y)-(cx + x, cy + y), clr&, BF
Next
End Sub
Sub fcirc (CX As Integer, CY As Integer, R As Integer, C As _Unsigned Long)
Dim Radius As Integer, RadiusError As Integer
Dim X As Integer, Y As Integer
Radius = Abs(R): RadiusError = -Radius: X = Radius: Y = 0
If Radius = 0 Then PSet (CX, CY), C: Exit Sub
Line (CX - X, CY)-(CX + X, CY), C, 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), C, BF
Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
End If
X = X - 1
RadiusError = RadiusError - X * 2
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
Wend
End Sub
RE: Another small filled circe sub (not as fast as fcirc) - SMcNeill - 08-28-2024
The trick with fcirc is that it takes advantage of a circle's mirror-like properties. You get one point, you've got 8.
For example, let's imagine a circle 100 pixels tall and 100 pixels wide. (It's got a radius of 50.)
From the very start, we can see that mirroring at work.
On the X axis, you're going to go 50 pixels left of the center to plot that first set of circle coordinates.
You're also going to go 50 pixels right from the center to plot that first set of circle coordinates.
And, on the Y axis, you're going to 50 pixels up to plot a point
and 50 pixels down to plot a point.
Knowing one offset (0 from center), you now easily have 4 points of the circle's perimeter.
Now, if you go one offset away from center, such as UP one point on the Y-axis, you can calculate the X-point once for the matching coordinate for the triangle with 1 height, 50 hypotenuse, and a 90 degree angle...
That point is valid for 1 pixel up from the center, and right that amount.
That point is also valid for 1 pixel up from the center, and left that amount.
That point is valid for 1 pixel down from the center, and right that amount.
That point is valid for 1 pixel down from the center, and left that amount.
...
And if we inverse our X/Y as we're looking at a perfect mirror here,
That point is valid for 1 pixel right from the center, and up that amount.
That point is also valid for 1 pixel right from the center, and down that amount.
That point is valid for 1 pixel left from the center, and up that amount.
That point is valid for 1 pixel left from the center, and down that amount.
You calculated one math point, and in return, you got 8 circle coordinates!
You're not drawing one line at a time, you're drawing a line in ALL FOUR QUADRANTS at a time.
Minimum points of calculation needed, so maximum performance.
And that's basically how fcirc works in a butshell.
RE: Another small filled circe sub (not as fast as fcirc) - SMcNeill - 08-28-2024
The one way that I've thought fcirc might actually be improved is if we:
1) draw a center square of maximum size inside the circle first. Fill it with a single LINE,,,,BF statement.
2) then calculate from the outer axis points inwards until we fill up to that same point that the square has already covered. This should prevent overlap or any such thing and might speed up the whole process overall.
I just haven't gotten around to sitting down and giving it a test run yet, though you can do so yourself sometime, if you ever fill like it.
RE: Another small filled circe sub (not as fast as fcirc) - Dav - 08-28-2024
Oh I see. Thanks for the details!
Yes, drawing a big square in the middle at Maximus range, then filling in the edges to complete the circle would probably a faster way. That gives me something to play with. Thanks!
- Dav
RE: Another small filled circe sub (not as fast as fcirc) - bplus - 08-28-2024
Holy ship! FC2 edges out fcirc!
Code: (Select All)
'FC.BAS
'Dav, AUG/2024 bplus mod 2024-08-28 try faster FC2 mod of fc
'fc & fcirc circle fill test.
'testing two filled circle SUB's for the fastest one.
'draws 100,000 circles and compares speed.
'fcirc still reigns as fastest on my laptop, by a little.
Screen _NewImage(1000, 700, 32)
_ScreenMove 150, 0
Randomize Timer
Print "Overlapping lines check of FC2"
FC2 500, 350, 300, &H200000FF ' check for overlapping lines
Print "Looking good! no lighter lines." ' FC passes too BTW
Print: Print " zzz... press any for timed test"
Sleep
'time the fc sub
t# = Timer
For c = 1 To 200000
fcirc Rnd * _Width, Rnd * _Height, 35, _RGB(Rnd * 255, Rnd * 255, Rnd * 255)
Next
t1# = Timer - t#
'time the fc2 sub
t# = Timer
For c = 1 To 200000
FC2 Rnd * _Width, Rnd * _Height, 35, _RGB(Rnd * 255, Rnd * 255, Rnd * 255)
Next
t2# = Timer - t#
Print
Print "fcirc ="; t1#
Print " FC2 ="; t2#
Print
If t2# < t1# Then
Print "FC2 wins!"
Else
Print "fcirc wins!"
End If
Sub fc (cx, cy, r, clr&)
For y = -r To r
x = Int(Sqr(r * r - y * y))
Line (cx - x, cy + y)-(cx + x, cy + y), clr&, BF
Next
End Sub
Sub FC2 (cx, cy, r, clr&)
Line (cx - r, cy)-(cx + r, cy), clr&, BF
For y = 1 To r
x = Int(Sqr(r * r - y * y))
Line (cx - x, cy + y)-(cx + x, cy + y), clr&, BF
Line (cx - x, cy - y)-(cx + x, cy - y), clr&, BF
Next
End Sub
Sub fcirc (CX As Integer, CY As Integer, R As Integer, C As _Unsigned Long)
Dim Radius As Integer, RadiusError As Integer
Dim X As Integer, Y As Integer
Radius = Abs(R): RadiusError = -Radius: X = Radius: Y = 0
If Radius = 0 Then PSet (CX, CY), C: Exit Sub
Line (CX - X, CY)-(CX + X, CY), C, 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), C, BF
Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
End If
X = X - 1
RadiusError = RadiusError - X * 2
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
Wend
End SubRE: Another small filled circe sub (not as fast as fcirc) - bplus - 08-28-2024
OK sometimes it goes the other way
RE: Another small filled circe sub (not as fast as fcirc) - a740g - 08-28-2024
@bplus try with optimization enabled and disabled. Would be interesting to see.
RE: Another small filled circe sub (not as fast as fcirc) - bplus - 08-28-2024
I did and no better results with everything as Integer or Long in fact worse in few tests I looked at.
On the other hand I didn't try a faster loop structure!!!
RE: Another small filled circe sub (not as fast as fcirc) - bplus - 08-28-2024
OK even better! AND Fcirc no longer gets ties
Code: (Select All)
_Title "FC2 edges out fcirc" ' b+ 2024-08-28
'Dav, AUG/2024 bplus mod 2024-08-28 try faster FC2 mod of fc
'fc & fcirc circle fill test.
'testing two filled circle SUB's for the fastest one.
'draws 100,000 circles and compares speed.
'fcirc still reigns as fastest on my laptop, by a little.
Screen _NewImage(1000, 700, 32)
_ScreenMove 150, 0
Randomize Timer
Print "Overlapping lines check of FC2"
FC2 500, 350, 300, &H200000FF ' check for overlapping lines
Print "Looking good! no lighter lines." ' FC passes too BTW
Print: Print " zzz... press any for timed test"
Sleep
'time the fc sub
t# = Timer
For c = 1 To 200000
fcirc Rnd * _Width, Rnd * _Height, 35, _RGB(Rnd * 255, Rnd * 255, Rnd * 255)
Next
t1# = Timer - t#
'time the fc2 sub
t# = Timer
For c = 1 To 200000
FC2 Rnd * _Width, Rnd * _Height, 35, _RGB(Rnd * 255, Rnd * 255, Rnd * 255)
Next
t2# = Timer - t#
Print
Print "fcirc ="; t1#
Print " FC2 ="; t2#
Print
If t2# < t1# Then
Print "FC2 wins!"
ElseIf t1# < t2# Then ' EDIT oops! idiot switch the > to <
Print "fcirc wins!"
Else
Print "Tie fcirc = FC2 time"
End If
Sub fc (cx, cy, r, clr&)
For y = -r To r
x = Int(Sqr(r * r - y * y))
Line (cx - x, cy + y)-(cx + x, cy + y), clr&, BF
Next
End Sub
Sub FC2 (cx, cy, r, clr&)
Line (cx - r, cy)-(cx + r, cy), clr&, BF
y = 1
While y <= r
x = Int(Sqr(r * r - 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
Wend
End Sub
Sub fcirc (CX As Integer, CY As Integer, R As Integer, C As _Unsigned Long)
Dim Radius As Integer, RadiusError As Integer
Dim X As Integer, Y As Integer
Radius = Abs(R): RadiusError = -Radius: X = Radius: Y = 0
If Radius = 0 Then PSet (CX, CY), C: Exit Sub
Line (CX - X, CY)-(CX + X, CY), C, 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), C, BF
Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
End If
X = X - 1
RadiusError = RadiusError - X * 2
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
Wend
End SubUPDATE: 10 out of 10 tests, FC2 beats fcirc!
ElseIf t1# < t2# Then ' EDIT oops! idiot switch the > to <
RE: Another small filled circe sub (not as fast as fcirc) - bplus - 08-28-2024
I switched from _RGB to _RGB32 and Fcirc seemed slightly improved.
Got 9/10 tests FC2 and one tie!
Damn fcirc can be beat!