{ MINY.PAS Copyright (c) TrSek alias Zdeno Sekerak } { Znama hra z OS Windows kde mate za ulohu hladat miny. } { Program ukazuje iba pocet min v okoli policka smer musite urcit. } { } { Datum:28.05.1996 http://www.trsek.com } program dos_miny; uses crt,dos; const UP = 0; LEFT = 0; DLZ_X=15; DLZ_Y=22; POC_MIN=30; CPODKL= Blue; CTEXT = Yellow; CMINY = LightRed; CBODY = LightGray; var miny:array[0..DLZ_X+1,0..DLZ_Y+1] of boolean; { false-nieje mina, true-mina } vminy:array[1..DLZ_X,1..DLZ_Y] of byte; { 0-zakryte, 1-odkryte, 2-mina oznacena } x,y:integer; but:integer; odkr :integer; oznac:integer; finish:boolean; omode:integer; { vypise na suradnice x,y text } procedure WriteXY(x,y:byte;txt:string); begin GotoXY(x,y); Write(txt); end; { vypne/zapne kurzor } procedure KurzorZap(ZapVyp:boolean); var Regs : Registers; begin with Regs do begin AH := $03; BH := $00; Intr($10,Regs); If not(Zapvyp) then CH := CH or $20 else CH := CH and $DF; AH := $01; Intr($10,Regs); end; end; { zinicializuje ovladac mysi } function mys_init:boolean; var reg:registers; begin reg.ax:=$0000; intr($33,reg); if reg.ax=$0000 then mys_init:=false else mys_init:=true; { but:=reg.bx;} end; { zobrazi kurzor mysi} procedure mys_view; var reg:registers; begin reg.ax:=$0001; intr($33,reg); end; { zistuje stav tlacidiel a polohu mysi } procedure mys_get(var x,y,but:integer); var reg:registers; begin reg.ax:=$0003; intr($33,reg); x:=(Integer(reg.cx)-8*LEFT) div 32; y:=(Integer(reg.dx)-8*UP) div 16; but:=reg.bx; end; { do policka vpise cislo, alebo text } procedure PolXY(x,y:integer); begin GotoXY(LEFT+4*x+1,UP+2*y+1); end; { zobrazi siet } procedure siet(dx,dy:byte); var x,y:byte; l,r:char; str:string; begin dy:=dy+1; TextColor(CTEXT); TextBackGround(CPODKL); for y:=1 to dy do for x:=1 to dx do begin l:='Å'; str:='ÄÄÄ'; r:=' '; { horna, dolna lista } if(y=1) then str:='ÄÄÄ'; if(y=1) then l:='Â'; if(y=dy)then l:='Á'; { lavy, pravy okraj } if(x=1) then l:='Ã'; if(x=dx)then r:='´'; { rohy } if(x=1) and (y=1) then l:='Ú'; if(x=1) and (y=dy)then l:='À'; if(x=dx)and (y=1) then r:='¿'; if(x=dx)and (y=dy)then r:='Ù'; WriteXY(LEFT+4*x,UP+2*y,l+str+r); { vypln } if(y<>dy)then WriteXY(LEFT+4*x,UP+2*y+1,'³°±°³'); end; end; { menu napravo } procedure menu; begin TextColor(CTEXT); WriteXY(68,UP+3,' MINY DOS '); WriteXY(68,UP+5,'Najst :'); WriteXY(68,UP+6,'Oznacene:'); WriteXY(68,UP+7,'Nezname :'); WriteXY(44,Hi(WindMax),'Software by TrSek (c), www.trsek.com'); end; { rozmienstni miny } procedure Rozmiestni(poc:integer); var x,y,i:integer; begin Randomize; odkr:=DLZ_X*DLZ_Y-poc; { najprv vsetko zmazem } for x:=0 to DLZ_X+1 do for y:=0 to DLZ_Y+1 do miny[x,y]:=false; { zmazem policka oznacenych } for x:=1 to DLZ_X do for y:=1 to DLZ_Y do vminy[x,y]:=0; for i:=1 to poc do begin { vygeneruj suradnice } x:=Random(DLZ_X)+1; y:=Random(DLZ_Y)+1; { najdi ine miesto ak je obsadene } while(miny[x,y])do begin x:=x+1; if(x>DLZ_X)then y:=y+1; if(x>DLZ_X)then x:=1; if(y>DLZ_Y)then y:=1; end; { tu bude mina } miny[x,y]:=true; end; end; { zisti ci je v povolenom rozsahu } function Rozsah(x,y:integer):boolean; begin Rozsah:=true; if(x<1)then Rozsah:=false; if(y<1)then Rozsah:=false; if(x>DLZ_X)then Rozsah:=false; if(y>DLZ_Y)then Rozsah:=false; end; { spocita kolko min je okolo } function Body(x,y:integer):byte; var kol:byte; begin kol:=0; { otestuje miny okolo } if(miny[x-1,y-1])then inc(kol); if(miny[x-1,y ])then inc(kol); if(miny[x-1,y+1])then inc(kol); if(miny[x ,y-1])then inc(kol); if(miny[x ,y+1])then inc(kol); if(miny[x+1,y-1])then inc(kol); if(miny[x+1,y ])then inc(kol); if(miny[x+1,y+1])then inc(kol); Body:=kol; end; { ukaze kolko je okolo min } procedure UkazBody(x,y:integer); var kol:integer; begin if(Rozsah(x,y) and (vminy[x,y]<>1))then begin { ak to bola oznacena mina } if(vminy[x,y]=2)then oznac:=oznac-1; { pocet min okolo } kol :=Body(x,y); odkr:=odkr-1; vminy[x,y]:=1; TextColor(CBODY); PolXY(x,y); { zobrazime cislo alebo medzeru } if(kol=0)then Write(' ') else Write(' ',kol,' '); { mensia rekurzia } if(kol=0)then begin UkazBody(x-1,y-1); UkazBody(x-1,y ); UkazBody(x-1,y+1); UkazBody(x ,y-1); UkazBody(x ,y+1); UkazBody(x+1,y-1); UkazBody(x+1,y ); UkazBody(x+1,y+1); end; end; end; { ukaze minu ak je na policku } procedure UkazMinu(x,y:integer); begin TextColor(CMINY); PolXY(x,y); if(miny[x,y])then Write('<*>'); end; { ukaze vsetky miny } procedure UkazMiny; var x,y:integer; begin for x:=1 to DLZ_X do for y:=1 to DLZ_y do UkazMinu(x,y); end; begin { zmenime roizsirenie a zmazeme obrazovku } OMode:=LastMode; TextMode(Lo(LastMode) + Font8x8); TextBackGround(Brown); ClrScr; Siet(DLZ_X,DLZ_Y); Rozmiestni(POC_MIN); Menu; mys_init; mys_view; finish:=false; KurzorZap(false); repeat mys_get(x,y,but); { klikol mysou - lavim } if(but=1) and Rozsah(x,y)then begin but:=0; UkazBody(x,y); { odkryl poslednu kocku } if(odkr=0)then finish:=true; { trafil minu } if(miny[x,y])then begin UkazMinu(x,y); finish:=true; odkr:=odkr+1; end; end; { klikol mysou - pravym } if(but=2) and Rozsah(x,y) and (vminy[x,y]=0)then begin vminy[x,y]:=2; oznac:=oznac+1; TextColor(CMINY); PolXY(x,y); Write('°°±'); end; { obsluha klavesnice - len klaves ESC } if(keypressed)then begin if(readkey=#27)then finish:=true; end; { zobraz priebezne body } TextColor(CTEXT); GotoXY(77,UP+5); Write(odkr:3); GotoXY(77,UP+6); Write(oznac:3); GotoXY(77,UP+7); Write(POC_MIN-oznac:3); until finish; UkazMiny; TextColor(CMINY+Blink); if(odkr=0)then WriteXY(16,Hi(WindMax),' -*- GRATULUJEM -*- ') else WriteXY(16,Hi(WindMax),' -*- TRAFIL SI MINU -*- '); { stary mod } repeat until keypressed; TextMode(OMode); end.