source: branches/delphi/UGame.pas

unit UGame;

interface

uses
  Classes, SysUtils, ExtCtrls, Graphics, Contnrs, Math, Types;

const
  DefaultPlayerStartUnits = 5;
  HexCellMulX = 1.12;
  HexCellMulY = 1.292;
  SquareCellMulX = 1.1;
  SquareCellMulY = 1.1;
  MaxPlayerCount = 8;

type
  TGame = class;
  TPlayer = class;

  TFloatPoint = record
    X, Y: Double;
  end;

  TPointArray = array of TPoint;

  TTerrainType = (ttVoid, ttNormal, ttCity);

  { TCell }

  TCell = class
  private
    FPower: Integer;
    procedure SetPower(AValue: Integer);
  public
    Pos: TPoint;
    Terrain: TTerrainType;
    Player: TPlayer;
    MovesFrom: TObjectList;
    MovesTo: TObjectList;
    function GetColor: TColor;
    function GetAvialPower: Integer;
    constructor Create;
    destructor Destroy; override;
    property Power: Integer read FPower write SetPower;
  end;

  TCellArray = array of TCell;

  { TView }

  TView = class
  private
    FDestRect: TRect;
    FZoom: Double;
    procedure SetDestRect(AValue: TRect);
    procedure SetZoom(AValue: Double);
  public
    Game: TGame;
    SourceRect: TRect;
    FocusedCell: TCell;
    SelectedCell: TCell;
    procedure Clear;
    constructor Create;
    destructor Destroy; override;
    procedure SelectCell(Pos: TPoint; Player: TPlayer);
    procedure CenterMap;
    function CanvasToCellPos(Pos: TPoint): TPoint;
    function CellToCanvasPos(Pos: TPoint): TPoint;
    function CanvasToCellRect(Pos: TRect): TRect;
    function CellToCanvasRect(Pos: TRect): TRect;
    procedure Assign(Source: TView);
    property DestRect: TRect read FDestRect write SetDestRect;
    property Zoom: Double read FZoom write SetZoom;
  end;

  { TMap }

  TMap = class
  private
    function GetSize: TPoint; virtual;
    procedure SetSize(AValue: TPoint); virtual;
  public
    Game: TGame;
    MaxPower: Integer;
    DefaultCellSize: TPoint;
    procedure DrawArrow(Canvas: TCanvas; View: TView; Pos: TPoint; Angle: Double; Size: TPoint);
    function IsCellsNeighbor(Cell1, Cell2: TCell): Boolean; virtual;
    function IsValidIndex(Index: TPoint): Boolean; virtual;
    procedure Assign(Source: TMap); virtual;
    procedure LoadFromFile(FileName: string); virtual;
    procedure SaveToFile(FileName: string); virtual;
    function PosToCell(Pos: TPoint; View: TView): TCell; virtual;
    function CellToPos(Cell: TCell): TPoint; virtual;
    procedure Grow(APlayer: TPlayer); virtual;
    procedure ComputePlayerStats; virtual;
    constructor Create; virtual;
    destructor Destroy; override;
    function GetCellNeighbours(Cell: TCell): TCellArray; virtual;
    procedure Paint(Canvas: TCanvas; View: TView); virtual;
    function GetPixelRect: TRect; virtual;
    function GetAllCells: TCellArray; virtual;
    procedure ForEachCells(Method: TMethod); virtual;
    property Size: TPoint read GetSize write SetSize;
  end;

  { THexMap }

  THexMap = class(TMap)
  private
    FSize: TPoint;
    function GetSize: TPoint; override;
    procedure SetSize(AValue: TPoint); override;
  public
    Cells: array of array of TCell;
    function IsCellsNeighbor(Cell1, Cell2: TCell): Boolean; override;
    procedure Assign(Source: TMap); virtual;
    function IsValidIndex(Index: TPoint): Boolean; override;
    function GetCellNeighbours(Cell: TCell): TCellArray; override;
    function PosToCell(Pos: TPoint; View: TView): TCell; override;
    function CellToPos(Cell: TCell): TPoint; override;
    function GetHexagonPolygon(Pos: TPoint; HexSize: TPoint): TPointArray;
    procedure Paint(Canvas: TCanvas; View: TView); override;
    constructor Create; override;
    destructor Destroy; override;
    function GetAllCells: TCellArray; override;
    function GetPixelRect: TRect; override;
  end;

  { TSquareMap }

  TSquareMap = class(TMap)
  private
    FSize: TPoint;
    function GetSize: TPoint; override;
    procedure SetSize(AValue: TPoint); override;
  public
    Cells: array of array of TCell;
    function IsCellsNeighbor(Cell1, Cell2: TCell): Boolean; override;
    function IsValidIndex(Index: TPoint): Boolean; override;
    function PosToCell(Pos: TPoint; View: TView): TCell; override;
    function CellToPos(Cell: TCell): TPoint; override;
    function GetCellNeighbours(Cell: TCell): TCellArray; override;
    function GetAllCells: TCellArray; override;
    function GetPixelRect: TRect; override;
    procedure Paint(Canvas: TCanvas; View: TView); override;
    constructor Create; override;
    destructor Destroy; override;
    property Size: TPoint read FSize write SetSize;
  end;

  TPlayerMode = (pmHuman, pmComputer);

  { TPlayer }

  TPlayer = class
  private
    FGame: TGame;
    procedure SetGame(AValue: TGame);
  public
    Name: string;
    Color: TColor;
    View: TView;
    Mode: TPlayerMode;
    TotalUnits: Integer;
    TotalCells: Integer;
    StartUnits: Integer;
    procedure ComputerTurn;
    procedure Paint(PaintBox: TPaintBox);
    constructor Create;
    destructor Destroy; override;
    procedure Assign(Source: TPlayer);
    property Game: TGame read FGame write SetGame;
  end;

  TPlayerArray = array of TPlayer;

  TPlayers = class(TObjectList)

  end;

  { TMove }

  TMove = class
  private
    FCellFrom: TCell;
    FCellTo: TCell;
    FDestroying: Boolean;
    procedure SetCellFrom(AValue: TCell);
    procedure SetCellTo(AValue: TCell);
  public
    List: TObjectList; // TList<TMove>
    CountOnce: Integer;
    CountRepeat: Integer;
    constructor Create;
    destructor Destroy; override;
    property CellFrom: TCell read FCellFrom write SetCellFrom;
    property CellTo: TCell read FCellTo write SetCellTo;
  end;

  { TGame }

  TMoveEvent = procedure(CellFrom, CellTo: TCell; var CountOnce, CountRepeat: Integer;
    Update: Boolean; var Confirm: Boolean) of object;
  TWinEvent = procedure(Player: TPlayer) of object;
  TGrowAmount = (gaByOne, gaBySquareRoot);
  TGrowCells = (gcNone, gcPlayerCities, gcPlayerAll);
  TMapType = (mtNone, mtHexagon, mtSquare);

  TGame = class
  private
    FMapType: TMapType;
    FOnMove: TMoveEvent;
    FOnWin: TWinEvent;
    FRunning: Boolean;
    procedure Attack(var AttackPower, DefendPower: Integer);
    procedure MoveAll(Player: TPlayer);
    procedure ClearMovesFromCell(Cell: TCell);
    procedure SetMapType(AValue: TMapType);
    procedure SetMove(CellFrom, CellTo: TCell; Power: Integer);
    procedure SetRunning(AValue: Boolean);
    procedure UpdateRepeatMoves(Player: TPlayer);
  public
    Players: TPlayers;
    Map: TMap;
    VoidEnabled: Boolean;
    VoidPercentage: Integer;
    GrowCells: TGrowCells;
    GrowAmount: TGrowAmount;
    CityEnabled: Boolean;
    CityPercentage: Integer;
    CurrentPlayer: TPlayer;
    Moves: TObjectList; // TList<TMove>
    TurnCounter: Integer;
    procedure ComputePlayerStats;
    function GetAlivePlayers: TPlayerArray;
    procedure NextTurn;
    constructor Create;
    destructor Destroy; override;
    procedure New;
    property Running: Boolean read FRunning write SetRunning;
    property MapType: TMapType read FMapType write SetMapType;
  published
    property OnMove: TMoveEvent read FOnMove write FOnMove;
    property OnWin: TWinEvent read FOnWin write FOnWin;
  end;

