.: Deleting a Ball After a Collision

'Used to decide if we should check for 3 touching balls
'Set in PositionBallCorrectly
Public ShouldWeCheckFor3TouchingBalls As Boolean = False

'If set to true the Remove balls Sub will Run, Set in FindTheBallsToRemove()
Public BallsNeedRemoved As Boolean = False

'When the ball launcher balls are launched into the game, a new ball is created outside the playarea
'This variable stops 21 balls being created on each render loop
'This variable is set in the Ball Class's MoveBallLaucnherBalls Sub
Public ANewBallIsNeeded As Boolean = False

The PositionBallCorrectly Sub has a new line of code as shown below:

'Move Ball into Correct Position
Public Sub PositionBallCorrectly()

'A Couple of Bounding Spheres to hold the 2 balls that have collided
Dim TempBoundingSphereMovingBall As BoundingSphere = New BoundingSphere(New Vector3(BallArray(IndexOfMovingBall).BallRect.X, _
BallArray(IndexOfMovingBall).BallRect.Y, 0), 19)
Dim TempBoundingSphereOtherBall As BoundingSphere = BoundingSphereOtherBallPub

'If these 2 balls have overlapped
If TempBoundingSphereMovingBall.Intersects(TempBoundingSphereOtherBall) = True Then

'If they overlap on each other's side
If TempBoundingSphereMovingBall.Center.Y < TempBoundingSphereOtherBall.Center.Y + 19 Then
'If the collision happened on the left of the other ball
If TempBoundingSphereMovingBall.Center.X < TempBoundingSphereOtherBall.Center.X Then
BallArray(IndexOfMovingBall).BallRect.X -= 1
TempBoundingSphereMovingBall = Nothing
TempBoundingSphereOtherBall = Nothing
Exit Sub
'If the collision happened on the right of the other ball
ElseIf TempBoundingSphereMovingBall.Center.X > TempBoundingSphereOtherBall.Center.X Then
BallArray(IndexOfMovingBall).BallRect.X += 1
TempBoundingSphereMovingBall = Nothing
TempBoundingSphereOtherBall = Nothing
Exit Sub
End If
End If

'If they overlap on the bottom then move down by one pixel
BallArray(IndexOfMovingBall).BallRect.Y += 1
'Ball Does not stop moving
TempBoundingSphereMovingBall = Nothing
TempBoundingSphereOtherBall = Nothing
Exit Sub

End If

'Dispose the variables
TempBoundingSphereMovingBall = Nothing
TempBoundingSphereOtherBall = Nothing
ABAllNeedsPositionedCorrectly = False
ShouldWeCheckFor3TouchingBalls = True

End Sub

This new code is shown in RED and tells the render loop to run the first new sub which is called CheckFor3TouchingBalls() and is used to determine if 3 balls of the same colour are touching:

'Check to See if 3 Balls Of the Same Colour are touching
Public Function CheckFor3TouchingBalls()

'This variable, if True, will tell the function call whether to run the remove balls sub
Dim FunctionResult As Boolean = False
'A couple of variables used to determine if balls need to be removed
Dim NumOfTouchingBalls As Integer = 0
Dim TempBallColour As String = BallArray(IndexOfMovingBall).BallColour
Dim NextBallBoundingSphere As BoundingSphere

'A Couple of Bounding Spheres to hold the 2 balls that have collided
Dim TempBoundingSphereMovingBall As BoundingSphere = New BoundingSphere(New Vector3(BallArray(IndexOfMovingBall).BallRect.X, _
BallArray(IndexOfMovingBall).BallRect.Y, 0), 22)
Dim TempBoundingSphereOtherBall As BoundingSphere

'Test each ball in the ball array to see if it intersects the moving ball
For Each TempBall As Ball In BallArray
'If it has already been deleted then ignore the ball
If TempBall.IsDeleted = False Then
'If the ball is in the ball launcher then ignore the ball
If TempBall.IsInLauncher = False Then
'Set the Boundingsphere to the other ball
TempBoundingSphereOtherBall = New BoundingSphere(New Vector3(TempBall.BallRect.X, TempBall.BallRect.Y, 0), 22)
'If the other ball is the movingball then move onto the next ball
If TempBoundingSphereOtherBall <> TempBoundingSphereMovingBall Then
'If these 2 balls have overlapped
If TempBoundingSphereMovingBall.Intersects(TempBoundingSphereOtherBall) = True Then
'If the other ball is the same colour as the moving ball
If TempBall.BallColour = TempBallColour Then
'hold the other balls bounding sphere for the next loop
NextBallBoundingSphere = TempBoundingSphereOtherBall
'Increment the number of touching balls
NumOfTouchingBalls += 1
End If
End If
'We only need to know if 3 balls are touching, so if NumOfTouchingBalls is more than 2 then set the
'function result to True and goto the EndOfFunction
If NumOfTouchingBalls > 2 Then
FunctionResult = True
GoTo EndOfFunction
Else
FunctionResult = False
End If
End If
End If
End If
Next

