Improved my small Gradient Ball drawing SUB

[Dav]

I use a small gradient ball SUB in various programs.  It had a flaw however - large balls with dark color values would have think back edges.  Made a new version to fix that.  Just thought I'd share it here.  If you have one too, please share it - I'd love to see what other people are using.  And if you see a way to improve mine please post it.  Thanks!

- Dav

Code: (Select All)

'================

'GRADIENTBALL.BAS

'================

'Simple SUB that draw gradient balls.

'Coded by Dav, JULY/2023





dh = _DESKTOPHEIGHT * .85

SCREEN _NEWIMAGE(dh, dh, 32)



DO

    ball RND * dh, RND * dh, RND * 500 + 25, RND * 255, RND * 255, RND * 255

    _LIMIT 5

LOOP



SUB ball (x, y, size, r, g, b)

    'This SUB draws a gradient ball with given color.



    'see current display status

    displayStatus%% = _AUTODISPLAY



    'turn off screen updates while we draw

    _DISPLAY



    reg = .4



    'if size is larger than value colors given,

    'adjust the reg value to step down at a slower rate.

    'This prevents thick black rim around larger balls

    'that have a too low a given color value.

    IF size > r AND size > g AND size > b THEN

        IF r > g AND r > b THEN reg = r / size * .4

        IF g > r AND g > b THEN reg = g / size * .4

        IF b > r AND b > g THEN reg = b / size * .4

    END IF



    'now draw the ball using CIRCLE.

    'Using smaller STEP value than 1 prevents gaps.

    FOR s = 0 TO size STEP .4

        CIRCLE (x, y), s, _RGB(r, g, b)

        r = r - reg: g = g - reg: b = b - reg

    NEXT



    'show the ball

    _DISPLAY



    'If autodislay was previously on, turn it back on

    IF displayStatus%% = -1 THEN _AUTODISPLAY



END SUB

[CharlieJV]

That's good stuff.  Thanks for sharing!

BAM Version (I had to do some tweaking to get that working):

• Run the program
  
• View the source code
  

[bplus]

My DrawBalls were improved by OldMoses Sin even smallest!!!

Code: (Select All)

dh = _DesktopHeight * .85
Screen _NewImage(dh, dh, 32)

Do
    drawBall Rnd * dh, Rnd * dh, 5, _RGB32(Rnd * 255, Rnd * 255, Rnd * 255)
    _Limit 5
Loop


Sub drawBall (x, y, r, c As _Unsigned Long)
    Dim rred As Long, grn As Long, blu As Long, rr, f
    rred = _Red32(c): grn = _Green32(c): blu = _Blue32(c)
    For rr = r To 0 Step -0.25 ' step -1 with Filled Circle
        f = 1 - Sin(rr / r) ' thank OldMoses for Sin ;-))
        Circle (x, y), rr, _RGB32(rred * f, grn * f, blu * f)
        ' better with Filled Circle
    Next
End Sub

[Dav]

Cool!  That's a slick way.  Looks good.

- Dav

[Dav]

Hey CharlieJV, Sorry I didn’t see your post up there before.  Thanks.

BAM s awesome!

- Dav

[mnrvovrfc]

Dav, nice program and with bplus' changes too. I modified it so it stopped with _KEYDOWN(27). Also changed so the radius varied from 5 to 10 inclusive. Maybe if it could be changed so the colors were yellowish or orangish in the majority, with a couple of red, blue and green balls, they would begin to look like a lumpy cluster of stars.

[Dav]

Thanks, mnrvovrfc.

Here's another version I played around with today, using SQR + PSET.  Added transparency.  Small, but slower though.

- Dav

Code: (Select All)

SCREEN _NEWIMAGE(800, 600, 32)



DO

    ball RND * _WIDTH, RND * _HEIGHT, RND * 400 + 25, RND * 255, RND * 255, RND * 255, 100 + RND * 155

    _LIMIT 5

LOOP UNTIL INKEY$ <> ""



SUB ball (x, y, size, r, g, b, a)

    FOR y2 = y - size TO y + size

        FOR x2 = x - size TO x + size

            clr = (size - (SQR((x2 - x) * (x2 - x) + (y2 - y) * (y2 - y)))) / size

            IF clr > 0 THEN PSET (x2, y2), _RGBA(clr * r, clr * g, clr * b, a)

        NEXT

    NEXT

END SUB

[CharlieJV]

That's good stuff.  Thanks for sharing!

BAM Version (I had to do some tweaking to get that working):

• Run the program
  
• View the source code
  

Alternative BAM version by ZXDUNNY, using SIN-based gradient instead of linear:

• Run the program
  
• View the source code
  

[CharlieJV]

And scrolling gradiant balls:

• Run the program
  
• View the source code
  

Yeah, dropped the resolution a bit to keep decent performance.

[CharlieJV]

[...]

BAM s awesome!

- Dav

Hey, thanks.  For a browser-based little guy, I'm pretty pleased with it so far.  Loads to do, which I don't mind 'cause it is a whole ton of fun marrying BASIC and TiddlyWiki.