var
  PlayerModeText: array[TPlayerMode] of string;

const
  clOrange = $009Aff;
  PlayerColors: array[0..7] of TColor = (clBlue, clRed, clGreen, clOrange,
    clPurple, clMaroon, clAqua, clFuchsia);

procedure InitStrings;
function FloatPoint(AX, AY: Double): TFloatPoint;


implementation

resourcestring
  SMinimumPlayers = 'You need at least two players';
  SHuman = 'Human';
  SComputer = 'Computer';
  SCannotSetPlayerStartCells = 'Cannot choose start cell for player';
  SUnfinishedBattle = 'Unfinished battle';

procedure InitStrings;
begin
  PlayerModeText[pmHuman] := SHuman;
  PlayerModeText[pmComputer] := SComputer;
end;

function FloatPoint(AX, AY: Double): TFloatPoint;
begin
  Result.X := AX;
  Result.Y := AY;
end;

function RectEquals(A, B: TRect): Boolean;
begin
  Result := (A.Left = B.Left) and (A.Top = B.Top) and
    (A.Right = B.Right) and (A.Bottom = B.Bottom);
end;

function PtInRect(const Rect: TRect; Pos: TPoint): Boolean;
begin
  Result := (Pos.X >= Rect.Left) and (Pos.Y >= Rect.Top) and
    (Pos.X <= Rect.Right) and (Pos.Y <= Rect.Bottom);
end;

function PtInPoly(const Points: array of TPoint; Pos: TPoint): Boolean;
var
  Count, K, J : Integer;
begin
  Result := False;
  Count := Length(Points) ;
  J := Count - 1;
  for K := 0 to Count - 1 do begin
  if ((Points[K].Y <= Pos.Y) and (Pos.Y < Points[J].Y)) or
    ((Points[J].Y <= Pos.Y) and (Pos.Y < Points[K].Y)) then
    begin
    if (Pos.X < (Points[j].X - Points[K].X) *
       (Pos.Y - Points[K].Y) /
       (Points[j].Y - Points[K].Y) + Points[K].X) then
        Result := not Result;
    end;
    J := K;
  end;
end;

{ TSquareMap }

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

procedure TSquareMap.SetSize(AValue: TPoint);
var
  X, Y: Integer;
  NewCell: TCell;
  C: Integer;
begin
  if (FSize.X <> AValue.X) or (FSize.Y <> AValue.Y) then begin
    // Free previous
    for Y := 0 to FSize.Y - 1 do
    for X := 0 to FSize.X - 1 do begin
      TCell(Cells[Y, X]).Destroy;
    end;
    FSize := AValue;
    // Allocate and init new
    SetLength(Cells, FSize.Y, FSize.X);
    for Y := 0 to FSize.Y - 1 do
    for X := 0 to FSize.X - 1 do begin
      NewCell := TCell.Create;
      NewCell.Pos := Point(X, Y);
      Cells[Y, X] := NewCell;
    end;
  end;
end;

function TSquareMap.IsCellsNeighbor(Cell1, Cell2: TCell): Boolean;
var
  DX: Integer;
  DY: Integer;
  MinY: Integer;
begin
  if Cell1.Pos.Y < Cell2.Pos.Y then MinY:= Cell1.Pos.Y
    else MinY := Cell2.Pos.Y;
  DX := Cell2.Pos.X - Cell1.Pos.X;
  DY := Cell2.Pos.Y - Cell1.Pos.Y;
  Result := (Abs(DX) <= 1) and (Abs(DY) <= 1);
  Result := Result and not (Cell1 = Cell2);
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.PosToCell(Pos: TPoint; View: TView): TCell;
var
  CX, CY: Integer;
  X, Y: Double;
  HexSize: TFloatPoint;
  CellSize: TFloatPoint;
  Frame: TRect;
begin
  // TODO: This is implemented as simple sequence lookup. Needs some faster algorithm
  Result := nil;
  CellSize := FloatPoint(DefaultCellSize.X * SquareCellMulX, DefaultCellSize.Y * SquareCellMulX);
  HexSize := FloatPoint(DefaultCellSize.X, DefaultCellSize.Y);
  with View do
    for CY := Trunc(SourceRect.Top / CellSize.Y) to Trunc(SourceRect.Bottom / CellSize.Y) + 1 do
    for CX := Trunc(SourceRect.Left / CellSize.X) to Trunc(SourceRect.Right / CellSize.X) + 1 do begin
      X := CX;
      Y := CY;
      if (CX >= 0) and (CY >= 0) and (CY < Size.Y) and (CX < Size.X) then
      if Cells[CY, CX].Terrain <> ttVoid then begin
        Frame := Rect(Trunc(X * CellSize.X - HexSize.X / 2),
          Trunc(Y * CellSize.Y - HexSize.Y / 2),
          Trunc(X * CellSize.X + HexSize.X / 2),
          Trunc(Y * CellSize.Y + HexSize.Y / 2));
        if PtInRect(Frame, Pos) then begin
          Result := Cells[CY, CX];
          Exit;
        end;
      end;
    end;
end;

function TSquareMap.CellToPos(Cell: TCell): TPoint;
var
  CX, CY: Integer;
  X, Y: Double;
  HexSize: TFloatPoint;
  CellSize: TFloatPoint;
  Points: array of TPoint;
begin
  CellSize := FloatPoint(DefaultCellSize.X * SquareCellMulX, DefaultCellSize.Y * SquareCellMulX);
  HexSize := FloatPoint(DefaultCellSize.X, DefaultCellSize.Y);
  X := Cell.Pos.X;
  Y := Cell.Pos.Y;

  Result.X := Trunc(X * CellSize.X);
  Result.Y := Trunc(Y * CellSize.Y);
end;

function TSquareMap.GetCellNeighbours(Cell: TCell): TCellArray;
var
  X, Y: Integer;
