8
\$\begingroup\$

The entry point is theMacros 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 GameControllerPublic Sub PlayWorksheetInterface()    Dim view As WorksheetView    Set view = New WorksheetView    Set controller = New GameController    controller.NewGame GridViewAdapter.Create(view)End Sub

Model

TheModel consists ofShip (IShip),PlayerGrid,GridCoord,AIPlayer, andHumanPlayer (IPlayer) classes, which I've postedhere. The code changed a little since then, but this post isn't about the model.

View

TheView consists essentially of two interfaces:IViewEvents, which sends messages from the view to the controller, andIViewCommands, which sends messages from the controller to the view.

IViewEvents

'@Folder("Battleship.View")'@Description("Commands sent from the view to the GridViewAdapter.")Option ExplicitPublic Sub CreatePlayer(ByVal gridId As Byte, ByVal pt As PlayerType, ByVal difficulty As AIDifficulty)End SubPublic Sub PreviewRotateShip(ByVal gridId As Byte, ByVal position As IGridCoord)End SubPublic Sub PreviewShipPosition(ByVal gridId As Byte, ByVal position As IGridCoord)End SubPublic Sub ConfirmShipPosition(ByVal gridId As Byte, ByVal position As IGridCoord)End SubPublic 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 IGridViewEventsEnd PropertyPublic 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 aGridViewAdapter, that implements both - this was adapted/inferred fromthis 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 ExplicitImplements IGridViewCommandsImplements IGridViewEventsPublic Enum ViewMode    NewGame    MessageShown    FleetPosition    player1    player2    GameOverEnd EnumPublic 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 IGridViewCommandsEnd TypePrivate this As TAdapterPublic Function Create(ByVal view As IGridViewCommands) As GridViewAdapter    With New GridViewAdapter        Set .GridView = view        Set view.Events = .Self        Set Create = .Self    End WithEnd FunctionPublic Property Get Self() As GridViewAdapter    Set Self = MeEnd PropertyPublic Property Get GridView() As IGridViewCommands    Set GridView = this.GridViewEnd PropertyPublic Property Set GridView(ByVal value As IGridViewCommands)    Set this.GridView = valueEnd PropertyPrivate Sub Class_Initialize()    this.ShipsToPosition = PlayerGrid.ShipsPerGridEnd Sub'@Ignore ParameterNotUsedPrivate Property Set IGridViewCommands_Events(ByVal value As IGridViewEvents)    Err.Raise 5, TypeName(Me)End PropertyPrivate Property Get IGridViewCommands_Events() As IGridViewEvents    Set IGridViewCommands_Events = MeEnd PropertyPrivate Sub IGridViewCommands_OnBeginAttack()    this.GridView.OnBeginAttackEnd SubPrivate 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, playerEnd SubPrivate 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 IfEnd SubPrivate Sub IGridViewCommands_OnGameOver(ByVal winningGrid As Byte)    this.GridView.OnGameOver winningGrid    Set this.GridView.Events = NothingEnd SubPrivate Sub IGridViewCommands_OnHit(ByVal gridId As Byte)    this.GridView.OnHit gridIdEnd SubPrivate Sub IGridViewCommands_OnKnownPositionAttack()    this.GridView.OnKnownPositionAttackEnd SubPrivate Sub IGridViewCommands_OnLockGrid(ByVal gridId As Byte)    this.GridView.OnLockGrid gridIdEnd SubPrivate Sub IGridViewCommands_OnMiss(ByVal gridId As Byte)    this.GridView.OnMiss gridIdEnd SubPrivate Sub IGridViewCommands_OnNewGame()    this.GridView.OnNewGameEnd SubPrivate Sub IGridViewCommands_OnPreviewShipPosition(ByVal player As IPlayer, ByVal newShip As IShip)    If player.PlayerType = ComputerControlled Then Exit Sub    this.GridView.OnPreviewShipPosition player, newShipEnd SubPrivate Sub IGridViewCommands_OnRefreshGrid(ByVal grid As PlayerGrid)    this.GridView.OnRefreshGrid gridEnd SubPrivate Sub IGridViewCommands_OnSelectPosition(ByVal gridId As Byte, ByVal position As IGridCoord)    this.GridView.OnSelectPosition gridId, positionEnd SubPrivate Sub IGridViewCommands_OnSink(ByVal gridId As Byte)    this.GridView.OnSink gridIdEnd SubPrivate Sub IGridViewCommands_OnUpdateFleetStatus(ByVal player As IPlayer, ByVal hitShip As IShip, Optional ByVal showAIStatus As Boolean = False)    this.GridView.OnUpdateFleetStatus player, hitShip, showAIStatusEnd SubPrivate Sub IGridViewEvents_AttackPosition(ByVal gridId As Byte, ByVal position As IGridCoord)    RaiseEvent OnAttackPosition(gridId, position)End SubPrivate Sub IGridViewEvents_ConfirmShipPosition(ByVal gridId As Byte, ByVal position As IGridCoord)    RaiseEvent OnConfirmCurrentShipPosition(gridId, position)End SubPrivate Sub IGridViewEvents_CreatePlayer(ByVal gridId As Byte, ByVal pt As PlayerType, ByVal difficulty As AIDifficulty)    RaiseEvent OnCreatePlayer(gridId, pt, difficulty)End SubPrivate Sub IGridViewEvents_PreviewRotateShip(ByVal gridId As Byte, ByVal position As IGridCoord)    RaiseEvent OnRotateCurrentShipPosition(gridId, position)End SubPrivate Sub IGridViewEvents_PreviewShipPosition(ByVal gridId As Byte, ByVal position As IGridCoord)    RaiseEvent OnPreviewCurrentShipPosition(gridId, position)End Sub

