uses
  graph, crt;

const
  mines : array[1..3] of integer = (10, 40, 90);
  size  : array[1..2, 1..3] of integer = ((9, 16, 25), (9, 16, 18));
  side = 25;      {сторона квадрата при отображении поля}
  zazor = 2;      {половинный зазор между квадратами}
  color_of_phone = 11;
  color_of_kursor = 5;
  color_of_flag = 4;
  color_of_lines = 0;
  filling_close = 7;
  filling_open = 15;
  color_of_text1 = 2;
  color_of_text2 = 12;
  color_of_text3 = 4;
  color_of_mine = 0;

type
  pole = array[1..25, 1..20] of integer;

var
  i, j, dr, md: integer;
  m: pole;
  dif: integer;           { уровень сложности 1-2-3}
  xk, yk: integer;        { координаты курсора }
  kl: char;
  buf: boolean;
  mine: integer;
  st: string;

procedure opening(x, y: integer; var b: boolean); forward;
procedure nachalo; forward;

{--------------------------------------------------------------------------}
procedure once_again;
begin
  settextstyle(1, 0, 5);
  outtextxy(120, 350, 'Play again? (y / n)');
  repeat
    kl := readkey;
  until (kl = 'y') or (kl = 'n');
  case kl of
   'y': begin
          bar(0, 0, 640, 480);
          nachalo;
        end;
   'n': halt;
  end;
end;
{--------------------------------------------------------------------------}
procedure pobeda;
begin
  setfillstyle(1, color_of_mine);
  bar(0, 0, 640, 480);
  setcolor(color_of_text1);
  delay(400);
  settextstyle(1, 0, 6);
  outtextxy(100, 200, 'You are winner!');
  delay(1500);
  once_again;
end;
{--------------------------------------------------------------------------}
procedure porazhenie;
var
  i, j: integer;
begin
  setfillstyle(1, color_of_mine);
  setcolor(color_of_mine);
  circle((xk - 1) * side + 13, (yk - 1) * side + 13, 9);
  floodfill((xk - 1) * side + 13, (yk - 1) * side + 13, color_of_mine);
  delay(600);
  for i := 1 to size[1, dif] do
    for j := 1 to size[2, dif] do
      if m[i, j] = 1 then
        begin
          circle((i - 1) * side + 13, (j - 1) * side + 13, 9);
          floodfill((i-1) * side + 13, (j-1) * side + 13, color_of_mine);
          sound(400);
          delay(30);
          nosound;
          delay(20);
        end;
  delay(3000);
  bar(0, 0, 640, 480);
  setcolor(color_of_text1);
  delay(400);
  settextstyle(1, 0, 6);
  outtextxy(100, 200, 'You are loser!');
  delay(1500);
  once_again;
end;
{--------------------------------------------------------------------------}
function uslovie_pobedy: boolean;
var
  i, j: integer;
begin
  uslovie_pobedy := true;
  for i := 1 to size[1, dif] do
    for j := 1 to size[2, dif] do
      if (m[i, j] = 10) or (m[i, j] = 1) or
         (m[i, j] = 0) then uslovie_pobedy := false;
end;
{--------------------------------------------------------------------------}
procedure flazhok(x, y: integer);
begin                  { если клетка не помечена и не открыта }
  if (m[x, y] < 10) and (m[x, y] <> 2) then
    begin                     { то рисуем флажок }
      setcolor(color_of_flag + 1);
      line((x - 1) * side + 5, (y - 1) * side + 4,
           (x - 1) * side + 5, y * side - 4);
      line((x - 1) * side + 5, (y - 1) * side + 4,
           x * side - 5, (y - 1) * side + 13);
      line((x - 1) * side + 5, y * side - 4,
           x * side - 5, (y - 1) * side + 13);
      setfillstyle(1, color_of_flag);
      floodfill((x - 1) * side + 7, (y - 1) * side + 9, color_of_flag + 1);
      setcolor(color_of_lines);
      m[x, y] := m[x, y] + 10;
      dec(mine);
      str(mine, st);
      st := 'Mines: ' + st;
      setfillstyle(1, color_of_phone);
      bar(559, 464, 640, 480);
      settextstyle(2, 0, 5);
      outtextxy(560, 465, st);
    end
  else
    if m[x, y] <> 2 then
      begin
        m[x, y] := m[x, y] - 10;
        setfillstyle(1, filling_close);
        floodfill((x - 1) * side + 7, (y - 1) * side + 8, color_of_lines);
        inc(mine);
        str(mine, st);
        st := 'Mines: ' + st;
        setfillstyle(1, color_of_phone);
        bar(559, 464, 640, 480);
        settextstyle(2, 0, 5);
        outtextxy(560, 465, st);
      end;
end;
{--------------------------------------------------------------------------}
procedure recurs_null(x, y: integer); {вызывается при b = false (opening)}
var
  i, j: integer;
  b: boolean;
begin
  for i := x - 1 to x + 1 do
    for j := y - 1 to y + 1 do
        if (i > 0) and (i <= size[1, dif]) and
           (j > 0) and (j <= size[2, dif]) then
             if (m[i, j] < 10)and(m[i, j] <> 2) then opening(i, j, b);
end;
{--------------------------------------------------------------------------}
procedure opening(x, y: integer; var b: boolean);
var
  i, j, k: integer;
