{ TETRIS.PAS Copyright (c) TrSek alias Zdeno Sekerak } { Hra tetris v textovom prevedeni. } { Uchovava skore a vykresluje dalsiu kocku. } { } { Datum:12.12.2004 http://www.trsek.com } program tetris; uses crt,dos; const F_PODKLAD = 'podklad.txt'; F_SCORE = 'score.dat'; LEFT = 29; WIDTH = 10; { sirka } HEIGHT = 24; { vyska } TO_LEV = 24; { kolko riadkov ma level } MAX_OS = 10; { pocet osob v rebricku } S_CUBE = ''; S_FOOT = ''; FOOT: array[0..1] of byte = ( DarkGray, Black); CUBE: array[1..7,1..4,1..4] of byte = (((0,0,0,0), { kocka } (0,1,1,0), (0,1,1,0), (0,0,0,0)), ((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(aWIDTH )then res:=false; if((y+yp) >HEIGHT )then res:=false; if( otoc <1 )then res:=false; if( otoc >4 )then res:=false; { 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; ptop[y].meno:=''; ptop[y].body:=body; WriteScore(y); { 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); { ulozi rebricek } Save; KurzorZap(true); end.