source: trunk/Map.pas

unit Map;

interface

uses
  Classes, SysUtils, Graphics, ExtCtrls, Geometry, DOM, Generics.Collections,
  Generics.Defaults, Building, XML, Units;

const
  DefaultMaxPower = 99;

type
  TMapArea = class;
  TMap = class;
  TCells = class;
  TCellLinks = class;

  TTerrainType = (ttVoid, ttNormal, ttCityUnused);
  TExtraType = (etNone, etObjectiveTarget, etAttack, etDefense, etLookout,
    etGrowLow, etGrowMedium, etGrowHigh);

  { TCell }

  TCell = class
  private
    FArea: TMapArea;
    FBuilding: TBuilding;
    FId: Integer;
    FMap: TMap;
    FUnit: TUnit;
    procedure SetArea(AValue: TMapArea);
    procedure SetBuilding(AValue: TBuilding);
    procedure SetId(AValue: Integer);
    procedure SetUnit(AValue: TUnit);
  public
    PosPx: TPoint;
    Polygon: TPolygon;
    Terrain: TTerrainType;
    PlayerId: Integer; // Temporary value
    Player: TObject; // TPlayer;
    NeighborsId: array of Integer;
    Neighbors: TCells;
    Mark: Boolean; // Temporary value
    Weight: Integer; // Temporary value
    Angle: Double; // Temporary value
    PlayerCell: TObject; // Temporary value
    Links: TCellLinks;
    Extra: TExtraType;
    OneUnitId: Integer; // Temporary value
    BuildingId: Integer; // Temporary value
    function Compare(Cell: TCell): Boolean;
    procedure ConnectTo(Cell: TCell);
    procedure DisconnectFrom(Cell: TCell);
    function NeighboringToVoid: Boolean;
    procedure AreaExtend;
    procedure FixRefId;
    procedure LoadFromNode(Node: TDOMNode);
    procedure SaveToNode(Node: TDOMNode);
    procedure Assign(Source: TCell);
    function GetColor: TColor;
    function ToString: ansistring; override;
    procedure CheckOwnership;
    constructor Create;
    destructor Destroy; override;
    property Id: Integer read FId write SetId;
    property Map: TMap read FMap write FMap;
    property Area: TMapArea read FArea write SetArea;
    property OneUnit: TUnit read FUnit write SetUnit;
    property Building: TBuilding read FBuilding write SetBuilding;
  end;

  TCellArray = array of TCell;

  { TCells }

  TCells = class(TObjectList<TCell>)
    Map: TMap;
    procedure FixRefId;
    function FindById(Id: Integer): TCell;
    procedure GetCellsWithWeight(List: TCells; Low, High: Integer);
    procedure GetCellsWithExtra(List: TCells; Extra: TExtraType);
    procedure LoadFromNode(Node: TDOMNode);
    procedure SaveToNode(Node: TDOMNode);
    function Compare(Cells: TCells): Boolean;
    procedure ClearMark;
    procedure ClearWeight;
    function ToString: ansistring; override;
  end;

  { TCellLink }

  TCellLink = class
    Points: array of TPoint;
    Cells: TCells;
    Map: TMap;
    procedure LoadFromNode(Node: TDOMNode);
    procedure SaveToNode(Node: TDOMNode);
    constructor Create;
    destructor Destroy; override;
  end;

  { TCellLinks }

  TCellLinks = class(TObjectList<TCellLink>)
    Map: TMap;
    function FindByCells(Cell1, Cell2: TCell): TCellLink;
    function AddLink(Cell1, Cell2: TCell): TCellLink;
    procedure LoadFromNode(Node: TDOMNode);
    procedure SaveToNode(Node: TDOMNode);
  end;

  { TCellLinkParams }

  TCellLinkParams = class
    Cell1: TCell;
    Cell2: TCell;
    Distance: Double;
    Angle: Double;
  end;

  TMapShape = (msRectangle, msImage, msRounded);

  { TMapArea }

  TMapArea = class
    Id: Integer;
    Map: TMap;
    BridgeCount: Integer;
    Cells: TCells;
    procedure GetBorderCells(List: TCells);
    constructor Create;
    destructor Destroy; override;
  end;

  TMapAreas = class(TObjectList<TMapArea>)
  end;

  { TMap }

  TMap = class
  private
    function GetPixelRect: TRect;
    function GetSize: TPoint; virtual;
    function SearchDifferentCellArea(List: TCells; SourceArea,
      DestArea: TMapArea): TCell;
  protected
    FSize: TPoint;
    FPixelRect: TRect;
    FNewCellId: Integer;
    function GetNewCellId: Integer; virtual;
    procedure SortNeighborsByAngle;
    procedure SetSize(AValue: TPoint); virtual;
  public
    Game: TObject; //TGame;
    MaxPower: Integer;
    DefaultCellSize: TPoint;
    Cells: TCells;
    Shape: TMapShape;
    Image: TImage;
    CellLinks: TCellLinks;
    Areas: TMapAreas;
    Cyclic: Boolean;
    function IsOutsideShape(Coord: TPoint): Boolean; virtual;
    function IsCellsNeighbor(Cell1, Cell2: TCell): Boolean; virtual;
    function IsValidIndex(Index: TPoint): Boolean; virtual;
    procedure Assign(Source: TMap); virtual;
    function Compare(Map: TMap): Boolean;
    procedure LoadFromFile(FileName: string); virtual;
    procedure SaveToFile(FileName: string); virtual;
    procedure LoadFromNode(Node: TDOMNode);
    procedure SaveToNode(Node: TDOMNode);
    function PosToCell(Pos: TPoint): TCell; virtual;
    function CellToPos(Cell: TCell): TPoint; virtual;
    procedure ComputePlayerStats; virtual;
    procedure Generate; virtual;
    procedure BuildMapAreas;
    procedure BuildBridges;
    procedure MakeSymetric;
    procedure CreateLinks;
    procedure Clear;
    procedure CheckCells;
    function ToString: string; override;
    constructor Create; virtual;
    destructor Destroy; override;
    function CalculatePixelRect: TRect; virtual;
    procedure ForEachCells(Method: TMethod); virtual;
    property Size: TPoint read GetSize write SetSize;
    property PixelRect: TRect read GetPixelRect;
  end;


