Filled Arc

[bplus]

+1 I was wondering if one routine might do it ALL! and replace Circle Fill, might replace circle too like Line with BF.

But did you notice you have checking off for the new routine but the Fill Circle routine doesn't turn it off.

[SMcNeill]

Aye, but that's because we're using arrays in the second routine and not in the circle fill.  Circlefill doesn't really improve from the checking off, while this can.  

Here's a version which I think is going to end up going into my library:

Code: (Select All)

$Color:32

Screen _NewImage(1024, 720, 32)



FilledArc 400, 300, 200, 150, 30, _RGB32(0, 180, 255)

Sleep

Cls , Red

FilledArc 400, 300, 200, 0, 360, _RGBA32(125, 0, 180, 255)

Sleep

Cls , White



' Draw a ring arc from 30 to 300, inner radius 100, outer radius 200

FilledRingArc 400, 300, 150, 200, 30, 300, _RGB32(255, 180, 0)

Sleep

' ---------------------------------------------------------

' TEST DRAWING

' ---------------------------------------------------------



Cls



Color _RGB32(255, 255, 255)



Print "Elliptical Arc / Ring Arc Test"

Print "Press any key to exit."



' Pie slice

FilledEllipseArc 250, 250, 200, 120, 20, 200, _RGB32(0, 180, 255)

Print "(1) Filled Elliptical Arc at (250,250)"



' Ring arc

FilledEllipseRingArc 700, 250, 80, 40, 200, 120, 45, 300, _RGB32(255, 150, 0)

Print "(2) Filled Elliptical Ring Arc at (700,250)"



' Another test arc

FilledEllipseArc 250, 300, 150, 250, 270, 360, _RGB32(0, 255, 120)

Print "(3) Tall Elliptical Arc at (250,300)"



' Another ring arc

FilledEllipseRingArc 700, 500, 50, 100, 180, 250, 0, 180, _RGB32(200, 80, 255)

Print "(4) Vertical Ring Arc at (700,500)"



Sleep

End



Sub FilledRingArc (cx As Long, cy As Long, r1 As Long, r2 As Long, a1 As Single, a2 As Single, col As _Unsigned Long)

    ' Draws a filled ring arc (donut slice)

    ' cx, cy  = center

    ' r1      = inner radius

    ' r2      = outer radius

    ' a1, a2  = start/end angles in degrees

    ' col    = fill color

    FilledEllipseRingArc cx, cy, r1, r1, r2, r2, a1, a2, col

End Sub



Sub FilledArc (cx As Long, cy As Long, r As Long, a1 As Single, a2 As Single, col As _Unsigned Long)

    ' Filled arc (pie slice) using only LINE (scanline polygon fill)

    ' cx, cy  = center of circle

    ' r      = radius

    ' a1, a2  = start and end angles in degrees (0 = right, 90 = up)

    ' col    = color

    FilledEllipseRingArc cx, cy, 0, 0, r, r, a1, a2, col

End Sub



Sub FilledEllipseArc (cx As Long, cy As Long, a As Long, b As Long, a1 As Single, a2 As Single, col As _Unsigned Long)

    ' Filled elliptical arc (pie slice) using only LINE

    ' cx, cy = center

    ' a, b = ellipse radii (horizontal, vertical)

    ' a1, a2 = start/end angles in degrees

    ' col = color

    FilledEllipseRingArc cx, cy, 0, 0, a, b, a1, a2, col

End Sub



