BattleShip - Ships & Players

Question

I'm making a full-blown OOP Battleship game in VBA (previous post: Battleship Grid), and I want this code to be as good as it gets - and better, if I can.

I've refactored a few things, introduced a ShipType enum, removed all globals, and finished implementing my second AI.. time for another post!

I hadn't presented the Ship class yet, so first, here is the IShip interface:

'@Folder("Battleship.Model.Ship")
'@Interface
Option Explicit

Public Enum ShipType
    Carrier
    Battleship
    Submarine
    Cruiser
    Destroyer
End Enum

Public Enum ShipOrientation
    Horizontal
    Vertical
End Enum

'@Description("Gets the type of the ship.")
Public Property Get ShipKind() As ShipType
End Property

'@Description("The name/description of the ship. Must be unique in a grid.")
Public Property Get Name() As String
End Property

'@Description("Use in 'With' blocks to get a reference to the scope variable.")
Public Property Get GridPosition() As GridCoord
End Property

'@Description("The number of grid squares (1-5) occupied by this ship.")
Public Property Get Size() As Byte
End Property

'@Description("The orientation of the ship.")
Public Property Get Orientation() As ShipOrientation
End Property

'@Description("True if this ship is sunken.")
Public Property Get IsSunken() As Boolean
End Property

'@Description("Gets all grid coordinates this ship was hit at.")
Public Property Get HitArea() As Collection
End Property

'@Description("Gets an array containing the state of each grid coordinate of the ship.")
Public Property Get StateArray() As Variant
End Property

'@Description("If the specified coordinate hits this ship, marks coordinate as a hit and returns True.")
Public Function Hit(ByVal coord As GridCoord) As Boolean
End Function

'@Description("Returns intersection coordinate if specified ship intersects with this instance.")
Public Function Intersects(ByVal shipSize As Byte, ByVal direction As ShipOrientation, ByVal position As GridCoord) As GridCoord
End Function

The interface is implemented by the Ship class, where I have moved a number of items that were previously in a Globals module - that module is now gone, and the default instance of the Ship class serves as a factory that also knows about all the ship types in the game, with their respective names and sizes.

'@Folder("Battleship.Model.Ship")
Option Explicit

Private Const MinimumShipSize As Byte = 2
Private Const MaximumShipSize As Byte = 5

Private ShipSizes As Scripting.Dictionary
Private ShipNames As Scripting.Dictionary
Private Const ShipNameCarrier As String = "Aircraft Carrier"
Private Const ShipNameBattleship As String = "Battleship"
Private Const ShipNameSubmarine As String = "Submarine"
Private Const ShipNameCruiser As String = "Cruiser"
Private Const ShipNameDestroyer As String = "Destroyer"

Private Type TShip
    ShipKind As ShipType
    Name As String
    GridPosition As GridCoord
    Orientation As ShipOrientation
    State As Scripting.Dictionary
    IsHit As Boolean
End Type

Private this As TShip
Implements IShip

'@Description("Gets a dictionary associating all ship names with their respective size.")
Public Property Get Fleet() As Scripting.Dictionary
    Dim names As Variant
    names = ShipNames.Items

    Dim sizes As Variant
    sizes = ShipSizes.Items

    Dim result As Scripting.Dictionary
    Set result = New Scripting.Dictionary
    Dim i As Long
    For i = LBound(names) To UBound(names)
        result.Add names(i), sizes(i)
    Next
    Set Fleet = result
End Property

'@Description("Gets an array of all valid ShipKind enum values.")
Public Property Get ShipKinds() As Variant
    ShipKinds = ShipNames.Keys
End Property

'@Description("The minimum valid ship size. Invoke from the default instance.")
Public Property Get MinimumSize() As Byte
    MinimumSize = MinimumShipSize
End Property

'@Description("The maximum valid ship size. Invoke from the default instance.")
Public Property Get MaximumSize() As Byte
    MaximumSize = MaximumShipSize
End Property

'@Description("Use from the class' default instance to create a new ship instance using parameters.")
Public Function Create(ByVal kind As ShipType, ByVal direction As ShipOrientation, ByVal position As GridCoord) As Ship
    ValidateInputs kind, direction, position
    With New Ship
        .ShipKind = kind
        .Name = ShipNames(kind)
        .Orientation = direction
        Set .GridPosition = position
        Dim Offset As Byte
        For Offset = 0 To ShipSizes(kind) - 1

            Dim currentPoint As GridCoord
            Set currentPoint = New GridCoord

            currentPoint.X = position.X + IIf(direction = Horizontal, Offset, 0)
            currentPoint.Y = position.Y + IIf(direction = Vertical, Offset, 0)

            ' each element is a Boolean, keyed with a grid coordinate:
            .State.Add item:=False, Key:=currentPoint.ToString
        Next
        Set Create = .Self
    End With
