Hra had ako ju poznate z mobilnych telefonov

Kategória: KMP (Klub mladých programátorov)

Autor: Werbhofen
Program: Python2.pas,  Kniznica.pas,  Data.pas
Súbor exe: Python2.exe

{ DATA.PAS                                                          }
{ Kniznica pre python.                                              }
{                                                                   }
{ Author: WERBHOFEN                                                 }
{ Datum: 12.10.2009                            http://www.trsek.com }
 
(* Datovy subor ku programu Python2.pas *)
procedure NovyBod; (* nahodne zvoli 1. bod, ktory treba zobrat *)
  begin
    Bod.x:=random(57)+2;
    Bod.y:=random(22)+2;
  end;
 
procedure VykresliHada;     (* nanovo vykresli celeho hada *)
  var i:integer;
  begin
    textbackground(FarbaHad);
    for i:=1 to DlzkaHada-1 do WriteXY(had[i].x,had[i].y,' ');
    textbackground(FarbaPozadie);
  end;
 
procedure Kraj;
  var n:integer;
  begin
    textbackground(FarbaOkraj);  (* hracia plocha *)
    window(1,1,60,25);
    ClrScr;
    textbackground(black);
    window(2,2,59,24);
    ClrScr;
 
    textbackground(FarbaOkraj);  (* pravy kraj obrazovky *)
    window(62,1,80,25);
    clrscr;
    textbackground(black);
    window(63,2,79,24);
    clrscr;
 
    textcolor(FarbaText);
    n:=4;
    WriteXY(n,3,'Hi-Score');
    GotoXY(n,4); Write(highscore:2);
    WriteXY(n,6,'Your Score');
    GotoXY(n,7); Write(score:2);
    WriteXY(n,9,'Life');
    GotoXY(n,10); Write(life:2);
    WriteXY(n,12,'Level');
    GotoXY(n,13); Write(level:2);
    WriteXY(n,21,'Space = Pause');
    WriteXY(n,22,' ESC  = Quit');
    window(1,1,80,25);
  end;
 
procedure ZvukPrehra;  (* zvuk pri narazeni hada *)
  var i:integer;
  begin
    i:=0;
    repeat
      i:=i+1;
      if zvuky then sound(random(500));
      cakaj(10);
    until i=50;
    nosound;
  end;
 
procedure ZvukNovyClanok; (* zvuk pri prejdeni cez novy clanok *)
  var i:integer;
  begin
    for i:=1 to 10 do begin
      if zvuky then sound(i*100);
      cakaj(10);
    end;
    nosound;
  end;
 
procedure UvodnaObrazovka;
  var x,y:integer;
  begin
    NoSound;
    x:=4; y:=3;
    textmode(1);
    VymazKurzor;
    textbackground(black);
    textcolor(FarbaOkraj);
    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+10,y+9);  writeln('Version 2.0');
    gotoxy(x+10,y+10); write('by WERBHOFEN');
    textcolor(26);
    WriteXY(x+8,18,'Press any key ...');
 
    ClearKeyboardBuffer;
    g:=readkey;
    if g=#27 then KoniecProgramu:=true;
    textmode(2);
    VymazKurzor;
  end;
 
procedure VymenSmer;
  var u,i:integer;
      n,m:array[1..100] of integer;
 
  begin                        (* superpoziciou poslednych 2 clankov   *)
    case had[1].x-had[2].x of  (* vypocita novy smer hada po stlaceni  *)
     -1: Smer:=4;              (* opacneho smeru, akym sa had pohybuje *)
      1: Smer:=2;
      else case had[1].y-had[2].y of
            -1: Smer:=1;
             1: Smer:=3;
           end;
    end;
 
    u:=0; i:=DlzkaHada+1;
    repeat        (* otoci hada naopak - tam, kde bola predna cast je *)
      u:=u+1;     (* zadna cast a tam, kde bola zadna cast je predna  *)
      i:=i-1;     (* cast (vymeni suradnice) *)
      m[u]:=had[i].x;
      n[u]:=had[i].y;
    until i=1;
 
    i:=0;
    repeat
      i:=i+1;
      had[i].x:=m[i];
      had[i].y:=n[i];
    until i=DlzkaHada;
  end;
 
procedure okno(s:string;color:byte);
  begin
    textcolor(color);
    textbackground(farbahad);
    WriteXY(27,11,s);
    g:=readkey;
    textbackground(FarbaPozadie);
    WriteXY(27,11,'          ');
    VykresliHada;
    textbackground(FarbaHad);
    WriteXY(Bod.x,Bod.y,' ');
    textbackground(FarbaPozadie);
  end;
 
procedure vymaz(oneskorenie:integer;zvuk:boolean);  (* vymaze hracu plochu po ukonceni hry *)
  var y,r,i:integer;
  begin
    textbackground(6);
    y:=y2;
    i:=0;
    repeat    (* maze z dola hore *)
      y:=y-1;
      i:=i+30;
      if zvuk and zvuky then sound(i);
      cakaj(oneskorenie);
      WriteXY(X1+1,y,'                                                          ');
    until y=y1+1;
 
    textbackground(FarbaPozadie);
    y:=y1;
    repeat    (* maze z hora dole *)
      y:=y+1;
      i:=i-30;
      if zvuk and zvuky then sound(i);
      cakaj(oneskorenie);
      WriteXY(X1+1,y,'                                                          ');
    until y=y2-1;
    nosound;
  end;
 
