Hra tetris v textovom mode

Delphi & Pascal (česká wiki)
Přejít na: navigace, hledání
Kategorija: KMP (Programy mladňakoch

Zrobil: Werbhofen
Program: Tetris.pasKniznica.pasTetrunit.pasTetrdata.pas
Subor exe: Tetris.exe

Hra tetris v textovom mode.
{ TETRIS.PAS                                                        }
{ Hra tetris v textovom mode.                                       }
{                                                                   }
{ Author: WERBHOFEN                                                 }
{ Datum: 12.10.2009                            http://www.trsek.com }
 
PROGRAM Tetris;
USES Crt,Dos,Kniznica,TetrUnit;
 
CONST FarbaOkraj=4;
      FarbaKocka=1;
      FarbaPozadie=0;
      FarbaText=14;
 
      XMin=12; XMax=XMin+13;      (* rozmery hracej plochy *)
      YMin=1; YMax=25;
 
      oneskorenie:byte=100;
      rychlo=0.5;        (* rychlost padajucej kocky *)
      pomaly=0.01;
      zvuky:boolean=true;
 
      StartX=13;
      StartY=1;
 
TYPE TKocka=object
       K:Pole4x4;
       poloha:TReal2D;
       smer:byte;
       TypKocky:byte;
       procedure Init(x,y:byte);
       procedure Vykresli(c:char);
       procedure Otoc(s:ShortInt);
       procedure Posun(s:ShortInt);
       procedure VyberTypKocky;
       function Kontrola:boolean;
     end;
 
VAR dotyk,KoniecHry,KoniecProgramu:boolean;
    score,HighScore:integer;
    HraciaPlocha:array[XMin..XMax,YMin..YMax] of Boolean;
    NovaKocka,Kocka:TKocka;
    f:file;
    g:char;
    rychlost:real;
 
{$I TetrData.pas}
 
BEGIN
  DelicKmitoctu;
  randomize;
 
  if ParamStr(1)='0' then zvuky:=false;
 
  assign(f,'TetScore.dat'); (* nacita hi-score z externeho suboru *)
  {$I-} reset(f); {$I+}
  if IOResult<>0
    then HighScore:=0      (* subor neexistuje/dajaka chyba *)
    else begin             (* vsjo jasno *)
      BlockRead(f,HighScore,1);
      close(f);
    end;
 
  repeat
    score:=0;
    KoniecProgramu:=false;
    KoniecHry:=false;
    UvodnaObrazovka;
    Kraj;
    NovaKocka.Init(StartX,StartY);
    repeat  (* nova kocka *)
      NovaKocka.poloha.x:=StartX;
      NovaKocka.poloha.y:=StartY;
      Kocka:=NovaKocka;
      NovaKocka.Init(31,10);
      NovaKocka.Vykresli(#219);
      dotyk:=false;
      rychlost:=pomaly;
      repeat  (* posunutie kocky o 1 dolu *)
        Kocka.Kontrola;
        g:=#0;
        if keypressed then g:=readkey;
        case g of
          #75: Kocka.Posun(-1);
          #77: Kocka.Posun(+1);
          #72: Kocka.Otoc(1);
          #27: begin
                 okno(14,11,'QUIT(Y/N)?',10);
                 if (g='z')or(g='Z')or(g='Y')or(g='y') then KoniecProgramu:=true;
               end;
          #32: okno(16,11,'PAUSE',26);
          else if g=#80 then rychlost:=rychlo else rychlost:=pomaly;
        end;
        Kocka.Vykresli(#219);
        Cakaj(2);
        Kocka.Vykresli(' ');
        Kocka.poloha.y:=Kocka.poloha.y+rychlost;
      until (dotyk)or(KoniecHry)or(KoniecProgramu);
      NovaKocka.Vykresli(' ');
      KontrolaPlochy;
      if KoniecHry then begin
        ZvukPrehra;
        vymaz(150,true);
      end;
    until (KoniecHry)or(KoniecProgramu);
    if score>HighScore then HighScore:=score;
  until KoniecProgramu;
 
  ReWrite(f);          (* zapise novu hodnotu hi-score do externeho suboru *)
  BlockWrite(f,HighScore,1);
  Close(f);
END.