Версия для печати темы

Нажмите сюда для просмотра этой темы в обычном формате

Форум «Всё о Паскале» _ Написание игр _ змейка

Автор: WhiteFang 17.12.2006 0:04

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


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.

Автор: WhiteFang 21.12.2006 20:09

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.

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

Автор: Бродяжник 22.12.2006 14:29

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

Автор: WhiteFang 22.12.2006 18:29

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

Автор: Бродяжник 22.12.2006 19:13

Ну хорошо, делаем через матрицу.
Вместо

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'а, чтобы он дописал свои лекции по змееводству.

Автор: WhiteFang 22.12.2006 23:21

Цитата

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

Так у мя змейка двигается, но за собой не стирает.

Автор: Aerophobic 1.01.2014 16:45

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 пикселей)

Автор: APAL 9.01.2014 13:35

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