source: trunk/Player.pas

unit Player;

interface

uses
  Classes, SysUtils, Graphics, Map, DOM, Generics.Collections, Generics.Defaults,
  XMLConf, XML, Math, Geometry, Units, Nation, ItemList, TurnStats;

type
  TUnitMoves = class;
  TPlayerCells = class;
  TPlayerMap = class;
  TPlayer = class;

  { TPlayerCell }

  TPlayerCell = class
    MovesFrom: TUnitMoves;
    MovesTo: TUnitMoves;
    Explored: Boolean;
    InVisibleRange: Boolean;
    MapCell: TCell;
    List: TPlayerCells;
    Neighbors: TPlayerCells;
    procedure ConnectTo(Cell: TPlayerCell);
    procedure DisconnectFrom(Cell: TPlayerCell);
    function GetAvialPower: Integer;
    function GetAvialPowerForMove: Integer;
    function GetAttackPower: Integer;
    procedure LoadFromNode(Node: TDOMNode);
    procedure SaveToNode(Node: TDOMNode);
    constructor Create;
    destructor Destroy; override;
  end;

  { TPlayerCells }

  TPlayerCells = class(TObjectList<TPlayerCell>)
    Map: TPlayerMap;
    function FindByCellId(Id: Integer): TPlayerCell;
    function SearchCell(Cell: TCell): TPlayerCell;
    procedure LoadFromNode(Node: TDOMNode);
    procedure SaveToNode(Node: TDOMNode);
  end;

  { TPlayerMap }

  TPlayerMap = class
    Cells: TPlayerCells;
    Player: TPlayer;
    function PosToCell(Pos: TPoint): TPlayerCell; virtual;
    function CellToPos(Cell: TPlayerCell): TPoint; virtual;
    procedure LoadFromNode(Node: TDOMNode);
    procedure SaveToNode(Node: TDOMNode);
    procedure Update;
    procedure Clear;
    constructor Create;
    destructor Destroy; override;
    procedure CheckVisibility;
  end;

  TPlayerMode = (pmHuman, pmComputer);
  TComputerAgressivity = (caLow, caMedium, caHigh);
  TUnitMove = class;

  TMoveEvent = procedure(CellFrom, CellTo: TPlayerCell; var CountOnce, CountRepeat: Integer;
    Update: Boolean; var Confirm: Boolean) of object;
  TMoveUpdatedEvent = procedure(UnitMove: TUnitMove) of object;

  { TPlayer }

  TPlayer = class(TItem)
  private
    FGame: TObject; //TGame;
    FMode: TPlayerMode;
    FOnMove: TMoveEvent;
    procedure MoveUnit(UnitMove: TUnitMove);
    procedure SetGame(AValue: TObject); // TGame
    procedure Attack(var AttackPower, DefendPower: Integer);
    procedure ClearMovesFromCell(Cell: TPlayerCell);
    procedure CheckCounterMove(Move: TUnitMove);
    procedure SetMode(AValue: TPlayerMode);
  public
    Color: TColor;
    TotalUnits: Integer;
    TotalCells: Integer;
    TotalCities: Integer;
    TotalDiscovered: Integer;
    TotalWinObjectiveCells: Integer;
    StartUnits: Integer;
    StartCell: TCell;
    PlayerMap: TPlayerMap;
    Defensive: Boolean;
    Agressivity: TComputerAgressivity;
    TurnStats: TGameTurnStats;
    Moves: TUnitMoves;
    Units: TUnits;
    Nation: TNation;
    class function GetFields: TItemFields; override;
    procedure GetValue(Index: Integer; out Value); override;
    procedure SetValue(Index: Integer; var Value); override;
    function GetReferenceList(Index: Integer): TBaseItemList; override;
    class function GetClassSysName: string; override;
    class function GetClassName: string; override;
    function IsAllowedMoveTarget(CellFrom, CellTo: TPlayerCell): Boolean;
    procedure ReduceMovesPower;
    procedure RemoveInvalidMoves;
    procedure RemoveEmptyUnits;
    procedure InitUnitMoves;
    procedure UpdateRepeatMoves;
    procedure UpdateEmptyCellsNeutral;
    procedure MoveAll;
    procedure Grow;
    function SetMove(CellFrom, CellTo: TPlayerCell; Power: Integer; Confirmation: Boolean = True): TUnitMove;
    procedure Reset;
    procedure Surrender;
    function IsAlive: Boolean;
    procedure Clear;
    procedure LoadFromNode(Node: TDOMNode); override;
    procedure SaveToNode(Node: TDOMNode); override;
    constructor Create; override;
    destructor Destroy; override;
    procedure Assign(Source: TItem); override;
    procedure LoadConfig(Config: TXmlConfig; Path: string);
    procedure SaveConfig(Config: TXmlConfig; Path: string);
    property Game: TObject read FGame write SetGame; // TGame
    property Mode: TPlayerMode read FMode write SetMode;
    property OnMove: TMoveEvent read FOnMove write FOnMove;
  end;

  TPlayerEvent = procedure (Player: TPlayer) of object;
  TPlayerArray = array of TPlayer;

  { TPlayers }

  TPlayers = class(TItemList<TPlayer>)
  public
    Game: TObject; //TGame;
    function GetPlayerByColor(Color: TColor): TPlayer;
    function GetUnusedColor: TColor;
    procedure Assign(Source: TItemList<TPlayer>); override;
    procedure New(Name: string; Color: TColor; Mode: TPlayerMode);
    function CreateItem(Name: string = ''): TPlayer; override;
    function GetFirstHuman: TPlayer;
    procedure LoadConfig(Config: TXmlConfig; Path: string);
    procedure SaveConfig(Config: TXmlConfig; Path: string);
    function GetAliveCount: Integer;
    procedure GetAlivePlayers(Players: TPlayers); overload;
    function GetAlivePlayers: TPlayerArray; overload;
    function GetAlivePlayersWithCities: TPlayerArray;
  end;

  { TUnitMove }

  TUnitMove = class
  private
    FCellFrom: TPlayerCell;
    FCellTo: TPlayerCell;
    procedure SetCellFrom(AValue: TPlayerCell);
    procedure SetCellTo(AValue: TPlayerCell);
  public
    List: TUnitMoves;
    CountOnce: Integer;
    CountRepeat: Integer;
    procedure Assign(Source: TUnitMove);
    procedure LoadFromNode(Node: TDOMNode);
    procedure SaveToNode(Node: TDOMNode);
    constructor Create;
    destructor Destroy; override;
    property CellFrom: TPlayerCell read FCellFrom write SetCellFrom;
    property CellTo: TPlayerCell read FCellTo write SetCellTo;
  end;

  { TUnitMoves }

  TUnitMoves = class(TObjectList<TUnitMove>)
    Game: TObject; //TGame;
    Player: TPlayer;
    procedure Assign(Source: TUnitMoves);
    function SearchByFromTo(CellFrom, CellTo: TPlayerCell): TUnitMove;
    procedure LoadFromNode(Node: TDOMNode);
    procedure SaveToNode(Node: TDOMNode);
  end;