I'm using anadapter, because I intend to make the game playable on aUserFormView just as well as on aWorksheetView - otherwise I guess wouldn't have minded coupling the controller with the view directly. Here's theWorksheetView:

'@Folder("Battleship.View.Worksheet")Option ExplicitImplements IGridViewCommandsPrivate adapter As IWeakReferencePrivate WithEvents sheetUI As GameSheetPrivate Sub Class_Initialize()    Set sheetUI = GameSheetEnd SubPrivate Property Get ViewEvents() As IGridViewEvents    Set ViewEvents = adapter.ObjectEnd PropertyPrivate Property Set IGridViewCommands_Events(ByVal value As IGridViewEvents)    Set adapter = WeakReference.Create(value)End PropertyPrivate Property Get IGridViewCommands_Events() As IGridViewEvents    Set IGridViewCommands_Events = adapter.ObjectEnd PropertyPrivate Sub IGridViewCommands_OnBeginAttack()    sheetUI.ShowInfoBeginAttackPhaseEnd SubPrivate Sub IGridViewCommands_OnBeginShipPosition(ByVal currentShip As IShip, ByVal player As IPlayer)    sheetUI.ShowInfoBeginDeployShip currentShip.NameEnd SubPrivate Sub IGridViewCommands_OnConfirmShipPosition(ByVal player As IPlayer, ByVal newShip As IShip, confirmed As Boolean)    sheetUI.ConfirmShipPosition player, newShip, confirmedEnd SubPrivate Sub IGridViewCommands_OnGameOver(ByVal winningGridId As Byte)    With sheetUI        .ShowAnimationVictory winningGridId        .ShowAnimationDefeat IIf(winningGridId = 1, 2, 1)        .LockGrids    End WithEnd SubPrivate Sub IGridViewCommands_OnHit(ByVal gridId As Byte)    With sheetUI        .ShowAnimationHit gridId        .LockGrid gridId    End WithEnd SubPrivate Sub IGridViewCommands_OnKnownPositionAttack()    sheetUI.ShowErrorKnownPositionAttackEnd SubPrivate Sub IGridViewCommands_OnLockGrid(ByVal gridId As Byte)    sheetUI.LockGrid gridIdEnd SubPrivate Sub IGridViewCommands_OnMiss(ByVal gridId As Byte)    With sheetUI        .ShowAnimationMiss gridId        .LockGrid gridId    End WithEnd SubPrivate Sub IGridViewCommands_OnNewGame()    With sheetUI        .Visible = xlSheetVisible        .OnNewGame    End WithEnd SubPrivate Sub IGridViewCommands_OnPreviewShipPosition(ByVal player As IPlayer, ByVal newShip As IShip)    sheetUI.PreviewShipPosition player, newShipEnd SubPrivate Sub IGridViewCommands_OnRefreshGrid(ByVal grid As PlayerGrid)    sheetUI.RefreshGrid gridEnd SubPrivate Sub IGridViewCommands_OnSelectPosition(ByVal gridId As Byte, ByVal position As IGridCoord)    If sheetUI Is Application.ActiveSheet Then        sheetUI.GridCoordToRange(gridId, position).Select    End IfEnd SubPrivate Sub IGridViewCommands_OnSink(ByVal gridId As Byte)    With sheetUI        .ShowAnimationSunk gridId        .LockGrid gridId    End WithEnd SubPrivate 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 WithEnd SubPrivate Sub sheetUI_CreatePlayer(ByVal gridId As Byte, ByVal pt As PlayerType, ByVal difficulty As AIDifficulty)    ViewEvents.CreatePlayer gridId, pt, difficultyEnd SubPrivate 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 SelectEnd SubPrivate Sub sheetUI_RightClick(ByVal gridId As Byte, ByVal position As IGridCoord, ByVal Mode As ViewMode)    If Mode = FleetPosition Then ViewEvents.PreviewRotateShip gridId, positionEnd SubPrivate Sub sheetUI_SelectionChange(ByVal gridId As Byte, ByVal position As IGridCoord, ByVal Mode As ViewMode)    If Mode = FleetPosition Then ViewEvents.PreviewShipPosition gridId, positionEnd Sub

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

