source: tags/1.3.0/UPlayer.pas

unit UPlayer;

{$mode delphi}

interface

uses
  Classes, SysUtils, Graphics, UMap, DOM, fgl, XMLConf,
  UXMLUtils, Math, UGeometry;

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 GetAttackPower: Integer;
    procedure LoadFromNode(Node: TDOMNode);
    procedure SaveToNode(Node: TDOMNode);
    constructor Create;
    destructor Destroy; override;
  end;

  { TPlayerCells }

  TPlayerCells = class(TFPGObjectList<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;

  { TGameTurnStat }

  TGameTurnStat = class
    OccupiedCells: Integer;
    Units: Integer;
    DiscoveredCells: Integer;
    Cities: Integer;
    WinObjectiveCells: Integer;
    procedure LoadFromNode(Node: TDOMNode);
    procedure SaveToNode(Node: TDOMNode);
  end;

  { TGameTurnStats }

  TGameTurnStats = class(TFPGObjectList<TGameTurnStat>)
    procedure LoadFromNode(Node: TDOMNode);
    procedure SaveToNode(Node: TDOMNode);
  end;


  { TPlayer }

  TPlayer = class
  private
    FGame: TObject; //TGame;
    FMode: TPlayerMode;
    FOnMove: TMoveEvent;
    procedure SetGame(AValue: TObject); // TGame
    procedure Attack(var AttackPower, DefendPower: Integer);
    procedure ClearMovesFromCell(Cell: TPlayerCell);
    procedure CheckCounterMove(Move: TUnitMove);
    procedure SetMode(AValue: TPlayerMode);
    procedure RemoveEmptyUnitMoves;
  public
    Id: Integer;
    Name: string;
    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;
    procedure ReduceMovesPower;
    procedure RemoveInvalidMoves;
    procedure UpdateRepeatMoves;
    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);
    procedure SaveToNode(Node: TDOMNode);
    constructor Create;
    destructor Destroy; override;
    procedure Assign(Source: TPlayer);
    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;

  TPlayerArray = array of TPlayer;

  { TPlayers }

  TPlayers = class(TFPGObjectList<TPlayer>)
  public
    Game: TObject; //TGame;
    NewPlayerId: Integer;
    function FindById(Id: Integer): TPlayer;
    procedure New(Name: string; Color: TColor; Mode: TPlayerMode);
    function GetNewPlayerId: Integer;
    procedure LoadFromNode(Node: TDOMNode);
    procedure SaveToNode(Node: TDOMNode);
    constructor Create(FreeObjects: Boolean = True);
    function GetFirstHuman: TPlayer;
    procedure Assign(Source: TPlayers);
    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 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(TFPGObjectList<TUnitMove>)
    Game: TObject; //TGame;
    Player: TPlayer;
    function SearchByFromTo(CellFrom, CellTo: TPlayerCell): TUnitMove;
    procedure LoadFromNode(Node: TDOMNode);
    procedure SaveToNode(Node: TDOMNode);
  end;

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


implementation

uses
  UGame;

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';

