Uses Knihovna,Crt;
(**)
Type Hle=array[1..11,1..11] of string[3];
Type Hle2=array[1..11,1..11] of byte;
(* 1. interval - cislo radky, 2.interval - cislo sloupce*)
Procedure NahodnaCisla; Forward;
Procedure Zvyrazni(X,Y:byte); Forward;
Procedure OdkryjOkoli(X,Y:byte); Forward;
Procedure ZobrazMenu(X:byte); Forward;
(**)
Var Pole:Hle;
    Cisla:Hle2; (*0 bez miny; 1 s minou*)
    Pocty:Hle2; (*kolik je v okoli policka min*)
    Udelano:Hle2;
    i,o,o2:byte;
    X,Y:byte;
    PocetMin:byte;
    s:string;
    Odkryto:byte;
    Oznaceno:Integer;
    Menu:array[1..4] of string;
    Pr:boolean;
    Kolik:string;
(**)
Procedure ZobrazMenu(X:byte);
  Begin
    For o:=1 to 4 Do Begin
      If o=X Then Barva(4,2) else Barva(0,3);
      Locate(5,o+6,Menu[o]+Strings(17-Length(Menu[o]),' '));
      Barva(0,3);
      Case X of
         1: Locate(7,21,'Zacit novou hru                                           ');
         2: Locate(7,21,'Pomoci klaces 0-9 zadejte pocet min v poli (20-99)        ');
         3: Locate(7,21,'Hra vnikla jako vypracovani ukolu na hodinu IVT           ');
         4: Locate(7,21,'Ukoncit hru Hledani min (naprogramoval Jan Dvorak r. 2006)');
      End;
    End;
  End;
  (**)
Procedure NahodnaCisla;
  Var a,i,o:byte;
  Begin
    For i:=1 to 11 do for o:=1 to 11 do Cisla[i,o]:=0;
    For a:=1 to PocetMin do Begin
      Repeat
        i:=Random(11)+1;
        o:=Random(11)+1;
      Until Cisla[i,o]=0;
        Cisla[i,o]:=1;
    End;
    For i:=1 To 11 Do Begin
      For o:=1 To 11 do Begin
        If Cisla[i,o]=1 then
           a:=10
        Else Begin
          a:=0;
          If i>1 then Begin
            If (o>1) and (Cisla[i-1,o-1]=1) then a:=a+1; (*LH roh*)
            If Cisla[i-1,o]=1 then a:=a+1;               (*StredH*)
            If (o<11) and (Cisla[i-1,o+1]=1) then a:=a+1;(*PH roh*)
          End;
          If i<11 then Begin
            If (o>1) and (Cisla[i+1,o-1]=1) then a:=a+1; (*LD roh*)
            If Cisla[i+1,o]=1 then a:=a+1;               (*StredD*)
            If (o<11) and (Cisla[i+1,o+1]=1) then a:=a+1;(*PD roh*)
          End;
          If (o>1) and (Cisla[i,o-1]=1) then a:=a+1;
          If (o<11) and (Cisla[i,o+1]=1) then a:=a+1;
        End;
        Pocty[i,o]:=a;
      End;
    End;
  End;
  (**)
Procedure ZobrazSit(var P:Hle);
  Var X,Y:byte;
  Begin
    For X:=1 to 11 do For Y:=1 to 11 do Begin
      Pismo(7);
      If (P[X,Y]<>'ÛÛÛ')and(P[X,Y]<>'<*>') then Begin
        Case Pocty[X,Y] of
          1:Pismo(3);
          2:Pismo(5);
          3:Pismo(6);
          4:Pismo(9);
          5:Pismo(12);
          6:Pismo(11);
          7:Pismo(10);
          8:Pismo(8);
          9:Pismo(7);
          10:Pismo(4);
        End;
      End;
      If P[X,Y]='<*>' Then Pismo(13);
      Locate(X*4+1,Y*2+1,P[X,Y]);
    End;
  End;
  (**)
