Battleship MVC Architecture

Question

The entry point is the Macros module, which - for now - includes only a single procedure, at a very high abstraction level - I'm quite happy with this:

'@Folder("Macros")
Option Explicit
'@Ignore MoveFieldCloserToUsage; controller reference needs to be held at module level!
Private controller As GameController

Public Sub PlayWorksheetInterface()

    Dim view As WorksheetView
    Set view = New WorksheetView

    Set controller = New GameController
    controller.NewGame GridViewAdapter.Create(view)

End Sub

Model

The Model consists of Ship (IShip), PlayerGrid, GridCoord, AIPlayer, and HumanPlayer (IPlayer) classes, which I've posted here. The code changed a little since then, but this post isn't about the model.

View

The View consists essentially of two interfaces: IViewEvents, which sends messages from the view to the controller, and IViewCommands, which sends messages from the controller to the view.

IViewEvents

'@Folder("Battleship.View")
'@Description("Commands sent from the view to the GridViewAdapter.")
Option Explicit

Public Sub CreatePlayer(ByVal gridId As Byte, ByVal pt As PlayerType, ByVal difficulty As AIDifficulty)
End Sub

Public Sub PreviewRotateShip(ByVal gridId As Byte, ByVal position As IGridCoord)
End Sub

Public Sub PreviewShipPosition(ByVal gridId As Byte, ByVal position As IGridCoord)
End Sub

Public Sub ConfirmShipPosition(ByVal gridId As Byte, ByVal position As IGridCoord)
End Sub

Public Sub AttackPosition(ByVal gridId As Byte, ByVal position As IGridCoord)
End Sub

IViewCommands

'@Folder("Battleship.View")
'@Description("Commands sent from the GridViewAdapter to the view.")
Option Explicit

'@Description("Gets/sets a weak refererence to the GridViewAdapter.")
Public Property Get Events() As IGridViewEvents
End Property

Public Property Set Events(ByVal value As IGridViewEvents)
End Property

'@Description("Instructs the view to react to a miss in the specified grid.")
Public Sub OnMiss(ByVal gridId As Byte)
End Sub

'@Description("Instructs the view to report a hit in the specified grid.")
Public Sub OnHit(ByVal gridId As Byte)
End Sub

'@Description("Instructs the view to report a sunken ship in the specified grid.")
Public Sub OnSink(ByVal gridId As Byte)
End Sub

'@Description("Instructs the view to update the specified player's fleet status, for the specified ship.")
Public Sub OnUpdateFleetStatus(ByVal player As IPlayer, ByVal hitShip As IShip, Optional ByVal showAIStatus As Boolean = False)
End Sub

'@Description("Instructs the view to select the specified position in the specified grid.")
Public Sub OnSelectPosition(ByVal gridId As Byte, ByVal position As IGridCoord)
End Sub

'@Description("Instructs the view to lock the specified grid, preventing user interaction.")
Public Sub OnLockGrid(ByVal gridId As Byte)
End Sub

'@Description("Instructs the view to begin a new game.")
Public Sub OnNewGame()
End Sub

'@Description("Instructs the view to end the game.")
Public Sub OnGameOver(ByVal winningGrid As Byte)
End Sub

'@Description("Instructs the view to begin positioning the specified ship.")
Public Sub OnBeginShipPosition(ByVal currentShip As IShip, ByVal player As IPlayer)
End Sub

'@Description("Instructs the view to confirm the position of the specified ship.")
Public Sub OnConfirmShipPosition(ByVal player As IPlayer, ByVal newShip As IShip, ByRef confirmed As Boolean)
End Sub

'@Description("Instructs the view to preview the position of the specified ship.")
Public Sub OnPreviewShipPosition(ByVal player As IPlayer, ByVal newShip As IShip)
End Sub

'@Description("Instructs the view to begin attack phase.")
Public Sub OnBeginAttack()
End Sub

'@Description("Instructs the view to react to an attack attempt on a known-state position.")
Public Sub OnKnownPositionAttack()
End Sub

