User:Pluke/mines
Jump to navigation
Jump to search
CC3.0 from http://community.computingatschool.org.uk/resources/301
Imports System.Console
Module minesweeper
Const gridSize = 6
Const CellSizeMax = 6 'use range of 1 to 6
Const maxTries = gridSize * gridSize - gridSize
Dim rnd As New Random
Dim debug As Boolean = False 'turn on to see values as you play
Enum ecell
empty = 0
mine = 9
flag = 10
End Enum
Structure cell
Dim contents As ecell
Dim revealed As Boolean
End Structure
Structure point
Dim x As Integer
Dim y As Integer
End Structure
Dim colourmap() As Integer = {ConsoleColor.Blue,
ConsoleColor.DarkMagenta,
ConsoleColor.Magenta,
ConsoleColor.DarkRed,
ConsoleColor.Red,
ConsoleColor.Red,
ConsoleColor.Red,
ConsoleColor.Red,
ConsoleColor.Red,
ConsoleColor.Red,
ConsoleColor.Yellow}
Sub Main()
Dim quit As Boolean = False
Dim choice As point
Dim complete As Boolean = True
Dim cellsize = CellSizeMax
Dim placedmines = gridSize - 1
Dim tries As Integer = maxtries
Dim score As Integer = 0
Dim grid(gridSize, gridSize) As cell
Console.Title = "Console Minesweeper"
Console.WindowWidth = ((gridSize - 1) * CellSizeMax) + 9
Console.WindowHeight = ((gridSize - 1) * CellSizeMax) + 13
Console.CursorVisible = False
'main loop
Do
placedmines = clearGrid(grid, gridSize - 1)
drawGrid(grid)
tries = maxTries
Do
SetCursorPosition(3, ((gridSize - 1) * CellSizeMax) + 9)
BackgroundColor = ConsoleColor.Black
ForegroundColor = ConsoleColor.White
WriteLine("Goes left : {0} Score : {1} ", tries, score)
choice = getuserinput()
complete = testChoice(grid, choice)
If testwin(grid, placedmines) Then
complete = True
showremainingcells(grid)
SetCursorPosition(3, ((gridSize - 1) * CellSizeMax) + 11)
score += gridSize ^ 2
WriteLine("You have won. press anykey")
Else
'If tries <= 0 And complete = False Then
' complete = True
' 'run out of goes
'End If
End If
tries -= 1
Loop Until complete
ReadKey()
Loop Until quit
End Sub
Function getuserinput() As point
Dim pt As point
Dim complete As Boolean = False
Dim str As String
Do
SetCursorPosition(3, ((gridSize - 1) * CellSizeMax) + 11)
BackgroundColor = ConsoleColor.Black
ForegroundColor = ConsoleColor.White
Write("Enter coords XY : ")
CursorVisible = True
Try
str = ReadLine()
If Val(str(0)) > -1 And Val(str(0)) < gridSize And Val(str(1)) > -1 And Val(str(1)) < gridSize Then
pt.x = Val(str(0))
pt.y = Val(str(1))
complete = True
End If
Catch ex As Exception
End Try
Loop Until complete
CursorVisible = False
SetCursorPosition(3, ((gridSize - 1) * CellSizeMax) + 11)
WriteLine(" ")
Return pt
End Function
Function clearGrid(ByRef grid(,) As cell, ByVal mines As Integer) As Integer
Dim i, j, placedmines As Integer
For i = 0 To gridSize - 1
For j = 0 To gridSize - 1
grid(i, j).contents = ecell.empty
grid(i, j).revealed = False
Next
Next
For i = 0 To mines - 2
grid(rnd.Next(0, gridSize), rnd.Next(0, gridSize)).contents = ecell.mine
Next
'populate grid with numbers
'look at each grid point
For i = 0 To gridSize - 1
For j = 0 To gridSize - 1
'look at its surrounding 8 cells, if possible
If Not grid(i, j).contents = ecell.mine Then
Dim mineCount = 0
'look up one row
If j > 0 Then
If i > 0 Then
If grid(i - 1, j - 1).contents = ecell.mine Then mineCount += 1
End If
If grid(i, j - 1).contents = ecell.mine Then mineCount += 1
If i < 10 Then
If grid(i + 1, j - 1).contents = ecell.mine Then mineCount += 1
End If
End If
'look at current row
If i > 0 Then
If grid(i - 1, j).contents = ecell.mine Then mineCount += 1
End If
If i < 10 Then
If grid(i + 1, j).contents = ecell.mine Then mineCount += 1
End If
'look at row below
If j < 10 Then
If i > 0 Then
If grid(i - 1, j + 1).contents = ecell.mine Then mineCount += 1
End If
If grid(i, j + 1).contents = ecell.mine Then mineCount += 1
If i < 10 Then
If grid(i + 1, j + 1).contents = ecell.mine Then mineCount += 1
End If
End If
grid(i, j).contents = mineCount
Else
placedmines += 1
End If
Next
Next
BackgroundColor = ConsoleColor.Black
Clear()
Return placedmines
End Function
Sub drawGrid(ByRef grid(,) As cell)
Dim i, j As Integer
'draw grid numbers
Console.BackgroundColor = ConsoleColor.Black
Console.ForegroundColor = ConsoleColor.White
For i = 0 To gridSize - 1
SetCursorPosition(3 + (CellSizeMax * (i + 0)), 1)
Write(i)
SetCursorPosition(1, 3 + (CellSizeMax * (i + 0)))
Write(i)
Next
For i = 0 To gridSize - 1
For j = 0 To gridSize - 1
drawsquare(i * CellSizeMax, j * CellSizeMax, CellSizeMax, CellSizeMax, grid(i, j))
Next
Next
End Sub
Sub drawsquare(ByVal x As Integer, ByVal y As Integer, ByVal w As Integer, ByVal h As Integer, ByVal c As cell)
Dim i, j As Integer
If c.revealed = False Then
BackgroundColor = ConsoleColor.Gray
Else
BackgroundColor = colourmap(c.contents)
End If
For i = 0 To w - 1
For j = 0 To h - 1
SetCursorPosition(x + i + 3, y + j + 3)
Write(" ")
Next
SetCursorPosition(x + 3, y + 3)
Select Case c.contents
Case Is = ecell.empty
'nothing to write
Case Is = ecell.mine
ForegroundColor = ConsoleColor.Black
If debug Or c.revealed Then
Write("X")
End If
Case Else
ForegroundColor = ConsoleColor.White
If debug Or c.revealed Then
Write(c.contents)
End If
End Select
Next
End Sub
Function testChoice(ByRef grid(,) As cell, ByVal x As Integer, ByVal y As Integer) As Boolean
Dim pt As point
pt.x = x
pt.y = y
Return testChoice(grid, pt)
End Function
Function testChoice(ByRef grid(,) As cell, ByVal pt As point) As Boolean
'split
Dim x, y, i As Integer
Dim complete As Boolean = False
Dim won As Boolean = False
Dim alive As Boolean = True
x = pt.x
y = pt.y
'reveal choice
grid(x, y).revealed = True
drawsquare(x * CellSizeMax, y * CellSizeMax, CellSizeMax, CellSizeMax, grid(x, y))
'test if you hit a mine
Select Case grid(pt.x, pt.y).contents
Case Is = ecell.empty
'cascade or add number
'look up one row
If y > 0 Then
If x > 0 Then
If grid(x - 1, y - 1).contents = ecell.empty And grid(x - 1, y - 1).revealed = False Then testChoice(grid, x - 1, y - 1)
End If
If grid(x, y - 1).contents = ecell.empty And grid(x, y - 1).revealed = False Then testChoice(grid, x, y - 1)
If x < gridSize - 1 Then
If grid(x + 1, y - 1).contents = ecell.empty And grid(x + 1, y - 1).revealed = False Then testChoice(grid, x + 1, y - 1)
End If
End If
'look at current row
If x > 0 Then
If grid(x - 1, y).contents = ecell.empty And grid(x - 1, y).revealed = False Then testChoice(grid, x - 1, y)
End If
If x < gridSize - 1 Then
If grid(x + 1, y).contents = ecell.empty And grid(x + 1, y).revealed = False Then testChoice(grid, x + 1, y)
End If
'look at row below
If y < gridSize - 1 Then
If i > 0 Then
If grid(x - 1, y + 1).contents = ecell.empty And grid(x - 1, y + 1).revealed = False Then testChoice(grid, x - 1, y + 1)
End If
If grid(x, y + 1).contents = ecell.empty And grid(x, y + 1).revealed = False Then testChoice(grid, x, y + 1)
If x < gridSize - 1 Then
If grid(x + 1, y + 1).contents = ecell.empty And grid(x + 1, y + 1).revealed = False Then testChoice(grid, x + 1, y + 1)
End If
End If
alive = True
complete = False
Case 1 To 8
alive = True
complete = False
Case Is = ecell.mine
alive = False
complete = True
showremainingcells(grid)
SetCursorPosition(3, ((gridSize - 1) * CellSizeMax) + 11)
Beep(600, 100)
Beep(550, 100)
Beep(500, 100)
Beep(450, 150)
Beep(400, 150)
Beep(350, 150)
WriteLine("You hit a mine. press anykey")
End Select
Return complete
End Function
Sub showremainingcells(ByRef grid(,) As cell)
Dim i, j As Integer
For i = 0 To gridSize - 1
For j = 0 To gridSize - 1
If Not grid(i, j).revealed = True Then
grid(i, j).revealed = True
drawsquare(i * CellSizeMax, j * CellSizeMax, CellSizeMax, CellSizeMax, grid(i, j))
End If
Next
Next
End Sub
Function testwin(ByRef grid(,) As cell, ByVal placedmines As Integer) As Boolean
Dim win As Boolean = False
Dim minecount As Integer = 0
Dim coveredcount As Integer = 0
'if only uncovered mines remain
For i = 0 To gridSize - 1
For j = 0 To gridSize - 1
If grid(i, j).contents = ecell.mine And grid(i, j).revealed = False Then
minecount += 1
End If
If grid(i, j).revealed = False Then
coveredcount += 1
End If
Next
Next
If minecount = placedmines And coveredcount = placedmines Then
win = True
Beep(600, 100)
Beep(600, 100)
Beep(600, 100)
Beep(670, 150)
Beep(600, 150)
Beep(670, 150)
Beep(670, 350)
End If
Return win
End Function
End Module