{ 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.