Procedure OdkryjOkoli(X,Y:byte);
  Var i,o:integer;
      d:string;
  Label Kon;
  Begin
     If Udelano[X,Y]=1 then Goto Kon;
     Udelano[X,Y]:=1;
     If Pole[X,Y]<>'<*>' then Pole[X,Y]:='   ';
     i:=X;o:=Y;
     If o>1 Then Begin
       If i>1 Then Begin
         If Pocty[i-1,o-1]=0 Then
            OdkryjOkoli(i-1,o-1)
         Else Begin
            Str(Pocty[i-1,o-1],d);
            If Pole[X,Y]<>'<*>' then Pole[i-1,o-1]:=' '+d+'  ';
         End;
       End;
       If i<11 Then Begin
         If Pocty[i+1,o-1]=0 Then
            OdkryjOkoli(i+1,o-1)
         Else Begin
            Str(Pocty[i+1,o-1],d);
            If Pole[X,Y]<>'<*>' then Pole[i+1,o-1]:=' '+d+'  ';
         End;
       End;
       If Pocty[i,o-1]=0 Then
          OdkryjOkoli(i,o-1)
       Else Begin
          Str(Pocty[i,o-1],d);
          If Pole[X,Y]<>'<*>' then Pole[i,o-1]:=' '+d+'  ';
       End;
     End;
     If i>1 Then Begin
       If Pocty[i-1,o]=0 Then
          OdkryjOkoli(i-1,o)
       Else Begin
          Str(Pocty[i-1,o],d);
          If Pole[X,Y]<>'<*>' then Pole[i-1,o]:=' '+d+'  ';
       End;
     End;
     If i<11 Then Begin
       If Pocty[i+1,o]=0 Then
          OdkryjOkoli(i+1,o)
       Else Begin
          Str(Pocty[i+1,o],d);
          If Pole[X,Y]<>'<*>' then Pole[i+1,o]:=' '+d+'  ';
       End;
     End;
     If o<11 Then Begin
       If i>1 Then Begin
         If Pocty[i-1,o+1]=0 Then
            OdkryjOkoli(i-1,o+1)
         Else Begin
            Str(Pocty[i-1,o+1],d);
            If Pole[X,Y]<>'<*>' then Pole[i-1,o+1]:=' '+d+'  ';
         End;
       End;
       If i<11 Then Begin
         If Pocty[i+1,o+1]=0 Then
            OdkryjOkoli(i+1,o+1)
         Else Begin
            Str(Pocty[i+1,o+1],d);
            If Pole[X,Y]<>'<*>' then Pole[i+1,o+1]:=' '+d+'  ';
         End;
       End;
       If Pocty[i,o+1]=0 Then
          OdkryjOkoli(i,o+1)
       Else Begin
          Str(Pocty[i,o+1],d);
          If Pole[X,Y]<>'<*>' then Pole[i,o+1]:=' '+d+'  ';
       End;
     End;
     Kon:
  End;
  (**)
Procedure Zvyrazni(X,Y:byte);
  Var a,b:byte;
  Begin
    a:=4*X;b:=2*Y;
    if (X=1) and (Y=1) then VytvorVlastniOkraj('Úij³ÃÄÅ');
    VytvorRam(a,b,a+4,b+2,2);
  End;
(**)
Label Start,Konec,Klavesy,Mnu,Vitez,Hra,Mnu0,Konec2;
Begin
  PocetMin:=20;Kolik:='20';
  Menu[1]:=' Nova hra';
  Menu[2]:=' Pocet min    20';
  Menu[3]:=' Informace';
  Menu[4]:=' Ukoncit';
  Barva(3,0);GotoXY(1,1);
  Vypln('ÛÛ',90,1);Barva(0,3);
  VytvorRam(1,1,80,24,2);
  VytvorNapis(11,3,1,'JAN DVORAK UVADI');
  Locate(3,23,'E - mail: dvorkaman@centrum.cz');
  Delay(1500);
  VytvorNapis(17,12,2,'HLEDANI MIN');
  Delay(3000);Barva(3,3);
  GOTOXY(1,1);Vypln('ÛÛ',70,1);
  Goto Mnu;
