Люди, помогите написать пожалуйста змейку, обычную змейку в графическом режиме; без всяких $, ассемблеров и неизвестных вещей начинающему программисту. Вот начальный код (только это начало и в нём мнооооооооогое не осуществлено):
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.
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;
При этом координаты "хвоста" находятся в элементе 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; ...
Бродяжник, конечно спасибо тебе, но тут используется тип рекорд, который я нифига не знаю. Мне понятней через матрицу было бы =). А насчёт графики надо будет исправить. Спасибо.
Вот и матрица, хотя imho это менее удобочитаемо. А от хранения всего тела змейки в отдельном массиве все равно никуда не деться, если есть желание, чтобы она могла двигаться. А вообще надо просить дядю Lapp'а, чтобы он дописал свои лекции по змееводству.
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;
как откомпилируешь, в папке с игрой должен быть пустой файл Hiscore.txt, модуль Sunit.tpu, модуль EGAVGA.BGI, иначе функция сохранения рекордов корректно работать не будет. Правда есть один баг, когда поворачиваешь, невозможно повернуть сразу же ещё раз, пока змейка не пройдет минимум 1 клетку. Да и размеры клеток фиксированы (10 пикселей)
Если что-то не делает того, что вы запланировали ему делать - это еще не означает, что оно бесполезно. -------------------- Прежде, чем задать вопрос - Правила :: FAQ :: Поиск
Скажите, пожалуйсто, как сделать, чтобы змейка стирала за собой, а не оставляла след? Как сделать, чтобы при врезании в себя, вы проигрывали? Как сделать, чтобы квадритики для собирания появлялись по одному и при их сборе змейка удлинялась? И как сделать, чтобы массив до желтой лиии был? Вроде всё правильно, а всё равно не доходит. И кодом желательно =) Заранее скажу, чтобы вы меня не осуждали, я взял оформление у одного из пользователей форума. [/quote]
Я попробовал сделать для ячеек наличае занятости в проге с роботами думаю как идея поможет