Помощь - Поиск - Пользователи - Календарь
Полная версия: Игра Лабиринт
Форум «Всё о Паскале» > Pascal, Object Pascal > Написание игр
Eichhorn
Помогите пожалуйста найти ошибку в игре, мне её сдать завтра надо. Она сначала запускается, а потом вылетает. И, если можете, подскажите как сделать отсчёт таймера от начала игры.
Вот текст игры:

program LABIRINT;
uses graph,wincrt;
type
Ttab=array[1..10,1..10] of integer;
var

grdriver, grmode, errcode:integer;
count:integer;
key:char;
p:pointer;
Prize:integer;
nx,ny,dx,dy,ik,jk,i,j:integer;
gd,gm:integer;


const
Left=#75;
Up=#72;
Down=#80;
Right=#77;
Esc=#27;
Enter=#13;
Tab1: Ttab=
((0,0,0,0,4,0,0,0,0,0),
(0,3,0,0,1,0,0,0,3,4),
(0,1,0,1,1,0,3,1,1,0),
(0,1,1,1,0,0,0,0,1,0),
(0,0,0,3,0,0,0,1,1,0),
(0,1,1,1,1,0,1,1,0,0),
(0,3,0,0,1,3,1,0,0,0),
(0,1,1,0,0,1,0,0,1,0),
(0,0,1,1,0,1,1,3,1,0),
(0,0,0,2,0,0,0,0,0,0));
Tab2: Ttab=
((0,0,0,0,0,4,0,0,0,0),
(0,0,0,0,0,1,0,0,0,0),
(4,1,1,1,1,1,1,1,0,0),
(0,1,0,0,0,0,0,1,0,0),
(0,1,0,1,1,1,3,1,0,0),
(0,3,0,1,0,0,0,0,0,0),
(0,0,0,1,1,1,1,1,0,0),
(0,0,0,3,0,1,0,1,0,0),
(0,0,0,0,0,3,0,1,1,3),
(0,0,0,0,0,0,0,2,0,0));



Procedure help;
var
f:text;
s:string;
y:integer;
begin
assign(f,'help.pas');
reset(f);
setcolor(15);
settextstyle(0,0,1);
y:=20;
cleardevice;
while not(eof(f)) do
begin
readln(f,s);
outtextxy(50,y,s);
y:=y+20;
end;
close(f);
readkey;
cleardevice;
end;

Procedure AnalyseKey(Var Key:char; Var i,j,ik,jk:integer);
begin
key:=readkey;
if key=#0 then
begin
key:=readkey;
case key of
left:j:=jk-1;
right:j:=jk+1;
up:i:=ik-1;
down:i:=ik+1;
end;
end;
setcolor(0);
settextstyle(0,0,3);
outtextxy(450,200,'Стена');
end;


Procedure Init;
Begin
count:=0;
Prize:=0;
dx:=40;
dy:=30;
nx:=30;
ny:=5;
end;


Procedure PrCount(count:integer);
Var
st:string[3];
begin
setcolor(14);
STR(count,st);
setfillstyle(1,0);
bar(370,310,640,340);
settextstyle(0,0,2);
outtextxy(400,320,'‚ иЁ ®зЄЁ-'+st);
end;

Procedure DrawCol;
var
size:integer;
begin
setcolor(Yellow);
setfillstyle(1,Yellow);
circle(round(dx/2),round(dy/2),round(dx/4));
floodfill(round(dx/2),round(dy/2),Yellow);
size:=imagesize(0,0,dx,dy);
getmem(p,size);
getimage(0,0,dx,dy,p^);
end;


Procedure DrawLab(var ik,jk:integer);
Var
i,j:integer;
x,y:integer;
begin
x:=nx+dx*10+5;
y:=ny+dy*10+5;
setfillstyle(1,Cyan);
bar(nx-5,ny-5,x,y);
for i:=1 to 10 do
for j:=1 to 10 do
begin
x:=(j-1)*dx+nx;
y:=(i-1)*dy+ny;
case tab1[i,j] of

0:begin
setfillstyle(8,brown);
bar(x,y,x+dx,y+dy);
end;

1:begin
setfillstyle(1,White);
bar(x,y,x+dx,y+dy);
end;

2:begin
setfillstyle(i,White);
bar(x,y,x+dx,y+dy);
ik:=i;
jk:=j;
putimage(x,y,p^,xorput);
end;

3:begin
setfillstyle(1,LightGray);
bar(x,y,x+dx,y+dy);
Prize:=Prize+1;
end;