resourcestring
  SCellRemoveNeighborError = 'Can''t remove cell from neighbour cell';
  SNegativeCellPowerNotAllowed = 'Not allowed to substract power under zero to negative value';

implementation

uses
  Player, Game;

{ TCellLink }

procedure TCellLink.LoadFromNode(Node: TDOMNode);
var
  Node2: TDOMNode;
  Node3: TDOMNode;
begin
  Node3 := Node.FindNode('Points');
  if Assigned(Node3) then begin
    SetLength(Points, 0);
    Node2 := Node3.FirstChild;
    while Assigned(Node2) and (Node2.NodeName = 'Point') do begin
      SetLength(Points, Length(Points) + 1);
      Points[High(Points)].X := ReadInteger(Node2, 'X', 0);
      Points[High(Points)].Y := ReadInteger(Node2, 'Y', 0);
      Node2 := Node2.NextSibling;
    end;
  end;
end;

procedure TCellLink.SaveToNode(Node: TDOMNode);
var
  NewNode: TDOMNode;
  NewNode2: TDOMNode;
  I: Integer;
begin
  NewNode := Node.OwnerDocument.CreateElement('Points');
  Node.AppendChild(NewNode);
  for I := 0 to Length(Points) - 1 do begin
    NewNode2 := NewNode.OwnerDocument.CreateElement('Point');
    NewNode.AppendChild(NewNode2);
    WriteInteger(NewNode2, 'X', Points[I].X);
    WriteInteger(NewNode2, 'Y', Points[I].Y);
  end;
end;

constructor TCellLink.Create;
begin
  Cells := TCells.Create;
  Cells.OwnsObjects := False;
end;

destructor TCellLink.Destroy;
var
  I: Integer;
begin
  for I := 0 to Cells.Count - 1 do begin
    if Cells[I].Neighbors.Remove(Cells[1 - I]) = -1 then
      raise Exception.Create(SCellRemoveNeighborError);
    if Cells[I].Links.Remove(Self) = -1 then
      raise Exception.Create(SCellRemoveNeighborError);
  end;
  FreeAndNil(Cells);
  inherited;
end;

{ TCellLinks }

function TCellLinks.FindByCells(Cell1, Cell2: TCell): TCellLink;
var
  I: Integer;
begin
  I := 0;
  while (I < Count) do begin
    if ((Items[I].Cells[0] = Cell1) and (Items[I].Cells[1] = Cell2)) or
    ((Items[I].Cells[0] = Cell2) and (Items[I].Cells[1] = Cell1)) then
      Break;
    Inc(I);
  end;
  if I < Count then Result := Items[I]
    else Result := nil;
end;

function TCellLinks.AddLink(Cell1, Cell2: TCell): TCellLink;
begin
  Result := TCellLink.Create;
  Cell1.ConnectTo(Cell2);
  Cell1.Links.Add(Result);
  Cell2.Links.Add(Result);
  SetLength(Result.Points, 2);
  Result.Cells.Add(Cell1);
  Result.Points[0] := Cell1.PosPx;
  Result.Cells.Add(Cell2);
  Result.Points[1] := Cell2.PosPx;
  Result.Map := Map;
  Map.CellLinks.Add(Result);
end;

procedure TCellLinks.LoadFromNode(Node: TDOMNode);
var
  Node2: TDOMNode;
  NewCell: TCellLink;
begin
  Count := 0;
  Node2 := Node.FirstChild;
  while Assigned(Node2) and (Node2.NodeName = 'CellLink') do begin
    NewCell := TCellLink.Create;
    //NewCell.Map := Map;
    NewCell.LoadFromNode(Node2);
    Add(NewCell);
    Node2 := Node2.NextSibling;
  end;
end;

procedure TCellLinks.SaveToNode(Node: TDOMNode);
var
  I: Integer;
  NewNode2: TDOMNode;
begin
  for I := 0 to Count - 1 do
  with Items[I] do begin
    NewNode2 := Node.OwnerDocument.CreateElement('CellLink');
    Node.AppendChild(NewNode2);
    SaveToNode(NewNode2);
  end;
