% Constants
const left := chr (203)
const right := chr (205)
const up := chr (200)
const down := chr (208)
const radius := 10
const Esc := chr (27)
const F1 := chr (187)
const BlockWidth := 16 % 20 X 20 pixels
%%% PROCEDURES
procedure ReadMap (filename : string, var map : array 1 .. *, 1 .. * of int,
var NumRows, NumColumns : int)
% Purpose of this procedure is to read the map
var FileIn : int
% Initialize the variables
NumRows := 0
NumColumns := 0
% Open the File
open : FileIn, filename, get
if FileIn > 0 then
get : FileIn, NumRows
get : FileIn, NumColumns
for row : 1 .. NumRows
for col : 1 .. NumColumns
get : FileIn, map (row, col)
end for
end for
close : FileIn
end if
end ReadMap
procedure DrawMap (map : array 1 .. *, 1 .. * of int,
NumRows, NumColumns, BlockWidth : int)
% Purpose of this procedure is to use the input and draw the screen image
% Draws the map from the array
% Declare Local Variables
var x, y : int
% Initialize Variables
x := 0
y := maxy - BlockWidth
for row : 1 .. NumRows
for col : 1 .. NumColumns
drawfillbox (x, y, x + BlockWidth, y + BlockWidth, map (row, col))
x := x + BlockWidth
end for
x := 0
y := y - BlockWidth
end for
end DrawMap
procedure DirectionKeys (var key : string (1), var a, b, x2, y2, x, y : int, BlockWidth : int)
% Direction keys
if key = up then
a := 0
b := BlockWidth
x2 := x
y2 := y
elsif key = down then
b := -BlockWidth
a := 0
x2 := x
y2 := y
elsif key = left then
b := 0
a := -BlockWidth
x2 := x
y2 := y
elsif key = right then
b := 0
a := BlockWidth
x2 := x
y2 := y
elsif key = F1 then
loop
drawfillbox (0, 0, maxx, maxy, white)
locate (2, 2)
put "Use the arrow keys to move the snake"
locate (3, 2)
put "To gain points 'eat' the blue rectangle"
locate (4, 2)
put "To end game press the Esc button"
locate (5, 2)
put "CAUTION: Do not touch walls. The game will end"
exit when key = Esc
getch (key)
end loop
end if
end DirectionKeys
procedure DrawSnake (var x, y, x2, y2, a, b : int, BlockWidth : int)
% Draw the snake character moving
x := x + a
y := y + b
x2 := x2 + a
y2 := y2 + b
drawfillbox (x, y, x + BlockWidth, y - BlockWidth, 8)
delay (100)
drawfillbox (x, y, x + BlockWidth, y - BlockWidth, white)
end DrawSnake
procedure RandomFood (var foodx, foody : int, BlockWidth : int)
randint (foodx, BlockWidth * 3, maxx - BlockWidth * 3)
randint (foody, BlockWidth * 3, maxy - BlockWidth * 3)
end RandomFood
procedure EatFood (var foodx, foody : int, BlockWidth : int)
drawfillbox (foodx, foody, foodx + BlockWidth, foody + BlockWidth, 8)
delay (5)
drawfillbox (foodx, foody, foodx + BlockWidth, foody + BlockWidth, white)
end EatFood
procedure LoseGame (var font, font2, score : int)
for decreasing i : 14 .. 10
drawfillbox (0, 0, maxx, maxy, black)
font := Font.New ("Broadway:40:bold")
font2 := Font.New ("Broadway:20:bold")
Font.Draw ("You Lose!", 180, 300, font, i)
Font.Draw ("Your Score was: ", 210, 225, font2, i)
colour (i)
locate (16, 60)
put score
delay (200)
end for
end LoseGame
% _________________________________________________________________________________
%%% MAIN PROGRAM
setscreen ("graphics:640;480")
% Variable Declarations
var map : array 1 .. 40, 1 .. 40 of int
var NumRows, NumColumns : int
var ManRow, ManColumn, x, y, x2, y2, a, b, score : int
var foodrow, foodcol, foodx, foody, font, font2 : int
var tailrow : array 1 .. 40 of int
var tailcol : array 1 .. 40 of int
var key : string (1)
% Initialize variable values
%% Initial Variable value for character
ManRow := 8
ManColumn := 8
x := (ManColumn - 1) * BlockWidth
y := maxy - ((ManRow - 1) * BlockWidth)
x2 := x + BlockWidth * 2
y2 := y + BlockWidth * 2
a := BlockWidth
b := 0
%% Initial Variable value for score
score := 0
%% Variable value for food
foodrow := 8
foodcol := 14
foodx := (foodcol - 1) * BlockWidth
foody := maxy - ((foodrow - 1) * BlockWidth)
% Carry Out Main Procedures
ReadMap ("GameMap.txt", map, NumRows, NumColumns)
DrawMap (map, NumRows, NumColumns, BlockWidth)
% Set Screen
setscreen ("nocursor")
% To put the food in a random place
RandomFood (foodx, foody, BlockWidth)
% Program
loop
DrawSnake (x, y, x2, y2, a, b, BlockWidth)
drawfillbox (foodx, foody, foodx + BlockWidth, foody + BlockWidth, 3)
% Checks for character input
if hasch then
getch (key)
exit when key = Esc
DirectionKeys (key, a, b, x2, y2, x, y, BlockWidth)
end if
% To end game if snake reaches end of screen(up & down)
if x > maxx - BlockWidth * 3 then
a := -BlockWidth
y := 0
LoseGame (font, font2, score)
exit
elsif x < BlockWidth * 2 then
a := BlockWidth
y := 0
LoseGame (font, font2, score)
exit
end if
% To end game if snake reaches end of screen (left & right)
if y > maxy - BlockWidth * 2 then
a := 0
b := -BlockWidth
LoseGame (font, font2, score)
exit
elsif y < BlockWidth * 3 then
a := 0
b := BlockWidth
LoseGame (font, font2, score)
exit
end if
% To eat the food
if x >= foodx - BlockWidth and x <= foodx and y >= foody and y <= foody + BlockWidth or
x >= foodx and x <= foodx + BlockWidth and y >= foody and y <= foody + BlockWidth or
x >= foodx and x <= foodx + BlockWidth and y >= foody + BlockWidth and y <= foody + BlockWidth * 2 or
x >= foodx - BlockWidth and x <= foodx and y >= foody + BlockWidth and y <= foody + BlockWidth * 2 then
EatFood (foodx, foody, BlockWidth)
score := score + 5
RandomFood (foodx, foody, BlockWidth)
end if
% Display Data
locate (1, 1)
colour (yellow)
colourback (black)
put "YOUR SCORE: ", score
locate (1, 55)
colour (yellow)
colourback (black)
put "Press F1 for instructions"
end loop
|
Register
Wiki
Blog
Search
Turing
Chat Room
Members