'For each ball in the array we will check for other balls that intersect with the previous other ball
For Each TempBall1 As Ball In BallArray
'If it has already been deleted then ignore the ball
If TempBall1.IsDeleted = False Then
'If the ball is in the ball launcher then ignore the ball
If TempBall1.IsInLauncher = False Then
'A Bounding Sphere for the Other ball in the collision
TempBoundingSphereOtherBall = New BoundingSphere(New Vector3(TempBall1.BallRect.X, TempBall1.BallRect.Y, 0), 22)
'Again if the other ball is the moving ball then move on to th enext ball
If TempBoundingSphereOtherBall <> TempBoundingSphereMovingBall Then
'If these 2 balls have overlapped
If NextBallBoundingSphere.Intersects(TempBoundingSphereOtherBall) = True Then
'and if both balls are the same colour
If TempBall1.BallColour = TempBallColour Then
'increment th enumber of touching balls
NumOfTouchingBalls += 1
End If
End If

'We only need to know if 3 balls are touching, so if NumOfTouchingBalls is more than 2 then set the
'function result to True and goto the EndOfFunction
If NumOfTouchingBalls > 2 Then
FunctionResult = True
GoTo EndOfFunction
Else
FunctionResult = False
End If
End If
End If
End If
Next

EndOfFunction:

'Clear the variables, set the ShouldWeCheckFor3TouchingBalls Boolean to false, ( so that the sub does not
'run again)and return the FunctionResult
ShouldWeCheckFor3TouchingBalls = False
NumOfTouchingBalls = Nothing
TempBallColour = Nothing
NextBallBoundingSphere = Nothing
TempBoundingSphereMovingBall = Nothing
TempBoundingSphereOtherBall = Nothing

'Return the result, either True or False
Return FunctionResult

End Function

This sub checks all the balls that intersect the moving ball and if they are the same colour as the moving ball it increments the variable NumOfTouchingBalls, at the end of the function if the NumOfTouchingBalls is bigger than 2 and hence 3 balls of the same colour are touching then the function returns True, else the function returns False. In the render loop if the function returns True then the following Sub is run:

'Find the Balls that are to be removed
Public Sub FindTheBallsToRemove()
'A variable for the ball colour
Dim TempBallColour As String = BallArray(IndexOfMovingBall).BallColour
'An Array to hold all the balls of the same colour
Dim BallsOfTheSameColour() As Ball = New Ball() {}

'If this sub is running then 3 balls of the same colour have touched and will definitely be removed
'One of these balls will be the moving ball so we can set its deletion flag now
BallArray(IndexOfMovingBall).MarkedForDeletionExplode = True
'If a ball has had its deletion marker set then set the global variable BallsNeedRemoved to True
'So that in the render loop the RemoveBalls sub will run
BallsNeedRemoved = True

'For each ball in the ball array
For Each TempBall As Ball In BallArray
'If it has already been deleted then ignore the ball
If TempBall.IsDeleted = False Then
'If the ball is in the ball launcher then ignore the ball
If TempBall.IsInLauncher = False Then
'If the ball is in the ball launcher then move on to the next ball
If TempBall.IsInLauncher = False Then
'If the current ball is the same colour as the moving ball
If TempBall.BallColour = TempBallColour Then
'Increase the size of the BallsOftheSameColourArray
ReDim Preserve BallsOfTheSameColour(UBound(BallsOfTheSameColour) + 1)
'And insert the current ball
BallsOfTheSameColour(UBound(BallsOfTheSameColour)) = TempBall
End If
End If
End If
End If
Next

'and a couple of bounding spheres for the other balls
Dim TempBoundingSphereOtherBall As BoundingSphere
Dim TempBoundingSphereOtherBall1 As BoundingSphere

