Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- '@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
- '@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
- '@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
- '@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
- '@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
- '@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
- '@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
Add Comment
Please, Sign In to add comment