'@Description("Instructs the view to redraw the specified grid.")
Public Sub OnRefreshGrid(ByVal grid As PlayerGrid)
End Sub

Then there's a GridViewAdapter, that implements both - this was adapted/inferred from this SO answer, which describes/outlines the pattern and roughly demonstrates how to use interfaces and events together (since VBA doesn't let you expose events on interfaces).

'@Folder("Battleship.View")
Option Explicit
Implements IGridViewCommands
Implements IGridViewEvents

Public Enum ViewMode
    NewGame
    MessageShown
    FleetPosition
    player1
    player2
    GameOver
End Enum

Public Event OnCreatePlayer(ByVal gridId As Byte, ByVal pt As PlayerType, ByVal difficulty As AIDifficulty)

Public Event OnPreviewCurrentShipPosition(ByVal gridId As Byte, ByVal position As IGridCoord)
Public Event OnConfirmCurrentShipPosition(ByVal gridId As Byte, ByVal position As IGridCoord)
Public Event OnRotateCurrentShipPosition(ByVal gridId As Byte, ByVal position As IGridCoord)
Public Event OnPlayerReady()
Public Event OnAttackPosition(ByVal gridId As Byte, ByVal position As IGridCoord)
Public Event OnHit(ByVal gridId As Byte, ByVal position As IGridCoord, ByVal hitShip As IShip)
Public Event OnMiss(ByVal gridId As Byte, ByVal position As IGridCoord)
Public Event OnGameOver(ByVal winner As IPlayer)

Public Event Play(ByVal enemyGrid As PlayerGrid, ByVal player As IPlayer, ByRef position As IGridCoord)

Private Type TAdapter
    ShipsToPosition As Byte
    GridView As IGridViewCommands
End Type
Private this As TAdapter

Public Function Create(ByVal view As IGridViewCommands) As GridViewAdapter
    With New GridViewAdapter
        Set .GridView = view
        Set view.Events = .Self
        Set Create = .Self
    End With
End Function

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

Public Property Get GridView() As IGridViewCommands
    Set GridView = this.GridView
End Property

Public Property Set GridView(ByVal value As IGridViewCommands)
    Set this.GridView = value
End Property

Private Sub Class_Initialize()
    this.ShipsToPosition = PlayerGrid.ShipsPerGrid
End Sub

'@Ignore ParameterNotUsed
Private Property Set IGridViewCommands_Events(ByVal value As IGridViewEvents)
    Err.Raise 5, TypeName(Me)
End Property

Private Property Get IGridViewCommands_Events() As IGridViewEvents
    Set IGridViewCommands_Events = Me
End Property

Private Sub IGridViewCommands_OnBeginAttack()
    this.GridView.OnBeginAttack
End Sub

Private Sub IGridViewCommands_OnBeginShipPosition(ByVal currentShip As IShip, ByVal player As IPlayer)
    this.GridView.OnLockGrid IIf(player.PlayGrid.gridId = 1, 2, 1)
    this.GridView.OnBeginShipPosition currentShip, player
End Sub

Private Sub IGridViewCommands_OnConfirmShipPosition(ByVal player As IPlayer, ByVal newShip As IShip, ByRef confirmed As Boolean)
    If player.PlayerType = ComputerControlled Then Exit Sub
    this.GridView.OnConfirmShipPosition player, newShip, confirmed
    If confirmed Then
        this.ShipsToPosition = this.ShipsToPosition - 1
        If this.ShipsToPosition = 0 Then
            RaiseEvent OnPlayerReady
        End If
    End If
End Sub

Private Sub IGridViewCommands_OnGameOver(ByVal winningGrid As Byte)
    this.GridView.OnGameOver winningGrid
    Set this.GridView.Events = Nothing
End Sub

Private Sub IGridViewCommands_OnHit(ByVal gridId As Byte)
    this.GridView.OnHit gridId
End Sub

