Mod'ing a classic- partial circle fill
#1
Something that I've needed for one of my projects for a long time. A modification of the circle fill algorithm that restricts the draw to the limits of a bounding box. I'm not sure why it took me so long to get around to this, but here it is, in case someone can make use of it or are inspired to wow us with a better solution.

Left button click to place the center of the box, mousewheel to change the box size.


Code: (Select All)
'OldMoses' mod of Steve's circle fill
'drawing only those portions that fit the bounding box

'e% = 128
sz% = 50
ls% = 300
rs% = 400
t% = 100
b% = 200
SCREEN _NEWIMAGE(1024, 512, 32)
DO
    WHILE _MOUSEINPUT
        osz% = wsz%
        wsz% = SGN(_MOUSEWHEEL) * 3
        IF osz% <> sz% THEN
            ls% = ls% - wsz%: rs% = rs% + wsz%
            t% = t% - wsz%: b% = b% + wsz%
            sz% = sz% + wsz%
        END IF
    WEND
    IF _MOUSEBUTTON(1) THEN
        ls% = _MOUSEX - sz%: rs% = _MOUSEX + sz%
        t% = _MOUSEY - sz%: b% = _MOUSEY + sz%
    END IF

    CLS
    'LINE (512 - e%, 256 - e%)-(512 + e%, 256 + e%)
    'LINE (512 + e%, 256 - e%)-(512 - e%, 256 + e%)
    LINE (ls%, t%)-(rs%, b%), , B '                             Bounding box

    'CIRCLE (512, 256), 128, &H7FFF0000
    FCirc 512, 256, 128, &H7FFF0000 '                           Steve's unmodified circle fill
    FCircPart 512, 256, 128, &H7F00FF00, ls%, rs%, t%, b% '     modified partial circle fill

    _LIMIT 30
    _DISPLAY
LOOP UNTIL _KEYDOWN(27)
END



SUB FCircPart (CX AS LONG, CY AS LONG, RR AS LONG, C AS _UNSIGNED LONG, lt AS LONG, rt AS LONG, t AS LONG, b AS LONG) 'modified circle fill
    IF rt < CX - RR OR lt > CX + RR OR t > CY + RR OR b < CY - RR THEN EXIT SUB 'leave if box not intersecting circle
    DIM AS LONG 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
    IF CY >= t AND CY <= b THEN LINE (MinOf&(CX - X, lt), CY)-(MaxOf&(CX + X, rt), CY), C, BF 'draw equatorial line if applicable
    WHILE X > Y
        RError = RError + Y * 2 + 1 '
        IF RError >= 0 THEN
            IF X <> Y + 1 THEN
                IF CY - X >= t AND CY - X <= b AND CX - Y <= rt AND CX + Y >= lt THEN
                    LINE (MinOf&(CX - Y, lt), CY - X)-(MaxOf&(CX + Y, rt), CY - X), C, BF ' draw lines for south polar latitudes
                END IF
                IF CY + X <= b AND CY + X >= t AND CX - Y <= rt AND CX + Y >= lt THEN
                    LINE (MinOf&(CX - Y, lt), CY + X)-(MaxOf&(CX + Y, rt), CY + X), C, BF ' draw lines for north polar latitudes
                END IF
            END IF
            X = X - 1
            RError = RError - X * 2
        END IF
        Y = Y + 1
        IF CY - Y >= t AND CY - Y <= b AND CX - X <= rt AND CX + X >= lt THEN
            LINE (MinOf&(CX - X, lt), CY - Y)-(MaxOf&(CX + X, rt), CY - Y), C, BF '         draw lines north equatorial latitudes
        END IF
        IF CY + Y <= b AND CY + Y >= t AND CX - X <= rt AND CX + X >= lt THEN
            LINE (MinOf&(CX - X, lt), CY + Y)-(MaxOf&(CX + X, rt), CY + Y), C, BF '         draw lines south equatorial latitudes
        END IF
    WEND
END SUB 'FCircPart


SUB FCirc (CX AS LONG, CY AS LONG, RR AS LONG, C AS _UNSIGNED LONG) 'Steve's circle fill unmodified
    DIM AS LONG 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 lines for south polar latitudes
                LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF ' draw lines for north polar latitudes
            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 lines north equatorial latitudes
        LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF '         draw lines south equatorial latitudes
    WEND
END SUB 'FCirc


FUNCTION MaxOf& (value AS LONG, max AS LONG)
    MaxOf& = -value * (value <= max) - max * (value > max)
END FUNCTION 'MaxOf%

FUNCTION MinOf& (value AS INTEGER, minimum AS INTEGER)
    MinOf& = -value * (value >= minimum) - minimum * (value < minimum)
END FUNCTION 'MinOf%
DO: LOOP: DO: LOOP
sha_na_na_na_na_na_na_na_na_na:
Reply


Messages In This Thread
Mod'ing a classic- partial circle fill - by OldMoses - 01-17-2023, 12:25 AM



Users browsing this thread: 1 Guest(s)