unit UMapType;

{$mode delphi}

interface

uses
  Classes, SysUtils, XMLRead, XMLWrite, DOM, UGeometry, fgl, UMap;

type
  TMapType = (mtNone, mtHexagonVertical, mtSquare, mtTriangle, mtRandom, mtIsometric,
    mtHexagonHorizontal);

  TCellsDistance = class
    Cell1: TCell;
    Cell2: TCell;
    Distance: Double;
  end;

  { THexMapVertical }

  THexMapVertical = class(TMap)
  private
    const
      CellMulX = 1.12 * 1.028;
      CellMulY = 1.292 * 1.03;
    function IsCellsPosNeighbor(CellPos1, CellPos2: TPoint): Boolean;
    procedure GetCellPosNeighbors(CellPos: TPoint; Cell: TCell);
    function GetHexagonPolygon(Pos: TPoint; Size: TPoint): TPolygon;
  protected
    procedure SetSize(AValue: TPoint); override;
  public
    function CalculatePixelRect: TRect; override;
    procedure LoadFromFile(FileName: string); override;
    procedure SaveToFile(FileName: string); override;
    procedure Generate; override;
  end;

  { THexMapHorizontal }

  THexMapHorizontal = class(TMap)
  private
    const
      CellMulX = 1.292 * 1.03;
      CellMulY = 1.12 * 1.028;
    function IsCellsPosNeighbor(CellPos1, CellPos2: TPoint): Boolean;
    procedure GetCellPosNeighbors(CellPos: TPoint; Cell: TCell);
    function GetHexagonPolygon(Pos: TPoint; Size: TPoint): TPolygon;
  protected
    procedure SetSize(AValue: TPoint); override;
  public
    function CalculatePixelRect: TRect; override;
    procedure LoadFromFile(FileName: string); override;
    procedure SaveToFile(FileName: string); override;
    procedure Generate; override;
  end;

  { TSquareMap }

  TSquareMap = class(TMap)
  private
    function GetSquarePolygon(Pos: TPoint; Size: TPoint): TPolygon;
  public
    procedure Generate; override;
  end;

  { TTriangleMap }

  TTriangleMap = class(TMap)
  private
    const
      CellMulX = 0.5;
      CellMulY = 1;
    function GetTrianglePolygon(Pos: TPoint; Size: TPoint; Reverse: Boolean): TPolygon;
  protected
    procedure SetSize(AValue: TPoint); override;
  public
    procedure Generate; override;
    function CalculatePixelRect: TRect; override;
  end;

  { TVoronoiMap }

  TVoronoiMap = class(TMap)
  private
  public
    procedure Generate; override;
    function CalculatePixelRect: TRect; override;
  end;

  { TIsometricMap }

  TIsometricMap = class(TMap)
  private
    const
      CellMulX = 1;
      CellMulY = 3.5;
    function GetTilePolygon(Pos: TPoint; Size: TPoint): TPolygon;
  protected
    procedure SetSize(AValue: TPoint); override;
  public
    procedure Generate; override;
    function CalculatePixelRect: TRect; override;
  end;

resourcestring
  SGridTypeHexagonVertical = 'Hexagonal vertical';
  SGridTypeHexagonHorizontal = 'Hexagonal horizontal';
  SGridTypeSquare = 'Square';
  SGridTypeTriangle = 'Triangural';
  SGridTypeRandom = 'Random';
  SGridTypeIsometric = 'Isometric';


implementation

{ THexMapHorizontal }

function THexMapHorizontal.IsCellsPosNeighbor(CellPos1, CellPos2: TPoint
  ): Boolean;
var
  DX: Integer;
  DY: Integer;
  MinY: Integer;
begin
  if CellPos1.Y < CellPos2.Y then MinY:= CellPos1.Y
    else MinY := CellPos2.Y;
  DX := CellPos2.X - CellPos1.X;
  DY := CellPos2.Y - CellPos1.Y;
  Result := (Abs(DX) <= 1) and (Abs(DY) <= 1) and
  ((((MinY mod 2) = 1) and
    not ((DX = 1) and (DY = -1)) and
    not ((DX = -1) and (DY = 1))) or
    (((MinY mod 2) = 0) and
    not ((DX = -1) and (DY = -1)) and
    not ((DX = 1) and (DY = 1))));
  Result := Result and not ((CellPos1.X = CellPos2.X) and (CellPos1.Y = CellPos2.Y));