Private Sub IGridViewCommands_OnKnownPositionAttack()
    this.GridView.OnKnownPositionAttack
End Sub

Private Sub IGridViewCommands_OnLockGrid(ByVal gridId As Byte)
    this.GridView.OnLockGrid gridId
End Sub

Private Sub IGridViewCommands_OnMiss(ByVal gridId As Byte)
    this.GridView.OnMiss gridId
End Sub

Private Sub IGridViewCommands_OnNewGame()
    this.GridView.OnNewGame
End Sub

Private Sub IGridViewCommands_OnPreviewShipPosition(ByVal player As IPlayer, ByVal newShip As IShip)
    If player.PlayerType = ComputerControlled Then Exit Sub
    this.GridView.OnPreviewShipPosition player, newShip
End Sub

Private Sub IGridViewCommands_OnRefreshGrid(ByVal grid As PlayerGrid)
    this.GridView.OnRefreshGrid grid
End Sub

Private Sub IGridViewCommands_OnSelectPosition(ByVal gridId As Byte, ByVal position As IGridCoord)
    this.GridView.OnSelectPosition gridId, position
End Sub

Private Sub IGridViewCommands_OnSink(ByVal gridId As Byte)
    this.GridView.OnSink gridId
End Sub

Private Sub IGridViewCommands_OnUpdateFleetStatus(ByVal player As IPlayer, ByVal hitShip As IShip, Optional ByVal showAIStatus As Boolean = False)
    this.GridView.OnUpdateFleetStatus player, hitShip, showAIStatus
End Sub

Private Sub IGridViewEvents_AttackPosition(ByVal gridId As Byte, ByVal position As IGridCoord)
    RaiseEvent OnAttackPosition(gridId, position)
End Sub

Private Sub IGridViewEvents_ConfirmShipPosition(ByVal gridId As Byte, ByVal position As IGridCoord)
    RaiseEvent OnConfirmCurrentShipPosition(gridId, position)
End Sub

Private Sub IGridViewEvents_CreatePlayer(ByVal gridId As Byte, ByVal pt As PlayerType, ByVal difficulty As AIDifficulty)
    RaiseEvent OnCreatePlayer(gridId, pt, difficulty)
End Sub

Private Sub IGridViewEvents_PreviewRotateShip(ByVal gridId As Byte, ByVal position As IGridCoord)
    RaiseEvent OnRotateCurrentShipPosition(gridId, position)
End Sub

Private Sub IGridViewEvents_PreviewShipPosition(ByVal gridId As Byte, ByVal position As IGridCoord)
    RaiseEvent OnPreviewCurrentShipPosition(gridId, position)
End Sub

I'm using an adapter, because I intend to make the game playable on a UserFormView just as well as on a WorksheetView - otherwise I guess wouldn't have minded coupling the controller with the view directly. Here's the WorksheetView:

'@Folder("Battleship.View.Worksheet")
Option Explicit
Implements IGridViewCommands

Private adapter As IWeakReference
Private WithEvents sheetUI As GameSheet

Private Sub Class_Initialize()
    Set sheetUI = GameSheet
End Sub

Private Property Get ViewEvents() As IGridViewEvents
    Set ViewEvents = adapter.Object
End Property

Private Property Set IGridViewCommands_Events(ByVal value As IGridViewEvents)
    Set adapter = WeakReference.Create(value)
End Property

Private Property Get IGridViewCommands_Events() As IGridViewEvents
    Set IGridViewCommands_Events = adapter.Object
End Property

Private Sub IGridViewCommands_OnBeginAttack()
    sheetUI.ShowInfoBeginAttackPhase
End Sub

Private Sub IGridViewCommands_OnBeginShipPosition(ByVal currentShip As IShip, ByVal player As IPlayer)
    sheetUI.ShowInfoBeginDeployShip currentShip.Name
End Sub

Private Sub IGridViewCommands_OnConfirmShipPosition(ByVal player As IPlayer, ByVal newShip As IShip, confirmed As Boolean)
    sheetUI.ConfirmShipPosition player, newShip, confirmed