end;

{ TMapArea }

procedure TMapArea.GetBorderCells(List: TCells);
var
  Cell: TCell;
begin
  List.Clear;
  Map.Cells.ClearMark;
  for Cell in Cells do begin
    if Cell.NeighboringToVoid and (Cell.Area = Self) and (not Cell.Mark) then begin
      List.Add(Cell);
      Cell.Mark := True;
    end;
  end;
end;

constructor TMapArea.Create;
begin
  Cells := TCells.Create;
  Cells.OwnsObjects := False;
end;

destructor TMapArea.Destroy;
begin
  FreeAndNil(Cells);
  inherited;
end;

{ TCells }

procedure TCells.FixRefId;
var
  I: Integer;
begin
  for I := 0 to Count - 1 do
    Items[I].FixRefId;
end;

function TCells.FindById(Id: Integer): TCell;
var
  I: Integer;
begin
  I := 0;
  while (I < Count) and (Items[I].Id <> Id) do Inc(I);
  if I < Count then Result := Items[I]
    else Result := nil;
end;

procedure TCells.GetCellsWithWeight(List: TCells; Low, High: Integer);
var
  Cell: TCell;
begin
  List.Clear;
  for Cell in Self do
    if (Cell.Terrain <> ttVoid) and (Cell.Weight >= Low) and
      (Cell.Weight <= High) then List.Add(Cell);
end;

procedure TCells.GetCellsWithExtra(List: TCells; Extra: TExtraType);
var
  Cell: TCell;
begin
  List.Clear;
  for Cell in Self do
    if Cell.Extra = Extra then List.Add(Cell);
end;

procedure TCells.LoadFromNode(Node: TDOMNode);
var
  Node2: TDOMNode;
  NewCell: TCell;
begin
  Count := 0;
  Node2 := Node.FirstChild;
  while Assigned(Node2) and (Node2.NodeName = 'Cell') do begin
    NewCell := TCell.Create;
    NewCell.Map := Map;
    NewCell.LoadFromNode(Node2);
    Add(NewCell);
    Node2 := Node2.NextSibling;
  end;
end;

procedure TCells.SaveToNode(Node: TDOMNode);
var
  I: Integer;
  NewNode2: TDOMNode;
begin
  for I := 0 to Count - 1 do
  with Items[I] do begin
    NewNode2 := Node.OwnerDocument.CreateElement('Cell');
    Node.AppendChild(NewNode2);
    SaveToNode(NewNode2);
  end;
end;

function TCells.Compare(Cells: TCells): Boolean;
var
  I: Integer;
begin
  Result := True;
  for I := 0 to Count - 1 do
  with Items[I] do begin
    if not Items[I].Compare(Cells[I]) then begin
      Result := False;
      Break;
    end;
  end;
end;

procedure TCells.ClearMark;
var
  Cell: TCell;
begin
  for Cell in Self do Cell.Mark := False;
end;

procedure TCells.ClearWeight;
var
  Cell: TCell;
begin
  for Cell in Self do Cell.Weight := 0;
end;

function TCells.ToString: ansistring;
var
  C: TCell;
begin
  Result := '';
  for C in Self do
    Result := Result + C.ToString + LineEnding;
end;

{ TMap }

function TMap.GetSize: TPoint;
begin
  Result:= FSize;
end;

function TMap.GetPixelRect: TRect;
begin
  if FPixelRect.Empty then FPixelRect := CalculatePixelRect;
  Result := FPixelRect;
end;

procedure TMap.SetSize(AValue: TPoint);
begin
  if (FSize.X <> AValue.X) or (FSize.Y <> AValue.Y) then begin
    FSize := AValue;
  end;
end;

function CompareCellAngle(constref C1, C2: TCell): Integer;
begin
  if C1.Angle < C2.Angle then Result := -1
  else if C1.Angle > C2.Angle then Result := 1
  else Result := 0;
end;

procedure TMap.SortNeighborsByAngle;
var
  Cell: TCell;
  NeighborCell: TCell;
begin
  for Cell in Cells do begin
    for NeighborCell in Cell.Neighbors do
      NeighborCell.Angle := TLine.Create(Cell.PosPx, NeighborCell.PosPx).GetAngle;

    Cell.Neighbors.Sort(TComparer<TCell>.Construct(CompareCellAngle));
  end;
end;

function TMap.GetNewCellId: Integer;
begin
  Result := FNewCellId;
  Inc(FNewCellId);
end;

function TMap.IsOutsideShape(Coord: TPoint): Boolean;
var
  Rect: TRect;
  Color: TColor;
  Pos: TPoint;
  Center: TPoint;
begin
  case Shape of
    msRectangle: Result := False;
    msImage: begin
      Rect := PixelRect;
      with Image.Picture.Bitmap do begin
        Pos := TPoint.Create(Trunc(Coord.X / Rect.Size.X * Width),
          Trunc(Coord.Y / Rect.Size.Y * Height));
        Color := Canvas.Pixels[Pos.X, Pos.Y];
      end;
      Result := Color <> clWhite;
    end;
    msRounded: begin
      Rect := PixelRect;
      Center := Rect.Center;
      Result := Sqr(Coord.X - Center.X) / Sqr(Rect.Size.X div 2) +
        Sqr(Coord.Y - Center.Y) / Sqr(Rect.Size.Y div 2) > 1;
    end
    else Result := False;
  end;