end;

procedure THexMapHorizontal.GetCellPosNeighbors(CellPos: TPoint; Cell: TCell);
var
  X, Y: Integer;
  P: TPoint;
  PMod: TPoint;
begin
  for Y := -1 to 1 do
  for X := -1 to 1 do begin
    P := TPoint.Create(CellPos.X + X, CellPos.Y + Y);
    PMod := TPoint.Create((P.X + Size.X) mod Size.X, (P.Y + Size.Y) mod Size.Y);
    if Cyclic then begin
      if IsValidIndex(PMod) and IsCellsPosNeighbor(CellPos, P) then begin
        Cell.ConnectTo(Cells[PMod.Y * Size.X + PMod.X]);
      end;
    end else begin
      if IsValidIndex(P) and IsCellsPosNeighbor(CellPos, P) then begin
        Cell.ConnectTo(Cells[P.Y * Size.X + P.X]);
      end;
    end;
  end;
end;

function THexMapHorizontal.GetHexagonPolygon(Pos: TPoint; Size: TPoint
  ): TPolygon;
var
  Shift: TPointF;
  Angle: Double;
begin
  Angle := 60 / 180 * Pi;
  Shift := TPointF.Create(0.5, 0.5) * TPointF.Create(Cos(Angle), Sin(Angle));
  SetLength(Result.Points, 6);
  Result.Points[0] := TPoint.Create(Trunc(Pos.X + Shift.X * Size.X), Trunc(Pos.Y - Shift.Y * Size.Y));
  Result.Points[1] := TPoint.Create(Trunc(Pos.X + 0.5 * Size.X), Trunc(Pos.Y + 0 * Size.Y));
  Result.Points[2] := TPoint.Create(Trunc(Pos.X + Shift.X * Size.X), Trunc(Pos.Y + Shift.Y * Size.Y));
  Result.Points[3] := TPoint.Create(Trunc(Pos.X - Shift.X * Size.X), Trunc(Pos.Y + Shift.Y * Size.Y));
  Result.Points[4] := TPoint.Create(Trunc(Pos.X - 0.5 * Size.X), Trunc(Pos.Y + 0 * Size.Y));
  Result.Points[5] := TPoint.Create(Trunc(Pos.X - Shift.X * Size.X), Trunc(Pos.Y - Shift.Y * Size.Y));
end;

procedure THexMapHorizontal.SetSize(AValue: TPoint);
begin
  inherited;
  if Cyclic then
    FSize := TPoint.Create(FSize.X, FSize.Y + FSize.Y mod 2);
end;

function THexMapHorizontal.CalculatePixelRect: TRect;
var
  Shift: TPointF;
  Angle: Double;
begin
  Result := inherited CalculatePixelRect;
  Angle := 60 / 180 * Pi;
  Shift := TPointF.Create(0.5, 0.5) * TPointF.Create(Cos(Angle), Sin(Angle));
  Result.P2 := Result.P2 - TPoint.Create(
    Trunc(1.35 * Shift.X * DefaultCellSize.X / CellMulX),
    Trunc(0.5 * DefaultCellSize.Y / CellMulY)
  );
end;

procedure THexMapHorizontal.LoadFromFile(FileName: string);
var
  Doc: TXMLDocument;
begin
  try
    ReadXMLFile(Doc, FileName);
    if Doc.DocumentElement.TagName <> 'Map' then
      raise Exception.Create('Invalid map format');
  finally
    Doc.Free;
  end;
  inherited LoadFromFile(FileName);
end;

procedure THexMapHorizontal.SaveToFile(FileName: string);
var
  Doc: TXMLDocument;
  RootNode: TDOMNode;