'We will now loop through the ballsofthesamecolour array and compare them to every other ball in the array
'If a ball touches another ball that has its deletion marker set then the first ball will have it's deletion marker
'set. When the RemoveBalls sub runs, any ball with its deletion marker set will be deleted
Dim LoopAgainToGetAllBalls As Integer = 0
'This sub loops twice
LoopAgain:
For Each TempBall1 As Ball In BallsOfTheSameColour
'If the ball is in the ball launcher then ignore the ball
If TempBall1.IsInLauncher = False Then
'Set the bounding sphere
TempBoundingSphereOtherBall = New BoundingSphere(New Vector3(TempBall1.BallRect.X, TempBall1.BallRect.Y, 0), 22)
'For each ball in the array
For Each TempBall2 As Ball In BallsOfTheSameColour
'If the ball is in the ball launcher then ignore the ball
If TempBall2.IsInLauncher = False Then
'Set it to the bounding sphere
TempBoundingSphereOtherBall1 = New BoundingSphere(New Vector3(TempBall2.BallRect.X, TempBall2.BallRect.Y, 0), 22)
'if the other ball has its deletion marker set then move on to the next ball
If TempBall1.MarkedForDeletionExplode = True Then
'Do the balls intersect
If TempBoundingSphereOtherBall1.Intersects(TempBoundingSphereOtherBall) = True Then
'If they do then set the other balls deletion marker
TempBall2.MarkedForDeletionExplode = True
End If
End If
End If
Next
End If
Next
'Increment the Loopnumber
LoopAgainToGetAllBalls += 1
'and loop a second time
If LoopAgainToGetAllBalls = 1 Then
GoTo LoopAgain
End If

'Clear the variables and erase the array
TempBallColour = Nothing
Erase BallsOfTheSameColour
TempBoundingSphereOtherBall = Nothing
TempBoundingSphereOtherBall1 = Nothing
LoopAgainToGetAllBalls = Nothing

End Sub

This sub loops through the Balls Array and finds all the balls of the same colour as the moving ball. These balls are then added to another array called BallsOfTheSameColour. Next, every ball in this array is compared to every other ball in the array and if the first ball has its deletion marker set and another ball intersects it, then the other ball has it's deletion maker set. The loop is run twice because after the first loop a ball may have its deletion maker set after its comparison, so the loop is run again to ensure that all touching balls are found.

Lastly we have the RemoveBalls Sub, which simply loops through the BallsArray and if any balls have their deletion marker set then that balls ISDeleted variable is set to true. There are 2 deletion markers, one for explode and one for drop, this tutorial uses explode, we will us the drop marker in a later tutorial:

'Remove Balls
Public Sub RemoveBalls()
'For each ball in the BallsArray
For Each TempBall As Ball In BallArray
'If the balls have their deletion arker set then
If TempBall.IsDeleted = False Then
'if the ball is not in the ball launcher
If TempBall.IsInLauncher = False Then
'If the balls deletion maker (Explode) is set - another type of deletion marker will be used in
'in a future tutorial
If TempBall.MarkedForDeletionExplode = True Then
'Set the balls deletion marker
TempBall.IsDeleted = True
End If
End If
End If
Next
'Stop the RemoveBalls Sub running again
BallsNeedRemoved = False
End Sub

That's all for the GraphicsModule, next we will move onto the Ball Class where a couple of new variables are declared and a change to the MoveBallLauncherBalls sub is implemented:

Public MarkedForDeletionExplode As Boolean = False ' used to decide which balls are to be removed
Public MarkedForDeletionDrop As Boolean = False ' used to decide which balls are to be removed
Public BallColour As String = "Blue" ' The colour of the ball to be used by the RemoveBall Sub
Public IsInLauncher As Boolean = True 'Balls in the ball launcher are not included in any most subs
Public IsDeleted As Boolean = False ' IF set to true then this ball will not be drawn

These variables are used to determine which balls will be acted upon in the various new subs. Next, we have the change in the MoveBallLaunhcerBalls Sub:

Public Sub MoveBallLauncherBalls()
'Move Ball Launcher Balls
If IndexOfBallLauncherBallsFound = False Then ' this If statement stops the idexes being overwritten before they are used
For m As UShort = 0 To UBound(BallArray)
If BallArray(m).BallRect = BallLauncherRect1 Then
IndexOfBallInBallLauncherRect1 = m
End If
If BallArray(m).BallRect = BallLauncherRect2 Then
IndexOfBallInBallLauncherRect2 = m
End If
If BallArray(m).BallRect = BallLauncherRect3 Then
IndexOfBallInBallLauncherRect3 = m
End If
If BallArray(m).BallRect = BallLauncherRect4 Then
IndexOfBallInBallLauncherRect4 = m
End If
If BallArray(m).BallRect = BallLauncherRect5 Then
IndexOfBallInBallLauncherRect5 = m
End If
If BallArray(m).BallRect = BallLauncherRect6 Then
IndexOfBallInBallLauncherRect6 = m
End If
If BallArray(m).BallRect = BallLauncherRect7 Then
IndexOfBallInBallLauncherRect7 = m
End If
Next
IndexOfBallLauncherBallsFound = True
End If

