source: trunk/UMap.pas

unit UMap;

{$mode delphi}

interface

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

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

  { THexMap }

  THexMap = class(TMap)
  private
    function IsCellsPosNeighbor(CellPos1, CellPos2: TPoint): Boolean;
    procedure GetCellPosNeighbors(CellPos: TPoint; Neighbours: TCells);
    function GetHexagonPolygon(Pos: TPoint; Size: TPoint): TPolygon;
  public
    procedure LoadFromFile(FileName: string); override;
    procedure SaveToFile(FileName: string); override;
    function IsValidIndex(Index: TPoint): Boolean; override;
    procedure Generate; override;
  end;

  { TSquareMap }

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

  { TTriangleMap }

  TTriangleMap = class(TMap)
  private
    function GetTrianglePolygon(Pos: TPoint; Size: TPoint; Reverse: Boolean): TPolygon;
  public
    function IsValidIndex(Index: TPoint): Boolean; override;
    procedure Generate; override;
  end;

  { TVoronoiMap }

  TVoronoiMap = class(TMap)
  private
  public
    procedure Generate; override;
  end;

implementation

{ THexMap }

function THexMap.GetHexagonPolygon(Pos: TPoint; Size: TPoint): TPolygon;
var
  Shift: TPointF;
begin
  Shift := TPointF.Create(0.5 * cos(30 / 180 * Pi), 0.5 * sin(30 / 180 * Pi));
  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;

function THexMap.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 THexMap.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 THexMap.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;

function THexMap.IsValidIndex(Index: TPoint): Boolean;
begin
  Result := (Index.X >= 0) and (Index.X < Size.X) and
    (Index.Y >= 0) and (Index.Y < Size.Y);
end;

procedure THexMap.GetCellPosNeighbors(CellPos: TPoint; Neighbours: TCells);
var
  X, Y: Integer;
begin
  Neighbours.Count := 0;
  for Y := -1 to 1 do
  for X := -1 to 1 do
  if IsValidIndex(TPoint.Create(CellPos.X + X, CellPos.Y + Y)) and
  IsCellsPosNeighbor(CellPos, TPoint.Create((CellPos.X + X), (CellPos.Y + Y))) then begin
    Neighbours.Add(TCell(Cells[(CellPos.Y + Y) * Size.X + (CellPos.X + X)]));
  end;
end;

procedure THexMap.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;
      //Y := Y + 0.5;
    end;
    NewCell.PosPx := TPoint.Create(Trunc(PX * DefaultCellSize.X / HexCellMulX),
      Trunc(PY * DefaultCellSize.Y / HexCellMulY));
    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 TCell(Cells[Y * Size.X + X]) do begin
    GetCellPosNeighbors(TPoint.Create(X, Y), Neighbors);
  end;

  FPixelRect := CalculatePixelRect;
end;


{ TSquareMap }

procedure TSquareMap.Generate;
var
  X, Y: Integer;
  NewCell: 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 * SquareCellMulX),
      Trunc(Y * DefaultCellSize.Y * SquareCellMulY));
    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 TCell(Cells[Y * Size.X + X]) do begin
    if IsValidIndex(TPoint.Create(X + 1, Y + 0)) then
      Neighbors.Add(TCell(Cells[(Y + 0) * Size.X + (X + 1)]));
    if IsValidIndex(TPoint.Create(X + 0, Y + 1)) then
      Neighbors.Add(TCell(Cells[(Y + 1) * Size.X + (X + 0)]));
    if IsValidIndex(TPoint.Create(X - 1, Y + 0)) then
      Neighbors.Add(TCell(Cells[(Y + 0) * Size.X + (X - 1)]));
    if IsValidIndex(TPoint.Create(X + 0, Y - 1)) then
      Neighbors.Add(TCell(Cells[(Y - 1) * Size.X + (X + 0)]));
  end;

  FPixelRect := CalculatePixelRect;
end;

function TSquareMap.IsValidIndex(Index: TPoint): Boolean;
begin
  Result := (Index.X >= 0) and (Index.X < Size.X) and
    (Index.Y >= 0) and (Index.Y < Size.Y);
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;
const
  CellGapWidth = 4;
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;

  // Compute polygon cat out by all other cells
  for Cell in Cells do begin
    Cell.Polygon := TPolygon.Create(TRect.Create(TPoint.Create(0, 0),
      TPoint.Create(Size.X * DefaultCellSize.X, Size.Y * DefaultCellSize.Y)));
    for Cell2 in Cells do
    if Cell2 <> Cell then begin
      LinkLine := TLine.Create(Cell.PosPx, Cell2.PosPx);
      LinkLine.Distance := LinkLine.Distance - CellGapWidth;
      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;

  // Link all cells with neighboring polygon edges
  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) < 2 * CellGapWidth then
        Cells[I].ConnectTo(Cells[J]);
    end;
  end;

  FPixelRect := CalculatePixelRect;
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;

function TTriangleMap.IsValidIndex(Index: TPoint): Boolean;
begin
  Result := (Index.X >= 0) and (Index.X < Size.X) and
    (Index.Y >= 0) and (Index.Y < Size.Y);
end;

procedure TTriangleMap.Generate;
var
  X, Y: Integer;
  Rev: Integer;
  Reverse: Boolean;
  NewCell: 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 * TriangleCellMulX),
      Trunc((Y * DefaultCellSize.Y * TriangleCellMulY) - (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 TCell(Cells[Y * Size.X + X]) do begin
    if Boolean(X mod 2) xor Boolean(Y mod 2) then Rev := -1
      else Rev := 1;
    if IsValidIndex(TPoint.Create(X + 1, Y + 0)) then
      Neighbors.Add(TCell(Cells[(Y + 0) * Size.X + (X + 1)]));
    if IsValidIndex(TPoint.Create(X + 0, Y - 1 * Rev)) then
      Neighbors.Add(TCell(Cells[(Y - 1 * Rev) * Size.X + (X + 0)]));
    if IsValidIndex(TPoint.Create(X - 1, Y + 0)) then
      Neighbors.Add(TCell(Cells[(Y + 0) * Size.X + (X - 1)]));
  end;

  FPixelRect := CalculatePixelRect;
end;


end.