|
|
Post by bplus on Aug 29, 2024 22:15:35 GMT
For years fcirc (fill circle) below has been "Gold Standard" in speed for a Circle Fill. Recently discovered FC3 as a pretty good alternate routine with simpler code:
_Title "FC3 versus fcirc QB64 v2.1" ' b+ 2024-08-29
'Dav, AUG/2024 bplus mod 2024-08-28 try faster FC2 mod of fc
' 2024-08-29 try larger circles all on screen with FC3
' next line uncommented will speed up test time but wont be able to exit until done.
'$Checking:Off
Screen _NewImage(1000, 700, 32)
_ScreenMove 150, 0
Randomize Timer
Print "Overlapping lines check of FC2"
FC3 500, 350, 300, &H200000FF ' check for overlapping lines
Print "Looking good! no lighter lines." ' FC passes too BTW
Print: Print " zzz... press any for timed test"
Sleep
Cls
For i = 1 To 10 ' in case going first has disadvantage
'time the fc sub
t# = Timer
For c = 1 To 2000
fcirc Rnd * (_Width - 700) + 350, 350, 350, _RGB32(Rnd * 255, Rnd * 255, Rnd * 255)
_Display
Next
t1# = t1# + Timer - t#
'time the fc2 sub
t# = Timer
For c = 1 To 2000
FC3 Rnd * (_Width - 700) + 350, 350, 350, _RGB32(Rnd * 255, Rnd * 255, Rnd * 255)
_Display
Next
t2# = t2# + Timer - t#
Next
Print
Print "fcirc ="; t1#
Print " FC3 ="; t2#
Print
If t2# < t1# Then
Print "FC3 wins!"
ElseIf t1# < t2# Then ' EDIT fixed!
Print "fcirc wins!"
Else
Print "Tie fcirc = FC3 time"
End If
_Display
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 FC3 (cx, cy, r, clr&)
Line (cx - r, cy)-(cx + r, cy), clr&, BF
y = 1
r2 = r * r ' Dav mod
While y <= r
x = Int(Sqr(r2 - y * y)) ' r2 Dav
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
Wend
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
|
|
|
|
Post by bplus on Aug 30, 2024 19:01:40 GMT
Ha! It turns out I missed noticing color for FC3 was a Long Type Not an _Unsigned Long Type. Also did not need to take Int(Sqr(...)) So after those fixes there was still a problem depending which was run first and second in the counting loop, the second routine dominates the first. So FC3 and fcirc are really really close but are basically very different! ie one uses all variables declared and the other uses the default Single Type (no dim or suffix) except for _Unsigned Long Color passed to sub. Here are the current codes for each routine:
Sub FC3 (cx, cy, r, clr~&)
Line (cx - r, cy)-(cx + r, cy), clr~&, BF
y = 1
r2 = r * r ' Dav mod
While y <= r
x = Sqr(r2 - y * y) ' r2 Dav
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
Wend
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
One giant gold star to you if you can definitively prove one is better than the other  |
|
|
|
Post by bplus on Aug 31, 2024 20:03:20 GMT
A circle fill routine that is fun to watch when slowed down:
_Title "Square filled center Circle Fill technique" ' b+ mod 2024-089-31
Screen _NewImage(1024, 512, 32)
Cls
For x% = 0 To 49
fCirc4 (x% Mod 10) * 100 + 50, (x% \ 10) * 100 + 50, x% + 10, _RGB32(0, 128, 0, 100)
Next x%
Sleep
'fCirc but doing octants until get to square, then just do square fill! 1.18 Gold Sdt
'this is closer to matching the Gold Standard
Sub fCirc4 (xx As Long, yy As Long, r As Long, K As _Unsigned Long)
Dim r2 As Long, t As Long, dist As Long, tstop As Long
r2 = r * r
t = r 'r - 1 gets rid of nipples but...
tstop = r * .707106781
While t > tstop 'remove FOR loop
dist = Sqr(r2 - t * t) ' + .5 for rounding down
Line (xx - t, yy + dist)-(xx - t, yy - dist), K, BF
Line (xx + t, yy + dist)-(xx + t, yy - dist), K, BF
Line (xx + dist, yy + t)-(xx - dist, yy + t), K, BF
Line (xx + dist, yy - t)-(xx - dist, yy - t), K, BF
t = t - 1
_Limit 30 ' to show off construction
Wend
Line (xx - tstop, yy - tstop)-(xx + tstop, yy + tstop), K, BF
End Sub
It's also pretty fast when the _limit is removed.
|
|
|
|
Post by bplus on Aug 31, 2024 23:58:14 GMT
Here is the FC3 Sub with a little demo after much discussion _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 OK if 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 ' integer type wont work right here
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  |
|
