Добавлено спустя 39 секунд:
- Код: Выделить всё
uses wincrt,Graph;
type tzmey=array[0..14] of integer;
const
left=#75;
up=#72;
esc=#27;
Right=#77;
Down=#80;
n=31;
m=16;
Var pole:array[0..n,0..m] of integer; {игровое поле}
izk,jzk,iz,jz:tzmey; {Массивы для определения положения змейки}
ch:char;
ochki,dx,dy,nx,ny,gd,gm:integer;
{-----------------Создания змейки--------------}
procedure createzmey; {Вначале змейка имеет длину 4 клетки}
Var i:integer;
begin
for i:=0 to 14 do
if i<=3 then
Begin
iz[i]:=4;
jz[i]:=8+i;
end
else
begin
iz[i]:=0;
jz[i]:=0;
end;
end;
{Процедура создает массив, отображающий игровое поле}
Procedure create_pole;
var k,i,j:integer;
begin
for i:=0 to n do
for j:=0 to m do
if (j=0) or (i=n) or (j=m) or (i=0) then
pole[i,j]:=-1 {Края поля обозначены -1}
else
pole[i,j]:=0;
k:=0;
repeat {Расстановка яблок}
i:=random(n-2)+1;
j:=random(m-2)+1;
if (pole[i,j]=0) and (i<>4) and (abs(pole[i-1,j])<>1)
and (abs(pole[i,j])<>1) and (abs(pole[i,j-1])<>1) and
(abs(pole[i,j+1])<>1)
then begin pole[i,j]:=1;
k:=k+1;
end;
until k=11;
end;
{--------------Рисование змеи в начальном положении--------}
procedure drawzmey;
var i,x,y:integer;
begin
setfillstyle(1,12);
for i:=0 to 14 do
if (iz[i]>0) and (iz[i]>0) then {Рисуем активные поля не
заполненые нулями}
begin
x:=nx+jz[i]*dx;
y:=ny+iz[i]*dy;
bar(x,y,x+dx,y+dy);
end;
end;
{-------------Рисуем игровое поле-------}
Procedure Drawpole;
var
i,j:integer;
x,y:integer;
begin
For i:=0 to n do
For j:=0 to m do
Begin
x:=j*dx+nx;
y:=i*dy+ny;
case pole[i,j] of
0:begin{Поле}
Setcolor(1);
setfillstyle(1,0);
bar(x,y,x+dx,y+dy);
rectangle(x,y,x+dx,y+dy);
end;
-1:begin{Стенка}
setfillstyle(1,White); bar(x,y,x+dx,y+dy);
end;
1:begin {Яблоки}
setfillstyle(1,14); bar(x,y,x+dx,y+dy);
end;
end;
end;
end;
{-----------Вывод очков на экран----------------}
procedure schet(xw,yw,n:integer);
var s:string;
begin
setfillstyle(1,1);
bar(xw,yw,xw+40,yw+20);
setcolor(14);
settextstyle(0,0,1);
str(n,s);
outtextxy(xw+5,yw+5,s);
end;
{-----------Движение змеи--------}
procedure movezmey;
var i,kz,hi,hj,x,y:integer;
stop:boolean;
{---------Реализация поворотов змеи------}
procedure rul;
begin
ch:=readkey;
if ch=#0 then
begin
ch:=readkey;
case ch of
left:if hj=0 then begin hi:=0; hj:=-1; end;
right:if hj=0 then begin hi:=0; hj:=1; end;
up:if hi=0 then begin hi:=-1; hj:=0; end;
down:if hi=0 then begin hi:=1; hj:=0; end;
end;
end;
end;
begin
hi:=0; hj:=-1; {Шаги п строчкам и столбцам}
kz:=3; {Конец змеи. Он будет увеличиваться при съедании яблок}
stop:=false;
repeat
setfillstyle(1,0); {Стираем последнее звено змеи};
x:=nx+jz[kz]*dx;
y:=ny+iz[kz]*dy;
bar(x,y,x+dx,y+dy);
setcolor(1);
rectangle(x,y,x+dx,y+dy);
izk:=iz;
jzk:=jz;
for i:=1 to kz do {Сдвигаем все хвенья, кроме первого}
begin
iz[i]:=izk[i-1];
jz[i]:=jzk[i-1];
end;
if keypressed then rul; {Поворот}
iz[0]:=iz[0]+hi; {Новое положение первого звена}
jz[0]:=jz[0]+hj;
setfillstyle(1,12);
x:=nx+jz[0]*dx;
y:=ny+iz[0]*dy;
bar(x,y,x+dx,y+dy);
if pole[iz[0],jz[0]]=1 then {Если в этой клетке яблоко}
begin
kz:=kz+1; {Удлиняем змею}
ochki:=ochki+10;
schet(500,10,ochki);
end;
for i:=1 to 14 do
if (iz[i]=iz[0]) and (jz[i]=jz[0]) then stop:=true;{Если змея попала в себя}
delay(30000);
until (pole[iz[0],jz[0]]=-1) or (ch=esc) or stop or
(kz=14);{Условия окончания игры: попали в стенку или
нажали esc или попали в себя или собрали все яблоки}
end;
{-----------------------Главная прогрмма-----------}
begin
gd:=detect;
initgraph(gd,gm,'');
randomize;
ochki:=0;
dx:=15; dy:=15;
nx:=20;
ny:=0; {Размеры}
create_pole;
createzmey;
drawpole;
drawzmey;
readkey;
movezmey;
readln;
closegraph;
end.
