Contact

 
Google
Web www.alanphipps.com

 
   
 
   
www.alanphipps.com

.: Dropping Balls After a Collision

 
 

This one was quite difficult, if you remember in the last tutorial, after a collision occurs we cycle through the ball array and find those balls which should be selected for deletion, this time we will be looking for those balls that should be dropped out the game. If you imagine the balls in our game as being connected to the balls above and all balls are hanging from the top of the play area. This means that if a few balls are deleted then the balls below are no longer connected to the top of the play area and hence these are the balls that will be dropped. It is possible that some balls will still be hanging from the top of the play area via connections to other balls, this will taken into account and only those balls that float with no connection will be dropped. So as usual, starting with the source code from the previous tutorial, copy the code folder and rename it to DropBalls, open the project and as before we will begin with the Graphics Module.

There are a couple of extra additions to this tutorial that are separate from the Dropping Balls procedure, we will get them out of the way first.

So add the following code to the Declarations section of the Graphics Module:

 

Public TempSBRotate As Single = 0

 

The GetBallVectorFromArrow Sub has new code added to it and now looks like:

'Get Ball trajectory from Arrow
Public Sub GetBallVectorFromArrow()

'If a ball has been launched and you moved the arrow, the moving ball would change direction to keep
' in the same direction as ArrowSBRotate which is defined by the direction of the arrow
'This If statement ensures that once a ball has entered the game it is not influenced by the movement of the
'Arrow
If ABallHasBeenLaunched = False Then
TempSBRotate = ArrowSBRotate
End If

'Find the direction of the arrow
Select Case MathHelper.ToDegrees(ArrowSBRotate)
Case Is < -0.1 ' if arrow is pointing to the left
'Get arrow direction using the equations of a circle
' x = r * cos(angle) and
' y = r * sin(angle)
' where r is the radius and angle is the angle from 'right' t the direction of the arrow

BallVectorXPub = 494 * Math.Cos(ArrowSBRotate * MathHelper.ToRadians(70))
BallVectorYPub = 494 * (-Math.Sin(ArrowSBRotate * MathHelper.ToRadians(75)))
If BallVectorXPub < 50 Then ' If arrow goes further than 85 degrees to the left then
BallVectorXPub = 50 ' the arrow is set to 85 degrees to the left
End If
Case -0.09 To 0.09 ' if arrow is pointing straight up
BallVectorXPub = (PlayAreaRect.X + (PlayAreaRect.Width / 2))
BallVectorYPub = PlayAreaRect.Y
Case Is > 0.1 ' if arrow is pointing to the right
BallVectorYPub = 494 * Math.Cos(ArrowSBRotate)
BallVectorXPub = 494 * Math.Sin(ArrowSBRotate)
If BallVectorYPub < 45 Then ' If arrow goes further than 85 degrees to the right then
BallVectorYPub = 60 'the arrow is set to 85 degrees to the left
End If
End Select

End Sub

 

This new code fixes a bug where the moving of the arrow would influence the direction of a moving ball after it had been launched.The next change is a new sub that will Redim the BallArray so that any deleted balls are removed, this ensures that the BallArray doesn't get too big, which would slow down our game:

'Remove Deleted Balls from the BallArray - to keep game efficient
Public Sub RedimBallArray()

Dim TempBallArray() As Ball = New Ball() {}

For Each TempBall As Ball In BallArray
If TempBall.IsDeleted = False Then
ReDim Preserve TempBallArray(UBound(TempBallArray) + 1)
TempBallArray(UBound(TempBallArray)) = TempBall
End If
Next

ReDim BallArray(UBound(TempBallArray))

TempBallArray.CopyTo(BallArray, 0)

Erase TempBallArray

End Sub

 

This new sub is implemented as part of the Render loop. Next we have a change to the CheckForCollision Sub:

'Check for Ball Collision
Public Sub CheckForCollision()
If IndexOfMovingBallFound = False Then ' If the moving ball is unknown
For m As Integer = 0 To UBound(BallArray) ' Search array for the ball that is moving
If BallArray(m).IsMoving = True Then ' When the moving ball is found
IndexOfMovingBall = m ' store the ball index in a variable and exit the for loop
IndexOfMovingBallFound = True
Exit For
End If
Next
End If

'Each ball will be enclosed in a bounding sphere. The BoundingSphere.Intersects method allows us to tell when
' two balls collide. The following objects are part of this process. The objects are declared here so that they are
' not declared in every loop, which would cause more work for the program
'One BoundingSphere for the Moving Ball

Dim TempBoundingSphereMovingBall As BoundingSphere = New BoundingSphere(New Vector3(BallArray(IndexOfMovingBall).BallRect.X, _
BallArray(IndexOfMovingBall).BallRect.Y, 0), 20)
Dim TempBoundingSphereOtherBall As BoundingSphere ' One BoundingSphere for the Other ball in the collision.

For Each Singleball As Ball In BallArray ' check each ball for a collision
If Singleball.IsDeleted = False Then 'Only those balls that are still in play
If Singleball.IsDropped = False Then 'Only those balls that have not been dropped
If Singleball.IsMoving = True Then ' If the current ball is the ball that has just been launched then
GoTo NextBall ' goto to the next ball
End If
If Singleball.IsInLauncher = True Then ' If the current ball is lower than the ball launcher
GoTo NextBall ' goto the next ball
End If

'Set the boundingsphere to the boundaries of the current ball
TempBoundingSphereOtherBall = New BoundingSphere(New Vector3(Singleball.BallRect.X, Singleball.BallRect.Y, 0), 20)

If TempBoundingSphereMovingBall.Intersects(TempBoundingSphereOtherBall) = True Then 'Check for a collision

'Set Public variable to be used in PositionBallCorrectly()
BoundingSphereOtherBallPub = TempBoundingSphereOtherBall

BallArray(IndexOfMovingBall).BallXVel = 0 ' Stop the Ball in the X direction
BallArray(IndexOfMovingBall).BallYVel = 0 ' Stop the ball in the Y direction
BallArray(IndexOfMovingBall).IsMoving = False ' Set the ball's IsMoving variable to False
IndexOfMovingBallFound = False ' Tell the program to find the next moving ball
ABallHasBeenLaunched = False ' Set the Ball Moving Global variable to false
TempBoundingSphereMovingBall = Nothing ' Empty the variables
TempBoundingSphereOtherBall = Nothing
ABallNeedsPositionedCorrectly = True 'Ball will now be positioned correctly
Exit Sub

End If
End If
End If
NextBall:
Next

' The loop is finished and are disposed
TempBoundingSphereMovingBall = Nothing
TempBoundingSphereOtherBall = Nothing

End Sub

 

This new code simply stops any balls that have been dropped being involved in collisions. Next we have a new Sub that locates which balls need to be dropped:

'Find the Balls that will be dropped and setting their MarkedForDeletionDrop Marker
Public Sub FindBallsToDrop()

'Set the MarkedForDeletionDrop markers for all balls
For Each SingleBall As Ball In BallArray
If SingleBall.IsInLauncher = False Then
SingleBall.MarkedForDeletionDrop = True
End If
Next
'So now all balls have their MarkedForDeletionDrop marker set and hence all balls are set to be removed
'Now we must got through the balls again and find the ones that are to stay.

'We will need a couple of BoundingSphere
Dim TempBoundingSphereOtherBall As BoundingSphere
Dim TempBoundingSphereOtherBall1 As BoundingSphere

'First we go through the ballsarray and get all the balls that are on the top row, once found
'we will set their MarkedForDeletionDrop marker to False. We will then compare all other balls to these top row
'balls and for those that intersect with the top row balls, they will have their marker set to False.