End Function

Private Sub ValidateInputs(ByVal kind As ShipType, ByVal Orientation As ShipOrientation, ByVal position As GridCoord)
    Dim shipSize As Byte
    shipSize = ShipSizes(kind)

    Select Case True

        Case Orientation <> Horizontal And Orientation <> Vertical
            OnInvalidArgument "orientation", "Invalid orientation."

        Case Orientation = Horizontal And position.X + shipSize - 1 > PlayerGrid.Size
            OnInvalidArgument "position", "Invalid position; ship exceeds right edge of the grid."

        Case Orientation = Vertical And position.Y + shipSize - 1 > PlayerGrid.Size
            OnInvalidArgument "position", "Invalid position; ship exceeds bottom edge of the grid."

    End Select

End Sub

Private Sub OnInvalidArgument(ByVal argName As String, ByVal message As String)
    Err.Raise 5, TypeName(Me), message
End Sub

Public Property Get Self() As Ship
    Set Self = Me
End Property

Public Property Get ShipKind() As ShipType
    ShipKind = this.ShipKind
End Property

Public Property Let ShipKind(ByVal value As ShipType)
    this.ShipKind = value
End Property

Public Property Get Name() As String
    Name = this.Name
End Property

Public Property Let Name(ByVal value As String)
    this.Name = value
End Property

Public Property Get Orientation() As ShipOrientation
    Orientation = this.Orientation
End Property

Public Property Let Orientation(ByVal value As ShipOrientation)
    this.Orientation = value
End Property

Public Property Get GridPosition() As GridCoord
    Set GridPosition = this.GridPosition
End Property

Public Property Set GridPosition(ByVal value As GridCoord)
    Set this.GridPosition = value
End Property

Public Property Get State() As Scripting.Dictionary
    Set State = this.State
End Property

Private Sub Class_Initialize()
    If Me Is Ship Then
        'default instance
        Set ShipSizes = New Scripting.Dictionary
        With ShipSizes
            .Add ShipType.Carrier, 5
            .Add ShipType.Battleship, 4
            .Add ShipType.Submarine, 3
            .Add ShipType.Cruiser, 3
            .Add ShipType.Destroyer, 2
        End With
        Set ShipNames = New Scripting.Dictionary
        With ShipNames
            .Add ShipType.Carrier, ShipNameCarrier
            .Add ShipType.Battleship, ShipNameBattleship
            .Add ShipType.Submarine, ShipNameSubmarine
            .Add ShipType.Cruiser, ShipNameCruiser
            .Add ShipType.Destroyer, ShipNameDestroyer
        End With
    Else
        Set this.State = New Scripting.Dictionary
    End If
End Sub

Private Sub Class_Terminate()
    Set ShipSizes = Nothing
    Set ShipNames = Nothing
    Set this.State = Nothing
End Sub

Private Property Get IShip_GridPosition() As GridCoord
    Set IShip_GridPosition = this.GridPosition
End Property

Private Function IShip_Hit(ByVal coord As GridCoord) As Boolean
    Dim coordString As String
    coordString = coord.ToString
    If this.State.Exists(coordString) Then
        'this.State.Remove coordString
        this.State(coordString) = True
        this.IsHit = True
        IShip_Hit = this.State(coordString)
    End If
End Function

Private Function IShip_Intersects(ByVal shipSize As Byte, ByVal direction As ShipOrientation, ByVal position As GridCoord) As GridCoord
    Dim gridOffset As Long
    For gridOffset = 0 To shipSize - 1
        Dim current As GridCoord
        Set current = position.Offset( _
            IIf(direction = Horizontal, gridOffset, 0), _
            IIf(direction = Vertical, gridOffset, 0))
        If this.State.Exists(current.ToString) Then
            Set IShip_Intersects = current
            Exit Function
        End If
    Next
End Function

Private Property Get IShip_HitArea() As VBA.Collection
    Dim result As VBA.Collection
    Set result = New VBA.Collection
    Dim currentPoint As Variant
    For Each currentPoint In this.State.Keys
        If this.State(currentPoint) Then
            result.Add GridCoord.FromString(currentPoint)
        End If
    Next
    Set IShip_HitArea = result
End Property

Private Property Get IShip_IsSunken() As Boolean
    If Not this.IsHit Then Exit Property
    Dim currentPoint As Variant
    For Each currentPoint In this.State.Items
        If Not currentPoint Then Exit Property
    Next
    IShip_IsSunken = True
