XNA 4.0 Game Development by Example: Beginner's Guide - Visual Basic Edition: Create your own exciting games with Visual Basic and Microsoft XNA 4.0

Private playingPieces As Texture2D
Private background As Texture2D
Private titleScreen As Texture2D

playingPieces = Content.Load(Of Texture2D)("Textures\Tile_Sheet")
background = Content.Load(Of Texture2D)("Textures\Background")
titleScreen = Content.Load(Of Texture2D)("Textures\TitleScreen")

Public Shared PieceTypes() As String = { 
    "Left,Right", 
    "Top,Bottom", 
    "Left,Top", 
    "Top,Right",
    "Right,Bottom", 
    "Bottom,Left",
    "Empty"
  }

  Public Const PieceHeight As Integer = 40
  Public Const PieceWidth As Integer = 40

  Public Const MaxPlayablePieceIndex As Integer = 5
  Public Const EmptyPieceIndex As Integer = 6

  Private Const textureOffsetX As Integer = 1
  Private Const textureOffsetY As Integer = 1
  Private Const texturePaddingX As Integer = 1
  Private Const texturePaddingY As Integer = 1

  Private _pieceType As String = ""
  Private _pieceSuffix As String = ""

Public Sub New(type As String, suffix As String)
  _pieceType = type
  _pieceSuffix = suffix
End Sub

Public Sub New(type As String)
  _pieceType = type
  _pieceSuffix = ""
End Sub

Public Sub SetPiece(type As String, suffix As String)
  _pieceType = type
  _pieceSuffix = suffix
End Sub

Public Sub SetPiece(type As String)
  SetPiece(type, "")
End Sub

Public Sub AddSuffix(suffix As String)
  If Not _pieceSuffix.Contains(suffix) Then
    _pieceSuffix &= suffix
  End If
End Sub

Public Sub RemoveSufix(suffix As String)
  _pieceSuffix = _pieceSuffix.Replace(suffix, "")
End Sub

Public Sub RotatePiece(clockwise As Boolean)
  Select Case _pieceType
    Case "Left,Right"
      _pieceType = "Top,Bottom"
    Case "Top,Bottom"
      _pieceType = "Left,Right"
    Case "Left,Top"
      If (clockwise) Then
        _pieceType = "Top,Right"
      Else
        _pieceType = "Bottom,Left"
      End If
    Case "Top,Right"
      If (clockwise) Then
        _pieceType = "Right,Bottom"
      Else
        _pieceType = "Left,Top"
      End If
    Case "Right,Bottom"
      If (clockwise) Then
        _pieceType = "Bottom,Left"
      Else
        _pieceType = "Top,Right"
      End If
    Case "Bottom,Left"
      If clockwise Then
        _pieceType = "Left,Top"
      Else
        _pieceType = "Right,Bottom"
      End If
  End Select
End Sub

Public Function GetOtherEnds(startingEnd As String) As String()
  Dim Opposites As List(Of String) = New List(Of String)()

    For Each pipeEnd As String In _pieceType.Split(CChar(","))
      If pipeEnd <> startingEnd Then
        Opposites.Add(pipeEnd)
      End If
    Next

  Return Opposites.ToArray()
End Function

Public Function HasConnector(direction As String) As Boolean
  Return _pieceType.Contains(direction)
End Function

Public Function GetSourceRectangle() As Rectangle
  Dim x As Integer = textureOffsetX
  Dim y As Integer = textureOffsetY

  If _pieceSuffix.Contains("W") Then
    x += PieceWidth + texturePaddingX
  End If

  y += (Array.IndexOf(PieceTypes, _pieceType) *(PieceHeight + texturePaddingY))

  Return New Rectangle(x, y, PieceWidth, PieceHeight)
End Function

Private rand As New Random()

Public Const GameBoardWidth As Integer = 7
Public Const GameBoardHeight As Integer = 9

Private playingPieces As Texture2D
Private emptyPiece As Rectangle

Private boardSquares(GameBoardWidth, GameBoardHeight) As GamePiece

Private waterTracker As New List(Of Vector2)()

