Fast filled circle

[mdijkens]

I ran into issues with Paint and transparency; they don't get along very well.
So I created my own filled circle routine:

Code: (Select All)

Sub fCircle (x%, y%, r%, c~&)
  'Filled Circle: Transparency OK & >4x faster then Paint
  r2& = r% * r%
  xx% = Sqr(r2& - y2&): Line (x% - xx%, y%)-(x% + xx%, y%), c~&
  For yy% = 1 To r%
    y2& = yy% * yy%: xx% = Sqr(r2& - y2&)
    Line (x% - xx%, y% - yy%)-(x% + xx%, y% - yy%), c~&
    Line (x% - xx%, y% + yy%)-(x% + xx%, y% + yy%), c~&
  Next yy%
End Sub

It runs a lot faster then Circle & Paint and also works well with transparent colors!

[CharlieJV]

I ran into issues with Paint and transparency; they don't get along very well.
So I created my own filled circle routine:

Code: (Select All)

Sub fCircle (x%, y%, r%, c~&)
  'Filled Circle: Transparency OK & >4x faster then Paint
  r2& = r% * r%
  xx% = Sqr(r2& - y2&): Line (x% - xx%, y%)-(x% + xx%, y%), c~&
  For yy% = 1 To r%
    y2& = yy% * yy%: xx% = Sqr(r2& - y2&)
    Line (x% - xx%, y% - yy%)-(x% + xx%, y% - yy%), c~&
    Line (x% - xx%, y% + yy%)-(x% + xx%, y% + yy%), c~&
  Next yy%
End Sub

It runs a lot faster then Circle & Paint and also works well with transparent colors!

That is very cool and very fast.  Side-question/observation:

Playing around with CIRCLE in GW-BASIC, the CIRCLE statement produces pretty perfect circles in every screen mode.  Drawing a square box (with LINE statement using the B parameter) in GW-BASIC will result in rectangles in different screen modes.  So the CIRCLE command in GW-BASIC must be doing something special to overcome the different pixel width to height ratios to always result in a circle instead of an oval.

For the code above, I would expect that same code to produce ovals in GW-BASIC when in screen modes that don't have 1 to 1 for pixel width to pixel height ratios.

Testing that out in QB64, the code above produces a perfect circle in every screen mode.

Just to understand the evolution of screen modes from GW-BASIC to QBASIC to QB64(pe), at which point did the varying pixel width to height ratios (as existing in GW-BASIC) go away?

[bplus]

This has been tested and tested again, it uses 8 point octal calculations and holds up aginst memory techniques with even alpha shading (no overlapping), very fast and efficient.

Code: (Select All)

'from Steve "Gold standard"
Sub fcirc (CX As Long, CY As Long, R As Long, C As _Unsigned Long)
    Dim Radius As Long, RadiusError As Long
    Dim X As Long, Y As Long
    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

Got it from Steve but he didn't invent it. fcirc is short for Filled Circle. The only place it doesn't work well is dbox's QBJS

[dbox]

This has been tested and tested again, it uses 8 point octal calculations and holds up aginst memory techniques with even alpha shading (no overlapping), very fast and efficient.

Code: (Select All)

'from Steve "Gold standard"
Sub fcirc (CX As Long, CY As Long, R As Long, C As _Unsigned Long)
    Dim Radius As Long, RadiusError As Long
    Dim X As Long, Y As Long
    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

Got it from Steve but he didn't invent it. fcirc is short for Filled Circle. The only place it doesn't work well is dbox's QBJS

Works fine if you comment out the unnecessary BF parameters:  View in QBJS

[bplus]

This has been tested and tested again, it uses 8 point octal calculations and holds up aginst memory techniques with even alpha shading (no overlapping), very fast and efficient.

Code: (Select All)

'from Steve "Gold standard"
Sub fcirc (CX As Long, CY As Long, R As Long, C As _Unsigned Long)
    Dim Radius As Long, RadiusError As Long
    Dim X As Long, Y As Long
    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

