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;
{----------------------------------------------------------------------------}
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 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);
end;
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;
{----------------------------------------------------------------------------}
Begin
gd := DETECT;
initgraph(gd,gm,'');
cleardevice;
mark(pMark);
PosSnake;
ch2 := #77;
repeat
delay(30000);
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);
MoveChain;
case ch1 of
#80 : inc(Last^.y);
#72 : dec(Last^.y);
#77 : inc(Last^.x);
#75 : dec(Last^.x);
end;
setcolor(2);
circle(Last^.x*20+10,Last^.y*20+10,10);
BorderTest;
SelfDestroyTest;
until ch2 = #27;
release(pMark);
closegraph;
End.