For Each TempBall As Ball In BallArray
'Only those balls that are on the top row
If TempBall.BallRect.Y <= PlayAreaRect.Y Then
If TempBall.MarkedForDeletionDrop = True Then 'Only those balls that have their Drop marker set to False
'Set the first bounding Sphere to the first ball
TempBoundingSphereOtherBall = New BoundingSphere(New Vector3(TempBall.BallRect.X, TempBall.BallRect.Y, 0), 22)
'Set the first Balls Drop marker to False, because this ball is touching the top of the play area
TempBall.MarkedForDeletionDrop = False
'Now we will compare with each other ball
For Each TempBall1 As Ball In BallArray
If TempBall1.IsInLauncher = False Then ' Not the balls that are in the ball launcher
If TempBall1.MarkedForDeletionDrop = True Then 'not the balls that have their drop marker set to false
'Set up the second bounding sphere

TempBoundingSphereOtherBall1 = New BoundingSphere(New Vector3(TempBall1.BallRect.X, TempBall1.BallRect.Y, 0), 22)
'Test to see if they intersect
If TempBoundingSphereOtherBall.Intersects(TempBoundingSphereOtherBall1) = True Then
'If they do then set the second balls drop marker
TempBall1.MarkedForDeletionDrop = False
End If
End If
End If
Next
End If
End If
Next

Dim LoopAgain As Integer = 0
Dim UBoundBallArrayDividedBy5 As Single = UBound(BallArray) / 5 ' The following loop will be repeated, The more
'balls there are in the game the more times this loop will repeat

LoopAgain:

'For each ball inn the arrya
For Each TempBall As Ball In BallArray
If TempBall.IsInLauncher = False Then 'Only those balls that are not in the launcher
If TempBall.MarkedForDeletionDrop = False Then ' Only those balls that have their drop marker set to false
'Setup the first bounding sphere
TempBoundingSphereOtherBall = New BoundingSphere(New Vector3(TempBall.BallRect.X, TempBall.BallRect.Y, 0), 22)
'Now we will compare with each other ball
For Each TempBall1 As Ball In BallArray
If TempBall1.IsInLauncher = False Then ' Not the balls that are in the ball launcher
If TempBall1.MarkedForDeletionDrop = True Then 'only those balls that have their drop marker set to true
'Set up the second bounding sphere

TempBoundingSphereOtherBall1 = New BoundingSphere(New Vector3(TempBall1.BallRect.X, TempBall1.BallRect.Y, 0), 22)
'Check to see if they intersect
If TempBoundingSphereOtherBall.Intersects(TempBoundingSphereOtherBall1) = True Then
'If they do intersect then set the second balls Drop marker to False
TempBall1.MarkedForDeletionDrop = False
End If
End If
End If
Next
End If
End If
Next

'Basically, the first loop will set all balls' drop marker to True
'The second loop will set the balls' drop marker to false if they are touching the top of the play area
'The third loop then finds those balls that touch another ball whose drop marker is False, once found the first ball
'will have its drop marker to False and the loop repeats. Basically when the loops are done, the balls that are not
'connected to the top of the play area, by themselves or via other balls then they have their drop marker set to True

'Loop again to get all balls
If LoopAgain < CInt(UBoundBallArrayDividedBy5) Then
LoopAgain += 1
GoTo LoopAgain
End If

'Erase variable
TempBoundingSphereOtherBall = Nothing
TempBoundingSphereOtherBall1 = Nothing

End Sub

 

I have tried to explain what this sub does as i wrote it, but in case it wasn't clear, I will try again. First, all balls that aren't in the ball launcher have their MarkedForDeletionDrop marker set to True. In the next loop all balls that touch the top of the playarea have their MarkedForDeletionDrop marker set to False and all other balls are compared to them, if they intersect then the other balls have their MarkedForDeletionDrop marker set to False. In the last loop, all balls are compared to each individual ball and if either has their MarkedForDeletionDrop = False and they intersect then the other ball has its MarkedForDeletionDrop set to False. After the loops have finished then any ball that does not have a path to the top of the playarea will still have its MarkedForDeletionDrop marker set to True and hence will be Dropped. Next we have the sub that will drop the balls:

