UCross.pas

// Модуль работы с самим кроссвордом
unit UCross;

interface

uses
  UTypes;

procedure GenCross;
procedure DelCross;

function GetFirstCell : TCrossCellPtr;
function GetCrossSize(Ornt : Integer) : Integer;

implementation

uses
  UMain, UWord, UDebug, UCell, System.SysUtils;

// Генерирование кроссворда
procedure GenCross;
var
  FreeWrd, CrossWrd : TWrdList;

begin
  DBG_ShowMsg('GenCross ->');
  FMain.StatusBar1.Panels[0].Text := 'Кроссворд создается...';

  if Cross <> nil then
    begin
      DBG_ShowMsg('GenCross -> Уже существует');

      DelCross;
      GenCross;
      Exit;
    end;

  while True do
    begin
      // Поиск свободного слова и пары для него
      CrossWrd := GetAvalWord(FreeWrd);

      // Если все слова добавлены в кроссворд
      if (FreeWrd = nil) and (CrossWrd = nil) then
        Break
      // Если кроссворд уже создан(в нем есть слова) и есть слово, для которого
      // нельзя подобрать пару
      else if (Cross <> nil) and ((FreeWrd <> nil) and (CrossWrd = nil)) then
        begin
          DBG_ShowMsg('GenCross -> Есть свободное слово, для которого нет пары');
          FMain.StatusBar1.Panels[0].Text := 'Ошибка при создании кроссворда!';

          DelCross;
          Exit;
        end;

      if not AddWordToCross(FreeWrd,CrossWrd) then
        begin
          DBG_ShowMsg('GenCross -> Не удалось добавить слово в кроссворд');
          FMain.StatusBar1.Panels[0].Text := 'Ошибка при создании кроссворда!';

          DelCross;
          Exit;
        end;
    end;

    DBG_ShowMsg('GenCross -> Кроссворд сгенерирован');
    FMain.StatusBar1.Panels[0].Text := 'Кроссворд готов!';
end;

// (-) Удаление кроссворда из памяти
procedure DelCross;
begin
  Cross := nil;
end;

// Нахождение крайней левой-верхней ячейки матрицы
function GetFirstCell:TCrossCellPtr;
var
  CellPtr : TCrossCellPtr;
begin
  DBG_ShowMsg('GetFirstCell ->');

  // Матрица не создана
  if Cross = nil then
    begin
      DBG_ShowMsg('GetFirstCell -> Матрица не создана');
      Result := nil;
      Exit;
    end;

  CellPtr := Cross;

  // Поиск ячейки
  repeat
    if CellPtr.Up <> nil then
      CellPtr := CellPtr.Up;

    if CellPtr.Left <> nil then
      CellPtr := CellPtr.Left;
  until (CellPtr.Up = nil) and (CellPtr.Left = nil);

  Result := CellPtr;
end;

// Вычисление ширины матрицы ячеек
function GetCrossSize(Ornt : Integer) : Integer;
var
  Cnt : Integer;
  CellPtr : TCrossCellPtr;
begin
  DBG_ShowMsg('GetCrossSize -> ['+ReturnOrntVal(Ornt)+']');

  if not (Ornt in [ORNT_VERT,ORNT_HORZ]) then
    begin
      DBG_ShowMsg('GetCrossSize -> Заданы не верные параметры');
      Result := 0;
      Exit;
    end;

  CellPtr := GetFirstCell;
  if CellPtr = nil then
    begin
      DBG_ShowMsg('GetCrossSize -> Не удалось получить начальную ячейку');
      Result := 0;
      Exit;
    end;

  // Вычисление
  Cnt := 0;
  while CellPtr <> nil do
    begin
      Inc(Cnt);

      if Ornt = ORNT_VERT then
        CellPtr := CellPtr.Down
      else
        CellPtr := CellPtr.Right;
    end;

  DBG_ShowMsg('GetCrossSize -> Размер составляет ['+IntToStr(Cnt)+'] ячеек');
  Result := Cnt;
end;

end.