{ 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; until (false); END.