Uses
Crt, Graph;
Type
tChain = ^tSection;
tSection = record
x : shortint;
y : shortint;
next : tChain;
end;
Const
arrowSymbols : set of char = [#80,#72,#77,#75];
Var
gd, gm : integer;
pMark : pointer;
First, Current, Last : tChain;
i : byte;
ch1, ch2 : char;
map : array [0..31,0..23] of boolean;
{----------------------------------------------------------------------------}
Procedure CreateChain;
const
count : boolean = FALSE;
begin
if NOT (count) then begin
new(First);
Current := First;
count := TRUE;
end else begin
new(Current^.next);
Current := Current^.next;
end;
Current^.next := nil;
Last := Current;
end;
{----------------------------------------------------------------------------}
Procedure AddChain;
begin
Current := nil;
new(Current);
Current^.next := First;
Current^.x := -1;
Current^.y := -1;
First := Current;
end;
{----------------------------------------------------------------------------}
Procedure PosSnake;
begin
setcolor(2);
for i := 0 to 9 do begin
CreateChain;
Current^.x := i;
Current^.y := 0;
circle(Current^.x*20+10,Current^.y*20+10,10);
map[Current^.x,Current^.y] := TRUE;
end;
end;
{----------------------------------------------------------------------------}
Procedure PosEat;
var
x, y : byte;
begin
x := random(32);
y := random(24);
while map[x,y] = TRUE do begin
x := random(32);
y := random(24);
end;
setcolor(4);
circle(x*20+10,y*20+10,10);
map[x,y] := TRUE;
end;
{----------------------------------------------------------------------------}
Procedure MoveChain;
begin
Current := First;
while Current <> Last do begin
Current^.x := (Current^.next)^.x;
Current^.y := (Current^.next)^.y;
Current := Current^.next;
end;
end;
{----------------------------------------------------------------------------}
Procedure GameOver;
begin
cleardevice;
setcolor(1);
outtextxy(275,240,'Game Over!!!');
ch2 := #27;
delay(65535);
end;
{----------------------------------------------------------------------------}
Procedure BorderTest;
begin
if Last^.x = -1 then GameOver;
if Last^.y = -1 then GameOver;
if Last^.x = 32 then GameOver;
if Last^.y = 24 then GameOver;
end;
{----------------------------------------------------------------------------}
Procedure SelfDestroyTest;
begin
Current := First;
while Current <> Last do begin
if (Current^.x = Last^.x) AND (Current^.y = Last^.y) then GameOver;
Current := Current^.next;
end;
end;
{----------------------------------------------------------------------------}
Procedure EatTest;
begin
if map[Last^.x,Last^.y] = TRUE then begin
AddChain;
PosEat;
end;
end;
{----------------------------------------------------------------------------}
Begin
gd := DETECT;
initgraph(gd,gm,'');
cleardevice;
randomize;
mark(pMark);
PosSnake;
for i := 1 to 10 do PosEat;
ch2 := #77;
repeat
delay(10000);
if keypressed then ch2 := readkey;
if ch2 = #0 then ch2 := readkey;
if ch2 in arrowSymbols then ch1 := ch2;
setcolor(0);
circle(First^.x*20+10,First^.y*20+10,10);
map[First^.x,First^.y] := FALSE;
MoveChain;
case ch1 of
#80 : inc(Last^.y);
#72 : dec(Last^.y);
#77 : inc(Last^.x);
#75 : dec(Last^.x);
end;
BorderTest;
SelfDestroyTest;
EatTest;
setcolor(2);
circle(Last^.x*20+10,Last^.y*20+10,10);
map[Last^.x,Last^.y] := TRUE;
until ch2 = #27;
release(pMark);
closegraph;
End.