Sub FilledEllipseRingArc (cx As Long, cy As Long, a1 As Long, b1 As Long, a2 As Long, b2 As Long, t_ang1 As Single, t_ang2 As Single, col As _Unsigned Long)

    ' Filled elliptical ring arc using only LINE

    ' cx, cy  = center

    ' a1, b1  = inner ellipse radii

    ' a2, b2  = outer ellipse radii

    ' ang1, ang2 = start/end angles

    ' col    = fill color

    Const angStep! = _D2R(5!) 'increase or lower for extra smoothness of circle.  5 seems like a circle to my eyes, without visible distortions.

    Dim As Single ang1, ang2: ang1 = _D2R(t_ang1): ang2 = _D2R(t_ang2)

    Dim As Single vx(0 To 4000), vy(0 To 4000), interX(0 To 4000)

    Dim As Long count, yScan, j, n, i, minY, maxY

    Dim As Single x1, y1, x2, y2, temp, angle, x, y



    If ang2 < ang1 Then ang2 = ang2 + _Pi(2)



    ' ---- Outer ellipse arc (ang1 ? ang2) ----

    For angle = ang1 To ang2 Step angStep

        vx(n) = cx + a2 * Cos(angle): vy(n) = cy - b2 * Sin(angle): n = n + 1

    Next



    ' Exact endpoint

    vx(n) = cx + a2 * Cos(ang2): vy(n) = cy - b2 * Sin(ang2): n = n + 1



    ' ---- Inner ellipse arc (ang2 ? ang1, reversed) ----

    For angle = ang2 To ang1 Step -angStep

        vx(n) = cx + a1 * Cos(angle): vy(n) = cy - b1 * Sin(angle): n = n + 1

    Next



    ' Exact endpoint

    vx(n) = cx + a1 * Cos(ang1): vy(n) = cy - b1 * Sin(ang1): n = n + 1



    ' ---- Scanline fill (same as before) ----



    minY = vy(0): maxY = vy(0)

    For i = 1 To n - 1: minY = _Min(minY, vy(i)): maxY = _Max(maxY, vy(i)): Next



    For yScan = minY To maxY

        count = 0

        For i = 0 To n - 1

            j = (i + 1) Mod n

            y1 = vy(i): y2 = vy(j)

            If y2 <> y1 Then

                If (y1 <= yScan And y2 > yScan) Or (y2 <= yScan And y1 > yScan) Then

                    x1 = vx(i): x2 = vx(j)

                    interX(count) = x1 + (yScan - y1) * (x2 - x1) / (y2 - y1)

                    count = count + 1

                End If

            End If

        Next

        ' Sort intersections

        For i = 0 To count - 2: For j = i + 1 To count - 1

                If interX(j) < interX(i) Then Swap interX(i), interX(j)

        Next j, i

        ' Draw spans

        For i = 0 To count - 2 Step 2: Line (interX(i), yScan)-(interX(i + 1), yScan), col, BF: Next

    Next yScan

End Sub

Since the math and all was the same for all those routines, I've just boiled them down to simple wrappers for the main routine and let it do all the real work. The rest is just tweaking inner radius, outer radius, and such.

[bplus]

I ran the test on my system after adding checking to Circle Fill but i moved the Cls, 0 time under the CircleFill time just to be a little harder on Circle Fill than the new routine:

Code: (Select All)

$Color:32

Screen _NewImage(1200, 700, 32)





Const lim1 = 100, numtests = 30

Dim As _Float t(numtests), t1(numtests), t2(numtests)



For j = 1 To numtests

    t(j) = Timer(0.001)

    For i = 1 To lim1

        Draw.Circle.Fill 600, 350, 350, _RGB32(Rnd * 255, Rnd * 255, Rnd * 255)

    Next

    Cls , 0   '  <<<< moved to circle fill time instead of Arc to be nice with Arc because it can do more stuff

    t1(j) = Timer(0.001)

    For i = 1 To lim1

        FilledEllipseRingArc 600, 350, 0, 0, 350, 350, 0, 360, _RGB32(Rnd * 255, Rnd * 255, Rnd * 255)

    Next

    t2(j) = Timer(0.001)

Next

Cls

For i = 1 To numtests

    Print Using "##.#### seconds with circle fill"; t1(i) - t(i),

    Print "", Using "##.#### seconds with ellipse ring fill"; t2(i) - t1(i)

    total1## = total1## + t1(i) - t(i)

    total2## = total2## + t2(i) - t1(i)

Next

Print



Color Yellow

Print "TOTAL TIMES"

Print Using "##.#### seconds with circle fill"; total1##

Print Using "##.#### seconds with ellipse ring fill"; total2##











Sub Draw.Circle.Fill (CX As Integer, CY As Integer, R As Integer, C As _Unsigned Long)

    ' CX = center x coordinate

    ' CY = center y coordinate

    '  R = radius

    '  C = fill color

    $Checking:Off

    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

    $Checking:On

End Sub







