IPB
ЛогинПароль:

> Змейка на паскале
сообщение
Сообщение #1


Гость






Вот, только там есть маленькие недорабоки:
uses CRT, Graph;
type TPoint = record
X, Y: integer;
end;
MAS = array[1..1000] of TPoint;
var A: MAS;
N, C: integer;
T1: TPoint;
Key: Char;
procedure DRIVER;
var Gd, Gm: integer;
begin
Gd:=Detect;
InitGraph(Gd, Gm, '');
end;
procedure POLE;
begin
moveto(51, 51);
lineto(428, 51);
lineto(428, 428);
lineto(51, 428);
lineto(51, 51);
end;
procedure PAINT(T: TPoint; N: integer);
begin
case N of
1: SetColor(White);
2: SetColor(Black);
3: SetColor(Red);
end;
Rectangle(T.X*15-15+52, T.Y*15-15+52, T.X*15+52, T.Y*15+52);
end;
procedure GAMEOVER(A: MAS; N: integer; var Key: char);
var I: integer;
begin
if (A[N].X=0) or (A[N].X=26) or (A[N].Y=0) or (A[N].Y=26) then
Key:='q';
for I:=1 to N-1 do
if (A[N].X=A[I].X) and (A[N].Y=A[I].Y) then
Key:='q';
end;
procedure METKA(var T1: TPoint);
begin
T1.X:=Random(25)+1; T1.Y:=Random(25)+1;
Paint(T1, 3);
end;
procedure SNAKE(A: MAS; N: integer; Key: char; var B: MAS);
var T: TPoint;
I, X, Y: integer;
begin
case Key of
'w': begin X:=0; Y:=-1; end;
'a': begin X:=-1; Y:=0; end;
's': begin X:=0; Y:=1; end;
'd': begin X:=1; Y:=0; end;
end;
T:=A[1];
for I:=1 to N-1 do
A[I]:=A[I+1];
A[N].X:=A[N].X+X; A[N].Y:=A[N].Y+Y;
PAINT(T, 2);
for I:=1 to N do
PAINT(A[I], 1);
for I:=1 to N do
B[I]:=A[I];
end;
begin
DRIVER;
POLE;
A[1].X:=1; A[1].Y:=1; A[2].X:=2; A[2].Y:=1;
N:=2;
C:=0;
Key:='d';
repeat
if C=30 then
begin
PAINT(T1, 2);
METKA(T1);
C:=0;
end;
inc©;
if (T1.X=A[N].X) and (T1.Y=A[N].Y) then
begin
inc(N);
C:=30;
A[N]:=T1;
end;
if KeyPressed then
Key:=readkey;
Delay(9000);
SNAKE(A, N, Key, A);
GAMEOVER(A, N, Key);
until Key='q';
OutTextXY(315, 238, 'GAME OVER');
OutTextXY(302, 250, 'press any key');
readkey;
end.
 К началу страницы 
+ Ответить 

Сообщений в этой теме


 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 27.04.2024 2:57
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name