Расстановка мин в игре "Сапёр"

{$apptype windows}
uses graphWPF, Timers;
 
const 
w = 24; //высота и ширина ячейки, рекомендовано: 16 или 24 или 32 
h = 3*w+12; //отступ над полем
 
var 
  visible, //0 - скрытая клетка, 1 - флаг, 2 - вопрос, 9 - открытая, 10,12 - предпросмотр
  Pole: array[,] of integer; //0 - пустая клетка, 1..8 - кол-во мин вокруг, 9 - мина
  n, m, //размер поля m x n
//status 0 - ждем первого хода, 1-первый ход сделан, расставили мины
  status: integer;  //2 - поражение, 3 - победа
  otkrit, //осталось ОТКРЫТЬ клеток до победы
  Bomb,//всего мин;
  nFlag,//флаги для установки (= Bomb);
  time: integer; // счетчик времени после первого хода
  LBdown, LBUp, RBdown, RBup, //состояния кнопок мыши (LB - LeftButton, RB - RigthButton) 
  vopros: boolean; //ставить ли '?' после флага правым кликом мыши; пусто → флаг → вопрос
  t: timer; //таймер
  (PreviewX, PreviewY) := (-2,-2); //предпросмотра нет, указатель за пределами поля
//указатель на клетку под предпросмотром, во время удержания правой кнопки мыши
//чтобы при движении курсора мыши внутки клетки не было повторного предпросмотра
 