procedure borec;
  begin
    window(1,1,80,25);
    clrscr;
    KoniecHry:=true;
    textcolor(30);
    WriteXY(35,11,'SI BOREC !!!');
    ClearKeyboardBuffer;
    g:=readkey;
  end;
 
procedure NoveKolo;
  BEGIN
    StarySmer:=smer;
 
    textcolor(FarbaPozadie); (* vymaze posledny clanok z hada *)
    textbackground(FarbaPozadie);
    WriteXY(had[1].x,had[1].y,' ');
    gotoxy(had[1].x,had[1].y);
 
    cakaj(oneskorenie);
    while keypressed do begin
      g:=readkey;
      case g of
        #80: smer:=3;
        #72: smer:=1;
        #75: smer:=4;
        #77: smer:=2;
        #32: okno('PAUSE',30);
        #27: begin
               okno('QUIT?(Y/N)',FarbaText);
               if (g='Y')or(g='y') then KoniecProgramu:=true;
             end;
      end;
    end;
 
    textcolor(FarbaPozadie); (* vymaze posledny clanok z hada *)
    textbackground(FarbaPozadie);
    WriteXY(had[1].x,had[1].y,' ');
    gotoxy(had[1].x,had[1].y);
 
    textcolor(FarbaText);
    gotoxy(66,4); write('Hi-Score');
    gotoxy(66,5); write(highscore:2);
    gotoxy(66,7); write('Your Score');
    gotoxy(66,8); write(score:2);
 
    textbackground(FarbaHad);     (* furt prekresluje bod na zobratie, je tu totiz *)
    WriteXY(Bod.x,Bod.y,' ');     (* 'podozrenie' na miznutie tohto bodu v pripade *)
    textbackground(FarbaPozadie); (* ze sa objavi na suradniciach ktore uz ma had *)
 
    i:=0;
    repeat   (* posunie vsetky suradnice v hadovi o 1 do predu *)
      i:=i+1;
      had[i].x:=had[i+1].x;
      had[i].y:=had[i+1].y;
    until i=DlzkaHada-1;
 
    case smer of   (* zatacanie + posunutie (ovladanie) hada *)
      1: if StarySmer=3 then VymenSmer else had[DlzkaHada].y:=had[DlzkaHada].y-1;
      2: if StarySmer=4 then VymenSmer else had[DlzkaHada].x:=had[DlzkaHada].x+1;
      3: if StarySmer=1 then VymenSmer else had[DlzkaHada].y:=had[DlzkaHada].y+1;
      4: if StarySmer=2 then VymenSmer else had[DlzkaHada].x:=had[DlzkaHada].x-1;
    end;
 
    if (had[DlzkaHada].x=Bod.x)and(had[DlzkaHada].y=Bod.y) (* had sa trafil na dalsi bod *)
      then begin
        score:=score+100;
 
        BodyPreNovyZivot:=BodyPreNovyZivot+100;
        DlzkaHada:=DlzkaHada+1; (* dlzka hada sa zvacsila o jeden clanok *)
        if score>highscore then highscore:=score;
        if BodyPreNovyZivot>NovyZivot then begin
          life:=life+1;
          oneskorenie:=oneskorenie-10;
          BodyPreNovyZivot:=0;
        end;
        if DlzkaHada<level+PocetKociek  (* had este nema dlzku potrebnu na skoncenie levelu *)
          then begin
            ZvukNovyClanok;
            case smer of
              1: begin
                   had[DlzkaHada].x:=Bod.x;
                   had[DlzkaHada].y:=Bod.y-1;
                 end;
              2: begin
                   had[DlzkaHada].x:=Bod.x+1;
                   had[DlzkaHada].y:=Bod.y;
                 end;
              3: begin
                   had[DlzkaHada].x:=Bod.x;
                   had[DlzkaHada].y:=Bod.y+1;
                 end;
              4: begin
                   had[DlzkaHada].x:=Bod.x-1;
                   had[DlzkaHada].y:=Bod.y;
                 end;
            end;
            NovyBod;
          end
          else begin (* had ma dlzku potrebnu na skoncenie levelu *)
            KoniecKola:=true;
            level:=level+1;
            textbackground(FarbaHad);
            textcolor(FarbaText);
            WriteXY(29,11,'YOU WIN !!!');
            g:=readkey;
            vymaz(100,true);
            if DlzkaHada=MaxDlzkaHada then borec;
          end;
      end;
    i:=0;
    repeat (* narazanie hada sameho do seba *)
      i:=i+1;
      if (had[DlzkaHada].x=had[i].x)and(had[DlzkaHada].y=had[i].y) then prehra:=true;
    until (i=DlzkaHada-1)or(prehra);
 
    (* narazenie hada do steny *)
    if (had[DlzkaHada].x=x1)or(had[DlzkaHada].x=x2)or(had[DlzkaHada].y=y1)or(had[DlzkaHada].y=y2)then prehra:=true;
 
    if prehra then begin
      ZvukPrehra;
      KoniecKola:=true;
      life:=life-1;
      if life<=0
        then begin
          KoniecHry:=true;
          textbackground(FarbaHad);
          textcolor(FarbaText);
          WriteXY(23,11,'GAME OVER !!!');
          g:=readkey;
          vymaz(100*2,false);
        end
        else vymaz(100 div 3,false);
    end;
    textbackground(FarbaHad);    (* vykresli novy clanok hada *)
    WriteXY(had[DlzkaHada].x,had[DlzkaHada].y,' ');
    textbackground(FarbaPozadie);
  END;