((0,1,0,0), { dlhe I }
(0,1,0,0),
(0,1,0,0),
(0,1,0,0)),
((0,1,0,0), { opacne T }
(0,1,1,0),
(0,1,0,0),
(0,0,0,0)),
((0,0,0,0), { Z vpravo }
(0,1,1,0),
(1,1,0,0),
(0,0,0,0)),
((0,0,0,0), { Z vlavo }
(1,1,0,0),
(0,1,1,0),
(0,0,0,0)),
((0,0,1,0), { L vpravo }
(0,0,1,0),
(0,1,1,0),
(0,0,0,0)),
((0,1,0,0), { L vlavo }
(0,1,0,0),
(0,1,1,0),
(0,0,0,0)));
type t_option = (Put, Clr, Sav);
{ moznosti Put - nakreslit kocku }
{ Clr - zmaze kocku }
{ Save - ulozit kocku do pola }
{ pre ukladania rebricka }
t_top = record
meno:string[10];
body:integer;
end;
var pole:array[1..WIDTH,1..HEIGHT] of byte;
ptop:array[1..MAX_OS] of t_top;
body:integer; { pocet bodov }
tlev:integer; { pocitanie do dalsieho lavelu }
level:byte; { v akom levely sa nachadza }
ntyp,typ:byte; { typ kocky, dalsi typ kocky }
otoc:byte; { otocenie kocky }
ncol,col:byte; { farba kocky }
x,y:integer;
ch:char;
{ zlucenie GotoXY a Write }
procedure WriteXY(x,y:integer;s:string);
begin
GotoXY(LEFT+2*x,y);
Write(s);
end;
{ nastavi prazdne pole }
procedure ClrPole;
var x,y:integer;
begin
for x:=1 to WIDTH do
for y:=1 to HEIGHT do
Pole[x,y]:=0;
for y:=1 to MAX_OS do
begin
ptop[y].meno:='TrSek';
ptop[y].body:=(MAX_OS-y+1)*TO_LEV;
end;
end;
{ urci predchadzajuci prvok }
function TPred(otoc:byte):byte;
begin
TPred:=otoc-1;
if(otoc=1)then TPred:=4;
end;
{ urci nasledujuci prvok }
function TSucc(otoc:byte):byte;
begin
TSucc:=otoc+1;
if(otoc=4)then TSucc:=1;
end;
{ urci mensi prvok }
function Min(a,b:integer):integer;
begin
if(a<b)then
Min:=a
else
Min:=b;
end;
{ zapne/vypne zobrazenie kurzora }
procedure KurzorZap(ZapVyp:boolean);
var Regs : Registers;
begin
with Regs do
begin
AH := $03;
BH := $00;
Intr($10,Regs);
If not (Zapvyp) then
CH := CH or $20
else
CH := CH and $DF;
AH := $01;
Intr($10,Regs);
end;
end;
{ precita zo suboru hi-score }
procedure Load;
var f:file of t_top;
i:integer;
begin
{$I-}
Assign(f,F_SCORE);
ReSet (f);
for i:=1 to MAX_OS do
Read (f,ptop[i]);
Close (f);
{$I+}
{ vynulujem pripadne chyby }
i:=IOResult;
end;
{ ulozi do suboru hi-score }
procedure Save;
var f:file of t_top;
i:integer;
begin
{$I-}
Assign(f,F_SCORE);
ReWrite(f);
for i:=1 to MAX_OS do
Write (f,ptop[i]);
Close (f);
{$I+}
{ vynulujem pripadne chyby }
i:=IOResult;
end;
{ vypise jeden riadok score }
procedure WriteScore(y:integer);
var i:integer;
begin
{ zarovname na 10 znakov }
ptop[y].meno:=Copy(ptop[y].meno+' ',1,10);
{ vratime kurzor na zaciatok }
GotoXY(LEFT+2*WIDTH+8,y+2);
end;
{ precita zo suboru podklad }
procedure Podklad;
var f:text;
s:string;
x,y:integer;
begin
{$I-}
assign(f, F_PODKLAD);
reset(f);
TextColor(LightGray);
while( not(eof(f))) do
begin
ReadLn(f,s);
Write(s);
if(not(eof(f)))then WriteLn;
end;
close(f);
{$I+}
{ vynulujem pripadne chyby }
x:=IOResult;
{ vykresli vodiace ciary }
for y:=1 to HEIGHT do
for x:=1 to WIDTH do
begin
TextColor(FOOT[x mod 2]);
WriteXY(x,y,S_FOOT);
end;
{ vykresli rebricek top score }
for y:=1 to MAX_OS do
WriteScore(y);
end;
{ vykresli, zmaz, uloz kocku, alebo urci ci je mozne kocku polozit }
procedure Kocka(xp,yp,typ,otoc,col:integer;option:t_option);
var x,y: integer;
bod: byte;
begin
{ v cykle vygenerujeme jednotlive prvky kocky }
for y:=1 to 4 do
for x:=1 to 4 do
begin
case otoc of
1: bod := CUBE[typ,x,y];
2: bod := CUBE[typ,5-y,x];
3: bod := CUBE[typ,5-x,5-y];
4: bod := CUBE[typ,y,5-x];
end;
case option of
clr: { zmaze kocku }
if( bod=1 )then
begin
TextColor( FOOT[(x+xp) mod 2]);
WriteXY(xp+x,yp+y,S_FOOT);
end;
sav: { ulozi kocku do pola }
if( bod=1 )then
pole[x+xp,y+yp]:=col;
end; { case }
end; { for }
{ vypnem kurzor }
KurzorZap(false);
end;
{ zisti ci je mozne polozit kocku }
function KockaOK(xp,yp,typ,otoc:integer):boolean;
var x,y: integer;
bod: byte;
res: boolean;
begin
{ zatial si mysli ze kocku je mozne polozit }
res:=true;
{ v cykle vygenerujeme jednotlive prvky kocky }
for y:=1 to 4 do
for x:=1 to 4 do
begin
case otoc of
1: bod := CUBE[typ,x,y];
2: bod := CUBE[typ,5-y,x];
3: bod := CUBE[typ,5-x,5-y];
4: bod := CUBE[typ,y,5-x];
end;
{ este ci je tam volne miesto }
if( res )then
if( pole[x+xp,y+yp]<>0 )then
res:=false;
end; { if }
end; { for }
{ moja odpoved }
kockaOK:=res;
end;
{ vypise aktualne score }
procedure Score;
begin
TextColor(LightGray);
GotoXY(11,22);
Write(body,'0'); { lepse je ak pocita po desiatich }
GotoXY(11,23);
Write(level);
end;
{ prida score na pozadovane miesto }
procedure PridajScore(body:integer);
var y:integer;
begin
y:=MAX_OS;
{ posunieme meno a score }
while((y>1) and (body>=ptop[y-1].body)) do
begin
ptop[y].meno:=ptop[y-1].meno;
ptop[y].body:=ptop[y-1].body;
WriteScore(y);
y:=y-1;
end;
{ precitame a zarovname na 10 znakov }
KurzorZap(true);
Read(ptop[y].meno);
WriteScore(y);
end;
{ zmaze zaplneny riadok }
{ a ostane posunie nadol }
procedure ZmazRiadok(yr:integer);
var x,y:integer;
begin
TextColor(Black);
{ efekt postupneho mazania }
for x:=1 to WIDTH do
begin
WriteXY(x,yr,S_CUBE);
Delay(20);
end;
{ efekt padu riadkov }
for y:=yr downto 2 do
for x:=1 to WIDTH do
begin
pole[x,y]:=pole[x,y-1];
if( pole[x,y]=0 )then
begin
TextColor(FOOT[x mod 2]);
WriteXY(x,y,S_FOOT);
end
else begin
TextColor(pole[x,y]);
WriteXY(x,y,S_CUBE);
end
end;
end;
{ skontroluje ktore riadky ma zmazat }
procedure Skontroluj(yr:integer);
var x,y:integer;
del:boolean;
begin
for y:=yr to Min(yr+4, HEIGHT) do
begin
del:=true;
for x:=1 to WIDTH do
if( pole[x,y]=0 )then
del:=false;
if( del )then
begin
ZmazRiadok(y);
body:=body+level;
tlev:=tlev+1;
Score;
end;
end;
{ ideme do dalsieho levelu }
if( tlev>=TO_LEV )then
begin
tlev:=0;
level:=level+1;
Score;
end;
end;
{ precita stlacenu klavesu }
function GetKey(level:byte):char;
var i:integer;
ch:char;
begin
ch:=#0;
for i:=1 to 200-level*5 do
begin
{ ak stlacil precitam klaves }
if( keypressed )then
begin
ch:=readkey;
if( ch=#0 )then
ch:=readkey;
end;
delay(1);
end;
GetKey:=ch;
end;
BEGIN
ClrScr;
Randomize;
ClrPole;
Load;
Podklad;
body :=0;
tlev :=0;
level:=1;
Score;
y :=1;
ch:=#0;
ntyp:=random(7)+1;
ncol:=random(15)+1;
repeat
{ generuj kocku a next typ }
if( y=1 )then
begin
x := (WIDTH div 2)-2;
otoc := random(4)+1;
typ := ntyp;
col := ncol;
{ stary next typ zmazeme }
Kocka(-5,2,ntyp,1,Black,put);
{ next typ vygenerujeme a vykreslime }
ntyp := random(7)+1;
ncol := random(15)+1;
Kocka(-5,2,ntyp,1,ncol,put);
end;
{ nakresli }
Kocka(x,y,typ,otoc,col,put);
{ bud rychlo pada alebo citam klaves }
if( ch<>#32 )then
ch:=GetKey(level);
{ zmaz staru }
Kocka(x,y,typ,otoc,Black,clr);
{ podmienky otocit, vlavo, vpravo }
if(ch='K') and KockaOK(x-1,y,typ,otoc) then x:=x-1;
if(ch='M') and KockaOK(x+1,y,typ,otoc) then x:=x+1;
if(ch='P') and KockaOK(x,y,typ,TPred(otoc)) then otoc:=TPred(otoc);
if(ch='H') and KockaOK(x,y,typ,TSucc(otoc)) then otoc:=TSucc(otoc);
{ posuniem o riadok nizsie }
if( KockaOK(x,y+1,typ,otoc))then
y:=y+1
else
{ kocka spadla }
begin
Kocka(x,y,typ,otoc,col,put);
Kocka(x,y,typ,otoc,col,sav);
Skontroluj(y);
ch:=#0;
if(y=1) then ch:=#27; { niet kam polozit koncim }
y :=1;
end;
until( ch=#27 );
{ spracovanie do rebricka }
if( body >= ptop[MAX_OS].body )then
PridajScore(body);