begin
  try
    Doc := TXMLDocument.Create;
    RootNode := Doc.CreateElement('Map');
    Doc.Appendchild(RootNode);
    WriteXMLFile(Doc, FileName);
  finally
    Doc.Free;
  end;
  inherited SaveToFile(FileName);
end;

procedure THexMapHorizontal.Generate;
var
  X, Y: Integer;
  NewCell: TCell;
  PX, PY: Double;
begin
  Clear;

  // Allocate and init new
  Cells.Count := Size.Y * Size.X;
  for Y := 0 to Size.Y - 1 do
  for X := 0 to Size.X - 1 do begin
    NewCell := TCell.Create;
    NewCell.Map := Self;
    PX := X;
    PY := Y;
    if (X and 1) = 1 then begin
      PY := PY + 0.5;
    end;
    NewCell.PosPx := TPoint.Create(Trunc(PX * DefaultCellSize.X / CellMulX),
      Trunc(PY * DefaultCellSize.Y / CellMulY));
    NewCell.Polygon := GetHexagonPolygon(NewCell.PosPx, DefaultCellSize);
    NewCell.Id := GetNewCellId;
    Cells[Y * Size.X + X] := NewCell;
  end;

  // Generate neightbours
  for Y := 0 to Size.Y - 1 do
  for X := 0 to Size.X - 1 do
  with Cells[Y * Size.X + X] do begin
    GetCellPosNeighbors(TPoint.Create(X, Y), Cells[Y * Size.X + X]);
  end;

  FPixelRect := CalculatePixelRect;
end;

{ TIsometricMap }

function TIsometricMap.GetTilePolygon(Pos: TPoint; Size: TPoint): TPolygon;
begin
  SetLength(Result.Points, 4);
  Result.Points[0] := TPoint.Create(Pos.X, Trunc(Pos.Y - Size.Y / 3.5));
  Result.Points[1] := TPoint.Create(Trunc(Pos.X + Size.X / 2), Pos.Y);
  Result.Points[2] := TPoint.Create(Pos.X, Trunc(Pos.Y + Size.Y / 3.5));
  Result.Points[3] := TPoint.Create(Trunc(Pos.X - Size.X / 2), Pos.Y);
end;

procedure TIsometricMap.SetSize(AValue: TPoint);
begin
  inherited;
  if Cyclic then
    FSize := TPoint.Create(FSize.X, FSize.Y + FSize.Y mod 2);
end;

procedure TIsometricMap.Generate;
var
  X, Y: Integer;
  NewCell: TCell;
  PX, PY: Double;
  P: TPoint;
  Cell: TCell;
begin
  Clear;

  // Allocate and init new
  Cells.Count := Size.Y * Size.X;
  for Y := 0 to Size.Y - 1 do
  for X := 0 to Size.X - 1 do begin
    NewCell := TCell.Create;
    NewCell.Map := Self;
    PX := X;
    PY := Y;
    if (Y and 1) = 1 then begin
      PX := PX + 0.5;
      //Y := Y + 0.5;
    end;
    NewCell.PosPx := TPoint.Create(Trunc(PX * DefaultCellSize.X / CellMulX),
      Trunc(PY * DefaultCellSize.Y / CellMulY));
    NewCell.Polygon := GetTilePolygon(NewCell.PosPx, DefaultCellSize);
    NewCell.Id := GetNewCellId;
    Cells[Y * Size.X + X] := NewCell;
  end;

  // Generate neightbours
  for Y := 0 to Size.Y - 1 do
  for X := 0 to Size.X - 1 do
  with Cells[Y * Size.X + X] do begin
    Cell := Cells[Y * Size.X + X];
    if Cyclic then begin
      P := TPoint.Create(X + 0 + (Y mod 2), Y + 1);
      P := TPoint.Create((P.X + Size.X) mod Size.X, (P.Y + Size.Y) mod Size.Y);
      Cell.ConnectTo(Cells[P.Y * Size.X + P.X]);
      P := TPoint.Create(X - 1 + (Y mod 2), Y + 1);
      P := TPoint.Create((P.X + Size.X) mod Size.X, (P.Y + Size.Y) mod Size.Y);
      Cell.ConnectTo(Cells[P.Y * Size.X + P.X]);
      P := TPoint.Create(X + 0 + (Y mod 2), Y - 1);
      P := TPoint.Create((P.X + Size.X) mod Size.X, (P.Y + Size.Y) mod Size.Y);
      Cell.ConnectTo(Cells[P.Y * Size.X + P.X]);
      P := TPoint.Create(X - 1 + (Y mod 2), Y - 1);
      P := TPoint.Create((P.X + Size.X) mod Size.X, (P.Y + Size.Y) mod Size.Y);
      Cell.ConnectTo(Cells[P.Y * Size.X + P.X]);
    end else begin
      P := TPoint.Create(X + 0 + (Y mod 2), Y + 1);
      if IsValidIndex(P) then Cell.ConnectTo(Cells[P.Y * Size.X + P.X]);
      P := TPoint.Create(X - 1 + (Y mod 2), Y + 1);
      if IsValidIndex(P) then Cell.ConnectTo(Cells[P.Y * Size.X + P.X]);
      P := TPoint.Create(X + 0 + (Y mod 2), Y - 1);
      if IsValidIndex(P) then Cell.ConnectTo(Cells[P.Y * Size.X + P.X]);
      P := TPoint.Create(X - 1 + (Y mod 2), Y - 1);
      if IsValidIndex(P) then Cell.ConnectTo(Cells[P.Y * Size.X + P.X]);
    end;
  end;

  FPixelRect := CalculatePixelRect;
