@Pete don't see much difference? they both print 2 to 11 for r = 10 and y starting at 1
Hey I found some old speed tests comparing a bunch of Circle fill routines with Gold Standard.
Compare new FC3 to old fCirc2 they are the same except one uses the default Single Type and the old fCirc2 declares all the variables.
The old fCirc2 was clearly slower than the Gold Standard BUT
FC3 is faster that the Standard in 1,000,000 iterations of drawing. Had to do 1 Million to overcome the disadvantage of going first!
Also the old fCirc2 had an extra variable xstop which was a waste of time!
Hey I found some old speed tests comparing a bunch of Circle fill routines with Gold Standard.
Compare new FC3 to old fCirc2 they are the same except one uses the default Single Type and the old fCirc2 declares all the variables.
The old fCirc2 was clearly slower than the Gold Standard BUT
FC3 is faster that the Standard in 1,000,000 iterations of drawing. Had to do 1 Million to overcome the disadvantage of going first!
Code: (Select All)
_Title "Circle Fill speed tests"
Screen _NewImage(1220, 680, 32)
_ScreenMove 50, 20
_Delay 1
ntests = 1000000 'it takes a really long run to prove Gold Standard Speed 167.9 versus vince 168.1
'ntests = 1000 'fast elimination
'It has been noticed that the one going first has a disadvantage
' ==================================================== the contender on left of screen
start## = Timer
For i = 1 To ntests
FC3 305, 305, 300, _RGBA32(0, 100, 0, 100)
'arcRing 305, 305, 300, 0, 0, 2 * _Pi, _RGBA32(0, 100, 0, 100)
Next
finish## = Timer - start##
_PrintString (100, 615), "Time for" + Str$(ntests) + " Contender Fills:" + Str$(finish##)
start## = Timer 'this runs the Gold standard to beat on Right Side of screen
For i = 1 To ntests
fcirc0 915, 305, 300, _RGBA32(0, 100, 0, 100)
Next
finish## = Timer - start##
_PrintString (700, 615), "Time for" + Str$(ntests) + " Gold Standard Circle Fills:" + Str$(finish##)
'from Gold standard
Sub fcirc0 (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
' Draw the middle span here so we don't draw it twice in the main loop,
' which would be a problem with blending turned on.
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
'vince's circle fill this one does not bother with types good almost identical to Steve's
Sub fcirc1 (x, y, r, c As _Unsigned Long)
x0 = r
y0 = 0
e = -r
Do While y0 < x0
If e <= 0 Then
y0 = y0 + 1
Line (x - x0, y + y0)-(x + x0, y + y0), c, BF
Line (x - x0, y - y0)-(x + x0, y - y0), c, BF
e = e + 2 * y0
Else
Line (x - y0, y - x0)-(x + y0, y - x0), c, BF
Line (x - y0, y + x0)-(x + y0, y + x0), c, BF
x0 = x0 - 1
e = e - 2 * x0
End If
Loop
Line (x - r, y)-(x + r, y), c, BF
End Sub
'this does not overlap with circle well 2.13 x's Gold Time
Sub fCirc2 (xx As Long, yy As Long, r As Long, K As _Unsigned Long)
Dim r2 As Long, x As Long, y As Long, xstop As Long
r2 = r * r
x = 1
xstop = r + 1
While x < xstop 'remove FOR loop
y = Sqr(r2 - x * x)
Line (xx - x, yy + y)-(xx - x, yy - y), K, BF
Line (xx + x, yy + y)-(xx + x, yy - y), K, BF
x = x + 1
Wend
Line (xx, yy - r)-(xx, yy + r), K, BF
End Sub
'andy amaya's version from SB, way too much overlapping! Junk as is but 1.1 Gold Standard Time
Sub fCirc3 (CX As Long, CY As Long, R As Long, K As _Unsigned Long) 'thanks Andy Amaya for heads up
Dim x As Long, y As Long, Xchange As Integer, yChange As Integer, RadiusError As Integer
x = R
y = 0
Xchange = 1 - 2 * R
yChange = 1
RadiusError = 0
While x >= y
Line (CX - x, CY + y)-(CX + x, CY + y), K, BF ';used calc'd values to draw
Line (CX - x, CY - y)-(CX + x, CY - y), K, BF ';scan lines from points
Line (CX - y, CY + x)-(CX + y, CY + x), K, BF ';in opposite octants
Line (CX - y, CY - x)-(CX + y, CY - x), K, BF
y = y + 1
RadiusError = RadiusError + yChange
yChange = yChange + 2
If 2 * RadiusError + Xchange > 0 Then
x = x - 1
RadiusError = RadiusError + Xchange
Xchange = Xchange + 2
End If
Wend
End Sub
'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
Wend
Line (xx - tstop, yy - tstop)-(xx + tstop, yy + tstop), K, BF
End Sub
'add a routine for sqr root 1,16 X's Gold Std
Sub fCirc5 (xx As Long, yy As Long, r As Long, K As _Unsigned Long)
Dim r2 As Long, t As Long, tstop As Long
Dim dist1 As Single, dist As Single, dist2 As Long, s As Long
r2 = r * r
t = r 'r - 1 gets rid of nipples but...
tstop = r * .707106781
While t > tstop 'remove FOR loop
'VVVVVVVVVVVVVVVVVVV this might now save a shade off SQR
s = r2 - t * t
dist = s / 10
dist2 = dist * dist
'WHILE ABS(dist ^ 2 - s) >= 1 'no! avoid function calls!
While dist2 - s > 1 Or dist2 - s < -1
dist = .5 * (dist + s / dist)
dist2 = dist * dist
Wend
'VVVVVVVVVVVVVVVVV faster to use this YES
'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
Wend
Line (xx - tstop, yy - tstop)-(xx + tstop, yy + tstop), K, BF
End Sub
'too slow, dest can't just be 0 Junk as is
Sub fcirc6 (xOrigin As Long, yOrigin As Long, radius As Long, K As _Unsigned Long)
a& = _NewImage(1, 1, 32)
_Dest a&
PSet (0, 0), K
_Dest 0
Dim x1 As Long, y1 As Long, x2 As Long, y2 As Long, i As Integer
Dim polyAngle As Single
polyAngle = _Pi(2) / 60
x1 = xOrigin + radius * Cos(polyAngle)
y1 = yOrigin + radius * Sin(polyAngle)
For i = 2 To 61
x2 = xOrigin + radius * Cos(i * polyAngle)
y2 = yOrigin + radius * Sin(i * polyAngle)
_MapTriangle (0, 0)-(0, 0)-(0, 0), a& To(xOrigin, yOrigin)-(x1, y1)-(x2, y2), 0
x1 = x2: y1 = y2
Next
_FreeImage a& '<<< this is important!
End Sub
'doing a circle fill with this runs 20 x's slower than Gold Std Circle Fill
Sub arcRing (x0, y0, outerR, innerR, raStart, raEnd, colr As _Unsigned Long)
PI2 = _Pi(2)
PI32 = _Pi(1.5)
PIh = _Pi(.5)
PI = _Pi
raS = raStart
While raS >= PI2
raS = raS - PI2
Wend
While raS < 0
raS = raS + PI2
Wend
raE = raEnd
While raE < 0
raE = raE + PI2
Wend
While raE >= PI2
raE = raE - PI2
Wend
If raE > raS Then ck1 = -1
For y = y0 - outerR To y0 + outerR
For x = x0 - outerR To x0 + outerR
dist = Sqr((x - x0) * (x - x0) + (y - y0) * (y - y0))
If dist >= innerR And dist <= outerR Then 'within 2 radii
'angle of x, y to x0, y0
If x - x0 <> 0 And y - y0 <> 0 Then
ra = _Atan2(y - y0, x - x0)
If ra < 0 Then ra = ra + PI2
ElseIf x - x0 = 0 Then
If y >= y0 Then ra = _Pi / 2 Else ra = PI32
ElseIf y - y0 = 0 Then
If x >= x0 Then ra = 0 Else ra = PI
End If
If ck1 Then 'raEnd > raStart
If ra >= raS And ra <= raE Then
PSet (x, y), colr
End If
Else 'raEnd < raStart, raEnd is falls before raStart clockwise so fill through 2 * PI
If ra >= raS And ra < PI2 Then
PSet (x, y), colr
Else
If ra >= 0 And ra <= raE Then
PSet (x, y), colr
End If
End If
End If
End If
Next
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 = 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 SubAlso the old fCirc2 had an extra variable xstop which was a waste of time!
b = b + ...