end;

function TMap.IsCellsNeighbor(Cell1, Cell2: TCell): Boolean;
begin
  Result := Cell1.Neighbors.IndexOf(Cell2) <> -1;
end;

function TMap.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 TMap.Assign(Source: TMap);
//var
//  I: Integer;
begin
  // Do not assign Game field
  MaxPower := Source.MaxPower;
  Cyclic := Source.Cyclic;
  Size := Source.Size;
  DefaultCellSize := Source.DefaultCellSize;
  Shape := Source.Shape;
  Image.Picture.Bitmap.Assign(Source.Image.Picture.Bitmap);

  // TODO: How to copy cells
  {// Copy all cells
  Cells.Count := 0;
  Cells.Count := Source.Cells.Count;
  for I := 0 to Cells.Count - 1 do begin
    Cells[I] := TCell.Create;
    Cells[I].Map := Self;
    Cells[I].Assign(Source.Cells[I]);
  end;
  }
end;

function TMap.Compare(Map: TMap): Boolean;
begin
  Result := (MaxPower = Map.MaxPower) and
    (Cyclic = Map.Cyclic) and
    (Size = Map.Size) and
    (DefaultCellSize = Map.DefaultCellSize) and
    (Shape = Map.Shape) and
    Cells.Compare(Map.Cells);
end;

procedure TMap.LoadFromFile(FileName: string);
begin
end;

procedure TMap.SaveToFile(FileName: string);
begin
end;

procedure TMap.LoadFromNode(Node: TDOMNode);
var
  Node2: TDOMNode;
begin
  Size := TPoint.Create(ReadInteger(Node, 'SizeX', 0), ReadInteger(Node, 'SizeY', 0));
  DefaultCellSize.X := ReadInteger(Node, 'DefaultCellSizeX', 1);
  DefaultCellSize.Y := ReadInteger(Node, 'DefaultCellSizeY', 1);
  MaxPower := ReadInteger(Node, 'MaxPower', DefaultMaxPower);
  Cyclic := ReadBoolean(Node, 'Cyclic', False);
  Shape := TMapShape(ReadInteger(Node, 'Shape', Integer(msRectangle)));
  Node2 := Node.FindNode('Cells');
  if Assigned(Node2) then
    Cells.LoadFromNode(Node2);
  Node2 := Node.FindNode('CellLinks');
  if Assigned(Node2) then
    CellLinks.LoadFromNode(Node2);
  FPixelRect := CalculatePixelRect;
end;

procedure TMap.SaveToNode(Node: TDOMNode);
var
  NewNode: TDOMNode;
begin
  WriteInteger(Node, 'DefaultCellSizeX', DefaultCellSize.X);
  WriteInteger(Node, 'DefaultCellSizeY', DefaultCellSize.Y);
  WriteInteger(Node, 'MaxPower', MaxPower);
  WriteBoolean(Node, 'Cyclic', Cyclic);
  WriteInteger(Node, 'Shape', Integer(Shape));
  WriteInteger(Node, 'SizeX', Size.X);
  WriteInteger(Node, 'SizeY', Size.Y);
  NewNode := Node.OwnerDocument.CreateElement('Cells');
  Node.AppendChild(NewNode);
  Cells.SaveToNode(NewNode);
  NewNode := Node.OwnerDocument.CreateElement('CellLinks');
  Node.AppendChild(NewNode);
  CellLinks.SaveToNode(NewNode);
end;

function TMap.PosToCell(Pos: TPoint): TCell;
var
  I: Integer;
begin
  Result := nil;
  for I := 0 to Cells.Count - 1 do
  if Cells[I].Terrain <> ttVoid then begin
    if Cells[I].Polygon.IsPointInside(Pos) then begin
      Result := Cells[I];
      Exit;
    end;
  end;
end;

function TMap.CellToPos(Cell: TCell): TPoint;
begin
  Result := Cell.PosPx;
end;

procedure TMap.ComputePlayerStats;
var
  Cell: TCell;
begin
  for Cell in Cells do
  with Cell do begin
    if Assigned(Player) then
    with TPlayer(Player) do begin
      Inc(TotalCells);
      if Assigned(OneUnit) then
        Inc(TotalUnits, OneUnit.Power);
      if Assigned(Building) and Assigned(Building.Kind) and
      (Building.Kind.SpecialType = stCity) then
        Inc(TotalCities);
      if Extra = etObjectiveTarget then
        Inc(TotalWinObjectiveCells);
    end;
  end;
end;

procedure TMap.Generate;
var
  X, Y: Integer;
  NewCell: TCell;
begin
  Clear;

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

procedure TMap.MakeSymetric;
var
  C: Integer;
  I: Integer;
  CellLink: TCellLink;
  OtherCell1: TCell;
  OtherCell2: TCell;
  Cell: TCell;
  OppositeCell: TCell;