end;

function TIsometricMap.CalculatePixelRect: TRect;
begin
  Result := inherited CalculatePixelRect;
  Result.P2 := Result.P2 - TPoint.Create(
    Trunc(0.5 * DefaultCellSize.X / CellMulX),
    Trunc(DefaultCellSize.Y / CellMulY)
  );
end;

{ THexMapVertical }

function THexMapVertical.GetHexagonPolygon(Pos: TPoint; Size: TPoint): TPolygon;
var
  Shift: TPointF;
  Angle: Double;
begin
  Angle := 30 / 180 * Pi;
  Shift := TPointF.Create(0.5, 0.5) * TPointF.Create(Cos(Angle), Sin(Angle));
  SetLength(Result.Points, 6);
  Result.Points[0] := TPoint.Create(Trunc(Pos.X + 0 * Size.X), Trunc(Pos.Y - 0.5 * Size.Y));
  Result.Points[1] := TPoint.Create(Trunc(Pos.X + Shift.X * Size.X), Trunc(Pos.Y - Shift.Y * Size.Y));
  Result.Points[2] := TPoint.Create(Trunc(Pos.X + Shift.X * Size.X), Trunc(Pos.Y + Shift.Y * Size.Y));
  Result.Points[3] := TPoint.Create(Trunc(Pos.X + 0 * Size.X), Trunc(Pos.Y + 0.5 * Size.Y));
  Result.Points[4] := TPoint.Create(Trunc(Pos.X - Shift.X * Size.X), Trunc(Pos.Y + Shift.Y * Size.Y));
  Result.Points[5] := TPoint.Create(Trunc(Pos.X - Shift.X * Size.X), Trunc(Pos.Y - Shift.Y * Size.Y));
end;

procedure THexMapVertical.SetSize(AValue: TPoint);
begin
  inherited;
  if Cyclic then
    FSize := TPoint.Create(FSize.X, FSize.Y + FSize.Y mod 2);
end;

function THexMapVertical.CalculatePixelRect: TRect;
var
  Shift: TPointF;
  Angle: Double;
begin
  Result := inherited CalculatePixelRect;
  Angle := 30 / 180 * Pi;
  Shift := TPointF.Create(0.5, 0.5) * TPointF.Create(Cos(Angle), Sin(Angle));
  Result.P2 := Result.P2 - TPoint.Create(
    Trunc(0.5 * DefaultCellSize.X / CellMulX),
    Trunc(1.35 * Shift.Y * DefaultCellSize.Y / CellMulY)
  );
end;

