QB64 Phoenix Edition
Draw circles - Printable Version

+- QB64 Phoenix Edition (https://staging.qb64phoenix.com)
+-- Forum: QB64 Rising (https://staging.qb64phoenix.com/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://staging.qb64phoenix.com/forumdisplay.php?fid=3)
+---- Forum: Programs (https://staging.qb64phoenix.com/forumdisplay.php?fid=7)
+---- Thread: Draw circles (/showthread.php?tid=550)

Draw circles - James D Jarvis - 06-13-2022

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


RE: Draw circles - DANILIN - 06-13-2022

Russian Circle Diagram

https://qb64forum.alephc.xyz/index.php?topic=4367

RealTime:

https://qbjs.org/index.html?qbcode=BOAQAHvAN8AKgkRJTdAZAAoXAKeoqmhqSKipyQDEAGU8JGT1J4BrvX7QVRPmANV/mKmJ6GgqiLuQBZhedrgNLi5u74BUByQkEkpypd+EpJyI3AKngBzqAYOgCt17aAOnpc0Mr2uQC1+rKy2AJCIaemJ6ldgL5ASkjoWv85k1Dw9iQxYBOIoKSSnKiqwahpyKsKhmRj386O3dc5evgfr8ARWQlNVTat3cAdo7R4sO6CrTu2sA3zLCr3M8MABel2HGdsigqCT3N2gCUCkoyfp9fIB9d+o/eeqAaokIqct+vmkcP8XlAhAF16wFBAdEABqbZcVdbdgamqIqg7PyAaSAf02mT63kAD6u2cYSanojLrLaBnlFQ0lSQ0xFevQDPXcbjl77g6eKWR+y6nvunuY7+59bZr2j71+/1r2s8+o51fcs7iIepdVa/OF86kziuad/vll7bv9/cAAxgkVORGFwADqfyx7vySbA5ev3nc6Rgz7Ss1qgbQXP1u95alLv23f866+47/n2+h/HjfEZt+4rdxsziXF++5akvvuWtR77557OuvYfez3YAHdXfsA72wCjqiIiKmIKy1d1xIBtsMXYUcSrvT4=

[Image: index.php?PHPSESSID=05a1e75e671f6f7f0465...tach=14866]

RE: Draw circles - James D Jarvis - 06-13-2022

Neato.

RE: Draw circles - triggered - 06-16-2022

This is an incredibly odd way to draw circles:

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

It took me forever to figure out how to make circles and arcs thicker, for instance:

Draw "ta " + Str$(d) + " br" + Str$(r - 3) + "rrr bl" + Str$(r)

produces thicker arcs. This didn't solve the leaking problem, however.

RE: Draw circles - James D Jarvis - 06-16-2022

I just stumbled on the idea making random curls and squiggles with the draw command. I was getting several big sweeping curves and realized how to make a circle from that.  Yup adjusting the end segment that is actually drawing  the arc is the way to get a thicker line.


Here's a modified dpieslice sub that cuts down the bleed by simply adding another line to the pie sides to reduce gaps caused by jaggy lines. It has one bleed I notice instead of the 4 or 5 in the demo from the original sub.

Code: (Select All)
Sub dpieslice (xx, yy, r, klr, fill, arc1, arc2)
    'draws and fills a pie splce
    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$(arc1 + 0.35) + " r " + Str$(r) + "bl" + Str$(r)
    Draw "ta" + Str$(arc2) + " r " + Str$(r) + "bl" + Str$(r)
    Draw "ta" + Str$(arc2 - 0.35) + " 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


RE: Draw circles - James D Jarvis - 06-16-2022

(06-16-2022, 07:03 AM)triggered Wrote: This is an incredibly odd way to draw circles:

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

It took me forever to figure out how to make circles and arcs thicker, for instance:

Draw "ta " + Str$(d) + " br" + Str$(r - 3) + "rrr  bl" + Str$(r)

produces thicker arcs. This didn't solve the leaking problem, however.



Drawing that arc with a thicker line: (I also cleared up that do at the center of the circle the arc is drawn from.)
Code: (Select All)
Sub dfarc (xx, yy, r, klr, arc1, arc2, t)
    'draws an arc with thickness defined as t, will draw an unfilled circle if the arc goes from 0 to 360
    tk = Point(xx, yy)
    PSet (xx, yy), tk
    Draw "c" + Str$(klr)
    For d = arc1 To arc2 Step 1
        Draw "ta " + Str$(d) + " br" + Str$(r - t) + "r" + Str$(t) + " bl" + Str$(r)
    Next d
End Sub

 
Code: (Select All)
Sub darc (xx, yy, r, klr, arc1, arc2)
    'draws an arc, will draw an unfilled circle if the arc goes from 0 to 360
    tk = Point(xx, yy)
    PSet (xx, yy), tk
    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