End Sub

Private Sub IGridViewCommands_OnGameOver(ByVal winningGridId As Byte)
    With sheetUI
        .ShowAnimationVictory winningGridId
        .ShowAnimationDefeat IIf(winningGridId = 1, 2, 1)
        .LockGrids
    End With
End Sub

Private Sub IGridViewCommands_OnHit(ByVal gridId As Byte)
    With sheetUI
        .ShowAnimationHit gridId
        .LockGrid gridId
    End With
End Sub

Private Sub IGridViewCommands_OnKnownPositionAttack()
    sheetUI.ShowErrorKnownPositionAttack
End Sub

Private Sub IGridViewCommands_OnLockGrid(ByVal gridId As Byte)
    sheetUI.LockGrid gridId
End Sub

Private Sub IGridViewCommands_OnMiss(ByVal gridId As Byte)
    With sheetUI
        .ShowAnimationMiss gridId
        .LockGrid gridId
    End With
End Sub

Private Sub IGridViewCommands_OnNewGame()
    With sheetUI
        .Visible = xlSheetVisible
        .OnNewGame
    End With
End Sub

Private Sub IGridViewCommands_OnPreviewShipPosition(ByVal player As IPlayer, ByVal newShip As IShip)
    sheetUI.PreviewShipPosition player, newShip
End Sub

Private Sub IGridViewCommands_OnRefreshGrid(ByVal grid As PlayerGrid)
    sheetUI.RefreshGrid grid
End Sub

Private Sub IGridViewCommands_OnSelectPosition(ByVal gridId As Byte, ByVal position As IGridCoord)
    If sheetUI Is Application.ActiveSheet Then
        sheetUI.GridCoordToRange(gridId, position).Select
    End If
End Sub

Private Sub IGridViewCommands_OnSink(ByVal gridId As Byte)
    With sheetUI
        .ShowAnimationSunk gridId
        .LockGrid gridId
    End With
End Sub

Private Sub IGridViewCommands_OnUpdateFleetStatus(ByVal player As IPlayer, ByVal hitShip As IShip, Optional ByVal showAIStatus As Boolean = False)
    With sheetUI
        If player.PlayerType = ComputerControlled And showAIStatus Then
            .ShowAcquiredTarget IIf(player.PlayGrid.gridId = 1, 2, 1), hitShip.Name, hitShip.IsSunken
        Else
            .UpdateShipStatus player, hitShip
        End If
    End With
End Sub

Private Sub sheetUI_CreatePlayer(ByVal gridId As Byte, ByVal pt As PlayerType, ByVal difficulty As AIDifficulty)
    ViewEvents.CreatePlayer gridId, pt, difficulty
End Sub

Private Sub sheetUI_DoubleClick(ByVal gridId As Byte, ByVal position As IGridCoord, ByVal Mode As ViewMode)
    Select Case Mode

        Case ViewMode.FleetPosition
            ViewEvents.ConfirmShipPosition gridId, position

        Case ViewMode.player1, ViewMode.player2
            ViewEvents.AttackPosition gridId, position

    End Select
End Sub

Private Sub sheetUI_RightClick(ByVal gridId As Byte, ByVal position As IGridCoord, ByVal Mode As ViewMode)
    If Mode = FleetPosition Then ViewEvents.PreviewRotateShip gridId, position
End Sub

Private Sub sheetUI_SelectionChange(ByVal gridId As Byte, ByVal position As IGridCoord, ByVal Mode As ViewMode)
    If Mode = FleetPosition Then ViewEvents.PreviewShipPosition gridId, position
End Sub

The IWeakReference is an updated version of this code that now includes precompiler directives (so that it works in both 32 and 64 bit hosts) and proper error handling.

The GameSheet is an Excel worksheet exposing the methods invoked by the WorksheetView; the reason I didn't make the worksheet itself implement IGridViewCommands, is because making VBA host document modules implement interfaces is a very good way to crash the entire thing - i.e. you don't do that. So instead I made the worksheet expose methods that handle all the presentation concerns, and the WorksheetView simply invokes them.

