October 2014

Sun Mon Tue Wed Thu Fri Sat
      1 2 3 4
5 6 7 8 9 10 11
12 13 14 15 16 17 18
19 20 21 22 23 24 25
26 27 28 29 30 31  










« No source available when debugging an AutoCAD plug-in | Main | Using the Microsoft Kinect SDK to bring a basic point cloud into AutoCAD »

September 23, 2011

An update to Minesweeper for AutoCAD

Stephen Preston sent me an update to his minesweeper application, some time ago, and it’s been languishing in my inbox until today. Stephen has spent some time polishing the app, adding a more coherent architecture (or so he tells me).

As I’m busy beavering away with the Kinect SDK, I thought I’d go ahead and post the code.

Here is the updated, AutoCAD-specific command class:

Imports Autodesk.AutoCAD.Runtime

Imports Autodesk.AutoCAD.ApplicationServices

Imports Autodesk.AutoCAD.DatabaseServices

Imports Autodesk.AutoCAD.Geometry

Imports Autodesk.AutoCAD.EditorInput

Imports System

Imports System.Collections.Generic

 

' This line is not mandatory, but improves loading performance

 

<Assembly: CommandClass(GetType(Minesweeper.MyCommands))>

 

Namespace Minesweeper

 

  Public Class MyCommands

 

    'This is the main Minesweeper command.

    'It createas a new document, and invokes the worker

    'command(RUNMINESWEEPER) in the new document.

 

    <CommandMethod(

      "SGP_Minesweeper", "MINESWEEPER", "MINESWEEPER",

      CommandFlags.Session

      )>

    Public Shared Sub Minesweeper()

 

      Dim doc As Document = Application.DocumentManager.Add("")

      Application.DocumentManager.MdiActiveDocument = doc

      doc.SendStringToExecute("RUNMINESWEEPER ", True, False, False)

 

    End Sub

 

    'This is the worker command invoked using SendStringToExecute

    'It starts the game running in the new doc created by the

    ' MINESWEEPER command.

    <CommandMethod(

      "SGP_Minesweeper", "RUNMINESWEEPER", CommandFlags.Modal

      )>

    Public Shared Sub RunMinesweeper()

 

      Try

        'Make sure new document has the text style we need

        CreateTextStyle()

        'Instantiate the game controller class and set game running

        Dim cls As New AcadMinesweeper

        cls.DoIt()

      Catch ex As Autodesk.AutoCAD.Runtime.Exception

        Application.DocumentManager.MdiActiveDocument.Editor.

          WriteMessage(vbCrLf &

            "Sorry - An error occurred. Game aborted." & vbCrLf)

      End Try

 

    End Sub

 

 

    'Adds a new text style to the drawing (if not already there)

 

    Private Shared Sub CreateTextStyle()

      Dim db As Database = HostApplicationServices.WorkingDatabase

      Dim tm As Autodesk.AutoCAD.DatabaseServices.TransactionManager

      tm = db.TransactionManager

      Dim myT As Transaction = tm.StartTransaction()

      Try

        Dim st As TextStyleTable =

          CType(

            tm.GetObject(

              db.TextStyleTableId, OpenMode.ForWrite, False),

            TextStyleTable)

        If Not st.Has("MinesweeperStyle") Then

          Dim str As TextStyleTableRecord =

            New TextStyleTableRecord()

          str.Name = "MinesweeperStyle"

          st.Add(str)

          str.FileName = "txt.shx"

          str.TextSize = 1.0

          str.IsShapeFile = True

          tm.AddNewlyCreatedDBObject(str, True)

        End If

        myT.Commit()

      Finally

        myT.Dispose()

      End Try

 

    End Sub

 

  End Class

 

 

  'The MinesweeperMgr class runs the game.

  'AcadMinesweeper instantiates the MinesweeperMgr class and acts as

  ' its input/output. Input is via IMinesweeperInput, output is via

  ' IMinesweeperOutput interfaces.

  'AcadMinesweeper knows about MinesweeperMgr and some structures and

  ' enums we created to communicate with it.

  'MinesweeperMgr knows nothing about AcadMinesweeper or AutoCAD.

 

  Public Class AcadMinesweeper

    Implements IMinesweeperInput, IMinesweeperOutput

 

    'A MineElement links ObjectId of MText representing a mine cell

    ' to the row and column of the mine cell it represents

 

    Private Structure MineElement

      Public Id As ObjectId

      Public Row As Integer

      Public Col As Integer

    End Structure

 

    Private mStartTime As DateTime 'USed to calc total game time.

    Private mMineMgr As MinesweeperMgr 'Our manager class

    Private mMinefield As List(Of MineElement) =

              New List(Of MineElement) ' MineElements in the grid

 

 

    'Main game controller function

 

    Public Sub DoIt()

      Dim ed As Editor =

        Application.DocumentManager.MdiActiveDocument.Editor

 

      'Prompt user for values to setup minefield

 

      If Not PromptSetup() Then

        ed.WriteMessage(

          vbCrLf & "You cancelled setup - aborting command" & vbCrLf)

        Exit Sub

      End If

 

    End Sub

 

    'Set the text for an MText entity with the provided ObjectId

 

    Private Sub SetText(

      ByVal objId As ObjectId, ByVal strText As String)

 

      Dim db As Database =

        Application.DocumentManager.MdiActiveDocument.Database

      Using tr As Transaction =

        db.TransactionManager.StartTransaction

 

        Dim txt As MText = tr.GetObject(objId, OpenMode.ForWrite)

        txt.Contents = strText

        tr.Commit()

      End Using

 

    End Sub

 

    ' Find MineElement with provided ObjectId in our list of all

    ' MineElements. This is how we asociate row and column value

    ' with an MText entity.

 

    Private Function FindInMinefield(

      ByVal objId As ObjectId) As MineElement

 

      For Each elem As MineElement In mMinefield

        If elem.Id = objId Then

          Return elem

        End If

      Next

      'If we didn't find it, we return a blank - calling function

      'should query for null ObjectId

      Return New MineElement

 

    End Function

 

    ' Find MineElement with provided row, col in our list of all

    ' MineElements. This is how we asociate an MText entity

    ' with a row and column value.

 

    Private Function FindInMinefield(

      ByVal row As Integer, ByVal col As Integer) As MineElement

 

      For Each elem As MineElement In mMinefield

        If elem.Row = row And elem.Col = col Then

          Return elem

        End If

      Next

      'If we didn't find it, we return a blank - calling function

      'should query for null ObjectId

      Return New MineElement

 

    End Function

 

    'Prompt user for grid size and number of mines, and pass those

    ' to the MinesweeperMgr to initialize itself.

    'Returns true if setup was successful

    'Returns false if setup was unsuccessful (e.g. cancelled by user)

 

    Private Function PromptSetup() As Boolean

 

      Try

 

        Dim ed As Editor =

          Application.DocumentManager.MdiActiveDocument.Editor

        Dim opts1 As New PromptIntegerOptions(

          "Enter Minefield width:")

        opts1.LowerLimit = 1

        opts1.UpperLimit = 100

        opts1.DefaultValue = 10

        Dim res1 As PromptIntegerResult = ed.GetInteger(opts1)

        If res1.Status <> PromptStatus.OK Then

          Return False

        End If

        Dim rows As Integer = res1.Value

 

        opts1.Message = "Enter minefield height:"

        res1 = ed.GetInteger(opts1)

        If res1.Status <> PromptStatus.OK Then

          Return False

        End If

        Dim cols As Integer = res1.Value

 

        opts1.Message = "Enter number of mines:"

        opts1.UpperLimit =

          rows * cols

        opts1.DefaultValue =

          rows * cols / 6

        res1 = ed.GetInteger(opts1)

        If res1.Status <> PromptStatus.OK Then

          Return False

        End If

        Dim num As Integer = res1.Value

 

        'If we got to here the then user provided all the data needed

        '  to instantiate our MinesweeperMgr class.

        'Instantiating MinesweeperMgr will setup the minefield and

        ' start the game running.

 

        mMineMgr = New MinesweeperMgr(Me, Me, rows, cols, num)

        Return True

 

      Catch ex As Autodesk.AutoCAD.Runtime.Exception

        Return False

      End Try

 

    End Function

 

    'The next two functions are helper functions to zoom to the grid.

    'Code copied from ADN DevNote

 

    Private Sub SetViewportToExtents(

      ByVal db As Database, ByVal vtr As ViewportTableRecord)

 

      'Let's update the database extents first

      'True gives the best fit but will take time

 

      db.UpdateExt(True)

 

      'Get the screen aspect ratio to calculate the height and width

 

      Dim scrRatio As Double = (vtr.Width / vtr.Height)

 

      'Prepare Matrix for DCS to WCS transformation

 

      Dim matWCS2DCS As Matrix3d =

        Matrix3d.PlaneToWorld(vtr.ViewDirection)

 

      'For DCS target point is the origin

 

      matWCS2DCS =

        Matrix3d.Displacement(vtr.Target - Point3d.Origin) *

        matWCS2DCS

 

      'WCS Xaxis is twisted by twist angle

 

      matWCS2DCS =

        Matrix3d.Rotation(

          -vtr.ViewTwist, vtr.ViewDirection, vtr.Target) *

        matWCS2DCS

      matWCS2DCS = matWCS2DCS.Inverse()

 

      'Tranform the extents to the DCS defined by the viewdir

 

      Dim extents As New Extents3d(db.Extmin, db.Extmax)

      extents.TransformBy(matWCS2DCS)

 

      'Width of the extents in current view

 

      Dim width As Double =

        (extents.MaxPoint.X - extents.MinPoint.X)

 

      'Height of the extents in current view

 

      Dim height As Double =

        (extents.MaxPoint.Y - extents.MinPoint.Y)

 

      'Get the view center point

 

      Dim center As New Point2d(

        (extents.MaxPoint.X + extents.MinPoint.X) * 0.5,

        (extents.MaxPoint.Y + extents.MinPoint.Y) * 0.5)

 

      'Check if the width 'fits' in current window

      'If not then get the new height as per the viewport's

      'aspect(ratio)

 

      If width > (height * scrRatio) Then

        height = width / scrRatio

      End If

      vtr.Height = height

      vtr.Width = height * scrRatio

      vtr.CenterPoint = center

      vtr.IconEnabled = False

    End Sub

 

    Private Sub ModelZoomExtents()

      Dim doc As Document =

        Application.DocumentManager.MdiActiveDocument

      Dim db As Database = doc.Database

      Dim ed As Editor = doc.Editor

      Using Tx As Transaction =

        db.TransactionManager.StartTransaction()

 

        ed.UpdateTiledViewportsInDatabase()

        Dim viewportTableRec As ViewportTableRecord =

          TryCast(

            Tx.GetObject(

              ed.ActiveViewportId, OpenMode.ForWrite),

            ViewportTableRecord)

        SetViewportToExtents(db, viewportTableRec)

        ed.UpdateTiledViewportsFromDatabase()

        Tx.Commit()

      End Using

    End Sub

 

    'Create a new MText entity to represent a cell at position

    ' (row, col), add it to the database and store its ObjectID and

    ' position in our list of MineElements

 

    Private Sub CreateNewCell(ByVal cell As MineCell,

                              ByVal row As Integer,

                              ByVal col As Integer)

      Dim db As Database =

        Application.DocumentManager.MdiActiveDocument.Database

      Using tr As Transaction =

          db.TransactionManager.StartTransaction

 

        Dim tst As TextStyleTable =

          tr.GetObject(db.TextStyleTableId, OpenMode.ForRead)

        Dim textStyleId As ObjectId = tst.Item("MinesweeperStyle")

        Dim btr As BlockTableRecord =

          CType(

            tr.GetObject(

              SymbolUtilityServices.GetBlockModelSpaceId(db),

              OpenMode.ForWrite),

            BlockTableRecord)

 

        Using txt As MText = New MText

          txt.SetDatabaseDefaults()

          txt.TextStyleId = textStyleId

          txt.Location = New Point3d(row, col, 0)

          txt.Width = 1.0

          txt.Height = 1.0

          txt.TextHeight = 0.8

          txt.Attachment = AttachmentPoint.MiddleCenter

          Dim elem As New MineElement

          elem.Row = row

          elem.Col = col

          elem.Id = btr.AppendEntity(txt)

          tr.AddNewlyCreatedDBObject(txt, True)

          mMinefield.Add(elem)

          txt.Contents = "X"

        End Using

        tr.Commit()

      End Using

    End Sub

 

