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.