begin
  // Generic way to create two sides symetric map independent to shape
  // Set first half as inverted second half
  for C := 0 to (Cells.Count div 2) - 1 do begin
    Cell := Cells[C];
    OppositeCell := Cells[Cells.Count - 1 - C];

    Cell.Terrain := OppositeCell.Terrain;

    // Sync units
    if not Assigned(Cell.OneUnit) and Assigned(OppositeCell.OneUnit) then begin
      Cell.OneUnit := TGame(Game).Units.AddNew(OppositeCell.OneUnit.Kind,
        OppositeCell.OneUnit.Power);
    end;
    if Assigned(Cell.OneUnit) and Assigned(OppositeCell.OneUnit) then begin
      Cell.OneUnit.Kind := OppositeCell.OneUnit.Kind;
      Cell.OneUnit.Power := OppositeCell.OneUnit.Power;
    end;

    if Assigned(Cell.OneUnit) and not Assigned(OppositeCell.OneUnit) then begin
      TGame(Game).Units.Remove(Cell.OneUnit);
    end;

    for I := Cell.Links.Count - 1 downto 0 do begin
      CellLink := Cell.Links[I];

      // Remove cells on first half of the map
      if (Cells.IndexOf(CellLink.Cells[0]) <= (Cells.Count div 2)) and
      (Cells.IndexOf(CellLink.Cells[1]) <= (Cells.Count div 2)) then
      begin
        CellLinks.Remove(CellLink);
        Continue;
      end;

      // Make cross half links symetric
      if (Cells.IndexOf(CellLink.Cells[0]) <= (Cells.Count div 2)) and
      (Cells.IndexOf(CellLink.Cells[1]) >= (Cells.Count div 2)) then begin
        OtherCell1 := Cells[Cells.Count - 1 - Cells.IndexOf(CellLink.Cells[1])];
        OtherCell2 := CellLink.Cells[1];
        CellLinks.Remove(CellLink);
        if not Assigned(CellLinks.FindByCells(OtherCell1, OtherCell2)) then
          CellLinks.AddLink(OtherCell1, OtherCell2);
      end else
      if (Cells.IndexOf(CellLink.Cells[0]) >= (Cells.Count div 2)) and
      (Cells.IndexOf(CellLink.Cells[1]) <= (Cells.Count div 2)) then begin
        OtherCell1 := Cells[Cells.Count - 1 - Cells.IndexOf(CellLink.Cells[0])];
        OtherCell2 := CellLink.Cells[0];
        CellLinks.Remove(CellLink);
        if not Assigned(CellLinks.FindByCells(OtherCell1, OtherCell2)) then
          CellLinks.AddLink(OtherCell1, OtherCell2);
      end;
    end;
  end;

  for C := 0 to (Cells.Count div 2) - 1 do begin
    // Make copy of links from second half
    OppositeCell := Cells[Cells.Count - 1 - C];

    for CellLink in OppositeCell.Links do
      if (Cells.IndexOf(CellLink.Cells[0]) > (Cells.Count div 2)) and
      (Cells.IndexOf(CellLink.Cells[1]) > (Cells.Count div 2)) then begin
      OtherCell1 := Cells[Cells.Count - 1 - Cells.IndexOf(CellLink.Cells[0])];
      OtherCell2 := Cells[Cells.Count - 1 - Cells.IndexOf(CellLink.Cells[1])];
      if not Assigned(CellLinks.FindByCells(OtherCell1, OtherCell2)) then
        CellLinks.AddLink(OtherCell1, OtherCell2);
    end;
  end;
end;

procedure TMap.CreateLinks;
var
  LastAreaCount: Integer;
begin
  BuildMapAreas;
  LastAreaCount := -1;
  while (Areas.Count > 1) and (Areas.Count <> LastAreaCount) do begin
    LastAreaCount := Areas.Count;
    BuildBridges;
    BuildMapAreas;
  end;
end;

procedure TMap.Clear;
begin
  CellLinks.Clear;
  Cells.Clear;
  FNewCellId := 1;
  FPixelRect.SetEmpty;
end;

procedure TMap.CheckCells;
var
  I: Integer;
  J: Integer;
begin
  for I := 0 to Cells.Count - 1 do begin
    for J := I + 1 to Cells.Count - 1 do begin
      if (Cells[I].Id = Cells[J].Id) then
        raise Exception.Create('Duplicate cells ID ' + IntToStr(I) + ' ' + IntToStr(J));
      if (Cells[I].PosPx = Cells[J].PosPx) then
        raise Exception.Create('Duplicate cells position ' + IntToStr(I) + ' ' + IntToStr(J));
    end;
  end;
end;

function TMap.ToString: string;
begin
  Result := 'MaxPower: ' + IntToStr(MaxPower) + LineEnding;
  Result := Result + 'Cyclic: ' + BoolToStr(Cyclic) + LineEnding;
  Result := Result + 'Size: ' + IntToStr(Size.X) + 'x' + IntToStr(Size.Y) + LineEnding;
  Result := Result + 'DefaultCellSize: ' + IntToStr(DefaultCellSize.X) + 'x' + IntToStr(DefaultCellSize.Y) + LineEnding;
  Result := Result + 'Shape: ' + IntToStr(Integer(Shape)) + LineEnding;
  Result := Result + Cells.ToString + LineEnding;
end;