#Region "IMinesweeperInput methods"

 

    Public Function GetAction() As MinesweeperAction _

      Implements IMinesweeperInput.GetAction

 

      'bMarking governs behavior depending on whether we're

      'clearing mines or marking them

 

      Static bMarking As Integer

      Dim strMsg As String = ""

      Dim strKeyword As String = ""

 

      'Setup prompts and keywords according to bMarking

 

      Do

 

        Select Case bMarking

          Case False

            strMsg = "Select a cell to uncover:"

            strKeyword = "Mark"

          Case True

            strMsg = "Select a cell to mark/unmark:"

            strKeyword = "Uncover"

        End Select

 

        'Prompt user to perform action

 

        Dim ed As Editor =

          Application.DocumentManager.MdiActiveDocument.Editor

        Dim opts As New PromptEntityOptions(vbCrLf & strMsg)

        opts.Keywords.Add(strKeyword)

        opts.AppendKeywordsToMessage = True

        opts.AllowNone = True

        Dim res As PromptEntityResult = ed.GetEntity(opts)

 

        'If user cancelled the command prompt then we end the game.

 

        If res.Status = PromptStatus.Cancel Then

          ed.WriteMessage(

            vbCrLf & "You cancelled the game. Byeee!" & vbCrLf)

 

          Return New MinesweeperAction(GameAction.CancelGame, 0, 0)

        End If

 

        'If user entered keyword, then we're toggling between

        ' mine clearing and mine marking

 

        If res.Status = PromptStatus.Keyword Then

 

          Select Case res.StringResult

            Case "Mark"

              bMarking = True

            Case Else

              bMarking = False

          End Select

 

          'If user selected an entity (which must be MText

          ' because this is a new document, and that's all

          ' we added to it), then we use the ObjectId to

          ' retrieve its row and column in the grid.

 

        ElseIf res.Status = PromptStatus.OK Then

 

          Dim elem As MineElement = FindInMinefield(res.ObjectId)

          'This next if statement should never be executed.

          If elem.Id = ObjectId.Null Then

            ed.WriteMessage(

              vbCrLf & "You didn't select a cell in the minefield." &

              vbCrLf)

 

          Else

 

            If bMarking Then 'If we're marking cells ...

              Return New MinesweeperAction(GameAction.Mark,

                                           elem.Row, elem.Col)

            Else ' If we're uncovering cells

              Return New MinesweeperAction(GameAction.Uncover,

                                           elem.Row, elem.Col)

            End If

          End If

 

        End If

      Loop Until False

 

    End Function

 

