mirror of
https://github.com/coding-horror/basic-computer-games.git
synced 2025-12-21 23:00:43 -08:00
296 lines
11 KiB
VB.net
296 lines
11 KiB
VB.net
Imports System
|
|
|
|
Module Program
|
|
|
|
Enum Directions
|
|
SolveAndReset = 0
|
|
Left = 1
|
|
Up = 2
|
|
Right = 3
|
|
Down = 4
|
|
End Enum
|
|
|
|
'Program State
|
|
Dim Width As Integer = 0, Height As Integer = 0, Q As Integer = 0, CellsVisited As Integer = 2, curCol As Integer, curRow As Integer = 1
|
|
Dim SolutionCompleted As Boolean = False
|
|
Dim CellVisitHistory(,) As Integer
|
|
Dim CellState(,) As Integer
|
|
|
|
Dim rnd As New Random()
|
|
|
|
Public ReadOnly Property BlockedLeft As Boolean
|
|
Get
|
|
Return curCol - 1 = 0 OrElse CellVisitHistory(curCol - 1, curRow) <> 0
|
|
End Get
|
|
End Property
|
|
Public ReadOnly Property BlockedAbove As Boolean
|
|
Get
|
|
Return curRow - 1 = 0 OrElse CellVisitHistory(curCol, curRow - 1) <> 0
|
|
End Get
|
|
End Property
|
|
Public ReadOnly Property BlockedRight As Boolean
|
|
Get
|
|
Return curCol = Width OrElse CellVisitHistory(curCol + 1, curRow) <> 0
|
|
End Get
|
|
End Property
|
|
'Note: "BlockedBelow" does NOT include checking if we have a solution!
|
|
Public ReadOnly Property BlockedBelow As Boolean
|
|
Get
|
|
Return curRow = Height OrElse CellVisitHistory(curCol, curRow + 1) <> 0
|
|
End Get
|
|
End Property
|
|
Public ReadOnly Property OnBottomRow As Boolean
|
|
Get
|
|
Return curRow.Equals(Height)
|
|
End Get
|
|
End Property
|
|
|
|
Sub Main(args As String())
|
|
Const header As String =
|
|
" AMAZING PROGRAM
|
|
CREATIVE COMPUTING MORRISTOWN, NEW JERSEY
|
|
|
|
|
|
|
|
"
|
|
Console.WriteLine(header)
|
|
|
|
While Width <= 1 OrElse Height <= 1
|
|
Console.Write("WHAT ARE YOUR WIDTH AND LENGTH? ")
|
|
|
|
'We no longer have the old convenient INPUT command, so need to parse out the inputs
|
|
Dim parts = Console.ReadLine().Split(","c).Select(Function(s) Convert.ToInt32(s.Trim())).ToList()
|
|
Width = parts(0)
|
|
Height = parts(1)
|
|
|
|
If Width <= 1 OrElse Height <= 1 Then Console.WriteLine($"MEANINGLESS DIMENSIONS. TRY AGAIN.{vbCrLf}")
|
|
End While
|
|
|
|
ReDim CellVisitHistory(Width, Height), CellState(Width, Height)
|
|
|
|
Console.WriteLine("
|
|
|
|
")
|
|
|
|
curCol = rnd.Next(1, Width + 1) 'Starting X position
|
|
CellVisitHistory(curCol, 1) = 1
|
|
Dim startXPos As Integer = curCol 'we need to know this at the end to print opening line
|
|
|
|
Dim keepGoing As Boolean = True
|
|
While keepGoing
|
|
If BlockedLeft Then
|
|
keepGoing = ChoosePath_BlockedToTheLeft()
|
|
ElseIf BlockedAbove Then
|
|
keepGoing = ChoosePath_BlockedAbove()
|
|
ElseIf BlockedRight Then
|
|
keepGoing = ChoosePath_BlockedToTheRight()
|
|
Else
|
|
keepGoing = SelectRandomDirection(Directions.Left, Directions.Up, Directions.Right) 'Go anywhere but down
|
|
End If
|
|
End While
|
|
|
|
PrintFinalResults(startXPos)
|
|
End Sub
|
|
|
|
Public Sub ResetCurrentPosition()
|
|
Do
|
|
If curCol <> Width Then 'not at the right edge
|
|
curCol += 1
|
|
ElseIf curRow <> Height Then 'not at the bottom
|
|
curCol = 1
|
|
curRow += 1
|
|
Else
|
|
curCol = 1
|
|
curRow = 1
|
|
End If
|
|
Loop While CellVisitHistory(curCol, curRow) = 0
|
|
End Sub
|
|
|
|
Dim methods() As Func(Of Boolean) = {AddressOf MarkSolvedAndResetPosition, AddressOf GoLeft, AddressOf GoUp, AddressOf GoRight, AddressOf GoDown}
|
|
Public Function SelectRandomDirection(ParamArray possibles() As Directions) As Boolean
|
|
Dim x As Integer = rnd.Next(0, possibles.Length)
|
|
Return methods(possibles(x))()
|
|
End Function
|
|
|
|
Public Function ChoosePath_BlockedToTheLeft() As Boolean
|
|
If BlockedAbove Then
|
|
If BlockedRight Then
|
|
If curRow <> Height Then
|
|
If CellVisitHistory(curCol, curRow + 1) <> 0 Then ' Can't go down, but not at the edge...blocked. Reset and try again
|
|
ResetCurrentPosition()
|
|
Return True
|
|
Else
|
|
Return GoDown()
|
|
End If
|
|
ElseIf SolutionCompleted Then 'Can't go Down (there's already another solution)
|
|
ResetCurrentPosition()
|
|
Return True
|
|
Else 'Can't go LEFT, UP, RIGHT, or DOWN, but we're on the bottom and there's no solution yet
|
|
Return MarkSolvedAndResetPosition()
|
|
End If
|
|
ElseIf BlockedBelow Then
|
|
Return GoRight()
|
|
ElseIf Not OnBottomRow Then
|
|
Return SelectRandomDirection(Directions.Right, Directions.Down)
|
|
ElseIf SolutionCompleted Then 'Can only go right, and we're at the bottom
|
|
Return GoRight()
|
|
Else 'Can only go right, we're at the bottom, and there's not a solution yet
|
|
Return SelectRandomDirection(Directions.Right, Directions.SolveAndReset)
|
|
End If
|
|
'== Definitely can go Up ==
|
|
ElseIf BlockedRight Then
|
|
If BlockedBelow Then
|
|
Return GoUp()
|
|
ElseIf Not OnBottomRow Then
|
|
Return SelectRandomDirection(Directions.Up, Directions.Down)
|
|
ElseIf SolutionCompleted Then 'We're on the bottom row, can only go up
|
|
Return GoUp()
|
|
Else 'We're on the bottom row, can only go up, but there's no solution
|
|
Return SelectRandomDirection(Directions.Up, Directions.SolveAndReset)
|
|
End If
|
|
'== Definitely can go Up and Right ==
|
|
ElseIf BlockedBelow Then
|
|
Return SelectRandomDirection(Directions.Up, Directions.Right)
|
|
ElseIf Not OnBottomRow Then
|
|
Return SelectRandomDirection(Directions.Up, Directions.Right, Directions.Down)
|
|
ElseIf SolutionCompleted Then 'at the bottom, but already have a solution
|
|
Return SelectRandomDirection(Directions.Up, Directions.Right)
|
|
Else
|
|
Return SelectRandomDirection(Directions.Up, Directions.Right, Directions.SolveAndReset)
|
|
End If
|
|
End Function
|
|
|
|
Public Function ChoosePath_BlockedAbove() As Boolean
|
|
'No need to check the left side, only called from the "keepGoing" loop where LEFT is already cleared
|
|
If BlockedRight Then
|
|
If BlockedBelow Then
|
|
Return GoLeft()
|
|
ElseIf Not OnBottomRow Then
|
|
Return SelectRandomDirection(Directions.Left, Directions.Down)
|
|
ElseIf SolutionCompleted Then 'Can't go down because there's already a solution
|
|
Return GoLeft()
|
|
Else 'At the bottom, no solution yet...
|
|
Return SelectRandomDirection(Directions.Left, Directions.SolveAndReset)
|
|
End If
|
|
ElseIf BlockedBelow Then
|
|
Return SelectRandomDirection(Directions.Left, Directions.Right)
|
|
ElseIf Not OnBottomRow Then
|
|
Return SelectRandomDirection(Directions.Left, Directions.Right, Directions.Down)
|
|
ElseIf SolutionCompleted Then
|
|
Return SelectRandomDirection(Directions.Left, Directions.Right)
|
|
Else
|
|
Return SelectRandomDirection(Directions.Left, Directions.Right, Directions.SolveAndReset)
|
|
End If
|
|
End Function
|
|
|
|
Public Function ChoosePath_BlockedToTheRight() As Boolean
|
|
'No need to check Left or Up, only called from the "keepGoing" loop where LEFT and UP are already cleared
|
|
If BlockedRight Then 'Can't go Right -- why? we knew this when calling the function
|
|
If BlockedBelow Then
|
|
Return SelectRandomDirection(Directions.Left, Directions.Up)
|
|
ElseIf Not OnBottomRow Then
|
|
Return SelectRandomDirection(Directions.Left, Directions.Up, Directions.Down)
|
|
ElseIf SolutionCompleted Then
|
|
Return SelectRandomDirection(Directions.Left, Directions.Up)
|
|
Else
|
|
Return SelectRandomDirection(Directions.Left, Directions.Up, Directions.SolveAndReset)
|
|
End If
|
|
Else 'Should never get here
|
|
Return SelectRandomDirection(Directions.Left, Directions.Up, Directions.Right) 'Go Left, Up, or Right (but path is blocked?)
|
|
End If
|
|
End Function
|
|
|
|
Public Sub PrintFinalResults(startPos As Integer)
|
|
For i As Integer = 0 To Width - 1
|
|
If i = startPos Then Console.Write(". ") Else Console.Write(".--")
|
|
Next
|
|
Console.WriteLine(".")
|
|
|
|
If Not SolutionCompleted Then 'Pick a random exit
|
|
Dim X As Integer = rnd.Next(1, Width + 1)
|
|
If CellState(X, Height) = 0 Then
|
|
CellState(X, Height) = 1
|
|
Else
|
|
CellState(X, Height) = 3
|
|
End If
|
|
End If
|
|
|
|
For j As Integer = 1 To Height
|
|
Console.Write("I")
|
|
For i As Integer = 1 To Width
|
|
If CellState(i, j) < 2 Then
|
|
Console.Write(" I")
|
|
Else
|
|
Console.Write(" ")
|
|
End If
|
|
Next
|
|
Console.WriteLine()
|
|
|
|
For i As Integer = 1 To Width
|
|
If CellState(i, j) = 0 OrElse CellState(i, j) = 2 Then
|
|
Console.Write(":--")
|
|
Else
|
|
Console.Write(": ")
|
|
End If
|
|
Next
|
|
Console.WriteLine(".")
|
|
Next
|
|
End Sub
|
|
|
|
Public Function GoLeft() As Boolean
|
|
curCol -= 1
|
|
CellVisitHistory(curCol, curRow) = CellsVisited
|
|
CellsVisited += 1
|
|
CellState(curCol, curRow) = 2
|
|
If CellsVisited > Width * Height Then Return False
|
|
Q = 0
|
|
Return True
|
|
End Function
|
|
|
|
Public Function GoUp() As Boolean
|
|
curRow -= 1
|
|
CellVisitHistory(curCol, curRow) = CellsVisited
|
|
CellsVisited += 1
|
|
CellState(curCol, curRow) = 1
|
|
If CellsVisited > Width * Height Then Return False
|
|
Q = 0
|
|
Return True
|
|
End Function
|
|
|
|
Public Function GoRight() As Boolean
|
|
CellVisitHistory(curCol + 1, curRow) = CellsVisited
|
|
CellsVisited += 1
|
|
If CellState(curCol, curRow) = 0 Then CellState(curCol, curRow) = 2 Else CellState(curCol, curRow) = 3
|
|
curCol += 1
|
|
If CellsVisited > Width * Height Then Return False
|
|
Return ChoosePath_BlockedToTheLeft()
|
|
End Function
|
|
|
|
Public Function GoDown() As Boolean
|
|
If Q = 1 Then Return MarkSolvedAndResetPosition()
|
|
|
|
CellVisitHistory(curCol, curRow + 1) = CellsVisited
|
|
CellsVisited += 1
|
|
If CellState(curCol, curRow) = 0 Then CellState(curCol, curRow) = 1 Else CellState(curCol, curRow) = 3
|
|
curRow += 1
|
|
If CellsVisited > Width * Height Then Return False
|
|
Return True
|
|
End Function
|
|
|
|
Public Function MarkSolvedAndResetPosition() As Boolean
|
|
' AlWAYS returns true
|
|
SolutionCompleted = True
|
|
Q = 1
|
|
If CellState(curCol, curRow) = 0 Then
|
|
CellState(curCol, curRow) = 1
|
|
curCol = 1
|
|
curRow = 1
|
|
If CellVisitHistory(curCol, curRow) = 0 Then ResetCurrentPosition()
|
|
Else
|
|
CellState(curCol, curRow) = 3
|
|
ResetCurrentPosition()
|
|
End If
|
|
Return True
|
|
End Function
|
|
End Module
|