I updated my original FC version to draw gradient balls too. If you want a gradient ball give the grad parameter a 1, otherwise it draws a solid color circle. Here is a demo using it, a moving starfield but with balls, so it's called the ballfield. I'll post just the update SUB at the bottom.
(btw, Happy labor day to all!)
- Dav
Ballfield Demo:
Updated FC SUB that draws gradient circles.
(btw, Happy labor day to all!)
- Dav
Ballfield Demo:
Code: (Select All)
'=============
'BALLFIELD.BAS
'=============
'Shows balls in space coming towards you.
'Dav, SEP/2024
'Uses updated version of FC SUB discussed here:
'https://qb64phoenix.com/forum/showthread.php?tid=2989
Randomize Timer
Screen _NewImage(1000, 700, 32)
balls = 600
Dim ballx(balls), bally(balls), ballz(balls), ballSize(balls)
Dim ballc~&(balls), sort(balls) 'array for bubble sort
' Init balls
For i = 0 To balls - 1
ballx(i) = Rnd * _Width 'x pos
bally(i) = Rnd * _Height 'y pos
ballz(i) = Rnd * 100 + 25 'z depth
ballc~&(i) = _RGBA(55 + (Rnd * 200), 55 + (Rnd * 200), 55 + (Rnd * 200), 255)
Next
Do
Cls
For i = 0 To balls - 1
'move faster towards front based on z
ballz(i) = ballz(i) - (.75 * (_Width - ballz(i)) / _Width)
'if done, reset ball x/y/z
If ballz(i) < 1 Then
ballz(i) = Rnd * 100 + 25
ballx(i) = Rnd * _Width
bally(i) = Rnd * _Height
End If
'get size from depth (decreases with depth)
ballSize(i) = (4 / ballz(i)) * 100
'drift off from center (veer away)
veerx = (ballx(i) - (_Width / 2)) * (ballSize(i) / _Width)
veery = (bally(i) - (_Height / 2)) * (ballSize(i) / _Height)
ballx(i) = ballx(i) + veerx
bally(i) = bally(i) + veery
sort(i) = i 'store this ball into array for sorting
Next
'bubble sort based on size (smallest first)
'so small ones are drawn first, big ones last
For i = 0 To balls - 2
For j = 0 To balls - 2 - i
If ballSize(sort(j)) > ballSize(sort(j + 1)) Then
Swap sort(j), sort(j + 1)
End If
Next
Next
'draw balls in the sort() array order
For i = 0 To balls - 1
'only call a draw if the ball is in screen bounds
If ballx(sort(i)) > 0 And ballx(sort(i)) < _Width Then
If bally(sort(i)) > 0 And bally(sort(i)) < _Height Then
fc ballx(sort(i)), bally(sort(i)), ballSize(sort(i)), ballc~&(sort(i)), 1
End If
End If
Next
_Limit 30
_Display
Loop Until InKey$ <> ""
Sub fc (cx, cy, radius, clr~&, grad)
If grad = 1 Then
red = _Red32(clr~&)
grn = _Green32(clr~&)
blu = _Blue32(clr~&)
alpha = _Alpha32(clr~&)
End If
r2 = radius * radius
For y = -radius To radius
x = Sqr(r2 - y * y)
'if doing gradient
If grad = 1 Then
For i = -x To x
dis = Sqr(i * i + y * y) / radius
red2 = red * (1 - dis) + (red / 2) * dis
grn2 = grn * (1 - dis) + (grn / 2) * dis
blu2 = blu * (1 - dis) + (blu / 2) * dis
clr2~& = _RGBA(red2, grn2, blu2, alpha)
Line (cx + i, cy + y)-(cx + i, cy + y), clr2~&, BF
Next
Else
Line (cx - x, cy + y)-(cx + x, cy + y), clr~&, BF
End If
Next
End Sub
Updated FC SUB that draws gradient circles.
Code: (Select All)
Sub fc (cx, cy, radius, clr~&, grad)
If grad = 1 Then
red = _Red32(clr~&)
grn = _Green32(clr~&)
blu = _Blue32(clr~&)
alpha = _Alpha32(clr~&)
End If
r2 = radius * radius
For y = -radius To radius
x = Sqr(r2 - y * y)
'if doing gradient
If grad = 1 Then
For i = -x To x
dis = Sqr(i * i + y * y) / radius
red2 = red * (1 - dis) + (red / 2) * dis
grn2 = grn * (1 - dis) + (grn / 2) * dis
blu2 = blu * (1 - dis) + (blu / 2) * dis
clr2~& = _RGBA(red2, grn2, blu2, alpha)
Line (cx + i, cy + y)-(cx + i, cy + y), clr2~&, BF
Next
Else
Line (cx - x, cy + y)-(cx + x, cy + y), clr~&, BF
End If
Next
End Sub