4:begin
setfillstyle(1,Yellow);
bar(x,y,x+dx,y+dy);
end;
end;
end;
end;

Procedure MoveLab(Var i,j,ik,jk:integer);
Var
x,y,xk,yk:integer;
Begin
if (i=ik) and(j=jk) then Exit;
x:=(j-1)*dx+nx;
y:=(i-1)*dy+ny;
xk:=(jk-1)*dx+nx;
yk:=(ik-1)*dy+ny;
case tab1[i,j] of
0:begin
sound(500);
delay(20);
count:=count-2;
PrCount(count);
setcolor(12);
settextstyle(0,0,3);
outtextxy(450,200,'Стена');
i:=ik;
j:=jk;
nosound;
end;

1:begin
putimage(x,y,p^,xorput);
putimage(xk,yk,p^,xorput);
tab1[ik,jk]:=1;
tab1[i,j]:=2;
ik:=i;
jk:=j;
end;

3:begin
count:=count+10;
PrCount(count);
setfillstyle(1,White);
bar(x,y,x+dx-1,y+dy-1);
putimage(x,y,p^,xorput);
putimage(xk,yk,p^,xorput);
tab1[ik,jk]:=1;
tab1[i,j]:=2;
ik:=i;
jk:=j;
end;

4:begin
putimage(x,y,p^,xorput);
putimage(xk,yk,p^,xorput);
setcolor(13);
settextstyle(0,0,3);
if count<Prize*9 then
begin
outtextxy(30,70,'Вы проиграли!');
outtextxy(30,70,'Вы не набрали очки!');
end
else
begin
outtextxy(30,70,'Вы выиграли!');
outtextxy(30,70,'Нажмите клавишу Esc');
end;
end;
end;
tab1:=tab2;
end;


Procedure game;
begin
init;
DrawCol;
cleardevice;
PrCount(count);
DrawLab(ik,jk);
repeat
i:=ik;
j:=jk;
AnalyseKey(Key,i,j,ik,jk);
MoveLab(i,j,ik,jk);
until key=Esc;
closegraph;
end;

Procedure zastavka;
Var c,n:integer;
Begin
Cleardevice;
repeat
c:=random(15)+1;
n:=random(500)+500;
sound(n);
setcolor©;
Settextstyle(0,0,3);
Outtextxy(250,40,'‹ ЎЁаЁ­в');
Outtextxy(250,100,' ўв®а ‘ дЁг««Ё­  Ђ«с­ ');
Outtextxy(250,150,'ЇаҐЇ®¤ ў вҐ«м ‡ «ҐўбЄЁ© Ђавс¬ Ђ«ҐЄб ­¤а®ўЁз');
Outtextxy(250,300, '­ ¦¬ЁвҐ «оЎго Є« ўЁиг');
delay(500);
Nosound;
Until keypressed;
Cleardevice;
End;


Procedure menu;
var
np:integer;
begin
setcolor(12);
settextstyle(0,0,3);
outtextxy(250,40,'Меню');
outtextxy(50,200,'1. Игра');
outtextxy(50,240,'2. Помощь');
outtextxy(50,280,'3. Выход');
setcolor(14);
settextstyle(0,0,2);
outtextxy(150,400,'‚Выберите нужный пункт и нажмите enter');
np:=1;
putimage(400,200+(np-1)*40,p^,1);
repeat
key:=readkey;
if key=#0 then
begin
key:=readkey;
putimage(400,200+(np-1)*40,p^,1);
case key of
up:if np>1 then np:=np-1;
down:if np<3 then np:=np+1;
end;
putimage(400,200+(np-1)*40,p^,1);
end;
until key=enter;
case np of
1:game;
2:help;
3:halt;
end;
end;


begin

initgraph(grdriver,grmode,'c:\bgi');
Randomize;
zastavka;
init;
repeat
menu;
until 1=2;

End.


volvo
Цитата
Она сначала запускается, а потом вылетает.
Разумеется. Вот тут вылет происходит:

Цитата
        outtextxy(150,400,'‚Выберите нужный пункт и нажмите enter');
np:=1;
putimage(400,200+(np-1)*40,p^,1); { <--- Вот в этой самой строке }
А теперь - почему он происходит. Потому что ДО вызова Menu с указателем ничего не делалось, память не выделялась, новое значение указателю p не присваивалось. То есть, он равен nil... Итого, у тебя в программе одна из самых частых ошибок - "разыменование нулевого указателя". Вот как-то так ты делаешь:
Цитата
putimage(400, 200+(np-1)*40, nil^, 1);

