Люди, помогите написать пожалуйста змейку, обычную змейку в графическом режиме; без всяких $, ассемблеров и неизвестных вещей начинающему программисту.
Вот начальный код (только это начало и в нём мнооооооооогое не осуществлено):
uses crt, graph;
type
arr = Array[1..60, 1..60] of byte;
{=================}
procedure newt(var field : arr);
var
i, j : byte;
begin
randomize;
i := random(60);
j := random(60);
if (field[i, j] <> 1) and (field[i, j] <> 2) then
field[i, j] := 2;
end;
{=================}
function st(a : longint) : String;
var
s : string;
Begin
Str(a, s);
st := s;
End;
{=================}
procedure snake(var snake : arr);
var
i, j : byte;
begin
i := 30;
for j := 29 to 31 do
snake[i, j] := 1;
end;
{=================}
procedure grafika(field : arr);
var
i, j : byte;
begin
for i := 1 to 60 do
begin
for j := 1 to 60 do
begin
if field[i, j] = 0 then
begin
setcolor(0);
setfillstyle(1, 0);
bar((i - 1) * 8, (j - 1) * 8, i * 8, j * 8);
end;
if field[i, j] = 1 then
begin
setcolor(4);
setfillstyle(1, 4);
bar((i - 1) * 8, (j - 1) * 8, i * 8, j * 8);
end;
if field[i, j] = 2 then
begin
setcolor(2);
setfillstyle(1, 10);
bar((i - 1) * 8, (j - 1) * 8, i * 8, j * 8);
end;
end;
end;
end;
{=================}
{=================}
var
speed, score, grdriver, grmode : integer;
field : arr;
BEGIN
grDriver:=Detect;
InitGraph(grDriver, grMode, '');
setcolor(1);
rectangle(0, 0, 480, 480);
settextstyle(defaultfont, horizdir, 1);
outtextxy(getmaxx - 100, 30, 'SPEED');
outtextxy(getmaxx - 40, 30, st(speed));
outtextxy(getmaxx - 100, 15, 'SCORE');
outtextxy(getmaxx - 40, 15, st(score));
grafika(field);
newt(field);
END.
uses crt, graph;
const
N = 61;
type
arr = Array[0..N, 0..N] of byte;
{=================}
{procedure newt(var field : arr);
var
i, j : byte;
begin
Repeat
i := random(N);
j := random(N);
if (field[i, j] <> 1) and (field[i, j] <> 2) then
field[i, j] := 2
until (field[i, j] <> 1) and (field[i, j] <> 2) and (field[i, j] <> 3);
end; }
{=================}
function st(a : longint) : String;
var
s : string;
Begin
Str(a, s);
st := s;
End;
{=================}
procedure grafika(field : arr);
var
i, j : byte;
begin
for i := 1 to N do
begin
for j := 1 to N do
begin
if field[i, j] = 0 then
begin
setcolor(0);
setfillstyle(1, 0);
bar((i - 1) * (getmaxy div N), (j - 1) * (getmaxy div N),
i * (getmaxy div N), j * (getmaxy div N));
end;
if field[i, j] = 1 then
begin
setcolor(12);
setfillstyle(1, 12);
bar((i - 1) * (getmaxy div N), (j - 1) * (getmaxy div N),
i * (getmaxy div N), j * (getmaxy div N));
end;
if field[i, j] = 2 then
begin
setcolor(2);
setfillstyle(1, 10);
bar((i - 1) * (getmaxy div N), (j - 1) * (getmaxy div N),
i * (getmaxy div N), j * (getmaxy div N));
end;
end;
end;
end;
{=================}
procedure playing(var esc : boolean; var dir, newdir : byte;
var score : integer; speed : integer; var field : arr; ranx, rany : integer);
var
i, j, l, m, i1, j1 : Integer;
pause : boolean;
begin
for i := 0 to 61 do
begin
for j := 0 to 61 do
field[i, j] := 0;
end;
m := 0;
l := 0;
cleardevice;
esc := false;
dir := 1;
setcolor(14);
settextstyle(defaultfont, horizdir, 2);
outtextxy(getmaxx div 2 - 250, getmaxy div 2, 'SELECT THE SPEED (0..9): ');
repeat
speed := ord(readkey) - 48;
until (speed <= 9) and (speed >= 0);
outtextxy(getmaxx div 2 + 185, getmaxy div 2, st(speed));
delay(30000);
cleardevice;
setcolor(9);
settextstyle(defaultfont, horizdir, 1);
outtextxy(getmaxx - 100, 30, 'SPEED');
outtextxy(getmaxx - 40, 30, st(speed));
outtextxy(getmaxx - 100, 15, 'SCORE');
outtextxy(getmaxx - 40, 15, st(score));
setcolor(12);
outtextxy(getmaxx - 150, 250, 'Press <Esc>');
outtextxy(getmaxx - 150, 265, 'for exit');
outtextxy(getmaxx-150,300,'Press <Space>');
outtextxy(getmaxx-150,315,'for pause');
i := 30;
j := 30;
{for l := -1 to 1 do
field[i, j + l] := 1;
i1 := 30;
j1 := 29;}
repeat
{newt(field);}
if keypressed then
case readkey of
#119 : newdir := 1;
#115 : newdir := 2;
#97 : newdir := 3;
#100 : newdir := 4;
#27 : esc := true;
#32 : pause := true;
end;
if pause=true then
begin
pause := false;
repeat
until keypressed;
end;
if (newdir=1) and (dir<>2) then dir:=newdir;
if (newdir=2) and (dir<>1) then dir:=newdir;
if (newdir=3) and (dir<>4) then dir:=newdir;
if (newdir=4) and (dir<>3) then dir:=newdir;
case dir of
1: j := j - 1;
2: j := j + 1;
3: i := i - 1;
4: i := i + 1;
end;
{field[i, j] := 1;
field[i1, j1] := 0;
if field[i1 - 1, j1] = 1 then
i1 := i1 - 1
else if field[i1 + 1, j1] = 1 then
i1 := i1 + 1
else if field[i1, j1 - 1] = 1 then
j1 := j1 - 1
else if field[i1, j1 + 1] = 1 then
j1 := j1 + 1;}
grafika(field);
setcolor(14);
line(getmaxy, 0, getmaxy, getmaxy);
for l := 0 to N do
begin
m := 0;
If field[l, m] = 1 then
esc := true;
end;
for l := 0 to N do
begin
m := N;
If field[l, m] = 1 then
esc := true;
end;
for m := 0 to N do
begin
l := 0;
If field[l, m] = 1 then
esc := true;
end;
for m := 0 to N do
begin
l := N;
If field[l, m] = 1 then
esc := true;
end;
delay(3000 - 2500 * speed div 9);
until esc = true;
end;
{=================}
var
speed, score, grdriver, grmode, ranx, rany : integer;
field : arr;
dir, newdir : byte;
esc, quit : boolean;
BEGIN
grDriver:=Detect;
InitGraph(grDriver, grMode, '');
randomize;
esc := false;
playing(esc, dir, newdir, score, speed, field, ranx, rany);
delay(20000);
repeat
setcolor(11);
settextstyle(defaultfont,horizdir,4);
outtextxy(getmaxx div 2 -250,getmaxy div 2,'GAME OVER');
setcolor(15);
settextstyle(defaultfont,horizdir,2);
outtextxy(getmaxx div 2 -250,getmaxy div 2 +100,'Play again? (y/n)...');
case readkey of
#121 : playing(esc, dir, newdir, score, speed, field, ranx, rany);
#110 : quit:=true;
end;
until quit;
closegraph;
END.
Начнем пинать с процедуры Grafika.
1. Почто каждый раз перевычислять getmaxy div N? Даже если цомпутер быстрый, заставлять его без конца делать одно и тоже нехорошо. Объявляем глобальную переменную типа CellSize: byte; (делать ее больше не имеет смысла), после установки графического режима один раз вычисляем CellSize := GetMaxY div N;
и радостно пользуемся.
2. Почто каждый раз перерисовывать все поле? Перерисовывать в цикле имеет смысл всего несколько клеток:
- ту клетку, куда переместилась голова змейки;
- если змейка не растет, тогда нужно перерисовать и клетку, откуда "уполз" ее хвост.
- если на этом такте появился бонус, то и его тоже надо нарисовать.
3. Поэтому надо следить, где находится змейка. Если бы змейка всегда росла и никогда не двигала свой хвост, было бы достаточно знать координаты ее головы. А так придется создать отдельный массив для хранения координат всех клеток, занятых змейкой. Нечто типа
Type TSnakeCell = record
x, y: byte;
end;
Var Snake: Array[1..1000] of TSnakeCell;
...
{увеличиваем длину}
Inc(Head);
{запоминаем новое положение головы}
Snake[Head].x := NewX;
Snake[Head].y := NewY;
{рисуем голову}
DrawSnakeHead;
...
...
{затираем хвост}
RemoveSnakeTail;
{передвигаем змейку на одну клетку}
for i:=1 to Head-1 do Snake[i] := Snake[i+1];
{запоминаем новое положение головы}
Snake[Head].x := NewX;
Snake[Head].y := NewY;
{рисуем голову}
DrawSnakeHead;
...
Бродяжник, конечно спасибо тебе, но тут используется тип рекорд, который я нифига не знаю.
Мне понятней через матрицу было бы =). А насчёт графики надо будет исправить. Спасибо.
Ну хорошо, делаем через матрицу.
Вместо
Type TSnakeCell = record
x, y: byte;
end;
Var Snake: Array[1..1000] of TSnakeCell;
Var Snake: Array[1..1000] of array[1..2] of byte;
Snake[Head].x := NewX;
Snake[Head].y := NewY;
Snake[Head][1] := NewX;
Snake[Head][2] := NewY;
uses Sunit,crt,graph;
label te;
var
f:text;
g,m,x:integer;
key:char;
over:boolean;
s1,s2:string;
begin
randomize;
over:=false;
g:=detect;
m:=getgraphmode;
initgraph(g,m,'');
rectangle(10,10,160,160);
OutTextXY(170,10,'Score');
key:=readkey;
case key of
#72 : direction:=1;
#80 : direction:=2;
#75 : direction:=3;
#77 : direction:=4;
#27 : goto te;
end;
head.x:=6;
head.y:=6;
cl:=1;
for x:=1 to 5 do
spawnapple(x);
repeat
if keypressed then
begin
key:=readkey;
case key of
#72 : if direction<>2 then direction:=1;
#80 : if direction<>1 then direction:=2;
#75 : if direction<>4 then direction:=3;
#77 : if direction<>3 then direction:=4;
#27 : goto te;
end;
end;
updatetail;
movehead(direction);
drawsnake;
for x:=1 to 5 do
if (apples[x].x=head.x) and (apples[x].y=head.y) then
eatapple(x);
if cl>1 then
for x:=2 to cl-1 do
if (body[x].x=head.x) and (body[x].y=head.y) then goto te;
if score<50 then
delay(100 - score)
else
delay(50);
until over;
te:
closegraph;
clrscr;
assign(f,'Hiscore.txt');
reset(f);
readln(f,s1);
readln(f,s2);
close(f);
val(s2,x,g);
Writeln(s1,' : ', s2);
if score > x then
begin
writeln('New HIGHSCORE!');
Write('Enter your name: ');
readln(s1);
str(score,s2);
rewrite(f);
writeln(f,s1);
writeln(f,s2);
close(f);
end;
Writeln('Game Over!');
Writeln('Your score: ', score);
readln;
end.
unit sunit;
interface
uses graph;
{User types}
type
dir=1..4;
coordinate=record x,y:integer; end;
{Procedures}
procedure DrawApple(i:integer);
procedure SpawnApple(i:integer);
procedure EatApple(i:integer);
procedure UpdateTail;
procedure Grow;
procedure MoveHead(d:dir);
procedure DrawSnake;
procedure UpdateScore;
{Variables}
var
head:coordinate;
body:array[1..30] of coordinate;
cl:integer;
apples:array[1..5] of coordinate;
score:integer;
s:string;
direction:dir;
implementation
procedure UpdateScore;
begin
setfillstyle(0,0);
setcolor(red);
bar(170,20,210,40);
str(score,s);
outtextxy(170,25,s);
end;
procedure SpawnApple;
label loop;
var x:integer;
begin
loop:
apples[i].x:=random(14);
apples[i].y:=random(14);
for x:=1 to cl do
if (body[x].x=apples[i].x) and (body[x].y=apples[i].y) then goto loop;
drawapple(i);
end;
procedure DrawApple;
begin
setcolor(red);
circle(apples[i].x*10+15,apples[i].y*10+15,4);
setfillstyle(0,red);
floodfill(apples[i].x*10+15,apples[i].y*10+15,red);
end;
procedure EatApple;
begin
score:=score+1;
Grow;
updatescore;
spawnapple(i);
end;
procedure Grow;
begin
if cl < 30 then cl:=cl+1;
end;
procedure MoveHead;
begin
case d of
1: if head.y<>0 then head.y:=head.y-1 else head.y:=14;{Up}
2: if head.y<>14 then head.y:=head.y+1 else head.y:=0;{Down}
3: if head.x<>0 then head.x:=head.x-1 else head.x:=14;{Left}
4: if head.x<>14 then head.x:=head.x+1 else head.x:=0;{Right}
end;
end;
procedure UpdateTail;
var i:integer;
begin
if i<>1 then
for i:=cl downto 1 do
begin
body[i].x:=body[i-1].x;
body[i].y:=body[i-1].y;
end;
body[1].x:=head.x;
body[1].y:=head.y;
end;
procedure DrawSnake;
begin
setfillstyle(0,0);
bar(11+head.x*10,11+head.y*10,19+head.x*10,19+head.y*10);
bar(11+body[cl].x*10,11+body[cl].y*10,19+body[cl].x*10,19+body[cl].y*10);
setfillstyle(0,green);
setcolor(green);
circle(head.x*10+15,head.y*10+15,4);
floodfill(head.x*10+15,head.y*10+15,green);
end;
end.
Мда... через 7 лет тема была реанимирована...
Скажите, пожалуйсто, как сделать, чтобы змейка стирала за собой, а не оставляла след?
Как сделать, чтобы при врезании в себя, вы проигрывали?
Как сделать, чтобы квадритики для собирания появлялись по одному и при их сборе змейка удлинялась?
И как сделать, чтобы массив до желтой лиии был? Вроде всё правильно, а всё равно не доходит.
И кодом желательно =)
Заранее скажу, чтобы вы меня не осуждали, я взял оформление у одного из пользователей форума.
[/quote]
Я попробовал сделать для ячеек наличае занятости в проге с роботами думаю как идея поможет