Public Sub New(pieceTexture As Texture2D, emptyArea As Rectangle)
  playingPieces = pieceTexture
  emptyPiece = emptyArea
  ClearBoard()
End Sub

Public Sub ClearBoard()
  Dim x, y As Integer
  For x = 0 To GameBoardWidth
    For y = 0 To GameBoardHeight
      boardSquares(x, y) = New GamePiece("Empty")
    Next
  Next
End Sub

Public Sub RotatePiece(x As Integer, y As Integer,
  clockwise As Boolean)
  boardSquares(x, y).RotatePiece(clockwise)
End Sub

Public Function GetSourceRect(
  x As Integer, y As Integer) As Rectangle
  Return boardSquares(x, y).GetSourceRectangle()
End Function

Public Function GetSquare(x As Integer, y As Integer) As String
  Return boardSquares(x, y).PieceType
End Function

Public Sub SetSquare(x As Integer, y As Integer, pieceType As String)
  boardSquares(x, y).SetPiece(pieceType)
End Sub

Public Function HasConnector(x As Integer, y As Integer, direction As String) As Boolean
  Return boardSquares(x, y).HasConnector(direction)
End Function

Public Sub RandomPiece(x As Integer, y As Integer)
  boardSquares(x, y).SetPiece(GamePiece.PieceTypes(
    rand.Next(0, GamePiece.MaxPlayablePieceIndex + 1)))
End Sub

Public Sub FillFromAbove(x As Integer, y As Integer)
  Dim rowLookup As Integer = y - 1

  Do While (rowLookup >= 0)
    If GetSquare(x, rowLookup) <> "Empty" Then
      SetSquare(x, y, GetSquare(x, rowLookup))
      SetSquare(x, rowLookup, "Empty")
      rowLookup = -1
    End If
    rowLookup -= 1
  Loop
End Sub

Public Sub GenerateNewPieces(dropSquare As Boolean)
  Dim x, y As Integer

  If dropSquare Then
    For x = 0 To GameBoardWidth
      For y = GameBoardHeight To 0 Step -1
        If GetSquare(x, y) = "Empty" Then
          FillFromAbove(x, y)
        End If
      Next
    Next
  End If

  For y = 0 To GameBoardHeight
    For x = 0 To GameBoardWidth
      If GetSquare(x, y) = "Empty" Then
        RandomPiece(x, y)
      End If
    Next
  Next

End Sub

Public Sub ResetWater()
  Dim x, y As Integer
  For x = 0 To GameBoardWidth
    For y = 0 To GameBoardHeight
      boardSquares(x, y).RemoveSufix("W")
    Next
  Next
End Sub

Public Sub FillPiece(x As Integer, y As Integer)
  boardSquares(x, y).AddSuffix("W")
End Sub

Public Sub PropagateWater(x As Integer, y As Integer, fromDirection As String)

  If (y >= 0) And (y <= GameBoardHeight) And
    (x >= 0) And (x <= GameBoardWidth) Then
    If boardSquares(x, y).HasConnector(fromDirection) And
      Not (boardSquares(x, y).PieceSuffix.Contains("W")) Then
      FillPiece(x, y)
      waterTracker.Add(New Vector2(x, y))
      For Each pipeEnd As String In 
        boardSquares(x, y).GetOtherEnds(fromDirection)
        Select Case pipeEnd
          Case "Left"
            PropagateWater(x - 1, y, "Right")
          Case "Right"
            PropagateWater(x + 1, y, "Left")
          Case "Top"
            PropagateWater(x, y - 1, "Bottom")
          Case "Bottom"
            PropagateWater(x, y + 1, "Top")
        End Select
      Next
    End If
  End If
End Sub