Controller

The GameController class encapsulates the entire game logic - too much for my taste: I find it's responsible for way too many things, and that's making it rather hard to refactor and support custom game modes, like salvo mode. I tried extracting the currentPlayer/currentTarget and player turn logic into a ClassicMode class (implementing an IGameMode interface that an eventual SalvoMode class could also implement), but that broke everything so I rolled it back... and basically I'm asking Code Review to help me cleanly separate the too many concerns I've put into this controller.

'@Folder("Battleship")
Option Explicit

Private Const Delay As Long = 1200

Private player1 As IPlayer
Private player2 As IPlayer

Private currentPlayer As IPlayer
Private currentTarget As IPlayer
Private currentShip As IShip

Private view As IGridViewCommands
Private WithEvents viewAdapter As GridViewAdapter

Public Sub NewGame(ByVal adapter As GridViewAdapter)
    Set viewAdapter = adapter
    Set view = adapter
    view.OnNewGame
End Sub

Private Sub viewAdapter_OnCreatePlayer(ByVal gridId As Byte, ByVal pt As PlayerType, ByVal difficulty As AIDifficulty)
    If gridId = 1 And Not player1 Is Nothing Then Exit Sub
    If gridId = 2 And Not player2 Is Nothing Then Exit Sub

    Dim player As IPlayer
    Select Case pt

        Case HumanControlled
            Set player = HumanPlayer.Create(gridId)

        Case ComputerControlled

            Select Case difficulty
                Case AIDifficulty.RandomAI
                    Set player = AIPlayer.Create(gridId, RandomShotStrategy.Create(New GameRandomizer))
                Case AIDifficulty.FairplayAI
                    Set player = AIPlayer.Create(gridId, FairPlayStrategy.Create(New GameRandomizer))
                Case AIDifficulty.MercilessAI
                    Set player = AIPlayer.Create(gridId, MercilessStrategy.Create(New GameRandomizer))
            End Select

        Case Else
            Err.Raise 5, TypeName(Me), "Invalid PlayerType"

    End Select

    If gridId = 1 Then
        Set player1 = player
    ElseIf gridId = 2 Then
        Set player2 = player
    End If

    If Not player1 Is Nothing And Not player2 Is Nothing Then
        OnShipPositionStart
        EndCurrentPlayerTurn
    End If

End Sub

Private Sub OnShipPositionStart()

    Dim kinds As Variant
    kinds = Ship.ShipKinds
    Set currentShip = Ship.Create(kinds(0), Horizontal, GridCoord.Create(1, 1))

    If player1.PlayerType = HumanControlled Then
        view.OnBeginShipPosition currentShip, player1
    ElseIf player2.PlayerType = HumanControlled Then
        view.OnBeginShipPosition currentShip, player2
    Else
        'AI vs AI
        Dim i As Long
        For i = LBound(kinds) To UBound(kinds)
            Set currentShip = Ship.Create(kinds(i), Horizontal, GridCoord.Create(1, 1))
            player1.PlaceShip currentShip
            player2.PlaceShip currentShip
        Next
        Set currentPlayer = player1
        Set currentTarget = player2
        PlayAI
    End If

End Sub

Private Sub viewAdapter_OnNewGame()
    NewGame viewAdapter
End Sub

Private Sub viewAdapter_OnPreviewCurrentShipPosition(ByVal gridId As Byte, ByVal position As IGridCoord)
    On Error Resume Next
    Set currentShip = Ship.Create(currentShip.ShipKind, currentShip.Orientation, position)
    On Error GoTo 0
    If gridId = 1 Then
        view.OnPreviewShipPosition player1, currentShip
    Else
        view.OnPreviewShipPosition player2, currentShip
    End If
End Sub