constructor TMap.Create;
begin
  MaxPower := DefaultMaxPower;
  DefaultCellSize := TPoint.Create(220, 220);
  Cells := TCells.Create;
  Cells.Map := Self;
  Size := TPoint.Create(0, 0);
  Image := TImage.Create(nil);
  CellLinks := TCellLinks.Create;
  CellLinks.Map := Self;
  Areas := TMapAreas.Create;
end;

destructor TMap.Destroy;
begin
  Size := TPoint.Create(0, 0);
  FreeAndNil(Areas);
  FreeAndNil(CellLinks);
  FreeAndNil(Image);
  FreeAndNil(Cells);
  inherited;
end;

function TMap.CalculatePixelRect: TRect;
var
  I: Integer;
  CellRect: TRect;
begin
  Result := TRect.Create(TPoint.Create(0, 0), TPoint.Create(0, 0));
  // This is generic algorithm to determine pixel size of entire map
  for I := 0 to Cells.Count - 1 do begin
    CellRect := Cells[I].Polygon.GetRect;
    if I = 0 then Result := CellRect
      else begin
        Result.P1 := TPoint.Min(Result.P1, CellRect.P1);
        Result.P2 := TPoint.Max(Result.P2, CellRect.P2);
      end;
  end;
end;

procedure TMap.ForEachCells(Method: TMethod);
begin
end;

function TMap.SearchDifferentCellArea(List: TCells; SourceArea, DestArea: TMapArea): TCell;
var
  NewList: TCells;
  NewListVoid: TCells;
  I: Integer;
  C: Integer;
begin
  Result := nil;
  NewList := TCells.Create;
  NewList.OwnsObjects := False;
  NewListVoid := TCells.Create;
  NewListVoid.OwnsObjects := False;

  for C := 0 to List.Count - 1 do
  with List[C] do begin
    for I := 0 to Neighbors.Count - 1 do
    with Neighbors[I] do
    if (not Mark) and (Terrain <> ttVoid) and (Area <> SourceArea) and ((DestArea = nil) or (DestArea = Area)) then begin
      NewList.Add(List[C].Neighbors[I]);
      Mark := True;
    end else
    if (not Mark) and (Terrain = ttVoid) then begin
      NewListVoid.Add(List[C].Neighbors[I]);
      Mark := True;
    end;
  end;

  if NewList.Count > 0 then begin
    // We found cell with different area
    Result := NewList[Random(NewList.Count)];
  end else
  if NewListVoid.Count > 0 then begin
    // Cell was not found but we have more void cells to check
    Result := SearchDifferentCellArea(NewListVoid, SourceArea, DestArea);
  end;

  FreeAndNil(NewListVoid);
  FreeAndNil(NewList);
end;

procedure TMap.BuildBridges;
var
  List: TCells;
  BorderList: TCells;
  Cell: TCell;
  FoundCell1: TCell;
  FoundCell2: TCell;
  I: Integer;
  J: Integer;
begin
  List := TCells.Create;
  List.OwnsObjects := False;

  BorderList := TCells.Create;
  BorderList.OwnsObjects := False;

  // Build area bridges
  if Areas.Count > 1 then
  for I := 0 to Areas.Count - 1 do
  with Areas[I] do begin
    GetBorderCells(BorderList);
    if BorderList.Count > 0 then
    for J := 0 to 4 do begin

    Cell := BorderList[Random(BorderList.Count)];
    List.Clear;
    List.Add(Cell);

    Map.Cells.ClearMark;

    // Find nearest cell with different area
    FoundCell1 := SearchDifferentCellArea(List, TMapArea(Map.Areas[I]), nil);
    if Assigned(FoundCell1) then begin
      // Again find back nearest cell with different area.
      // This will ensure that both cells are closest ones

      Map.Cells.ClearMark;
      List[0] := FoundCell1;
      FoundCell2 := SearchDifferentCellArea(List, FoundCell1.Area, TMapArea(Map.Areas[I]));
      if Assigned(FoundCell2) then begin
        // Check if link doesn't exist already
        if not Assigned(FoundCell1.Links.FindByCells(FoundCell1, FoundCell2)) then begin
          Map.CellLinks.AddLink(FoundCell1, FoundCell2);
          Inc(BridgeCount);
        end;
      end;
    end;
    end;
  end;
  FreeAndNil(List);
  FreeAndNil(BorderList);
end;

procedure TMap.BuildMapAreas;
var
  C: Integer;
  NewArea: TMapArea;
begin
  for C := 0 to Cells.Count - 1 do
  with Cells[C] do
    Area := nil;
  Areas.Clear;
  for C := 0 to Cells.Count - 1 do
  with Cells[C] do
  if (Terrain <> ttVoid) and (not Assigned(Area)) then begin
    NewArea := TMapArea.Create;
    NewArea.Id := Map.Areas.Count;
    NewArea.Map := Map;
    Areas.Add(NewArea);
    Area := NewArea;
    AreaExtend;
  end;
end;

{ TCell }

procedure TCell.SetUnit(AValue: TUnit);
var
  OldValue: TUnit;