'Move the balls in the previous rectangle forward to take position in the next one
If BallArray(IndexOfBallInBallLauncherRect6).BallRect.X < BallLauncherRect7.X Then
BallArray(IndexOfBallInBallLauncherRect6).BallRect.X += 1
End If
If BallArray(IndexOfBallInBallLauncherRect6).BallRect.X = BallLauncherRect7.X AndAlso _
BallArray(IndexOfBallInBallLauncherRect6).BallRect.Y > BallLauncherRect7.Y Then
BallArray(IndexOfBallInBallLauncherRect6).BallRect.Y -= 1
End If
If BallArray(IndexOfBallInBallLauncherRect5).BallRect.X < BallLauncherRect6.X Then
BallArray(IndexOfBallInBallLauncherRect5).BallRect.X += 1
End If
If BallArray(IndexOfBallInBallLauncherRect4).BallRect.X < BallLauncherRect5.X Then
BallArray(IndexOfBallInBallLauncherRect4).BallRect.X += 1
End If
If BallArray(IndexOfBallInBallLauncherRect3).BallRect.X < BallLauncherRect4.X Then
BallArray(IndexOfBallInBallLauncherRect3).BallRect.X += 1
End If
If BallArray(IndexOfBallInBallLauncherRect2).BallRect.X < BallLauncherRect3.X Then
BallArray(IndexOfBallInBallLauncherRect2).BallRect.X += 1
End If
If BallArray(IndexOfBallInBallLauncherRect1).BallRect.X < BallLauncherRect2.X Then
BallArray(IndexOfBallInBallLauncherRect1).BallRect.X += 1
End If
If BallArray(IndexOfBallInBallLauncherRect1).BallRect.X = BallLauncherRect2.X Then
'A new ball needs to be created
If ANewBallIsNeeded = True Then
CreateBall(GetRandomColour(), BallLauncherRect1.X, BallLauncherRect1.Y)
End If
'Only one ball is needed so we will set the boolean to false, without this switch 21 balls would be created
'During every Render loop
ANewBallIsNeeded = False
End If

'When the balls have moved forward set the conditional variables to false so that the
'operation does not run again
If BallArray(IndexOfBallInBallLauncherRect6).BallRect.Y = BallLauncherRect7.Y Then
IndexOfBallLauncherBallsFound = False
BallLauncherRect7IsEmpty = False
End If

End Sub

Before the new code was added, 21 balls were created in every render loop, this made our balls array so big that it slowed down our game. With the new code in place only one balls is created and the game is more efficient. As with all programs there will be bugs and mistakes, as the game develops we will hopefully find and fix them all. Now, the last code changes are in the Form1 code, specifically in the Render function and the KeyDown Sub:

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()
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, shown in RED implements the 3 new subs in the GraphicsModule, as previously stated, they check for, find and remove the appropriate balls when 3 of the same colour collide. The new code in the KeyDown Sub

Private Sub Form1_KeyDown(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles Me.KeyDown

Select Case e.KeyCode
Case Is = Windows.Forms.Keys.Escape
Application.Exit()
Exit Sub
Case Is = Windows.Forms.Keys.Right
If ArrowSBRotate >= MathHelper.ToRadians(85) Then
ArrowSBRotate = MathHelper.ToRadians(85)
Exit Sub
End If
ArrowSBRotate = ArrowSBRotate + MathHelper.ToRadians(2)
Case Is = Windows.Forms.Keys.Left
If ArrowSBRotate <= MathHelper.ToRadians(-85) Then
ArrowSBRotate = MathHelper.ToRadians(-85)
Exit Sub
End If
ArrowSBRotate = ArrowSBRotate - MathHelper.ToRadians(2)
Case Is = Windows.Forms.Keys.Space
If ABallHasBeenLaunched = False Then ' If a ball is not already moving
ABallHasBeenLaunched = True
For Each SingleBall As Ball In BallArray ' Check every ball in the array
If SingleBall.IsDeleted = False Then
If SingleBall.BallRect = BallLauncherRect7 Then ' If ball is in the launch position
If SingleBall.IsMoving = False Then
GetBallVectorFromArrow() ' Get direction of arrow
End If
BallLauncherRect7IsEmpty = True
ANewBallIsNeeded = True
SingleBall.IsMoving = True
SingleBall.IsInLauncher = False
Exit For ' because only one ball will be in the launch position we can safely exit the
'for loop after we have found it
End If
End If
Next
End If
End Select

End Sub

The new code here simply stops erratic movement of the moving ball at certin points in the game. Now if you compile the code you should get something that acts like this:

and after collision

As you can see the 3 Red balls disappear leaving the rest, in later tutorials we will develop a particle system that shows the balls exploding rather than just disappearing. However, in the next tutorial we will be working on making any balls that were connected to the balls that disappeared but not connected to the top of the playarea drop out the bottom of the screen as if they were hanging there. Once i have completed it, I will upload it to the tutorials page. So, until then, enjoy.

__PayPal

XNA in C#

Games at Amazon