#End Region

 

#Region "IMinesweeperOutput methods"

 

    'MinesweeperMgr tells us the game has started. Zoom minefield to

    ' fill screen and record start time.

 

    Public Sub StartGame() Implements IMinesweeperOutput.StartGame

 

      ModelZoomExtents()

      mStartTime = DateTime.Now

 

    End Sub

 

    'MinesweeperMgr tells us the game has ended (and if player won).

    'Notify player accordingly.

 

    Public Sub EndGame(ByVal won As Boolean) _

      Implements IMinesweeperOutput.EndGame

 

      Dim ed As Autodesk.AutoCAD.EditorInput.Editor

      ed = Application.DocumentManager.MdiActiveDocument.Editor

      Dim timeInterval As TimeSpan = DateTime.Now - mStartTime

      If won Then

        ed.WriteMessage(vbCrLf &

                      "Congratulations - you cleared all the mines")

      Else

        ed.WriteMessage(vbCrLf & "Game over - You hit a mine!")

      End If

      ed.WriteMessage(

        vbCrLf & "Time taken = " & timeInterval.TotalSeconds &

        " seconds" & vbCrLf)

 

    End Sub

 

    'MinesweeperMgr is telling us to update our grid UI

 

    Public Function SetCell(ByVal cell As MineCell,

                             ByVal row As Integer,

                             ByVal col As Integer) As Boolean _

      Implements IMinesweeperOutput.SetCell

 

      Try

 

        ' Find the Mtext corresponding to cell's location

 

        Dim elem As MineElement = FindInMinefield(row, col)

 

        'If Mtext not created yet, then we create it

 

        If elem.Id = ObjectId.Null Then

          CreateNewCell(cell, row, col)

        Else 'We change its text to show the new status

          Select Case cell.Status

            Case CellStatus.Marked

              SetText(elem.Id, "M")

            Case CellStatus.Uncovered

              If cell.isBomb Then

                SetText(elem.Id, "*")

              Else

                SetText(elem.Id, cell.Value.ToString)

              End If

            Case CellStatus.Covered

              SetText(elem.Id, "X")

          End Select

        End If

        Return True

      Catch ex As Autodesk.AutoCAD.Runtime.Exception

        Return False

      End Try

 

    End Function

 

    'Called by MinesweeperMgr if there's an error it can't handle.

    'Just tell the player there's a problem.

 

    Public Sub FatalError() Implements IMinesweeperOutput.FatalError

 

      Dim ed As Autodesk.AutoCAD.EditorInput.Editor

      ed = Application.DocumentManager.MdiActiveDocument.Editor

      ed.WriteMessage(vbCrLf & _

        "Minesweeepr has encountered a problem and can't continue." _

        & vbCrLf)

 

    End Sub

 