function THexMapVertical.IsCellsPosNeighbor(CellPos1, CellPos2: TPoint): Boolean;
var
  DX: Integer;
  DY: Integer;
  MinY: Integer;
begin
  if CellPos1.Y < CellPos2.Y then MinY:= CellPos1.Y
    else MinY := CellPos2.Y;
  DX := CellPos2.X - CellPos1.X;
  DY := CellPos2.Y - CellPos1.Y;
  Result := (Abs(DX) <= 1) and (Abs(DY) <= 1) and
  ((((MinY mod 2) = 1) and
    not ((DX = 1) and (DY = -1)) and
    not ((DX = -1) and (DY = 1))) or
    (((MinY mod 2) = 0) and
    not ((DX = -1) and (DY = -1)) and
    not ((DX = 1) and (DY = 1))));
  Result := Result and not ((CellPos1.X = CellPos2.X) and (CellPos1.Y = CellPos2.Y));
end;

procedure THexMapVertical.LoadFromFile(FileName: string);
var
  Doc: TXMLDocument;
begin
  try
    ReadXMLFile(Doc, FileName);
    if Doc.DocumentElement.TagName <> 'Map' then
      raise Exception.Create('Invalid map format');
  finally
    Doc.Free;
  end;
  inherited LoadFromFile(FileName);
end;

procedure THexMapVertical.SaveToFile(FileName: string);
var
  Doc: TXMLDocument;
  RootNode: TDOMNode;
begin
  try
    Doc := TXMLDocument.Create;
    RootNode := Doc.CreateElement('Map');
    Doc.Appendchild(RootNode);
    WriteXMLFile(Doc, FileName);
  finally
    Doc.Free;
  end;
  inherited SaveToFile(FileName);
end;

procedure THexMapVertical.GetCellPosNeighbors(CellPos: TPoint; Cell: TCell);
var
  X, Y: Integer;
  P: TPoint;
  PMod: TPoint;
begin
  for Y := -1 to 1 do
  for X := -1 to 1 do begin
    P := TPoint.Create(CellPos.X + X, CellPos.Y + Y);
    PMod := TPoint.Create((P.X + Size.X) mod Size.X, (P.Y + Size.Y) mod Size.Y);
    if Cyclic then begin
      if IsValidIndex(PMod) and IsCellsPosNeighbor(CellPos, P) then begin
        Cell.ConnectTo(Cells[PMod.Y * Size.X + PMod.X]);
      end;
    end else begin
      if IsValidIndex(P) and IsCellsPosNeighbor(CellPos, P) then begin
        Cell.ConnectTo(Cells[P.Y * Size.X + P.X]);
      end;
    end;
  end;
end;

procedure THexMapVertical.Generate;
var
  X, Y: Integer;
  NewCell: TCell;
  PX, PY: Double;
begin
  Clear;

  // Allocate and init new
  Cells.Count := Size.Y * Size.X;
  for Y := 0 to Size.Y - 1 do
  for X := 0 to Size.X - 1 do begin
    NewCell := TCell.Create;
    NewCell.Map := Self;
    PX := X;
    PY := Y;
    if (Y and 1) = 1 then begin
      PX := PX + 0.5;
    end;
    NewCell.PosPx := TPoint.Create(Trunc(PX * DefaultCellSize.X / CellMulX),
      Trunc(PY * DefaultCellSize.Y / CellMulY));
    NewCell.Polygon := GetHexagonPolygon(NewCell.PosPx, DefaultCellSize);
    NewCell.Id := GetNewCellId;
    Cells[Y * Size.X + X] := NewCell;
  end;

  // Generate neightbours
  for Y := 0 to Size.Y - 1 do
  for X := 0 to Size.X - 1 do
  with Cells[Y * Size.X + X] do begin
    GetCellPosNeighbors(TPoint.Create(X, Y), Cells[Y * Size.X + X]);
  end;

  FPixelRect := CalculatePixelRect;
end;


{ TSquareMap }

procedure TSquareMap.Generate;
var
  X, Y: Integer;
  NewCell: TCell;
  P: TPoint;
  Cell: TCell;