Этого делать нельзя. В программе присутствует процедура DrawCol, в которой под p выделяется память, тебе надо вызвать ее перед обращением к меню...
Eichhorn
Спасибо!
TarasBer
> setcolor©;

Кстати, как от этой замены избавиться?
На юкозе та же проблема.

Автору - если это для ТурбоПаса, то используй русские шрифты, а то я запустил и не понял, что надо делать. Смена шрифта на векторный делается, кажись, через SetTextStyle, файлы с русскими векторными шрифтами можно найти, можно скачать редактор векторных шрифтов с моего сайта.
Eichhorn
Это free paskal.
У меня он тоже язык искажает при загрузке..(
И не знаю как исправить..
TarasBer
> И не знаю как исправить..

Я же сказал, что делать.
volvo
Цитата
Кстати, как от этой замены избавиться?
Не понял...
Нажмите для просмотра прикрепленного файла

А. Ну да. Пользуюсь FF со своей подсветкой синтаксиса, проблемы как не бывало... Если интересно - скажу, как установить такую подсветку. Возможно, и на Опере будет работать...

Цитата
Смена шрифта на векторный делается, кажись, через SetTextStyle
Для FPC это может не заработать. Там скорее всего придется идти другим путем. Чуть позже проверю...
TarasBer
> Ну да. Пользуюсь FF со своей подсветкой синтаксиса, проблемы как не бывало...

Это делает браузер?
Я думал, сайт.

Кстати, кнопка отправки не нажимается. И только тогда, когда я отрубаю жабаскрипт, сразу страница оживает.
Eichhorn
А меню игры почему не открывается? Или там чего-то не хватает? Я просто сижу сейчас с методичкой в руках, там больше ничего не написано... Только то, что у меня в программе..
volvo
Цитата
А меню игры почему не открывается? Или там чего-то не хватает?
Там слишком большие для FPC задержки. Попробуй уменьшить. Значит, смотри, для FPC последовательность такая:

0) вместо IDE Фри-Паскаля используем любой продвинутый текстовый редактор (у меня - SciTE);
1) исходник программы сохраняем в новый файл, в кодировке "UTF8 with BOM" (посмотри скриншот, я специально показал это меню) и правим текст сообщений (убираем кракозябры и пишем нормальные русские буквы smile.gif );
2) в самое начало кода пишем {$codepage utf8}
3) меняем устаревший Graph на более современный WinGraph, который абсолютно корректно работает с Юникодом, но его инициализацию придется сделать по-другому:
	grdriver := nopalette;
grmode := m800x600;
initgraph(grdriver, grmode, 'Alena');
;
4) не пользуемся "магическими константами" цветов (я же говорил об этом десятки раз, нет опять все пользуются 12 вместо LightRed. Ну, и к чему кроме проблем это приведет? WinGraph не будет работать с 12, зато будет с LightRed);
5) компилируем, запускаем и получаем вот такую картинку:
Нажмите для просмотра прикрепленного файла

Вот сам исходник в архиве:
Нажмите для просмотра прикрепленного файла
Я там пока просто поставил паузу при отрисовке меню, перед строкой где возникала ошибка, и закомментировал заставку.

(возражения вида "там где я буду сдавать нет этого редактора") - не принимаются smile.gif Вместо жмаканья по F7 в редакторе можно набрать fpc -B "F:\Programs\Pascal\lab_uni.pas" в командной строке, результат будет абсолютно тот же.

Как добиться аналогичного результата, используя только среду FPC - не знаю, у меня не русская Windows, так что проверить не смогу... Мой вариант работает везде (где есть юникод), независимо от настроек системы...
Eichhorn
Возражений вида "там где я буду сдавать нет этого редактора" и не будет) Я сдаю со своего ноутбука. Мне разрешили с него сдавать, тк я к нему долго паскаль найти не могла под Windows7. В итоге пишу на виртуальной ХР. Только я с редактором пока не могу разобраться... Он ошибку выдаёт при запуске этой программы..
Eichhorn
Я тут с уровнями ещё косяки пытаюсь исправить. Программа не выходит с последнего уровня.
Вот что я исправила:

Procedure MoveLab(Var i,j,ik,jk:integer);
Var
x,y,xk,yk:integer;
Begin
if (i=ik) and(j=jk) then
Exit;
x:=(j-1)*dx+nx;
y:=(i-1)*dy+ny;
xk:=(jk-1)*dx+nx;
yk:=(ik-1)*dy+ny;
case tab[i,j] of
0:begin
sound(500);
delay(20);
count:=count-2;
PrCount(count);
setcolor(12);
settextstyle(0,0,3);
outtextxy(450,200,'Stena');
i:=ik;
j:=jk;
nosound;
end;

