Gry Logiczne - Tetris

Prezentowane poniżej programy utworzono w następujących środowiskach programowania:

Jeśli stosujesz inne środowiska, to prawdopodobnie będziesz musiał przetworzyć odpowiednio kod programów.

Programy

Strona tytułowa gry
Wybór poziomu i zapełnienia
Przykładowa rozgrywka

Program w języku Pascal

//               T E T R I S
//            WERSJA  FUNKCYJNA
//--------------------------------------------
// (C)2004 mgr Jerzy Wałaszek  I LO w Tarnowie

program GraTetris;

uses Crt, Windows;

//----------------------------------------------------
// PROCEDURY I FUNKCJE POMOCNICZE
//----------------------------------------------------

// Funkcja PL konwertuje tekst ze standardu Windows 1250
// na standard konsoli znakowej Latin II
//------------------------------------------------------
function PL(s : string) : string;
var
  i : integer;
  c : char;
begin
  for i := 1 to length(s) do
  begin
   case s[i] of
      'ą' : c := #165;
      'ć' : c := #134;
      'ę' : c := #169;
      'ł' : c := #136;
      'ń' : c := #228;
      'ó' : c := #162;
      'ś' : c := #152;
      'ż' : c := #190;
      'ź' : c := #171;
      'Ą' : c := #164;
      'Ć' : c := #143;
      'Ę' : c := #168;
      'Ł' : c := #157;
      'Ń' : c := #227;
      'Ó' : c := #224;
      'Ś' : c := #151;
      'Ż' : c := #189;
      'Ź' : c := #141;
      else
        c := s[i]; 
    end;
    s[i] := c;
  end;
  Result := s;
end;

// Procedura centruje w bieżącym wierszu
// tekst podany jako parametr
//----------------------------------------------------
procedure Centruj(t : string);
begin
  GotoXY(1 + (80-length(t)) div 2, WhereY);
  writeln(t);
end;

// Procedura rysuje pojedynczą ramkę ze znaków
// tabelek. Parametry określają współrzędne
// lewego górnego i prawego dolnego narożnika
//----------------------------------------------------
procedure Ramka(xp,yp,xk,yk : integer);
var
  i : integer;
