+- QB64 Phoenix Edition (https://qb64phoenix.com/forum)
+-- Forum: QB64 Rising (https://qb64phoenix.com/forum/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://qb64phoenix.com/forum/forumdisplay.php?fid=3)
+---- Forum: Programs (https://qb64phoenix.com/forum/forumdisplay.php?fid=7)
+---- Thread: Another small filled circe sub (not as fast as fcirc) (/showthread.php?tid=2989)
RE: Another small filled circe sub (not as fast as fcirc) - Dav - 08-29-2024
Either is fast enouh for me. I'm more concerned why I can stop or close the testing program running under linux? I press the X but nothing happens, Keeps running until it finishes. Kinda miss the task manager.
- Dav
RE: Another small filled circe sub (not as fast as fcirc) - Pete - 08-29-2024
Have you tried:
Ctrl + Alt + x
or
Alt + F4
Pete
RE: Another small filled circe sub (not as fast as fcirc) - bplus - 08-29-2024
(08-29-2024, 08:38 PM)Dav Wrote: Either is fast enouh for me. I'm more concerned why I can stop or close the testing program running under linux? I press the X but nothing happens, Keeps running until it finishes. Kinda miss the task manager.
- Dav
If you are CHECKING my code, remember $Checking:Off was used.
RE: Another small filled circe sub (not as fast as fcirc) - bplus - 08-29-2024
(08-29-2024, 08:31 PM)Pete Wrote: Seriously guys, with results this close I will assert you can't tell which is faster by running the programs due to the various background processes always running in any operating system. So if consistent results are impossible, how can such small and inconsistent measurements be noteworthy?
Pete
Just that I never expected to see the day "the Gold Standard" of Circle fill routines would see a contender.
RE: Another small filled circe sub (not as fast as fcirc) - Pete - 08-29-2024
Very cool you found something on par with it. Now all you have to do is lobby for it as an alternative! Didn't we work together with Bill and Steve on some ellipse fill gold standard years ago?
Pete
- The Three Musketeers and the Theoretical Musketeer
RE: Another small filled circe sub (not as fast as fcirc) - Dav - 08-29-2024
Just continuing testing this out of curiosity (and boredom!). I'm seeing a pattern with the timed numbers. There's only a few different numbers really, and they are shared among all the SUB's. Maybe this is more of a TIMER calc thing, and not a drawing faster thing?
I removed the RND calls to eliminate that element, and just had every SUB draw the same circle info over and over. 10 loops of 5000 circles. The SUB's share the exact same numbers. (although different winners). Made a 4th SUB (FC4) just to have a 4th player. It shares the same numbers as the others.
- Dav
Code: (Select All)
Screen _NewImage(1000, 700, 32)
Print
Print " fcirc fc fc3 fc4 "
Print
For i = 1 To 10
'time the fcirc sub
t# = Timer
For c = 1 To 5000
fcirc 400, 400, 100, _RGB(128, 128, 128)
Next
t1# = Timer - t#
'time the fc sub
t# = Timer
For c = 1 To 5000
fc 400, 400, 100, _RGB(255, 128, 128)
Next
t2# = Timer - t#
'time the fc3 sub
t# = Timer
For c = 1 To 5000
FC3 400, 400, 100, _RGB(128, 255, 128)
Next
t3# = Timer - t#
'time the fc4 sub
t# = Timer
For c = 1 To 5000
fc4 400, 400, 100, _RGB(128, 128, 255)
Next
t4# = Timer - t#
Print t1#, t2#, t3#, t4#
Next
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 fc4 (cx, cy, r, clr&)
r2 = r * r
For y = 0 To r
y2 = y * y
'If y2 <= r2 Then
x = Int(Sqr(r2 - y2))
Line (cx - x, cy - y)-(cx + x, cy - y), clr&, BF
Line (cx - x, cy + y)-(cx + x, cy + y), clr&, BF
'End If
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
y2 = y * y
If y2 < r2 Then
x = Int(Sqr(r2 - y2))
Line (cx - x, cy + y)-(cx + x, cy + y), clr&, BF
Line (cx - x, cy - y)-(cx + x, cy - y), clr&, BF
End If
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
RE: Another small filled circe sub (not as fast as fcirc) - bplus - 08-30-2024
Your F4 is disqualified because it will have an overlapping line, won't do for transparent colors
Code: (Select All)
Screen _NewImage(800, 600, 32)
fc4 400, 300, 300, _RGB32(0, 0, 255, 100)
Sub fc4 (cx, cy, r, clr&)
r2 = r * r
For y = 0 To r
y2 = y * y
'If y2 <= r2 Then
x = Int(Sqr(r2 - y2))
Line (cx - x, cy - y)-(cx + x, cy - y), clr&, BF
Line (cx - x, cy + y)-(cx + x, cy + y), clr&, BF
'End If
Next
End SubRE: Another small filled circe sub (not as fast as fcirc) - bplus - 08-30-2024
Agreed the Timer calculations can be handled better!
Use Timer(.001) for max accuracy
Try accumulation of totals and bigger longer drawing circles
Code: (Select All)
Screen _NewImage(1000, 700, 32)
For i = 1 To 10
'time the fcirc sub
t# = Timer(.001)
For c = 1 To 500
fcirc 400, 400, 350, _RGB(128, 128, 128)
Next
t1# = t1# + Timer(.001) - t#
'time the fc sub
t# = Timer(.001)
For c = 1 To 500
fc 400, 400, 350, _RGB(255, 128, 128)
Next
t2# = t2# + Timer(.001) - t#
'time the fc3 sub
t# = Timer(.001)
For c = 1 To 500
FC3 400, 400, 350, _RGB(128, 255, 128)
Next
t3# = t3# + Timer(.001) - t#
'time the fc4 sub
t# = Timer(.001)
For c = 1 To 500
fc4 400, 400, 350, _RGB(128, 128, 255)
Next
t4# = t4# + Timer(.001) - t#
' Print t1#, t2#, t3#, t4#
Next
Cls
Print
Print " fcirc ", " fc ", " fc3 ", " fc4 "
Print
Print "Final Total:"
Print t1#, t2#, t3#, t4#
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 fc4 (cx, cy, r, clr&)
r2 = r * r
For y = 0 To r
y2 = y * y
'If y2 <= r2 Then
x = Int(Sqr(r2 - y2))
Line (cx - x, cy - y)-(cx + x, cy - y), clr&, BF
Line (cx - x, cy + y)-(cx + x, cy + y), clr&, BF
'End If
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
y2 = y * y
If y2 < r2 Then
x = Int(Sqr(r2 - y2))
Line (cx - x, cy + y)-(cx + x, cy + y), clr&, BF
Line (cx - x, cy - y)-(cx + x, cy - y), clr&, BF
End If
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 SubThis is representative of 5 trials I've run so far:
Aw crap you messed with the FC3 code !!!
This is one decision too many!!!
If y2 < r2 Then
RE: Another small filled circe sub (not as fast as fcirc) - bplus - 08-30-2024
the test with better FC3 code
Code: (Select All)
Screen _NewImage(1000, 700, 32)
For i = 1 To 10
'time the fcirc sub
t# = Timer(.001)
For c = 1 To 500
fcirc 400, 400, 350, _RGB(128, 128, 128)
Next
t1# = t1# + Timer(.001) - t#
'time the fc sub
t# = Timer(.001)
For c = 1 To 500
fc 400, 400, 350, _RGB(255, 128, 128)
Next
t2# = t2# + Timer(.001) - t#
'time the fc3 sub
t# = Timer(.001)
For c = 1 To 500
FC3 400, 400, 350, _RGB(128, 255, 128)
Next
t3# = t3# + Timer(.001) - t#
'time the fc4 sub
t# = Timer(.001)
For c = 1 To 500
fc4 400, 400, 350, _RGB(128, 128, 255)
Next
t4# = t4# + Timer(.001) - t#
' Print t1#, t2#, t3#, t4#
Next
Cls
Print
Print " fcirc ", " fc ", " fc3 ", " fc4 "
Print
Print "Final Total:"
Print t1#, t2#, t3#, t4#
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 fc4 (cx, cy, r, clr&)
r2 = r * r
For y = 0 To r
y2 = y * y
'If y2 <= r2 Then
x = Int(Sqr(r2 - y2))
Line (cx - x, cy - y)-(cx + x, cy - y), clr&, BF
Line (cx - x, cy + y)-(cx + x, cy + y), clr&, BF
'End If
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 SubA sample of results with the better FC3 code
RE: Another small filled circe sub (not as fast as fcirc) - Dav - 08-30-2024
Timer(.001)? Forgot about that. That’s cool.
Sorry, I guess I did mess up the fc3 code. In my defense, I was being nagged very professionally over here while playing with the program.
- Dav