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