source: tags/1.2.0/UMap.pas

unit UMap;

{$mode delphi}

interface

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

type
  { THexMap }

  THexMap = class(TMap)
  private
    function IsCellsPosNeighbor(CellPos1, CellPos2: TPoint): Boolean;
    procedure GetCellPosNeighbors(CellPos: TPoint; Neighbours: TCells);
    function GetHexagonPolygon(Pos: TPoint; Size: TPoint): TPointArray;
  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): TPointArray;
  public
    function IsValidIndex(Index: TPoint): Boolean; override;
    procedure Generate; override;
  end;

  { TTriangleMap }

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

  { TVoronoiMap }

  TVoronoiMap = class(TMap)
  private
    function GetTrianglePolygon(Pos: TPoint; Size: TPoint; Reverse: Boolean): TPointArray;
  public
    procedure Generate; override;
  end;


implementation

{ THexMap }

function THexMap.GetHexagonPolygon(Pos: TPoint; Size: TPoint): TPointArray;
var
  Shift: TFloatPoint;
begin
  Shift := FloatPoint(0.5 * cos(30 / 180 * Pi), 0.5 * sin(30 / 180 * Pi));
  SetLength(Result, 6);
  Result[0] := Point(Trunc(Pos.X + 0 * Size.X), Trunc(Pos.Y - 0.5 * Size.Y));
  Result[1] := Point(Trunc(Pos.X + Shift.X * Size.X), Trunc(Pos.Y - Shift.Y * Size.Y));
  Result[2] := Point(Trunc(Pos.X + Shift.X * Size.X), Trunc(Pos.Y + Shift.Y * Size.Y));
  Result[3] := Point(Trunc(Pos.X + 0 * Size.X), Trunc(Pos.Y + 0.5 * Size.Y));
  Result[4] := Point(Trunc(Pos.X - Shift.X * Size.X), Trunc(Pos.Y + Shift.Y * Size.Y));
  Result[5] := Point(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(Point(CellPos.X + X, CellPos.Y + Y)) and
  IsCellsPosNeighbor(CellPos, Point((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 := Point(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(Point(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 := Point(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(Point(X + 1, Y + 0)) then
      Neighbors.Add(TCell(Cells[(Y + 0) * Size.X + (X + 1)]));
    if IsValidIndex(Point(X + 0, Y + 1)) then
      Neighbors.Add(TCell(Cells[(Y + 1) * Size.X + (X + 0)]));
    if IsValidIndex(Point(X - 1, Y + 0)) then
      Neighbors.Add(TCell(Cells[(Y + 0) * Size.X + (X - 1)]));
    if IsValidIndex(Point(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): TPointArray;
begin
  SetLength(Result, 4);
  Result[0] := Point(Trunc(Pos.X - Size.X / 2), Trunc(Pos.Y - Size.Y / 2));
  Result[1] := Point(Trunc(Pos.X + Size.X / 2), Trunc(Pos.Y - Size.Y / 2));
  Result[2] := Point(Trunc(Pos.X + Size.X / 2), Trunc(Pos.Y + Size.Y / 2));
  Result[3] := Point(Trunc(Pos.X - Size.X / 2), Trunc(Pos.Y + Size.Y / 2));
end;

{ TVoronoiMap }

function TVoronoiMap.GetTrianglePolygon(Pos: TPoint; Size: TPoint;
  Reverse: Boolean): TPointArray;
begin
  SetLength(Result, 0);
end;

procedure TVoronoiMap.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 := Point(Trunc(Random * Size.X * DefaultCellSize.X),
      Trunc(Random * Size.Y * DefaultCellSize.Y));
    SetLength(NewCell.Polygon, 1);
    NewCell.Polygon[0] := NewCell.PosPx;
    NewCell.Id := GetNewCellId;
    Cells[Y * Size.X + X] := NewCell;
  end;

  FPixelRect := CalculatePixelRect;
end;

{ TTriangleMap }

function TTriangleMap.GetTrianglePolygon(Pos: TPoint; Size: TPoint;
  Reverse: Boolean): TPointArray;
var
  Rev: Integer;
begin
  if Reverse then Rev := -1
    else Rev := 1;
  SetLength(Result, 3);
  Result[0] := Point(Trunc(Pos.X - Size.X / 2), Trunc(Pos.Y - (Size.Y * 0.8) / 2 * Rev));
  Result[1] := Point(Trunc(Pos.X + Size.X / 2), Trunc(Pos.Y - (Size.Y * 0.8) / 2 * Rev));
  Result[2] := Point(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 := Point(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(Point(X + 1, Y + 0)) then
      Neighbors.Add(TCell(Cells[(Y + 0) * Size.X + (X + 1)]));
    if IsValidIndex(Point(X + 0, Y - 1 * Rev)) then
      Neighbors.Add(TCell(Cells[(Y - 1 * Rev) * Size.X + (X + 0)]));
    if IsValidIndex(Point(X - 1, Y + 0)) then
      Neighbors.Add(TCell(Cells[(Y + 0) * Size.X + (X - 1)]));
  end;

  FPixelRect := CalculatePixelRect;
end;


end.