Got it from Steve but he didn't invent it. fcirc is short for Filled Circle. The only place it doesn't work well is dbox's QBJS

Works fine if you comment out the unnecessary BF parameters:  View in QBJS

Is that all it was? I couldn't remember, just that I had to do something for code to use in QBJS. The BF's was because they were somehow optimized some time ago according to Steve and it was true back in version 1.2 or so...

Still true? I don't know...

AS I recall, lines were better/faster than PSet's as well.

[mdijkens]

Thanks bplus for the excellent example.
It got me thinking about BF option; why is it there? It seems unneeded.

After experimenting, I found that the BF option, even with single line makes drawing the line 5x faster!
Against common sense I added the BF option to the line statements in my code and surprise... it was 5x faster also.
Now it has the same speed (even a tiny bit faster) as your routine:

Code: (Select All)

Sub fCircle (x%, y%, r%, c~&)
  'Filled Circle: Transparency OK & >20x faster then Paint
  r2& = r% * r%
  xx% = Sqr(r2& - y2&): Line (x% - xx%, y%)-(x% + xx%, y%), c~&, BF
  For yy% = 1 To r%
    y2& = yy% * yy%: xx% = Sqr(r2& - y2&)
    Line (x% - xx%, y% - yy%)-(x% + xx%, y% - yy%), c~&, BF
    Line (x% - xx%, y% + yy%)-(x% + xx%, y% + yy%), c~&, BF
  Next yy%
End Sub

[bplus]

Thanks bplus for the excellent example.
It got me thinking about BF option; why is it there? It seems unneeded.

After experimenting, I found that the BF option, even with single line makes drawing the line 5x faster!
Against common sense I added the BF option to the line statements in my code and surprise... it was 5x faster also.
Now it has the same speed  (even a tiny bit faster) as your routine:

Code: (Select All)

Sub fCircle (x%, y%, r%, c~&)
  'Filled Circle: Transparency OK & >20x faster then Paint
  r2& = r% * r%
  xx% = Sqr(r2& - y2&): Line (x% - xx%, y%)-(x% + xx%, y%), c~&, BF
  For yy% = 1 To r%
    y2& = yy% * yy%: xx% = Sqr(r2& - y2&)
    Line (x% - xx%, y% - yy%)-(x% + xx%, y% - yy%), c~&, BF
    Line (x% - xx%, y% + yy%)-(x% + xx%, y% + yy%), c~&, BF
  Next yy%
End Sub

Ah very interesting! Thanks I like less LOC whenever it makes sense.

[SMcNeill]

Thanks bplus for the excellent example.
It got me thinking about BF option; why is it there? It seems unneeded.

After experimenting, I found that the BF option, even with single line makes drawing the line 5x faster!
Against common sense I added the BF option to the line statements in my code and surprise... it was 5x faster also.

As I've explained to bplus and a few others before, it makes perfect sense once you take a second to think about it...

How do you calculate a vertical line??   A horizontalntal line?  Or a box?

for y = start to finish
    memfill (xpos,y) to (xpos2, y), color
next

......

Now, how do you calculate and plot a sloped line?
for y = start to finish step yslope
   for x = start to finish step xslope
        plot x, y, color
   next
next 

.....  The first, you just fill a whole chunk of memory with one set of values in a single pass...   For the second, you do a lot of math to calculate your slope and plot each point as you move upon that slope.


Now, which is going to be faster than the other? 

[SMcNeill]

And, if all you need is something faster than PAINT, keep in mind this simple little circlefill:


SUB CircleFill (x, y, size)
   FOR i = 1 to size
        CIRCLE (x, y), size
   NEXT
END SUB

It doesn't get any simpler than that, and it's still quite a bit faster than PAINT!

[gaslouk]

Hi
A good idea for the keyword of the day 020

Gaslouk