#End Region

 

  End Class

 

End Namespace

And here is the updated, application-independent manager class:

Namespace Minesweeper

 

  'Interfaces that host app must implement to manage Minesweeper UI

 

#Region "Interface Definitions"

 

  'Provide input required by MinesweeperMgr

 

  Public Interface IMinesweeperInput

    'Requests host to get next game action

    ' e.g. Mark/Unmark/Uncover cell

    Function GetAction() As MinesweeperAction

  End Interface

 

  'Process output from MinesweeperMgr

 

  Public Interface IMinesweeperOutput

    'Tell host game is starting

    Sub StartGame()

    'Tell host when game is won or lost

    Sub EndGame(ByVal won As Boolean)

    'Tell host to update the value of a cell in the UI. Host returns

    ' false if it coouldn't update the cell.

    Function SetCell(ByVal cell As MineCell, ByVal row As Integer,

                     ByVal col As Integer) As Boolean

    'Tell host if there's an irrecoverable error

    Sub FatalError()

  End Interface

 

#End Region

 

  'Used by MinesweeperMgr internal error handling

 

  Public Class MinesweeperException

    Inherits Exception

  End Class

 

  'Used by MinesweeperAction to pass action type

 

  Public Enum GameAction

    Uncover

    Mark

    CancelGame

  End Enum

 

  'Used by host to provide input to MinesweeeprMgr -

  ' action type, and (row, col) of cell to act on.

 

  Public Structure MinesweeperAction

 

    Public Action As GameAction

    Public Row As Integer

    Public Col As Integer

 

    Public Sub New(ByVal act As GameAction, ByVal r As Integer,

                   ByVal c As Integer)

 

      Action = act

      Row = r

      Col = c

 

    End Sub

 

  End Structure

 

