{ TETRDATA.PAS } { Kniznica pre tetris. } { } { Author: WERBHOFEN } { Datum: 12.10.2009 http://www.trsek.com } procedure UvodnaObrazovka; var x,y:integer; begin NoSound; x:=4; y:=3; textmode(1); VymazKurzor; textcolor(FarbaKocka); textbackground(FarbaPozadie); clrscr; gotoxy(x,y+0); write('ллллл ллллл ллллл лллл ллл ллл '); gotoxy(x,y+1); write(' л л л л л л л л'); gotoxy(x,y+2); write(' л л л л л л л '); gotoxy(x,y+3); write(' л лллл л лллл л ллл '); gotoxy(x,y+4); write(' л л л ллл л л'); gotoxy(x,y+5); write(' л л л л лл л л л'); gotoxy(x,y+6); write(' л ллллл л л лл ллл ллл '); textcolor(4); gotoxy(x+10,y+10); writeln('Version 1.0'); gotoxy(x+10,y+11); write('by WERBHOFEN'); textcolor(26); WriteXY(x+8,19,'Press any key ...'); ClearKeyboardBuffer; g:=readkey; if g=#27 then KoniecProgramu:=true; clrscr; end; procedure Kraj; (* okraj hracej plochy nastavi tak, *) var m,n,sirka:byte; (* ako keby tam boli naukoladane kocky *) begin clrscr; for m:=XMin to XMax do for n:=YMin to YMax do HraciaPlocha[m,n]:=false; for m:=XMin to XMax do HraciaPlocha[m,YMin]:=true; for m:=XMin to XMax do HraciaPlocha[m,YMax]:=true; for n:=YMin to YMax do HraciaPlocha[XMin,n]:=true; for n:=YMin to YMax do HraciaPlocha[XMax,n]:=true; textbackground(FarbaOkraj); (* hracia plocha *) window(XMin,YMin,XMax,YMax); ClrScr; textbackground(FarbaPozadie); window(XMin+1,YMin+1,XMax-1,YMax-1); ClrScr; m:=2; sirka:=13; textbackground(FarbaOkraj); (* pravy kraj obrazovky *) window(XMax+m,1,XMax+m+sirka,25); clrscr; textbackground(FarbaPozadie); window(XMax+m+1,2,XMax+m+sirka-1,24); clrscr; textcolor(FarbaText); n:=2; m:=2; WriteXY(n,m,'Hi-Score'); GotoXY(n,m+1); Write(highscore:2); WriteXY(n,m+3,'Your Score'); GotoXY(n,m+4); Write(score:2); WriteXY(n-1,21,'Space=Pause'); WriteXY(n-1,22,' ESC=Quit'); window(1,1,40,25); end; procedure TKocka.Init(x,y:byte); var m,n:byte; begin poloha.x:=x; poloha.y:=y; smer:=1; TypKocky:=random(9); VyberTypKocky; end; procedure TKocka.Vykresli(c:char); var i,j:byte; begin textbackground(FarbaPozadie); textcolor(FarbaKocka); for i:=1 to 4 do for j:=1 to 4 do if K[i,j]=1 then WriteXY(round(poloha.x)+i,round(poloha.y)+j,c); end; procedure TKocka.VyberTypKocky; begin case TypKocky of 0: K:=ZL[smer]; 1: K:=ZP[smer]; 2: K:= I[smer]; 3: K:= O[smer]; 4: K:=LL[smer]; 5: K:=LP[smer]; 6: K:= T[smer]; 7: K:= X[smer]; 8: K:= Y[smer]; 9: K:= H[smer]; end; end; procedure TKocka.Posun(s:ShortInt); (* posunutie do stran *) var m,n:byte; hranica:boolean; begin hranica:=false; for m:=1 to 4 do for n:=1 to 4 do if K[m,n]=1 then if HraciaPlocha[round(poloha.x) + m + s, round(poloha.y) + n]=true then hranica:=true; if not hranica then Kocka.poloha.x:=Kocka.poloha.x + s; end; procedure TKocka.Otoc(s:ShortInt); var m,n:byte; DaSaOtocit:boolean; begin smer:=smer+s; if smer=5 then smer:=1; if smer=0 then smer:=4; VyberTypKocky; DaSaOtocit:=true; (* skontroluje ci je dost priestoru na hracej ploche *) for m:=1 to 4 do (* na otocenie kocky, ak nie tak ju vrati do povodnej *) for n:=1 to 4 do(* polohy *) if K[m,n]=1 then if HraciaPlocha[round(poloha.x) + m, round(poloha.y) + n]=true then DaSaOtocit:=false; if not DaSaOtocit then begin smer:=smer-s; if smer=5 then smer:=1; if smer=0 then smer:=4; VyberTypKocky; end; end; procedure PrekresliPlochu; var m,n:byte; begin for m:=XMin+1 to XMax-1 do for n:=YMin+1 to YMax-1 do if HraciaPlocha[m,n] then WriteXY(m,n,#219) else WriteXY(m,n,' '); end; procedure okno(x,y:byte;s:string;color:byte); begin textcolor(color); textbackground(FarbaOkraj); WriteXY(x,y,s); g:=readkey; textbackground(FarbaPozadie); textcolor(FarbaKocka); PrekresliPlochu; end; procedure KontrolaPlochy; (* skontroluje ci sa na hracej ploche nenachadza *) var m,n,k,l:byte; (* kompletny riadok, ked hej tak ho vymaze *) Kompletny:boolean; begin for n:=YMin+1 to YMax-1 do begin Kompletny:=true; for m:=XMin+1 to XMax-1 do if not HraciaPlocha[m,n] then Kompletny:=false; if Kompletny then begin score:=score+100; textcolor(FarbaText); GotoXY(30,7); Write(score); textcolor(FarbaKocka); for l:=n-1 downto YMin+1 do (* posunie celu hraciu plochu o policko dolu, *) for k:=XMin+1 to XMax-1 do (* cize vymaze riadok *) HraciaPlocha[k,l+1]:=HraciaPlocha[k,l]; end; end; PrekresliPlochu; end; function TKocka.Kontrola:boolean; var m,n:byte; (* skontroluje ci sa kocka uz dotkla spodneho *) begin (* okraja hracej plochy / inej kocky *) Kontrola:=false; for m:=1 to 4 do for n:=1 to 4 do if K[m,n]=1 then if HraciaPlocha[round(poloha.x) + m,round(poloha.y) + n {+ 1}] then begin Kontrola:=true; dotyk:=true; if zvuky then sound(1000); cakaj(10); nosound; end; if dotyk then begin for m:=1 to 4 do for n:=1 to 4 do if K[m,n]=1 then HraciaPlocha[round(poloha.x) + m, round(poloha.y) + n - 1]:=true; if poloha.y<=StartY then KoniecHry:=true; end; textbackground(FarbaOkraj); for m:=XMin to XMax do WriteXY(m,YMax,' '); end; procedure vymaz(oneskorenie:integer;zvuk:boolean); (* vymaze hracu plochu po ukonceni hry *) var y,r,i:integer; begin textbackground(FarbaOkraj); y:=YMax; i:=0; repeat (* maze z dola hore *) y:=y-1; i:=i+30; if zvuk and zvuky then sound(i); cakaj(oneskorenie); WriteXY(XMin+1,y,' '); until y=YMin+1; textbackground(FarbaPozadie); y:=YMin; repeat (* maze z hora dole *) y:=y+1; i:=i-30; if zvuk and zvuky then sound(i); cakaj(oneskorenie); WriteXY(XMin+1,y,' '); until y=YMax-1; nosound; end; procedure ZvukPrehra; var i:integer; begin if zvuky then begin i:=0; repeat i:=i+1; sound(random(500)); cakaj(10); until i=150; nosound; end; end;