function CellCompare(constref Item1, Item2: TPlayerCell): Integer;
function CellCompareDescending(constref Item1, Item2: TPlayerCell): Integer;


implementation

uses
  Game, GameSystem, Building, UnitKind;

resourcestring
  SAttackerPowerPositive = 'Attacker power have to be higher then 0.';
  SDefenderPowerPositive = 'Defender power have to be higher then or equal to 0.';
  SUnfinishedBattle = 'Unfinished battle';
  SLow = 'Low';
  SMedium = 'Medium';
  SHigh = 'High';
  SHuman = 'Human';
  SComputer = 'Computer';
  SNation = 'Nation';
  SMode = 'Mode';
  SColor = 'Color';
  SAgressivity = 'Agressivity';
  SStartUnits = 'Start units';
  SDefensive = 'Defensive';

const
  clDarkYellow = $00C0C0;
  PlayerColors: array[0..11] of TColor = (clBlue, clRed, clGreen, clDarkYellow,
    clFuchsia, clAqua, clOlive, clMaroon, clNavy, clPurple, clTeal, clGray);

function ComparePointer(constref Item1, Item2: Integer): Integer;
begin
  Result := -CompareValue(Item1, Item2);
end;


{ TPlayerCell }

procedure TPlayerCell.LoadFromNode(Node: TDOMNode);
var
  C: TCell;
  CellId: Integer;
begin
  Explored := ReadBoolean(Node, 'Explored', False);
  CellId := ReadInteger(Node, 'MapCell', 0);
  C := TGame(List.Map.Player.Game).Map.Cells.FindById(CellId);
  if not Assigned(C) then
    raise Exception.Create('Cell map not found ' + IntToStr(CellId));
  if List.SearchCell(C) <> nil then
    raise Exception.Create('Map cell used twice ' + IntToStr(CellId));
  MapCell := C;
end;

procedure TPlayerCell.ConnectTo(Cell: TPlayerCell);
begin
  if Cell = Self then
    raise Exception.Create('Can''t connect player cell to itself');
  if (Cell.Neighbors.IndexOf(Self) = -1) and
  (Neighbors.IndexOf(Cell) = -1) then begin
    Cell.Neighbors.Add(Self);
    Neighbors.Add(Cell);
  end;
end;

procedure TPlayerCell.DisconnectFrom(Cell: TPlayerCell);
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 TPlayerCell.GetAvialPower: Integer;
var
  UnitMove: TUnitMove;
begin
  Result := 0;
  if Assigned(MapCell.OneUnit) then
    Result := MapCell.OneUnit.Power;
  for UnitMove in MovesFrom do
    Result := Result - UnitMove.CountOnce;
end;

function TPlayerCell.GetAvialPowerForMove: Integer;
var
  UnitMove: TUnitMove;
begin
  Result := 0;
  if Assigned(MapCell.OneUnit) then
    if MapCell.OneUnit.Moves > 0 then Result := MapCell.OneUnit.Power;
  for UnitMove in MovesFrom do
    Result := Result - UnitMove.CountOnce;
end;

function TPlayerCell.GetAttackPower: Integer;
var
  I: Integer;
begin
  Result := 0;
  for I := 0 to MovesTo.Count - 1 do
    Result := Result + TUnitMove(MovesTo[I]).CountOnce;
end;

procedure TPlayerCell.SaveToNode(Node: TDOMNode);
begin
  WriteBoolean(Node, 'Explored', Explored);
  WriteInteger(Node, 'MapCell', MapCell.Id);
end;

constructor TPlayerCell.Create;
begin
  MovesFrom := TUnitMoves.Create;
  MovesFrom.OwnsObjects := False;
  MovesTo := TUnitMoves.Create;
  MovesTo.OwnsObjects := False;
  Neighbors := TPlayerCells.Create;
  Neighbors.OwnsObjects := False;
end;

destructor TPlayerCell.Destroy;
var
  I: Integer;
begin
  for I := MovesFrom.Count - 1 downto 0 do
    if TUnitMove(MovesFrom[I]).List.Remove(TUnitMove(MovesFrom[I])) = -1 then
      raise Exception.Create('MoveFrom cell remove error');
  FreeAndNil(MovesFrom);
  for I := MovesTo.Count - 1 downto 0 do
    if TUnitMove(MovesTo[I]).List.Remove(TUnitMove(MovesTo[I])) = -1 then
      raise Exception.Create('MoveTo cell remove error');
  FreeAndNil(MovesTo);
  for I := Neighbors.Count - 1 downto 0 do
    if Neighbors[I].Neighbors.Remove(Self) = -1 then
      raise Exception.Create(SCellRemoveNeighborError);
  FreeAndNil(Neighbors);
  inherited;
end;

{ TPlayerCells }

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

function TPlayerCells.SearchCell(Cell: TCell): TPlayerCell;
var
  I: Integer;
begin
  I := 0;
  while (I < Count) and (Items[I].MapCell <> Cell) do Inc(I);
  if I < Count then Result := Items[I]
    else Result := nil;
end;

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

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

{ TPlayerMap }

function TPlayerMap.PosToCell(Pos: TPoint): TPlayerCell;
var
  I: Integer;
begin
  // TODO: Can it be optimized somehow?
  Result := nil;
  for I := 0 to Cells.Count - 1 do
  if Cells[I].MapCell.Terrain <> ttVoid then begin
    if Cells[I].MapCell.Polygon.IsPointInside(Pos) then begin
      Result := Cells[I];
      Exit;
    end;
  end;
end;

function TPlayerMap.CellToPos(Cell: TPlayerCell): TPoint;
begin
  Result := Cell.MapCell.PosPx;
end;

procedure TPlayerMap.LoadFromNode(Node: TDOMNode);
var
  NewNode: TDOMNode;
begin
  with Node do begin
    NewNode := FindNode('Cells');
    if Assigned(NewNode) then
      Cells.LoadFromNode(NewNode);
  end;
end;

procedure TPlayerMap.SaveToNode(Node: TDOMNode);
var
  NewNode: TDOMNode;
begin
  with Node do begin
    NewNode := OwnerDocument.CreateElement('Cells');
    AppendChild(NewNode);
    Cells.SaveToNode(NewNode);
  end;
end;

procedure TPlayerMap.Update;
var
  I: Integer;
  J: Integer;
  OldCount: Integer;
begin
  for I := 0 to Cells.Count - 1 do
  with Cells[I] do begin
    for J := Neighbors.Count - 1 downto 0 do
      DisconnectFrom(Neighbors[J]);
  end;

  // Update players cells count to map cells count to be 1:1
  OldCount := Cells.Count;
  Cells.Count := TGame(Player.Game).Map.Cells.Count;
  for I := OldCount to Cells.Count - 1 do
    Cells[I] := TPlayerCell.Create;

  for I := 0 to TGame(Player.Game).Map.Cells.Count - 1 do begin
    with Cells[I] do begin
      List := Cells;
      Explored := False;
      InVisibleRange := False;
      MapCell := TGame(Player.Game).Map.Cells[I];
      TGame(Player.Game).Map.Cells[I].PlayerCell := Cells[I];
    end;
  end;

  for I := 0 to Cells.Count - 1 do
  with TPlayerCell(Cells[I]) do begin
    for J := 0 to MapCell.Neighbors.Count - 1 do
      ConnectTo(TPlayerCell(MapCell.Neighbors[J].PlayerCell));
  end;
end;

procedure TPlayerMap.Clear;
begin
  Cells.Clear;
end;

constructor TPlayerMap.Create;
begin
  Cells := TPlayerCells.Create;
  Cells.Map := Self;
end;

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

procedure TPlayerMap.CheckVisibility;
var
  I: Integer;
  C: Integer;
  NeighCount: Integer;
begin
  for I := 0 to Cells.Count - 1 do
  with Cells[I] do begin
    NeighCount := 0;
    for C := 0 to MapCell.Neighbors.Count - 1 do
      if MapCell.Neighbors[C].Player = Player then
        Inc(NeighCount);

    InVisibleRange := (NeighCount > 0) or (MapCell.Player = Player);
    if InVisibleRange and not Explored then Explored := True;
  end;
end;

{ TPlayers }

function TPlayers.GetAliveCount: Integer;
var
  I: Integer;
begin
  Result := 0;
  for I := 0 to Count - 1 do
    if Items[I].IsAlive then Inc(Result);
end;

procedure TPlayers.GetAlivePlayers(Players: TPlayers);
var
  I: Integer;
begin
  Players.Clear;
  for I := 0 to Count - 1 do
    if Items[I].IsAlive then Players.Add(Items[I]);
end;

function TPlayers.GetPlayerByColor(Color: TColor): TPlayer;
var
  I: Integer;
begin
  I := 0;
  while (I < Count) do begin
    if Assigned(Items[I]) and (Items[I].Color = Color) then Break;
    Inc(I);
  end;
  if I < Count then Result := Items[I]
    else Result := nil;
end;

function TPlayers.GetUnusedColor: TColor;
var
  I: Integer;
begin
  Result := clBlack;
  for I := 0 to Length(PlayerColors) - 1 do
    if not Assigned(GetPlayerByColor(PlayerColors[I])) then begin
      Result := PlayerColors[I];
      Exit;
    end;
end;

procedure TPlayers.Assign(Source: TItemList<TPlayer>);
var
  I: Integer;
begin
  inherited;
  for I := 0 to Count - 1 do
    Items[I].Game := Game;
end;

procedure TPlayers.New(Name: string; Color: TColor; Mode: TPlayerMode);
var
  NewPlayer: TPlayer;
begin
  NewPlayer := AddItem(Name);
  NewPlayer.Color := Color;
  NewPlayer.Mode := Mode;
  if Mode = pmComputer then
    NewPlayer.Agressivity := caMedium;
end;

function TPlayers.CreateItem(Name: string): TPlayer;
begin
  Result := inherited;
  Result.Game := Game;
  Result.Mode := pmComputer;
  Result.Agressivity := caMedium;
  Result.Color := GetUnusedColor;
end;

function TPlayers.GetFirstHuman: TPlayer;
var
  I: Integer;
begin
  I := 0;
  while (I < Count) and (Items[I].Mode <> pmHuman) do Inc(I);
  if I < Count then Result := Items[I]
    else Result := nil;
end;

procedure TPlayers.LoadConfig(Config: TXmlConfig; Path: string);
var
  I: Integer;
  NewCount: Integer;
begin
  with Config do begin
    NewCount := GetValue(DOMString(Path + '/Count'), -1);
    NewId := 1;
    if NewCount >= MinPlayerCount then begin
      Self.Clear;
      Count := NewCount;
      for I := 0 to Count - 1 do begin
        Items[I] := CreateItem;
        Items[I].Id := GetNewId;
        Items[I].LoadConfig(Config, Path + '/Player' + IntToStr(I));
      end;
    end;
  end;
end;

procedure TPlayers.SaveConfig(Config: TXmlConfig; Path: string);
var
  I: Integer;
begin
  for I := 0 to Count - 1 do
    Items[I].SaveConfig(Config, Path + '/Player' + IntToStr(I));
  with Config do begin
    SetValue(DOMString(Path + '/Count'), Count);
  end;
end;

function TPlayers.GetAlivePlayers: TPlayerArray;
var
  I: Integer;
begin
  Result := Default(TPlayerArray);
  SetLength(Result, 0);
  for I := 0 to Count - 1 do
    if Items[I].IsAlive then begin
      SetLength(Result, Length(Result) + 1);
      Result[Length(Result) - 1] := Items[I];
    end;
end;

function TPlayers.GetAlivePlayersWithCities: TPlayerArray;
var
  I: Integer;
begin
  Result := Default(TPlayerArray);
  SetLength(Result, 0);
  for I := 0 to Count - 1 do
    if Items[I].TotalCities > 0 then begin
      SetLength(Result, Length(Result) + 1);
      Result[Length(Result) - 1] := Items[I];
    end;
end;

{ TUnitMoves }

procedure TUnitMoves.Assign(Source: TUnitMoves);
var
  I: Integer;
begin
  while Count > Source.Count do
    Delete(Count - 1);
  while Count < Source.Count do
    Add(TUnitMove.Create);
  for I := 0 to Count - 1 do begin
    Items[I].Assign(Source.Items[I]);
  end;
end;

function TUnitMoves.SearchByFromTo(CellFrom, CellTo: TPlayerCell): TUnitMove;
var
  UnitMove: TUnitMove;
begin
  Result := nil;
  for UnitMove in Self do
  if (UnitMove.CellFrom = CellFrom) and (UnitMove.CellTo = CellTo) then begin
    Result := UnitMove;
    Break;
  end;
end;

procedure TUnitMoves.LoadFromNode(Node: TDOMNode);
var
  Node2: TDOMNode;
  NewUnitMove: TUnitMove;
begin
  Count := 0;
  Node2 := Node.FirstChild;
  while Assigned(Node2) and (Node2.NodeName = 'UnitMove') do begin
    NewUnitMove := TUnitMove.Create;
    NewUnitMove.List := Self;
    NewUnitMove.LoadFromNode(Node2);
    Add(NewUnitMove);
    Node2 := Node2.NextSibling;
  end;
end;

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

{ TUnitMove }

procedure TUnitMove.SetCellFrom(AValue: TPlayerCell);
var
  OldValue: TPlayerCell;
begin
  if FCellFrom = AValue then Exit;
  OldValue := FCellFrom;
  FCellFrom := nil;
  if Assigned(OldValue) then begin
    if OldValue.MovesFrom.IndexOf(Self) <> -1 then
      OldValue.MovesFrom.Remove(Self)
      else raise Exception.Create('Unit move not found');
  end;
  FCellFrom := AValue;
  if Assigned(FCellFrom) then begin
    if FCellFrom.MovesFrom.IndexOf(Self) = -1 then
      FCellFrom.MovesFrom.Add(Self)
      else raise Exception.Create('Unit move already exists');
  end else
end;

procedure TUnitMove.SetCellTo(AValue: TPlayerCell);
var
  OldValue: TPlayerCell;
begin
  if FCellTo = AValue then Exit;
  OldValue := FCellTo;
  FCellTo := nil;
  if Assigned(OldValue) then begin
    if OldValue.MovesTo.IndexOf(Self) <> -1 then
      OldValue.MovesTo.Remove(Self)
      else raise Exception.Create('Unit move not found');
  end;
  FCellTo := AValue;
  if Assigned(FCellTo) then begin
    if FCellTo.MovesTo.IndexOf(Self) = -1 then
      FCellTo.MovesTo.Add(Self)
      else raise Exception.Create('Unit move already exists');
  end else
end;

procedure TUnitMove.Assign(Source: TUnitMove);
begin
  CountOnce := Source.CountOnce;
  CountRepeat := Source.CountRepeat;
  CellFrom.MapCell.Id := Source.CellFrom.MapCell.Id;
  CellTo.MapCell.Id := Source.CellTo.MapCell.Id;
end;

procedure TUnitMove.LoadFromNode(Node: TDOMNode);
begin
  CountOnce := ReadInteger(Node, 'CountOnce', 0);
  CountRepeat := ReadInteger(Node, 'CountRepeat', 0);
  CellFrom := List.Player.PlayerMap.Cells.FindByCellId(ReadInteger(Node, 'CellFrom', 0));
  CellTo := List.Player.PlayerMap.Cells.FindByCellId(ReadInteger(Node, 'CellTo', 0));
end;

procedure TUnitMove.SaveToNode(Node: TDOMNode);
begin
  WriteInteger(Node, 'CountOnce', CountOnce);
  WriteInteger(Node, 'CountRepeat', CountRepeat);
  WriteInteger(Node, 'CellFrom', CellFrom.MapCell.Id);
  WriteInteger(Node, 'CellTo', CellTo.MapCell.Id);
end;

constructor TUnitMove.Create;
begin
  List := nil; // Is later set to parent list owning item
  FCellFrom := nil;
  FCellTo := nil;
end;

destructor TUnitMove.Destroy;
begin
  CellFrom := nil;
  CellTo := nil;
  List := nil;
  inherited;
end;

{ TPlayer }

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

procedure TPlayer.Clear;
begin
  TurnStats.Clear;
  Moves.Clear;
  PlayerMap.Clear;
end;

{procedure TPlayer.SetClient(AValue: TClient);
begin
  if FClient = AValue then Exit;
  if Assigned(FClient) then FClient.FControlPlayer := nil;
  FClient := AValue;
  if Assigned(FClient) then FClient.FControlPlayer := Self;
end;
}

procedure TPlayer.LoadFromNode(Node: TDOMNode);
var
  NewNode: TDOMNode;
begin
  inherited;
  StartCell := TGame(FGame).Map.Cells.FindById(ReadInteger(Node, 'StartCell', 0));

  with Node do begin
    NewNode := FindNode('Map');
    if Assigned(NewNode) then
      PlayerMap.LoadFromNode(NewNode);
    PlayerMap.Update;
  end;
  with Node do begin
    NewNode := FindNode('UnitMoves');
    if Assigned(NewNode) then
      Moves.LoadFromNode(NewNode);
  end;
  with Node do begin
    NewNode := FindNode('TurnStats');
    if Assigned(NewNode) then
      TurnStats.LoadFromNode(NewNode);
  end;
end;

procedure TPlayer.SaveToNode(Node: TDOMNode);
var
  NewNode: TDOMNode;
begin
  inherited;
  if Assigned(StartCell) then
    WriteInteger(Node, 'StartCell', StartCell.Id);

  with Node do begin
    NewNode := OwnerDocument.CreateElement('Map');
    AppendChild(NewNode);
    PlayerMap.SaveToNode(NewNode);
  end;
  with Node do begin
    NewNode := OwnerDocument.CreateElement('UnitMoves');
    AppendChild(NewNode);
    Moves.SaveToNode(NewNode);
  end;
  with Node do begin
    NewNode := OwnerDocument.CreateElement('TurnStats');
    AppendChild(NewNode);
    TurnStats.SaveToNode(NewNode);
  end;
end;

constructor TPlayer.Create;
begin
  inherited;
  Units := TUnits.Create(False);
  Moves := TUnitMoves.Create;
  Moves.Player := Self;
  StartUnits := DefaultPlayerStartUnits;
  StartCell := nil;
  PlayerMap := TPlayerMap.Create;
  PlayerMap.Player := Self;
  TurnStats := TGameTurnStats.Create;
end;

destructor TPlayer.Destroy;
var
  I: Integer;
begin
  //Client := nil;
  FreeAndNil(TurnStats);
  FreeAndNil(PlayerMap);
  FreeAndNil(Moves);
  for I := Units.Count - 1 downto 0 do
    Units[I].Player := nil;
  FreeAndNil(Units);
  inherited;
end;

procedure TPlayer.Assign(Source: TItem);
begin
  inherited;
  TotalCells := TPlayer(Source).TotalCells;
  TotalUnits := TPlayer(Source).TotalUnits;
  TotalCities := TPlayer(Source).TotalCities;
  TotalDiscovered := TPlayer(Source).TotalDiscovered;
  TotalWinObjectiveCells := TPlayer(Source).TotalWinObjectiveCells;
  StartCell := TPlayer(Source).StartCell;
  Color := TPlayer(Source).Color;
  Units.Assign(TPlayer(Source).Units);
  Moves.Assign(TPlayer(Source).Moves);
  Nation := TPlayer(Source).Nation;
end;

procedure TPlayer.LoadConfig(Config: TXmlConfig; Path: string);
begin
  with Config do begin
    Self.Name := string(GetValue(DOMString(Path + '/Name'), ''));
    Color := TColor(GetValue(DOMString(Path + '/Color'), 0));
    StartUnits := GetValue(DOMString(Path + '/StartUnits'), 5);
    Mode := TPlayerMode(GetValue(DOMString(Path + '/Mode'), 0));
    Defensive := GetValue(DOMString(Path + '/Defensive'), False);
    Agressivity := TComputerAgressivity(GetValue(DOMString(Path + '/Agressivity'), 0));
    Nation := TGame(Game).GameSystem.Nations.FindById(GetValue(DOMString(Path + '/Nation'), 0));
  end;
end;

procedure TPlayer.SaveConfig(Config: TXmlConfig; Path: string);
begin
  with Config do begin
    SetValue(DOMString(Path + '/Name'), DOMString(Self.Name));
    SetValue(DOMString(Path + '/Color'), Integer(Color));
    SetValue(DOMString(Path + '/StartUnits'), StartUnits);
    SetValue(DOMString(Path + '/Mode'), Integer(Mode));
    SetValue(DOMString(Path + '/Defensive'), Defensive);
    SetValue(DOMString(Path + '/Agressivity'), Integer(Agressivity));
    if Assigned(Nation) then
      SetValue(DOMString(Path + '/Nation'), Nation.Id)
      else SetValue(DOMString(Path + '/Nation'), 0)
  end;
end;

procedure TPlayer.Attack(var AttackPower, DefendPower: Integer);
var
  AttackerDiceCount: Integer;
  DefenderDiceCount: Integer;
  S: string;
  I: Integer;
  AttackRolls: TList<Integer>;
  DefendRolls: TList<Integer>;
begin
  AttackRolls := TList<Integer>.Create;
  DefendRolls := TList<Integer>.Create;
  if AttackPower < 1 then
    raise Exception.Create(SAttackerPowerPositive);
  if DefendPower < 0 then
    raise Exception.Create(SDefenderPowerPositive);
  while (AttackPower > 0) and (DefendPower > 0) do begin
    // Risk game rules:
    // Each side do their dice roll and compare result. Defender wins tie.
    // Attacker can use three dices and defender two
    AttackerDiceCount := Min(AttackPower, 3);
    DefenderDiceCount := Min(DefendPower, 2);
    // Roll and sort numbers
    AttackRolls.Count := AttackerDiceCount;
    for I := 0 to AttackerDiceCount - 1 do begin
      AttackRolls[I] := Random(7);
    end;
    AttackRolls.Sort(TComparer<Integer>.Construct(ComparePointer));
    S := 'Att:';
    for I := 0 to AttackerDiceCount - 1 do
      S := S + IntToStr(Integer(AttackRolls[I])) + ', ';
    DefendRolls.Count := DefenderDiceCount;
    for I := 0 to DefenderDiceCount - 1 do begin
      DefendRolls[I] := Random(7);
    end;
    DefendRolls.Sort(TComparer<Integer>.Construct(ComparePointer));
    S := S + ' Def:';
    for I := 0 to DefenderDiceCount - 1 do
      S := S + IntToStr(Integer(DefendRolls[I])) + ', ';
    // Resolution
    for I := 0 to Min(AttackerDiceCount, DefenderDiceCount) - 1 do
      if AttackRolls[I] > DefendRolls[I] then Dec(DefendPower)
      else Dec(AttackPower);
  end;
  FreeAndNil(AttackRolls);
  FreeAndNil(DefendRolls);
end;

function CellCompare(constref Item1, Item2: TPlayerCell): Integer;
var
  Stack1, Stack2: Integer;
begin
  if Assigned(Item1.MapCell.OneUnit) then Stack1 := Item1.MapCell.OneUnit.Power
    else Stack1 := 0;
  if Assigned(Item2.MapCell.OneUnit) then Stack2 := Item2.MapCell.OneUnit.Power
    else Stack2 := 0;
  if Stack1 > Stack1 then Result := 1
  else if Stack1 < Stack2 then Result := -1
  else Result := 0;
end;

function CellCompareDescending(constref Item1, Item2: TPlayerCell): Integer;
var
  Stack1, Stack2: Integer;
begin
  if Assigned(Item1.MapCell.OneUnit) then Stack1 := Item1.MapCell.OneUnit.Power
    else Stack1 := 0;
  if Assigned(Item2.MapCell.OneUnit) then Stack2 := Item2.MapCell.OneUnit.Power
    else Stack2 := 0;
  if Stack1 > Stack2 then Result := -1
  else if Stack1 < Stack2 then Result := 1
  else Result := 0;
end;

procedure TPlayer.MoveUnit(UnitMove: TUnitMove);
var
  AttackerPower: Integer;
  DefenderPower: Integer;
  UnitCount: Integer;
begin
  with UnitMove do begin
    UnitCount := CountOnce;
    if CountOnce > CellFrom.MapCell.OneUnit.Power then
      UnitCount := CellFrom.MapCell.OneUnit.Power;
    CountOnce := 0;
    if not Assigned(CellTo.MapCell.OneUnit) then begin
      CellTo.MapCell.OneUnit := TGame(Game).Units.AddNew(CellFrom.MapCell.OneUnit.Kind, 0);
      CellTo.MapCell.OneUnit.Player := Self;
      CellTo.MapCell.Player := Self;
    end;

    if CellTo.MapCell.OneUnit.Player = Self then begin
      // Inner move
      CellTo.MapCell.OneUnit.Power := CellTo.MapCell.OneUnit.Power + UnitCount;
      Dec(CellTo.MapCell.OneUnit.Moves);
    end else begin
      AttackerPower := UnitCount;
      if Assigned(CellTo.MapCell.OneUnit) then
        DefenderPower := CellTo.MapCell.OneUnit.Power
        else DefenderPower := 0;
      Attack(AttackerPower, DefenderPower);
      if DefenderPower = 0 then begin
        // Attacker wins with possible loses
        ClearMovesFromCell(CellTo);
        CellTo.MapCell.Player := Self;
        CellTo.MapCell.OneUnit.Player := Self;
        CellTo.MapCell.OneUnit.Power := AttackerPower;
      end else
      if AttackerPower = 0 then begin
        // Defender wins with possible loses
        CellTo.MapCell.OneUnit.Power := DefenderPower;
        CellTo.MapCell.OneUnit.Moves := CellFrom.MapCell.OneUnit.Moves - 1;
      end else
        raise Exception.Create(SUnfinishedBattle);
    end;
    CellFrom.MapCell.OneUnit.Power := CellFrom.MapCell.OneUnit.Power - UnitCount;
    CellFrom.MapCell.CheckOwnership;
  end;

  // Clean from cell from empty units
  if UnitMove.CellFrom.MapCell.OneUnit.Power = 0 then begin
    UnitMove.CellFrom.MapCell.OneUnit.Player := nil;
    UnitMove.CellFrom.MapCell.OneUnit := nil;
  end;

  // Remove empty move
  if (UnitMove.CellFrom.MapCell.Player = Self) and
    (UnitMove.CountOnce = 0) and (UnitMove.CountRepeat = 0) then
    Moves.Remove(UnitMove);
end;

procedure TPlayer.MoveAll;
var
  I: Integer;
begin
  for I := Moves.Count - 1 downto 0 do
  with Moves[I] do
  if CountOnce > 0 then begin
    if CellFrom.MapCell.Player = Self then begin
      MoveUnit(Moves[I]);
    end;
  end;
end;

procedure TPlayer.ReduceMovesPower;
var
  UnitMove: TUnitMove;
  Power: Integer;
begin
  // Power of cell can be reduced by unsucessful enemy attack
  for UnitMove in Moves do begin
    Power := UnitMove.CellFrom.GetAvialPower;
    if Power < 0 then begin
      if Abs(Power) < UnitMove.CountOnce then
        UnitMove.CountOnce := UnitMove.CountOnce - Abs(Power)
        else UnitMove.CountOnce := 0;
    end;
  end;
end;

procedure TPlayer.RemoveInvalidMoves;
var
  I: Integer;
begin
  for I := Moves.Count - 1 downto 0 do
    if Moves[I].CellFrom.MapCell.Player <> Self then
      Moves.Delete(I);
end;

procedure TPlayer.RemoveEmptyUnits;
var
  I: Integer;
  OneUnit: TUnit;
begin
  for I := 0 to PlayerMap.Cells.Count - 1 do
  with PlayerMap.Cells[I] do begin
    if Assigned(MapCell.OneUnit) and (MapCell.OneUnit.Power = 0) then begin
      OneUnit := MapCell.OneUnit;
      MapCell.OneUnit := nil;
      OneUnit.Player := nil;
    end;
  end;
end;

procedure TPlayer.InitUnitMoves;
var
  I: Integer;
begin
  for I := 0 to Units.Count - 1 do
    Units[I].Moves := Units[I].Kind.Moves;
end;

procedure TPlayer.ClearMovesFromCell(Cell: TPlayerCell);
var
  I: Integer;
  OtherPlayerCell: TPlayerCell;
begin
  if Assigned(Cell.MapCell.Player) then
  with TPlayer(Cell.MapCell.Player) do begin
    OtherPlayerCell := PlayerMap.Cells.SearchCell(Cell.MapCell);
    if Assigned(OtherPlayerCell) then begin
    for I := OtherPlayerCell.MovesFrom.Count - 1 downto 0 do
      Moves.Remove(OtherPlayerCell.MovesFrom[I]);
    end;
  end;
end;

function TPlayer.SetMove(CellFrom, CellTo: TPlayerCell; Power: Integer; Confirmation: Boolean = True): TUnitMove;
var
  NewMove: TUnitMove;
  CountOnce: Integer;
  CountRepeat: Integer;
  Confirm: Boolean;
begin
  if CellFrom.MapCell.Player <> Self then
    raise Exception.Create('Can''t set move of other player.');
  Confirm := True;
  Result := Moves.SearchByFromTo(CellFrom, CellTo);

  if Assigned(Result) then begin
    // Update existing move
    CountOnce := Result.CountOnce;
    CountRepeat := Result.CountRepeat;
    if (Mode = pmHuman) and Confirmation and
      Assigned(FOnMove) then
        FOnMove(CellFrom, CellTo, CountOnce, CountRepeat, True, Confirm);
  end else begin
    // Create new move
    CountOnce := Power;
    CountRepeat := 0;
    if (Mode = pmHuman) and Confirmation and
      Assigned(FOnMove) then
        FOnMove(CellFrom, CellTo, CountOnce, CountRepeat, False, Confirm);
  end;
  if Confirm then begin
    if Assigned(Result) then begin
      // Already have such move
      if (CountOnce = 0) and (CountRepeat = 0) then begin
          Result.List.Remove(Result);
        end else begin
          Result.CountOnce := CountOnce;
          Result.CountRepeat := CountRepeat;
          CheckCounterMove(Result);
        end;
    end else begin
      // Add new move
      if (CountOnce > 0) or (CountRepeat > 0) then begin
        NewMove := TUnitMove.Create;
        NewMove.List := Moves;
        NewMove.CellFrom := CellFrom;
        NewMove.CellTo := CellTo;
        NewMove.CountOnce := CountOnce;
        NewMove.CountRepeat := CountRepeat;
        Moves.Add(NewMove);
        Result := NewMove;
        CheckCounterMove(NewMove);
        if TGame(Game).GameSystem.UnitsMoveImmediately then begin
          MoveUnit(NewMove);
        end;
      end;
    end;
    if Assigned(TGame(Game).OnMoveUpdated) then
      TGame(Game).OnMoveUpdated(Result);
  end;
end;

procedure TPlayer.UpdateRepeatMoves;
var
  Move: TUnitMove;
  AvailPower: Integer;
begin
  for Move in Moves do
  with Move do begin
    if CellFrom.MapCell.Player = Self then begin
      AvailPower := CellFrom.GetAvialPower + Move.CountOnce;
      if CountRepeat <= AvailPower then
        CountOnce := CountRepeat
        else CountOnce := AvailPower;
    end;
  end;
end;

procedure TPlayer.UpdateEmptyCellsNeutral;
var
  I: Integer;
begin
  if TGame(Game).GameSystem.EmptyCellsNeutral then
  for I := 0 to PlayerMap.Cells.Count - 1 do
  with TPlayerCell(PlayerMap.Cells[I]) do begin
    MapCell.CheckOwnership;
  end;
end;

procedure TPlayer.Reset;
begin
  Moves.Clear;
  PlayerMap.Cells.Clear;
  TotalUnits := 0;
  TotalCells := 0;
  TotalCities := 0;
  TotalDiscovered := 0;
  TotalWinObjectiveCells := 0;
  TurnStats.Clear;
  StartCell := nil;
end;

procedure TPlayer.Surrender;
var
  I: Integer;
begin
  Moves.Clear;
  for I := 0 to PlayerMap.Cells.Count - 1 do
    if PlayerMap.Cells[I].MapCell.Player = Self then
      PlayerMap.Cells[I].MapCell.Player := nil;
