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

[SierraKen]

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)

---

[Pete]

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

[bplus]

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.

[Pete]

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

[bplus]

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 Sub

[Pete]

That works, + 1.

Pete

[bplus]

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 Sub

shows how nice transparency is.

   

[Dav]

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

[bplus]

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.

[a740g]

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