function ComparePointer(const 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 := MapCell.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.FreeObjects := False;
  MovesTo := TUnitMoves.Create;
  MovesTo.FreeObjects := False;
  Neighbors := TPlayerCells.Create;
  Neighbors.FreeObjects := 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 Destroy;
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 TPlayerCell(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(TCell(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 Destroy;
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
  Player: TPlayer;
begin
  Result := 0;
  for Player in Self do
    if Player.IsAlive then Inc(Result);
end;

procedure TPlayers.GetAlivePlayers(Players: TPlayers);
var
  Player: TPlayer;
begin
  Players.Clear;
  for Player in Self do
    if Player.IsAlive then Players.Add(Player);
end;

function TPlayers.FindById(Id: Integer): TPlayer;
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 TPlayers.New(Name: string; Color: TColor; Mode: TPlayerMode);
var
  NewPlayer: TPlayer;
begin
  NewPlayer := TPlayer.Create;
  NewPlayer.Game := Game;
  NewPlayer.Name := Name;
  NewPlayer.Color := Color;
  NewPlayer.Mode := Mode;
  NewPlayer.Id := GetNewPlayerId;
  if Mode = pmComputer then
    NewPlayer.Agressivity := caMedium;
  Add(NewPlayer);
end;

function TPlayers.GetNewPlayerId: Integer;
begin
  Result := NewPlayerId;
  Inc(NewPlayerId);
end;

procedure TPlayers.LoadFromNode(Node: TDOMNode);
var
  Node2: TDOMNode;
  NewPlayer: TPlayer;
begin
  Count := 0;
  Node2 := Node.FirstChild;
  while Assigned(Node2) and (Node2.NodeName = 'Player') do begin
    NewPlayer := TPlayer.Create;
    NewPlayer.Game := Game;
    NewPlayer.LoadFromNode(Node2);
    Add(NewPlayer);
    Node2 := Node2.NextSibling;
  end;
end;

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

constructor TPlayers.Create(FreeObjects: Boolean = True);
begin
  inherited;
  NewPlayerId := 1;
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.Assign(Source: TPlayers);
var
  I: Integer;
begin
  while Count > Source.Count do
    Delete(Count - 1);
  while Count < Source.Count do
    Add(TPlayer.Create);
  for I := 0 to Count - 1 do begin
    Items[I].Assign(Source[I]);
    Items[I].Game := Game;
  end;
  NewPlayerId := Source.NewPlayerId;
end;

procedure TPlayers.LoadConfig(Config: TXmlConfig; Path: string);
var
  I: Integer;
  NewCount: Integer;
begin
  with Config do begin
    NewCount := GetValue(DOMString(Path + '/Count'), -1);
    NewPlayerId := 1;
    if NewCount >= 2 then begin
      Self.Clear;
      Count := NewCount;
      for I := 0 to Count - 1 do begin
        Items[I] := TPlayer.Create;
        Items[I].Id := GetNewPlayerId;
        Items[I].Game := Game;
        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
  Player: TPlayer;
begin
  SetLength(Result, 0);
  for Player in Self do
    if Player.IsAlive then begin
      SetLength(Result, Length(Result) + 1);
      Result[Length(Result) - 1] := Player;
    end;
end;

function TPlayers.GetAlivePlayersWithCities: TPlayerArray;
var
  Player: TPlayer;
begin
  SetLength(Result, 0);
  for Player in Self do
    if Player.TotalCities > 0 then begin
      SetLength(Result, Length(Result) + 1);
      Result[Length(Result) - 1] := Player;
    end;
end;

{ TUnitMoves }

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);
    TUnitMove(Items[I]).SaveToNode(NewNode);
  end;
end;

{ TUnitMove }

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

procedure TUnitMove.SetCellTo(AValue: TPlayerCell);
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;

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 Destroy;
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
  Id := ReadInteger(Node, 'Id', 0);
  Name := ReadString(Node, 'Name', '');
  Color := ReadInteger(Node, 'Color', clSilver);
  Mode := TPlayerMode(ReadInteger(Node, 'Mode', Integer(pmHuman)));
  StartCell := TGame(FGame).Map.Cells.FindById(ReadInteger(Node, 'StartCell', 0));
  StartUnits := ReadInteger(Node, 'StartUnits', 0);
  Agressivity := TComputerAgressivity(ReadInteger(Node, 'Agressivity', Integer(caMedium)));
  Defensive := ReadBoolean(Node, 'Defensive', False);

  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
  WriteInteger(Node, 'Id', Id);
  WriteString(Node, 'Name', Name);
  WriteInteger(Node, 'Color', Color);
  WriteInteger(Node, 'Mode', Integer(Mode));
  WriteInteger(Node, 'StartCell', StartCell.Id);
  WriteInteger(Node, 'StartUnits', StartUnits);
  WriteInteger(Node, 'Agressivity', Integer(Agressivity));
  WriteBoolean(Node, 'Defensive', Defensive);

  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
  Moves := TUnitMoves.Create;
  Moves.Player := Self;
  StartUnits := DefaultPlayerStartUnits;
  StartCell := nil;
  PlayerMap := TPlayerMap.Create;
  PlayerMap.Player := Self;
  TurnStats := TGameTurnStats.Create;
end;

destructor TPlayer.Destroy;
begin
  //Client := nil;
  FreeAndNil(TurnStats);
  FreeAndNil(PlayerMap);
  FreeAndNil(Moves);
  inherited Destroy;
end;

procedure TPlayer.Assign(Source: TPlayer);
begin
  Id := Source.Id;
  Name := Source.Name;
  Color := Source.Color;
  Mode := Source.Mode;
  Game := Source.Game;
  TotalCells := Source.TotalCells;
  TotalUnits := Source.TotalUnits;
  TotalCities := Source.TotalCities;
  TotalDiscovered := Source.TotalDiscovered;
  TotalWinObjectiveCells := Source.TotalWinObjectiveCells;
  StartUnits := Source.StartUnits;
  StartCell := Source.StartCell;
  Agressivity := Source.Agressivity;
  Defensive := Source.Defensive;
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));
  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));
  end;
end;

procedure TPlayer.Attack(var AttackPower, DefendPower: Integer);
var
  AttackerDiceCount: Integer;
  DefenderDiceCount: Integer;
  S: string;
  I: Integer;
  AttackRolls: TFPGList<Integer>;
  DefendRolls: TFPGList<Integer>;