begin
  SetLength(Result, 0);
  for Y := -1 to 1 do
  for X := -1 to 1 do
  if IsValidIndex(Point(Cell.Pos.X + X, Cell.Pos.Y + Y)) and
  IsCellsNeighbor(Cell, Cells[Cell.Pos.Y + Y, Cell.Pos.X + X]) then begin
    SetLength(Result, Length(Result) + 1);
    Result[Length(Result) - 1] := Cells[Cell.Pos.Y + Y, Cell.Pos.X + X];
  end;
end;

function TSquareMap.GetAllCells: TCellArray;
var
  X: Integer;
  Y: Integer;
  I: Integer;
begin
  SetLength(Result, Size.Y * Size.X);
  for Y := 0 to Size.Y - 1 do
  for X := 0 to Size.X - 1 do
    Result[Y * Size.X + X] := Cells[Y, X];
end;

function TSquareMap.GetPixelRect: TRect;
begin
  Result := Bounds(Trunc(-0.5 * DefaultCellSize.X),
    Trunc(-0.5 * DefaultCellSize.Y),
    Trunc((Size.X + 0.5) * DefaultCellSize.X),
    Trunc(((Size.Y + 0.5) * 0.78) * DefaultCellSize.Y));
end;

procedure TSquareMap.Paint(Canvas: TCanvas; View: TView);
var
  CX, CY: Integer;
  X, Y: Double;
  CellSizeZoomed: TFloatPoint;
  CellSize: TFloatPoint;
  HexSize: TFloatPoint;
  I: Integer;
  Points: array of TPoint;
  Cell: TCell;
  PosFrom, PosTo: TPoint;
  Angle: Double;

procedure PaintHexagon(Pos: TPoint; Text: string);
begin
  with Canvas do begin
    if Assigned(View.FocusedCell) and (View.FocusedCell = TCell(Cells[CY, CX])) then begin
      Pen.Color := clYellow;
      Pen.Style := psSolid;
      Pen.Width := 1;
    end else
    if TCell(Cells[CY, CX]).Terrain = ttCity then begin
      // Cannot set clear border as it will display shifted on gtk2
      //Pen.Style := psClear;
      Pen.Color := clBlack;
      Pen.Style := psSolid;
      Pen.Width := 3;
    end else begin
      // Cannot set clear border as it will display shifted on gtk2
      //Pen.Style := psClear;
      Pen.Color := Brush.Color;
      Pen.Style := psSolid;
      Pen.Width := 0;
    end;
    Rectangle(Trunc(Pos.X - HexSize.X / 2), Trunc(Pos.Y - HexSize.Y / 2), Trunc(Pos.X + HexSize.X / 2), Trunc(Pos.Y + HexSize.Y / 2));
    //Rectangle(Trunc(Pos.X), Trunc(Pos.Y), Trunc(Pos.X + HexSize.X), Trunc(Pos.Y + HexSize.Y));
    Pen.Style := psSolid;
    Font.Color := clWhite;
    Font.Size := Trunc(12 * View.Zoom);
    TextOut(Round(Pos.X) - TextWidth(Text) div 2, Round(Pos.Y) - TextHeight(Text) div 2, Text);
  end;
end;

begin
  CellSize := FloatPoint(DefaultCellSize.X * SquareCellMulX, DefaultCellSize.Y * SquareCellMulY);
  HexSize := FloatPoint(DefaultCellSize.X * View.Zoom, DefaultCellSize.Y * View.Zoom);
  CellSizeZoomed := FloatPoint(CellSize.X * View.Zoom, CellSize.Y * View.Zoom);
  with Canvas, View do try
    Lock;
    for CY := Trunc(SourceRect.Top / CellSize.Y) to Trunc(SourceRect.Bottom / CellSize.Y) + 1 do
    for CX := Trunc(SourceRect.Left / CellSize.X) to Trunc(SourceRect.Right / CellSize.X) + 1 do begin
      X := CX;
      Y := CY;
      if (CX >= 0) and (CY >= 0) and (CY < Size.Y) and (CX < Size.X) then begin
        Cell := Cells[CY, CX];
        if Cell.Terrain <> ttVoid then begin
          if Assigned(SelectedCell) and (SelectedCell = TCell(Cells[CY, CX])) then Brush.Color := clGreen
            else if Assigned(SelectedCell) and IsCellsNeighbor(SelectedCell, TCell(Cells[CY, CX])) then Brush.Color := clPurple
            else Brush.Color := Cell.GetColor;
          Pen.Color := clBlack;
          PaintHexagon(View.CellToCanvasPos(Point(Trunc(X * CellSize.X),
            Trunc(Y * CellSize.Y))),
            IntToStr(Cell.GetAvialPower));
          // Draw arrows
          Pen.Color := clCream;
          for I := 0 to Cell.MovesFrom.Count - 1 do begin
            PosFrom := CellToPos(Cell);
            PosTo := CellToPos(TMove(Cell.MovesFrom[I]).CellTo);
            if TMove(Cell.MovesFrom[I]).CountRepeat > 0 then Pen.Width := 2
              else Pen.Width := 1;
            Angle := ArcTan((PosTo.Y - PosFrom.Y) / (PosTo.X - PosFrom.X));
            if Sign(PosTo.X - PosFrom.X) = -1 then Angle := Angle + Pi;
            DrawArrow(Canvas, View, View.CellToCanvasPos(Point(Trunc(PosFrom.X + (PosTo.X - PosFrom.X) / 3),
              Trunc(PosFrom.Y + (PosTo.Y - PosFrom.Y) / 3))),
              Angle, Point(Trunc(HexSize.X / 4), Trunc(HexSize.Y / 4)));
            Pen.Width := 1;
          end;
        end;
      end;
    end;
  finally
    Unlock;
  end;
end;

constructor TSquareMap.Create;
begin
  inherited;
end;

destructor TSquareMap.Destroy;
begin
  inherited Destroy;
end;

{ TMap }

function TMap.GetSize: TPoint;
begin
  Result:= Point(0, 0);
end;

procedure TMap.SetSize(AValue: TPoint);
begin

end;

procedure TMap.DrawArrow(Canvas: TCanvas; View: TView; Pos: TPoint; Angle: Double; Size: TPoint);
var
  Points: array of TPoint;
  FPoints: array of TFloatPoint;
  I: Integer;
begin
  Canvas.Brush.Color := clWhite;
  Canvas.Pen.Color := clBlack;
  SetLength(Points, 8);
  SetLength(FPoints, 8);
  FPoints[0] := FloatPoint(+0.5 * Size.X, +0 * Size.Y);
  FPoints[1] := FloatPoint(+0 * Size.X, +0.5 * Size.Y);
  FPoints[2] := FloatPoint(+0 * Size.X, +0.25 * Size.Y);
  FPoints[3] := FloatPoint(-0.5 * Size.X, +0.25 * Size.Y);
  FPoints[4] := FloatPoint(-0.5 * Size.X, -0.25 * Size.Y);
  FPoints[5] := FloatPoint(+0 * Size.X, -0.25 * Size.Y);
  FPoints[6] := FloatPoint(+0 * Size.X, -0.5 * Size.Y);
  FPoints[7] := FloatPoint(+0.5 * Size.X, 0 * Size.Y);
  // Rotate
  for I := 0 to Length(Points) - 1 do
    FPoints[I] := FloatPoint(FPoints[I].X * cos(Angle) - FPoints[I].Y * sin(Angle),
      FPoints[I].X * sin(Angle) + FPoints[I].Y * cos(Angle));
  // Shift
  for I := 0 to Length(Points) - 1 do
    Points[I] := Point(Trunc(FPoints[I].X + Pos.X), Trunc(FPoints[I].Y + Pos.Y));
  Canvas.Polygon(Points);
end;

function TMap.IsCellsNeighbor(Cell1, Cell2: TCell): Boolean;
begin
  Result := False;
end;

function TMap.IsValidIndex(Index: TPoint): Boolean;
begin
  Result := False;
end;

procedure TMap.Assign(Source: TMap);
begin
  MaxPower := Source.MaxPower;
  Game := Source.Game;
  Size := Source.Size;
  DefaultCellSize := Source.DefaultCellSize;
end;

procedure TMap.LoadFromFile(FileName: string);
begin

end;

procedure TMap.SaveToFile(FileName: string);
begin

end;

function TMap.PosToCell(Pos: TPoint; View: TView): TCell;
begin
  Result := nil;
end;

function TMap.CellToPos(Cell: TCell): TPoint;
begin
  Result := Point(0, 0);
end;

procedure TMap.Grow(APlayer: TPlayer);
var
  I: Integer;
  Addition: Integer;
  Cells: TCellArray;
begin
  Cells := GetAllCells;
  for I := 0 to Length(Cells) - 1 do
  with TCell(Cells[I]) do begin
    if (Player = APlayer) and ((Game.GrowCells = gcPlayerAll) or
    ((Game.GrowCells = gcPlayerCities) and (Terrain = ttCity))) then begin
      if Game.GrowAmount = gaByOne then Addition := 1
        else if Game.GrowAmount = gaBySquareRoot then begin
          Addition := Trunc(Sqrt(Power));
          if Addition = 0 then Addition := 1;
        end;
      Power := Power + Addition;
      if Power > MaxPower then Power := MaxPower;
    end;
  end;
end;

procedure TMap.ComputePlayerStats;
var
  Cells: TCellArray;
  I: Integer;
begin
  Cells := GetAllCells;
  for I := 0 to Length(Cells) - 1 do
  with Cells[I] do begin
    if Assigned(Player) then begin
      Player.TotalCells := Player.TotalCells + 1;
      Player.TotalUnits := Player.TotalUnits + Power;
    end;
  end;
end;

constructor TMap.Create;
begin
  MaxPower := 99;
  DefaultCellSize := Point(62, 62);
end;

destructor TMap.Destroy;
begin
  Size := Point(0, 0);
  inherited Destroy;
end;

function TMap.GetCellNeighbours(Cell: TCell): TCellArray;
begin

end;

procedure TMap.Paint(Canvas: TCanvas; View: TView);
begin

end;

function TMap.GetPixelRect: TRect;
var
  Cells: TCellArray;
  I: Integer;
  CellPos: TPoint;
begin
  Result := Rect(0, 0, 0, 0);
  // This is generic iterative algorithm to determine map pixel size
  Cells := GetAllCells;
  for I := 0 to Length(Cells) - 1 do begin
    CellPos := CellToPos(Cells[I]);
    if I = 0 then Result := Rect(CellPos.X, CellPos.Y, CellPos.X, CellPos.Y)
      else begin
        if CellPos.X > Result.Right then Result.Right := CellPos.X;
        if CellPos.Y > Result.Bottom then Result.Bottom := CellPos.Y;
        if CellPos.X < Result.Left then Result.Left := CellPos.X;
        if CellPos.Y < Result.Top then  Result.Top := CellPos.Y;
      end;
  end;
end;


function TMap.GetAllCells: TCellArray;
begin

end;

procedure TMap.ForEachCells(Method: TMethod);
begin

end;

{ TMove }

procedure TMove.SetCellFrom(AValue: TCell);
begin
  if FCellFrom = AValue then Exit;
  if Assigned(AValue) and not Assigned(FCellFrom) then begin
    AValue.MovesFrom.Add(Self);
  end else
  if not Assigned(AValue) and Assigned(FCellFrom) then begin
    FCellFrom.MovesFrom.Remove(Self);
  end;
  FCellFrom := AValue;
end;

procedure TMove.SetCellTo(AValue: TCell);
begin
  if FCellTo = AValue then Exit;
  if Assigned(AValue) and not Assigned(FCellTo) then begin
    AValue.MovesTo.Add(Self);
  end else
  if not Assigned(AValue) and Assigned(FCellTo) then begin
    FCellTo.MovesTo.Remove(Self);
  end;
  FCellTo := AValue;
end;

constructor TMove.Create;
begin
  FCellFrom := nil;
  FCellTo := nil;
end;

destructor TMove.Destroy;
var
  LastState: Boolean;
begin
  CellFrom := nil;
  CellTo := nil;
  if Assigned(List) then begin
    // To remove itself from list we need disable owning to not be called twice
    try
      LastState := List.OwnsObjects;
      List.OwnsObjects := False;
      List.Remove(Self);
    finally
      List.OwnsObjects := LastState;
    end;
  end;
  inherited Destroy;
end;

{ TView }

procedure TView.SetZoom(AValue: Double);
var
  OldSourceRect: TRect;
begin
  if FZoom = AValue then Exit;
  FZoom := AValue;
  SourceRect := Bounds(Trunc(SourceRect.Left + (SourceRect.Right - SourceRect.Left) div 2 - (DestRect.Right - DestRect.Left) / Zoom / 2),
    Trunc(SourceRect.Top +  (SourceRect.Bottom - SourceRect.Top) div 2 - (DestRect.Bottom - DestRect.Top) / Zoom / 2),
    Trunc((DestRect.Right - DestRect.Left) / Zoom),
    Trunc((DestRect.Bottom - DestRect.Top) / Zoom));
end;

procedure TView.Clear;
begin
  FocusedCell := nil;
  SelectedCell := nil;
end;

procedure TView.SetDestRect(AValue: TRect);
var
  Diff: TPoint;
begin
  if RectEquals(FDestRect, AValue) then Exit;
  Diff := Point(Trunc((DestRect.Right - DestRect.Left) / Zoom - (AValue.Right - AValue.Left) / Zoom) div 2,
    Trunc((DestRect.Bottom - DestRect.Top) / Zoom - (AValue.Bottom - AValue.Top) / Zoom) div 2);
  FDestRect := AValue;
  SourceRect := Bounds(SourceRect.Left + Diff.X, SourceRect.Top + Diff.Y,
    Trunc((DestRect.Right - DestRect.Left) / Zoom),
    Trunc((DestRect.Bottom - DestRect.Top) / Zoom));
end;

constructor TView.Create;
begin
  Zoom := 1.5;
  Clear;
end;

destructor TView.Destroy;
begin
  inherited Destroy;
end;

{ TCell }

procedure TCell.SetPower(AValue: Integer);
begin
  if FPower = AValue then Exit;
  if AValue < 0 then
    raise Exception.Create('Not allowed to substract power under zero do negative value');
  FPower := AValue;
end;

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

function TCell.GetAvialPower: Integer;
var
  I: Integer;
begin
  Result := Power;
  for I := 0 to MovesFrom.Count - 1 do
    Result := Result - TMove(MovesFrom[I]).CountOnce;
  if Result < 0 then Result := 0;
end;

constructor TCell.Create;
begin
  Player := nil;
  MovesFrom := TObjectList.Create;
  MovesFrom.OwnsObjects := False;
  MovesTo := TObjectList.Create;
  MovesTo.OwnsObjects := False;
end;

destructor TCell.Destroy;
var
  I: Integer;
begin
  for I := MovesFrom.Count - 1 downto 0 do
    TMove(MovesFrom[I]).Free;
  FreeAndNil(MovesFrom);
  for I := MovesTo.Count - 1 downto 0 do
    TMove(MovesTo[I]).Free;
  FreeAndNil(MovesTo);
  inherited Destroy;
end;

{ TPlayer }

function TView.CanvasToCellPos(Pos: TPoint): TPoint;
begin
  Result := Point(Trunc(Pos.X / Zoom + SourceRect.Left),
    Trunc(Pos.Y / Zoom + SourceRect.Top));
end;

function TView.CellToCanvasPos(Pos: TPoint): TPoint;
begin
  Result := Point(Trunc((Pos.X - SourceRect.Left) * Zoom),
    Trunc((Pos.Y - SourceRect.Top) * Zoom));
end;

function TView.CanvasToCellRect(Pos: TRect): TRect;
begin
  Result.TopLeft := CanvasToCellPos(Pos.TopLeft);
  Result.BottomRight := CanvasToCellPos(Pos.BottomRight);
end;

function TView.CellToCanvasRect(Pos: TRect): TRect;
begin
  Result.TopLeft := CellToCanvasPos(Pos.TopLeft);
  Result.BottomRight := CellToCanvasPos(Pos.BottomRight);
end;

procedure TView.Assign(Source: TView);
begin
  SourceRect := Source.SourceRect;
  DestRect := Source.DestRect;
  Zoom := Source.Zoom;
  SelectedCell := Source.SelectedCell;
  FocusedCell := Source.FocusedCell;
end;

procedure TPlayer.SetGame(AValue: TGame);
begin
  if FGame = AValue then Exit;
  FGame := AValue;
  View.Game := Game;
end;

procedure TPlayer.ComputerTurn;
var
  AllCells: TCellArray;
  Cells: TCellArray;
  X, Y: Integer;
  TotalPower: Integer;
  AttackPower: Integer;
  TotalAttackPower: Integer;
  I: Integer;
  C: Integer;
  CanAttack: Integer;
begin
  AllCells := Game.Map.GetAllCells;
  for C := 0 to Length(AllCells) - 1 do
  with AllCells[C] do begin
    if (Terrain <> ttVoid) and (Player <> Self) then begin
      // Attack to not owned cell yet
      // Count own possible power
      Cells := Game.Map.GetCellNeighbours(AllCells[C]);
      TotalPower := 0;
      for I := 0 to Length(Cells) - 1 do
      if (Cells[I].Player = Self) then begin
        TotalPower := TotalPower + Cells[I].GetAvialPower;
      end;
      // Attack if target is weaker
      if TotalPower >= Power then begin
        TotalAttackPower := 0;
        for I := 0 to Length(Cells) - 1 do
        if (Cells[I].Player = Self) then begin
          // Use only necessary power
          AttackPower := Power - TotalAttackPower + 1;
          if Cells[I].GetAvialPower < AttackPower then
            AttackPower := Cells[I].GetAvialPower;
          Game.SetMove(Cells[I], AllCells[C], AttackPower);
          TotalAttackPower := TotalAttackPower + AttackPower;
        end;
      end;
    end else
    if (Terrain <> ttVoid) and (Player = Self) then begin
      // Inner moves
      // We need to move available power to borders to be available for attacks
      // or defense
      Cells := Game.Map.GetCellNeighbours(AllCells[C]);
      CanAttack := 0;
      for I := 0 to Length(Cells) - 1 do
      if (Cells[I].Player <> Self) and (Cells[I].Terrain <> ttVoid) then begin
        Inc(CanAttack);
      end;
      if CanAttack = 0 then begin
        // We cannot attack and should do move
        // For simplicty just try to balance inner area cells power
        for I := 0 to Length(Cells) - 1 do
        if (Cells[I].Player = Self) and (Cells[I].Power < AllCells[C].GetAvialPower) then begin
          Game.SetMove(AllCells[C], Cells[I], (AllCells[C].GetAvialPower - Cells[I].Power) div 2);
        end;
      end;
    end;
  end;
end;

procedure TView.SelectCell(Pos: TPoint; Player: TPlayer);
var
  NewSelectedCell: TCell;
  TopLeft: TPoint;
  BottomRight: TPoint;
begin
  NewSelectedCell := Game.Map.PosToCell(CanvasToCellPos(Pos), Self);
  if Assigned(NewSelectedCell) then begin
    if Assigned(SelectedCell) and Game.Map.IsCellsNeighbor(NewSelectedCell, SelectedCell) then begin
      Game.SetMove(SelectedCell, NewSelectedCell, SelectedCell.Power);
      SelectedCell := nil;
    end else
    if (NewSelectedCell <> SelectedCell) and (NewSelectedCell.Player = Player) then
      SelectedCell := NewSelectedCell
    else
    if (NewSelectedCell = SelectedCell) and (NewSelectedCell.Player = Player) then
      SelectedCell := nil;
  end;
end;

procedure TView.CenterMap;
var
  MapRect: TRect;
begin
  MapRect := Game.Map.GetPixelRect;
  SourceRect := Bounds(MapRect.Left + (MapRect.Right - MapRect.Left) div 2 - (SourceRect.Right - SourceRect.Left) div 2,
    MapRect.Top + (MapRect.Bottom - MapRect.Top) div 2 - (SourceRect.Bottom - SourceRect.Top) div 2,
    SourceRect.Right - SourceRect.Left,
    SourceRect.Bottom - SourceRect.Top);
end;

procedure TPlayer.Paint(PaintBox: TPaintBox);
begin
  Game.Map.Paint(PaintBox.Canvas, View);
end;

constructor TPlayer.Create;
begin
  View := TView.Create;
  StartUnits := DefaultPlayerStartUnits;
end;

destructor TPlayer.Destroy;
begin
  FreeAndNil(View);
  inherited Destroy;
end;

procedure TPlayer.Assign(Source: TPlayer);
begin
  Name := Source.Name;
  Color := Source.Color;
  Mode := Source.Mode;
  Game := Source.Game;
  TotalCells := Source.TotalCells;
  TotalUnits := Source.TotalUnits;
  StartUnits := Source.StartUnits;
  View.Assign(Source.View);
end;

{ TGame }

procedure TGame.Attack(var AttackPower, DefendPower: Integer);
var
  AttackerRoll: Integer;
  DefenderRoll: Integer;
begin
  if AttackPower < 1 then
    raise Exception.Create('Attacker power have to be higher then 0.');
  if DefendPower < 0 then
    raise Exception.Create('Defender power have to be higher then or equal to 0.');
  while (AttackPower > 0) and (DefendPower > 0) do begin
    // Earch side do dice roll and compare result. Defender wins tie
    AttackerRoll := Random(6);
    DefenderRoll := Random(6);
    if AttackerRoll > DefenderRoll then Dec(DefendPower)
      else Dec(AttackPower);
  end;
end;

procedure TGame.MoveAll(Player: TPlayer);
var
  I: Integer;
  Remain: Integer;
  AttackerPower: Integer;
  DefenderPower: Integer;
begin
  I := 0;
  while I < Moves.Count do
  with TMove(Moves[I]) do begin
  if CountOnce > 0 then begin
    if CellFrom.Player = Player then begin
      if CellTo.Player = Player then begin
        // Inner move
        CellTo.Power := CellTo.Power + CountOnce;
      end else begin
        AttackerPower := CountOnce;
        DefenderPower := CellTo.Power;
        Attack(AttackerPower, DefenderPower);
        if DefenderPower = 0 then begin
          // Attacker wins with possible loses
          ClearMovesFromCell(CellTo);
          CellTo.Player := Player;
          CellTo.Power := AttackerPower;
        end else
        if AttackerPower = 0 then begin
          // Defender wins with possible loses
          CellTo.Power := DefenderPower;
        end else
          raise Exception.Create(SUnfinishedBattle);
      end;
      CellFrom.Power := CellFrom.Power - CountOnce;
      CountOnce := 0;
    end;
    end;
    Inc(I);
  end;
  // Remove empty moves
  for I := Moves.Count - 1 downto 0 do
  if (TMove(Moves[I]).CellFrom.Player = Player) and
    (TMove(Moves[I]).CountOnce = 0) and (TMove(Moves[I]).CountRepeat = 0) then
    Moves.Delete(I);
end;

procedure TGame.ClearMovesFromCell(Cell: TCell);
var
  I: Integer;
begin
  for I := Moves.Count - 1 downto 0 do
  if TMove(Moves[I]).CellFrom = Cell then
    Moves.Delete(I);
end;

procedure TGame.SetMapType(AValue: TMapType);
var
  OldMap: TMap;
begin
  if FMapType = AValue then Exit;
  OldMap := Map;
  case AValue of
    mtNone: Map := TMap.Create;
    mtHexagon: Map := THexMap.Create;
    mtSquare: Map := TSquareMap.Create;
  end;
  Map.Assign(OldMap);
  OldMap.Free;
  FMapType := AValue;
end;

procedure TGame.SetMove(CellFrom, CellTo: TCell; Power: Integer);
var
  NewMove: TMove;
  OldMove: TMove;
  I: Integer;
  CountOnce: Integer;
  CountRepeat: Integer;
  Confirm: Boolean;
begin
  I := 0;
  while (I < Moves.Count) and ((TMove(Moves[I]).CellFrom <> CellFrom) or
    (TMove(Moves[I]).CellTo <> CellTo)) do Inc(I);
  if I < Moves.Count then OldMove := TMove(Moves[I])
    else OldMove := nil;
  if Assigned(OldMove) then begin
    CountOnce := OldMove.CountOnce;
    CountRepeat := OldMove.CountRepeat;
    if Assigned(CurrentPlayer) and (CurrentPlayer.Mode = pmHuman) and
      Assigned(FOnMove) then FOnMove(CellFrom, CellTo, CountOnce, CountRepeat, True, Confirm);
  end else begin
    CountOnce := Power;
    CountRepeat := 0;
    if Assigned(CurrentPlayer) and (CurrentPlayer.Mode = pmHuman) and
      Assigned(FOnMove) then FOnMove(CellFrom, CellTo, CountOnce, CountRepeat, False, Confirm);
  end;
  if Confirm then begin
  if Assigned(OldMove) then begin
    // Already have such move
    if (CountOnce = 0) and (CountRepeat = 0) then Moves.Delete(I)
      else begin
        TMove(Moves[I]).CountOnce := CountOnce;
        TMove(Moves[I]).CountRepeat := CountRepeat;
      end;
  end else begin
    // Add new move
    if (CountOnce > 0) or (CountRepeat > 0) then begin
      NewMove := TMove(Moves[Moves.Add(TMove.Create)]);
      NewMove.List := Moves;
      NewMove.CellFrom := CellFrom;
      NewMove.CellTo := CellTo;
      NewMove.CountOnce := CountOnce;
      NewMove.CountRepeat := CountRepeat;
    end;
  end;
  end;
end;

procedure TGame.SetRunning(AValue: Boolean);
var
  I: Integer;
begin
  if FRunning = AValue then Exit;
  if AValue then begin
    if Players.Count < 2 then raise Exception.Create(SMinimumPlayers);
    FRunning := AValue;
  end else begin
    FRunning := AValue;
    for I := 0 to Players.Count - 1 do
    with TPlayer(Players[I]) do begin
      View.Clear;
    end;
  end;
end;

procedure TGame.UpdateRepeatMoves(Player: TPlayer);
var
  I: Integer;
begin
  for I := 0 to Moves.Count - 1 do
  with TMove(Moves[I]) do begin
    if CellFrom.Player = Player then
      if CountRepeat <= CellFrom.GetAvialPower then
        CountOnce := CountRepeat
        else CountOnce := CellFrom.GetAvialPower;
  end;
end;


procedure TGame.ComputePlayerStats;
var
  I: Integer;
begin
  for I := 0 to Players.Count - 1 do
  with TPlayer(Players[I]) do begin
    TotalUnits := 0;
    TotalCells := 0;
  end;
  Map.ComputePlayerStats;
end;

function TGame.GetAlivePlayers: TPlayerArray;
var
  I: Integer;
begin
  SetLength(Result, 0);
  for I := 0 to Players.Count - 1 do
    if TPlayer(Players[I]).TotalCells > 0 then begin
      SetLength(Result, Length(Result) + 1);
      Result[Length(Result) - 1] := TPlayer(Players[I]);
    end;
end;

procedure TGame.NextTurn;
var
  PrevPlayer: TPlayer;
  AlivePlayers: TPlayerArray;
begin
  MoveAll(CurrentPlayer);
  Map.Grow(CurrentPlayer);
  ComputePlayerStats;
  PrevPlayer := CurrentPlayer;
  // Skip dead players
  repeat
    CurrentPlayer := TPlayer(Players[(Players.IndexOf(CurrentPlayer) + 1) mod Players.Count]);
  until CurrentPlayer.TotalCells > 0;
  if Players.IndexOf(CurrentPlayer) < Players.IndexOf(PrevPlayer) then Inc(TurnCounter);
  AlivePlayers := GetAlivePlayers;
  if (Length(AlivePlayers) <= 1) then begin
    Running := False;
    if Assigned(OnWin) and (Length(AlivePlayers) > 0) then OnWin(TPlayer(AlivePlayers[0]));
  end;
  UpdateRepeatMoves(CurrentPlayer);
  // For computers take view from previous human
  if CurrentPlayer.Mode = pmComputer then CurrentPlayer.View.Assign(PrevPlayer.View);
end;

constructor TGame.Create;
var
  Player: TPlayer;
begin
  Moves := TObjectList.Create;
  Map := TMap.Create;
  Players := TPlayers.Create;

  Randomize;

  Player := TPlayer.Create;
  Player.Name := 'Player 1';
  Player.Game := Self;
  Player.Color := clBlue;
  Players.Add(Player);
  Player := TPlayer.Create;
  Player.Name := 'Player 2';
  Player.Game := Self;
  Player.Color := clRed;
  Player.Mode := pmComputer;
  Players.Add(Player);

  VoidEnabled := True;
  VoidPercentage := 20;

  Map.Game := Self;
  MapType := mtHexagon;
  Map.Size := Point(3, 3);
end;

destructor TGame.Destroy;
begin
  FreeAndNil(Moves);
  FreeAndNil(Players);
  FreeAndNil(Map);
  inherited Destroy;
end;

procedure TGame.New;
var
  X, Y: Integer;
  NewCell: TCell;
  I: Integer;
  StartCell: TCell;
  Counter: Integer;
  AllCells: TCellArray;
  C: Integer;
begin
  TurnCounter := 1;
  Moves.Clear;
  AllCells := Map.GetAllCells;
  for C := 0 to Length(AllCells) - 1 do
  with AllCells[C] do begin
    if VoidEnabled and (Random < VoidPercentage / 100) then Terrain := ttVoid
      else begin
        if CityEnabled and (Random < CityPercentage / 100) then Terrain := ttCity
          else Terrain := ttNormal;
      end;
    Power := Random(4);
    Player := nil;
  end;
  for I := 0 to Players.Count - 1 do
  with TPlayer(Players[I]) do begin
    View.Clear;
    if (Map.Size.X > 0) and (Map.Size.Y > 0) then begin
      // Try to obtain start cell for each player
      StartCell := nil;
      Counter := 0;
      while not Assigned(StartCell) or Assigned(StartCell.Player) do begin
        StartCell := AllCells[Random(Length(AllCells))];
        Inc(Counter);
        if Counter > 100 then
          raise Exception.Create(SCannotSetPlayerStartCells);
      end;
      if CityEnabled then StartCell.Terrain := ttCity
        else StartCell.Terrain := ttNormal;
      StartCell.Player := TPlayer(Players[I]);
      StartCell.Power := TPlayer(Players[I]).StartUnits;
    end;
    View.Zoom := 1;
    View.CenterMap;
  end;
  CurrentPlayer := TPlayer(Players[0]);
end;

{ THexMap }

function THexMap.GetHexagonPolygon(Pos: TPoint; HexSize: TPoint): TPointArray;
var
  HexShift: TFloatPoint;
begin
  HexShift := FloatPoint(0.5 * cos(30 / 180 * Pi), 0.5 * sin(30 / 180 * Pi));
  SetLength(Result, 6);
  Result[0] := Point(Round(Pos.X + 0 * HexSize.X), Round(Pos.Y - 0.5 * HexSize.Y));
  Result[1] := Point(Round(Pos.X + HexShift.X * HexSize.X), Round(Pos.Y - HexShift.Y * HexSize.Y));
  Result[2] := Point(Round(Pos.X + HexShift.X * HexSize.X), Round(Pos.Y + HexShift.Y * HexSize.Y));
  Result[3] := Point(Round(Pos.X + 0 * HexSize.X), Round(Pos.Y + 0.5 * HexSize.Y));
  Result[4] := Point(Round(Pos.X - HexShift.X * HexSize.X), Round(Pos.Y + HexShift.Y * HexSize.Y));
  Result[5] := Point(Round(Pos.X - HexShift.X * HexSize.X), Round(Pos.Y - HexShift.Y * HexSize.Y));
end;

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

procedure THexMap.SetSize(AValue: TPoint);
var
  X, Y: Integer;
  NewCell: TCell;
  C: Integer;
begin
  if (FSize.X <> AValue.X) or (FSize.Y <> AValue.Y) then begin
    // Free previous
    for Y := 0 to FSize.Y - 1 do
    for X := 0 to FSize.X - 1 do begin
      TCell(Cells[Y, X]).Destroy;
    end;
    FSize := AValue;
    // Allocate and init new
    SetLength(Cells, FSize.Y, FSize.X);
    for Y := 0 to FSize.Y - 1 do
    for X := 0 to FSize.X - 1 do begin
      NewCell := TCell.Create;
      NewCell.Pos := Point(X, Y);
      Cells[Y, X] := NewCell;
    end;
  end;
end;

function THexMap.IsCellsNeighbor(Cell1, Cell2: TCell): Boolean;
var
  DX: Integer;
  DY: Integer;
  MinY: Integer;
begin
  if Cell1.Pos.Y < Cell2.Pos.Y then MinY:= Cell1.Pos.Y
    else MinY := Cell2.Pos.Y;
  DX := Cell2.Pos.X - Cell1.Pos.X;
  DY := Cell2.Pos.Y - Cell1.Pos.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 (Cell1 = Cell2);
end;

procedure THexMap.Assign(Source: TMap);
begin
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;

function THexMap.GetCellNeighbours(Cell: TCell): TCellArray;
var
  X, Y: Integer;
begin
  SetLength(Result, 0);
  for Y := -1 to 1 do
  for X := -1 to 1 do
  if IsValidIndex(Point(Cell.Pos.X + X, Cell.Pos.Y + Y)) and
  IsCellsNeighbor(Cell, Cells[Cell.Pos.Y + Y, Cell.Pos.X + X]) then begin
    SetLength(Result, Length(Result) + 1);
    Result[Length(Result) - 1] := Cells[Cell.Pos.Y + Y, Cell.Pos.X + X];
  end;
end;

function THexMap.PosToCell(Pos: TPoint; View: TView): TCell;
var
  CX, CY: Integer;
  X, Y: Double;
  HexSize: TFloatPoint;
  CellSize: TFloatPoint;
  Points: TPointArray;
begin
  // TODO: This is implemented as simple sequence lookup. Needs some faster algorithm
  Result := nil;
  CellSize := FloatPoint(DefaultCellSize.X / HexCellMulX, DefaultCellSize.Y / HexCellMulY);
  HexSize := FloatPoint(DefaultCellSize.X, DefaultCellSize.Y);
  with View do
    for CY := Trunc(SourceRect.Top / CellSize.Y) to Trunc(SourceRect.Bottom / CellSize.Y) + 1 do
    for CX := Trunc(SourceRect.Left / CellSize.X) to Trunc(SourceRect.Right / CellSize.X) + 1 do begin
      X := CX;
      Y := CY;
      if (CY and 1) = 1 then begin
        X := X + 0.5;
        //Y := Y + 0.5;
      end;
      if (CX >= 0) and (CY >= 0) and (CY < Size.Y) and (CX < Size.X) then
      if Cells[CY, CX].Terrain <> ttVoid then begin
        Points := GetHexagonPolygon(Point(Trunc(X * CellSize.X),
          Trunc(Y * CellSize.Y)),
          Point(Trunc(HexSize.X), Trunc(HexSize.Y)));
        if PtInPoly(Points, Pos) then begin
          Result := Cells[CY, CX];
          Exit;
        end;
      end;
    end;
end;

function THexMap.CellToPos(Cell: TCell): TPoint;
var
  CX, CY: Integer;
  X, Y: Double;
  HexSize: TFloatPoint;
  CellSize: TFloatPoint;
  Points: array of TPoint;
begin
  CellSize := FloatPoint(DefaultCellSize.X / HexCellMulX, DefaultCellSize.Y / HexCellMulY);
  HexSize := FloatPoint(DefaultCellSize.X, DefaultCellSize.Y);
  X := Cell.Pos.X;
  Y := Cell.Pos.Y;
  if (Cell.Pos.Y and 1) = 1 then begin
    X := X + 0.5;
    //Y := Y + 0.5;
  end;

  Result.X := Trunc(X * CellSize.X);
  Result.Y := Trunc(Y * CellSize.Y);
end;

procedure THexMap.Paint(Canvas: TCanvas; View: TView);
var
  CX, CY: Integer;
  X, Y: Double;
  CellSizeZoomed: TFloatPoint;
  CellSize: TFloatPoint;
  HexSize: TFloatPoint;
  I: Integer;
  Points: array of TPoint;
  Cell: TCell;
  PosFrom, PosTo: TPoint;
  Angle: Double;

procedure PaintHexagon(Pos: TPoint; Text: string);
var
  Points: TPointArray;
begin
  with Canvas do begin
    if Assigned(View.FocusedCell) and (View.FocusedCell = TCell(Cells[CY, CX])) then begin
      Pen.Color := clYellow;
      Pen.Style := psSolid;
      Pen.Width := 1;
    end else
    if TCell(Cells[CY, CX]).Terrain = ttCity then begin
      // Cannot set clear border as it will display shifted on gtk2
      //Pen.Style := psClear;
      Pen.Color := clBlack;
      Pen.Style := psSolid;
      Pen.Width := 3;
    end else begin
      // Cannot set clear border as it will display shifted on gtk2
      //Pen.Style := psClear;
      Pen.Color := Brush.Color;
      Pen.Style := psSolid;
      Pen.Width := 0;
    end;
    Points := GetHexagonPolygon(Point(Trunc(Pos.X), Trunc(Pos.Y)), Point(Trunc(HexSize.X), Trunc(HexSize.Y)));
    Polygon(Points);
    //Rectangle(Trunc(Pos.X), Trunc(Pos.Y), Trunc(Pos.X + HexSize.X), Trunc(Pos.Y + HexSize.Y));
    Pen.Style := psSolid;
    Font.Color := clWhite;
    Font.Size := Trunc(12 * View.Zoom);
    TextOut(Round(Pos.X) - TextWidth(Text) div 2, Round(Pos.Y) - TextHeight(Text) div 2, Text);
  end;
end;

begin
  CellSize := FloatPoint(DefaultCellSize.X / HexCellMulX, DefaultCellSize.Y / HexCellMulY);
  HexSize := FloatPoint(DefaultCellSize.X * View.Zoom, DefaultCellSize.Y * View.Zoom);
  CellSizeZoomed := FloatPoint(CellSize.X * View.Zoom, CellSize.Y * View.Zoom);
  with Canvas, View do
  try
    Lock;
    for CY := Trunc(SourceRect.Top / CellSize.Y) to Trunc(SourceRect.Bottom / CellSize.Y) + 1 do
    for CX := Trunc(SourceRect.Left / CellSize.X) to Trunc(SourceRect.Right / CellSize.X) + 1 do begin
      X := CX;
      Y := CY;
      if (CY and 1) = 1 then begin
        X := X + 0.5;
        //Y := Y + 0.5;
      end;
      if (CX >= 0) and (CY >= 0) and (CY < Size.Y) and (CX < Size.X) then begin
        Cell := Cells[CY, CX];
        if Cell.Terrain <> ttVoid then begin
          if Assigned(SelectedCell) and (SelectedCell = TCell(Cells[CY, CX])) then Brush.Color := clGreen
            else if Assigned(SelectedCell) and IsCellsNeighbor(SelectedCell, TCell(Cells[CY, CX])) then Brush.Color := clPurple
            else Brush.Color := Cell.GetColor;
          Pen.Color := clBlack;
          PaintHexagon(View.CellToCanvasPos(Point(Trunc(X * CellSize.X),
            Trunc(Y * CellSize.Y))),
            IntToStr(Cell.GetAvialPower));
          // Draw arrows
          Pen.Color := clCream;
          for I := 0 to Cell.MovesFrom.Count - 1 do begin
            PosFrom := CellToPos(Cell);
            PosTo := CellToPos(TMove(Cell.MovesFrom[I]).CellTo);
            if TMove(Cell.MovesFrom[I]).CountRepeat > 0 then Pen.Width := 2
              else Pen.Width := 1;
            Angle := ArcTan((PosTo.Y - PosFrom.Y) / (PosTo.X - PosFrom.X));
            if Sign(PosTo.X - PosFrom.X) = -1 then Angle := Angle + Pi;
            DrawArrow(Canvas, View, View.CellToCanvasPos(Point(Trunc(PosFrom.X + (PosTo.X - PosFrom.X) / 3),
              Trunc(PosFrom.Y + (PosTo.Y - PosFrom.Y) / 3))),
              Angle, Point(Trunc(HexSize.X / 4), Trunc(HexSize.Y / 4)));
            Pen.Width := 1;
          end;
        end;
      end;
    end;
  finally
    Unlock;
  end;
end;

constructor THexMap.Create;
begin
  inherited;
end;

destructor THexMap.Destroy;
begin
  inherited Destroy;
end;

function THexMap.GetAllCells: TCellArray;
var
  X: Integer;
  Y: Integer;
  I: Integer;
  TempSize: TPoint;
begin
  TempSize := Size;
  SetLength(Result, TempSize.Y * TempSize.X);
  for Y := 0 to TempSize.Y - 1 do
  for X := 0 to TempSize.X - 1 do
    Result[Y * TempSize.X + X] := Cells[Y, X];
end;

function THexMap.GetPixelRect: TRect;
begin
  Result := Bounds(Trunc(-0.5 * DefaultCellSize.X),
    Trunc(-0.5 * DefaultCellSize.Y),
    Trunc((Size.X + 0.5) * DefaultCellSize.X),
    Trunc(((Size.Y + 0.5) * 0.78) * DefaultCellSize.Y));
end;

end.