{ 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