Another small filled circe sub (not as fast as fcirc)

[Dav]

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

[SMcNeill]

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. 

[SMcNeill]

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. 

[Dav]

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

[bplus]

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 Sub

   

[bplus]

OK sometimes it goes the other way
   

[a740g]

@bplus try with optimization enabled and disabled. Would be interesting to see.

[bplus]

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!!!

[bplus]

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 Sub

UPDATE: 10 out of 10 tests, FC2 beats fcirc!

ElseIf t1# < t2# Then ' EDIT oops! idiot switch the > to <

[bplus]

I switched from _RGB to _RGB32 and Fcirc seemed slightly improved.

Got 9/10 tests FC2 and one tie!

---

Damn fcirc can be beat!