#Region "Enums and structures shared by MinesweeperMgr and host"

 

  'Used in MineCell structure to represent status of cell

 

  Public Enum CellStatus

    Covered

    Uncovered

    Marked

  End Enum

 

  'Represents a cell in the minefield (grid)

 

  Public Structure MineCell

 

    Public Status As CellStatus 'Covered/Uncovered/Marked

    Public Value As Integer 'No of neighboring cells containing bombs

    Public isBomb As Boolean 'Is this cell a bomb?

 

    Public Sub New(ByVal stat As CellStatus, ByVal val As Integer,

                    ByVal bomb As Boolean, ByVal marked As Boolean)

 

      Status = stat

      isBomb = bomb

      Value = val

 

    End Sub

 

  End Structure

 

#End Region

 

#Region "MinesweeperMgr class"

 

  Public Class MinesweeperMgr

 

    Private mRows As Integer 'Rows in grid

    Private mCols As Integer 'Columns in grid

    Private mMineArray(,) As MineCell 'The grid

    Private mNumMines As Integer 'Number of mines hidden in grid

    Private mNumCellsUncovered 'Number of cells currently uncovered

    Private mInputInterface As IMinesweeperInput

    Private mOutputInterface As IMinesweeperOutput

 

 

    'Instantiating MinesweeperMgr will initialize the game

    ' and set it running. The class is meant to be used once and then

    ' discarded. Instantiate a new class to start a new game.

    'The host application must provide the input and output for this

    ' class by implementing the IMinesweeperInput

    ' and IMinesweeperOutput interfaces. Input and output have been

    ' kept separate so  different classes can be used for each

    ' if required.

    'MinesweeperMgr doen't know anything about how the host app

    ' handles its input/output requests.

 

    Public Sub New(ByRef inputInterface As IMinesweeperInput,

                   ByRef outputInterface As IMinesweeperOutput,

                   ByVal rows As Integer, ByVal cols As Integer,

                   ByVal num As Integer)

 

      mInputInterface = inputInterface

      mOutputInterface = outputInterface

      InitMinefield(rows, cols, num)

      GameLoop()

 

    End Sub

 

 

    Private ReadOnly Property NumCellsUncovered() As Integer

      Get

        Return mNumCellsUncovered

      End Get

    End Property

 

    Private Function IncrementNumCellsUncovered() As Integer

      mNumCellsUncovered = mNumCellsUncovered + 1

      Return mNumCellsUncovered

    End Function

 

    Private Property MinefieldRows() As Integer

      Get

        Return mRows

      End Get

      Set(ByVal value As Integer)

        If value > 0 Then

          mRows = value

          If NumMines > mRows * MinefieldColumns Then

            NumMines = mRows * MinefieldColumns

          End If

        Else

          Throw New MinesweeperException

        End If

      End Set

    End Property

 

    Private Property MinefieldColumns() As Integer

      Get

        Return mCols

      End Get

      Set(ByVal value As Integer)

        If value > 0 Then

          mCols = value

          If NumMines > MinefieldRows * mCols Then

            NumMines = MinefieldRows * mCols

          End If

        Else

          Throw New MinesweeperException

        End If

      End Set

    End Property

 

    Private Property NumMines() As Integer

      Get

        Return mNumMines

      End Get

      Set(ByVal value As Integer)

        If mNumMines <= (mCols * mRows) Then

          mNumMines = value

        Else

          mNumMines = mCols * mRows

        End If

      End Set

    End Property

 

    'Private ReadOnly Property MineArray() As MineCell(,)

    '  Get

    '    Return mMineArray

    '  End Get

    'End Property

 

 

    'Uncover cell at specified location.

    'Returns true if uncovered cell  is a mine.

 

    Private Function UncoverCell(

      ByVal row As Integer, ByVal col As Integer) As Boolean

 

      'Only process covered cells- not marked ones

      '(Player would be annoyed if they accidentally cleared a

      '  marked cell)

      If mMineArray(row, col).Status = CellStatus.Covered Then

        mMineArray(row, col).Status = CellStatus.Uncovered

        If Not mOutputInterface.SetCell(mMineArray(row, col),

                                        row, col) Then

          Throw New MinesweeperException

        End If

        IncrementNumCellsUncovered()

        ' If its a bomb, tell host the player lost

        If mMineArray(row, col).isBomb Then

          mOutputInterface.EndGame(False)

          Return True

          'If you cleared everything except the bombs,

          ' tell host the player won

        ElseIf AllEmptyCellsUncovered() Then

          '

          mOutputInterface.EndGame(True)

          Return True

        End If

      End If

      Return False

 

    End Function

 

    'Toggle cell between Covered and Marked Status.

    'Ignores Uncovered cells.

 

    Private Sub MarkCell(

      ByVal row As Integer, ByVal col As Integer)

 

      If mMineArray(row, col).Status = CellStatus.Covered Then

        mMineArray(row, col).Status = CellStatus.Marked

      ElseIf mMineArray(row, col).Status = CellStatus.Marked Then

        mMineArray(row, col).Status = CellStatus.Covered

      End If

      If Not mOutputInterface.SetCell(mMineArray(row, col),

                                      row, col) Then

        Throw New MinesweeperException

      End If

 

    End Sub

 

 

    'Returns true if we've cleared all our non-mine cells

 

    Private Function AllEmptyCellsUncovered() As Boolean

 

      If NumCellsUncovered =

         MinefieldColumns * MinefieldRows - NumMines Then

        Return True

      Else

        Return False

      End If

 

    End Function

 

 

    Private Sub ResetNumCellsUncovered()

 

      mNumCellsUncovered = 0

 

    End Sub

 

    'Initialize grid, and put the mines in random locations

 

    Private Sub InitMinefield(

      ByVal rows As Integer, ByVal cols As Integer,

      ByVal num As Integer)

 

      Try

 

 

        If rows < 1 Or cols < 1 Or num < 1 Then

          Throw New MinesweeperException

        End If

 

        MinefieldRows = rows

        MinefieldColumns = cols

        If num > rows * cols Then

          NumMines = rows * cols

        Else

          NumMines = num

        End If

 

        'Initialize grid (array) to represent minefield

 

        ResetNumCellsUncovered()

        ReDim mMineArray(rows - 1, cols - 1)

 

        ' Add mines to grid (value of -1 means a mine is at

        ' that location)

 

        Randomize()

        Dim i As Integer = 0

        Do

          Dim rndRow As Integer = Rnd() * (MinefieldRows - 1)

          Dim rndCol As Integer = Rnd() * (MinefieldColumns - 1)

          If mMineArray(rndRow, rndCol).isBomb = False Then

            mMineArray(rndRow, rndCol).Value = -1

            mMineArray(rndRow, rndCol).isBomb = True

            mMineArray(rndRow, rndCol).Status = CellStatus.Covered

            i = i + 1

          End If

        Loop While i < num

 

        ' Now mines are added, we populate the rest of the grid

        ' with the numbers to indicate how many mines are in

        ' neighbouring(cells)

 

        For i = 0 To MinefieldRows - 1

          For j As Integer = 0 To MinefieldColumns - 1

 

 

            ' If this cell contains a mine then don't process it

 

            If Not mMineArray(i, j).isBomb = True Then

 

              Dim mineCounter As Integer = 0

 

              'Check grid cells around this one looking for mines ...

              ' i-1,j-1 | i,j-1 | i+1,j-1

              '   i-1,j |  i,j  | i+1,j

              ' i-1,j+1 | i,j+1 | i+1,j+1

 

              For k As Integer = -1 To 1

                For l As Integer = -1 To 1

 

                  ' Skip over cells outside bounds of minefield

 

                  If (i + k < 0) Or (i + k > MinefieldRows - 1) Or

                   (j + l < 0) Or (j + l > MinefieldColumns - 1) Then

 

                    Continue For

                  End If

                  'Don't include cell (i,j)

                  If k = 0 And l = 0 Then

                    Continue For

                  End If

                  If mMineArray(i + k, j + l).isBomb = True Then

                    mineCounter = mineCounter + 1

                  End If

                Next

              Next

              mMineArray(i, j).Value = mineCounter

              mMineArray(i, j).Status = CellStatus.Covered

            End If

            If Not mOutputInterface.SetCell(mMineArray(i, j),

                                            i, j) Then

              Throw New MinesweeperException

            End If

          Next

        Next

 

      Catch ex As MinesweeperException

        mOutputInterface.FatalError()

      End Try

 

    End Sub

 

    'This is the main game loop. It requests input from the host,

    ' acts on the input, updates its own data, and tells host to

    ' update its UI to reflect the change.

 

    Private Sub GameLoop()

 

      Dim bGameOver As Boolean

 

      'Tell host game is starting

      mOutputInterface.StartGame()

 

      Try

 

        'Loop until game ends or is cancelled. Possible input is

        ' Uncover a cell, toggles Mark on a cell, Cancel the game.

 

        Do

          Dim act As MinesweeperAction = mInputInterface.GetAction

          ValidateAction(act)

          Select Case act.Action

            Case GameAction.Uncover

              bGameOver = UncoverCell(act.Row, act.Col)

            Case GameAction.Mark

              MarkCell(act.Row, act.Col)

            Case GameAction.CancelGame

              bGameOver = True

          End Select

 

        Loop Until bGameOver

 

      Catch ex As MinesweeperException

        mOutputInterface.FatalError()

      End Try

 

 

    End Sub

 

    'Throws an exception if (act.Row, act.Col) is outside grid

    Private Sub ValidateAction(ByVal act As MinesweeperAction)

 

      If act.Row < 0 Or act.Row >= MinefieldRows Then

        Throw New MinesweeperException

      End If

      If act.Col < 0 Or act.Col >= MinefieldColumns Then

        Throw New MinesweeperException

      End If

 

    End Sub

 

  End Class

 

#End Region

 

End Namespace

I won’t go ahead and show the code running here – please see the previous post to get a feel for how it works.

blog comments powered by Disqus

Feed/Share

10 Random Posts