End Property

Private Property Get IShip_Name() As String
    IShip_Name = this.Name
End Property

Private Property Get IShip_Orientation() As ShipOrientation
    IShip_Orientation = this.Orientation
End Property

Private Property Get IShip_ShipKind() As ShipType
    IShip_ShipKind = this.ShipKind
End Property

Private Property Get IShip_Size() As Byte
    IShip_Size = this.State.Count
End Property

Private Property Get IShip_StateArray() As Variant
    IShip_StateArray = this.State.Items
End Property

The PlayerGrid.FindHitArea method calls into this parameterless IShip.HitArea, which returns a collection of grid positions that belong to a given ship - but only the previous hits: the AI is responsible for doing whatever it wants to do with this information, and it doesn't need to "remember" its "last hit position" to do it.

In my game an IPlayer can be either HumanControlled or ComputerControlled. Here's the interface:

'@Folder("Battleship.Model.Player")
Option Explicit

Public Enum PlayerType
    HumanControlled
    ComputerControlled
End Enum

'@Description("Gets the player's grid/state.")
Public Property Get PlayGrid() As PlayerGrid
End Property

'@Description("Identifies the player class implementation.")
Public Property Get PlayerType() As PlayerType
End Property

'@Description("Attempts to make a hit on the enemy grid.")
Public Function Play(ByVal enemyGrid As PlayerGrid) As GridCoord
End Function

'@Description("Places specified ship on game grid.")
Public Sub PlaceShip(ByVal currentShip As IShip)
End Sub

The HumanPlayer class is rather uninteresting (PlaceShip and Play implementations are no-op / empty). The AIPlayer class (which also has a default instance - I hope this is becoming quite an apparent pattern by now), on the other hand, gets injected with an IGameStrategy:

'@Folder("Battleship.Model.Player")
Option Explicit
Implements IPlayer

Private Type TPlayer
    GridIndex As Byte
    PlayerType As PlayerType
    PlayGrid As PlayerGrid
    Strategy As IGameStrategy
End Type

Private this As TPlayer

Public Function Create(ByVal grid As Byte, ByVal gameStrategy As IGameStrategy) As AIPlayer
    With New AIPlayer
        .PlayerType = ComputerControlled
        .GridIndex = grid
        Set .Strategy = gameStrategy
        Set .PlayGrid = PlayerGrid.Create(grid)
        Set Create = .Self
    End With
End Function

Public Property Get Self() As AIPlayer
    Set Self = Me
End Property

Public Property Get Strategy() As IGameStrategy
    Set Strategy = this.Strategy
End Property

Public Property Set Strategy(ByVal value As IGameStrategy)
    Set this.Strategy = value
End Property

Public Property Get PlayGrid() As PlayerGrid
    Set PlayGrid = this.PlayGrid
End Property

Public Property Set PlayGrid(ByVal value As PlayerGrid)
    Set this.PlayGrid = value
End Property

Public Property Get GridIndex() As Byte
    GridIndex = this.GridIndex
End Property

Public Property Let GridIndex(ByVal value As Byte)
    this.GridIndex = value
End Property

Public Property Get PlayerType() As PlayerType
    PlayerType = this.PlayerType
End Property

Public Property Let PlayerType(ByVal value As PlayerType)
    this.PlayerType = value
End Property

Private Property Get IPlayer_PlayGrid() As PlayerGrid
    Set IPlayer_PlayGrid = this.PlayGrid
End Property

Private Sub IPlayer_PlaceShip(ByVal currentShip As IShip)
    this.Strategy.PlaceShip this.PlayGrid, currentShip
End Sub

Private Function IPlayer_Play(ByVal enemyGrid As PlayerGrid) As GridCoord
    Set IPlayer_Play = this.Strategy.Play(enemyGrid)
End Function

Private Property Get IPlayer_PlayerType() As PlayerType
    IPlayer_PlayerType = this.PlayerType
End Property

A game strategy is defined as follows:

'@Folder("Battleship.AI")
'@Interface
Option Explicit

Public Enum AIDifficulty
    Unspecified
    RandomAI
    FairplayAI
    MercilessAI
End Enum

'@Description("Places the specified ship on the specified grid.")
Public Sub PlaceShip(ByVal grid As PlayerGrid, ByVal currentShip As IShip)
End Sub

'@Description("Gets the grid coordinate to attack on the specified enemy grid.")
Public Function Play(ByVal enemyGrid As PlayerGrid) As GridCoord
End Function