begin
  k := 0;
  b := true;
  {здесь открывается выбранная клетка}
  setfillstyle(1, filling_open);
  floodfill(side * x - zazor * 2, side * y - zazor * 2, black);
  if m[x, y] = 1 then porazhenie
  else
    for i := x - 1 to x + 1 do
      for j := y - 1 to y + 1 do
        if (i > 0) and (i <= size[1, dif]) and
           (j > 0) and (j <= size[2, dif]) then
             if (m[i, j] mod 10 = 1) then inc(k);
  m[x, y] := 2;
  if k = 0 then b := false
  else
    begin
      case k of
        1..2: setcolor(color_of_text1);
        3..5: setcolor(color_of_text2);
        6..8: setcolor(color_of_text3);
      end;
      settextstyle(1, 0, 1);
      outtextXY((x - 1) * side + 6, (y - 1) * side + 4, chr(ord('0') + k));
    end;
  if b = false then recurs_null(x, y);
end;
{--------------------------------------------------------------------------}
procedure moving_of_kursor(a, b: integer);
begin
  if (xk + a >= 1) and (yk + b >= 1) and
     (xk + a <= size[1, dif]) and (yk + b <= size[2, dif]) then
       begin
         setcolor(color_of_phone);
         rectangle(side * xk, side * yk,
                  side * (xk - 1), side * (yk - 1));
         inc(xk, a);
         inc(yk, b);
         setcolor(color_of_kursor);
         rectangle(side * xk, side * yk,
                  side * (xk - 1), side * (yk - 1));
       end;
end;
{--------------------------------------------------------------------------}
procedure upravlenie;
begin
  kl := readkey;
  case kl of
    'w': moving_of_kursor(0, -1);
    'a': moving_of_kursor(-1, 0);
    's': moving_of_kursor(0, 1);
    'd': moving_of_kursor(1, 0);
    'e': flazhok(xk, yk);
    #13: if (m[xk, yk] <> 2)and(m[xk, yk] < 10) then opening(xk, yk, buf);
    'q': halt;
  end;
end;
{--------------------------------------------------------------------------}
procedure game;
begin
  setcolor(color_of_kursor);
  {rectangle(side * xk - zazor, side * yk - zazor,
                  side * (xk - 1) + zazor, side * (yk - 1) + zazor); }
  repeat upravlenie until uslovie_pobedy;
  pobeda;
end;
{--------------------------------------------------------------------------}
procedure moving_of_rectangle(var k: integer; a: integer);
begin
  setcolor(color_of_mine);
  rectangle(60, 200 + (k - 1) * 40, 400, 240 + (k - 1) * 40);
  inc(k, a);
  setcolor(color_of_text1);
  rectangle(60, 200 + (k - 1) * 40, 400, 240 + (k - 1) * 40);
end;
{--------------------------------------------------------------------------}
procedure menu;
var
  k: integer;
begin
  delay(1000);
  setcolor(color_of_text1);
  settextstyle(1, 0, 8);
  outtextxy(150, 40, 'Miner');
  setcolor(color_of_text2);
  settextstyle(1, 0, 2);
  outtextxy(200, 160, 'Made by Dimon.');
  setcolor(color_of_text3);
  outtextxy(100, 280, 'Move up    - ''w''');
  outtextxy(100, 300, 'Move down  - ''s''');
  outtextxy(100, 320, 'Move left  - ''a''');
  outtextxy(100, 340, 'Move right - ''d''');
  outtextxy(100, 360, 'Put/delete a flag - ''e''');
  outtextxy(100, 380, 'Open the cell - Enter');
  outtextxy(100, 400, 'Exit - ''q''');
  setcolor(color_of_text1);
  settextstyle(2, 0, 7);
  outtextxy(200, 440, 'Press any key...');
  kl := readkey;
  setfillstyle(1, color_of_mine);
  bar(0, 0, 640, 480);
  settextstyle(1, 0, 3);
  outtextxy(40, 170, 'Choose level:');
  outtextxy(70, 210, 'Simple: 9x9,   10 mines;');
  outtextxy(70, 250, 'Normal: 16x16, 40 mines;');
  outtextxy(70, 290, 'Hard:   25x18, 90 mines;');
  rectangle(60, 200, 400, 240);
  k := 1;
  buf := false;
  while not buf do
    begin
      kl := readkey;
      case kl of
        'w': if k <> 1 then moving_of_rectangle(k, -1);
        's': if k <> 3 then moving_of_rectangle(k,  1);
        #13: begin
               dif := k;
               buf := true;
               bar(0, 0, 640, 480);
               delay(1000);
             end;
      end;
    end;
end;
{--------------------------------------------------------------------------}
procedure nachalo;
begin
  menu;
  for i := 1 to size[1, dif] do
    for j := 1 to size[2, dif] do m[i, j] := 0;
  setcolor(color_of_lines);
  setfillstyle(1, color_of_phone);
  floodfill(5, 5, color_of_phone);
  setfillstyle(1, filling_close);
  setlinestyle(0, 0, thickwidth);
  for i := 0 to size[1, dif] - 1 do
    for j := 0 to size[2, dif] - 1 do
      begin
        rectangle(side * i + zazor, side * j + zazor,
                  side * (i + 1) - zazor, side * (j + 1) - zazor);
        floodfill(side * i + zazor * 2, side * j + zazor * 2, black);
      end;
  randomize;
  for i := 1 to mines[dif] do
    begin
      repeat
        xk := 1 + random(size[1, dif]);
        yk := 1 + random(size[2, dif]);
      until m[xk, yk] <> 1;
      m[xk, yk] := 1;
    end;
  xk := 1;
  yk := 1;
  mine := mines[dif];
  str(mine, st);
  st := 'Mines: ' + st;
  settextstyle(2, 0, 5);
  setfillstyle(1, color_of_phone);
  bar(559, 464, 640, 480);
  outtextxy(560, 465, st);
  setlinestyle(0, 0, normwidth);
  game;
end;
{--------------------------------------------------------------------------}
begin
  dr := detect;
  initgraph(dr, md, '');
  nachalo;
end.