begin
  if FUnit = AValue then Exit;
  OldValue := FUnit;
  FUnit := nil;
  if Assigned(OldValue) then OldValue.MapCell := nil;
  FUnit := AValue;
  if Assigned(FUnit) then FUnit.MapCell := Self;
end;

function TCell.Compare(Cell: TCell): Boolean;
begin
  Result := (Id = Cell.Id) and
    (PosPx = Cell.PosPx) and
    (Terrain = Cell.Terrain) and
    Polygon.Compare(Cell.Polygon) and
    (Player = Cell.Player) and
    (Mark = Cell.Mark) and
    (Extra = Cell.Extra);
end;

procedure TCell.ConnectTo(Cell: TCell);
begin
  if Cell = Self then
    raise Exception.Create('Can''t connect map cell to itself');
  // Connect only if already not connected
  if Neighbors.IndexOf(Cell) < 0 then begin
    Cell.Neighbors.Add(Self);
    Neighbors.Add(Cell);
  end;
end;

procedure TCell.DisconnectFrom(Cell: TCell);
var
  I: Integer;
begin
  I := Cell.Neighbors.IndexOf(Self);
  if I >= 0 then Cell.Neighbors.Delete(I) else
    raise Exception.Create('Can''t disconnect neigboring cells.');
  I := Neighbors.IndexOf(Cell);
  if I >= 0 then Neighbors.Delete(I)
    else Exception.Create('Can''t disconnect neigboring cells.');
end;

function TCell.NeighboringToVoid: Boolean;
var
  NeighVoidCount: Integer;
  NeighborCell: TCell;
begin
  NeighVoidCount := 0;
  for NeighborCell in Neighbors do
    if (NeighborCell.Terrain = ttVoid) then Inc(NeighVoidCount);
  Result := NeighVoidCount > 0;
end;

procedure TCell.SetArea(AValue: TMapArea);
begin
  if FArea = AValue then Exit;
  if Assigned(FArea) then FArea.Cells.Remove(Self);
  FArea := AValue;
  if Assigned(FArea) then FArea.Cells.Add(Self);
end;

procedure TCell.SetBuilding(AValue: TBuilding);
var
  OldValue: TBuilding;
begin
  if FBuilding = AValue then Exit;
  OldValue := FBuilding;
  FBuilding := nil;
  if Assigned(OldValue) then OldValue.MapCell := nil;
  FBuilding := AValue;
  if Assigned(FBuilding) then FBuilding.MapCell := Self;
end;

procedure TCell.SetId(AValue: Integer);
begin
  if FId = AValue then Exit;
  FId := AValue;
end;

procedure TCell.AreaExtend;
var
  NeighborCell: TCell;
begin
  for NeighborCell in Neighbors do
  if (NeighborCell.Terrain <> ttVoid) and (not Assigned(NeighborCell.Area)) then begin
    NeighborCell.Area := Area;
    NeighborCell.AreaExtend;
  end;
end;

procedure TCell.FixRefId;
var
  I: Integer;
  Cell: TCell;
begin
  if PlayerId <> 0 then begin
    Player := TGame(Map.Game).Players.FindById(PlayerId);
    if not Assigned(Player) then
      raise Exception.Create('Referenced player id ' + IntToStr(PlayerId) + ' not found.');
  end else Player := nil;

  if BuildingId <> 0 then begin
    Building := TGame(Map.Game).Buildings.FindById(BuildingId);
    if not Assigned(Building) then
      raise Exception.Create('Referenced building id ' + IntToStr(BuildingId) + ' not found.');
  end else Building := nil;

  if OneUnitId <> 0 then begin
    OneUnit := TGame(Map.Game).Units.FindById(OneUnitId);
    if not Assigned(OneUnit) then
      raise Exception.Create('Referenced unit id ' + IntToStr(OneUnitId) + ' not found.');
  end else OneUnit := nil;

  Neighbors.Count := Length(NeighborsId);
  for I := 0 to Length(NeighborsId) - 1 do
    Neighbors[I] := nil;
  for I := 0 to Length(NeighborsId) - 1 do begin
    Cell := Map.Cells.FindById(NeighborsId[I]);
    if not Assigned(Cell) then
      raise Exception.Create('Neighbor cell id not found ' + IntToStr(NeighborsId[I]));
    if Neighbors.IndexOf(Cell) <> -1 then
      raise Exception.Create('Duplicate neighbor cell ' + IntToStr(NeighborsId[I]) + ' found for cell ' + IntToStr(Id));
    Neighbors[I] := Cell;
  end;
end;

procedure TCell.LoadFromNode(Node: TDOMNode);
var
  Node2: TDOMNode;
  Node3: TDOMNode;