Now I plan to implement 3 of these. At this point I have a RandomShotStrategy that places its ships completely randomly and shoots anywhere, regardless of the grid state:

'@Folder("Battleship.AI")
' dumbest possible AI game strategy: randomly places ships, randomly shoots
Option Explicit
Implements IGameStrategy

Private Type TStrategy
    RNG As IRandomizer
End Type

Private this As TStrategy

Public Function Create(ByVal randomizer As IRandomizer) As IGameStrategy
    With New RandomShotStrategy
        Set .RNG = randomizer
        Set Create = .Self
    End With
End Function

Public Property Get Self() As RandomShotStrategy
    Set Self = Me
End Property

Public Property Get RNG() As IRandomizer
    Set RNG = this.RNG
End Property

Public Property Set RNG(ByVal value As IRandomizer)
    Set this.RNG = value
End Property

Private Sub IGameStrategy_PlaceShip(ByVal grid As PlayerGrid, ByVal currentShip As IShip)

    Do
        Dim gridX As Long
        gridX = this.RNG.Between(1, PlayerGrid.Size)

        Dim direction As ShipOrientation
        If gridX + currentShip.Size - 1 > PlayerGrid.Size Then
            direction = Vertical
        Else
            direction = IIf(this.RNG.NextSingle < 0.5, Horizontal, Vertical)
        End If

        Dim gridY As Long
        If direction = Horizontal Then
            gridY = this.RNG.Between(1, PlayerGrid.Size)
        Else
            gridY = this.RNG.Between(1, PlayerGrid.Size - currentShip.Size)
        End If

        Dim position As GridCoord
        Set position = GridCoord.Create(gridX, gridY)

    Loop Until grid.CanAddShip(position, direction, currentShip.Size)
    grid.AddShip Ship.Create(currentShip.ShipKind, direction, position)

    If grid.ShipCount = PlayerGrid.ShipsPerGrid Then grid.Scramble

End Sub

Private Function IGameStrategy_Play(ByVal enemyGrid As PlayerGrid) As GridCoord

    Do
        Dim position As GridCoord
        Set position = GridCoord.Create( _
            xPosition:=this.RNG.Between(1, PlayerGrid.Size), _
            yPosition:=this.RNG.Between(1, PlayerGrid.Size))

    Loop Until enemyGrid.State(position) <> PreviousHit And _
               enemyGrid.State(position) <> PreviousMiss

    Set IGameStrategy_Play = position

End Function

Here's the FairPlayStrategy, which now cares to avoid placing ships adjacent to each other, shoots randomly until it hits something - then proceeds to destroy that target:

'@Folder("Battleship.AI")
Option Explicit
Implements IGameStrategy

Private Type TStrategy
    RNG As IRandomizer
End Type

Private this As TStrategy

Public Function Create(ByVal randomizer As IRandomizer) As IGameStrategy
    With New FairPlayStrategy
        Set .RNG = randomizer
        Set Create = .Self
    End With
End Function

Public Property Get Self() As FairPlayStrategy
    Set Self = Me
End Property

Public Property Get RNG() As IRandomizer
    Set RNG = this.RNG
End Property

Public Property Set RNG(ByVal value As IRandomizer)
    Set this.RNG = value
End Property

Private Sub IGameStrategy_PlaceShip(ByVal grid As PlayerGrid, ByVal currentShip As IShip)

    Do
        Dim gridX As Long
        gridX = this.RNG.Between(1, PlayerGrid.Size)

        Dim direction As ShipOrientation
        If gridX + currentShip.Size - 1 > PlayerGrid.Size Then
            direction = Vertical
        Else
            direction = IIf(this.RNG.NextSingle < 0.5, Horizontal, Vertical)
        End If

        Dim gridY As Long
        If direction = Horizontal Then
            gridY = this.RNG.Between(1, PlayerGrid.Size)
        Else
            gridY = this.RNG.Between(1, PlayerGrid.Size - currentShip.Size)
        End If

        Dim position As GridCoord
        Set position = GridCoord.Create(gridX, gridY)

        DoEvents

    Loop Until grid.CanAddShip(position, direction, currentShip.Size) And _
           Not grid.HasAdjacentShip(position, direction, currentShip.Size)

    grid.AddShip Ship.Create(currentShip.ShipKind, direction, position)
    If grid.ShipCount = PlayerGrid.ShipsPerGrid Then grid.Scramble

End Sub

