Antialiased Circles

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
Post Reply
acetoline
Posts: 228
Joined: Oct 27, 2006 6:50
Contact:

Antialiased Circles

Post by acetoline »

This is a quick hack I put together to draw anti-aliased circles. It could do with some optimizations, but it's fast enough for most purposes. It's suitable for things like game engines, graphics editors, etc.
I put an emphasis on accuracy. The edges are beautifully smooth, and the position, radius, etc. are arbitrary and all are floating-point.
Written in pure fb. Enjoy.

Code: Select all

'#Define TEST_DOTS
'As of the latest version, it needs this to run properly.
'it could be disabled in later versions
#Define BUGGY_GFX_LIB

'TODO: arbitrary drawing doesn't do well on top and bottom edges.
Sub DrawFilledCircle(x As Double, y As Double, radius As Double, r As uByte, g As uByte, b As uByte, a As uByte)
    Dim d As Double
    Dim As Double px,py
    Dim As Double rad2
    Dim As Double spx
    Dim As uByte DoneScan
    
    spx = -3
    rad2 = radius+2
    For py= -rad2 To +rad2
        DoneScan = 0
        For px = spx To +rad2
            d = Sqr((px*px)+(py*py))
            If d < rad2 Then
                DoneScan = 1
                d = d / radius
                d = d^(radius*2)
                If d > 1 Then d = 1
                #IfDef BUGGY_GFX_LIB
                    Line(x+px, y+py)-(x+px,y+py),RGBA(r,g,b,a*(1-d)),BF
                #EndIf
                #IfnDef BUGGY_GFX_LIB
                    Pset(x+px, y+py),RGBA(r,g,b,a*(1-d))
                #EndIf
                'reached the end of the edge?
                If d < 0.02 Then
                    Line (px+x+1, py+y)-(-px+x,py+y),RGBA(r,g,b,a)
                    px = -px
                End If
            Else
                If DoneScan = 1 Then
                    spx = -px-1
                    Exit For
                End If
            End If
            #ifdef TEST_DOTS 
                Pset (x+px,y+py),RGBA(255,0,0,255)  'testing
            #endif
        Next
    Next
End Sub

'TODO: has problems with width<1.
Sub DrawCircleOutline(x As Double, y As Double, radius As Double, lwidth As Double, r As uByte, g As uByte, b As uByte, a As uByte)
    Dim As Double d, d1, d2
    Dim As Double px,py
    Dim As Double rad2
    Dim As Double radius1, radius2
    Dim As Double spx
    Dim As uByte DoneScan
    
    radius1 = radius - (lwidth/2)
    radius2 = radius + (lwidth/2)
    
    spx = -3
    rad2 = radius+lwidth
    For py= -rad2 To +rad2
        DoneScan = 0
        For px = spx To +rad2
            d = Sqr((px*px)+(py*py))
            If d < rad2 Then
                DoneScan = 1
                d1 = (d/radius1)^(radius1+lwidth)
                d2 = (d/radius2)^(radius2+lwidth)
                
                If d2 > 1 Then d2 = 1
                If (1-d1) > d2 Then d2 = (1-d1)
                
                #IfDef BUGGY_GFX_LIB
                    Line(x+px, y+py)-(x+px,y+py),RGBA(r,g,b,a*(1-d2)),BF
                #EndIf
                #IfnDef BUGGY_GFX_LIB
                    Pset(x+px, y+py),RGBA(r,g,b,a*(1-d))
                #EndIf
                'reached the end of the edge?
                If d < (radius1-1) Then
                    'Line (px+x+1, py+y)-(-px+x,py+y),RGBA(r,g,b,a)
                    px = -px
                End If
            Else
                If DoneScan = 1 Then
                    spx = -px-1
                    Exit For
                End If
            End If
            #ifdef TEST_DOTS 
                Pset (x+px,y+py),RGBA(255,0,0,255)  'testing
            #endif
        Next
    Next
End Sub
    
    
ScreenRes 600,600,32,1,&h41
Randomize Timer

Print "Press any key to draw 100 filled circles"
Sleep
For i As Integer = 1 To 100
    DrawFilledCircle(600*rnd,600*rnd,16+(8*rnd),255*rnd,255*rnd,255*rnd,255)
Next i

Print "Press any key to draw 100 filled circles with alpha"
Sleep
Cls
For i As Integer = 1 To 100
    DrawFilledCircle(600*rnd,600*rnd,16+(8*rnd),255*rnd,255*rnd,255*rnd,155+(100*rnd))
Next i

Print "Press any key to draw 100 circle outlines"
Sleep
Cls
For i As Integer = 1 To 100
    DrawCircleOutline(600*rnd,600*rnd,32*rnd,1+(1*rnd),255*rnd,255*rnd,255*rnd,155+(100*rnd))
Next i

Sleep
DaveUnit
Posts: 239
Joined: Apr 20, 2006 15:47
Location: Central MA

Post by DaveUnit »

Wow, those are really nice. I dunno why I'm so impressed by circles but I am. :P
Very good job.
thesanman112
Posts: 538
Joined: Jul 15, 2005 4:13

huh>?

Post by thesanman112 »

hehehehe



[/code]

'$include: "gl.bi"
do
for texture as gl_define_texture_2d_filename to render_everything_get_all_user_input
next
loop
joseywales72
Posts: 206
Joined: Aug 27, 2005 2:02
Location: Istanbul, Turkey

Post by joseywales72 »

These circles are really great... I had something on my mind, I'll definitely use your code.. Thank you for sharing.
D.J.Peters
Posts: 8629
Joined: May 28, 2005 3:28
Contact:

Post by D.J.Peters »

good idea

Joshy
acetoline
Posts: 228
Joined: Oct 27, 2006 6:50
Contact:

Post by acetoline »

Thanks for the feedback, guys!
I'm also thinking of writing other primitives, such as beziers and triangles. Let's see how that comes out.

thesanman112: I couldn't decipher what you meant. elaborate?
Dr_D
Posts: 2453
Joined: May 27, 2005 4:59
Contact:

Post by Dr_D »

Very nice looking circles. If you do make AA lines and triangles, I think you should make it into a little 2d primitive library. ;)
Post Reply