Thanks, @bplus.
I updated the BALLRAIN demo posted last September with the new FC SUB and also incorporated a movable bigball and collision and overlapping technique used in the last demo. It's easier to see how it works in this one I think, although it's only doing collision detecting with the bigball and not with other balls.
FC draws much faster than the way I did it last year (had to hardware images to go this smooth last year).
- Dav
Code: (Select All)
'=============
'BALLRAIN3.BAS
'=============
'Balls rain from the top, some drop, some bounce then sink away.
'Move bigball with mouse to block and knock them out of the way.
'Coded by Dav for QB64 Phoenix Edition, SEP/2024
'This is an updated BALLRAIN demo that demonstrates the FC SUB and how
'to do collision detection using vector reflection & overlap correction.
'Demo ends when the balls stop raining, or you press ESC.
Screen _NewImage(1000, 600, 32)
balls = 300 'number of balls on screen
Dim ballx(balls), bally(balls), ballxvel(balls), ballyvel(balls), ballsize(balls)
Dim ballred(balls), ballgrn(balls), ballblu(balls)
'make random ball values
For b = 1 To balls
ballx(b) = Rnd * (_Width) 'x position
bally(b) = Rnd * -(_Height) 'y position
ballxvel(b) = Int(Rnd * 2) 'x speed
ballyvel(b) = Int(Rnd * 2) 'y speed
ballsize(b) = Rnd * 20 + 10 'ball size
ballred(b) = Rnd * 255 'red color
ballgrn(b) = Rnd * 255 'green color
ballblu(b) = Rnd * 255 'blue color
Next
_MouseMove _Width / 2, _Height / 2
bigballsize = 100 'bigball size
bigballclr& = _RGBA(255, 0, 255, 200) 'bigball color
Do
Cls
While _MouseInput: Wend
bigballx = _MouseX: bigbally = _MouseY
'do all falling balls
For b = 1 To balls
If bally(b) < _Height - ballsize(b) Then
ballx(b) = ballx(b) + ballxvel(b)
bally(b) = bally(b) + ballyvel(b)
If ballx(b) < ballsize(b) Or ballx(b) > _Width - ballsize(b) Then
ballxvel(b) = -ballxvel(b)
End If
If bally(b) < ballsize(b) Or bally(b) > _Height - (ballsize(b) * 2) Then
ballyvel(b) = -ballyvel(b)
End If
ballyvel(b) = ballyvel(b) + 3 'gravity value
'do collision detection of balls and bigball
'calculate distance from center
dis = Sqr((ballx(b) - bigballx) ^ 2 + (bally(b) - bigbally) ^ 2)
If dis < (bigballsize + ballsize(b)) Then
'calculate the normal vector
x = (ballx(b) - bigballx) / dis
y = (bally(b) - bigbally) / dis
'reflect the velocity off the normal vector
vr = ballxvel(b) * x + ballyvel(b) * y
ballxvel(b) = ballxvel(b) - 2 * vr * x
ballyvel(b) = ballyvel(b) - 2 * vr * y
'calculate how much it's overlapping
over = (bigballsize + ballsize(b)) - dis
'move it away from the bigball
ballx(b) = ballx(b) + x * over
bally(b) = bally(b) + y * over
End If
'draw ball, but only if it's actually on the screen
If ballx(b) > ballsize(b) And ballx(b) < _Width + ballsize(b) Then
If bally(b) > ballsize(b) And bally(b) < _Height + ballsize(b) Then
fc ballx(b), bally(b), ballsize(b), _RGBA(ballred(b), ballgrn(b), ballblu(b), 225), 1
End If
End If
End If
Next
' Draw the big ball
fc bigballx, bigbally, bigballsize, bigballclr&, 1
'Check if all the balls are off-screen
onscreen = 0
For b = 1 To balls
If bally(b) < _Height - ballsize(b) Then onscreen = 1
Next
If onscreen = 0 Then Exit Do
_Display
_Limit 24
Loop Until InKey$ <> ""
Sub fc (cx, cy, radius, clr~&, grad)
If radius = 0 Then Exit Sub ' safety bail
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