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!

• Mathieu Guindon: Gosh.. There's something about reading your own code in a CR post that mysteriously makes you see all the redundancies... there's much more to clean up in that controller than just extracting the playing logic!
• Raystafarian: I mean I'd say I'm pretty okay with VBA, but all these Battleship posts fly over my head..
• Mathieu Guindon: @Raystafarian I haven't blogged about it yet =) I'm very interested in a VBA veteran but OOP neophyte's point of view! I'll make another post to show the gory details of what happens on the actual GameSheet.
• AJD: Wish I had the time to go through these posts! Nothing really jumps out at me without a detailed look. Can you please add a .Select and a .Activate so we can criticise it? :-)
• AJD: One thought from the OOP perspective, and it is something I am doing for a singleton VBA class in a work project. If you are asking a question a lot (e.g. If player1.PlayerType = HumanControlled Then), then you could build that in as a property, which makes the main code question to be If player1.IsHuman Then. You then encapsulate (hide) some of the workings and more clearly define that as a property of the object.