polyFT - draw filled polygons

[James D Jarvis]

an update of an older sub to draw filled polygons using _maptriangle . This one is faster than the earlier version (polyT) and includes options for rotation, horizontal and vertical scaling, and a border.

Code: (Select All)

'draw_polyFT

' by James D.  Jarvis  , August 20,2023

'draw filled  polygons

'

'HEADER

Dim Shared xmax, ymax

xmax = 800: ymax = 500

Screen _NewImage(xmax, ymax, 32)

Dim Shared pk& 'must be included in a program that uses polyFT

pk& = _NewImage(3, 3, 32) 'must be included in a program that uses polyFT



'======================================

' demo

'======================================

' This demo draws 64000 random polygons, and then clears the screen and draws a handful of polygons  rotating



Randomize Timer



t1 = Timer

For reps = 1 To 64000

    polyFT Int(Rnd * xmax), Int(Rnd * ymax), Int(3 + Rnd * 20), Int(3 + Rnd * 12), Int(Rnd * 60), Int(1 + Rnd * 3), Int(1 + Rnd * 3), _RGB32(Int(Rnd * 256), Int(Rnd * 256), Int(Rnd * 256)), _RGB32(Int(Rnd * 256), Int(Rnd * 256), Int(Rnd * 256))

Next reps

t2 = Timer

Print "That took "; t2 - t1; " seconds to draw 64000 polygons"

Sleep

rtn = 0

Do

    _Limit 60

    Cls

    Print "Press <ESC> to quit>"

    polyFT 100, 100, 40, 3, rtn, 1, 1, _RGB32(100, 200, 50), 0

    polyFT 200, 100, 40, 4, 45 + rtn, 1, 1, _RGB32(100, 200, 250), 0

    polyFT 300, 100, 40, 5, rtn, 1, 1, _RGB32(200, 100, 250), 0

    polyFT 400, 100, 40, 6, rtn, 1, 1, _RGB32(100, 250, 150), 0

    polyFT 500, 100, 40, 7, rtn, 1, 1, _RGB32(150, 200, 200), 0

    polyFT 600, 100, 40, 8, 22.5 + rtn, 1, 1, _RGB32(200, 200, 0), 0

    _PrintString (100 - (_PrintWidth("Triangle")) / 2, 160), "Triangle"

    _PrintString (200 - (_PrintWidth("Square")) / 2, 160), "Square"

    _PrintString (300 - (_PrintWidth("Pentagon")) / 2, 160), "Pentagon"

    _PrintString (400 - (_PrintWidth("Hexagon")) / 2, 160), "Hexagon"

    _PrintString (500 - (_PrintWidth("Heptagon")) / 2, 160), "Heptagon"

    _PrintString (600 - (_PrintWidth("Octagon")) / 2, 160), "Octagon"

    rtn = rtn + 1: If rtn > 360 Then rtn = 0

    _Display 'for smooth display

Loop Until InKey$ = Chr$(27)



'==========================================================================

'subroutines

'

'  polyFT    draw a filled polygon

'

' setklr    is a sub to build the color image used by triangles in  polyFT

'====================================== ==================================

Sub polyFT (cx As Long, cy As Long, rad As Long, sides As Integer, rang As Long, ww, vv, klr As _Unsigned Long, lineyes As _Unsigned Long)

    'draw an equilateral polygon using filled triangle for each segment

    'centered at cx,cy to radius rad of sides # of face rotated to angle rang scaled to ww and vv of color klr and lineyes if there is an outline, a value 0 would create no outline

    setklr klr

    Dim px(sides)

    Dim py(sides)

    pang = 360 / sides

    ang = 0

    For p = 1 To sides

        px(p) = cx + (rad * Cos(0.01745329 * (ang + rang))) * ww

        py(p) = cy + (rad * Sin(0.01745329 * (ang + rang))) * vv

        ang = ang + pang



    Next p

    For p = 1 To sides - 1

        _MapTriangle (0, 0)-(0, 2)-(2, 0), pk& To(cx, cy)-(px(p), py(p))-(px(p + 1), py(p + 1))

        If lineyes > 0 Then Line (px(p), py(p))-(px(p + 1), py(p + 1)), lineyes

    Next p

    _MapTriangle (0, 0)-(0, 2)-(2, 0), pk& To(cx, cy)-(px(sides), py(sides))-(px(1), py(1))

    If lineyes > 0 Then Line (px(sides), py(sides))-(px(1), py(1)), lineyes







End Sub

Sub setklr (klr As Long)

    'internal routine to setup an image to copy a colored triangle from in the color klr

    'called by polyT

    _Dest pk&

    Line (0, 0)-(2, 2), klr, BF

    _Dest 0

End Sub

[grymmjack]

WOW, fantastic code!

64,000 polygons drawn in 1.8seconds lol.

Beautiful rotation too.

[johnno56]

Cool... 64,000 in 0.765625 seconds... Nicely done!!

[Dav]

Nice snippet of code!  Thank for sharing.

My laptop took 2.199 secs to draw 64k polygons.

- Dav

[James D Jarvis]

Fixed a couple types in the comments. Hope folks can get some use out of this code.   My laptop draws 64,000 polygons in .8242 to .9883 seconds, the overall size and number of slices in each polygon creating the difference; borders surely have some impact as well but I haven't ran any good testing to figure out how much.

[johnno56]

Could not resist it... Re-ran with 1,000,000 polygons! 12.08789 seconds... This is fun!