begin
  Id := ReadInteger(Node, 'Id', 0);
  OneUnitId := ReadInteger(Node, 'Unit', 0);
  Terrain := TTerrainType(ReadInteger(Node, 'Terrain', Integer(ttVoid)));
  Extra := TExtraType(ReadInteger(Node, 'Extra', Integer(etNone)));
  PosPx.X := ReadInteger(Node, 'PosX', 0);
  PosPx.Y := ReadInteger(Node, 'PosY', 0);
  PlayerId := ReadInteger(Node, 'Player', 0);
  BuildingId := ReadInteger(Node, 'Building', 0);

  Node3 := Node.FindNode('Neighbours');
  if Assigned(Node3) then begin
    SetLength(NeighborsId, 0);
    Node2 := Node3.FirstChild;
    while Assigned(Node2) and (Node2.NodeName = 'Neighbour') do begin
      SetLength(NeighborsId, Length(NeighborsId) + 1);
      NeighborsId[High(NeighborsId)] := ReadInteger(Node2, 'Id', 0);
      Node2 := Node2.NextSibling;
    end;
  end;

  Node3 := Node.FindNode('Polygon');
  if Assigned(Node3) then begin
    Polygon.Clear;
    Node2 := Node3.FirstChild;
    while Assigned(Node2) and (Node2.NodeName = 'Point') do begin
      Polygon.AddPoint(TPoint.Create(ReadInteger(Node2, 'X', 0), ReadInteger(Node2, 'Y', 0)));
      Node2 := Node2.NextSibling;
    end;
  end;
end;

procedure TCell.SaveToNode(Node: TDOMNode);
var
  NewNode: TDOMNode;
  NewNode2: TDOMNode;
  I: Integer;
begin
  WriteInteger(Node, 'Id', Id);
  if Assigned(OneUnit) then
    WriteInteger(Node, 'Unit', OneUnit.Id)
    else WriteInteger(Node, 'Unit', 0);
  WriteInteger(Node, 'Terrain', Integer(Terrain));
  WriteInteger(Node, 'Extra', Integer(Extra));
  WriteInteger(Node, 'PosX', PosPx.X);
  WriteInteger(Node, 'PosY', PosPx.Y);
  if Assigned(Player) then
    WriteInteger(Node, 'Player', TPlayer(Player).Id)
    else WriteInteger(Node, 'Player', 0);
  if Assigned(Building) then
    WriteInteger(Node, 'Building', Building.Id)
    else WriteInteger(Node, 'Building', 0);
  NewNode := Node.OwnerDocument.CreateElement('Neighbours');
  Node.AppendChild(NewNode);
  for I := 0 to Neighbors.Count - 1 do begin
    NewNode2 := NewNode.OwnerDocument.CreateElement('Neighbour');
    NewNode.AppendChild(NewNode2);
    WriteInteger(NewNode2, 'Id', Neighbors[I].Id);
  end;
  NewNode := Node.OwnerDocument.CreateElement('Polygon');
  Node.AppendChild(NewNode);
  for I := 0 to Length(Polygon.Points) - 1 do begin
    NewNode2 := NewNode.OwnerDocument.CreateElement('Point');
    NewNode.AppendChild(NewNode2);
    WriteInteger(NewNode2, 'X', Polygon.Points[I].X);
    WriteInteger(NewNode2, 'Y', Polygon.Points[I].Y);
  end;
end;

procedure TCell.Assign(Source: TCell);
begin
  Id := Source.Id;
  PosPx := Source.PosPx;
  Terrain := Source.Terrain;
  Polygon := Source.Polygon;
  Player := Source.Player;
  Mark := Source.Mark;
  Extra := Source.Extra;
  // TODO: How to copy neighbours and moves list
end;

function TCell.GetColor: TColor;
begin
  if Assigned(Player) then Result := TPlayer(Player).Color
    else Result := clGray;
end;

function TCell.ToString: ansistring;
begin
  Result := 'Id: ' + IntToStr(Id) + LineEnding;
  Result := Result + 'PosPx: ' + IntToStr(PosPx.X) + 'x' + IntToStr(PosPx.Y) + LineEnding;
  Result := Result + 'Terrain: ' + IntToStr(Integer(Terrain)) + LineEnding;
  Result := Result + 'Extra: ' + IntToStr(Integer(Extra)) + LineEnding;
  //Result := Result + 'Polygon: ' + IntToStr(Polygon) + LineEnding;
  if Assigned(Player) then
    Result := Result + 'Player: ' + IntToStr(TPlayer(Player).Id) + LineEnding;
  Result := Result + 'Mark:' + BoolToStr(Mark) + LineEnding;
  if Assigned(OneUnit) then
    Result := Result + 'OneUnit:' + IntToStr(OneUnit.Id) + LineEnding;
end;

procedure TCell.CheckOwnership;
begin
  if TGame(Map.Game).GameSystem.EmptyCellsNeutral then
  if Assigned(Player) and  (Assigned(OneUnit) and (OneUnit.Power = 0)) or
    not Assigned(OneUnit) then
      Player := nil;
end;

constructor TCell.Create;
begin
  FId := -1;
  Player := nil;
  Neighbors := TCells.Create;
  Neighbors.OwnsObjects := False;
  Links := TCellLinks.Create;
  Links.OwnsObjects := False;
end;

destructor TCell.Destroy;
var
  I: Integer;
begin
  OneUnit := nil;
  for I := Links.Count - 1 downto 0 do
    FMap.CellLinks.Remove(Links[I]);
  FreeAndNil(Links);
  for I := Neighbors.Count - 1 downto 0 do
    if Neighbors[I].Neighbors.Remove(Self) = -1 then
      raise Exception.Create(SCellRemoveNeighborError);
  FreeAndNil(Neighbors);
  inherited;
end;

end.