end;

function TPlayer.IsAlive: Boolean;
begin
  Result := (TotalCells > 0) and Assigned(StartCell);
end;

procedure TPlayer.CheckCounterMove(Move: TUnitMove);
var
  CounterMove: TUnitMove;
begin
  CounterMove := Moves.SearchByFromTo(Move.CellTo, Move.CellFrom);
  if Assigned(CounterMove) then begin
    // For now, just remove counter move
    Moves.Remove(CounterMove);
  end;
end;

procedure TPlayer.SetMode(AValue: TPlayerMode);
begin
  if FMode = AValue then Exit;
  FMode := AValue;
end;

class function TPlayer.GetFields: TItemFields;
var
  Field: TItemField;
begin
  Result := inherited;
  Field := Result.AddField(2, 'Nation', SNation, dtReference);
  Field := Result.AddField(3, 'Mode', SMode, dtEnumeration);
  Field.EnumStates.Add(SHuman);
  Field.EnumStates.Add(SComputer);
  Result.AddField(4, 'Color', SColor, dtColor);
  Field := Result.AddField(5, 'Agressivity', SAgressivity, dtEnumeration);
  Field.EnumStates.Add(SLow);
  Field.EnumStates.Add(SMedium);
  Field.EnumStates.Add(SHigh);
  Field.VisibleIfIndex := 2;
  Field := Result.AddField(6, 'Defensive', SDefensive, dtBoolean);
  Field.VisibleIfIndex := 2;
  Result.AddField(7, 'StartUnits', SStartUnits, dtInteger);
end;

procedure TPlayer.GetValue(Index: Integer; out Value);
begin
  if Index = 1 then string(Value) := Name
  else if Index = 2 then TNation(Value) := Nation
  else if Index = 3 then TPlayerMode(Value) := Mode
  else if Index = 4 then TColor(Value) := Color
  else if Index = 5 then TComputerAgressivity(Value) := Agressivity
  else if Index = 6 then Boolean(Value) := Defensive
  else if Index = 7 then Integer(Value) := StartUnits
  else inherited;
end;

procedure TPlayer.SetValue(Index: Integer; var Value);
begin
  if Index = 1 then Name := string(Value)
  else if Index = 2 then Nation := TNation(Value)
  else if Index = 3 then Mode := TPlayerMode(Value)
  else if Index = 4 then Color := TColor(Value)
  else if Index = 5 then Agressivity := TComputerAgressivity(Value)
  else if Index = 6 then Defensive := Boolean(Value)
  else if Index = 7 then StartUnits := Integer(Value)
  else inherited;
end;

function TPlayer.GetReferenceList(Index: Integer): TBaseItemList;
begin
  if Index = 2 then Result := TGame(Game).GameSystem.Nations.BaseItemList
  else Result := nil;
end;

class function TPlayer.GetClassSysName: string;
begin
  Result := 'Player';
end;

class function TPlayer.GetClassName: string;
begin
  Result := SPlayer;
end;

function TPlayer.IsAllowedMoveTarget(CellFrom, CellTo: TPlayerCell): Boolean;
var
  CellToHasOwnUnit: Boolean;
  UnitHasMoveEnergy: Boolean;
begin
  CellToHasOwnUnit := Assigned(CellTo.MapCell.OneUnit) and
    (CellTo.MapCell.OneUnit.Player = Self) and (CellTo.MapCell.OneUnit.Power > 0);
  UnitHasMoveEnergy := Assigned(CellFrom.MapCell.OneUnit) and
    (CellFrom.MapCell.OneUnit.Moves > 0);
  Result := UnitHasMoveEnergy and
  TGame(Game).Map.IsCellsNeighbor(CellFrom.MapCell, CellTo.MapCell)
    and (TGame(Game).GameSystem.UnitsSplitMerge or
    (not TGame(Game).GameSystem.UnitsSplitMerge and not CellToHasOwnUnit));
end;

procedure TPlayer.Grow;
var
  I: Integer;
  Addition: Integer;
  Dies: Integer;
  NewUnit: TUnit;
begin
  with TGame(Game).Map do
  for I := 0 to Cells.Count - 1 do
  with Cells[I] do begin
    if (Player = Self) and ((TGame(Game).GrowCells = gcPlayerAll) or
    ((TGame(Game).GrowCells = gcPlayerCities) and (Assigned(Building) and (Building.Kind.SpecialType = stCity)))) then begin
      if not Assigned(OneUnit) then begin
        NewUnit := TGame(Game).Units.AddNew(TGame(Game).GameSystem.UnitKinds.First, 0);
        NewUnit.Player := Self;
        NewUnit.MapCell := Cells[I];
      end;
      if OneUnit.Power < MaxPower then begin
        // Increase units count
        Addition := 0;
        if TGame(Game).GrowAmount = gaByOne then begin
          Addition := 1;
        end else
        if TGame(Game).GrowAmount = gaBySquareRoot then begin
          Addition := Trunc(Sqrt(OneUnit.Power));
          if Addition = 0 then Addition := 1;
        end;
        if Assigned(Building) and (Building.Kind.BonusGrow > 0) then
          OneUnit.Power := OneUnit.Power + Trunc(OneUnit.Power * Building.Kind.BonusGrow / 100);
        OneUnit.Power := Min(OneUnit.Power + Addition, MaxPower);
      end else
      if OneUnit.Power > MaxPower then begin
        // Reduce units count
        // If cell has more then MaxPower units then additional units dies
        // in twice of squeare root of unites over MaxPower
        Dies := 2 * Trunc(Sqrt(OneUnit.Power - MaxPower));
        OneUnit.Power := Max(OneUnit.Power - Dies, 0);
      end;
    end;
  end;
end;

end.