Private Function IGameStrategy_Play(ByVal enemyGrid As PlayerGrid) As GridCoord
    Dim result As GridCoord
    Do
        Dim area As Collection
        Set area = enemyGrid.FindHitArea

        If Not area Is Nothing Then

            Dim inferredDirection As ShipOrientation
            inferredDirection = TryInferDirection(area)

            If inferredDirection = Horizontal Then
                If this.RNG.NextSingle < 0.5 Then
                    Set result = FindLeftMostHit(area).Offset(xOffset:=-1)
                    If result.X = 1 Or enemyGrid.State(result) = PreviousMiss Then
                        Set result = FindRightMostHit(area).Offset(xOffset:=1)
                    End If
                Else
                    Set result = FindRightMostHit(area).Offset(xOffset:=1)
                    If result.X = PlayerGrid.Size Or enemyGrid.State(result) = PreviousMiss Then
                        Set result = FindLeftMostHit(area).Offset(xOffset:=-1)
                    End If
                End If
            Else
                If this.RNG.NextSingle < 0.5 Then
                    Set result = FindTopMostHit(area).Offset(yOffset:=-1)
                    If result.Y = 1 Or enemyGrid.State(result) = PreviousMiss Then
                        Set result = FindBottomMostHit(area).Offset(yOffset:=1)
                    End If
                Else
                    Set result = FindBottomMostHit(area).Offset(yOffset:=1)
                    If result.Y = PlayerGrid.Size Or enemyGrid.State(result) = PreviousMiss Then
                        Set result = FindTopMostHit(area).Offset(yOffset:=-1)
                    End If
                End If
            End If

        Else
            'no hit area: just shoot *somewhere*
            Set result = ShootRandom
        End If

    Loop Until result.X >= 1 And result.X <= PlayerGrid.Size And _
               result.Y >= 1 And result.Y <= PlayerGrid.Size And _
               enemyGrid.State(result) <> PreviousHit And _
               enemyGrid.State(result) <> PreviousMiss

    Set IGameStrategy_Play = result
    Exit Function
End Function

Private Function ShootRandom() As GridCoord
    Set ShootRandom = GridCoord.Create( _
        xPosition:=this.RNG.Between(1, PlayerGrid.Size), _
        yPosition:=this.RNG.Between(1, PlayerGrid.Size))
End Function

Private Function TryInferDirection(ByVal area As Collection) As ShipOrientation
    Dim previousPosition As GridCoord
    Dim currentPosition As GridCoord
    For Each currentPosition In area
        If previousPosition Is Nothing Then
            Set previousPosition = currentPosition
            'could be either (ignoring remaining enemy ships)
            TryInferDirection = IIf(this.RNG.NextSingle < 0.5, Horizontal, Vertical)
        Else
            If currentPosition.Y = previousPosition.Y Then
                TryInferDirection = Horizontal
            Else
                TryInferDirection = Vertical
            End If
        End If
    Next
End Function

Private Function FindLeftMostHit(ByVal area As Collection) As GridCoord
    Dim leftMost As GridCoord
    Set leftMost = area(1)

    Dim current As GridCoord
    For Each current In area
        If current.X < leftMost.X Then Set leftMost = current
    Next

    Set FindLeftMostHit = leftMost
End Function

Private Function FindRightMostHit(ByVal area As Collection) As GridCoord
    Dim rightMost As GridCoord
    Set rightMost = area(1)

    Dim current As GridCoord
    For Each current In area
        If current.X > rightMost.X Then Set rightMost = current
    Next

    Set FindRightMostHit = rightMost
End Function

Private Function FindTopMostHit(ByVal area As Collection) As GridCoord
    Dim topMost As GridCoord
    Set topMost = area(1)

    Dim current As GridCoord
    For Each current In area
        If current.Y < topMost.Y Then Set topMost = current
    Next

    Set FindTopMostHit = topMost
End Function

Private Function FindBottomMostHit(ByVal area As Collection) As GridCoord
    Dim bottomMost As GridCoord
    Set bottomMost = area(1)

    Dim current As GridCoord
    For Each current In area
        If current.Y > bottomMost.Y Then Set bottomMost = current
    Next

    Set FindBottomMostHit = bottomMost
End Function

Here's two of them playing against each other. Now, I'm going to be implementing a MercilessStrategy that will no longer shoot completely randomly without a target - it will be taking into account the available empty spots, vs what enemy ships remain to sink.

But I will likely need to reuse much of the code of the FairPlayStrategy (even that one duplicates the random shot code), so I'm thinking to extract a utility class and compose my AI strategies - or is there a better solution? In .NET I'd probably make an abstract GameStrategyBase class, shove all the base methods in there, and derive the strategies from it.

Anything sticks out? Again, please be picky!

^{RandomShotStrategy vs FairPlayStrategy - guess which AI is in which grid!}