begin
  Clear;

  // Allocate and init new
  Cells.Count := Size.Y * Size.X;
  for Y := 0 to Size.Y - 1 do
  for X := 0 to Size.X - 1 do begin
    NewCell := TCell.Create;
    NewCell.Map := Self;
    NewCell.PosPx := TPoint.Create(Trunc(X * DefaultCellSize.X),
      Trunc(Y * DefaultCellSize.Y));
    NewCell.Polygon := GetSquarePolygon(NewCell.PosPx, DefaultCellSize);
    NewCell.Id := GetNewCellId;
    Cells[Y * Size.X + X] := NewCell;
  end;

  // Generate neighbours
  for Y := 0 to Size.Y - 1 do
  for X := 0 to Size.X - 1 do
  with Cells[Y * Size.X + X] do begin
    Cell := Cells[Y * Size.X + X];
    if Cyclic then begin
      P := TPoint.Create(X + 1, Y + 0);
      P := TPoint.Create((P.X + Size.X) mod Size.X, (P.Y + Size.Y) mod Size.Y);
      Cell.ConnectTo(Cells[P.Y * Size.X + P.X]);
      P := TPoint.Create(X + 0, Y + 1);
      P := TPoint.Create((P.X + Size.X) mod Size.X, (P.Y + Size.Y) mod Size.Y);
      Cell.ConnectTo(Cells[P.Y * Size.X + P.X]);
      P := TPoint.Create(X - 1, Y + 0);
      P := TPoint.Create((P.X + Size.X) mod Size.X, (P.Y + Size.Y) mod Size.Y);
      Cell.ConnectTo(Cells[P.Y * Size.X + P.X]);
      P := TPoint.Create(X + 0, Y - 1);
      P := TPoint.Create((P.X + Size.X) mod Size.X, (P.Y + Size.Y) mod Size.Y);
      Cell.ConnectTo(Cells[P.Y * Size.X + P.X]);
    end else begin
      P := TPoint.Create(X + 1, Y + 0);
      if IsValidIndex(P) then Cell.ConnectTo(Cells[P.Y * Size.X + P.X]);
      P := TPoint.Create(X + 0, Y + 1);
      if IsValidIndex(P) then Cell.ConnectTo(Cells[P.Y * Size.X + P.X]);
      P := TPoint.Create(X - 1, Y + 0);
      if IsValidIndex(P) then Cell.ConnectTo(Cells[P.Y * Size.X + P.X]);
      P := TPoint.Create(X + 0, Y - 1);
      if IsValidIndex(P) then Cell.ConnectTo(Cells[P.Y * Size.X + P.X]);
    end;
  end;

  FPixelRect := CalculatePixelRect;
end;

function TSquareMap.GetSquarePolygon(Pos: TPoint; Size: TPoint): TPolygon;
begin
  SetLength(Result.Points, 4);
  Result.Points[0] := TPoint.Create(Trunc(Pos.X - Size.X / 2), Trunc(Pos.Y - Size.Y / 2));
  Result.Points[1] := TPoint.Create(Trunc(Pos.X + Size.X / 2), Trunc(Pos.Y - Size.Y / 2));
  Result.Points[2] := TPoint.Create(Trunc(Pos.X + Size.X / 2), Trunc(Pos.Y + Size.Y / 2));
  Result.Points[3] := TPoint.Create(Trunc(Pos.X - Size.X / 2), Trunc(Pos.Y + Size.Y / 2));
end;

{ TVoronoiMap }

function CompareDistance(const C1, C2: TCellsDistance): Integer;
begin
  if C1.Distance > C2.Distance then Result := 1
  else if C1.Distance < C2.Distance then Result := -1
  else Result := 0;
end;

procedure TVoronoiMap.Generate;
var
  X, Y: Integer;
  NewCell: TCell;
  I, J: Integer;
  Cell: TCell;
  Cell2: TCell;
  L1: TLine;
  MP: TPoint;
  LinkLine: TLine;
  P: TPolygon;
  AreaSize: TPoint;
const
  LinkTolerance = 8;