begin
  GotoXY(xp,yp); write(#218);
  GotoXY(xp,yk); write(#192);
  GotoXY(xk,yp); write(#191);
  GotoXY(xk,yk); write(#217);
  for i := xp + 1 to xk - 1 do
  begin
    GotoXY(i,yp); write(#196);
    GotoXY(i,yk); write(#196);
  end;
  for i := yp + 1 to yk - 1 do
  begin
    GotoXY(xp,i); write(#179);
    GotoXY(xk,i); write(#179);
  end;
end;

// Procedura przesuwa w dół o jeden wiersz
// prostokątny obszar okna konsoli. Współrzędne
// definiują obszar przesunięcia. Atrybut definiuje
// kolor pierwszego wiersza, który zostanie uzupełniony
// po przesunięciu.
//----------------------------------------------------
procedure PrzesunOkno(xp,yp,xk,yk,attr : integer);
var
  Standardowe_Wyjscie      : HANDLE ;
  Prostokat_Przewijania,
  Prostokat_Ograniczenia   : SMALL_RECT ;
  Struktura_Wypelniania    : CHAR_INFO ;
  Wspolrzedne_Przesuniecia : COORD ;
begin
  Standardowe_Wyjscie              := GetStdHandle(STD_OUTPUT_HANDLE);
  Prostokat_Przewijania.Top        := yp - 1;
  Prostokat_Przewijania.Bottom     := yk - 1;
  Prostokat_Przewijania.Left       := xp - 1;
  Prostokat_Przewijania.Right      := xk - 1;
  Wspolrzedne_Przesuniecia.X       := xp - 1;
  Wspolrzedne_Przesuniecia.Y       := yp;
  Prostokat_Ograniczenia           := Prostokat_Przewijania;
  Struktura_Wypelniania.Attributes := attr;
  Struktura_Wypelniania.AsciiChar  := ' ';
  ScrollConsoleScreenBuffer(Standardowe_Wyjscie,
                            Prostokat_Przewijania,
                            Prostokat_Ograniczenia,
                            Wspolrzedne_Przesuniecia,
                            Struktura_Wypelniania)
end;

//------------------------------------------------------
// PROGRAM GRY
//------------------------------------------------------

//------------------------------------------------------
// Struktury danych wykorzystywane w programie
//------------------------------------------------------
type

  figura = array[1..4] of string[16];

const
  zestaw : array[1..7] of figura = (
  ('XXXX X        X ',
   '     X        X ',
   '     X  XXXX  X ',
   '     X        X '),
  ('XXX X        XX ',
   'X   X     X   X ',
   '    XX  XXX   X ',
   '                '),
  ('XXX XX        X ',
   '  X X   X     X ',
   '    X   XXX  XX ',
   '                '),
  (' XX X    XX X   ',
   'XX  XX  XX  XX  ',
   '     X       X  ',
   '                '),
  ('XX   X  XX   X  ',
   ' XX XX   XX XX  ',
   '    X       X   ',
   '                '),
  ('XXX X         X ',
   ' X  XX   X   XX ',
   '    X   XXX   X ',
   '                '),
  ('XX  XX  XX  XX  ',
   'XX  XX  XX  XX  ',
   '                ',
   '                '));

var
  pole_gry : array[1..24] of string[14];
  obecny, obecny_kolor, obecny_obrot, obecny_x, obecny_y,
  nastepny, nastepny_kolor,
  zapelnienie, punkty,poziom,wiersze : integer;

//------------------------------------------------------
// Procedury i funkcje wykorzystywane przez program gry
//------------------------------------------------------

// Procedura wyświetla stronę tytułową gry Tetris, czeka
// na wciśnięcie klawisza, czyści ekran i kończy.
//------------------------------------------------------
procedure StronaTytulowa;
begin
  TextAttr := $07; ClrScr;
  GotoXY(1,4);
  TextAttr := $1f;
  Centruj(PL('                                  '));
  Centruj(PL('            T E T R I S           '));
  Centruj(PL('                                  '));
  TextAttr := $2e;
  Centruj(PL('                                  '));
  Centruj(PL('    (C)2004 mgr Jerzy Wałaszek    '));
  Centruj(PL('                                  '));
  TextAttr := $3f;
  Centruj(PL('                                  '));
  Centruj(PL('     I Liceum Ogólnokształcące    '));
  Centruj(PL('   im. Kazimierza  Brodzińskiego  '));
  Centruj(PL('             w Tarnowie           '));
  Centruj(PL('                                  '));
  TextAttr := $f1;
  Centruj(PL('                                  '));
  Centruj(PL('     Zbadaj swoje umiejętności    '));
  Centruj(PL(' szybkiego i logicznego myślenia  '));
  Centruj(PL('                                  '));
  TextAttr := $f4;
  Centruj(PL('        Gdy będziesz gotowy,      '));
  Centruj(PL('     naciśnij dowolny klawisz     '));
  Centruj(PL('                                  '));
  TextAttr := $09; Ramka(23,3,58,22);
  while ReadKey = #0 do; // Oczekiwanie na dowolny klawisz
  TextAttr := $07; ClrScr;
end;

// Procedura umożliwia wybór poziomu startowego dla gry.
// Pozwala również określić wstępne zapełnienie pola gry
// kwadratami, które będą ułożone losowo we wybranej
// ilości dolnych rzędów.
//------------------------------------------------------
procedure WyborPoziomu;
var
  i,j : integer;
  c   : char;
begin
  poziom := 1; zapelnienie := 0;
  repeat
    TextAttr := $09; Ramka(1,1,12,24);
    TextAttr := $ff;
    for i := 2 to 23 - zapelnienie do
    begin
      GotoXY(2,i); write('          ');
    end;
    for i := 24 - zapelnienie to 23 do
    begin
      GotoXY(2,i);
      for j := 1 to 10 do
        if random(2) = 0 then
        begin
           TextAttr := random(15)*16; write('_');
        end
        else
        begin
          TextAttr := $ff; write(' ');
        end;
    end;
    TextAttr := $0c;
    GotoXY(15,5); writeln('T E T R I S');
    GotoXY(15,6); writeln('===========');
    TextAttr := $0e;
    GotoXY(15,8); writeln('Poziom startowy....... : ',poziom:2);
    GotoXY(15,10); writeln(PL('Zapełnienie początkowe : '),zapelnienie:2);
    TextAttr := $0f; GotoXY(15,12);
    writeln(PL('Klawisze sterujące:'));
    GotoXY(15,14);
    writeln(PL('[+/-]   - zwiększenie, zmniejszenie poziomu'));
    GotoXY(15,16);
    writeln(PL('[Z/X]   - zwiększenie, zmniejszenie zapełnienia'));
    GotoXY(15,18);
    writeln(PL('[Enter] - zatwierdzenie zmian i rozpoczęcie gry'));
    c := UpCase(ReadKey);
    case c of
      '+' : if poziom < 9 then Inc(poziom);
      '-' : if poziom > 1 then Dec(poziom);
      'Z' : if zapelnienie < 15 then Inc(zapelnienie);
      'X' : if zapelnienie > 0  then Dec(zapelnienie);
    end;
  until c = #13;
end;

// Ustawia i wyświetla pole gry
//------------------------------------------------------
procedure PoleGry;
var
  i,j : integer;
begin
  for i := 1 to 24 do
    if i < 23 then
      pole_gry[i] := 'XX          XX'
    else
      pole_gry[i] := 'XXXXXXXXXXXXXX';
  TextAttr := $07; ClrScr;
  TextAttr := $09; Ramka(34,1,45,24);
  for i := 1 to 22 do
  begin
    GotoXY(35,i+1); TextAttr := $f0;
    if i < 23 - zapelnienie then
      write('          ')
    else
      for j := 1 to 10 do
        if random(2) = 1 then
        begin
          TextAttr := random(15) * 16; write('_'); pole_gry[i][j+2] := 'X';
        end
        else
        begin
          TextAttr := $f0; write(' ');
        end;
  end;
end;

// Wyświetla nagłówek na planszy gry
//------------------------------------------------------
procedure Logo;
begin
  TextAttr := $0c;
  GotoXY(52,2); write('G R A  W   T E T R I S');
  TextAttr := $0e;
  GotoXY(50,3); write(PL('(C)2004 mgr Jerzy Wałaszek'));
  TextAttr := $0f;
  GotoXY(50,4); write(PL('I Liceum  Ogólnokształcące'));
  GotoXY(59,5); write('w Tarnowie');
  TextAttr := $09; Ramka(48,1,77,6);
end;

// Procedura wyświetla na planszy opis klawiszy.
//------------------------------------------------------
procedure Opis;
begin
  TextAttr := $09; Ramka(3,1,31,24);
  TextAttr := $07;
  GotoXY(4,6); write(PL('Klawisze sterujące grą'));
  GotoXY(4,7); write('======================');
  TextAttr := $0f;
  GotoXY(4,9);  write(PL('[w górę]     - obrót'));
  GotoXY(4,11); write('[prawo/lewo] - ruch');
  GotoXY(4,13); write(PL('[w dół]      - upuszczenie'));
  GotoXY(4,15); write('[Spacja]     - pauza');
  GotoXY(4,17); write(PL('[Escape]     - koniec gry'));
end;

// Procedura wyświetla na planszy następną figurę, czyli
// element, który weźmie udział w grze po opuszczeniu
// bieżącej figury
//------------------------------------------------------
procedure NastepnaFigura;
var
  i,j     : integer;
  ksztalt : string[4];
begin
  TextAttr := $09; Ramka(48,8,77,15);
  TextAttr := $ff;
  for i := 9 to 14 do
  begin
    GotoXY(49,i); write('                            ');
  end;
  TextAttr := $f4; GotoXY(55,9); write(PL('Następna figura'));
  for i := 1 to 4 do
  begin
    GotoXY(61,10+i); ksztalt := zestaw[nastepny][i];
    for j := 1 to 4 do
      if ksztalt[j] = 'X' then
      begin
        TextAttr := nastepny_kolor; write('_');
      end
      else
      begin
        TextAttr := $ff; write(' ');
      end;
  end;
end;

// Procedura wyświetla poziom oraz punkty
//------------------------------------------------------
procedure PoziomPunkty;
begin
  TextAttr := $09; Ramka(48,17,77,24);
  TextAttr := $0c; GotoXY(55,18);
  write(PL('Bieżąca punktacja'));
  TextAttr := $0e;
  GotoXY(56,20); write('Poziom : ',poziom:6);
  GotoXY(56,22); write('Wynik  : ',punkty:6);
end;

// Procedura ustawia planszę gry i wyświetla ją w oknie
// konsoli wraz ze wszystkimi napisami gry
//------------------------------------------------------
procedure Plansza;
begin
  nastepny := random(7) + 1; nastepny_kolor := random(15) * 16;
  wiersze := 0; punkty := 0;
  PoleGry;
  Opis;
  Logo;
  NastepnaFigura;
  PoziomPunkty;
end;

// Procedura losuje kolejny kawałek
//------------------------------------------------------
procedure Losuj;
begin
  obecny := nastepny; obecny_kolor := nastepny_kolor;
  nastepny := 1 + random(7); nastepny_kolor := random(15) * 16;
  NastepnaFigura;
  obecny_x := 6; obecny_y := 1; obecny_obrot := 1;
end;

// Funkcja sprawdza, czy podany kawałek da się wprowadzić
// na planszę gry. Jeśli nie, to zwraca true.
//------------------------------------------------------
function Kolizja(figura,obrot,x,y : integer) : boolean;
var
  i,j     : integer;
  ksztalt : string[4];
begin
  for i := 1 to 4 do
  begin
    ksztalt := Copy(zestaw[figura][i],1 + 4 * (obrot - 1),4);
    for j := 1 to 4 do
      if (ksztalt[j] = 'X') and (pole_gry[y + i - 1][x + j - 1] = 'X') then
      begin
        Result := true; Exit;
      end;
  end;
  Result := false;
end;

// Procedura dla tryb = true wyświetla bieżącą figurę
// na jej aktualnych współrzędnych w obrębie planszy
// gry, a dla tryb = false usuwa tę figurę z planszy
//------------------------------------------------------
procedure PokazFigure(tryb : boolean);
var
  i,j     : integer;
  ksztalt : string[4];
begin
  if tryb then
    TextAttr := obecny_kolor
  else
    TextAttr := $ff;
  for i := 1 to 4 do
  begin
    ksztalt := Copy(zestaw[obecny][i],1 + 4 * (obecny_obrot - 1),4);
    for j := 1 to 4 do
      if ksztalt[j] = 'X' then
      begin
        GotoXY(31 + obecny_x + j, obecny_y + i);
        if tryb then write('_') else write(' ');
      end;
  end;
end;

procedure Ruch_w_lewo;
begin
  if not Kolizja(obecny,obecny_obrot,obecny_x-1,obecny_y) then
  begin
    PokazFigure(false); dec(obecny_x); PokazFigure(true);
  end;
end;

procedure Ruch_w_prawo;
begin
  if not Kolizja(obecny,obecny_obrot,obecny_x+1,obecny_y) then
  begin
    PokazFigure(false); inc(obecny_x); PokazFigure(true);
  end;
end;

procedure Obrot;
var
  xobo : integer;
begin
  xobo := obecny_obrot + 1; if xobo > 4 then xobo := 1;
  if not Kolizja(obecny,xobo,obecny_x,obecny_y) then
  begin
    PokazFigure(false); obecny_obrot := xobo; PokazFigure(true);
  end;
end;

function Ruch_w_dol : boolean;
begin
  if not Kolizja(obecny,obecny_obrot,obecny_x,obecny_y+1) then
  begin
    PokazFigure(false); inc(obecny_y); PokazFigure(true);
    Result := true;
  end
  else Result := false;
end;

// Procedura wpisuje bieżący kawałek do planszy gry
//------------------------------------------------------
procedure Wpisz;
var
  i,j     : integer;
  ksztalt : string[4];
begin
  for i := 1 to 4 do
  begin
    ksztalt := Copy(zestaw[obecny][i],1 + 4 * (obecny_obrot - 1),4);
    for j := 1 to 4 do
      if ksztalt[j] = 'X' then
        pole_gry[obecny_y + i - 1][obecny_x + j - 1] := 'X';
  end;
end;

// Procedura przegląda pole gry i usuwa z niego każdy
// pełny wiersz. Ilość usuniętych wierszy jest zliczana
// i służy później do zwiększenia punktacji gracza.
//------------------------------------------------------
procedure UsunPelneWiersze;
var
  i,j,licznik_wierszy : integer;
begin
  licznik_wierszy := 0; i := 22;
  while i > 0 do
  begin
    if pole_gry[i] = 'XXXXXXXXXXXXXX' then
    begin
      inc(licznik_wierszy);
      for j := i downto 2 do
        pole_gry[j] := pole_gry[j - 1];
      pole_gry[1] := 'XX          XX';
      PrzesunOkno(35,2,44,i+1,$f0);
    end
    else dec(i);
  end;
  case licznik_wierszy of
    1 : inc(punkty,50);
    2 : inc(punkty,150);
    3 : inc(punkty,300);
    4 : inc(punkty,600);
  end;
  inc(wiersze,licznik_wierszy);
  if wiersze > 50 then
  begin
    wiersze := wiersze - 50;
    inc(punkty,1000);
    if poziom < 9 then inc(poziom);
  end;
end;

// Procedura upuszcza bieżący kawałek
//------------------------------------------------------
procedure Upuszczenie;
begin
  while Ruch_w_dol do
  begin
    Inc(punkty); PoziomPunkty; Delay(10);
  end;
  Wpisz; UsunPelneWiersze; inc(punkty,5); PoziomPunkty;
end;

// Funkcja obsługuje ruch figury w obrębie planszy.
// Zwraca true, jeśli w trakcie wstawiania nowej figury
// następuje kolizja z zawartością pola gry.
//------------------------------------------------------
function Brak_Miejsca : boolean;
var
  c     : char;
  lc,li : integer;
begin
  if Kolizja(obecny,obecny_obrot,obecny_x,obecny_y) then
  begin
    PokazFigure(true); Result := true;
  end
  else
  begin
    lc := 100 - 10 * (poziom - 1); li := lc;
    PokazFigure(true);
    repeat // UWAGA - to jest pętla nieskończona
      if KeyPressed then
      begin
        repeat c := ReadKey; until c <> #0;
        case c of
          #27 : begin
                  Result := true; Exit;
                end;
          #32 : while ReadKey <> #32 do;
          #75 : Ruch_w_lewo;
          #77 : Ruch_w_prawo;
          #72 : Obrot;
          #80 : begin
                  Upuszczenie; break; // Wyjście z pętli
                end;
        end;
      end;
      Dec(li); Delay(8);
      if li = 0 then
      begin
        li := lc;
        if not Ruch_w_dol then
        begin
          Wpisz; UsunPelneWiersze; inc(punkty,5); PoziomPunkty;
          break; // Wyjście z pętli
        end;
      end;
    until false;
    Result := false;
  end;
end;

// Procedura przeprowadza rozgrywkę w Tetris
//------------------------------------------------------
procedure Gra;
begin
  Plansza;
  repeat
    Losuj;
  until Brak_Miejsca;
  while KeyPressed do
  begin
    ReadKey; Delay(100);
  end;
end;

// Funkcja zwraca true, jeśli gracz chce zakończyć grę.
//------------------------------------------------------
function KoniecGry : boolean;
begin
  GotoXY(1,11); TextAttr := $4e;
  Centruj('                                       ');
  Centruj(' Jeszcze raz ? [T] = Tak, [Inny] = Nie ');
  Centruj('                                       ');
  Result := UpCase(ReadKey) <> 'T';
end;

//------------------------------------------------------
// Tutaj rozpoczyna się program główny
//------------------------------------------------------

var
  a : integer;

begin
  Randomize;
  a := TextAttr; CursorOff;
  repeat
    StronaTytulowa;
    WyborPoziomu;
    Gra;
  until KoniecGry;
  TextAttr := a; CursorOn; ClrScr;
end.

Program obiektowy w języku Pascal

//               T E T R I S
//            WERSJA  OBIEKTOWA
//--------------------------------------------
// (C)2004 mgr Jerzy Wałaszek  I LO w Tarnowie

program GraTetris;

uses Crt, Windows;

//----------------------------------------------------
// PROCEDURY I FUNKCJE POMOCNICZE
//----------------------------------------------------

// Funkcja PL konwertuje tekst ze standardu Windows 1250
// na standard konsoli znakowej Latin II
//------------------------------------------------------
function PL(s : string) : string;
var
  i : integer;
  c : char;
begin
  for i := 1 to length(s) do
  begin
   case s[i] of
      'ą' : c := #165;
      'ć' : c := #134;
      'ę' : c := #169;
      'ł' : c := #136;
      'ń' : c := #228;
      'ó' : c := #162;
      'ś' : c := #152;
      'ż' : c := #190;
      'ź' : c := #171;
      'Ą' : c := #164;
      'Ć' : c := #143;
      'Ę' : c := #168;
      'Ł' : c := #157;
      'Ń' : c := #227;
      'Ó' : c := #224;
      'Ś' : c := #151;
      'Ż' : c := #189;
      'Ź' : c := #141;
      else
        c := s[i]; 
    end;
    s[i] := c;
  end;
  Result := s;
end;

// Procedura centruje w bieżącym wierszu
// tekst podany jako parametr
//----------------------------------------------------
procedure Centruj(t : string);
begin
  GotoXY(1 + (80-length(t)) div 2, WhereY);
  writeln(t);
end;

// Procedura rysuje pojedynczą ramkę ze znaków
// tabelek. Parametry określają współrzędne
// lewego górnego i prawego dolnego narożnika
//----------------------------------------------------
procedure Ramka(xp,yp,xk,yk : integer);
var
  i : integer;
begin
  GotoXY(xp,yp); write(#218);
  GotoXY(xp,yk); write(#192);
  GotoXY(xk,yp); write(#191);
  GotoXY(xk,yk); write(#217);
  for i := xp + 1 to xk - 1 do
  begin
    GotoXY(i,yp); write(#196);
    GotoXY(i,yk); write(#196);
  end;
  for i := yp + 1 to yk - 1 do
  begin
    GotoXY(xp,i); write(#179);
    GotoXY(xk,i); write(#179);
  end;
end;

// Procedura przesuwa w dół o jeden wiersz
// prostokątny obszar okna konsoli. Współrzędne
// definiują obszar przesunięcia. Atrybut definiuje
// kolor pierwszego wiersza, który zostanie uzupełniony
// po przesunięciu.
//----------------------------------------------------
procedure PrzesunOkno(xp,yp,xk,yk,attr : integer);
var
  Standardowe_Wyjscie      : HANDLE ;
  Prostokat_Przewijania,
  Prostokat_Ograniczenia   : SMALL_RECT ;
  Struktura_Wypelniania    : CHAR_INFO ;
  Wspolrzedne_Przesuniecia : COORD ;
begin
  Standardowe_Wyjscie              := GetStdHandle(STD_OUTPUT_HANDLE);
  Prostokat_Przewijania.Top        := yp - 1;
  Prostokat_Przewijania.Bottom     := yk - 1;
  Prostokat_Przewijania.Left       := xp - 1;
  Prostokat_Przewijania.Right      := xk - 1;
  Wspolrzedne_Przesuniecia.X       := xp - 1;
  Wspolrzedne_Przesuniecia.Y       := yp;
  Prostokat_Ograniczenia           := Prostokat_Przewijania;
  Struktura_Wypelniania.Attributes := attr;
  Struktura_Wypelniania.AsciiChar  := ' ';
  ScrollConsoleScreenBuffer(Standardowe_Wyjscie,
                            Prostokat_Przewijania,
                            Prostokat_Ograniczenia,
                            Wspolrzedne_Przesuniecia,
                            Struktura_Wypelniania)
end;

//------------------------------------------------------
// PROGRAM GRY
//------------------------------------------------------

//*****************************************************************************
//*****************************************************************************
//*****************************************************************************

// Definicja obiektu figury
//------------------------------------------------------

type

  ksztalt = array[1..4] of string[4];

  TFigura = class
      figura       : integer;
      obrot        : integer;
      wsp_x, wsp_y : integer;
      kolor        : integer;
      constructor Tworz;
      procedure   Kopiuj(f : TFigura);
      procedure   Losuj;
      function    Pobierz : ksztalt;
      procedure   RysujWymaz(tryb : boolean);
  end;

// Tylko podstawowa funkcja konstruktora
//------------------------------------------------------
constructor TFigura.Tworz;
begin
end;

// Procedura przepisuje z obiektu źródłowego dane
//------------------------------------------------------

procedure TFigura.Kopiuj(f : TFigura);
begin
  figura := f.figura; obrot  := f.obrot; kolor  := f.kolor;
  wsp_x  := 6; wsp_y := 1;
end;

// Funkcja zwraca definicję kształtu figury na podstawie
// jej numeru (1..7) oraz obrotu (1..4). Kształt figury jest
// skompilowany w zmiennej ks. Każdy wiersz to jedna figura.
// Wiersz składa się z 4 ciągów po 16 znaków.
//------------------------------------------------------
function TFigura.Pobierz : ksztalt;
const
  ks : array[1..7] of string[64] =
('XXXX X        X      X        X      X  XXXX  X      X        X ',
 'XXX X        XX X   X     X   X     XX  XXX   X                 ',
 'XXX XX        X   X X   X     X     X   XXX  XX                 ',
 ' XX X    XX X   XX  XX  XX  XX       X       X                  ',
 'XX   X  XX   X   XX XX   XX XX      X       X                   ',
 'XXX X         X  X  XX   X   XX     X   XXX   X                 ',
 'XX  XX  XX  XX  XX  XX  XX  XX                                  ');
var
  k : ksztalt;
  i : integer;
begin
  for i := 1 to 4 do
    k[i] := Copy(ks[figura],1 + 16 * (i - 1) + 4 * (obrot - 1),4);
  Result := k
end;

// Metoda losuje figurę oraz jej kolor
//------------------------------------------------------
procedure TFigura.Losuj;
begin
  kolor  := random(15) * 16;
  figura := 1 + random(7);
  obrot  := 1;
end;

// Procedura dla tryb = true wyświetla bieżącą figurę
// na jej aktualnych współrzędnych w obrębie planszy
// gry, a dla tryb = false usuwa tę figurę z planszy
//------------------------------------------------------
procedure TFigura.RysujWymaz(tryb : boolean);
var
  i,j : integer;
  k   : ksztalt;
begin
  if tryb then TextAttr := kolor else TextAttr := $ff;
  k := Pobierz;
  for i := 1 to 4 do
    for j := 1 to 4 do
      if k[i][j] = 'X' then
      begin
        GotoXY(31 + wsp_x + j, wsp_y + i);
        if tryb then write('_') else write(' ');
      end;
end;

//*****************************************************************************
//*****************************************************************************
//*****************************************************************************

// Definicja obiektu planszy gry
//------------------------------------------------------

type

  TPlansza = class
      pole_gry    : array[1..24] of string[14];
      zapelnienie : integer;
      punkty      : integer;
      poziom      : integer;
      wiersze     : integer;
      obecna      : TFigura;
      nastepna    : TFigura;
      constructor Tworz;
      function    Brak_Miejsca : boolean;
      function    Kolizja(k : ksztalt;x,y : integer) : boolean;
      procedure   LosujFigure;
      procedure   NastepnaFigura;
      procedure   PoleGry;
      procedure   PoziomPunkty;
      procedure   Ruch_obrot;
      function    Ruch_spadek : boolean;
      procedure   Ruch_w_lewo;
      procedure   Ruch_w_prawo;
      procedure   Upuszczenie;
      procedure   UsunPelneWiersze;
      procedure   Wpisz;
      procedure   WyborPoziomu;
      procedure   ZwiekszPunkty(p : integer);
   end;

constructor TPlansza.Tworz;
begin
  obecna   := TFigura.Tworz;
  nastepna := TFigura.Tworz;
end;

// Funkcja obsługuje ruch figury w obrębie planszy.
// Zwraca true, jeśli w trakcie wstawiania nowej figury
// następuje kolizja z zawartością pola gry.
//------------------------------------------------------
function TPlansza.Brak_Miejsca : boolean;
var
  c     : char;
  lc,li : integer;
begin
  with obecna do
    if Kolizja(Pobierz,wsp_x,wsp_y) then
    begin
      RysujWymaz(true); Result := true;
    end
    else
    begin
      lc := 100 - 10 * (poziom - 1); li := lc;
      RysujWymaz(true);
      repeat // UWAGA - to jest pętla nieskończona
        if KeyPressed then
        begin
          repeat c := ReadKey; until c <> #0;
          case c of
            #27 : begin
                    Result := true; Exit;
                  end;
            #32 : while ReadKey <> #32 do;
            #75 : Ruch_w_lewo;
            #77 : Ruch_w_prawo;
            #72 : Ruch_obrot;
            #80 : begin
                    Upuszczenie; break; // Wyjście z pętli
                  end;
          end;
        end;
        Dec(li); Delay(8);
        if li = 0 then
        begin
          li := lc;
          if not Ruch_spadek then
          begin
            Wpisz; UsunPelneWiersze; ZwiekszPunkty(5);
            break; // Wyjście z pętli
          end;
        end;
      until false;
      Result := false;
    end;
end;

// Funkcja sprawdza, czy podany kawałek da się wprowadzić
// na planszę gry. Jeśli nie, to zwraca true.
//------------------------------------------------------
function TPlansza.Kolizja(k : ksztalt; x, y : integer) : boolean;
var
  i,j     : integer;
begin
  for i := 1 to 4 do
    for j := 1 to 4 do
      if (k[i][j] = 'X') and (pole_gry[y + i - 1][x + j - 1] = 'X') then
      begin
        Result := true; Exit;
      end;
  Result := false;
end;

// Procedura losuje kolejną figurę
//------------------------------------------------------
procedure TPlansza.LosujFigure;
begin
  obecna.Kopiuj(nastepna);
  nastepna.Losuj;
  NastepnaFigura;
end;

// Procedura wyświetla na planszy następną figurę, czyli
// element, który weźmie udział w grze po opuszczeniu
// bieżącej figury
//------------------------------------------------------
procedure TPlansza.NastepnaFigura;
var
  i : integer;
begin
  TextAttr := $09; Ramka(48,8,77,15);
  TextAttr := $ff;
  for i := 9 to 14 do
  begin
    GotoXY(49,i); write('                            ');
  end;
  TextAttr := $f4; GotoXY(55,9); write(PL('Następna figura'));
  nastepna.RysujWymaz(true);
end;

// Ustawia i wyświetla pole gry
//------------------------------------------------------
procedure TPlansza.PoleGry;
var
  i,j : integer;
begin
  nastepna.Losuj; nastepna.wsp_x := 30; nastepna.wsp_y := 10;
  wiersze := 0; punkty := 0;
  for i := 1 to 24 do
    if i < 23 then
      pole_gry[i] := 'XX          XX'
    else
      pole_gry[i] := 'XXXXXXXXXXXXXX';
  TextAttr := $07; ClrScr;
  TextAttr := $09; Ramka(34,1,45,24);
  for i := 1 to 22 do
  begin
    GotoXY(35,i+1); TextAttr := $f0;
    if i < 23 - zapelnienie then
      write('          ')
    else
      for j := 1 to 10 do
        if random(2) = 1 then
        begin
          TextAttr := random(15) * 16; write('_'); pole_gry[i][j+2] := 'X';
        end
        else
        begin
          TextAttr := $f0; write(' ');
        end;
  end;
  TextAttr := $0c;
  GotoXY(52,2); write('G R A  W   T E T R I S');
  TextAttr := $0e;
  GotoXY(50,3); write(PL('(C)2004 mgr Jerzy Wałaszek'));
  TextAttr := $0f;
  GotoXY(50,4); write(PL('I Liceum  Ogólnokształcące'));
  GotoXY(59,5); write('w Tarnowie');
  TextAttr := $09; Ramka(48,1,77,6);
  TextAttr := $09; Ramka(3,1,31,24);
  TextAttr := $07;
  GotoXY(4,6); write(PL('Klawisze sterujące grą'));
  GotoXY(4,7); write('======================');
  TextAttr := $0f;
  GotoXY(4,9);  write(PL('[w górę]     - obrót'));
  GotoXY(4,11); write('[prawo/lewo] - ruch');
  GotoXY(4,13); write(PL('[w dół]      - upuszczenie'));
  GotoXY(4,15); write('[Spacja]     - pauza');
  GotoXY(4,17); write(PL('[Escape]     - koniec gry'));
  NastepnaFigura;
  PoziomPunkty;
end;

// Procedura wyświetla poziom oraz punkty
//------------------------------------------------------
procedure TPlansza.PoziomPunkty;
begin
  TextAttr := $09; Ramka(48,17,77,24);
  TextAttr := $0c; GotoXY(55,18);
  write(PL('Bieżąca punktacja'));
  TextAttr := $0e;
  GotoXY(56,20); write('Poziom : ',poziom:6);
  GotoXY(56,22); write('Wynik  : ',punkty:6);
end;

procedure TPlansza.Ruch_obrot;
var
  o1,o2 : integer;
begin
  with obecna do
  begin
    o1 := obrot;
    inc(obrot); if obrot > 4 then obrot := 1;
    o2 := obrot;
    if not Kolizja(Pobierz,wsp_x,wsp_y) then
    begin
      obrot := o1; RysujWymaz(false);
      obrot := o2; RysujWymaz(true);
    end
    else obrot := o1;
  end;
end;

procedure TPlansza.Ruch_w_lewo;
begin
  with obecna do
    if not Kolizja(Pobierz,wsp_x-1,wsp_y) then
    begin
      RysujWymaz(false); dec(wsp_x); RysujWymaz(true);
    end;
end;

procedure TPlansza.Ruch_w_prawo;
begin
  with obecna do
    if not Kolizja(Pobierz,wsp_x+1,wsp_y) then
    begin
      RysujWymaz(false); inc(wsp_x); RysujWymaz(true);
    end;
end;

function TPlansza.Ruch_spadek : boolean;
begin
  with obecna do
    if not Kolizja(Pobierz,wsp_x,wsp_y+1) then
    begin
      RysujWymaz(false); inc(wsp_y); RysujWymaz(true);
      Result := true;
    end
    else Result := false;
end;

// Procedura upuszcza bieżący kawałek
//------------------------------------------------------
procedure TPlansza.Upuszczenie;
begin
  while Ruch_spadek do
  begin
    ZwiekszPunkty(1); Delay(10);
  end;
  Wpisz; UsunPelneWiersze; ZwiekszPunkty(5);
end;

// Procedura przegląda pole gry i usuwa z niego każdy
// pełny wiersz. Ilość usuniętych wierszy jest zliczana
// i służy później do zwiększenia punktacji gracza.
//------------------------------------------------------
procedure TPlansza.UsunPelneWiersze;
var
  i,j,licznik_wierszy : integer;
begin
  licznik_wierszy := 0; i := 22;
  while i > 0 do
  begin
    if pole_gry[i] = 'XXXXXXXXXXXXXX' then
    begin
      inc(licznik_wierszy);
      for j := i downto 2 do
        pole_gry[j] := pole_gry[j - 1];
      pole_gry[1] := 'XX          XX';
      PrzesunOkno(35,2,44,i+1,$f0);
    end
    else dec(i);
  end;
  case licznik_wierszy of
    1 : ZwiekszPunkty(50);
    2 : ZwiekszPunkty(150);
    3 : ZwiekszPunkty(300);
    4 : ZwiekszPunkty(600);
  end;
  inc(wiersze,licznik_wierszy);
  if wiersze > 50 then
  begin
    wiersze := wiersze - 50;
    ZwiekszPunkty(10000);
    if poziom < 9 then inc(poziom);
  end;
end;

// Procedura wpisuje bieżącą figurę do planszy gry
//------------------------------------------------------
procedure TPlansza.Wpisz;
var
  i,j : integer;
  k   : ksztalt;
begin
  k := obecna.Pobierz;
  for i := 1 to 4 do
    for j := 1 to 4 do
      if k[i][j] = 'X' then
        pole_gry[obecna.wsp_y + i - 1][obecna.wsp_x + j - 1] := 'X';
end;

// Procedura umożliwia wybór poziomu startowego dla gry.
// Pozwala również określić wstępne zapełnienie pola gry
// kwadratami, które będą ułożone losowo we wybranej
// ilości dolnych rzędów.
//------------------------------------------------------
procedure TPlansza.WyborPoziomu;
var
  i,j : integer;
  c   : char;
begin
  poziom := 1; zapelnienie := 0;
  repeat
    TextAttr := $09; Ramka(1,1,12,24);
    TextAttr := $ff;
    for i := 2 to 23 - zapelnienie do
    begin
      GotoXY(2,i); write('          ');
    end;
    for i := 24 - zapelnienie to 23 do
    begin
      GotoXY(2,i);
      for j := 1 to 10 do
        if random(2) = 0 then
        begin
           TextAttr := random(15)*16; write('_');
        end
        else
        begin
          TextAttr := $ff; write(' ');
        end;
    end;
    TextAttr := $0c;
    GotoXY(15,5); writeln('T E T R I S');
    GotoXY(15,6); writeln('===========');
    TextAttr := $0e;
    GotoXY(15,8); writeln('Poziom startowy....... : ',poziom:2);
    GotoXY(15,10); writeln(PL('Zapełnienie początkowe : '),zapelnienie:2);
    TextAttr := $0f; GotoXY(15,12);
    writeln(PL('Klawisze sterujące:'));
    GotoXY(15,14);
    writeln(PL('[+/-]   - zwiększenie, zmniejszenie poziomu'));
    GotoXY(15,16);
    writeln(PL('[Z/X]   - zwiększenie, zmniejszenie zapełnienia'));
    GotoXY(15,18);
    writeln(PL('[Enter] - zatwierdzenie zmian i rozpoczęcie gry'));
    c := UpCase(ReadKey);
    case c of
      '+' : if poziom < 9 then Inc(poziom);
      '-' : if poziom > 1 then Dec(poziom);
      'Z' : if zapelnienie < 15 then Inc(zapelnienie);
      'X' : if zapelnienie > 0  then Dec(zapelnienie);
    end;
  until c = #13;
end;

// Metoda zwiększa o p punkty i wyświetla wynik
//------------------------------------------------------
procedure TPlansza.ZwiekszPunkty(p : integer);
begin
  Inc(punkty,p); PoziomPunkty;
end;

//*****************************************************************************
//*****************************************************************************
//*****************************************************************************

// Definicja obiektu gry
//------------------------------------------------------

type

  TGra = class(TPlansza)
      a : integer;
      constructor Tworz;
      destructor  Niszcz;
      procedure   Graj;
      function    KoniecGry : boolean;
      procedure   StronaTytulowa;
  end;

constructor TGra.Tworz;
begin
  inherited Tworz;
  a := TextAttr; CursorOff; Randomize;
end;

destructor TGra.Niszcz;
begin
  TextAttr := a; CursorOn; ClrScr;
end;

// Procedura wyświetla stronę tytułową gry Tetris, czeka
// na wciśnięcie klawisza, czyści ekran i kończy.
//------------------------------------------------------
procedure TGra.StronaTytulowa;
begin
  TextAttr := $07; ClrScr;
  GotoXY(1,4);
  TextAttr := $1f;
  Centruj(PL('                                  '));
  Centruj(PL('            T E T R I S           '));
  Centruj(PL('                                  '));
  TextAttr := $2e;
  Centruj(PL('                                  '));
  Centruj(PL('    (C)2004 mgr Jerzy Wałaszek    '));
  Centruj(PL('                                  '));
  TextAttr := $3f;
  Centruj(PL('                                  '));
  Centruj(PL('     I Liceum Ogólnokształcące    '));
  Centruj(PL('   im. Kazimierza  Brodzińskiego  '));
  Centruj(PL('             w Tarnowie           '));
  Centruj(PL('                                  '));
  TextAttr := $f1;
  Centruj(PL('                                  '));
  Centruj(PL('     Zbadaj swoje umiejętności    '));
  Centruj(PL(' szybkiego i logicznego myślenia  '));
  Centruj(PL('                                  '));
  TextAttr := $f4;
  Centruj(PL('        Gdy będziesz gotowy,      '));
  Centruj(PL('     naciśnij dowolny klawisz     '));
  Centruj(PL('                                  '));
  TextAttr := $09; Ramka(23,3,58,22);
  while ReadKey = #0 do; // Oczekiwanie na dowolny klawisz
  TextAttr := $07; ClrScr;
end;

// Funkcja zwraca true, jeśli gracz chce zakończyć grę.
//------------------------------------------------------
function TGra.KoniecGry : boolean;
begin
  GotoXY(1,11); TextAttr := $4e;
  Centruj('                                       ');
  Centruj(' Jeszcze raz ? [T] = Tak, [Inny] = Nie ');
  Centruj('                                       ');
  Result := UpCase(ReadKey) <> 'T';
end;

// Metoda obsługuje całą rozgrywkę w Tetris
//------------------------------------------------------
procedure TGra.Graj;
begin
  repeat
    StronaTytulowa;
    WyborPoziomu;
    PoleGry;
    repeat
      LosujFigure;
    until Brak_Miejsca;
    while KeyPressed do
    begin
      ReadKey; Delay(100);
    end;
  until KoniecGry;
end;

// Program główny
//------------------------------------------------------

var
  gra : TGra;
begin
  gra := TGra.Tworz;
  gra.Graj;
  gra.Niszcz;
end.

Dla ambitnych

Zauważ, iż w trakcie gry niektóre figury nie chcą się obracać, gdy znajdują się przy krawędzi pola gry. Jest to spowodowane tym, iż po obrocie program wykrywa kolizję takiej figury z obrzeżem pola. Popraw algorytm, tak aby takie obroty mimo wszystko były możliwe.
Dodaj do programu bonus, np. w wysokości 10000 punktów, za wyczyszczenie całego pola gry. Zdarza się to rzadko, ale się zdarza, więc gracz powinien być nagradzany.
Gracze zdobywają w tej grze punkty - dodaj zatem do niej tablicę rekordów z 10 najlepszymi wynikami.
A może tak wersja demo z graczem komputerowym, uruchamiana po wykryciu bezczynności gracza ludzkiego, np. przez okres 5 minut...

W artykułach serwisu są używane cookies. Jeśli nie chcesz ich otrzymywać,
zablokuj je w swojej przeglądarce.
Informacje dodatkowe

W tym rozdziale:	Podrozdziały:
Programy Program w języku Pascal Program obiektowy w języku Pascal Dla ambitnych	Opis Algorytm

Tetris - programy

Programy

Program w języku Pascal

Program obiektowy w języku Pascal

Dla ambitnych