Hra je podobna starsej hre supaplex.

{ FLUPAK.PAS                                                        }
{ Hra je podobna starsej hre supaplex.                              }
{ Sipkami sa pohybujes a zeries listky, na zaciatku ale musis       }
{ napisat kolko listkov chces vygenerovat.                          }
{ Author: BX                                                        }
{ Date  : 5.8.2009                             http://www.trsek.com }
 
program flupak;
uses crt,dos;
 
const chEnter = #13;
      chHore  = #72;
      chDole  = #80;
      chPravo = #77;
      chLavo  = #75;
 
var stl,ria:byte;
    metrov,ZjedeneListy,pocetListov,PridaneListy:integer;
    i:integer;
    max:integer; { Pre pridavanie listov }
    x,y:array[1..150] of integer;
    zozrane:array[1..100] of boolean;
 
 
     { menu }
    mStl,mRia:byte;
    hSlovo:integer;
 
	 { moznosti }
    List:string;
    TList:integer;
	fSchema:integer;
 
procedure menu; forward;
procedure main; forward;
procedure koniec; forward;
procedure StartOhradka; forward;
 
procedure hide;
var reg:registers;
begin
     reg.ah:=1;
     reg.ch:=32;
     intr($10,reg);
end;
 
 { Moznosti }
 procedure moznosti; forward;
 
procedure StartOhradka;
var i,j:integer;
 
begin
     for i:=28 to 54 do
      begin
 
       gotoxy(i,8);
        write(#205);
       gotoxy(i,18);
        write(#205);
      end;
 
     for j:=9 to 17 do
      begin
 
       gotoxy(27,j);
        write(#186);
       gotoxy(55,j);
        write(#186);
 
      end;
 
      gotoxy(27,8);
       write('o');
      gotoxy(55,18);
       write('o');
      gotoxy(27,18);
       write('o');
      gotoxy(55,8);
       write('o');
end;
 
procedure VyberFarbyInica;
begin
     clrscr;
     StartOhradka;
 
     gotoxy(4,24);
      write('Sipkami (vpravo, vlavo) si vyber vzhlad programu. Enterom potvrd');
 
     gotoxy(31,10);
      write('Typ listu: ',List);
     gotoxy(31,12);
      write('o Farebna schema: ',TextAttr);
end;
 
procedure ZmenaFarby;
var VyberFarby:char;
 
begin
     VyberFarbyInica;
      repeat
     TextAttr:=fSchema;
 
     VyberFarby:=readkey;
 
     if(VyberFarby=chPravo) then
                       begin
                        fSchema:=fSchema+1;
			  if(fSchema=64) then fSchema:=80;
                        TextAttr:=fSchema;
                        gotoxy(47,12);
                         write(TextAttr);
                        VyberFarbyInica;
                       end;
 
     if(VyberFarby=chLavo) then
                       begin
                        fSchema:=fSchema-1;
			  if(fSchema=79) then fSchema:=63;
                        TextAttr:=fSchema;
                        gotoxy(47,12);
                         write(TextAttr);
                        VyberFarbyInica;
                       end;
 
     if(VyberFarby=chHore) then begin moznosti; end;
 
     if(VyberFarby=#27)or(VyberFarby=chEnter) then begin menu; end;
 
     until(VyberFarby=#27)or(VyberFarby=chHore)or(VyberFarby=chEnter);
end;
 
function TypListu(TL:integer):string;
begin
     TList:=TL;
      case TL of
                1 : begin List:=#1; write(List); end;
                2 : begin List:=#2; write(List); end;
                3 : begin List:=#3; write(List); end;
                4 : begin List:=#4; write(List); end;
                5 : begin List:=#5; write(List); end;
                6 : begin List:=#6; write(List); end;
                7 : begin List:=#14; write(List); end;
                8 : begin List:=#15; write(List); end;
                9 : begin List:=#176; write(List); end;
      end; { pre case }
end;
 
procedure Moznosti;
var VyberListu:char;
begin
     TextAttr:=fSchema;
     clrscr;
     StartOhradka;
 
     gotoxy(4,24);
      write('Sipkami (vpravo, vlavo) si vyber styl listu. Enterom potvrd');
 
     gotoxy(31,12);
      write('Farebna schema: ',TextAttr);
 
     gotoxy(31,10);
     write('o Typ listu: ',List);
 
      repeat
     VyberListu:=readkey;
 
      if(VyberListu=#77) then
       begin
             if(TList=9) then TList:=0;
            TList:=TList+1;
            gotoxy(44,10);
            TypListu(TList);
       end;
      if(VyberListu=#75) then
        begin
              if(TList=1) then TList:=10;
             TList:=TList-1;
             gotoxy(44,10);
             TypListu(TList);
        end;
 
      if(VyberListu=#27)or(VyberListu=chEnter) then begin menu end;
 
      if(VyberListu=chDole)then begin ZmenaFarby; end;
 
      until(VyberListu=#27)or(VyberListu=chEnter)or(VyberListu=chDole);
 
end;
 
 { koniec moznosti }
 
 { O programe }
procedure oPrograme;
begin
     {textbackground(green);
     textcolor(white);}
     clrscr;
     gotoxy(10,4);
      write('Programator: BX');
     gotoxy(10,5);
      write(' (www.nemamziadnustranku.sk)');
 
     gotoxy(10,8);
      write('Verzia programu: 2.1');
 
     gotoxy(10,12);
     writeln('Ovladanie: Sipky : Pohyb ');
     writeln(' ':20,'Tab   : Statistiky');
     writeln(' ':20,'A     : Pridat listy');
     {writeln(' ':20,'R     : Restartovat hru');}
     writeln(' ':20,'Esc   : Koniec');
 
     {textcolor(yellow);}
     gotoxy(7,20);
     write('Dufam ze sa vam moj vytvor paci :)');
 
     {textcolor(red);}
     gotoxy(50,24);
      write('sp',#132,#156,' -> Esc');
     readkey;
end;
 
 
{ start of program }
procedure start;
var startkl:char;
    x,y:byte;
    Chyba:boolean;
begin
     {textbackground(green);}
     clrscr;
     {textcolor(lightblue);}
     gotoxy(1,17);
     writeln('Ovladanie: Sipky : Pohyb ');
     writeln('           Tab   : Statistiky');
     writeln('           A     : Pridat listy');
     writeln('           R     : Restartovat hru');
     writeln('           Esc   : Koniec');
     {textcolor(white);}
     gotoxy(1,3);
     writeln('Hra je podobna starsej hre supaplex');
     writeln('Sipkami sa pohybujes a zeries listky, na zaciatku ale musis napisat');
     writeln('kolko listkov chces vygenerovat');
     delay(1000);
     gotoxy(5,12);
     write('Zadaj kolko listkov chces generovat(max=100): ');
     gotoxy(51,12);
     {$I-} readln(pocetListov); {$I+}
     Chyba:=IOResult<>0;
     if(pocetListov>100) or(PocetListov<0) or Chyba then begin
                    gotoxy(50,14);
                    TextColor(lightred);
                    write('Vloz cislo od 0 do 100 !!!');
 
		    TextAttr:=fSchema;
 
                    delay(1000);
                    clrscr;
                    {textcolor(white);}
                    start;
                   end;
 
     {gotoxy(20,12);
     write(' ':30);
     gotoxy(1,1);}
end;
 
 { menu }
 
function fSlovo(pSlovo:integer):string;
begin
     hSlovo:=pSlovo;
     if(pSlovo=1) then
                      begin
                        write('Nova Hra');
                      end;
     if(pSlovo=2) then
                      begin
                        write('Moznosti');
                      end;
     if(pSlovo=3) then
                      begin
                        write('O programe');
                      end;
     if(pSlovo=4) then
                      begin
                        write('Koniec');
                      end;
end;
 
procedure menu;
var smer:char;
 
begin
     mStl:=37; mRia:=10;
     hSlovo:=1;
     max:=100;
     PridaneListy:=0;
     metrov:=0;
     ZjedeneListy:=0;
     ZjedeneListy:=ZjedeneListy;
     clrscr;
 
     StartOhradka;
 
     gotoxy(1,1);
     writeln('Fupaplex, verzia 2.1');
     write('Enjoy the Game! ',#1);
 
     gotoxy(37,10);
     textbackground(lightred);
     write('Nova Hra');
     TextAttr:=fSchema;
 
     gotoxy(37,12);
     write('Moznosti');
 
     gotoxy(37,14);
     write('O programe');
 
     gotoxy(37,16);
     write('Koniec');
 
      repeat
 
     smer:=readkey;
 
     if(smer=chDole)or(smer=chEnter) then
                       begin
                            gotoxy(mStl, mRia);
                            TextAttr:=fSchema;
                            fSlovo(hSlovo);
                             if(hSlovo=4)and(smer<>chEnter) then begin hSlovo:=0; mStl:=37; mRia:=8; end;
                            mRia:=mRia+2;
                            gotoxy(mStl, mRia);
                            textbackground(lightred);
                             fSlovo(hSlovo+1);
                       end;
 
     if(smer=chHore)or(smer=chEnter) then
                       begin
                            gotoxy(mStl, mRia);
                            TextAttr:=fSchema;
                            fSlovo(hSlovo);
                              if(hSlovo=1)and(smer<>chEnter) then begin hSlovo:=5; mStl:=37; mRia:=18; end;
                            mRia:=mRia-2;
                            gotoxy(mStl, mRia);
                            textbackground(lightred);
                            fSlovo(hSlovo-1);
			    TextAttr:=fSchema;
                             if(smer=chEnter)and(mRia=10) then begin start; end;
                             if(smer=chEnter)and(mRia=12) then begin moznosti; end;
			     if(smer=chEnter)and(mRia=14) then begin oPrograme; menu; end;
                             if(smer=chEnter)and(mRia=16) then Koniec;
                       end;
      until(smer=chEnter);
end;
 { koniec menu }
 
{ end of program }
procedure koniec;
begin
     TextAttr:=fSchema+2;
     clrscr;
     gotoxy(50,22);
     write('This program was made by BX');
     delay(500);
     halt;
end;
 
{ ohrada }
procedure ohrada;
var i:integer;
begin
  TextAttr:=fSchema;
  clrscr;
  TextAttr:=fSchema;
  write(chr(201)); for i:=2 to 79 do write(chr(205)); write(chr(187));
  for i:=2 to 22 do begin write(chr(186)); write(chr(186):79) end;
  write(chr(200)); for i:=2 to 79 do write(chr(205)); write(chr(188));
  TextAttr:=fSchema;
  { inicializacia flupaka na zaciatok }
      stl:=33;
      ria:=12;
      gotoxy(stl,ria);
      write('<');
	TextAttr:=fSchema;
end;
 
{ smer }
procedure dole;
begin
  if (ria<21) then begin
     inc(ria);
     gotoxy(stl,ria);
     TextAttr:=fSchema;
     write(#94);
     metrov:=metrov+1;
     TextAttr:=fSchema;
                   end;
end;
 
procedure hore;
begin
  if (ria>2) then begin
     dec(ria);
     gotoxy(stl,ria);
     TextAttr:=fSchema;
     write('V');
     metrov:=metrov+1;
     TextAttr:=fSchema;
                  end;
end;
 
procedure doprava;
begin
  if (stl<79) then begin
     inc(stl);
     gotoxy(stl,ria);
     TextAttr:=fSchema;
     write('<');
     metrov:=metrov+1;
     TextAttr:=fSchema;
                   end;
end;
 
procedure dolava;
begin
  if stl>2 then begin
     dec(stl);
     gotoxy(stl,ria);
     TextAttr:=fSchema;
     write('>');
     metrov:=metrov+1;
     TextAttr:=fSchema;
                end;
end;
 
{ statistics }
procedure tabs;
begin
     gotoxy(10,24);
	TextAttr:=fSchema;
      if(metrov=1) then write('Presiel si ',metrov,' meter');
      if(metrov<=4)and(metrov>=2) then write('Presiel si ',metrov,' metre');
      if(metrov>=5)or(metrov=0) then write('Presiel si ',metrov,' metrov');
     delay(1000);
     gotoxy(10,24);
     write('                                           ');
     gotoxy(10,24);
     write('Zjedol si: ',ZjedeneListy,'/',pocetListov+PridaneListy);
     delay(1000);
     gotoxy(10,24);
     write('                                           ');
     gotoxy(stl,ria);
     TextAttr:=fSchema;
     write('<');
end;
 
{ inicializacia listov }
function VykreslenieListov(Pocet:integer):integer;
var i,j:integer;
begin
for i:=1 to Pocet do begin
  x[i]:=random(75)+2;
  y[i]:=random(20)+2;
  zozrane[i]:=false;
                     end;
 
for j:=1 to Pocet do begin
                        gotoxy(x[j],y[j]);
                        write(List);
                     end;
end;
 
 
{ Pridanie listov }
function pridat(xKolko:integer):integer;
var i,j:integer;
    Chyba:boolean;
begin
     xKolko:=PridaneListy;
     gotoxy(10,24);
     TextAttr:=fSchema;
     write('Kolko chces pridat? (max ',max-PocetListov,'): ');
 
     {$I-} readln(PridaneListy); {$I+}
 
     Chyba := IOResult <> 0;
 
 
 
     if Chyba or (max-PocetListov-PridaneListy<0) then begin { Ak nastane chyba, vykreslenie listov sa preskoci }
 
                    gotoxy(45,24);
                    textcolor(lightred);
                    write('Nemozno vykreslit listy !!!');
					TextAttr:=fSchema;
                    delay(1500);
                    max:=max+PridaneListy;
 
                                          end
   else begin  { Ak chyba nenastane, vykreslia sa nove listy }
 
       for i:=(PocetListov+1) to (PocetListov+PridaneListy) do begin
       x[i]:=random(75)+2;
       y[i]:=random(20)+2;
       zozrane[i]:=false;
                                                end;
 
       for j:=(PocetListov+1) to (PocetListov+PridaneListy) do begin
 
                       if(PridaneListy>max) then break;
 
                        gotoxy(x[j],y[j]);
                        TextAttr:=fSchema;
                        write(List);
 
                                                end;
   end; { koniec pre else }
 
       max:=max-PridaneListy;
	TextAttr:=fSchema;
       gotoxy(10,24);
       write(' ':68); {vymazanie vety dole v pravo}
      TextAttr:=fSchema;
end;
 
{ pohyb }
procedure move;
var i,l,j:integer;
    klaves:char; { na pohyb }
begin
 
     VykreslenieListov(PocetListov);
     repeat
 
      klaves:=readkey;
      gotoxy(stl,ria);
      write(' ');
       case klaves of
                     #80 : dole;
                     #72 : hore;
                     #75 : dolava;
                     #77 : doprava;
                     #27 : koniec;
                     #9  : tabs;
                     #97 : pridat(PridaneListy); 
 
       end;
      for i:=1 to (pocetListov+PridaneListy) do begin
                             if(stl=x[i]) and (ria=y[i]) and (not(zozrane[i])) then begin
                             ZjedeneListy:=ZjedeneListy+1;
                             zozrane[i]:=true;
                            end;
      end;
 
     until(ZjedeneListy=(pocetListov+PridaneListy));
		TextAttr:=fSchema;
        clrscr;
        gotoxy(10,11);
        write('GRATULUJEM! Zozral si vsetky :)');
        gotoxy(10,12);
        write('Nepostupujes nikde, pretoze levely to nema, dufam ze sa pacilo :)');
        delay(3000);
       {end;}
end;
 
 
{///////////I///N///T///R//O/////////////////////////////////////////////////////////////////////////////////}
procedure intro;
var x,y,i,j:integer;
begin
     textbackground(white);
     clrscr;
 
textcolor(lightred);
gotoxy(1,4);
write('    %%%%%%%%%%%  ');
gotoxy(1,5);
write('    %            ');
gotoxy(1,6);
write('    %            ');
gotoxy(1,7);
write('    %            ');
gotoxy(1,8);
write('    %%%%%%%%%    ');
gotoxy(1,9);
write('    %            ');
gotoxy(1,10);
write('    %            ');
gotoxy(1,11);
write('    %            ');
gotoxy(1,12);
write('    %            ');
gotoxy(1,13);
write('    %            ');
gotoxy(1,14);
write('    %            ');
gotoxy(1,15);
write('    %            ');
 
textcolor(lightgreen);
gotoxy(15,6);
write('    #          ');
gotoxy(15,7);
write('    #           ');
gotoxy(15,8);
write('    #           ') ;
gotoxy(15,9);
write('    #             ');
gotoxy(15,10);
write('    #           ')   ;
gotoxy(15,11);
write('    #           ')    ;
gotoxy(15,12);
write('    #           ')     ;
gotoxy(15,13);
write('    #           ')      ;
gotoxy(15,14);
write('    #           ')       ;
gotoxy(15,15);
write('    #           ')        ;
gotoxy(15,16);
write('    #           ')         ;
gotoxy(15,17);
write('    ###########')           ;
 
 
textcolor(black);
gotoxy(27,5);
write('    @         @');
gotoxy(27,6);
write('    @         @') ;
gotoxy(27,7);
write('    @         @')  ;
gotoxy(27,8);
write('    @         @')   ;
gotoxy(27,9);
write('    @         @')    ;
gotoxy(27,10);
write('    @         @')     ;
gotoxy(27,11);
write('    @         @')      ;
gotoxy(27,12);
write('    @         @')       ;
gotoxy(27,13);
write('    @         @')        ;
gotoxy(27,14);
write('    @         @')         ;
gotoxy(27,15);
write('    @         @')          ;
gotoxy(27,16);
write('    @@@@@@@@@@@')           ;
 
 
textcolor(cyan);
gotoxy(44,2);
write('*********');
gotoxy(44,3);
write('*        *');
gotoxy(44,4);
write('*         *');
gotoxy(44,5);
write('*         * ');
gotoxy(44,6);
write('*        *')  ;
gotoxy(44,7);
write('*********')  ;
gotoxy(44,8);
write('*')         ;
gotoxy(44,9);
write('*')        ;
gotoxy(44,10);
write('*')        ;
gotoxy(44,11);
write('*')        ;
gotoxy(44,12);
write('*')        ;
gotoxy(44,13);
write('*')        ;
 
 
textcolor(lightblue);
gotoxy(55,5);
write('    %%%%%%%%%%');
gotoxy(55,6);
write('    %        %');
gotoxy(55,7);
write('    %        %');
gotoxy(55,8);
write('    %        %');
gotoxy(55,9);
write('    %        %');
gotoxy(55,10);
write('    %        %');
gotoxy(55,11);
write('    %%%%%%%%%%');
gotoxy(55,12);
write('    %        %');
gotoxy(55,13);
write('    %        %');
gotoxy(55,14);
write('    %        %');
gotoxy(55,15);
write('    %        %');
gotoxy(55,16);
write('    %        %');
 
 
textcolor(yellow);
gotoxy(70,7);
write('&     &  ');
gotoxy(70,8);
write('&    &   ');
gotoxy(70,9);
write('&   &    ');
gotoxy(70,10);
write('&  &     ');
gotoxy(70,11);
write('& &      ');
gotoxy(70,12);
write('&&       ');
gotoxy(70,13);
write('& &       ');
gotoxy(70,14);
write('&  &       ');
gotoxy(70,15);
write('&   &      ');
gotoxy(70,16);
write('&    &     ');
gotoxy(70,17);
write('&     &    ');
gotoxy(70,18);
write('&      &   ');
 
 
textcolor(blue);
x:=1;
y:=22;
for i:=1 to 80 do begin
                    gotoxy(x,y);
                    write(#176);
                    x:=x+1;
                   end;
y:=23;
for i:=1 to 80 do begin
                    gotoxy(x,y);
                    write(#176);
                    x:=x+1;
                   end;
y:=24;
for i:=1 to 80 do begin
                    gotoxy(x,y);
                    write(#176);
                    x:=x+1;
                   end;
 
    { odpocet }
    textcolor(black);
      for j:=3 downto 0 do begin
                               delay(1000);
                               gotoxy(40,23);
                               write(j);
                          end;
 
 
 
end;
 
procedure main;
begin
     TextAttr:=fSchema;
     clrscr;
     menu;
     ohrada;
     move;
end;
 
{ main program }
begin
     TList:=1; List:=#5;
     fSchema:=39;
     hide;
     intro;
     main;
     koniec;
end.