'Drop Balls
Public Sub DropBalls()
'For each ball in the BallsArray
For Each TempBall As Ball In BallArray
'If the balls have their deletion marker set then
If TempBall.IsDeleted = False Then
'if the ball is not in the ball launcher
If TempBall.IsInLauncher = False Then
'If the Balls MarkedForDeletionDrop marker has been set
If TempBall.MarkedForDeletionDrop = True Then
TempBall.IsDropped = True 'Variable to exclude ball from Collision Sub
'We will temporarily change a dropped balls Text, so that we can distinguish between a dropped
'Ball and a Deleted ball. eventually both will have their own deletion method.
'Deleted balls will explode and Dropped balls will fall out the bottom of the screen

TempBall.BallTex = Texture2D.FromFile(Device, "../../images/38x38AlphaChannelOnlyRedBorder.png", NonBallTexCreationParams)
End If
End If
End If
Next
'Stop the RemoveBalls Sub running again
BallsNeedRemoved = False
End Sub

 

This Sub goes through the ballarray searching for balls that have their MarkedForDeletionDrop = False, just now i have changed their texture so that we can tell the difference between those balls that have been deleted and those balls that have been dropped, but in the next tutorial we will work on the system of making these balls fall out of the game properly.

In the Ball Class, there are a couple of changes, first to the MoveBall Sub:

Public Sub MoveBall()

'move ball in direction of arrow
Dim Vector1 As Vector2 = New Vector2

'Holds the direction of the arrow and hence the trajectory of the ball
Vector1 = New Vector2(BallVectorXPub, BallVectorYPub)

'Selects whether the arrow is pointing left, right or straight up
' TempSBRotate is given the value of ArrowSBrotate only when a ball has been launched into the game

Select Case MathHelper.ToDegrees(TempSBRotate)
Case Is < -0.1 ' Arrow points Left
' if ball is lower than the top of the Playarea
If BallRect.Y > PlayAreaRect.Y Then
BallRect.Y -= (Vector1.X * (BallXVel + 0.005)) 'ball moves left along vector1 at speed BallXVel + 0.005
BallRect.X -= (Vector1.Y * BallYVel) ' ball moves up along vector1 at speed BallYVel
End If
Case -0.09 To 0.09 ' Arrow points Up
BallRect.Y -= (Vector1.Y * (BallXVel + 0.2)) ' ball moves straight up at speed BallYVel
Case Is > 0.1 ' Arrow points right
BallRect.Y -= (Vector1.Y * BallXVel) ' ball moves up along vector1 at speed BallXVel
BallRect.X -= -(Vector1.X * BallYVel) ' ball moves right along vector1 at speed BallYVel
End Select

' The following code keeps the ball inside the Playarea
If BallRect.Y < (PlayAreaRect.Y + 2) Then ' if ball moves above top of playarea then
BallXVel = 0 ' Stop ball in X direction
BallYVel = 0 ' Stop ball in Y direction
BallRect.Y = PlayAreaRect.Y 'bring ball back into playarea if it had moved out of Playarea
IsMoving = False ' set Ismoving to false
IndexOfMovingBallFound = False ' Sets condition so that ball collision can be detected
ABallHasBeenLaunched = False 'Prevents another ball being launched if one is already moving.
End If
If BallRect.X < PlayAreaRect.X Then ' if ball moves passed left of playarea then
BallYVel = -(BallYVel) ' Change x direction of ball from left to right
End If
If BallRect.X > (PlayAreaRect.X + PlayAreaRect.Width) - 38 Then ' if ball moves passed right of playarea then
BallYVel = -(BallYVel) ' Change x direction of ball from right to left
End If

End Sub

This new code is part of the bug fix that i mentioned earlier, next we have a new declaration for the Ball Class:


Public IsDropped As Boolean = False ' IF set to true then this ball will not be drawn

 

Lastly, the Render Sub has had a couple of additions:

Private Sub Render()

'Clear the backbuffer to a blue color
Device.Clear(ClearOptions.Target, Microsoft.Xna.Framework.Graphics.Color.Blue, 1.0F, 0)

'Draw all Non Ball Textures
MainSB.Begin(SpriteBlendMode.AlphaBlend)
'Draw Ball
If UBound(BallArray) > 0 Then
For Each SingleBall As Ball In BallArray ' Check every ball in array
If SingleBall.IsDeleted = False Then
MainSB.Draw(SingleBall.BallTex, SingleBall.BallRect, Color.White) 'Draw Each Ball
End If
If SingleBall.IsMoving = True Then 'If a ball is set to move
SingleBall.MoveBall() 'Move the ball
End If
If BallLauncherRect7IsEmpty = True Then ' BallLauncherRect7IsEmpty is Set to True when a ball is launched
SingleBall.MoveBallLauncherBalls() ' Move the balls in the ball launcher
End If
Next
If ABallHasBeenLaunched = True Then ' A global variable used to tell the program when to start checking for
If UBound(BallArray) > 1 Then ' collisions
CheckForCollision() ' Check for a collision
End If
End If

'If a Ball needs to be positioned correctly
If ABallNeedsPositionedCorrectly = True Then
If UBound(BallArray) > 1 Then
'Correctly Position Ball
PositionBallCorrectly()
End If
End If

'Check for 3 touching Balls
If ShouldWeCheckFor3TouchingBalls = True Then
If CheckFor3TouchingBalls() = True Then
FindTheBallsToRemove()
End If
End If

'If BallsNeedRemoved = True then Run the RemoveBalls Sub
If BallsNeedRemoved = True Then
RemoveBalls() ' Find those balls that have MarkedForDeletionExplode = Falsle, then set IsDeleted = True
RedimBallArray() ' Remove those Balls that have IsDeleted = True from the Array
FindBallsToDrop() ' Find which Balls should fall out the game, as they are no longer connected to the top of the playarea
DropBalls() ' Find those balls that have MarkedForDeletionDrop set to True and then drop them

End If

End If

MainSB.Draw(BackgroundTex, BackgroundRect, Color.White)
MainSB.Draw(PlayAreaTex, PlayAreaRect, Color.White)
MainSB.Draw(BallLauncherTex, BallLauncherRect, Color.White)

'Draw Arrow - Arrow is drawn after ball so that it appears on top of ball.
'Anything drawn last will appear above anything drawn before

MainSB.Draw(ArrowTex, New Vector2(405, 485), Nothing, Color.White, ArrowSBRotate, _
New Vector2((ArrowTex.Width / 2), (ArrowTex.Height / 2)), 1.0F, SpriteEffects.None, 0.0F)
MainSB.End()

'Display the Scene to the Screen
Device.Present()

End Sub

The new code is run after a collision and when some balls have been deleted. Now if you run the game it should act like this:

XNA In VB.NET - Ball About to be Dropped

and once the black balls collide

XNA In VB.NET - Ball Have Been Dropped

As you can see the black balls have disappeared and the balls below them have had their texture changed, just as we designed them to. In the next tutorial we will create the particle system, that allows deleted balls to explode and dropped balls to fall out of the game. So once I have completed the tutorial, I will upload it to the tutorials page . Until then, enjoy.

 

DropBalls Source Code - 201Kb
Next Tutorial - The Particle System

 

     
 
 
     

 

Web site contents © Copyright Alan Phipps 2006, All rights reserved.
Website templates
   
 
 

 

__PayPal

PayPal - Any Amount is Welcome
 
Please Donate to the Nvidia Geforce Go 7950 GTX Fund, All donations welcome. Thanks.

 

XNA in C#

 
 

 

Games at Amazon