Localize file www.TrSek.com/cover/sargo/t1.pas{ T1.PAS Copyright (c) Sargo }
{ }
{ Jedna sa o hru, v ktorej musite skladat objekty do skupiny }
{ minimalne troch stvorcekov vodorovne, zvislo alebo sikmo oba }
{ smermi. Hra pocita skore a konci pri zaplneni hracej plochy tak }
{ ze neni mozne pridat dalsi objekt. }
{ }
{ Hra sa ovlada 4-sipkami }
{ }
{ Zmena poradia stvorcekov v objetke }
{ I }
{ do lava <- -> do prava }
{ I }
{ Rychle posunutie objektu smerom dolu }
{ }
{ Author: Sargo }
{ Date : 29.07.2006 http://www.trsek.com }
program tetris;
uses crt;
var x,y,a,b,c,s :longint;
p :array[1..8,1..15] of longint;
k :array[1..3] of longint;
d,e :boolean;
procedure vym;
begin
for a:=1 to 3 do begin
gotoxy(x+33,y+a+11);
write(' ')
end
end;
procedure vyj;
begin
for a:=1 to 3 do begin
gotoxy(x+33,y+a+11);
textcolor(k[a]);
write('Û')
end
end;
procedure nova;
begin
for a:=1 to 3 do begin
k[a]:=random(4)+1;
if k[a]=3 then k[a]:=14
end;
x:=4;y:=1;
d:=true;
vyj;
if (p[x,y+1]<>0) or (p[x,y+1]<>0) or (p[x,y+1]<>0) then halt
end;
procedure vymazanie;
var z,y :longint;
begin
for z:=1 to 8 do
for y:=1 to 13 do
if (abs(p[z,y])=abs(p[z,y+1])) and (abs(p[z,y])=abs(p[z,y+2])) then
begin
if p[z,y ]>0 then p[z,y ]:=-p[z,y ] ;
if p[z,y+1]>0 then p[z,y+1]:=-p[z,y+1] ;
if p[z,y+2]>0 then p[z,y+2]:=-p[z,y+2]
end;
for z:=1 to 6 do
for y:=1 to 15 do
if (abs(p[z,y])=abs(p[z+1,y])) and (abs(p[z,y])=abs(p[z+2,y])) then
begin
if p[z ,y]>0 then p[z ,y]:=-p[z ,y] ;
if p[z+1,y]>0 then p[z+1,y]:=-p[z+1,y] ;
if p[z+2,y]>0 then p[z+2,y]:=-p[z+2,y]
end;
for z:=1 to 6 do
for y:=1 to 13 do
if (abs(p[z,y])=abs(p[z+1,y+1])) and (abs(p[z,y])=abs(p[z+2,y+2])) then
begin
if p[z ,y ]>0 then p[z ,y ]:=-p[z ,y ] ;
if p[z+1,y+1]>0 then p[z+1,y+1]:=-p[z+1,y+1] ;
if p[z+2,y+2]>0 then p[z+2,y+2]:=-p[z+2,y+2]
end;
for z:=1 to 6 do
for y:=1 to 13 do
if (abs(p[z,y+2])=abs(p[z+1,y+1])) and (abs(p[z,y+2])=abs(p[z+2,y])) then
begin
if p[z ,y+2]>0 then p[z ,y+2]:=-p[z ,y+2] ;
if p[z+1,y+1]>0 then p[z+1,y+1]:=-p[z+1,y+1] ;
if p[z+2,y ]>0 then p[z+2,y ]:=-p[z+2,y ]
end;
e:=false;
for z:=1 to 8 do
for y:=1 to 15 do
if p[z,y]<0 then
begin
gotoxy(z+33,y+11);
write(' ')
end;
delay(200);
for z:=1 to 8 do
for y:=1 to 15 do
if p[z,y]<0 then
begin
textcolor(abs(p[z,y]));
gotoxy(z+33,y+11);
write('Û')
end;
delay(200);
for z:=1 to 8 do
for y:=1 to 15 do
if p[z,y]<0 then
begin
gotoxy(z+33,y+11);
write(' ');
p[z,y]:=0;
e:=true;
textcolor(7);
inc(s);
gotoxy(10,12);write('Skore: ',s,0)
end;
repeat
d:=false;
for z:=1 to 8 do
for y:=15 downto 2 do
if (p[z,y]=0) and (p[z,y-1]<>0) then
begin
d:=true;
p[z,y]:=p[z,y-1];
p[z,y-1]:=0;
end;
for z:=1 to 8 do
for y:=1 to 15 do
begin
gotoxy(z+33,y+11);
textcolor(p[z,y]);
write('Û')
end;
until not(d);
if e then vymazanie
end;
begin
textmode(CO80 + Font8x8);
randomize;
clrscr;
textcolor(7);
gotoxy(10,12);write('Skore: ',s);
for a := 1 to 9 do begin gotoxy(a+33,27);write(chr(219));end;
for a := 1 to 15 do begin gotoxy(33,12+a);write(chr(219));gotoxy(42,12+a);write(chr(219));end;
nova;
repeat
for c:=1 to 200 do
begin
if d then delay(1);
if keypressed then case ord(readkey) of
75:if (x>1) and (p[x-1,y+1]=0) and (p[x-1,y+2]=0) and (p[x-1,y+3]=0) then begin vym;dec(x);vyj end;
77:if (x<8) and (p[x+1,y+1]=0) and (p[x+1,y+2]=0) and (p[x+1,y+3]=0) then begin vym;inc(x);vyj end;
80:d:=false;
72:begin a:=k[1];k[1]:=k[2];k[2]:=k[3];k[3]:=a;vyj end;
end
end;
if (y<12) and (p[x,y+4]=0) then
begin
vym;
inc(y);
vyj
end
else
begin
for a:=1 to 3 do p[x,y+a]:=k[a];
vymazanie;
nova
end;