Umiestnenie súboru www.TrSek.com/cover/neznamy/miny.pas{ MINY.PAS Copyright (c) }
{ Tak chcel by som v prvom rade napisat, ze toto je moj treti }
{ pouzitelny program v pascale a preto prosim ospravedln nejake }
{ zbytocne riadky alebo neefektivne algoritmy. Dalej si myslim, ze }
{ popis velmi netreba, cele som to uz pri pisani rozdeloval do }
{ podprogramov pre vacsiu prehladnost a aj ich nazvy myslim hovoria }
{ za vsetko. A este si nevsimaj (pripadne prepis) nazvy premennych }
{ ako kill a win. neplanoval som to zverejnovat :) }
{ }
{ Author: }
{ Datum: 02.06.2009 http://www.trsek.com }
program miny;
uses crt,sysutils;
var a,b,polehraca:array[2..79,2..20]of integer;
xos,yos,minky,x,y,kill,win,lvyh,lrem,lpreh,svyh,srem,spreh,tvyh,trem,tpreh:integer;
c:char;
f:file of integer;
prvytah:boolean;
procedure instrukcie;
var i:integer;
j:string;
begin
clrscr;
j:='MINY';
for i:=1 to 4 do begin
if i mod 2=1 then begin
textcolor(lightred);
write(copy(j,i,1));
end;
if i mod 2=0 then begin
textcolor(lightgreen);
write(copy(j,i,1));
end;
end;
textcolor(white);
writeln;
writeln;
textcolor(yellow);
writeln('Ovladanie:');
textcolor(white);
writeln('sipky -pohyb kurzora');
writeln('enter -slapnutie na dane policko');
writeln('del -oznacenie miny');
writeln('Q -ukoncenie aktualnej hry (prehra)');
writeln;
textcolor(cyan);
write('(potvrd enterom)');
textcolor(white);
repeat until readkey=chr(13);
end;
procedure prvytahvynulovanie;
var i,j:integer;
begin
for i:=2 to 79 do
for j:=2 to 20 do begin
a[i,j]:=0;
b[i,j]:=0;
polehraca[i,j]:=0;
end;
end;
procedure vynulovanie;
var i,j:integer;
begin
clrscr;
for i:=2 to 79 do
for j:=2 to 20 do begin
a[i,j]:=0;
b[i,j]:=0;
polehraca[i,j]:=0;
end;
x:=2;
y:=2;
kill:=0;
win:=0;
prvytah:=true;
textcolor(white);
end;
procedure vykrespole(xos,yos,minky:integer);
var i,j,r,s:integer;
begin
clrscr;
j:=0;
gotoxy(1,1); write(chr(201));
for i:=1 to xos do write(chr(205));
write(chr(187));
for i:=2 to yos+1 do begin
gotoxy(1,i);
write(chr(186));
textbackground(7);
for j:=1 to xos do write(' ');
textbackground(black);
write(chr(186));
end;
gotoxy(1,yos+2); write(chr(200));
for i:=1 to xos do write(chr(205));
write(chr(188));
j:=0;
repeat
r:=random(xos)+2;
s:=random(yos)+2;
if a[r,s]=0 then begin
a[r,s]:=1;
inc(j);
end;
until j=minky;
end;
procedure check(cx,cy:integer);
var i:integer;
begin
i:=0;
if polehraca[cx,cy]=0 then begin
if a[cx,cy]=0 then begin
if (cy<=yos)and(a[cx,cy+1]=1) then inc(i);
if (cx>=3)and(cy<=yos)and(a[cx-1,cy+1]=1) then inc(i);
if (cx>=3)and(a[cx-1,cy]=1) then inc(i);
if (cx>=3)and(cy>=3)and(a[cx-1,cy-1]=1) then inc(i);
if (cy>=3)and(a[cx,cy-1]=1) then inc(i);
if (cx<=xos)and(cy>=3)and(a[cx+1,cy-1]=1) then inc(i);
if (cx<=xos)and(a[cx+1,cy]=1) then inc(i);
if (cx<=xos)and(cy<=yos)and(a[cx+1,cy+1]=1) then inc(i);
case i of
0:begin
gotoxy(cx,cy);
write(' ');
polehraca[cx,cy]:=1;
if cy<=yos then check(cx,cy+1);
if (cx>=3)and(cy<=yos) then check(cx-1,cy+1);
if cx>=3 then check(cx-1,cy);
if (cx>=3)and(cy>=3) then check(cx-1,cy-1);
if cy>=3 then check(cx,cy-1);
if (cx<=xos)and(cy>=3) then check(cx+1,cy-1);
if cx<=xos then check(cx+1,cy);
if (cx<=xos)and(cy<=yos) then check(cx+1,cy+1);
end;
1:begin
textcolor(lightblue);
gotoxy(cx,cy);
write('1');
polehraca[cx,cy]:=1;
end;
2:begin
textcolor(lightgreen);
gotoxy(cx,cy);
write('2');
polehraca[cx,cy]:=1;
end;
3:begin
textcolor(yellow);
gotoxy(cx,cy);
write('3');
polehraca[cx,cy]:=1;
end;
4:begin
textcolor(lightred);
gotoxy(cx,cy);
write('4');
polehraca[cx,cy]:=1;
end;
5:begin
textcolor(brown);
gotoxy(cx,cy);
write('5');
polehraca[cx,cy]:=1;
end;
6:begin
textcolor(magenta);
gotoxy(cx,cy);
write('6');
polehraca[cx,cy]:=1;
end;
7:begin
textcolor(red);
gotoxy(cx,cy);
write('7');
polehraca[cx,cy]:=1;
end;
8:begin
textcolor(blue);
gotoxy(cx,cy);
write('8');
polehraca[cx,cy]:=1;
end;
end;
end;
if a[cx,cy]=1 then kill:=1;
end;
end;
procedure tahhraca;
var i:integer;
begin
i:=0;
gotoxy(x,y);
repeat
repeat until keypressed;
c:=readkey;
if (ord(c)=72)and(y>2) then y:=y-1;
if (ord(c)=80)and(y<=yos) then y:=y+1;
if (ord(c)=75)and(x>2) then x:=x-1;
if (ord(c)=77)and(x<=xos) then x:=x+1;
if (ord(c)=83)and(polehraca[x,y]=0) then begin
if b[x,y]=0 then begin
gotoxy(x,y);
textcolor(lightred);
write(chr(219));
end;
if b[x,y]=1 then begin
gotoxy(x,y);
textbackground(7);
write(' ');
textbackground(black);
end;
if b[x,y]=0 then b[x,y]:=1
else b[x,y]:=0;
end;
if (ord(c)=13)and(polehraca[x,y]=0)and(b[x,y]=0) then begin
while (prvytah)and(a[x,y]=1) do begin
prvytahvynulovanie;
vykrespole(xos,yos,minky);
if a[x,y]=0 then prvytah:=false;
end;
if prvytah then prvytah:=false;
check(x,y);
i:=1;
end;
if c='q' then i:=1;
gotoxy(x,y);
until i=1;
end;
procedure kontvyt;
var i,j,k:integer;
begin
i:=0;
for k:=2 to yos+1 do
for j:=2 to xos+1 do
if not((a[j,k]=0)and(polehraca[j,k]=1)) then inc(i);
if i=minky then win:=1;
end;
procedure vyhodnotenie;
var i,j:integer;
begin
if win=1 then begin
for i:=2 to 79 do
for j:=2 to 20 do
if a[i,j]=1 then begin
gotoxy(i,j);
textcolor(white);
write('X');
end;
gotoxy(1,yos+4);
textcolor(yellow);
write('Vyhral si');
textcolor(white);
case random(4) of
0:write(', uspesne si vycistil cele minove pole!');
1:write(' dobry pocit!');
2:write(', vdaka tebe sa uz nemusia afganske deti nicoho obavat!');
3:write(', dokazal si objavit aj tu poslednu minu!');
end;
reset(f);
read(f,lvyh,lpreh,svyh,spreh,tvyh,tpreh);
if (minky=10)and(xos=9)and(yos=9) then inc(lvyh);
if (minky=40)and(xos=16)and(yos=16) then inc(svyh);
if (minky=100)and(xos=30)and(yos=16) then inc(tvyh);
rewrite(f);
write(f,lvyh,lpreh,svyh,spreh,tvyh,tpreh);
end;
if kill=1 then begin
for i:=2 to 79 do
for j:=2 to 20 do
if a[i,j]=1 then begin
gotoxy(i,j);
textcolor(white);
write('X');
end;
gotoxy(x,y);
textbackground(lightred);
write('X');
textbackground(black);
gotoxy(1,yos+4);
textcolor(yellow);
write('Prehral si');
textcolor(white);
case random(4) of
0:write(', uz asi svoje lietajuce casti tela nepozbieras...');
1:write(', tentoraz si sa trafil zle.');
2:write(', je to az take tazke?');
3:write(', posledne, na co si pamatas, je tiche cvaknutie.');
end;
reset(f);
read(f,lvyh,lpreh,svyh,spreh,tvyh,tpreh);
if (minky=10)and(xos=9)and(yos=9) then inc(lpreh);
if (minky=40)and(xos=16)and(yos=16) then inc(spreh);
if (minky=100)and(xos=30)and(yos=16) then inc(tpreh);
rewrite(f);
write(f,lvyh,lpreh,svyh,spreh,tvyh,tpreh);
end;
if c='q' then begin
gotoxy(1,yos+4);
textcolor(yellow);
write('Prehral si');
textcolor(white);
case random(4) of
0:write(', len tak odchadzas? Nejake miny este ostali neodhalene...');
1:write(', naozaj si sklamal afganske deti.');
2:write(', je tych min na teba prilis?');
3:write(', zbytocne dalsia prehra.');
end;
reset(f);
read(f,lvyh,lpreh,svyh,spreh,tvyh,tpreh);
if (minky=10)and(xos=9)and(yos=9) then inc(lpreh);
if (minky=40)and(xos=16)and(yos=16) then inc(spreh);
if (minky=100)and(xos=30)and(yos=16) then inc(tpreh);
rewrite(f);
write(f,lvyh,lpreh,svyh,spreh,tvyh,tpreh);
end;
gotoxy(1,yos+5);
writeln('Pre zacatie novej hry stlac N, pre pole z predoslej hry P, pre zobrazenie');
write('statistiky S a pre ukoncenie Q.');
end;
procedure koniec;
begin
clrscr;
textcolor(cyan);
case random(5) of
0:write('GOODBYE!');
1:write('SEE YA!');
2:write('SEE YOU LATER!');
3:write('BYE BYE!');
4:write('GOOD GAME!');
end;
delay(2000);
end;
procedure statistika;
begin
clrscr;
writeln('LAHKA');
writeln('Vyhry = ');
writeln('Prehry = ');
writeln('Hranych hier = ');
writeln;
writeln('STREDNA');
writeln('Vyhry = ');
writeln('Prehry = ');
writeln('Hranych hier = ');
writeln;
writeln('TAZKA');
writeln('Vyhry = ');
writeln('Prehry = ');
writeln('Hranych hier = ');
writeln;
writeln('Celkovo hranych hier = ');
writeln;
writeln('Pre vymazanie statistik stlac V, pre zacatie novej hry N, pre pole z predoslej');
write('hry P, pre ukoncenie Q.');
reset(f);
read(f,lvyh,lpreh,svyh,spreh,tvyh,tpreh);
textcolor(yellow);
gotoxy(9,2);
write(lvyh);
gotoxy(10,3);
write(lpreh);
gotoxy(9,7);
write(svyh);
gotoxy(10,8);
write(spreh);
gotoxy(9,12);
write(tvyh);
gotoxy(10,13);
write(tpreh);
textcolor(lightred);
gotoxy(16,4);
write(lvyh+lpreh);
gotoxy(16,9);
write(svyh+spreh);
gotoxy(16,14);
write(tvyh+tpreh);
gotoxy(24,16);
write(lvyh+lpreh+svyh+spreh+tvyh+tpreh);
textcolor(white);
gotoxy(24,19);
end;
begin
randomize;
assign(f,'minstats.dat');
if not(fileexists('minstats.dat')) then begin
rewrite(f);
write(f,0,0,0,0,0,0);
end;
xos:=9;
yos:=9;
minky:=10;
instrukcie;
repeat
vynulovanie;
if c<>'p' then begin
writeln('Vyber si obtiaznost lahku, strednu, tazku alebo vlastne pole. (L/S/T/V)');
repeat
repeat until keypressed;
c:=readkey;
if c='l' then begin xos:=9; yos:=9; minky:=10; end;
if c='s' then begin xos:=16; yos:=16; minky:=40; end;
if c='t' then begin xos:=30; yos:=16; minky:=100; end;
if c='v' then begin
repeat
clrscr;
writeln('Zadaj sirku (max 78), vysku (max 19) a pocet min (max sirka*vyska) na poli:');
read(xos,yos,minky);
until (xos<79)and(xos>0)and(yos<20)and(yos>0)and(minky>0)and(minky<xos*yos);
end;
until (c='l')or(c='s')or(c='t')or(c='v');
c:='0';
end;
vykrespole(xos,yos,minky);
repeat
tahhraca;
kontvyt;
until (kill=1)or(win=1)or(c='q');
vyhodnotenie;
repeat
repeat until keypressed;
c:=readkey;
until (c='n')or(c='q')or(c='s')or(c='p');
if c='s' then begin
repeat
statistika;
repeat
repeat until keypressed;
c:=readkey;
until (c='n')or(c='q')or(c='v')or(c='p');
if c='v' then begin
rewrite(f);
write(f,0,0,0,0,0,0);
end;
until (c='n')or(c='q')or(c='p');
end;
until c='q';
koniec;
end.