Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Another small filled circe sub (not as fast as fcirc)
#14
Update: I thought might be advantage to smaller circles but no!

And QB64 v2.1 does run this code significantly faster!

Bigger circles all on screen
Code: (Select All)
_Title "FC3 versus fcirc QB64pe v3.13.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
$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

   
b = b + ...
Reply


Messages In This Thread
RE: Another small filled circe sub (not as fast as fcirc) - by bplus - 08-29-2024, 12:44 PM



Users browsing this thread: 31 Guest(s)