Rounded Rectangles and Thick Circles

[OldMoses]

I came up with one that I call Balloon_Box, which uses the fill circle routine on the corners.

Code: (Select All)

$COLOR:32

TYPE V2
    x AS INTEGER
    y AS INTEGER
END TYPE

TYPE region
    ul AS V2
    lr AS V2
END TYPE

SCREEN _NEWIMAGE(1024, 512, 32)
DO: LOOP UNTIL _SCREENEXISTS

DIM AS region ulrg, urrg, llrg, lrrg
ulrg.ul.x = 0: ulrg.ul.y = 0: ulrg.lr.x = _WIDTH / 2 - 1: ulrg.lr.y = _HEIGHT / 2 - 1
urrg.ul.x = _WIDTH / 2: urrg.ul.y = 0: urrg.lr.x = _WIDTH - 1: urrg.lr.y = _HEIGHT / 2 - 1
llrg.ul.x = 0: llrg.ul.y = _HEIGHT / 2: llrg.lr.x = _WIDTH / 2 - 1: llrg.lr.y = _HEIGHT - 1
lrrg.ul.x = _WIDTH / 2: lrrg.ul.y = _HEIGHT / 2: lrrg.lr.x = _WIDTH - 1: lrrg.lr.y = _HEIGHT - 1


DO
    CLS
    BalloonRegion ulrg, Green, Blue
    BalloonRegion urrg, Black, Cyan
    BalloonRegion llrg, Black, White
    BalloonRegion lrrg, Blue, Green
    WHILE _MOUSEINPUT: WEND
    'BalloonBox _MOUSEX, _MOUSEY, Green, Red, 0, 0
    BalloonBox 100, 100, Green, Red, _MOUSEX - 50, _MOUSEY - 50
    _LIMIT 30
    _DISPLAY
LOOP UNTIL _KEYDOWN(27)
END

SUB BalloonRegion (r AS region, bk AS _UNSIGNED LONG, vg AS _UNSIGNED LONG)
    BalloonBox r.lr.x - r.ul.x, r.lr.y - r.ul.y, bk, vg, r.ul.x, r.ul.y
END SUB 'BalloonRegion

SUB BalloonBox (wd AS INTEGER, ht AS INTEGER, bk AS _UNSIGNED LONG, vg AS _UNSIGNED LONG, xp AS INTEGER, yp AS INTEGER)
    DIM bbox&, pre&
    DIM radius%, shrink%, wd1%, ht1%
    IF wd < 1 OR ht < 1 THEN EXIT SUB
    radius% = _IIF(wd < ht, wd \ 10, ht \ 10)
    shrink% = radius% \ 4
    bbox& = _NEWIMAGE(wd, ht, 32) '                             balloon
    wd1% = _WIDTH(bbox&) - 1: ht1% = _HEIGHT(bbox&) - 1
    pre& = _DEST
    _DEST bbox&
    CLS , &HFFFF00FF '                                          full magenta masking color
    'Draw outer border in border color (vg)
    LINE (radius%, 0)-(wd1% - radius%, ht1%), vg, BF '          Tall narrow block
    LINE (0, radius%)-(wd1%, ht1% - radius%), vg, BF '          short fat block
    FCirc radius%, radius%, radius%, vg '                       upper left fillet
    FCirc wd1% - radius%, radius%, radius%, vg '                upper right fillet
    FCirc radius%, ht1% - radius%, radius%, vg '                lower left fillet
    FCirc wd1% - radius%, ht1% - radius%, radius%, vg '         lower right fillet
    'draw inner field in background color (bk)
    LINE (radius%, shrink%)-(wd1% - radius%, ht1% - shrink%), bk, BF
    LINE (shrink%, radius%)-(wd1% - shrink%, ht1% - radius%), bk, BF
    FCirc radius%, radius%, radius% - shrink%, bk
    FCirc wd1% - radius%, radius%, radius% - shrink%, bk
    FCirc radius%, ht1% - radius%, radius% - shrink%, bk
    FCirc wd1% - radius%, ht1% - radius%, radius% - shrink%, bk

    _CLEARCOLOR &HFFFF00FF
    _DEST pre&
    _PUTIMAGE (xp, yp), bbox&
    _FREEIMAGE bbox&
END SUB 'BallonBox

SUB FCirc (CX AS INTEGER, CY AS INTEGER, RR AS INTEGER, C AS _UNSIGNED LONG) 'Steve's circle draw
    DIM AS INTEGER R, RError, X, Y
    R = ABS(RR) '                                               radius value along positive x
    RError = -R '                                               opposite side of circle? negative x
    X = R '                                                     point along positive x position
    Y = 0 '                                                     starting at the equator
    IF R = 0 THEN PSET (CX, CY), C: EXIT SUB '                  zero radius is point, not circle
    LINE (CX - X, CY)-(CX + X, CY), C, BF '                     draw equatorial line
    WHILE X > Y
        RError = RError + Y * 2 + 1
        IF RError >= 0 THEN
            IF X <> Y + 1 THEN
                LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF ' draw line above equator
                LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF ' draw line below equator
            END IF
            X = X - 1
            RError = RError - X * 2
        END IF
        Y = Y + 1
        LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF '         draw line north latitudes
        LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF '         draw line south latitudes
    WEND
END SUB 'FCirc