begin
  Clear;
  //RandSeed := 1234;

  // Allocate and init new cells
  Cells.Count := Size.Y * Size.X;
  for Y := 0 to Size.Y - 1 do
  for X := 0 to Size.X - 1 do begin
    NewCell := TCell.Create;
    NewCell.Map := Self;
    NewCell.PosPx := TPoint.Create(Trunc(Random * Size.X * DefaultCellSize.X),
      Trunc(Random * Size.Y * DefaultCellSize.Y));
    SetLength(NewCell.Polygon.Points, 1);
    NewCell.Polygon.Points[0] := NewCell.PosPx;
    NewCell.Id := GetNewCellId;
    Cells[Y * Size.X + X] := NewCell;
  end;

  AreaSize := TPoint.Create(Size.X * DefaultCellSize.X, Size.Y * DefaultCellSize.Y);

  // Compute polygon by cutting out map area by all other cells
  if Cyclic then begin
    for Cell in Cells do begin
      Cell.Polygon := TPolygon.Create(TRect.Create(
        TPoint.Create(-AreaSize.X, -AreaSize.Y),
        TPoint.Create(2 * AreaSize.X, 2 * AreaSize.Y)));
      for Y := -1 to 1 do
      for X := -1 to 1 do
      for Cell2 in Cells do
      if Cell2 <> Cell then begin
        LinkLine := TLine.Create(Cell.PosPx, Cell2.PosPx +
          TPoint.Create(X * AreaSize.X, Y * AreaSize.Y));
        LinkLine.Distance := LinkLine.Distance;
        MP := LinkLine.GetMiddle;
        // Create half plane vector
        L1 := TLine.Create(MP, TPoint.Create(MP.X + LinkLine.GetSize.X,
          MP.Y + LinkLine.GetSize.Y));

        Cell.Polygon.CutLine(L1, Cell.PosPx);
      end;
    end;
  end else begin
    for Cell in Cells do begin
      Cell.Polygon := TPolygon.Create(TRect.Create(TPoint.Create(0, 0),
        AreaSize));
      for Cell2 in Cells do
      if Cell2 <> Cell then begin
        LinkLine := TLine.Create(Cell.PosPx, Cell2.PosPx);
        LinkLine.Distance := LinkLine.Distance;
        MP := LinkLine.GetMiddle;
        // Create half plane vector
        L1 := TLine.Create(MP, TPoint.Create(MP.X + LinkLine.GetSize.X,
          MP.Y + LinkLine.GetSize.Y));

        Cell.Polygon.CutLine(L1, Cell.PosPx);
      end;
    end;
  end;

  // Link all cells with neighboring polygon edges
  if Cyclic then begin
    for I := 0 to Cells.Count - 1 do begin
      for Y := -1 to 1 do
      for X := -1 to 1 do
      for J := 0 to Cells.Count - 1 do
      if J <> I then begin
        P := Cells[J].Polygon;
        P.Move(TPoint.Create(X * AreaSize.X, Y * AreaSize.Y));
        if Cells[I].Polygon.EdgeDistance(P) < LinkTolerance then
          Cells[I].ConnectTo(Cells[J]);
      end;
    end;
  end else begin
    for I := 0 to Cells.Count - 1 do begin
      for J := I + 1 to Cells.Count - 1 do begin
        if Cells[I].Polygon.EdgeDistance(Cells[J].Polygon) < LinkTolerance then
          Cells[I].ConnectTo(Cells[J]);
      end;
    end;
  end;

  // Adjust polygon centers
  for I := 0 to Cells.Count - 1 do begin
    Cells[I].PosPx := Cells[I].Polygon.GetCenter;
  end;

  FPixelRect := CalculatePixelRect;
end;

function TVoronoiMap.CalculatePixelRect: TRect;
begin
  Result.P1 := TPoint.Create(0, 0);
  Result.P2 := TPoint.Create(Size.X * DefaultCellSize.X, Size.Y * DefaultCellSize.Y);
end;

{ TTriangleMap }

function TTriangleMap.GetTrianglePolygon(Pos: TPoint; Size: TPoint;
  Reverse: Boolean): TPolygon;
