API tools faq
paste
Advertisement
ewelina_r

Tetris gotowe

ewelina_r
Jan 26th, 2015
189
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Pascal 20.53 KB | None | 0 0
raw download clone embed print report
  1. program Tetris_Ewelina_Rybczynska;
  2. uses Crt, Windows;
  3.  
  4. type
  5.   tablica = array [1..4] of integer;
  6.   P_tablica =^tablica;
  7.   wiersz = array [1..14] of integer;
  8.   wiersze_klocki = array [1..16] of integer;
  9.   klocek = array [1..4] of wiersze_klocki;
  10.   wiersz_wszystkie_klocki = array [1..7] of klocek;
  11.  
  12. var
  13.   tetrion: array[1..24] of wiersz;
  14.   ciekawostki: array[1..6] of string;
  15.  
  16.   poziom,wynik,wiersze:integer;
  17.   aktualny, aktualny_kolor,aktualny_x,aktualny_y,aktualny_obrot:integer;
  18.   nastepny,nastepny_kolor:integer;
  19.  
  20. const
  21.   wiersz1: array [1..14] of integer = (1,1,0,0,0,0,0,0,0,0,0,0,1,1);
  22.   wiersz2: array [1..14] of integer = (1,1,1,1,1,1,1,1,1,1,1,1,1,1);
  23.  
  24.   wszystkie_klocki: array[1..7] of klocek=(
  25.   ((1,1,1,1,0,1,0,0,0,0,0,0,0,0,1,0),
  26.    (0,0,0,0,0,1,0,0,0,0,0,0,0,0,1,0),
  27.    (0,0,0,0,0,1,0,0,1,1,1,1,0,0,1,0),
  28.    (0,0,0,0,0,1,0,0,0,0,0,0,0,0,1,0)),
  29.   ((1,1,1,0,1,0,0,0,0,0,0,0,0,1,1,0),
  30.    (1,0,0,0,1,0,0,0,0,0,1,0,0,0,1,0),
  31.    (0,0,0,0,1,1,0,0,1,1,1,0,0,0,1,0),
  32.    (0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0)),
  33.   ((1,1,1,0,1,1,0,0,0,0,0,0,0,0,1,0),
  34.    (0,0,1,0,1,0,0,0,1,0,0,0,0,0,1,0),
  35.    (0,0,0,0,1,0,0,0,1,1,1,0,0,1,1,0),
  36.    (0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0)),
  37.   ((0,1,1,0,1,0,0,0,0,1,1,0,1,0,0,0),
  38.    (1,1,0,0,1,1,0,0,1,1,0,0,1,1,0,0),
  39.    (0,0,0,0,0,1,0,0,0,0,0,0,0,1,0,0),
  40.    (0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0)),
  41.   ((1,1,0,0,0,1,0,0,1,1,0,0,0,1,0,0),
  42.    (0,1,1,0,1,1,0,0,0,1,1,0,1,1,0,0),
  43.    (0,0,0,0,1,0,0,0,0,0,0,0,1,0,0,0),
  44.    (0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0)),
  45.   ((1,1,1,0,1,0,0,0,0,0,0,0,0,0,1,0),
  46.    (0,1,0,0,1,1,0,0,0,1,0,0,0,1,1,0),
  47.    (0,0,0,0,1,0,0,0,1,1,1,0,0,0,1,0),
  48.    (0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0)),
  49.   ((1,1,0,0,1,1,0,0,1,1,0,0,1,1,0,0),
  50.    (1,1,0,0,1,1,0,0,1,1,0,0,1,1,0,0),
  51.    (0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0),
  52.    (0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0)));
  53.  
  54. procedure wysrodkuj_tekst(s:string);
  55. var dlugosc:byte;
  56. begin
  57.  dlugosc:=(80-Length(s)) div 2;
  58.  GotoXY(dlugosc,WhereY);
  59.  writeln(s);
  60. end;
  61.  
  62. procedure narysuj_ramke(x1,y1,x2,y2:integer);
  63. var i:integer;
  64. begin
  65.   GotoXY(x1,y1); write(#218);
  66.   GotoXY(x1,y2); write(#192);
  67.   GotoXY(x2,y1); write(#191);
  68.   GotoXY(x2,y2); write(#217);
  69.  
  70.   for i:=x1+1 to x2-1 do
  71.   begin
  72.     GotoXY(i,y1); write(#196);
  73.     GotoXY(i,y2); write(#196);
  74.   end;
  75.   for i:=y1+1 to y2-1 do
  76.   begin
  77.     GotoXY(x1,i); write(#179);
  78.     GotoXY(x2,i); write(#179);
  79.   end;
  80. end;
  81.  
  82. procedure nowa_gra forward;
  83. procedure menu forward;
  84. procedure gotowy forward;
  85. procedure wypisz_plansze forward;
  86.  
  87. procedure wynik_koncowy;
  88. begin
  89.  ClrScr;
  90.  TextBackground(0);
  91.  TextAttr := $0f;
  92.  GotoXY(22,2); write('Zdobyte punkty: ');
  93.  GotoXY(39,2); write(wynik);
  94.  GotoXY(22,4); TextAttr := $0c; write('G ');
  95.  GotoXY(24,4); TextAttr := $0e; write('R ');
  96.  GotoXY(26,4); TextAttr := $0a; write('A ');
  97.  GotoXY(28,4); TextAttr := $0b; write('T ');
  98.  GotoXY(30,4); TextAttr := $0d; write('U ');
  99.  GotoXY(32,4); TextAttr := $0c; write('L ');
  100.  GotoXY(34,4); TextAttr := $0e; write('A ');
  101.  GotoXY(36,4); TextAttr := $0a; write('C ');
  102.  GotoXY(38,4); TextAttr := $0b; write('J ');
  103.  GotoXY(40,4); TextAttr := $0d; write('E ');
  104.  GotoXY(42,4); TextAttr := $0c; write('! ');
  105.  Delay(3000);
  106.  ClrScr;
  107. end;
  108.  
  109. procedure powitanie;
  110. begin
  111.   clrscr;
  112.   TextAttr:=$0e;
  113.   GotoXY(5,2); writeln('_|_|_|_|_|');
  114.   GotoXY(5,3); writeln('    _|    ');
  115.   GotoXY(5,4); writeln('    _|    ');
  116.   GotoXY(5,5); writeln('    _|    ');
  117.   GotoXY(5,6); writeln('    _|    ');
  118.  
  119.   TextAttr:=$0c;
  120.   GotoXY(17,2); writeln('_|_|_|_|');
  121.   GotoXY(17,3); writeln('_|      ');
  122.   GotoXY(17,4); writeln('_|_|_|  ');
  123.   GotoXY(17,5); writeln('_|      ');
  124.   GotoXY(17,6); writeln('_|_|_|_|');
  125.  
  126.   TextAttr:=$0d;
  127.   GotoXY(27,2); writeln('_|_|_|_|_|');
  128.   GotoXY(27,3); writeln('    _|    ');
  129.   GotoXY(27,4); writeln('    _|    ');
  130.   GotoXY(27,5); writeln('    _|    ');
  131.   GotoXY(27,6); writeln('    _|    ');
  132.  
  133.   TextAttr:=$0b;
  134.   GotoXY(39,2); writeln('_|_|_|  ');
  135.   GotoXY(39,3); writeln('_|    _|');
  136.   GotoXY(39,4); writeln('_|_|_|  ');
  137.   GotoXY(39,5); writeln('_|    _|');
  138.   GotoXY(39,6); writeln('_|    _|');
  139.  
  140.   TextAttr:=$0a;
  141.   GotoXY(49,2); writeln('_|_|_|');
  142.   GotoXY(49,3); writeln('  _|  ');
  143.   GotoXY(49,4); writeln('  _|  ');
  144.   GotoXY(49,5); writeln('  _|  ');
  145.   GotoXY(49,6); writeln('_|_|_|');
  146.  
  147.   TextAttr:=$09;
  148.   GotoXY(57,2); writeln(' _|_|_| ');
  149.   GotoXY(57,3); writeln('_|      ');
  150.   GotoXY(57,4); writeln('  _|_|  ');
  151.   GotoXY(57,5); writeln('      _|');
  152.   GotoXY(57,6); writeln('_|_|_|  ');
  153.  
  154.   TextAttr:=$0f;
  155.   writeln; writeln;
  156.   GotoXY(25,9);write('Ewelina Rybczynska');
  157.   GotoXY(22,11); write('Wstep do Informatyki 2015');
  158.   delay(2000);
  159.   ClrScr;
  160. end;
  161.  
  162. procedure podaj_imie;
  163. var
  164.   imie_gracza:string;
  165.   F:Text;
  166. begin
  167.  GotoXY(35,2); TextAttr := $0c; write('T ');
  168.  GotoXY(37,2); TextAttr := $0e; write('E ');
  169.  GotoXY(39,2); TextAttr := $09; write('T ');
  170.  GotoXY(41,2); TextAttr := $0a; write('R ');
  171.  GotoXY(43,2); TextAttr := $0b; write('I ');
  172.  GotoXY(45,2); TextAttr := $0d; write('S ');
  173.  TextAttr := $0c;
  174.  narysuj_ramke(30,4,50,10);
  175.  TextAttr := $0f; GotoXY(32,5); write('Podaj swoje imie:');
  176.  writeln;
  177.  GotoXY(35,7); read(imie_gracza);
  178.  Assign(F, 'plik.txt');
  179.  Rewrite(F);
  180.  WriteLn(F, imie_gracza);
  181.  Close(F);
  182.  ClrScr;
  183.  GotoXY(20,3); write('Witaj'); GotoXY(26,3); write(imie_gracza);
  184.  write(', zagrajmy w Tetrisa!');
  185.  Windows.Beep(294,200);
  186.  Windows.Beep(330,200);
  187.  Windows.Beep(349,200);
  188.  Windows.Beep(392,200);
  189.  Windows.Beep(440,200);
  190.  Windows.Beep(494,200);
  191.  Windows.Beep(523,200);
  192.  Delay(2000);
  193.  ClrScr;
  194. end;
  195.  
  196. procedure plansza_tetrion;
  197. var
  198.   i:integer;
  199.   begin
  200.     for i:=1 to 24 do
  201.       if (i<23) then tetrion[i]:=wiersz1
  202.       else tetrion[i]:=wiersz2;
  203.       for i:=1 to 22 do
  204.       begin
  205.         GotoXY(2,i+1); TextAttr := $f0;
  206.         if i<23 then
  207.          write('          ');
  208.       end;
  209. end;
  210.  
  211. procedure gotowy;
  212. begin
  213.  TextAttr:=$0e; narysuj_ramke(1,1,12,24);
  214.       TextBackground(0);
  215.       TextAttr:=$0f;
  216.       GotoXY(2,3); write('Gotowy?');
  217.       Delay(1000);
  218.       GotoXY(2,3); TextAttr:=$ff; write('       ');
  219.       TextBackground(0);
  220.       TextAttr:=$0f;
  221.       GotoXY(2,3); write('Za chwile ');
  222.       GotoXY(2,4); write('rozpocznie');
  223.       GotoXY(2,5); write('sie gra.');
  224.       Delay(2000);
  225. end;
  226.  
  227. procedure tytul;
  228. begin
  229.  TextAttr := $09; narysuj_ramke(13,1,33,3);
  230.  GotoXY(18,2); TextAttr := $0c; write('T ');
  231.  GotoXY(20,2); TextAttr := 13; write('E ');
  232.  GotoXY(22,2); TextAttr := $0e; write('T ');
  233.  GotoXY(24,2); TextAttr := $0a; write('R ');
  234.  GotoXY(26,2); TextAttr := $0b; write('I ');
  235.  GotoXY(28,2); TextAttr := $0d; write('S ');
  236. end;
  237.  
  238. procedure instrukcja;
  239. begin
  240. TextAttr := $0a; narysuj_ramke(13,4,33,11);
  241. TextAttr := $0f;
  242. GotoXY(14,5); write('Instrukcja gry:');
  243. GotoXY(14,6); write('w gore - obrot');
  244. GotoXY(14,7); write('prawo/lewo - ruch');
  245. GotoXY(14,8); write('w dol - oposc');
  246. GotoXY(14,9); write('spacja - pauza');
  247. GotoXY(14,10); write('escape - koniec gry');
  248. end;
  249.  
  250. procedure punkty_poziom;
  251. begin
  252. TextAttr := $0b; narysuj_ramke(13,12,33,18);
  253. TextAttr := $0f;
  254. GotoXY(14,13); write('     PUNKTACJA:');
  255. GotoXY(14,15); write('   Wynik:', wynik:7);
  256. GotoXY(14,17); write('   Poziom:', poziom:6);
  257. end;
  258.  
  259. procedure ciekawostka;
  260. var
  261.   x:integer;
  262. begin
  263. TextAttr := $0d; narysuj_ramke(13,19,62,24);
  264. TextAttr := $0f;
  265. GotoXY(16,20); write('Czy wiesz, ze...');
  266. ciekawostki[1]:='klocki spadajace w grze nazywane sa tetrimino?';
  267. ciekawostki[2]:='plansza nazywana jest tetrionem lub matriksem?';
  268. ciekawostki[3]:='gra powstala w Zwiazku Radzieckim w roku 1984?';
  269. ciekawostki[4]:='autorem gry jest Rosjanin Aleksieja Pazytnowa?';
  270. ciekawostki[5]:='w Tetrisa obecnia gra sie w ponad 50 krajach?';
  271. ciekawostki[6]:='nazwa gry tetris pochodzi od slowa tetra (4)?';
  272. randomize;
  273. x:=random(6)+1;
  274. TextAttr := $0f;
  275. GotoXY(15,22); write(ciekawostki[x]);
  276. end;
  277.  
  278. procedure nastepny_klocek;
  279. var
  280.   i,j,k: integer;
  281.   nastepne_tetrimino: wiersze_klocki;
  282. begin
  283.   TextAttr:=$0e; narysuj_ramke(34,1,51,10);
  284.   TextAttr:=$0f;
  285.   GotoXY(35,2); write('Nastepny klocek:');
  286.   for k:=4 to 9 do begin
  287.   TextAttr := $ff;
  288.   GotoXY(35,k);
  289.   write('               ');
  290.   end;
  291.  
  292.   for i:=1 to 4 do
  293.   begin
  294.     GotoXY(41,4+i); nastepne_tetrimino:=wszystkie_klocki[nastepny][i];
  295.     for j:=1 to 4 do
  296.     if nastepne_tetrimino[j]=1 then
  297.     begin
  298.      TextAttr:=nastepny_kolor;
  299.      TextColor(16); write('_');
  300.      end
  301.     else
  302.     begin
  303.       TextAttr:=255; write(' ');
  304.     end;
  305.   end;
  306. end;
  307.  
  308. procedure klocki;
  309. var
  310.   i,j:integer;
  311.   tetrimino: wiersze_klocki;
  312. begin
  313.  narysuj_ramke(52,1,62,18);
  314.  GotoXY(53,2);
  315.  TextAttr:=$0f; write('Klocki:');
  316.  for i:=1 to 4 do
  317.   begin
  318.   GotoXY(53,3+i); tetrimino:=wszystkie_klocki[1][i];
  319.     for j:=1 to 4 do
  320.     if tetrimino[j]=1 then
  321.     begin
  322.      TextAttr:=16*5;
  323.      TextColor(0); write('_');
  324.      end
  325.     else
  326.     begin
  327.       TextAttr:=0; write(' ');
  328.     end;
  329.   end;
  330.  
  331.   for i:=1 to 4 do
  332.   begin
  333.   GotoXY(53,5+i); tetrimino:=wszystkie_klocki[2][i];
  334.     for j:=1 to 4 do
  335.     if tetrimino[j]=1 then
  336.     begin
  337.      TextAttr:=16*7;
  338.      TextColor(0); write('_');
  339.      end
  340.     else
  341.     begin
  342.      TextAttr:=0; write(' ');
  343.     end;
  344.   end;
  345.  
  346.   for i:=1 to 4 do
  347.   begin
  348.   GotoXY(53,8+i); tetrimino:=wszystkie_klocki[3][i];
  349.     for j:=1 to 4 do
  350.     if tetrimino[j]=1 then
  351.     begin
  352.      TextAttr:=16*6;
  353.      TextColor(0); write('_');
  354.      end
  355.     else
  356.     begin
  357.      TextAttr:=0; write(' ');
  358.     end;
  359.   end;
  360.  
  361. for i:=1 to 4 do
  362.   begin
  363.   GotoXY(53,11+i); tetrimino:=wszystkie_klocki[4][i];
  364.     for j:=1 to 4 do
  365.     if tetrimino[j]=1 then
  366.     begin
  367.      TextAttr:=16*3;
  368.      TextColor(0); write('_');
  369.      end
  370.     else
  371.     begin
  372.      TextAttr:=0; write(' ');
  373.     end;
  374.   end;
  375.  
  376. for i:=1 to 4 do
  377.   begin
  378.   GotoXY(58,3+i); tetrimino:=wszystkie_klocki[5][i];
  379.     for j:=1 to 4 do
  380.     if tetrimino[j]=1 then
  381.     begin
  382.      TextAttr:=16*4;
  383.      TextColor(0); write('_');
  384.      end
  385.     else
  386.     begin
  387.       TextAttr:=0; write(' ');
  388.     end;
  389.   end;
  390.  
  391. for i:=1 to 4 do
  392.   begin
  393.   GotoXY(58,6+i); tetrimino:=wszystkie_klocki[6][i];
  394.     for j:=1 to 4 do
  395.     if tetrimino[j]=1 then
  396.     begin
  397.      TextAttr:=16*2;
  398.      TextColor(0); write('_');
  399.      end
  400.     else
  401.     begin
  402.       TextAttr:=0; write(' ');
  403.     end;
  404.   end;
  405.  
  406.  for i:=1 to 4 do
  407.   begin
  408.   GotoXY(58,9+i); tetrimino:=wszystkie_klocki[7][i];
  409.     for j:=1 to 4 do
  410.     if tetrimino[j]=1 then
  411.     begin
  412.      TextAttr:=16*9;
  413.      TextColor(0); write('_');
  414.      end
  415.     else
  416.     begin
  417.       TextAttr:=0; write(' ');
  418.     end;
  419.     TextAttr:=$0f;
  420.     GotoXY(53,15); write('Klocki');
  421.     GotoXY(53,16); write('mozna');
  422.     GotoXY(53,17); write('obracac!');
  423.   end;
  424. end;
  425.  
  426. procedure do_menu;
  427. begin
  428.   TextAttr := $0c; narysuj_ramke(34,11,51,18);
  429.   TextAttr := $0f;
  430.   GotoXY(35,12); write('Aby powrocic');
  431.   GotoXY(35,14); write('do MENU nacisnij');
  432.   GotoXY(35,16); write('klawisz m.');
  433. end;
  434.  
  435. procedure losowania;
  436. begin
  437.  randomize;
  438.  aktualny:=nastepny;
  439.  aktualny_kolor:=nastepny_kolor;
  440.  nastepny:=1+random(7);
  441.  nastepny_kolor:=1+random(15)*16;
  442.  if nastepny_kolor =1 then nastepny_kolor := 16;
  443.  nastepny_klocek;
  444.  aktualny_x:=6; aktualny_y:=1; aktualny_obrot:=1;
  445. end;
  446.  
  447. function kopiuj(wszystkie_klocki: wiersz_wszystkie_klocki; faza,wiersz,nr_klocka:integer):P_tablica;
  448. var
  449.   i,j: integer;
  450.   P:P_tablica;
  451. begin
  452.  New(P);
  453.  i:=1;
  454.    for j:=faza to faza+3 do begin
  455.    P^[i]:= wszystkie_klocki[nr_klocka][wiersz][j];
  456.    i:=i+1;
  457.    end;
  458.  kopiuj:=P;
  459. end;
  460.  
  461. function czy_kolizja(klocek,obrot,x,y:integer):boolean;
  462. var
  463.   i,j:integer;
  464.   rodzaj_klocka: tablica;
  465. begin
  466.  for i:=1 to 4 do
  467.  begin
  468.    rodzaj_klocka:=kopiuj(wszystkie_klocki,1+4*(obrot-1),i,klocek)^;
  469.    for j:=1 to 4 do
  470.     if((rodzaj_klocka[j]<>0) and (tetrion[y+i-1][x+j-1]<>0)) then
  471.     begin
  472.      Result:=true;
  473.      Exit;
  474.     end;
  475.  end;
  476.  Result:=false;
  477. end;
  478.  
  479. procedure wyswietl_klocek(true_false:boolean);
  480. var
  481.   i,j:integer;
  482.   rodzaj_klocka: tablica;
  483. begin
  484.  if true_false then begin
  485.    TextAttr:=aktualny_kolor;
  486.    TextColor(16);
  487.  end
  488.  else
  489.    TextAttr:=$ff;
  490.  for i:=1 to 4 do
  491.  begin
  492.   rodzaj_klocka:=kopiuj(wszystkie_klocki,1+4*(aktualny_obrot-1),i,aktualny)^;
  493.   for j:=1 to 4 do
  494.     if rodzaj_klocka[j] <> 0 then
  495.     begin
  496.       GotoXY(aktualny_x+j-2, aktualny_y+i);
  497.       write ('_');
  498.     end;
  499.   end;
  500.  end;
  501.  
  502. procedure w_lewo;
  503.  begin
  504.  if not czy_kolizja(aktualny,aktualny_obrot,aktualny_x-1,aktualny_y) then
  505.   begin
  506.     wyswietl_klocek(false);
  507.     dec(aktualny_x);
  508.     wyswietl_klocek(true);
  509.   end;
  510.  end;
  511.  
  512. procedure w_prawo;
  513.  begin
  514.  if not czy_kolizja(aktualny,aktualny_obrot,aktualny_x+1,aktualny_y) then
  515.   begin
  516.     wyswietl_klocek(false);
  517.     inc(aktualny_x);
  518.     wyswietl_klocek(true);
  519.   end;
  520.  end;
  521.  
  522. procedure obroc_klocek;
  523.  var
  524.    x_obrot:integer;
  525.  begin
  526.    x_obrot:=aktualny_obrot+1;
  527.    if (x_obrot>4) then
  528.     x_obrot:=1;
  529.    if not czy_kolizja(aktualny,x_obrot,aktualny_x,aktualny_y) then
  530.     begin
  531.      wyswietl_klocek(false);
  532.      aktualny_obrot:=x_obrot;
  533.      wyswietl_klocek(true);
  534.     end;
  535.  end;
  536.  
  537. function w_dol:boolean;
  538.  begin
  539.   if not czy_kolizja(aktualny,aktualny_obrot,aktualny_x,aktualny_y+1) then
  540.    begin
  541.      wyswietl_klocek(false);
  542.      inc(aktualny_y);
  543.      wyswietl_klocek(true);
  544.      Result:=true;
  545.    end
  546.   else Result:=false;
  547.  end;
  548.  
  549. procedure uzupelnij_plansze;
  550. var
  551.   i,j:integer;
  552.   rodzaj_klocka: tablica;
  553. begin
  554.  for i:=1 to 4 do
  555.  begin
  556.   rodzaj_klocka:=kopiuj(wszystkie_klocki,1+4*(aktualny_obrot-1),i,aktualny)^;
  557.   for j:=1 to 4 do
  558.     if rodzaj_klocka[j]=1 then
  559.       tetrion[aktualny_y+i-1][aktualny_x+j-1]:=aktualny_kolor;
  560.  end;
  561.  wypisz_plansze;
  562. end;
  563.  
  564. procedure wypisz_plansze;
  565. var
  566.   i,j:integer;
  567.   begin
  568.    GotoXY(2,2);
  569.     for i:=1 to 24 do begin
  570.       for j:=1 to 14 do
  571.       begin
  572.         if tetrion[i][j] = 0 then
  573.         begin
  574.          TextAttr := $f0; write(' ');
  575.         end
  576.         else if ((tetrion[i][j] <> 0) and (tetrion[i][j] <> 1)) then
  577.         begin
  578.           TextAttr := tetrion[i][j]; TextColor(16);  write('_');
  579.         end;
  580.       end;
  581.       GotoXY(2,2+i);
  582.     end;
  583.    end;
  584.  
  585. function takie_same(i:integer):boolean;
  586. var
  587.   j:integer;
  588. begin
  589.  for j:=1 to 14 do
  590.  begin
  591.  if tetrion[i][j] = 0 then
  592.   begin
  593.     Result:=False;
  594.     break;
  595.   end;
  596.  Result:=True;
  597.  end;
  598. end;
  599.  
  600. function puste(i:integer):boolean;
  601. var
  602.   j:integer;
  603. begin
  604.  for j:=1 to 14 do
  605.  begin
  606.  if tetrion[i][j] <> 0 then
  607.   begin
  608.     Result:=False;
  609.     break;
  610.   end;
  611.  Result:=True;
  612.  end;
  613. end;
  614.  
  615. function pusta_plansza:boolean;
  616. var
  617.   j:integer;
  618. begin
  619.  for j:=1 to 14 do
  620.  begin
  621.  if not puste(j) then
  622.   begin
  623.     Result:=False;
  624.     break;
  625.   end;
  626.  Result:=True;
  627.  end;
  628. end;
  629.  
  630. procedure usun_wiersze;
  631. var
  632.   i,j,licznik_wierszy:integer;
  633. begin
  634.   licznik_wierszy:=0;
  635.   i:= 22;
  636.   j:= 22;
  637.   while i>0 do
  638.   begin
  639.     if takie_same(i) then
  640.     begin
  641.       inc(licznik_wierszy);
  642.        Windows.Beep(1000,200);
  643.        Windows.Beep(1200,200);
  644.        Windows.Beep(1400,200);
  645.       for j:=i downto 2 do
  646.       tetrion[j]:= tetrion[j-1];
  647.       tetrion[1]:= wiersz1;
  648.       wypisz_plansze;
  649.       end
  650.     else dec(i);
  651.     end;
  652.     if pusta_plansza then inc(wynik, 10000);
  653.     case licznik_wierszy of
  654.     1: inc(wynik,50);
  655.     2: inc(wynik,150);
  656.     3: inc(wynik,300);
  657.     4: inc(wynik,600);
  658.     end;
  659.     inc(wiersze,licznik_wierszy);
  660.     if wiersze>25 then
  661.      begin
  662.       wiersze:=wiersze-25;
  663.       inc(wynik,1000);
  664.       if (poziom<9) then
  665.       begin
  666.        inc(poziom);
  667.        ciekawostka;
  668.        Windows.Beep(1000,200);
  669.        Windows.Beep(1200,200);
  670.        Windows.Beep(1400,200);
  671.        Windows.Beep(1600,200);
  672.        Windows.Beep(1800,200);
  673.        Windows.Beep(2000,200);
  674.        TextAttr:=$0c;
  675.        TextColor(0);
  676.        TextBackGround(15);
  677.        GotoXY(3,3); write('Nastepny');
  678.        GotoXY(3,4); write('poziom!');
  679.        Delay(1000);
  680.        TextAttr:=$ff;
  681.        GotoXY(3,3); write('        ');
  682.        GotoXY(3,4); write('        ');
  683.       end;
  684.      end;
  685.  end;
  686.  
  687. procedure upusc_klocek;
  688. begin
  689.  if w_dol then
  690.  begin
  691.    inc(wynik);
  692.    punkty_poziom;
  693.    Delay(4);
  694.  end;
  695. end;
  696.  
  697. function brak_miejsca:boolean;
  698. var
  699.   c:char;
  700.   lc,li:integer;
  701. begin
  702.  if  czy_kolizja(aktualny,aktualny_obrot,aktualny_x,aktualny_y) then
  703.  begin
  704.   wyswietl_klocek(true);
  705.   Result:=true;
  706.  end
  707.  else
  708.  begin
  709.   lc:=100-10*(poziom-1);
  710.   li:=lc;
  711.   wyswietl_klocek(true);
  712.   repeat
  713.     if Keypressed then
  714.     begin
  715.      repeat c:=ReadKey; until c <> #0;
  716.      case c of
  717.      #109:begin
  718.            Result:=true;
  719.            Exit;
  720.            TextBackGround(0);
  721.            menu;
  722.           end;
  723.       #27:begin
  724.            Result:=true; Exit;
  725.           end;
  726.       #32: while ReadKey <> #32 do;
  727.       #75: w_lewo;
  728.       #77: w_prawo;
  729.       #72: obroc_klocek;
  730.       #80: upusc_klocek;
  731.       end;
  732.      end;
  733.     Dec(li); Delay(4);
  734.     if li=0 then
  735.     begin
  736.      li:=lc;
  737.      if not w_dol then
  738.      begin
  739.       uzupelnij_plansze; usun_wiersze;
  740.       inc(wynik,5);
  741.       punkty_poziom;
  742.       break;
  743.       end;
  744.      end;
  745.     until false;
  746.     Result:=false;
  747.     end;
  748. end;
  749.  
  750. procedure wyswietl_plansze;
  751. begin
  752.  randomize;
  753.  nastepny:=random(7)+1;
  754.  nastepny_kolor:=2+random(15)*16;
  755.  tytul;
  756.  instrukcja;
  757.  punkty_poziom;
  758.  klocki;
  759.  ciekawostka;
  760.  nastepny_klocek;
  761.  do_menu;
  762.  gotowy;
  763.  plansza_tetrion;
  764. end;
  765.  
  766. procedure tetris;
  767. begin
  768.   wyswietl_plansze;
  769.   plansza_tetrion;
  770.   repeat
  771.     losowania;
  772.   until brak_miejsca;
  773.   while KeyPressed do
  774.   begin
  775.    ReadKey;
  776.    Delay(100);
  777.   end;
  778. end;
  779.  
  780. function koniec_gry : boolean;
  781. var
  782.   znak:char;
  783. begin
  784.   ClrScr;
  785.   TextBackground(0);
  786.   wynik_koncowy;
  787.   TextAttr:=$0c ;narysuj_ramke(10,2,69,6);
  788.   GotoXY(1,3);
  789.   TextAttr:=$0f; wysrodkuj_tekst('Czy chcesz zagrac jeszcze raz?');
  790.   writeln;
  791.   TextAttr:=$0f;
  792.   wysrodkuj_tekst('Jezeli tak nacisnij znak t a jezeli nie nacisnij znak n.');
  793.   repeat
  794.    znak:=readkey;
  795.   until ((znak='t') or (znak='n'));
  796.   case znak of
  797.    't' : begin
  798.           ClrScr;
  799.           nowa_gra;
  800.          end;
  801.    'n' : begin
  802.           ClrScr;
  803.           menu;
  804.          end;
  805.    end;
  806.   ClrScr;
  807. end;
  808.  
  809. procedure nowa_gra;
  810. var
  811.   x:integer;
  812. begin
  813.   ClrScr;
  814.   poziom:=1;
  815.   wynik:=0;
  816.   Randomize;
  817.   x:=TextAttr;
  818.   CursorOff;
  819.   repeat
  820.     tetris;
  821.   until koniec_gry;
  822.   TextAttr:=x;
  823.   CursorOn;
  824.   ClrScr;
  825. end;
  826.  
  827. procedure zasady_gry;
  828. var
  829.   znak:char;
  830. begin
  831.  TextAttr := $0f;
  832.  GotoXY(30,2); TextAttr := $0c; write('Z ');
  833.  GotoXY(32,2); TextAttr := $0b; write('A ');
  834.  GotoXY(34,2); TextAttr := $0e; write('S ');
  835.  GotoXY(36,2); TextAttr := $0a; write('A ');
  836.  GotoXY(38,2); TextAttr := $09; write('D ');
  837.  GotoXY(40,2); TextAttr := $0d; write('Y  ');
  838.  GotoXY(43,2); TextAttr := $0e; write('G ');
  839.  GotoXY(45,2); TextAttr := $0a; write('R ');
  840.  GotoXY(47,2); TextAttr := $0c; write('Y ');
  841.  writeln;
  842.  writeln;
  843.  TextAttr := $0f;
  844.  wysrodkuj_tekst('Twoim zadaniem jest ukladanie spadajacych klockow.');
  845.  wysrodkuj_tekst('Klocki mozesz obracac za pomoca klawiszy strzalek.');
  846.  wysrodkuj_tekst('Jezeli wypelnisz caly wiersz kolckami, otrzymasz punkt.');
  847.  wysrodkuj_tekst('Przegrasz gdy cala planasza bedzie zapelniona klockami.');
  848.  writeln;
  849.  wysrodkuj_tekst('Powodzenia!');
  850.  writeln;
  851.  writeln;
  852.  wysrodkuj_tekst('Nacisnij klawisz g, zeby przejsc do gry.');
  853.  writeln;
  854.  wysrodkuj_tekst('Nacisnij klawisz m jezeli chcesz wrocic do menu.');
  855.  repeat
  856.    znak:=readkey;
  857.  until ((znak='g') or (znak='m'));
  858.  case znak of
  859.  'g' : begin
  860.         ClrScr;
  861.         nowa_gra;
  862.        end;
  863.  'm' : begin
  864.         ClrScr;
  865.         menu;
  866.        end;
  867.  end;
  868. end;
  869.  
  870. procedure menu;
  871. var
  872.   znak:char;
  873. begin
  874.  ClrScr;
  875.  TextBackground(black);
  876.  GotoXY(19,3); TextAttr := $0c; write('T  ');
  877.  GotoXY(22,3); TextAttr := $0d; write('E  ');
  878.  GotoXY(25,3); TextAttr := $0e; write('T  ');
  879.  GotoXY(28,3); TextAttr := $0c; write('R  ');
  880.  GotoXY(31,3); TextAttr := $0a; write('I  ');
  881.  GotoXY(34,3); TextAttr := $09; write('S  ');
  882.  TextAttr := $0d; narysuj_ramke(16,5,37,23);
  883.  GotoXY(24,6); TextAttr := $0c; write('M ');
  884.  GotoXY(26,6); TextAttr := $0b; write('E ');
  885.  GotoXY(28,6); TextAttr := $0e; write('N ');
  886.  GotoXY(30,6); TextAttr := $0a; write('U ');
  887.  TextAttr := $09; narysuj_ramke(17,8,36,12);
  888.  GotoXY(21,10); TextAttr := $0f; write('1. nowa gra');
  889.  TextAttr := $09; narysuj_ramke(17,13,36,17);
  890.  GotoXY(21,15); TextAttr := $0f; write('2. zasady gry');
  891.  TextAttr := $09; narysuj_ramke(17,18,36,22);
  892.  GotoXY(21,20); TextAttr := $0f; write('3. wyjscie');
  893.  repeat
  894.    znak:=readkey;
  895.  until ((znak='1') or (znak='2') or (znak='3'));
  896.  case znak of
  897.   '1' : begin
  898.          ClrScr;
  899.          nowa_gra;
  900.         end;
  901.   '2' : begin
  902.          ClrScr;
  903.          zasady_gry;
  904.         end;
  905.   '3' : exit;
  906.  end;
  907. end;
  908.  
  909. begin
  910.   powitanie;
  911.   podaj_imie;
  912.   menu;
  913. end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!