User:Pluke/snake
Jump to navigation
Jump to search
CC3.0 from http://community.computingatschool.org.uk/resources/444
Imports System.Console
Module snake
Const maxlvl = 99
Const maxscore = 999
Const maxlives = 4
Const gridSize = 30
Const maxbonus = 999
Const maxadd = 50
Const sleeptime = 100
Const lvlScore = 10000
Enum etile
empty = 0
head = 1
tail = 2
addtail = 3
removetail = 4
bonus = 6
walls = 7
exitlvl = 8
food = 9
End Enum
Structure theSnake
Dim x As Integer
Dim y As Integer
Dim dirx As Integer
Dim diry As Integer
Dim newmoveokay As Boolean
Dim tailsize As Integer
Dim score As Integer
Dim dead As Boolean
End Structure
Dim r As New Random
Sub Main()
Dim quit As Boolean = False
Dim g(gridSize, gridSize) As etile
Dim mySnake As theSnake
Dim win As Boolean = False
'game loop
Console.WindowWidth = gridSize + 3
Console.WindowHeight = gridSize + 6
Console.CursorVisible = False
Console.Title = "Snake"
Do
setupBoard(g, mySnake)
drawboard(g)
win = False
Do
'test for collision
'see if input abvailable
If (Console.KeyAvailable) Then
'get input
Select Case Console.ReadKey().Key
Case System.ConsoleKey.LeftArrow
mySnake.dirx = -1
mySnake.diry = 0
Case System.ConsoleKey.RightArrow
mySnake.dirx = 1
mySnake.diry = 0
Case System.ConsoleKey.UpArrow
mySnake.diry = -1
mySnake.dirx = 0
Case System.ConsoleKey.DownArrow
mySnake.diry = 1
mySnake.dirx = 0
Case System.ConsoleKey.Escape
mySnake.dead = True
quit = True
Case Else
'ignore
End Select
End If
'check move
drawChar(mySnake.x, mySnake.y, etile.tail)
g(mySnake.x, mySnake.y) = etile.tail
mySnake.x += mySnake.dirx
mySnake.y += mySnake.diry
Select Case g(mySnake.x, mySnake.y)
Case etile.empty
mySnake.newmoveokay = True
Case etile.food
mySnake.score += maxadd
mySnake.newmoveokay = True
mySnake.tailsize += 1
Case etile.walls
mySnake.newmoveokay = False
Case etile.bonus
mySnake.score += r.Next(maxbonus / 4, maxbonus + 1)
mySnake.newmoveokay = True
Case etile.head
mySnake.newmoveokay = False
Case etile.tail
mySnake.newmoveokay = False
Case Else
mySnake.newmoveokay = True
End Select
'won?
win = haswon(g)
'move snake
If Not win Then
If mySnake.newmoveokay = True Then
drawChar(mySnake.x, mySnake.y, etile.head)
g(mySnake.x, mySnake.y) = etile.head
Else
'crash
mySnake.dead = True
mySnake.score = 0
End If
'sleep
Threading.Thread.Sleep(sleeptime)
End If
displayScore(mySnake.score)
Loop Until mySnake.dead Or win
If mySnake.dead Then
ForegroundColor = ConsoleColor.White
SetCursorPosition(2, gridSize + 2)
WriteLine("CRASH!!! Score: " & mySnake.score & " ")
Else
ForegroundColor = ConsoleColor.Yellow
SetCursorPosition(2, gridSize + 2)
WriteLine("Next Lvl Score: " & mySnake.score & " ")
End If
ReadKey()
Loop Until quit
End Sub
Function haswon(ByRef g(,) As etile) As Boolean
Dim won As Boolean = True
Dim i, j As Integer
For i = 0 To gridSize - 1
For j = 0 To gridSize - 1
If g(i, j) = etile.food Or g(i, j) = etile.bonus Then
won = False
End If
Next
Next
Return won
End Function
Sub displayScore(ByVal s As Integer)
ForegroundColor = ConsoleColor.White
SetCursorPosition(2, gridSize + 2)
WriteLine(" Score: " & s & " ")
End Sub
Sub setupBoard(ByRef g(,) As etile, ByRef s As theSnake)
Dim i, j, x, y As Integer
Dim setvalue As Boolean = False
'set walls
For i = 0 To gridSize - 1
For j = 0 To gridSize - 1
g(i, j) = etile.walls
Next
Next
'set ground
For i = 1 To gridSize - 2
For j = 1 To gridSize - 2
g(i, j) = etile.empty
Next
Next
'set snake position
g(gridSize / 2, gridSize / 2) = etile.head
For i = 0 To gridSize - 1
For j = 0 To gridSize - 1
If g(i, j) = etile.head Then
s.x = i
s.y = j
s.dirx = -1
s.diry = 0
s.tailsize = 0
s.dead = False
s.newmoveokay = True
End If
Next
Next
'set food
setplace(g, etile.food, r.Next(gridSize / 6, gridSize / 4))
'set snake bonus
setplace(g, etile.bonus, r.Next(1, 5))
End Sub
Sub setplace(ByRef g(,) As etile, ByVal t As etile, ByVal number As Integer)
Dim i, j, x, y As Integer
Dim r As New Random
Dim setvalue As Boolean = False
For i = 0 To number - 1
Do
setvalue = False
x = r.Next(1, gridSize - 1)
y = r.Next(1, gridSize - 1)
If g(x, y) = etile.empty Then
g(x, y) = t
setvalue = True
End If
Loop Until setvalue = True
Next
End Sub
Sub drawboard(ByRef g(,) As etile)
Dim i, j As Integer
Console.Clear()
For i = 0 To gridSize - 1
For j = 0 To gridSize - 1
drawChar(i, j, g(i, j))
Next
Next
Console.BackgroundColor = ConsoleColor.Black
End Sub
Sub drawChar(ByVal x As Integer, ByVal y As Integer, ByVal t As etile)
Console.SetCursorPosition(x + 1, y + 1)
Select Case t
Case etile.bonus
Console.BackgroundColor = ConsoleColor.Black
Console.ForegroundColor = ConsoleColor.Red
Write("B")
Case etile.walls
Console.BackgroundColor = ConsoleColor.Blue
Console.ForegroundColor = ConsoleColor.Blue
Write(" ")
Case etile.food
Console.BackgroundColor = ConsoleColor.Black
Console.ForegroundColor = ConsoleColor.Yellow
Write(".")
Case etile.head
Console.BackgroundColor = ConsoleColor.Black
Console.ForegroundColor = ConsoleColor.Green
Write("☻")
Case etile.tail
Console.BackgroundColor = ConsoleColor.Black
Console.ForegroundColor = r.Next(1, 16)
Write("O")
Case Else
End Select
End Sub
End Module