Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Игры";
Текущий архив: 2004.01.09;
Скачать: [xml.tar.bz2];

Вниз

Глючный Тетрис.   Найти похожие ветки 

 
INCOGNITO   (2003-06-22 04:38) [0]

Здравствуйте!

Взялся написать тетрис... Банально, конечно, но надо же с чего-то начинать.

Короче, всё вроде работает, фигуры падают, поворачиваются... но как дошло дело до самого, казалось бы, несложного (начисления очков), прогу мою заглючило не по-детски :-(
Я уже замучался глюк этот искать. Вот, от безысходности решил помощи попросить... Может я какой мелочи не учёл или ещё чего... Короче, помогите, а то крыша съедет!

Вот кусок кода:

Примечания
tet - Игровое поле. двухмерный массив [1..h,1..w] of byte;
tet[i,j]=0 - значит, что клетка пуста;
tet[i,j]=1 - значит в этой клетке находится "упавший" блок;
tet[i,j]=2 - значит в этой клетке находится "летящий" блок;
tet[i,j]=5 - промежуточное значениедля сдвига массива вниз;
А проблемма в том, что иногда вместо очередного увелечения очков на 20 40 80 или 120 очков очки превращаются в заоблачное число!

{Процедура для очистки заполненных горизонтальных рядов и сдвига всего "нагромождения" вниз}
procedure ClearLines;
var
i, j, x : byte;
begin
CL:=0; // глобальная переменная типа byte (кол-во убранных рядов)
for i:=h downto 1 do
begin // цикл находит заполненные ряды и заменяет 1 на 5 в них.
x:=0;
for j:=w downto 1 do
if tet[i,j]=1 then x:=x+1;
if x=w then
begin
for j:=w downto 1 do
tet[i,j]:=5;
CL:=CL+1;
end;
end;
if CL=0 then Exit;
for i1:=1 to CL do // цикл сдвигает массив вниз
for i:=h downto 2 do
for j:=w downto 1 do
if tet[i,j]=5 then
begin
x:=tet[i,j];
tet[i,j]:=tet[i-1,j];
tet[i-1,j]:=x;
end;
for i:=1 to h do // цикл меняет уже ненужные 5 на 0
for j:=1 to w do
if tet[i,j]=5 then tet[i,j]:=0;
end;


procedure TfmMain.Timer1Timer(Sender: TObject);
var
i, j, air : byte;
begin
air:=0;
for i:=1 to h do // цикл для определения количества блоков, находящихся "в воздухе". Если air<4 значит летящая фигура коснулась "земли"
for j:=1 to w do
if (tet[i,j]=2)and(tet[i+1,j]<>1)and(i<h) then
air:=air+1;
// если фигура коснулась "земли"
if air<>nb then
begin
for i:=1 to h do
for j:=1 to w do
begin
if tet[i,j]=2 then tet[i,j]:=1;
tet[i,j,2]:=0;
end;
ClearLines; // !
case CL of // !
1 : scores:=scores+20; // !
2 : scores:=scores+40; // !
3 : scores:=scores+80; // !
4 : scores:=scores+160; // !
end;
lbInfo.Caption:=IntToStr(scores);
Randomize;
( Random(nf) Здравствуйте!

Взялся написать тетрис... Банально, конечно, но надо же с чего-то начинать.

Короче, всё вроде работает, фигуры падают, поворачиваются... но как дошло дело до самого, казалось бы, несложного (начисления очков), прогу мою заглючило не по-детски :-(
Я уже замучался глюк этот искать. Вот, от безысходности решил помощи попросить... Может я какой мелочи не учёл или ещё чего... Короче, помогите, а то крыша съедет!

Вот кусок кода:

Примечания
tet - Игровое поле. двухмерный массив [1..h,1..w] of byte;
tet[i,j]=0 - значит, что клетка пуста;
tet[i,j]=1 - значит в этой клетке находится "упавший" блок;
tet[i,j]=2 - значит в этой клетке находится "летящий" блок;
tet[i,j]=5 - промежуточное значениедля сдвига массива вниз;
А проблемма в том, что иногда вместо очередного увелечения очков на 20 40 80 или 120 очков очки превращаются в заоблачное число!

{Процедура для очистки заполненных горизонтальных рядов и сдвига всего "нагромождения" вниз}
procedure ClearLines;
var
i, j, x : byte;
begin
CL:=0; // глобальная переменная типа byte (кол-во убранных рядов)
for i:=h downto 1 do
begin // цикл находит заполненные ряды и заменяет 1 на 5 в них.
x:=0;
for j:=w downto 1 do
if tet[i,j]=1 then x:=x+1;
if x=w then
begin
for j:=w downto 1 do
tet[i,j]:=5;
CL:=CL+1;
end;
end;
if CL=0 then Exit;
for i1:=1 to CL do // цикл сдвигает массив вниз
for i:=h downto 2 do
for j:=w downto 1 do
if tet[i,j]=5 then
begin
x:=tet[i,j];
tet[i,j]:=tet[i-1,j];
tet[i-1,j]:=x;
end;
for i:=1 to h do // цикл меняет уже ненужные 5 на 0
for j:=1 to w do
if tet[i,j]=5 then tet[i,j]:=0;
end;


procedure TfmMain.Timer1Timer(Sender: TObject);
var
i, j, air : byte;
begin
air:=0;
for i:=1 to h do // цикл для определения количества блоков, находящихся "в воздухе". Если air<4 значит летящая фигура коснулась "земли"
for j:=1 to w do
if (tet[i,j]=2)and(tet[i+1,j]<>1)and(i<h) then
air:=air+1;
// если фигура коснулась "земли"
if air<>nb then
begin
for i:=1 to h do
for j:=1 to w do
begin
if tet[i,j]=2 then tet[i,j]:=1;
tet[i,j,2]:=0;
end;
ClearLines; // !
case CL of // !
1 : scores:=scores+20; // !
2 : scores:=scores+40; // !
3 : scores:=scores+80; // !
4 : scores:=scores+160; // !
end;
lbInfo.Caption:=IntToStr(scores);
Randomize;
CreateFigure(Random(nf)+1);
end
else
...

Надеюсь, ничего не забыл пояснить.
Оч. надеюсь на помощь, хотя понимаю, что вникнуть в чужой код довольно сложно...


Если кто-то может помочь, могу даже весь проект скинуть на мыло.


 
INCOGNITO   (2003-06-22 04:46) [1]

Пару опечаток нашёл:
tet[i,j, 2]:=0; - на самом деле массив 3-х мерный. Не обращайте на 2 внимания

В процедуре ClearLines забыл описать i1.


 
11132   (2003-06-22 16:08) [2]

Незнаю...
Это конечно глупо, но с Дельфёй всякое бывает, попробуй вместо
scores:=scores+20;
написать
inc(scores,20);
и то-же с остальными


 
Palladin   (2003-06-22 16:16) [3]


> 11132 (22.06.03 16:08)

дык ты значит программы на авось пишешь?


> INCOGNITO © (22.06.03 04:46)

кидай на palladin@pisem.net, я гляну...


 
cyborg   (2003-06-22 19:27) [4]

Range checking включи, узнаешь.

Когда ошибка выходит, залазишь в меню Search - FindError и вводишь адрес ошибки и смотришь.


 
Kobik   (2003-06-23 19:39) [5]

Что такое nb и где чему оно равно?
>>if air<>nb then ...

так как далее перед case CL of ... не стоит других проверок, наверное дело в этом.


 
INCOGNITO   (2003-06-23 19:51) [6]

nb-это количество блоков из которых фигура состоит (равно 4)
если оно не равно 4, значит один из элементов "летящей" фигуры коснулся "земли", т.е. самое время проверить, появились ли там целые ряды и, если появились, убрать их и очки подсчитать.



Страницы: 1 вся ветка

Форум: "Игры";
Текущий архив: 2004.01.09;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.48 MB
Время: 0.016 c
4-25638
npAKTuk
2003-11-07 06:43
2004.01.09
Как совершить перехват Message?


1-25354
BaDeVlad
2003-12-25 08:58
2004.01.09
Как сделать главную форму невидимой при запуске?


6-25493
May
2003-11-10 15:42
2004.01.09
Копирование файлов


3-25188
perova
2003-12-12 13:42
2004.01.09
Уважаемые мастера, подскажите, пожалуйста, как скрыть сценарий БД


6-25491
how
2003-10-12 14:51
2004.01.09
IMAP component





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский