Umiestnenie súboru www.TrSek.com/cover/neznamy/snakev1_1.pas{ SNAKE.PAS }
{ SNAKE-Game }
{ }
{ Probeer de blokjes te pakken zonder }
{ tegen je staart te botsen }
{ }
{ Druk op een pijltje of de spatie om te }
{ beginnen of druk op een andere toets }
{ om te stoppen. }
{ }
{ Author: Unknown }
{ Datum: 20.01.2009 http://www.trsek.com }
program snake;
uses crt, keyboard, strings;
const TIMEA:integer = 10;
const TIMEB:integer = 0;
const GROWSIZE:integer = 1;
{-------------------------------------------------------}
{ if TIMEA is high and TIMEB is low then }
{ are the wait time on some verry high. }
{ but if TIMEA is low and TIMEB is high then }
{ it detect some keys not. }
{-------------------------------------------------------}
type wurm = array[0..20] of array[0..20] of longint;
var i,j:integer;
procedure show_screen (scherm:string);
var ch,ch1,ch3,ch2:char;
begin
if (scherm = 'welkom') then
begin
clrscr;
writeln(' ');
writeln(' SNAKE-Game ');
writeln(' ');
writeln(' Probeer de blokjes te pakken zonder ');
writeln(' tegen je staart te botsen ');
writeln(' ');
writeln(' Druk op een pijltje of de spatie om te ');
writeln(' beginnen of druk op een andere toets ');
writeln(' om te stoppen. ');
writeln(' ');
end
else if (scherm = 'in_game0') then
begin
ch := chr(205);
ch1 := chr(186);
window(20,19,44,44);
textbackground(black);
textcolor(white);
writeln(' ');
writeln(' ',ch,ch,chr(187),' ');
writeln(' ',ch1,' ');
writeln(' ',ch,ch,chr(185),' ');
writeln(' ',ch1,' ');
writeln(' ',ch,ch,chr(188),' ');
writeln(' ');
end
else if (scherm = 'in_game1') then
begin
ch := chr(205);
ch1 := chr(186);
window(20,19,44,44);
textbackground(black);
textcolor(white);
writeln(' ');
writeln(' ',ch,ch,chr(187),' ');
writeln(' ',ch1,' ');
writeln(' ',chr(201),ch,chr(188),' ');
writeln(' ',ch1,' ');
writeln(' ',chr(200),ch,ch,' ');
writeln(' ');
end
else if (scherm = 'in_game2') then
begin
ch := chr(186);
window(20,19,44,44);
textbackground(black);
textcolor(white);
writeln(' ');
writeln(' ',chr(187),' ');
for i := 0 to 3 do writeln(' ',ch,' ');
writeln(' ');
end
else if (scherm = 'in_game3') then
begin
window(3,3,45,45);
textcolor(darkgray);
ch := chr(218);
ch1 := chr(191);
ch2 := chr(192);
ch3 := chr(217);
for i := 0 to 20 do
begin
for j := 0 to 20 do write(ch,ch1);
writeln;
for j := 0 to 20 do write(ch2,ch3);
writeln;
end;
textcolor(black);
gotoxy(1,1);
end
else
begin
writeln('ERROR');
end;
window(3,3,44,44);
textcolor(black);
textbackground(white);
end;
procedure init;
begin
cursoroff;
randomize;
textmode(CO80 + Font8x8);
textbackground(green);
clrscr;
window(2,2,45,45);
textcolor(black);
textbackground(red);
clrscr;
initkeyboard;
window(3,3,44,44);
textbackground(white);
show_screen('welkom');
end;
procedure game_move (var arr:wurm; const dir:char; var lenght:integer);
var stop:boolean = False; var i,j,x,y,r:integer; var loc:array[0..1] of integer;
begin
for i := 0 to 20 do
begin
for j := 0 to 20 do
begin
if (arr[i][j] = 2) and not (stop) then
begin
x := i; {X}
y := j; {Y}
stop := True;
end;
end;
end;
if (stop) then
begin
loc[0] := x;
loc[1] := y;
if (dir = 'l') and (x = 0) then
begin
x := 20;
end
else if (dir = 'r') and (x = 20) then
begin
x := 0;
end
else if (dir = 'u') and (y = 0) then
begin
y := 20;
end
else if (dir = 'd') and (y = 20) then
begin
y := 0;
end
else if (dir = 'd') then
begin
y := y + 1;
end
else if (dir = 'u') then
begin
y := y - 1;
end
else if (dir = 'l') then
begin
x := x - 1;
end
else
begin
x := x + 1;
end;
if (arr[x][y] = 0) then
begin
for i := 0 to 20 do
begin
for j := 0 to 20 do
begin
if (arr[i][j] = (lenght + 3)) then
begin
arr[i][j] := arr[i][j] + GROWSIZE;
end
else if (arr[i][j] > 1) and (arr[i][j] < (lenght + 3)) then
begin
arr[i][j] := arr[i][j] + 1;
end;
end;
end;
arr[x][y] := 2;
lenght := lenght + GROWSIZE;
r := random(400);
repeat
begin
for i := 0 to 20 do
begin
for j := 0 to 20 do
begin
if (arr[i][j] = 1) or (arr[i][j] > (lenght + 1)) then
begin
if (r = 0) then
begin
arr[i][j] := 0;
r := r - 1;
end
else if not (r = -1) then
begin
r := r - 1;
end;
end;
end;
end;
end
until (r = -1);
end
else if (arr[x][y] = 1) or (arr[x][y] > (lenght + 1)) then
begin
for i := 0 to 20 do
begin
for j := 0 to 20 do
begin
if (arr[i][j] > 1) and (arr[i][j] < (lenght + 3)) then
begin
arr[i][j] := arr[i][j] + 1;
end;
end;
end;
arr[x][y] := 2;
end
else
begin {Je bent dood}
for i := 0 to 20 do
begin
for j := 0 to 20 do
begin
arr[i][j] := 1;
end;
end;
lenght := 0;
end;
end
else
begin
writeln('ERROR');
end;
end;
procedure game_vieuw(const arr:wurm;const l:integer);
var ch:array[0..3] of char;
begin
ch[0] := chr(218);
ch[1] := chr(191);
ch[2] := chr(192);
ch[3] := chr(217);
window(3,3,45,45);
for i := 0 to 20 do
begin
for j := 0 to 20 do
begin
if (arr[i][j] = 2) then
begin
textbackground(red);
textcolor(yellow);
end
else if (arr[i][j] > 1) and (arr[i][j] < (l + 3)) then
begin
textbackground(yellow);
textcolor(red);
end
else if (arr[i][j] = 0) then
begin
textbackground(green);
textcolor(white);
end
else
begin
textbackground(white);
textcolor(darkgray);
end;
gotoxy(i * 2 + 1,j * 2 + 1);
writeln(ch[0],ch[1]);
gotoxy(i * 2 + 1,whereY);
writeln(ch[2],ch[3]);
end;
end;
window(3,3,44,44);
textcolor(black);
textbackground(white);
end;
procedure game_reset(var arr:wurm; var l:integer);
begin
for i := 0 to 20 do
begin
for j := 0 to 20 do
begin
arr[i][j] := 1;
end;
end;
arr[18][19] := 2;
arr[19][19] := 3;
arr[1][18] := 0;
l := 3;
end;
procedure game_over(score:integer);
var ch:char;
begin
window(15,15,44,44);
textbackground(blue);
write(chr(201));
ch := chr(205);
for i := 0 to 13 do
begin
write(ch);
end;
ch := chr(186);
writeln(chr(187));
writeln(ch,' GAME OVER ',ch);
writeln(ch,' ',ch);
writeln(ch,' Druk op de ',ch);
writeln(ch,' spatiebalk ',ch);
writeln(ch,' om opnieuw ',ch);
writeln(ch,' te beginnen. ',ch);
writeln(ch,' score: ',ch);
gotoxy(10,8);
writeln(score);
write(chr(200));
ch := chr(205);
for i := 0 to 13 do
begin
write(ch);
end;
writeln(chr(188));
window(3,3,44,44);
end;
function game_input(k1:tKeyEvent;dir:char):char;
var K:tKeyEvent;var key:string;
begin
k := pollkeyevent;
if not (k = 0) then
begin
key := keyeventtostring(translatekeyevent(getkeyevent));
end
else if not (k1 = 0) then
begin
key := keyeventtostring(translatekeyevent(k1));
end;
if not (key = '') then
begin
if (key = 'Left') and not (dir = 'r') then
begin
dir := 'l';
end
else if (key = 'Up') and not (dir = 'd') then
begin
dir := 'u';
end
else if (key = 'Down') and not (dir = 'u') then
begin
dir := 'd';
end
else if (key = 'Right') and not (dir = 'l') then
begin
dir := 'r';
end;
end;
game_input := dir;
end;
function game_wait:boolean;
var k:tKeyEvent;
begin
game_wait := true;
repeat
begin
k := pollkeyevent;
end
until not (k = 0);
K := translatekeyevent(getkeyevent);
if(keyeventtostring(k) = ' ') then
begin
textcolor(black);
textbackground(white);
show_screen('welkom');
repeat
begin
K := pollkeyevent;
end
until not (keyeventtostring(translatekeyevent(k)) = ' ');
game_wait := False;
end;
end;
var k,k1:tKeyEvent;
var key:string;
var stop:boolean = False;
var old:integer;
var map:wurm;
var l:integer = 3;
var dir:char = 'l';
var temp:char = 'l';
var die:boolean;
begin
{ INIT }
init();
for i := 0 to 20 do
begin
for j := 0 to 20 do
begin
map[i][j] := 1;
end;
end;
map[18][19] := 2;
map[19][19] := 3;
map[19][18] := 4;
map[19][17] := 5;
map[1][18] := 0;
{ INIT end }
repeat
begin
gotoxy(20,whereY);
cursoron;
repeat
begin
k := pollkeyevent;
end
until not (k = 0);
cursoroff;
key := keyeventtostring(translatekeyevent(getkeyevent));
if (key = 'Left') then
begin
dir := 'l';
end
else if (key = ' ') then
begin
dir := 'l';
end
else if (key = 'Up') then
begin
dir := 'u';
end
else if (key = 'Down') then
begin
dir := 'd';
end
else if (key = 'Right') then
begin
dir := 'r';
end
else
begin
stop := true;
end;
if not (stop) then
begin
lowvideo;
show_screen('in_game3');
game_vieuw(map,l);
show_screen('in_game0');
delay(1000);
show_screen('in_game1');
delay(1000);
show_screen('in_game2');
delay(1000);
k1 := pollkeyevent;
die := False;
repeat
begin
{invoer}
dir := game_input(k1,dir);
{Verwerking}
game_move(map,dir,l);
if (l = 0) then
begin
die := true;
end
else
begin
game_vieuw(map,l);
old := l;
end;
for i := 0 to TIMEA do
begin
k := pollkeyevent;
if not (k = 0) then k1 := getkeyevent;
delay(TIMEB);
end;
end
until die;
normvideo;
game_over(old);
game_reset(map,l);
stop := game_wait;
end;
end
until stop;
donekeyboard;
clrscr;
end.