Sub FilledEllipseRingArc (cx As Long, cy As Long, a1 As Long, b1 As Long, a2 As Long, b2 As Long, ang1 As Single, ang2 As Single, col As _Unsigned Long)

    ' Filled elliptical ring arc using only LINE

    ' cx, cy  = center

    ' a1, b1  = inner ellipse radii

    ' a2, b2  = outer ellipse radii

    ' ang1, ang2 = start/end angles

    ' col    = fill color

    $Checking:Off

    Const angStep! = 6!

    Dim As Single vx(0 To 4000), vy(0 To 4000), interX(0 To 4000)

    Dim As Single x1, y1, x2, y2, an1, an2, ans, temp, angle

    Dim As Long minY, maxY, i, n, j, count, yScan



    If ang2 < ang1 Then ang2 = ang2 + 360

    an1 = _D2R(ang1): an2 = _D2R(ang2): ans = _D2R(angStep)



    ' ---- Outer ellipse arc (ang1 ? ang2) ----

    For angle = an1 To an2 Step ans

        vx(n) = cx + a2 * Cos(angle): vy(n) = cy - b2 * Sin(angle): n = n + 1

    Next



    ' Exact endpoint

    vx(n) = cx + a2 * Cos(an2): vy(n) = cy - b2 * Sin(an2): n = n + 1



    ' ---- Inner ellipse arc (ang2 ? ang1, reversed) ----

    For angle = an2 To an1 Step -ans

        vx(n) = cx + a1 * Cos(angle): vy(n) = cy - b1 * Sin(angle): n = n + 1

    Next



    ' Exact endpoint

    vx(n) = cx + a1 * Cos(an1): vy(n) = cy - b1 * Sin(an1): n = n + 1



    ' ---- Scanline fill (same as before) ----

    minY = vy(0): maxY = vy(0)

    For i = 1 To n - 1: minY = _Min(minY, vy(i)): maxY = _Max(maxY, vy(i)): Next

    For yScan = minY To maxY

        count = 0

        For i = 0 To n - 1

            j = (i + 1) Mod n

            y1 = vy(i): y2 = vy(j)

            If y2 <> y1 Then

                If (y1 <= yScan _AndAlso y2 > yScan) _OrElse (y2 <= yScan _AndAlso y1 > yScan) Then

                    x1 = vx(i): x2 = vx(j)

                    interX(count) = x1 + (yScan - y1) * (x2 - x1) / (y2 - y1)

                    count = count + 1: If count > 1 Then Exit For

                End If

            End If

        Next

        Line (interX(0), yScan)-(interX(1), yScan), col, BF

    Next yScan

    $Checking:On

End Sub

My results 5.291 / 2.965 = 1.78 x's longer

[SMcNeill]

Like most math stuffs, it all depends on the system and such.  My times were pretty close, with CircleFill being about 20-30% faster than the other.  But that's why I like to make timed stuff so people can test things on their own systems and see how they perform for them. 

[bplus]

trying alpha testing that looks good BUT look no Ring!???

Code: (Select All)

$Color:32

Screen _NewImage(1200, 700, 32)





Const lim1 = 100, numtests = 30

Dim As _Float t(numtests), t1(numtests), t2(numtests)

Cls , White

'For j = 1 To numtests

'    t(j) = Timer(0.001)

'    For i = 1 To lim1

'        Draw.Circle.Fill 600, 350, 350, _RGB32(Rnd * 255, Rnd * 255, Rnd * 255)

'    Next

'    Cls , 0

'    t1(j) = Timer(0.001)

'    For i = 1 To lim1

FilledEllipseRingArc 600, 350, 200, 100, 400, 200, 180, 360, _RGB32(255, 0, 255, 50)

'    Next

'    t2(j) = Timer(0.001)

'Next

'Cls

'For i = 1 To numtests

'    Print Using "##.#### seconds with circle fill"; t1(i) - t(i),

'    Print "", Using "##.#### seconds with ellipse ring fill"; t2(i) - t1(i)

'    total1## = total1## + t1(i) - t(i)

'    total2## = total2## + t2(i) - t1(i)

'Next

'Print



'Color Yellow

'Print "TOTAL TIMES"

'Print Using "##.#### seconds with circle fill"; total1##

'Print Using "##.#### seconds with ellipse ring fill"; total2##

Sleep











Sub Draw.Circle.Fill (CX As Integer, CY As Integer, R As Integer, C As _Unsigned Long)

    ' CX = center x coordinate

    ' CY = center y coordinate

    '  R = radius

    '  C = fill color

    $Checking:Off

    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

    $Checking:On

End Sub