Public Function GetWaterChain(y As Integer...

Private _gameBoard As GameBoard
Private gameBoardDisplayOrigin As New Vector2(70, 89)
Private playerScore As Integer = 0

Private Enum GameStates
  TitleScreen
  Playing
End Enum

Private gameState As GameStates = GameStates.TitleScreen

Private EmptyPiece As Rectangle = New Rectangle(1, 247, 40, 40)

Private Const MinTimeSinceLastInput As Single = 0.25
Private timeSinceLastInput As Single = 0

Me.IsMouseVisible = True
Me.graphics.PreferredBackBufferWidth = 800
Me.graphics.PreferredBackBufferHeight = 600
graphics.ApplyChanges()

_gameBoard = New GameBoard(playingPieces, EmptyPiece)

If gameState = GameStates.TitleScreen Then
  spriteBatch.Begin()
  spriteBatch.Draw(titleScreen,New Rectangle(0, 0,Me.Window.ClientBounds.Width,Me.Window.ClientBounds.Height),
    Color.White)
  spriteBatch.End()
End If

Public Sub Draw(
  spriteBatch As SpriteBatch,
  DisplayOrigin As Vector2)

  Dim x As Integer, y As Integer

  For x = 0 To GameBoardWidth
    For y = 0 To GameBoardHeight
      Dim pixelX As Integer = CInt(DisplayOrigin.X + (x * GamePiece.PieceWidth))
      Dim pixelY As Integer = CInt(DisplayOrigin.Y + (y * GamePiece.PieceHeight))

      spriteBatch.Draw(
        playingPieces,New Rectangle(
          pixelX,pixelY,GamePiece.PieceWidth,GamePiece.PieceHeight),EmptyPiece,Color.White)

      spriteBatch.Draw(
        playingPieces,New Rectangle(
          pixelX,pixelY,GamePiece.PieceWidth,GamePiece.PieceHeight),GetSourceRect(x, y),Color.White)
    Next
  Next
End Sub

If gameState = GameStates.Playing...

Private Function DetermineScore(squareCount As Integer) As Integer
  Return CInt(
    ((Math.Pow((squareCount / 5), 2) + squareCount) * 10))
End Function

Private Sub CheckScoringChain(WaterChain As List(Of Vector2))
  If (WaterChain.Count > 0) Then
    Dim LastPipe As Vector2 = WaterChain(WaterChain.Count - 1)

    If LastPipe.X = gameBoard.GameBoardWidth Then
      If _gameBoard.HasConnector(
        CInt(LastPipe.X),
        CInt(LastPipe.Y), 
      "Right") Then
        playerScore += DetermineScore(WaterChain.Count)
        For Each thisPipe As Vector2 In WaterChain
          _gameBoard.SetSquare(
            CInt(thisPipe.X),
            CInt(thisPipe.Y),
          "Empty")
        Next
      End If
    End If
  End If
End Sub

Private Sub HandleMouseInput(mouseInfo As MouseState)
  Dim x, y As Integer

  x = mouseInfo.X - CInt(gameBoardDisplayOrigin.X)
  y = mouseInfo.Y - CInt(gameBoardDisplayOrigin.Y)

  x = x \ GamePiece.PieceWidth
  y = y \ GamePiece.PieceHeight

  If (x >= 0) And (x <= GameBoard.GameBoardWidth) And
    (y >= 0) And (y <= GameBoard.GameBoardHeight) Then
    If mouseInfo.LeftButton = ButtonState.Pressed Then
      _gameBoard.RotatePiece(x, y, False)
      timeSinceLastInput = 0
    End If
    If mouseInfo.RightButton = ButtonState.Pressed Then
      _gameBoard.RotatePiece(x, y, True)
      timeSinceLastInput = 0
    End If
  End If
End Sub

Select Case gameState
  Case GameStates.TitleScreen
    If Keyboard.GetState().IsKeyDown(Keys.Space) Then
      _gameBoard.ClearBoard()
      _gameBoard.GenerateNewPieces(False)
      playerScore = 0
      gameState = GameStates.Playing
    End If

    Case GameStates.Playing
      timeSinceLastInput +=
      (CSng(gameTime.ElapsedGameTime.TotalSeconds))

      If timeSinceLastInput >= MinTimeSinceLastInput Then
        HandleMouseInput(Mouse.GetState())
      End If

      _gameBoard.ResetWater()

      Dim y As Integer

      For y = 0 To GameBoard.GameBoardHeight
        CheckScoringChain(_gameBoard.GetWaterChain(y))
      Next

      _gameBoard.GenerateNewPieces(True)
End Select