Draw circles

[James D Jarvis]

A few circle drawing routines that use the draw command. You can never have too many options.

Code: (Select All)

'draw circles
'by James D. Jarvis
' a few subs with to draw circles and pie charts


Screen _NewImage(800, 500, 256)
'$dynamic 'this is just set to dynamic for the piechart part of the demo
Print "A few subs to draw cricles, arcs, and pie charts using simple math and the draw command."
Print "Not perfect yet, but they work for smaller circles."
Locate 3, 1: Print "A simple filled circle"
_Delay 0.85
dcircle 200, 100, 10, 12

Locate 3, 1: Print "An arc from 0 t0 270"
_Delay 0.85
darc 200, 100, 20, 13, 0, 270

Locate 3, 1: Print "An arc from 140 0 320"
_Delay 0.85
darc 200, 100, 56, 10, 140, 320

Locate 3, 1: Print "A pie slice with different color borders "
_Delay 0.85
dpieslice 100, 100, 20, 2, 10, 0, 60

Dim pd(3)
pd(1) = 5
pd(2) = 10
pd(3) = 15
piechart 300, 300, 70, 15, pd()
For t = 1 To 10
    _Limit 5
Next t
Cls

'showing a pie chart if one of the fields grows and another has a decreese
For x = 5 To 20
    _Limit 3

    pd(1) = x
    pd(3) = pd(3) * .9
    Cls
    dcircle 200, 100, 10, 12 'copied so it doesn't vanish
    darc 200, 100, 20, 13, 0, 270 'copied so it doesn't vanish
    darc 200, 100, 56, 13, 140, 320 'copied so it doesn't vanish
    dpieslice 100, 100, 20, 2, 10, 0, 60 'copied so it doesn't vanish

    piechart 300, 300, 70, 15, pd()
    _Display
Next x
'showing a pie chart gaining entries
For n = 1 To 12
    _Limit 3

    np = UBound(pd) + n
    ReDim _Preserve pd(np)
    pd(np) = 15 - n
    Cls
    dcircle 200, 100, 10, 12 'copied so it doesn't vanish
    darc 200, 100, 20, 13, 0, 270 'copied so it doesn't vanish
    darc 200, 100, 56, 13, 140, 320 'copied so it doesn't vanish
    dpieslice 100, 100, 20, 2, 10, 0, 60 'copied so it doesn't vanish

    piechart 300, 300, 70, 15, pd()
    _Display
    'getting a color leak I haven't figured out just yet
    Locate 1, 1: Print "Haven't tracked down why that bleed happens just yet. Hope you find some of this useful."
Next n

Sub dcircle (xx, yy, r, klr)
    'draw a circle
    PSet (xx, yy), klr
    Draw "c" + Str$(klr)
    For d = 0 To 360 Step 1
        Draw "ta " + Str$(d) + " r" + Str$(r) + " bl" + Str$(r)
    Next d
End Sub


Sub darc (xx, yy, r, klr, arc1, arc2)
    'draws an arc, will draw an unfilled circle if the arc goes from 0 to 360
    PSet (xx, yy), klr
    Draw "c" + Str$(klr)
    For d = arc1 To arc2 Step 1
        Draw "ta " + Str$(d) + " br" + Str$(r - 1) + "r  bl" + Str$(r)
    Next d
End Sub

Sub dpieslice (xx, yy, r, klr, fill, arc1, arc2)
    'draws and fills a pie slice
    PSet (xx, yy), klr
    Draw "c" + Str$(klr)
    For d = arc1 To arc2 Step 0.3
        Draw "ta " + Str$(d) + " br" + Str$(r - 1) + "r  bl" + Str$(r)
    Next d
    Draw "ta" + Str$(arc1) + " r " + Str$(r) + "bl" + Str$(r)
    Draw "ta" + Str$(arc2) + " r " + Str$(r) + "bl" + Str$(r)
    Draw "ta" + Str$((arc1 + arc2) / 2) + "br " + Str$(Int(r / 2)) + "P" + Str$(fill) + "," + Str$(klr) + " bl" + Str$(Int(r / 2))
End Sub

Sub piechart (xx, yy, r, klr, a())
    'takes array a() as raw data and calculates size of pie wedges to be drawn
    Dim portion(UBound(a))
    total = 0
    For ss = 1 To UBound(a)
        total = a(ss) + total
    Next ss
    For ss = 1 To UBound(a)
        portion(ss) = a(ss) / total
    Next ss
    a1 = 0
    'pie wedges are drawn AND filled with colors starting from color 1
    For ss = 1 To UBound(a)
        ap = portion(ss) * 360
        a2 = a1 + ap
        dpieslice xx, yy, r, klr, ss, a1, a2
        a1 = a2
    Next ss
End Sub