1:begin
putimage(x,y,p^,xorput);
putimage(xk,yk,p^,xorput);
tab[ik,jk]:=1;
tab[i,j]:=2;
ik:=i;
jk:=j;
end;

3:begin
count:=count+10;
PrCount(count);
setfillstyle(1,White);
bar(x,y,x+dx-1,y+dy-1);
putimage(x,y,p^,xorput);
putimage(xk,yk,p^,xorput);
tab[ik,jk]:=1;
tab[i,j]:=2;
ik:=i;
jk:=j;
end;

4:begin
putimage(x,y,p^,xorput);
putimage(xk,yk,p^,xorput);
setcolor(13);
settextstyle(0,0,3);
if count<Prize*9 then
begin
outtextxy(30,70,'Vi proigrali!');
outtextxy(30,70,'Vi ne nabrali ochki!');
end
else
begin
outtextxy(30,70,'Vi viygrali!!');
outtextxy(30,70,'nazhmite Esc');
cleardevice;
case uroven of
1:begin
tab:=tab2;
uroven:=2;
end;
end;
drawlab(ik,jk);
i:=ik;
j:=jk;
end;
end;
end;
end;


Procedure game;
begin

init;
uroven:=1;
tab:=tab1;
cleardevice;
PrCount(count);
DrawLab(ik,jk);
repeat
i:=ik;
j:=jk;
AnalyseKey(Key,i,j,ik,jk);
MoveLab(i,j,ik,jk);
until key=Esc;
closegraph;
end;

volvo
Цитата
Только я с редактором пока не могу разобраться... Он ошибку выдаёт при запуске этой программы..
Показывай скриншот ошибки.
Eichhorn
Вот:
TarasBer
"Не удаётся найти указанный файл".
Это означает, что программе не удалось найти указанный файл.
Вот и ищи строку, на которой вылетает, и исправь имя файла на существующее.
А если посмотреть на вывод ошибок, то видно, что это не ошибка, выдываемая при запуске, а ошибка компиляции - не удаётся найти модуль wingraph.
Программу сама писала?
Откуда относительно адекватный стиль кода в сочетании с неумением читать ответ компилятора?
Eichhorn
Программу сама пишу. А с текстовыми редакторами я никогда не работала. Я вижу, что он файл найти не может, но не знаю почему... А программу пишу по методичкам, которые нам в библиотеке дали...
volvo
Цитата
Я вижу, что он файл найти не может, но не знаю почему...
Вот этот самый WinGraph:
Нажмите для просмотра прикрепленного файла

(тут мной было внесено несколько исправлений, люди на форумах жаловались, что модуль не всегда корректно работал. То, на что жаловались - пофиксил)

Распакуй этот файл туда же, в ту папку где лежит исходник, и перекомпилируй. Предупреждаю сразу: из-за кириллицы в пути тоже может возникнуть проблема. Нельзя положить исходники в другую папку, куда-нибудь в C:\MyProgs ?
Eichhorn
Что значит эта ошибка?:
volvo
Где-то End пропущен, и по мнению компилятора ты внутрь одной процедуры пытаешься вставить другую...
Eichhorn
О! Прогресс пошёл! Меню появилось! Только пока не работает...
Eichhorn
Это была ошибка... В программе ничего не меняла-перестал меню показывать...(
volvo
Цитата
В программе ничего не меняла-перестал меню показывать...(
"Так не бывает - тут помню, тут не помню" (С)

Вот эта версия (вместе с wingraph-ом, который я выложил чуть выше) прекрасно запускается из SciTE, отрабатывает заставку, показывает меню, и дает выбрать нужный пункт. Дальше тестировать не могу, это надо довольно много времени. Ах, да. Я там сверху добавил "пустышки" для Sound/NoSound, чтоб не мешало...
Eichhorn
Спасибо большое! Меню работает. Только игра глючит как только может... То прямоугольник нарисует чёрный, то ещё что-нибудь... Кажись, не успею я игру дописать... Слишком много непоняток у меня.. unsure.gif Вот что значит проболеть полсеместра... Сейчас с уровнями всё мучаюсь... Не хочет у меня программа выходить из последнего..
x2lk
Ну и код огромный Оо
where can i buy zithromax over t
Feline Amoxicillin
plaquenil side effects mayo clin
Cialis Generico Profesional
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.