Hra tetris v textovom mode

Category: KMP (Club of young programmers)

Author: Werbhofen
Program: Tetris.pas,  Kniznica.pas,  Tetrunit.pas,  Tetrdata.pas
File exe: Tetris.exe

{ 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;