begin
  AttackRolls := TFPGList<Integer>.Create;
  DefendRolls := TFPGList<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(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(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(const Item1, Item2: TPlayerCell): Integer;
begin
  if Item1.MapCell.Power > Item2.MapCell.Power then Result := 1
  else if Item1.MapCell.Power < Item2.MapCell.Power then Result := -1
  else Result := 0;
end;

function CellCompareDescending(const Item1, Item2: TPlayerCell): Integer;
begin
  if Item1.MapCell.Power > Item2.MapCell.Power then Result := -1
  else if Item1.MapCell.Power < Item2.MapCell.Power then Result := 1
  else Result := 0;
end;

procedure TPlayer.MoveAll;
var
  AttackerPower: Integer;
  DefenderPower: Integer;
  UnitCount: Integer;
  UnitMove: TUnitMove;
begin
  for UnitMove in Moves do
  with UnitMove do begin
  if CountOnce > 0 then begin
    if CellFrom.MapCell.Player = Self then begin
      UnitCount := CountOnce;
      if CountOnce > CellFrom.MapCell.Power then
        UnitCount := CellFrom.MapCell.Power;
      CountOnce := 0;
      if CellTo.MapCell.Player = Self then begin
        // Inner move
        CellTo.MapCell.Power := CellTo.MapCell.Power + UnitCount;
      end else begin
        AttackerPower := UnitCount;
        DefenderPower := CellTo.MapCell.Power;
        Attack(AttackerPower, DefenderPower);
        if DefenderPower = 0 then begin
          // Attacker wins with possible loses
          ClearMovesFromCell(CellTo);
          CellTo.MapCell.Player := Self;
          CellTo.MapCell.Power := AttackerPower;
        end else
        if AttackerPower = 0 then begin
          // Defender wins with possible loses
          CellTo.MapCell.Power := DefenderPower;
        end else
          raise Exception.Create(SUnfinishedBattle);
      end;
      CellFrom.MapCell.Power := CellFrom.MapCell.Power - UnitCount;
    end;
    end;
  end;

  RemoveEmptyUnitMoves;
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.ClearMovesFromCell(Cell: TPlayerCell);
var
  I: Integer;
begin
  for I := Cell.MovesFrom.Count - 1 downto 0 do
    Cell.MovesFrom.Delete(I);
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
    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
    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);
      end;
    end;
    if Assigned(TGame(Game).OnMoveUpdated) then
      TGame(Game).OnMoveUpdated(Result);
  end;
end;

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

procedure TPlayer.RemoveEmptyUnitMoves;
var
  I: Integer;
begin
  // Remove empty moves
  for I := Moves.Count - 1 downto 0 do
  if (TUnitMove(Moves[I]).CellFrom.MapCell.Player = Self) and
    (TUnitMove(Moves[I]).CountOnce = 0) and (TUnitMove(Moves[I]).CountRepeat = 0) then
    Moves.Delete(I);
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;

procedure TPlayer.Grow;
var
  I: Integer;
  Addition: Integer;
  Dies: Integer;
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 (Terrain = ttCity))) then begin
      if 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(Power));
          if Addition = 0 then Addition := 1;
        end;
        Power := Min(Power + Addition, MaxPower);
      end else
      if 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(Power - MaxPower));
        Power := Max(Power - Dies, 0);
      end;
    end;
  end;
end;

{ TGameTurnStat }

procedure TGameTurnStat.LoadFromNode(Node: TDOMNode);
begin
  OccupiedCells := ReadInteger(Node, 'OccupiedCells', 0);
  Units := ReadInteger(Node, 'Units', 0);
  DiscoveredCells := ReadInteger(Node, 'DiscoveredCells', 0);
  Cities := ReadInteger(Node, 'Cities', 0);
  WinObjectiveCells := ReadInteger(Node, 'WinObjectiveCells', 0);
end;

procedure TGameTurnStat.SaveToNode(Node: TDOMNode);
begin
  WriteInteger(Node, 'OccupiedCells', OccupiedCells);
  WriteInteger(Node, 'Units', Units);
  WriteInteger(Node, 'DiscoveredCells', DiscoveredCells);
  WriteInteger(Node, 'Cities', Cities);
  WriteInteger(Node, 'WinObjectiveCells', WinObjectiveCells);
end;

{ TGameTurnStats }

procedure TGameTurnStats.LoadFromNode(Node: TDOMNode);
var
  Node2: TDOMNode;
  NewTurnStat: TGameTurnStat;
begin
  Count := 0;
  Node2 := Node.FirstChild;
  while Assigned(Node2) and (Node2.NodeName = 'TurnStat') do begin
    NewTurnStat := TGameTurnStat.Create;
    NewTurnStat.LoadFromNode(Node2);
    Add(NewTurnStat);
    Node2 := Node2.NextSibling;
  end;
end;

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


end.