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(' Û ÛÛÛÛÛ Û Û ÛÛ ÛÛÛ ÛÛÛ ');
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;
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.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 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;