TheGameSheet is an Excel worksheet exposing the methods invoked by theWorksheetView; the reason I didn't make the worksheet itself implementIGridViewCommands, 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 theWorksheetView simply invokes them.

Controller

TheGameController 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, likesalvo mode. I tried extracting thecurrentPlayer/currentTarget and player turn logic into aClassicMode class (implementing anIGameMode interface that an eventualSalvoMode 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 ExplicitPrivate Const Delay As Long = 1200Private player1 As IPlayerPrivate player2 As IPlayerPrivate currentPlayer As IPlayerPrivate currentTarget As IPlayerPrivate currentShip As IShipPrivate view As IGridViewCommandsPrivate WithEvents viewAdapter As GridViewAdapterPublic Sub NewGame(ByVal adapter As GridViewAdapter)    Set viewAdapter = adapter    Set view = adapter    view.OnNewGameEnd SubPrivate 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 IfEnd SubPrivate 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 IfEnd SubPrivate Sub viewAdapter_OnNewGame()    NewGame viewAdapterEnd SubPrivate 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 IfEnd SubPrivate 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 IfEnd SubPrivate 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 IfEnd SubPrivate Sub viewAdapter_OnPlayerReady()    Set currentPlayer = player1    Set currentTarget = player2    If currentPlayer.PlayerType = HumanControlled Then        view.OnBeginAttack    Else        currentPlayer.Play currentTarget.PlayGrid    End IfEnd SubPrivate 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 SubCleanFail:    With Err        If .Number = PlayerGridErrors.KnownGridStateError Then            view.OnKnownPositionAttack        End If    End WithEnd SubPrivate Sub PlayAI()    Debug.Assert currentPlayer.PlayerType <> HumanControlled    Win32API.Sleep Delay    Play currentTarget.PlayGrid.gridId, currentPlayer.Play(currentTarget.PlayGrid)End SubPrivate 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    EndCurrentPlayerTurnEnd SubPrivate 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 PlayAIEnd 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!

askedAug 31, 2018 at 3:42
Mathieu Guindon's user avatar
\$\endgroup\$
9
  • \$\begingroup\$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!\$\endgroup\$CommentedAug 31, 2018 at 4:15
  • \$\begingroup\$I mean I'd say I'mpretty okay with VBA, but all these Battleship posts fly over my head..\$\endgroup\$CommentedAug 31, 2018 at 4:40
  • \$\begingroup\$@Raystafarian I haven't blogged about it yet =) I'mvery 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 actualGameSheet.\$\endgroup\$CommentedAug 31, 2018 at 11:21
  • 1
    \$\begingroup\$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? :-)\$\endgroup\$CommentedAug 31, 2018 at 21:52
  • 2
    \$\begingroup\$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 beIf player1.IsHuman Then. You then encapsulate (hide) some of the workings and more clearly define that as a property of the object.\$\endgroup\$CommentedAug 31, 2018 at 21:55

0

You mustlog in to answer this question.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.