Sub FilledEllipseRingArc (cx As Long, cy As Long, a1 As Long, b1 As Long, a2 As Long, b2 As Long, ang1 As Single, ang2 As Single, col As _Unsigned Long)

    ' Filled elliptical ring arc using only LINE

    ' cx, cy  = center

    ' a1, b1  = inner ellipse radii

    ' a2, b2  = outer ellipse radii

    ' ang1, ang2 = start/end angles

    ' col    = fill color

    $Checking:Off

    Const angStep! = 6!

    Dim As Single vx(0 To 4000), vy(0 To 4000), interX(0 To 4000)

    Dim As Single x1, y1, x2, y2, an1, an2, ans, temp, angle

    Dim As Long minY, maxY, i, n, j, count, yScan



    If ang2 < ang1 Then ang2 = ang2 + 360

    an1 = _D2R(ang1): an2 = _D2R(ang2): ans = _D2R(angStep)



    ' ---- Outer ellipse arc (ang1 ? ang2) ----

    For angle = an1 To an2 Step ans

        vx(n) = cx + a2 * Cos(angle): vy(n) = cy - b2 * Sin(angle): n = n + 1

    Next



    ' Exact endpoint

    vx(n) = cx + a2 * Cos(an2): vy(n) = cy - b2 * Sin(an2): n = n + 1



    ' ---- Inner ellipse arc (ang2 ? ang1, reversed) ----

    For angle = an2 To an1 Step -ans

        vx(n) = cx + a1 * Cos(angle): vy(n) = cy - b1 * Sin(angle): n = n + 1

    Next



    ' Exact endpoint

    vx(n) = cx + a1 * Cos(an1): vy(n) = cy - b1 * Sin(an1): n = n + 1



    ' ---- Scanline fill (same as before) ----

    minY = vy(0): maxY = vy(0)

    For i = 1 To n - 1: minY = _Min(minY, vy(i)): maxY = _Max(maxY, vy(i)): Next

    For yScan = minY To maxY

        count = 0

        For i = 0 To n - 1

            j = (i + 1) Mod n

            y1 = vy(i): y2 = vy(j)

            If y2 <> y1 Then

                If (y1 <= yScan _AndAlso y2 > yScan) _OrElse (y2 <= yScan _AndAlso y1 > yScan) Then

                    x1 = vx(i): x2 = vx(j)

                    interX(count) = x1 + (yScan - y1) * (x2 - x1) / (y2 - y1)

                    count = count + 1: If count > 1 Then Exit For

                End If

            End If

        Next

        Line (interX(0), yScan)-(interX(1), yScan), col, BF

    Next yScan

    $Checking:On

End Sub

[SMcNeill]

Aye, I stripped the ring logic out of the routine to try and get it as close to the circle routine as possible.  If you compare it to the full version, you'll see there's a few segments missing which exclude the sections outside the ring.  

I was looking to see if it'd be worth excluding portions of code depending on what one wanted to do with the routine. 

[bplus]

man am i confused! you are comparing the circle filled to NOT the real code that could do it ALL including fill circle if fast enough. that would be impressive! 

Ha! I wondered where that sort routine went (it's still there in the real Arc Ring, maybe better test that too) LOL!

[SMcNeill]

man am i confused! you are comparing the circle filled to NOT the real code that could do it ALL including fill circle if fast enough. that would be impressive! 

Ha! I wondered where that sort routine went (it's still there in the real Arc Ring, maybe better test that too) LOL!

That's why I said: 

Optimized the math on the main routine here a little bit

When dealing with a filled circle, you can skip a lot of that end code.  A filled circle has a single line for each line of the circle.  Start on the left, finish on the right.  All it needs is two points the (0) and (1) that I yanked out here:  Line (interX(0), yScan)-(interX(1), yScan), col, BF

If dealing with rings and such, it can have a solid line (like at the top of the ring), or a series of lines (line near the middle where you have one line on the left, the gap in the middle, and then line on the right).  It needs more work to draw those lines for us.

I was seeing how the scanline technique held up against CircleFill in the most comparable speed test, so I stripped out a lot of the extra code for that test.  I was seeing if it'd be worth trying to optimize any further than this, or wrap it in various logic to skip those routines or not, depending on the parameters an user passed to it.  In the end, CircleFill was *still* faster, and so I don't think this will be a replacement for it.

But it's close enough that I imagine several of my other routines might be replaced just by it.  (Such as the ThickCircleFill and ThickEllipseFill routines my library currently holds.)  I'll do better speed testing against those routines as well, but if it's close to the same ballpark figures, then why not just keep the one main routine here and use it?  One set of code to upkeep and maintain and keep debugged, rather than having a dozen different routines to upkeep which only over minimal improvement on performance.

I was trying to compare apples to apples, not apples to a fruit basket, so I stripped out the non-circle stuff for that test.  Make sense now?  I imagine it'll always be a little slower than our circlefill routines, but at the same time, it's a whole heckuva lot more flexible and powerful, and those extra options each are going to add a little drag to the process.  Personally, I think I can live with that performance hit, for the flexibility which we get with the new routine.

[grymmjack]

That is one heck of a Challenge @grymmjack I think it beats the spreadsheet one by a mile! Yes and great use of the RingArc routines! PS how did you get that inflated image posted? Is this one of those forum developer privileges?

@bplus I went to my buddies web site, right clicked on his image, chose open in new tab, then copy image URL, then typed like Steve showed you lower. just [img]stuff[/img]

Looks like Steve explained better...

[grymmjack]

@grymmjack How about I do this the simple way -- I just make you a simple DrawKnob button and then you can use it however you want. 

Awesome, thank you very kindly @SMcNeill.

I can figure out how to evolve it from this for sure