Private Sub viewAdapter_OnRotateCurrentShipPosition(ByVal gridId As Byte, ByVal position As IGridCoord)
    On Error Resume Next
    Set currentShip = Ship.Create(currentShip.ShipKind, IIf(currentShip.Orientation = Horizontal, Vertical, Horizontal), position)
    On Error GoTo 0
    If gridId = 1 Then
        view.OnPreviewShipPosition player1, currentShip
    Else
        view.OnPreviewShipPosition player2, currentShip
    End If
End Sub

Private Sub viewAdapter_OnConfirmCurrentShipPosition(ByVal gridId As Byte, ByVal position As IGridCoord)
    If gridId <> currentPlayer.PlayGrid.gridId Then Exit Sub
    Dim confirmed As Boolean
    view.OnConfirmShipPosition currentPlayer, currentShip, confirmed

    ' no-op for human players
    player1.PlaceShip currentShip
    player2.PlaceShip currentShip

    Dim ships As Long
    ships = currentPlayer.PlayGrid.shipCount

    If confirmed And ships < PlayerGrid.ShipsPerGrid Then
        Dim kind As ShipType
        kind = Ship.ShipKinds(ships)
        Set currentShip = Ship.Create(kind, Horizontal, GridCoord.Create(1, 1))
        view.OnBeginShipPosition currentShip, currentPlayer
    End If
End Sub

Private Sub viewAdapter_OnPlayerReady()
    Set currentPlayer = player1
    Set currentTarget = player2
    If currentPlayer.PlayerType = HumanControlled Then
        view.OnBeginAttack
    Else
        currentPlayer.Play currentTarget.PlayGrid
    End If
End Sub

Private Sub viewAdapter_OnAttackPosition(ByVal gridId As Byte, ByVal position As IGridCoord)
    If gridId = currentPlayer.PlayGrid.gridId Then Exit Sub
    On Error GoTo CleanFail

    If currentPlayer.PlayerType = HumanControlled Then
        Play gridId, position
    Else
        PlayAI
    End If

    Exit Sub
CleanFail:
    With Err
        If .Number = PlayerGridErrors.KnownGridStateError Then
            view.OnKnownPositionAttack
        End If
    End With
End Sub

Private Sub PlayAI()
    Debug.Assert currentPlayer.PlayerType <> HumanControlled
    Win32API.Sleep Delay
    Play currentTarget.PlayGrid.gridId, currentPlayer.Play(currentTarget.PlayGrid)
End Sub

Private Sub Play(ByVal gridId As Byte, ByVal position As IGridCoord)
    Dim result As AttackResult, hitShip As IShip
    result = currentTarget.PlayGrid.TryHit(position, hitShip)

    view.OnRefreshGrid currentTarget.PlayGrid
    view.OnSelectPosition gridId, position

    Select Case result

        Case AttackResult.Miss
            view.OnMiss gridId

        Case AttackResult.Hit
            view.OnUpdateFleetStatus currentTarget, hitShip, (player1.PlayerType = ComputerControlled And player2.PlayerType = ComputerControlled)
            view.OnHit gridId

        Case AttackResult.Sunk
            view.OnUpdateFleetStatus currentTarget, hitShip
            If currentTarget.PlayGrid.IsAllSunken Then
                view.OnGameOver currentPlayer.PlayGrid.gridId
                End
            Else
                view.OnSink gridId
            End If

    End Select

    EndCurrentPlayerTurn
End Sub

Private Sub EndCurrentPlayerTurn()
    If currentPlayer Is player1 Then
        Set currentPlayer = player2
        Set currentTarget = player1
    Else
        Set currentPlayer = player1
        Set currentTarget = player2
    End If
    If currentPlayer.PlayerType <> HumanControlled Then PlayAI
End Sub

So, while I'm mostly interested in separating the too many concerns handled by the controller, as always I'm very open to feedback on every other aspect of this code. No feedback can be too picky - I want to eventually present this code as a demonstration of VBA+OOP capabilities, so I ultimately need it to be as close as possible to object-oriented perfection... as far as VBA allows anyway!