Hra:
  Barva(7,0);ClrScr;
  NapisNaStred(1,'HLEDANI MIN by Jan Dvorak (dvorkaman@centrum.cz)');
  Locate(60,3,'OVLADANI:');
  Locate(52,4,Strings(25,'-'));
  Locate(52,5,'Sipky:      pohyb kurzoru');
  Locate(52,6,'Enter:    odkryti policka');
  Locate(52,7,'Num +:   oznaceni policka');
  Locate(52,8,'Escape:     zobrazit menu');
  Locate(52,10,Strings(25,'-'));
  GoToXY(52,11);Write('Pocet min: ',PocetMin);
  Locate(52,12,'Zbyva min: ');
  (*Deklarace*)
  For i:=1 to 11 do For o:=1 to 11 do Begin
      Pole[i,o]:='ÛÛÛ';
      Udelano[i,o]:=0;
  End;
  Odkryto:=0;
  Oznaceno:=0;
  Randomize;
  ZobrazSit(Pole);
  NahodnaCisla;
  ZobrazSit(Pole);
  X:=1;Y:=1;
  (*//*)
Start:
  Pismo(7);
  VytvorSit(4,2,48,24,2,3,1,False);
  Pismo(4);
  Zvyrazni(X,Y);GotoXY(80,24);
Klavesy:
  GotoXY(63,12);Pismo(7);Write(PocetMin-Oznaceno,'   ');
  If Odkryto=121-PocetMin Then Goto Vitez;
  Repeat Until KeyPressed;
  i:=Ord(ReadKey);
  Case i of
   100,77:Begin
         If X<11 then X:=X+1 else X:=1;
         Goto Start;
       End;
    97,75:Begin
         If X>1 then X:=X-1 else X:=11;
         Goto Start;
       End;
   115,80:Begin
         If Y<11 then Y:=Y+1 else Y:=1;
         Goto Start;
       End;
   119,72:Begin
         If Y>1 then Y:=Y-1 else Y:=11;
         Goto Start;
       End;
   27:Goto Mnu;
   13:Begin
        If Pocty[x,y]=0 then Begin
           For o:=1 to 11 do For o2:=1 to 11 do Udelano[o,o2]:=0;
           OdkryjOkoli(X,Y);Pismo(7);ZobrazSit(Pole);
           Odkryto:=0;
           For o:=1 to 11 do
              For o2:=1 to 11 Do Begin
                If (Pole[o,o2]<>'ÛÛÛ')and(Pole[o,o2]<>'<*>') then Odkryto:=Odkryto+1;
              End;
           Goto Klavesy;
        End;
        If Pole[x,y]<>'ÛÛÛ' Then Goto Klavesy;
        Str(Pocty[x,y],s);
        If Pocty[x,y]=10 then begin
          s:='*';
        End;
        Pole[x,y]:=' '+s+' ';
        Odkryto:=Odkryto+1;
        Pismo(7);
        ZobrazSit(Pole);
        If s<>'*' then Goto Start else Goto Konec;
      End;
   43:Begin
        If Pole[x,y]='ÛÛÛ' then Begin
           Pole[x,y]:='<*>';
           Oznaceno:=Oznaceno+1
        End Else Begin
           If Pole[x,y]='<*>' then Begin
             Pole[x,y]:='ÛÛÛ';
             Oznaceno:=Oznaceno-1;
           End;
        End;
        Pismo(7);
        ZobrazSit(Pole);
        Goto Start;
      End;
  End;
  Goto Klavesy;
Mnu:
  Barva(0,3);ClrScr;
  VytvorRam(1,1,80,24,2);
  VytvorNapis(16,2,2,'HLEDANI MIN');
  Locate(1,5,'Ã');Locate(2,5,Strings(78,'Ä'));Locate(80,5,'´');
  VytvorRam(3,6,78,23,2);
  VytvorRam(3,6,23,11,2);Locate(3,11,'Ã');Locate(23,6,'Â');
  VytvorRam(25,7,76,22,2);
  VytvorRam(5,12,25,22,2);
  VytvorVlastniOkraj('Ùa b ÄeÄg');VytvorRam(25,12,25,22,0);
  Locate(45,8,'HLEDANI MIN');
  Locate(26,9,Strings(50,'-'));
  Locate(27,10,'Hledani min je vysoce navykova hra.');
  Locate(27,11,'Tato verze vnikla podle vzoru hry z Windows 98.');
  Locate(27,12,'Cilem hry je objevit vsechny miny v poli 11x11.');
  Locate(7,13,'Cislo v policku udava pocet min v jeho okoli. Kliknete-li na policko,');
  Locate(7,14,'v jehoz okoli se nenachazi zadna mina, okryji se vsechna okolni');
  Locate(7,15,'policka, az na policka, v jejichz okoli se nachazi alespon 1 mina.');
  Locate(7,16,'Hra konci, kdyz okdkryjete vsechna policka na kterych mina neni.');
  Locate(7,17,'Policka s minou si muzete oznacit. Oznacena policka nelze odkryt.');
  Locate(7,18,'O stavu hry Vas bude informovat prava cast obrazovky.');
  Locate(7,19,'Hodne stesti.');
  VytvorVlastniOkraj('ÃÄ´defghi');VytvorRam(5,20,76,20,0);
  i:=1;Pr:=False;
Mnu0:
  ZobrazMenu(i);
  Repeat Until Keypressed;
  o:=ord(Readkey);
  Case o of
     80:Begin
          Pr:=False;
          i:=i+1;If i=5 then i:=1;
        End;
     72:Begin
          Pr:=False;
          i:=i-1;If i=0 then i:=4;
        End;
     13:Begin
          Pr:=False;
          Case i of
            1:Begin
                Val(Kolik,PocetMin,oznaceno);
                If PocetMin>=20 Then Goto Hra;
              End;
            4:Goto Konec2;
          End;
        End;
   48..57: Begin
             If i=2 then Begin
               If (Length(Kolik)=2) or (Pr=False) Then Begin Pr:=True;Kolik:='';End;
               if Length(Kolik)<2 then Kolik:=Kolik + Chr(o);
               Menu[2]:=' Pocet min    ' + strings(2-Length(Kolik),' ') + Kolik;
             End;
           End;
  End;
  Goto Mnu0;
Vitez:
  Barva(3,0);GotoXY(1,1);
  Vypln('ÛÛ',90,1);Barva(0,3);
  VytvorRam(15,10,66,14,2);
  VytvorNapis(18,11,2,'VYHRAL JSI');
  Delay(2000);GOTOXY(1,1);
  Barva(0,0);
  Vypln('  ',90,1);
  Goto Mnu;
Konec:
  Pismo(4);
  VytvorRam(52,14,76,18,2);
  VytvorNapis(55,15,1,'KONEC');
  Readkey;Goto Mnu;
Konec2:
  Delay(1000);
  Barva(3,0);GotoXY(1,1);
  Vypln('ÛÛ',90,1);Barva(0,3);
  VytvorRam(14,10,68,14,2);
  VytvorNapis(17,11,2,'HLEDANI MIN');
  Delay(2000);GOTOXY(1,20);
  For i:=1 to 20 Do Begin
    For Oznaceno:=1 to 30000 do Write;For Oznaceno:=1 to 30000 do Write;For Oznaceno:=1 to 30000 do Write;
    For Oznaceno:=1 to 30000 do Write;
    Writeln;
  End;
End.