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