uses GraphABC;
const
  box = 50; // размер ребра прямоугольников
  r = 20; // радиус шаров
  w = 10; // кол-во клеток по ширине
  h = 10; // кол-во клеток по высоте
  k = 10;  // кол-во новых шаров генерируемых каждый новый ход
  d = 6;  // кол-во шаров для удаления ряда
  c = 3;// кол-во цветов

var
  Xc, Yc, y0, x0, clStep: word;
  count: integer;// количество незанятых элементов массива
  score: uint64;
  gameOver: boolean;
  arr: array [1..h, 1..w] of integer; //матрица наших шаров
  zer: array [1..h, 1..w] of integer;//матрица обнуления шаров

{***ПРОЦЕДУРА  ПРИВЕДЕНИЯ МАТРИЦЫ ОБНУЛЕНИЯ К  ЕДИНИЧНОМУ ВИДУ**}
procedure Identity();
begin
  for var x := 1 to w do
    for var y := 1 to h do
      zer[y, x] := 1;
end;

{***ПРОЦЕДУРА  ОБНУЛЕНИЯ МАТРИЦЫ ШАРОВ**}
procedure null();
begin
  for var x := 1 to w do
    for var y := 1 to h do
      arr[y, x] := 0;
end;

{***ПРОЦЕДУРА ОБРАБОТКИ НАЖАТИЯ КЛAВИШИ ПОСЛЕ ПРОИГРЫША**}
procedure repeat_game(key: integer);
begin
  gameOver := false;
end;

{***ПРОЦЕДУРА ОБРАБОТКИ НАЖАТИЯ КЛAВИШИ В ИГРЕ**}
procedure keyDown(key: integer);
begin
  var sum: byte;

  for var i := 1 to k do
  begin
    var x: byte;
    var y: byte;

    repeat
      begin
        x := random(1, w); // получаю случайное значение столбца массива
        y := random(1, h); // получаю случайное значение строки массива
      end;
    until (arr[y, x] = 0) or (count <= 0); // перебираю случайные элементы массива до тех пор пока не найду пустой

    count -= 1; // уменьшаю количество свободных элементов массива
    arr[y, x] := random(1, c); // присваиваю элементу случайный цвет
      { установка цвета заливки, формулы содержания компонента цвета
      выбраны совершенно случайно, какого-то математического смысла в них нет }
    SetBrushColor(RGB(clStep * arr[y, x], 255 - clStep * arr[y, x], 127 - trunc(power(-1, arr[y, x]) * clStep * arr[y, x] / 2)));
    FillCircle(x0 + box * x - box div 2, y0 + box * y - box div 2, r); // рисую окружность
  end;

  for var y := 1 to h do
  begin
    var val: byte := 1; //счетчик одинаковых шаров
    for var x := 2 to w do
    begin
      if (arr[y, x] = arr[y, x - 1]) and (arr[y, x] <> 0) then  // если цвет текущего шара равен цвету предыдущего и не равен нулю
      begin
        val += 1; //инкрементирую количество шаров одного цвета
        if val >= d then  // если превысило предельное значение
          for var i := 0 to val - 1  do
            zer[y, x - i] := 0; // обнуляю позиции  шаров в матрице обнуления
      end
      else
        val := 1;
    end;
  end;

  for var x := 1 to w do
  begin
    var val: byte := 1; //счетчик одинаковых шаров
    for var y := 2 to h do
    begin
      if (arr[y, x] = arr[y - 1, x]) and (arr[y, x] <> 0) then  // если цвет текущего шара равен цвету предыдущего
      begin
        val += 1; //инкрементирую количество шаров одного цвета
        if val >= d then  // если превысило предельное значение
          for var i := 0 to val - 1  do
            zer[y - i, x] := 0; // обнуляю позиции  шаров в матрице обнуления
      end
      else
        val := 1;
    end;
  end;

  for var y := 1 to h do
    for var x := 1 to w do
      arr[y, x] *= zer[y, x]; //умнажаю нашу матрицу на матрицу обнуления;

  SetBrushColor(ClWhite);

  for var y := 1 to h do
    for var x := 1 to w do
      if zer[y, x] = 0 then
      begin
        Rectangle(x0 + box * (x - 1), y0 + box * (y - 1), x0 + x * box, y0 + y * box );
        sum += 1;
      end;

  count := count + sum;
  score += sum;
  Identity();  // привожу обратно к единичному виду
  sum := 0;
end;

begin
  SetFontSize(20);
  clStep := 255 div c;
  window.Height := 700;  // устанавливаю высоту окна
  window.Width := 700;  // устанавливаю ширину окна
  //координаты центра
  Xc := window.Width div 2; //центр по х
  Yc := window.Height div 2; //центр по у

  //координаты  левого верхнего угла нащего поля
  x0 := Xc - (box * w) div 2;
  y0 := Yc - (box * h) div 2;

  {***БЕСКОНЕЧНЫЙ ЦИКЛ ИГРЫ**}
  while true do
  begin
    //Блок инициализации каждой новой игры
    clearWindow();
    SetFontColor(ClRed);
    OnKeyDown := keyDown; // назначаю обработчик события по нажатию кнопки
    count := h * w;
    null();
    Identity();  // привожу  к единичному виду
    score:=0;
    gameOver:=true;

    // отрисовываю прямоугольники
    for var y := 1 to h do
      for var x := 1 to w do
        DrawRectangle(x0 + box * (x - 1), y0 + box * (y - 1), x0 + x * box, y0 + y * box );

    while count > 0 do;

    OnKeyDown := repeat_game; // назначаю обработчик события по нажатию кнопки
    Window.Clear();
    DrawTextCentered(Xc - 100, Yc - 100, Xc + 100, Yc + 100, 'YOU LOST!!!');
    SetFontColor(ClBlack);
    DrawTextCentered(Xc - 200, Yc - 60, Xc + 200, Yc + 140, 'YOUR SCORE:');
    DrawTextCentered(Xc - 200, Yc - 20, Xc + 200, Yc + 180, score);
    OnKeyDown := repeat_game; // назначаю обработчик события по нажатию кнопки

    while gameOver do;

  end;
end.