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

 
 Ответить  Открыть новую тему 
> змейка, змейка с нуля
сообщение
Сообщение #1





Группа: Пользователи
Сообщений: 7
Пол: Мужской
Реальное имя: Артём

Репутация: -  0  +


Люди, помогите написать пожалуйста змейку, обычную змейку в графическом режиме; без всяких $, ассемблеров и неизвестных вещей начинающему программисту.
Вот начальный код (только это начало и в нём мнооооооооогое не осуществлено):

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.


Ещё такая проблема: если повторяю через репит вывод newt, то границы поля не отображаются, и не выводится процедура snake.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2





Группа: Пользователи
Сообщений: 7
Пол: Мужской
Реальное имя: Артём

Репутация: -  0  +


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.

Скажите, пожалуйсто, как сделать, чтобы змейка стирала за собой, а не оставляла след?
Как сделать, чтобы при врезании в себя, вы проигрывали?
Как сделать, чтобы квадритики для собирания появлялись по одному и при их сборе змейка удлинялась?
И как сделать, чтобы массив до желтой лиии был? Вроде всё правильно, а всё равно не доходит.
И кодом желательно =)
Заранее скажу, чтобы вы меня не осуждали, я взял оформление у одного из пользователей форума.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Бывалый
***

Группа: Пользователи
Сообщений: 206
Пол: Мужской

Репутация: -  3  +


Начнем пинать с процедуры 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;

При этом координаты "хвоста" находятся в элементе Snake[1], а "голова" по мере роста змейки движется в сторону увеличения индекса. Это значит, что нужна еще некая переменная Head: word; которая будет указывать на положение головы: Snake[Head].
Если змейка растет, то все просто:
...
{увеличиваем длину}
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;
...

 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4





Группа: Пользователи
Сообщений: 7
Пол: Мужской
Реальное имя: Артём

Репутация: -  0  +


Бродяжник, конечно спасибо тебе, но тут используется тип рекорд, который я нифига не знаю.
Мне понятней через матрицу было бы =). А насчёт графики надо будет исправить. Спасибо.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #5


Бывалый
***

Группа: Пользователи
Сообщений: 206
Пол: Мужской

Репутация: -  3  +


Ну хорошо, делаем через матрицу.
Вместо
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;


Вот и матрица, хотя imho это менее удобочитаемо.
А от хранения всего тела змейки в отдельном массиве все равно никуда не деться, если есть желание, чтобы она могла двигаться.
А вообще надо просить дядю Lapp'а, чтобы он дописал свои лекции по змееводству.

Сообщение отредактировано: Бродяжник -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #6





Группа: Пользователи
Сообщений: 7
Пол: Мужской
Реальное имя: Артём

Репутация: -  0  +


Цитата
А от хранения всего тела змейки в отдельном массиве все равно никуда не деться, если есть желание, чтобы она могла двигаться.

Так у мя змейка двигается, но за собой не стирает.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #7


Гость






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.


А теперь сам модуль Sunit
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.


как откомпилируешь, в папке с игрой должен быть пустой файл Hiscore.txt, модуль Sunit.tpu, модуль EGAVGA.BGI, иначе функция сохранения рекордов корректно работать не будет. Правда есть один баг, когда поворачиваешь, невозможно повернуть сразу же ещё раз, пока змейка не пройдет минимум 1 клетку. Да и размеры клеток фиксированы (10 пикселей)
 К началу страницы 
+ Ответить 
сообщение
Сообщение #8


Смотрю...
*****

Группа: Пользователи
Сообщений: 1 055
Пол: Мужской
Реальное имя: Пшеничный Алексей Анатольевич

Репутация: -  6  +


Мда... через 7 лет тема была реанимирована...


--------------------
Если что-то не делает того, что вы запланировали ему делать - это еще не означает, что оно бесполезно.
--------------------
Прежде, чем задать вопрос - Правила :: FAQ :: Поиск
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #9


Гость







Скажите, пожалуйсто, как сделать, чтобы змейка стирала за собой, а не оставляла след?
Как сделать, чтобы при врезании в себя, вы проигрывали?
Как сделать, чтобы квадритики для собирания появлялись по одному и при их сборе змейка удлинялась?
И как сделать, чтобы массив до желтой лиии был? Вроде всё правильно, а всё равно не доходит.
И кодом желательно =)
Заранее скажу, чтобы вы меня не осуждали, я взял оформление у одного из пользователей форума.
[/quote]

Я попробовал сделать для ячеек наличае занятости в проге с роботами думаю как идея поможет
 К началу страницы 
+ Ответить 

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

 





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