Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Паскаль, Turbo Pascal, PascalABC.NET
Регистрация

Восстановить пароль

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 07.06.2010, 11:06   #1
ronil
 
Регистрация: 07.06.2010
Сообщений: 7
По умолчанию Недоделанный тетрис!)

Код:
program tetris;
uses
crt,graphABC;
var ss,nn,x,y,pus,a,b,c,d,lin,rlin:integer;
st:array[1..12,1..22] of integer;
n:integer;
  
procedure k(x,y:integer);
begin
gotoxy(x*2+30,24-y);
 if ss=0 then write('  ');
if ss=1 then write('()');
if ss=2 then write(chr(1));
if (ss=3) and (st[x,y]>0) then pus:=1;
if ss=4 then st[x,y]:=1;

end;

procedure fig(x,y,n,s:integer);
begin
 if s=3 then pus:=0;
 ss:=s; k(x,y);
 if n=1 then begin k(x+1,y);k(x,y-1);k(x+1,y-1) end;
 if n=2 then begin k(x-1,y);k(x+1,y);k(x+2,y) end;
 if n=3 then begin k(x,y+1);k(x,y-1);k(x,y-2) end;
 if n=4 then begin k(x+1,y);k(x-1,y);k(x-1,y+1) end;
 if n=5 then begin k(x,y+1);k(x+1,y+1);k(x,y-1) end;
 if n=6 then begin k(x-1,y);k(x+1,y);k(x+1,y-1) end;
 if n=7 then begin k(x,y+1);k(x,y-1);k(x-1,y-1) end;
 if n=8 then begin k(x-1,y);k(x+1,y);k(x+1,y+1) end;
 if n=9 then begin k(x,y+1);k(x,y-1);k(x+1,y-1) end;
 if n=10 then begin k(x+1,y);k(x-1,y);k(x-1,y-1) end;
 if n=11 then begin k(x,y+1);k(x,y-1);k(x-1,y+1) end;
 if n=12 then begin k(x-1,y);k(x,y-1);k(x+1,y-1) end;
 if n=13 then begin k(x,y+1);k(x-1,y);k(x-1,y-1) end;
 if n=14 then begin k(x+1,y);k(x-1,y-1);k(x,y-1) end;
 if n=15 then begin k(x-1,y);k(x,y-1);k(x-1,y+1) end;
 if n=16 then begin k(x+1,y);k(x-1,y);k(x,y+1) end;
 if n=17 then begin k(x+1,y);k(x,y+1);k(x,y-1) end;
 if n=18 then begin k(x,y-1);k(x-1,y);k(x+1,y) end;
 if n=19 then begin k(x-1,y);k(x,y+1);k(x,y-1) end
end;

procedure pov;
begin
 nn:=nn-1;
 if nn=15 then nn:=19;
 if nn=13 then nn:=15;
 if nn=11 then nn:=13;
 if nn=7 then nn:=11;
 if nn=3 then nn:=7;
 if nn=1 then nn:=3;
 if nn=0 then nn:=1;
end;

procedure clrst;
begin
for x:=1 to 12 do
for y:=1 to 22 do
if (x=1) or (x=12) or (y=1) then st[x,y]:=2 else st[x,y]:=0;
end;

procedure risvesst;
begin
for x:=1 to 12 do  for y:=1 to 22 do
begin
ss:=st[x,y];
k(x,y)
end;
end;

procedure dvig;
var
i:integer;key:char;
begin
for i:=1 to 10 do
begin
delay(d);
key:=' ';
if keypressed then key:=readkey;
if key='a' then
begin
fig(x-1,y,nn,3);
if pus=0 then begin fig(x,y,nn,0); x:=x-1; fig(x,y,nn,1);
end;
end;
if key='d' then
begin
fig(x+1,y,nn,3);
if pus=0 then begin fig(x,y,nn,0); x:=x+1; fig(x,y,nn,1);
end;
end;
if key='w' then
begin
pov; fig(x,y,nn,3); pov;pov;pov;
if pus=0 then begin fig(x,y,nn,0); pov; fig(x,y,nn,1);
end;
end;
if key='s' then d:=1;
end;
end;


begin
randomize;
clrscr;
clrst;
risvesst;
lin:=0;
repeat
nn:=1+random(18);
x:=6;y:=20; fig(x,y,nn,3); d:=70-(lin*5);
if pus=0 then
begin
repeat
fig(x,y,nn,1);
dvig;
fig(x,y-1,nn,3);
if pus=0 then begin fig(x,y,nn,0); y:=y-1;
end;
until pus=1;
fig(x,y,nn,4);
end;
risvesst;
pus:=0;
until pus=1;
end.
Это тетрис который немного не доделанный ,но это не главное) Я эту задачу скачал с инета и показал препадУ и он меня попросил объяснить как она работает и написать коментарии((
Добрые люди) прошу вас помогите мне плиз!! Нужны коментарии к каждому процессу. Помогите кто сможет)

Последний раз редактировалось Stilet; 07.06.2010 в 11:25.
ronil вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Не просто тетрис Сергей37912 Мультимедиа в Delphi 1 26.05.2010 02:47
Тетрис k1r1ch Gamedev - cоздание игр: Unity, OpenGL, DirectX 2 02.01.2010 12:20
Мой тетрис Виталий Серов Gamedev - cоздание игр: Unity, OpenGL, DirectX 2 31.05.2009 01:23
Тетрис на VBA TheHolyDemon Microsoft Office Excel 4 30.05.2009 11:37
массив и тетрис sid Паскаль, Turbo Pascal, PascalABC.NET 2 04.04.2007 14:41