Another small filled circe sub (not as fast as fcirc)

[Petr]

I messed around with it and the transparency now works in both cases. For CircleFill I had to remove the BF parameter on the first LINE command.

Code: (Select All)

_Title "FC3 versus fcirc reverse order" ' b+ 2024-08-30

'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



' 2024-08-30 test idea who goes first loses!



' 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 FC3"

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



$Checking:On

'better for program quit...



Dim A As _Unsigned _Byte



For i = 1 To 10 ' in case going first has disadvantage

    'time the fc sub

    t# = Timer(.001)

    For c = 1 To 5

        Randomize Timer

        A = Rnd * 255

        FC3 Rnd * (_Width - 700) + 350, 350, 350, _RGBA32(Rnd * 255, Rnd * 255, Rnd * 255, A)

        Locate 1: Print "Alpha: "; A

        _Display

    Next

    t1# = t1# + Timer(.001) - t#



    'time the fc2 sub

    t# = Timer(.001)

    For c = 1 To 5

        A = Rnd * 255

        fcirc Rnd * (_Width - 700) + 350, 350, 350, _RGBA32(Rnd * 255, Rnd * 255, Rnd * 255, A)

        Locate 1: Print "Alpha: "; A

        _Display

    Next

    t2# = t2# + Timer(.001) - t#

Next

Print

Print "  FC3 ="; t1#

Print "fcirc ="; t2#

Print



If t2# < t1# Then

    Print "fcirc wins!"

ElseIf t1# < t2# Then ' EDIT fixed!

    Print "FC3 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

    Sound 250, .2

    Sleep

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

    Beep

    Sleep

End Sub





Sub fcirc (CX As Integer, CY As Integer, R As Integer, C As _Unsigned Long)

    Dim Radius As Integer, RadiusError As _Integer64

    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

    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



    Sound 320, .2

    Sleep

End Sub

A BEEP is to announce that FC3 has completed a circle, a SOUND is to announce that Fcirc has completed a circle. Testing doesn't work here, it was about transparency.