draw_polyT (Polygons)

[James D Jarvis]

draw filled equilateral polygons and circles using _MapTriangle

Code: (Select All)

'draw_polyT
' by James D.  Jarvis
'draw filled equilateral polygons and circles
'
'HEADER
Dim Shared xmax, ymax
xmax = 800: ymax = 500
Screen _NewImage(xmax, ymax, 32)
Dim Shared pk&
pkt& = _NewImage(3, 3, 32)

'======================================
' demo
'======================================
Randomize Timer
Dim degr(10) As Long 'just to ahve a clean demonstration of randomly defiend shapes
degr(1) = 1
degr(2) = 3
degr(3) = 12
degr(4) = 30
degr(5) = 40
degr(6) = 45
degr(7) = 60
degr(8) = 72
degr(9) = 90
degr(10) = 120

t1 = Timer
For reps = 1 To 64000
    polyT Int(Rnd * xmax), Int(Rnd * ymax), Int(10 + Rnd * 60), _RGB32(Int(Rnd * 256), Int(Rnd * 256), Int(Rnd * 256)), degr(Int(1 + Rnd * 10))
Next reps
t2 = Timer
Print "That took "; t2 - t1; " seconds to draw 64000 polygons"

'==========================================================================
'subroutines
'
'  polyT    draw a filled equilateral polygon or circle
'
' setklr    is an  sub to build the color image used byt triangles in  polyT
'====================================== ==================================
Sub polyT (cx As Long, cy As Long, r As Long, klr As _Unsigned Long, deg As Long)
    'draw an equilateral polygon
    'if degrees dont' evenly divide into 360 it's goign to be ragged.
    'circles will be drawn when the value for degree is low
    setklr klr
    d = 0
    x = r * Sin(0)
    y = r * Cos(0)
    While d < 360
        d = d + deg
        x2 = r * Sin(0.01745329 * d)
        y2 = r * Cos(0.01745329 * d)
        _MapTriangle (0, 2)-(2, 2)-(2, 0), pk& To(cx, cy)-(cx + x, cy + y)-(cx + x2, cy + y2)
        x = x2
        y = y2
    Wend
End Sub
Sub setklr (klr As Long)
    'setup a image to copy a colored triangle
    'called by polyT
    _Dest pk&
    Line (0, 0)-(2, 2), klr, BF
    _Dest 0
End Sub