Drawing Tools Subs or Functions with Demo

[bplus]

OK since I wrote this test demo I changed the name Squicle (which I luv and attracted me to video) to rectircle (which I don't like and can't even remember how to spell it!) The reason as I said was not to mistake the math Squircle with my humble graphics button or window frame thingy.

Code: (Select All)

Option _Explicit 'maje sure test subs will be OK with this
_Title "Draw Squircle testing" ' b+ 2021-09-08
' revisit arc drawing: arc3 had a recent complaint about previous arc code that did not check raBegin and ra end
' so I updated arc#3 to arcC as 000Handy already has a simpler arc drawing sub probably the one I was complaining

Const xmax = 1024, ymax = 700
Screen _NewImage(xmax, ymax, 32)
_Delay .25
_ScreenMove _Middle
Dim r
Do
    For r = 0 To 250 Step 10
        Cls
        Rectircle xmax / 2, ymax / 2, 500, 500, r, &HFFFFFF00, 0
        Locate 3, 5: Print "Area ="; _Pi * r ^ 2 + 5 * (500 - 2 * r) ^ 2
        Print , "r ="; r
        _Display
        _Limit 5
    Next
    For r = 250 To 0 Step -2
        Cls
        Rectircle xmax / 2, ymax / 2, 500, 500, r, &HFFFFFF00, 1
        Locate 3, 5: Print "Area ="; _Pi * r ^ 2 + 5 * (500 - 2 * r) ^ 2
        Print , "r ="; r
        _Display
        _Limit 50
    Next
Loop

' this sub uses Sub arc (x, y, r, raStart, raStop, c As _Unsigned Long) ' this does not check raStart and raStop like arcC does
Sub Rectircle (cx, cy, w, h, r, c As _Unsigned Long, Fill) 'assume default single
    ' cx, cy is the middle of the Squircle
    ' a square with arc circle corners
    ' w, h = rectangle width and height
    ' r = radius of circular arc (as opposed to elliptical arc
    ' c is color
    'so r needs to be  < .5 * s ie if r = .5 * s then it's just a circle
    'likewise? if r = 0 then just a square
    Dim temp&, xo, yo, p, pd2, p32, xConst, yConst
    Static sd& ' so dont have to free image after each use
    sd& = _Dest ' save dest
    temp& = _NewImage(w + 1, h + 1, 32) ' create a drawing area  side of square
    _Dest temp&
    xo = w / 2: yo = h / 2 ' middles
    p = _Pi: pd2 = p / 2: p32 = p * 3 / 2
    xConst = .5 * (w - 2 * r) ' looks like this is first needed number to get the 4 origins for the arcs from xm y center
    yConst = .5 * (h - 2 * r)
    '4 arcs
    arc xo - xConst, yo - yConst, r, p, p32, c
    arc xo + xConst, yo - yConst, r, p32, 0, c
    arc xo + xConst, yo + yConst, r, 0, pd2, c
    arc xo - xConst, yo + yConst, r, pd2, p, c
    '4 lines
    Line (xo - xConst, yo - yConst - r)-(xo + xConst, yo - yConst - r), c
    Line (xo - xConst, yo + yConst + r)-(xo + xConst, yo + yConst + r), c
    Line (xo - xConst - r, yo - yConst)-(xo - xConst - r, yo + yConst), c
    Line (xo + xConst + r, yo - yConst)-(xo + xConst + r, yo + yConst), c
    If Fill Then Paint (xo, yo), c, c
    _Dest sd&
    _PutImage (cx - xo, cy - yo), temp&, sd&
End Sub

' will Squircle work with simpler arc sub? the angles are pretty well set
Sub arc (x, y, r, raStart, raStop, c As _Unsigned Long) ' this does not check raStart and raStop like arcC does
    Dim al, a
    'x, y origin, r = radius, c = color

    'raStart is first angle clockwise from due East = 0 degrees
    ' arc will start drawing there and clockwise until raStop angle reached

    If raStop < raStart Then
        arc x, y, r, raStart, _Pi(2), c
        arc x, y, r, 0, raStop, c
    Else
        ' modified to easier way suggested by Steve
        'Why was the line method not good? I forgot.
        al = _Pi * r * r * (raStop - raStart) / _Pi(2)
        For a = raStart To raStop Step 1 / al
            PSet (x + r * Cos(a), y + r * Sin(a)), c
        Next
    End If
End Sub

Sub arcC (x, y, r, raBegin, raEnd, c As _Unsigned Long) ' updated 2021-09-09
    ' raStart is first angle clockwise from due East = 0 degrees
    ' arc will start drawing there and clockwise until raStop angle reached
    'x, y origin, r = radius, c = color

    Dim p, p2 ' update 2021-09-09 save some time by doing _pi function once
    p = _Pi: p2 = p * 2

    Dim raStart, raStop, dStart, dStop, al, a

    ' Last time I tried to use this SUB it hung the program, possible causes:
    ' Make sure raStart and raStop are between 0 and 2pi.
    ' This sub does not have to be recursive, use GOSUB to do drawing to execute arc in one call.

    'make copies before changing
    raStart = raBegin: raStop = raEnd
    While raStart < 0: raStart = raStart + p2: Wend
    While raStart >= p2: raStart = raStart - p2: Wend
    While raStop < 0: raStop = raStop + p2: Wend
    While raStop >= p2: raStop = raStop - p2: Wend

    If raStop < raStart Then
        dStart = raStart: dStop = p2 - .00001
        GoSub drawArc
        dStart = 0: dStop = raStop
        GoSub drawArc
    Else
        dStart = raStart: dStop = raStop
        GoSub drawArc
    End If
    Exit Sub
    drawArc:
    al = p * r * r * (dStop - dStart) / p2
    For a = dStart To dStop Step 1 / al
        PSet (x + r * Cos(a), y + r * Sin(a)), c
    Next
    Return
End Sub