//вывод разных элементов
procedure DrawXY(i, j: integer); 
const
//для вывода: цифры, мина, флаг и вопрос
  poleSt: array of char = (' ','1','2','3','4','5','6','7','8',#8277, #9873,'?');
//цвета цифр, мины и флага
  ColorN: array of Color = (Colors.Black, Colors.Blue, Colors.Green, Colors.Red, Colors.DarkBlue,
   Colors.Brown, Colors.DarkCyan, Colors.Black, Colors.DarkGray, Colors.Black, Colors.MediumVioletRed);
 
begin
 var unvisible := Procedure(a,b: integer) → //рисуем закрытые клетки
  begin 
   var (x, y) := (b*w+12, a*w+h);
   FillRectangle(x,y,w-1, 2, Colors.White);
   FillRectangle(x,y,2, w-1, Colors.White);
   FillRectangle(x+1,y+w-2,w-1, 2, Colors.Gray);
   FillRectangle(x+w-2,y+1,2, w-1, Colors.Gray);
   FillRectangle(x+2,y+2,w-4, w-4, Colors.LightGray);
   SetPixel(x,y+w-1,Colors.DarkGray);
   SetPixel(x+1,y+w-2,Colors.DarkGray);
   SetPixel(x+w-2,y+1,Colors.DarkGray);
   SetPixel(x+w-1,y,Colors.DarkGray);
  end;
 var (ii, jj) := (j*w+12, i*w+h); //индекс ячейки переводим в координаты на поле
 
 case visible[i,j] of
//вывести закрытую ячейку без пометок
    0: unvisible(i,j); 
//вывести флажок
    1: begin unvisible(i,j); DrawText(ii, jj, w, w, poleSt[10], ColorN[10]) end;
//вывести вопрос    
    2: begin unvisible(i,j);  DrawText(ii, jj, w, w, poleSt[11], Colors.Black) end;
//вывести перечеркнутую мину (флаг был не верно поставлен)
    7: begin 
         FillRectangle(ii,jj,w, w, Colors.Gray);
         FillRectangle(ii+1,jj+1,w-1, w-1, Colors.LightGray);
         DrawText(ii+1, jj+2, w, w, poleSt[9], Colors.Black);
         Pen.Width := 3;
         line(ii+7,jj+2, ii+w-2,jj+w-2, Colors.MediumVioletRed);
         line(ii+3,jj+w-2, ii+w-2,jj+5, Colors.MediumVioletRed);
        end;
//вывести цифру мин вокруг или мину
    9: begin
         FillRectangle(ii,jj,w, w, Colors.Gray);
         FillRectangle(ii+1,jj+1,w-1, w-1, Colors.LightGray);
         if pole[i,j] <> 9 then
           begin//вывод кол-ва мин вокруг
             DrawText(ii+1, jj+2, w, w, poleSt[pole[i,j]], ColorN[pole[i,j]]);
             dec(otkrit); //счетчик открытых
           end
         else
           begin //вывод мины, первая(подрыв) на цветном фоне
             if Status < 2 then FillRectangle(ii+1,jj+1,w-1, w-1, Colors.HotPink);
             DrawText(ii + 1, jj+3, w, w, poleSt[pole[i,j]], ColorN[pole[i,j]]);
           end;
        end;
//вывести клетку предпросмотр         
  10: begin 
         FillRectangle(ii,jj,w, w, Colors.Gray);
         FillRectangle(ii+1,jj+1,w-1, w-1, Colors.LightGray);
        end;
//вывести клетку предпросмотр c "вопросом"        
  12: begin 
         FillRectangle(ii,jj,w, w, Colors.Gray);
         FillRectangle(ii+1,jj+1,w-1, w-1, Colors.LightGray);
         DrawText(ii, jj, w, w, poleSt[11], Colors.Black);
        end;    
   end;
end;
 
//рисуем вверху "круг с вопросом"
procedure DrawVopros; 
begin 
  Pen.Color := vopros ? Colors.DarkCyan : Colors.Red;
  Pen.Width := 2;
  Circle(12 + m div 2 * w + w div 2 , h - w - 3, w div 2, Colors.White);
  Font.Size := w + w div 4;
  DrawText(12 + m div 2 * w, h - 3*w div 2-2 , w, w, '?', Colors.Black);      
  Font.Size := w;  
  if not vopros then DrawSector(12 + m div 2 * w + w div 2, h - w - 3, w div 2, -45, 135);
end;
 
//true - слева сверху вывод nFlag, false - справа сверху вывод time
procedure Tablo(nFlagOrTtime:boolean); 
Const 
 DrawRebro: array of integer = (   //Ребра одной цифры табло для вывода
{Верх} 0,0,w div 2,0, {ПравыйВерх}  w div 2,2,w div 2,3*w div 4, 
{ПравыйНиз} w div 2,3*w div 4,w div 2,3*w div 2-2, 
{Низ} 0,3*w div 2,w div 2,3*w div 2, {ЛевыйНиз} 0,3*w div 4,0,3*w div 2-2, 
{ЛевыйВерх}0,2,0,3*w div 4,{Средняя}2,3*w div 4, w div 2-2,3*w div 4);
 
Rebro: array of array of integer = ( //какие ребра одной цифры подсветить
{0}(1, 1, 1, 1, 1, 1, 0), {1}(0, 1, 1, 0, 0, 0, 0), {2}(1, 1, 0, 1, 1, 0, 1), 
{3}(1, 1, 1, 1, 0, 0, 1), {4}(0, 1, 1, 0, 0, 1, 1), {5}(1, 0, 1, 1, 0, 1, 1),
{6}(1, 0, 1, 1, 1, 1, 1), {7}(1, 1, 1, 0, 0, 0, 0), {8}(1, 1, 1, 1, 1, 1, 1),
{9}(1, 1, 1, 1, 0, 1, 1), {-}(0, 0, 0, 0, 0, 0, 1)); 
 
begin
 var cc, y: integer;// выводимое число; отступ слева (разный для кол-ва флагов и таймера)
 if nFlagOrTtime then 
   (cc, y) := (abs(nFlag), 23) //для вывода кол-ва флагов
 else 
   (cc, y) := (Time, window.Width.Trunc - 13 - (w*2+w div 2)); //для вывода таймера
 var c := Arr(cc div 100, cc div 10 mod 10, cc mod 10); //Цифры для вывода
 if nFlagOrTtime and (nFlag<0) then c[0] := 10; //вывести минус вначале у кол-ва флагов
 Pen.Width := w div 5;
 for var j := 0 to 2 do //Перебор цифр из массива С для вывода
  for var k := 0 to 6 do
   line(DrawRebro [k*4] + (w-5) * j + y, DrawRebro [k*4 + 1] + 26,
    DrawRebro [k*4 + 2] + (w-5) * j + y, DrawRebro [k*4 + 3] + 26, 
     Rebro[c[j], k]=0 ? Colors.Black : Colors.Red);
end;
 
//запускается раз в секунду после t.start
procedure OnTimer(); 
begin
  Tablo(false); //справа сверху рисуем выводим time
  time += 1; //число секунд для вывода +1
end;
 
//генерируем поле с минами и цифрами; (n1, m1) первая открытая клетка "без мины"
procedure GenPole(n1, m1, nbomb: integer);
begin
 SetLength(Pole, n, m);
 Pole.Fill((i,j)-> 0);
//расставляем цифры по полю
 repeat
  var (i,j) := (Random(n), Random(m));
  if (Pole[i,j] = 9) or ((i,j) = (n1,m1)) then continue else Pole[i,j] := 9;
  for var ii := (i-1).ClampBottom(0) to (i+1).ClampTop(n-1) do
   for var jj := (j-1).ClampBottom(0) to (j+1).ClampTop(m-1) do
    if Pole[ii, jj] <> 9 then Pole[ii, jj] += 1; //вокруг мины каждой клетке +1
  nbomb -= 1; 
 until nbomb = 0;      
 t.Start;
end;
 
//Инициализация новой игры
Procedure Init(level: integer); 
begin
  case level of //Поле n x m, и кол-во бомб
    1: (n, m, Bomb) := ( 9, 9,10); //Новичок
    2: (n, m, Bomb) := (16,16,40); //Любитель
    3: (n, m, Bomb) := (16,30,99); //Профессионал
  end;
 status := 0; //статус ожидания первого хода
 otkrit := n*m - Bomb; //количество клеток, для открывания (подсчет до победы)
 nFlag := Bomb; //количество флагов для пометок (выводится слева сверху)
 var LevelOld := false; //размер поля изменился (для ускорения вывода поля);
 if window.Width <> m * w + 25 then
    window.SetSize(m * w + 25, n * w + h + 11) else LevelOld := true;
 //Рисуем игровое поле
 FillRectangle(3,3,m * w + 17, n * w + h + 5,Colors.LightGray);
 FillRectangle(9,h-3, 3, n*w+5,Colors.Gray); 
 FillRectangle(9,h-3, m*w+5, 3,Colors.Gray);
 FillRectangle(10,h + n * w, m * w+4, 3, Colors.White); 
 FillRectangle(12 + m * w, h-2, 3, n * w+5, Colors.White);
 SetPixel(10, h + n * w, Colors.Gray);
 SetPixel(10, h+1 + n * w, Colors.LightGray);
 SetPixel(11, h + n * w, Colors.LightGray);
 SetPixel(12 + m * w, h-2, Colors.Gray);
 SetPixel(12 + m * w, h-1, Colors.LightGray);
 SetPixel(13 + m * w, h-2, Colors.LightGray);
 //рисуем область сверху над игровым полем
 FillRectangle(9,9, 3, h - 18,Colors.Gray); 
 FillRectangle(9,9, m*w+5, 3,Colors.Gray);
 FillRectangle(10,h-11 , m * w+5, 3, Colors.White); 
 FillRectangle(12 + m * w, 10, 3, h-19, Colors.White);
 SetPixel(10, h-11, Colors.Gray);
 SetPixel(10, h-10, Colors.LightGray);
 SetPixel(11, h-11, Colors.LightGray);
 SetPixel(12+m*w, 10, Colors.Gray);
 SetPixel(13+m*w, 10,  Colors.LightGray);
 SetPixel(12+m*w, 11,  Colors.LightGray);
 //выводим кнопки сверху "1-2-3 Новая игра" 
 var knopka := Procedure(a,b: integer) → //рикусем кнопкy
  begin
   var (x, y) := (b*w+12, a*w+15);
   FillRectangle(x,y,w-1, 2, Colors.White);
   FillRectangle(x,y,2, w-1, Colors.White);
   FillRectangle(x+1,y+w-2,w-1, 2, Colors.Gray);
   FillRectangle(x+w-2,y+1,2, w-1, Colors.Gray);
   FillRectangle(x+2,y+2,w-4, w-4, Colors.LightGray);
   SetPixel(x,y+w-1,Colors.DarkGray);
   SetPixel(x+1,y+w-2,Colors.DarkGray);
   SetPixel(x+w-2,y+1,Colors.DarkGray);
   SetPixel(x+w-1,y,Colors.DarkGray);
  end;
  if not LevelOld then //если новый размер окна то перерисовываем
   for var f := 0 to 2 do
   begin 
    var ColorN := Arr(Colors.Blue, Colors.Green, Colors.Red);
    var yy := m div 2 - 1+ f;
    knopka(0, yy);
    DrawText(yy*w+12, 16, w, w, (f+1).ToString, ColorN[f]);      
   end; 
//выводим сверху "круг с вопросом"
  DrawVopros; 
//слева сверху колво оставшихся флагов
  FillRectangle(16,18, 2, w*2+2, Colors.Gray);
  FillRectangle(16,18, w*2+w div 2+2, 2, Colors.Gray);
  FillRectangle(18,19+w*2+1, w*2+w div 2+2, 2, Colors.White);
  FillRectangle(18+w*2+w div 2, 20, 2, w*2, Colors.White);
  FillRectangle(18,20,w*2+w div 2, w*2, Colors.Black);
  Tablo(true); //вывод цифр
 //справа сверху таймер 
  FillRectangle(Window.Width.Trunc - 18,20, 2, w*2+2, Colors.White);
  FillRectangle(Window.Width.Trunc - 18,18, -(w*2+w div 2+2), 2, Colors.Gray);
  FillRectangle(Window.Width.Trunc - 18,19+w*2+1, -(w*2+w div 2), 2, Colors.White);
  FillRectangle(Window.Width.Trunc - (18+w*2+w div 2), 20, -2, w*2, Colors.Gray);
  //DrawText(window.Width - 18, 20, -(w*2+w div 2), w*2, '0'.toString, Colors.PaleVioletRed);
  FillRectangle(window.Width.Trunc - 18, 20, -(w*2+w div 2), w*2, Colors.Black);
  t.Stop; time:=0; OnTimer; //остановка таймера и вывод 000 справа сверху
//выводим поле "закрытых" клеток
 SetLength(visible,n,m);
 for var i := 0 to n-1 do
  for var j := 0 to m-1 do
   if LevelOld then 
    //обновляем поле старых размеров заменяя только открытые клетки
    begin if visible[i,j] <> 0 then begin visible[i,j] := 0; DrawXY(i, j) end end
   else 
    //выводим все клетки на поле с новыми размерами
    begin visible[i,j] := 0; DrawXY(i, j) end;
//обнуляем состояние кнопок мыши 
 (LBdown, LBUp, RBdown, RBup):=(false,false,false,false);  
end;
 
//при зажатой левой или обеих кнопках мыши запускаем Предпросмотр
procedure MouseMove(x,y: real; mb:integer);
begin
 if Status > 1 then exit;
//зачистка предпросмотра 
 var PreviewClear := Procedure → 
   begin
    (PreviewX, PreviewY) := (-2, -2); //сброс указателя предпросмотра
    for var u := 0 to n-1 do 
     for var v:= 0 to m-1 do
       if visible[u,v] > 9 then begin visible[u,v] -= 10; DrawXY(u,v) end
   end;
//выход за границы игрового поля при предпросмотре  
  if not((x.Trunc in [12..11+m*w]) and (y.Trunc in [h..h+n*w-1])) then
   begin PreviewClear; exit; end; 
//если клетка уже на предпросмотре то выходим
 var (i,j) := (trunc(y - h) div w, trunc(x - 12) div w);
 if (PreviewX = i) and (PreviewY = j) then exit; 
//выводим: предпросмотр 1 клетки или 3х3
 if (LBdown or (LBdown and RBdown)) and not (LBup and RBup) then
   begin
    (PreviewX, PreviewY) := (i, j); //указатель предпросмотра на текущую клетку
    var d := RBdown ? 1 : 0; //с зажатой правой кнопкой мыши предпросмотр 3х3
    for var u := 0 to n-1 do 
     for var v:= 0 to m-1 do
      if (u in i-d..i+d) and (v in j-d..j+d) then 
       begin if visible[u,v] in [0,2] then begin visible[u,v] += 10; DrawXY(u,v) end end
      else if visible[u,v] > 9 then begin visible[u,v] -= 10; DrawXY(u,v); end
   end
//прекращение предпросмотра, отжата клавиша мыши
 else begin (PreviewX, PreviewY) := (-2, -2); PreviewClear; end;
end;
 
//победа (status = 3) или поражение (status = 2)
procedure theEnd;
begin
  t.Stop; //остановить таймер
 for var i := 0 to n-1 do
  for var j := 0 to m-1 do //вывести все флажки и ошибочные флаги
   if (visible[i,j] =1) and (Status=2) then 
      //флаг заменить на мину или перечеркнутую мину (ошибка игрока)
      begin visible[i,j] := pole[i,j]=9 ? 9 : 7; DrawXY(i,j) end
   else       
      if (visible[i,j] in [0,2]) and (pole[i,j] = 9) then 
        //вывести мины(поражение) или флаги(победа)
        begin visible[i,j] := status=2 ? 9 : 1; DrawXY(i,j) end;
 if status = 3 then begin nFlag := 0; Tablo(true) end; //победа, осталось 0 флагов
end;
 
//обработать клик мыши над игровым полем
procedure mbPole(i,j:integer);
begin
  if Status > 1 then exit; //состояние "вне игры"
 var mbClick:= ord(LBdown)*1000+ord(LBUp)*100+ord(RBdown)*10+ord(RBup);
 //1000 или 0100 -нажата или отжата левая, 0010 или 0001 - нажата или отжата правая
 case mbClick of 
  0010: //нажата правая кнопка мыши, ставим пусто-флаг-вопрос
    if visible[i,j] < 3 then
    begin     
      //если убираем/ставим флажок то выводим кол-во оставшихся флагов
      if visible[i,j] = 0 then begin dec(nFlag); Tablo(true) end 
      else if visible[i,j] = 1 then begin inc(nFlag); Tablo(true) end;
      inc(visible[i,j]);
      if visible[i,j] > 1+ord(vopros) then visible[i,j]:=0;
      DrawXY(i,j);
    end;
  0100: //отжата левая кнопка мыши. открыть скрытую ячейку
    begin
     if Status = 0 then begin GenPole(i,j,bomb); Status := 1 end;
     if visible[i,j] in [1,9] then exit;
     visible[i,j] := 9;
     DrawXY(i,j);
     var pusto: Procedure(ii,jj: integer);
      pusto := (ii,jj) → //рекурсия на открытие пустых клеток поля
        for var u := (ii-1).ClampBottom(0) to (ii+1).ClampTop(n-1) do
         for var v := (jj-1).ClampBottom(0) to (jj+1).ClampTop(m-1) do
         begin  
           if  visible[u,v] in [1,9] then continue else visible[u,v] := 9;
           DrawXY(u,v);
           if pole[u,v] = 0 then pusto(u,v);
         end;
      if pole[i, j] = 0 then pusto(i,j);//открыта пустая, запускаем рекурсию
      if pole[i, j] = 9 then begin Status := 2; theEnd; exit end; //поражение
      if otkrit = 0 then begin Status := 3; theEnd; exit end // победа      
    end;
 //отжали одну из двух нажатых кнопок мыши,  открыть ячейки учитывая флаги вокруг
  1001, 0110: 
      begin 
       (LBdown, LBup, RBdown, RBup) := (false, true, false, false); //эмуляция mbClick := 0100
       (PreviewX, PreviewY) := (-2, -2); MouseMove(i*n,j*m,0); //отменить предпросмотр
       var c := 0;
       for var ii := (i-1).ClampBottom(0) to (i+1).ClampTop(n-1) do
        for var jj := (j-1).ClampBottom(0) to (j+1).ClampTop(m-1) do
         if visible[ii,jj] = 1 then inc(c); //подсчитали сколько флагов вокруг
       if (visible[i,j] = 9) and (pole[i,j] = c) then //и сравнили с нажатой цифрой
        for var u := (i-1).ClampBottom(0) to (i+1).ClampTop(n-1) do
         for var v := (j-1).ClampBottom(0) to (j+1).ClampTop(m-1) do
         begin
          if  visible[u,v] = 9 then continue;
          if visible[u,v] <> 1 then mbPole(u,v);//открытие клетки, т.к. mbClick = 0100
         end;
       LBup := false;
      end;
   end; 
end;
 
procedure MouseUp(x,y: real;mb:integer);
begin
  case mb of
   0: if LBdown then (LBdown, LBup, RBup) := (false, true, false)
       else if RBdown then (LBup, RBdown, RBup) := (false, false, true);
   1: (LBdown, RBdown, RBup) := (true, false, true);
   2: (LBdown, LBUp) := (false, true);
  end;
 
//проверяем правильность отражения поля после предпросмотра
  if (mb > 0) or LBup then MouseMove(x,y,0);
//клик в поле, запуск обработки
  if (x.Trunc in [12..11+m*w]) and (y.Trunc in [h..h+n*w-1]) then 
   mbPole(trunc(y - h) div w, trunc(x - 12) div w);
end;
 
procedure MouseDown(x,y: real;mb:integer);
begin
  case mb of
   1: if LBdown and RBup then (RBdown, RBup) := (true, false) else
       if LBdown then (LBup, RBdown, RBUp) := (false, true, false) else
       if LBup then (LBdown, LBup) := (true, false)
       else (LBdown, RBup) := (true, false);   
   2: (LBup, RBdown, RBup) := (false, true, false);
  end; 
  
  if LBdown then //проверка клика сверху, над игровым полем
  begin 
 //клик на "круг с вопросом"
    if (x.trunc in [(m+2) div 2 * w - (w div 2) .. (m+2) div 2 * w + (w div 2)]) and
       (y.trunc in [ h-27 - w div 2 .. h-27 + w div 2])  then
         begin vopros := not vopros; DrawVopros end;
 //клик в ряду "1-2-3" новая игра
    if (x.trunc in [m div 2 * w - w div 2.. (m+6) div 2 * w - w div 2]) and
       (y.trunc in [16 .. w+14])  then 
         begin Init((x.Trunc - (m div 2 * w - w div 2)) div w + 1); exit; end;//запуск новой игры
  end;       
  
//если нажата левая или обе кнопки мыши, запускаем предпросмотр
  if LBdown or (LBdown and RBdown) then 
    begin (PreviewX, PreviewY) := (-2,-2); MouseMove(x,y,0) end;
  
//обработать клик в игровом поле
  if (x.Trunc in [12..11+m*w]) and (y.Trunc in [h..h+n*w-1]) then
   mbPole(trunc(y - h) div w, trunc(x - 12) div w);
end;
 
begin
  t := new Timer(1000,OnTimer);
  Window.Title := 'Сапёр';
  window.SetSize(9 * w + 25, 9 * w + h + 11);
  Window.CenterOnScreen; 
  Window.IsFixedSize := True; 
  Font.Name := 'Courier New';
  Font.Style := Bold; 
  Font.Size := w;
  Init(1); //1-новичок, 2-любитель,3-профи
  OnMouseDown += MouseDown;
  OnMouseUp += MouseUp;
  OnMouseMove += MouseMove;
end.