var
  Rev: Integer;
begin
  if Reverse then Rev := -1
    else Rev := 1;
  SetLength(Result.Points, 3);
  Result.Points[0] := TPoint.Create(Trunc(Pos.X - Size.X / 2), Trunc(Pos.Y - (Size.Y * 0.8) / 2 * Rev));
  Result.Points[1] := TPoint.Create(Trunc(Pos.X + Size.X / 2), Trunc(Pos.Y - (Size.Y * 0.8) / 2 * Rev));
  Result.Points[2] := TPoint.Create(Trunc(Pos.X), Trunc(Pos.Y + (Size.Y * 1.2) / 2 * Rev));
end;

procedure TTriangleMap.SetSize(AValue: TPoint);
begin
  inherited;
  if Cyclic then
    FSize := TPoint.Create(FSize.X + FSize.X mod 2, FSize.Y + FSize.Y mod 2);
end;

procedure TTriangleMap.Generate;
var
  X, Y: Integer;
  Rev: Integer;
  Reverse: Boolean;
  NewCell: TCell;
  P: TPoint;
  Cell: TCell;
begin
  Clear;

  // Allocate and init new
  Cells.Count := Size.Y * Size.X;
  for Y := 0 to Size.Y - 1 do
  for X := 0 to Size.X - 1 do begin
    NewCell := TCell.Create;
    NewCell.Map := Self;
    Reverse := Boolean(X mod 2) xor Boolean(Y mod 2);
    if Reverse then Rev := -1
      else Rev := 1;
    NewCell.PosPx := TPoint.Create(Trunc(X * DefaultCellSize.X * CellMulX),
      Trunc((Y * DefaultCellSize.Y * CellMulY) - (0.1 * Rev * DefaultCellSize.Y)));
    NewCell.Polygon := GetTrianglePolygon(NewCell.PosPx, DefaultCellSize, Reverse);
    NewCell.Id := GetNewCellId;
    Cells[Y * Size.X + X] := NewCell;
  end;

  // Generate neighbours
  for Y := 0 to Self.Size.Y - 1 do
  for X := 0 to Size.X - 1 do
  with Cells[Y * Size.X + X] do begin
    Cell := Cells[Y * Size.X + X];
    if Boolean(X mod 2) xor Boolean(Y mod 2) then Rev := -1
      else Rev := 1;
    if Cyclic then begin
      P := TPoint.Create(X + 1, Y + 0);
      P := TPoint.Create((P.X + Size.X) mod Size.X, (P.Y + Size.Y) mod Size.Y);
      Cell.ConnectTo(Cells[P.Y * Size.X + P.X]);
      P := TPoint.Create(X + 0, Y - 1 * Rev);
      P := TPoint.Create((P.X + Size.X) mod Size.X, (P.Y + Size.Y) mod Size.Y);
      Cell.ConnectTo(Cells[P.Y * Size.X + P.X]);
      P := TPoint.Create(X - 1, Y + 0);
      P := TPoint.Create((P.X + Size.X) mod Size.X, (P.Y + Size.Y) mod Size.Y);
      Cell.ConnectTo(Cells[P.Y * Size.X + P.X]);
    end else begin
      P := TPoint.Create(X + 1, Y + 0);
      if IsValidIndex(P) then Cell.ConnectTo(Cells[P.Y * Size.X + P.X]);
      P := TPoint.Create(X + 0, Y - 1 * Rev);
      if IsValidIndex(P) then Cell.ConnectTo(Cells[P.Y * Size.X + P.X]);
      P := TPoint.Create(X - 1, Y + 0);
      if IsValidIndex(P) then Cell.ConnectTo(Cells[P.Y * Size.X + P.X]);
    end;
  end;

  FPixelRect := CalculatePixelRect;
end;

function TTriangleMap.CalculatePixelRect: TRect;
begin
  Result := inherited CalculatePixelRect;
  Result.P2 := Result.P2 + TPoint.Create(
    Trunc(- 0.25 * DefaultCellSize.X / CellMulX),
    0
  );
end;


end.

