Changeset 231 for trunk/UGame.pas


Ignore:
Timestamp:
Sep 19, 2018, 2:05:52 PM (6 years ago)
Author:
chronos
Message:
  • Modified: UGame unit was split to UPlayer, UMap and UClientGUI units to have better logical separation of game classes.
  • Modified: Drawing methods moved from TMap and TPlayerMap to TClientGUI. Generic TClient class and TComputer classes don't need have any drawing support.
File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/UGame.pas

    r229 r231  
    88  Classes, SysUtils, ExtCtrls, Graphics, XMLConf, XMLRead, XMLWrite, Forms,
    99  DOM, Math, LazFileUtils, UXMLUtils, Dialogs, Types, LCLType, LCLIntf, fgl,
    10   UGeometry;
     10  UGeometry, UPlayer, UMap, UMapType;
    1111
    1212const
    1313  DefaultPlayerStartUnits = 5;
    14   SquareCellMulX = 1.05;
    15   SquareCellMulY = 1.05;
    16   TriangleCellMulX = 0.55;
    17   TriangleCellMulY = 1.05;
    1814  MaxPlayerCount = 8;
    19   DefaultMaxPower = 99;
    2015
    2116type
    2217  TGame = class;
    23   TPlayer = class;
    24   TView = class;
    25   TUnitMoves = class;
    26   TCells = class;
    27   TMap = class;
    28   TCellLinks = class;
    29   TMapArea = class;
    30   TPlayerCells = class;
    31   TPlayerCell = class;
    32   TPlayerMap = class;
    33 
    34   TTerrainType = (ttVoid, ttNormal, ttCity);
    35   TExtraType = (etNone, etObjectiveTarget, etAttack, etDefense, etLookout,
    36     etGrowLow, etGrowMedium, etGrowHigh);
    37 
    38   { TCell }
    39 
    40   TCell = class
    41   private
    42     FArea: TMapArea;
    43     FId: Integer;
    44     FMap: TMap;
    45     FPower: Integer;
    46     procedure SetArea(AValue: TMapArea);
    47     procedure SetId(AValue: Integer);
    48     procedure SetPower(AValue: Integer);
    49   public
    50     PosPx: TPoint;
    51     Polygon: TPolygon;
    52     Terrain: TTerrainType;
    53     PlayerId: Integer;
    54     Player: TPlayer;
    55     NeighborsId: array of Integer;
    56     Neighbors: TCells;
    57     Mark: Boolean; // Temporary value
    58     Weight: Integer; // Temporary value
    59     Angle: Double; // Temporary value
    60     PlayerCell: Pointer; // Temporary value
    61     Links: TCellLinks;
    62     Extra: TExtraType;
    63     property Id: Integer read FId write SetId;
    64     procedure ConnectTo(Cell: TCell);
    65     procedure DisconnectFrom(Cell: TCell);
    66     function NeighboringToVoid: Boolean;
    67     procedure AreaExtend;
    68     procedure FixRefId;
    69     procedure LoadFromNode(Node: TDOMNode);
    70     procedure SaveToNode(Node: TDOMNode);
    71     procedure Assign(Source: TCell);
    72     function IsVisible(View: TView): Boolean;
    73     function GetColor: TColor;
    74     function ToString: ansistring; override;
    75     constructor Create;
    76     destructor Destroy; override;
    77     property Power: Integer read FPower write SetPower;
    78     property Map: TMap read FMap write FMap;
    79     property Area: TMapArea read FArea write SetArea;
    80   end;
    81 
    82   TCellArray = array of TCell;
    83 
    84   { TCells }
    85 
    86   TCells = class(TFPGObjectList<TCell>)
    87     Map: TMap;
    88     procedure FixRefId;
    89     function FindById(Id: Integer): TCell;
    90     procedure GetCellsWithWeight(List: TCells; Low, High: Integer);
    91     procedure GetCellsWithExtra(List: TCells; Extra: TExtraType);
    92     procedure LoadFromNode(Node: TDOMNode);
    93     procedure SaveToNode(Node: TDOMNode);
    94     procedure ClearMark;
    95     procedure ClearWeight;
    96     function ToString: ansistring; override;
    97   end;
    98 
    99   { TCellLink }
    100 
    101   TCellLink = class
    102     Points: array of TPoint;
    103     Cells: TCells;
    104     Map: TMap;
    105     procedure LoadFromNode(Node: TDOMNode);
    106     procedure SaveToNode(Node: TDOMNode);
    107     constructor Create;
    108     destructor Destroy; override;
    109   end;
    110 
    111   { TCellLinks }
    112 
    113   TCellLinks = class(TFPGObjectList<TCellLink>)
    114     Map: TMap;
    115     function FindByCells(Cell1, Cell2: TCell): TCellLink;
    116     function AddLink(Cell1, Cell2: TCell): TCellLink;
    117     procedure LoadFromNode(Node: TDOMNode);
    118     procedure SaveToNode(Node: TDOMNode);
    119   end;
    120 
    121   { TCellLinkParams }
    122 
    123   TCellLinkParams = class
    124     Cell1: TCell;
    125     Cell2: TCell;
    126     Distance: Double;
    127     Angle: Double;
    128   end;
    129 
    130   { TView }
    131 
    132   TView = class
    133   private
    134     FDestRect: TRect;
    135     FZoom: Double;
    136     procedure SetDestRect(AValue: TRect);
    137     procedure SetZoom(AValue: Double);
    138   public
    139     Game: TGame;
    140     SourceRect: TRect;
    141     FocusedCell: TPlayerCell;
    142     SelectedCell: TPlayerCell;
    143     procedure Clear;
    144     constructor Create;
    145     destructor Destroy; override;
    146     procedure SelectCell(Pos: TPoint; Player: TPlayer; ShiftState: TShiftState);
    147     procedure CenterMap;
    148     procedure CenterPlayerCity(Player: TPlayer);
    149     function CanvasToCellPos(Pos: TPoint): TPoint;
    150     function CellToCanvasPos(Pos: TPoint): TPoint;
    151     function CanvasToCellRect(Pos: TRect): TRect;
    152     function CellToCanvasRect(Pos: TRect): TRect;
    153     procedure Assign(Source: TView);
    154     property DestRect: TRect read FDestRect write SetDestRect;
    155     property Zoom: Double read FZoom write SetZoom;
    156   end;
    15718
    15819  { TCanvasEx }
    … …  
    16223    class procedure PolygonEx(Canvas: TCanvas; const Points: array of Classes.TPoint; Winding: Boolean);
    16324  end;
    164 
    165   TMapShape = (msRectangle, msImage, msRounded);
    166 
    167   { TMapArea }
    168 
    169   TMapArea = class
    170     Id: Integer;
    171     Map: TMap;
    172     BridgeCount: Integer;
    173     Cells: TCells;
    174     procedure GetBorderCells(List: TCells);
    175     constructor Create;
    176     destructor Destroy; override;
    177   end;
    178 
    179   TMapAreas = class(TFPGObjectList<TMapArea>)
    180   end;
    181 
    182   { TMap }
    183 
    184   TMap = class
    185   private
    186     FSize: TPoint;
    187     function GetPixelRect: TRect;
    188     function GetSize: TPoint; virtual;
    189     procedure PaintCell(Canvas: TCanvas; Pos: TPoint; Text: string; View: TView;
    190       Cell: TCell);
    191     procedure DrawArrow(Canvas: TCanvas; View: TView; Pos: TPoint; Angle: Double;
    192       Text: string);
    193     function SearchDifferentCellArea(List: TCells; SourceArea,
    194       DestArea: TMapArea): TCell;
    195     procedure SetSize(AValue: TPoint); virtual;
    196   protected
    197     FPixelRect: TRect;
    198     FNewCellId: Integer;
    199     function GetNewCellId: Integer; virtual;
    200     procedure SortNeighborsByAngle;
    201   public
    202     Game: TGame;
    203     MaxPower: Integer;
    204     DefaultCellSize: TPoint;
    205     Cells: TCells;
    206     Shape: TMapShape;
    207     Image: TImage;
    208     CellLinks: TCellLinks;
    209     Areas: TMapAreas;
    210     Cyclic: Boolean;
    211     procedure Paint(Canvas: TCanvas; View: TView);
    212     function IsOutsideShape(Coord: TPoint): Boolean; virtual;
    213     function IsCellsNeighbor(Cell1, Cell2: TCell): Boolean; virtual;
    214     function IsValidIndex(Index: TPoint): Boolean; virtual;
    215     procedure Assign(Source: TMap); virtual;
    216     procedure LoadFromFile(FileName: string); virtual;
    217     procedure SaveToFile(FileName: string); virtual;
    218     procedure LoadFromNode(Node: TDOMNode);
    219     procedure SaveToNode(Node: TDOMNode);
    220     function PosToCell(Pos: TPoint; View: TView): TCell; virtual;
    221     function CellToPos(Cell: TCell): TPoint; virtual;
    222     procedure Grow(APlayer: TPlayer); virtual;
    223     procedure ComputePlayerStats; virtual;
    224     procedure Generate; virtual;
    225     procedure BuildMapAreas;
    226     procedure BuildBridges;
    227     procedure MakeSymetric;
    228     procedure CreateLinks;
    229     procedure Clear;
    230     procedure CheckCells;
    231     constructor Create; virtual;
    232     destructor Destroy; override;
    233     function CalculatePixelRect: TRect; virtual;
    234     procedure ForEachCells(Method: TMethod); virtual;
    235     property Size: TPoint read GetSize write SetSize;
    236     property PixelRect: TRect read GetPixelRect;
    237   end;
    238 
    239   { TPlayerCell }
    240 
    241   TPlayerCell = class
    242     MovesFrom: TUnitMoves;
    243     MovesTo: TUnitMoves;
    244     Explored: Boolean;
    245     InVisibleRange: Boolean;
    246     MapCell: TCell;
    247     List: TPlayerCells;
    248     Neighbors: TPlayerCells;
    249     procedure ConnectTo(Cell: TPlayerCell);
    250     procedure DisconnectFrom(Cell: TPlayerCell);
    251     function GetAvialPower: Integer;
    252     function GetAttackPower: Integer;
    253     procedure LoadFromNode(Node: TDOMNode);
    254     procedure SaveToNode(Node: TDOMNode);
    255     constructor Create;
    256     destructor Destroy; override;
    257   end;
    258 
    259   { TPlayerCells }
    260 
    261   TPlayerCells = class(TFPGObjectList<TPlayerCell>)
    262     Map: TPlayerMap;
    263     function FindByCellId(Id: Integer): TPlayerCell;
    264     function SearchCell(Cell: TCell): TPlayerCell;
    265     procedure LoadFromNode(Node: TDOMNode);
    266     procedure SaveToNode(Node: TDOMNode);
    267   end;
    268 
    269   { TPlayerMap }
    270 
    271   TPlayerMap = class
    272     Cells: TPlayerCells;
    273     Player: TPlayer;
    274     procedure PaintCell(Canvas: TCanvas; Pos: TPoint; Text: string; View: TView;
    275       Cell: TPlayerCell);
    276     function PosToCell(Pos: TPoint; View: TView): TPlayerCell; virtual;
    277     function CellToPos(Cell: TPlayerCell): TPoint; virtual;
    278     procedure LoadFromNode(Node: TDOMNode);
    279     procedure SaveToNode(Node: TDOMNode);
    280     procedure Update;
    281     constructor Create;
    282     destructor Destroy; override;
    283     procedure CheckVisibility;
    284     procedure Paint(Canvas: TCanvas; View: TView);
    285   end;
    286 
    287   { TGameTurnStat }
    288 
    289   TGameTurnStat = class
    290     OccupiedCells: Integer;
    291     Units: Integer;
    292     DiscoveredCells: Integer;
    293     Cities: Integer;
    294     WinObjectiveCells: Integer;
    295     procedure LoadFromNode(Node: TDOMNode);
    296     procedure SaveToNode(Node: TDOMNode);
    297   end;
    298 
    299   { TGameTurnStats }
    300 
    301   TGameTurnStats = class(TFPGObjectList<TGameTurnStat>)
    302     procedure LoadFromNode(Node: TDOMNode);
    303     procedure SaveToNode(Node: TDOMNode);
    304   end;
    305 
    306   TPlayerMode = (pmHuman, pmComputer);
    307   TComputerAgressivity = (caLow, caMedium, caHigh);
    308   TUnitMove = class;
    309 
    310   TMoveEvent = procedure(CellFrom, CellTo: TPlayerCell; var CountOnce, CountRepeat: Integer;
    311     Update: Boolean; var Confirm: Boolean) of object;
    312 
    313   { TPlayer }
    314 
    315   TPlayer = class
    316   private
    317     FGame: TGame;
    318     FMode: TPlayerMode;
    319     FOnMove: TMoveEvent;
    320     procedure SetGame(AValue: TGame);
    321     procedure Attack(var AttackPower, DefendPower: Integer);
    322     procedure ClearMovesFromCell(Cell: TPlayerCell);
    323     procedure MoveAll;
    324     procedure ReduceMovesPower;
    325     procedure RemoveInvalidMoves;
    326     procedure CheckCounterMove(Move: TUnitMove);
    327     procedure SetMode(AValue: TPlayerMode);
    328     procedure UpdateRepeatMoves;
    329     procedure RemoveEmptyUnitMoves;
    330   public
    331     Id: Integer;
    332     Name: string;
    333     Color: TColor;
    334     TotalUnits: Integer;
    335     TotalCells: Integer;
    336     TotalCities: Integer;
    337     TotalDiscovered: Integer;
    338     TotalWinObjectiveCells: Integer;
    339     StartUnits: Integer;
    340     StartCell: TCell;
    341     PlayerMap: TPlayerMap;
    342     Defensive: Boolean;
    343     Agressivity: TComputerAgressivity;
    344     TurnStats: TGameTurnStats;
    345     Moves: TUnitMoves;
    346     function SetMove(CellFrom, CellTo: TPlayerCell; Power: Integer; Confirmation: Boolean = True): TUnitMove;
    347     procedure Reset;
    348     procedure Surrender;
    349     function IsAlive: Boolean;
    350     procedure Clear;
    351     procedure LoadFromNode(Node: TDOMNode);
    352     procedure SaveToNode(Node: TDOMNode);
    353     procedure Paint(Canvas: TCanvas; View: TView);
    354     constructor Create;
    355     destructor Destroy; override;
    356     procedure Assign(Source: TPlayer);
    357     procedure LoadConfig(Config: TXmlConfig; Path: string);
    358     procedure SaveConfig(Config: TXmlConfig; Path: string);
    359     property Game: TGame read FGame write SetGame;
    360     property Mode: TPlayerMode read FMode write SetMode;
    361     property OnMove: TMoveEvent read FOnMove write FOnMove;
    362   end;
    363 
    364   TPlayerArray = array of TPlayer;
    365 
    366   { TPlayers }
    367 
    368   TPlayers = class(TFPGObjectList<TPlayer>)
    369   public
    370     Game: TGame;
    371     NewPlayerId: Integer;
    372     function FindById(Id: Integer): TPlayer;
    373     procedure New(Name: string; Color: TColor; Mode: TPlayerMode);
    374     function GetNewPlayerId: Integer;
    375     procedure LoadFromNode(Node: TDOMNode);
    376     procedure SaveToNode(Node: TDOMNode);
    377     constructor Create(FreeObjects: Boolean = True);
    378     function GetFirstHuman: TPlayer;
    379     procedure Assign(Source: TPlayers);
    380     procedure LoadConfig(Config: TXmlConfig; Path: string);
    381     procedure SaveConfig(Config: TXmlConfig; Path: string);
    382     function GetAliveCount: Integer;
    383     procedure GetAlivePlayers(Players: TPlayers); overload;
    384     function GetAlivePlayers: TPlayerArray; overload;
    385     function GetAlivePlayersWithCities: TPlayerArray;
    386   end;
    387 
    388   { TUnitMove }
    389 
    390   TUnitMove = class
    391   private
    392     FCellFrom: TPlayerCell;
    393     FCellTo: TPlayerCell;
    394     procedure SetCellFrom(AValue: TPlayerCell);
    395     procedure SetCellTo(AValue: TPlayerCell);
    396   public
    397     List: TUnitMoves;
    398     CountOnce: Integer;
    399     CountRepeat: Integer;
    400     procedure LoadFromNode(Node: TDOMNode);
    401     procedure SaveToNode(Node: TDOMNode);
    402     constructor Create;
    403     destructor Destroy; override;
    404     property CellFrom: TPlayerCell read FCellFrom write SetCellFrom;
    405     property CellTo: TPlayerCell read FCellTo write SetCellTo;
    406   end;
    407 
    408   { TUnitMoves }
    409 
    410   TUnitMoves = class(TFPGObjectList<TUnitMove>)
    411     Game: TGame;
    412     Player: TPlayer;
    413     function SearchByFromTo(CellFrom, CellTo: TPlayerCell): TUnitMove;
    414     procedure LoadFromNode(Node: TDOMNode);
    415     procedure SaveToNode(Node: TDOMNode);
    416   end;
    417 
    418   TMoveUpdatedEvent = procedure(UnitMove: TUnitMove) of object;
    41925
    42026  TWinEvent = procedure(Player: TPlayer) of object;
    … …  
    506112
    507113procedure InitStrings;
    508 function CellCompare(const Item1, Item2: TPlayerCell): Integer;
    509 function CellCompareDescending(const Item1, Item2: TPlayerCell): Integer;
    510114
    511115resourcestring
    … …  
    515119
    516120implementation
    517 
    518 uses
    519   UMap;
    520121
    521122resourcestring
    … …  
    524125  SComputer = 'Computer';
    525126  SWrongFileFormat = 'Wrong file format';
    526   SUnfinishedBattle = 'Unfinished battle';
    527127  SNewGameFile = 'New game.xtg';
    528   SZeroZoomNotAlowed = 'Zero zoom not allowed';
    529   SCellRemoveNeighborError = 'Can''t remove cell from neighbour cell';
    530   SNegativeCellPowerNotAllowed = 'Not allowed to substract power under zero to negative value';
    531   SAttackerPowerPositive = 'Attacker power have to be higher then 0.';
    532   SDefenderPowerPositive = 'Defender power have to be higher then or equal to 0.';
    533128  SUnitPowerMismatch = 'Unit move power mismatch. Cell power is %d but %d moved away.';
    534129
    … …  
    546141    ((((Color shr 16) and $ff) shr 1) shl 16) or
    547142    ((((Color shr 24) and $ff) shr 0) shl 24);
    548 end;
    549 
    550 function ComparePointer(const Item1, Item2: Integer): Integer;
    551 begin
    552   Result := -CompareValue(Item1, Item2);
    553 end;
    554 
    555 
    556 { TGameTurnStat }
    557 
    558 procedure TGameTurnStat.LoadFromNode(Node: TDOMNode);
    559 begin
    560   OccupiedCells := ReadInteger(Node, 'OccupiedCells', 0);
    561   Units := ReadInteger(Node, 'Units', 0);
    562   DiscoveredCells := ReadInteger(Node, 'DiscoveredCells', 0);
    563   Cities := ReadInteger(Node, 'Cities', 0);
    564   WinObjectiveCells := ReadInteger(Node, 'WinObjectiveCells', 0);
    565 end;
    566 
    567 procedure TGameTurnStat.SaveToNode(Node: TDOMNode);
    568 begin
    569   WriteInteger(Node, 'OccupiedCells', OccupiedCells);
    570   WriteInteger(Node, 'Units', Units);
    571   WriteInteger(Node, 'DiscoveredCells', DiscoveredCells);
    572   WriteInteger(Node, 'Cities', Cities);
    573   WriteInteger(Node, 'WinObjectiveCells', WinObjectiveCells);
    574 end;
    575 
    576 { TGameTurnStats }
    577 
    578 procedure TGameTurnStats.LoadFromNode(Node: TDOMNode);
    579 var
    580   Node2: TDOMNode;
    581   NewTurnStat: TGameTurnStat;
    582 begin
    583   Count := 0;
    584   Node2 := Node.FirstChild;
    585   while Assigned(Node2) and (Node2.NodeName = 'TurnStat') do begin
    586     NewTurnStat := TGameTurnStat.Create;
    587     NewTurnStat.LoadFromNode(Node2);
    588     Add(NewTurnStat);
    589     Node2 := Node2.NextSibling;
    590   end;
    591 end;
    592 
    593 procedure TGameTurnStats.SaveToNode(Node: TDOMNode);
    594 var
    595   I: Integer;
    596   NewNode: TDOMNode;
    597 begin
    598   for I := 0 to Count - 1 do begin;
    599     NewNode := Node.OwnerDocument.CreateElement('TurnStat');
    600     Node.AppendChild(NewNode);
    601     TGameTurnStat(Items[I]).SaveToNode(NewNode);
    602   end;
    603 end;
    604 
    605 { TCellLink }
    606 
    607 procedure TCellLink.LoadFromNode(Node: TDOMNode);
    608 var
    609   Node2: TDOMNode;
    610   Node3: TDOMNode;
    611 begin
    612   Node3 := Node.FindNode('Points');
    613   if Assigned(Node3) then begin
    614     SetLength(Points, 0);
    615     Node2 := Node3.FirstChild;
    616     while Assigned(Node2) and (Node2.NodeName = 'Point') do begin
    617       SetLength(Points, Length(Points) + 1);
    618       Points[High(Points)].X := ReadInteger(Node2, 'X', 0);
    619       Points[High(Points)].Y := ReadInteger(Node2, 'Y', 0);
    620       Node2 := Node2.NextSibling;
    621     end;
    622   end;
    623 end;
    624 
    625 procedure TCellLink.SaveToNode(Node: TDOMNode);
    626 var
    627   NewNode: TDOMNode;
    628   NewNode2: TDOMNode;
    629   I: Integer;
    630 begin
    631   NewNode := Node.OwnerDocument.CreateElement('Points');
    632   Node.AppendChild(NewNode);
    633   for I := 0 to Length(Points) - 1 do begin
    634     NewNode2 := NewNode.OwnerDocument.CreateElement('Point');
    635     NewNode.AppendChild(NewNode2);
    636     WriteInteger(NewNode2, 'X', Points[I].X);
    637     WriteInteger(NewNode2, 'Y', Points[I].Y);
    638   end;
    639 end;
    640 
    641 constructor TCellLink.Create;
    642 begin
    643   Cells := TCells.Create;
    644   Cells.FreeObjects := False;
    645 end;
    646 
    647 destructor TCellLink.Destroy;
    648 var
    649   I: Integer;
    650 begin
    651   for I := 0 to Cells.Count - 1 do begin
    652     if Cells[I].Neighbors.Remove(Cells[1 - I]) = -1 then
    653       raise Exception.Create(SCellRemoveNeighborError);
    654     if Cells[I].Links.Remove(Self) = -1 then
    655       raise Exception.Create(SCellRemoveNeighborError);
    656   end;
    657   FreeAndNil(Cells);
    658   inherited Destroy;
    659 end;
    660 
    661 { TCellLinks }
    662 
    663 function TCellLinks.FindByCells(Cell1, Cell2: TCell): TCellLink;
    664 var
    665   I: Integer;
    666 begin
    667   I := 0;
    668   while (I < Count) do begin
    669     if ((TCellLink(Items[I]).Cells[0] = Cell1) and (TCellLink(Items[I]).Cells[1] = Cell2)) or
    670     ((TCellLink(Items[I]).Cells[0] = Cell2) and (TCellLink(Items[I]).Cells[1] = Cell1)) then
    671       Break;
    672     Inc(I);
    673   end;
    674   if I < Count then Result := TCellLink(Items[I])
    675     else Result := nil;
    676 end;
    677 
    678 function TCellLinks.AddLink(Cell1, Cell2: TCell): TCellLink;
    679 begin
    680   Result := TCellLink.Create;
    681   Cell1.Neighbors.Add(Cell2);
    682   Cell1.Links.Add(Result);
    683   Cell2.Neighbors.Add(Cell1);
    684   Cell2.Links.Add(Result);
    685   SetLength(Result.Points, 2);
    686   Result.Cells.Add(Cell1);
    687   Result.Points[0] := Cell1.PosPx;
    688   Result.Cells.Add(Cell2);
    689   Result.Points[1] := Cell2.PosPx;
    690   Result.Map := Map;
    691   Map.CellLinks.Add(Result);
    692 end;
    693 
    694 procedure TCellLinks.LoadFromNode(Node: TDOMNode);
    695 var
    696   Node2: TDOMNode;
    697   NewCell: TCellLink;
    698 begin
    699   Count := 0;
    700   Node2 := Node.FirstChild;
    701   while Assigned(Node2) and (Node2.NodeName = 'CellLink') do begin
    702     NewCell := TCellLink.Create;
    703     //NewCell.Map := Map;
    704     NewCell.LoadFromNode(Node2);
    705     Add(NewCell);
    706     Node2 := Node2.NextSibling;
    707   end;
    708 end;
    709 
    710 procedure TCellLinks.SaveToNode(Node: TDOMNode);
    711 var
    712   I: Integer;
    713   NewNode2: TDOMNode;
    714 begin
    715   for I := 0 to Count - 1 do
    716   with TCellLink(Items[I]) do begin
    717     NewNode2 := Node.OwnerDocument.CreateElement('CellLink');
    718     Node.AppendChild(NewNode2);
    719     SaveToNode(NewNode2);
    720   end;
    721 end;
    722 
    723 { TMapArea }
    724 
    725 procedure TMapArea.GetBorderCells(List: TCells);
    726 var
    727   Cell: TCell;
    728 begin
    729   List.Clear;
    730   Map.Cells.ClearMark;
    731   for Cell in Cells do begin
    732     if Cell.NeighboringToVoid and (Cell.Area = Self) and (not Cell.Mark) then begin
    733       List.Add(Cell);
    734       Cell.Mark := True;
    735     end;
    736   end;
    737 end;
    738 
    739 constructor TMapArea.Create;
    740 begin
    741   Cells := TCells.Create;
    742   Cells.FreeObjects := False;
    743 end;
    744 
    745 destructor TMapArea.Destroy;
    746 begin
    747   FreeAndNil(Cells);
    748   inherited Destroy;
    749 end;
    750 
    751 { TPlayerCell }
    752 
    753 procedure TPlayerCell.LoadFromNode(Node: TDOMNode);
    754 begin
    755   Explored := ReadBoolean(Node, 'Explored', False);
    756   MapCell := List.Map.Player.Game.Map.Cells.FindById(ReadInteger(Node, 'MapCell', 0));
    757 end;
    758 
    759 procedure TPlayerCell.ConnectTo(Cell: TPlayerCell);
    760 begin
    761   if (Cell.Neighbors.IndexOf(Self) = -1) and
    762   (Neighbors.IndexOf(Cell) = -1) then begin;
    763     Cell.Neighbors.Add(Self);
    764     Neighbors.Add(Cell);
    765   end;
    766 end;
    767 
    768 procedure TPlayerCell.DisconnectFrom(Cell: TPlayerCell);
    769 var
    770   I: Integer;
    771 begin
    772   I := Cell.Neighbors.IndexOf(Self);
    773   if I >= 0 then Cell.Neighbors.Delete(I) else
    774     raise Exception.Create('Can''t disconnect neigboring cells.');
    775   I := Neighbors.IndexOf(Cell);
    776   if I >= 0 then Neighbors.Delete(I)
    777     else Exception.Create('Can''t disconnect neigboring cells.');
    778 end;
    779 
    780 function TPlayerCell.GetAvialPower: Integer;
    781 var
    782   UnitMove: TUnitMove;
    783 begin
    784   Result := MapCell.Power;
    785   for UnitMove in MovesFrom do
    786     Result := Result - UnitMove.CountOnce;
    787 end;
    788 
    789 function TPlayerCell.GetAttackPower: Integer;
    790 var
    791   I: Integer;
    792 begin
    793   Result := 0;
    794   for I := 0 to MovesTo.Count - 1 do
    795     Result := Result + TUnitMove(MovesTo[I]).CountOnce;
    796 end;
    797 
    798 procedure TPlayerCell.SaveToNode(Node: TDOMNode);
    799 begin
    800   WriteBoolean(Node, 'Explored', Explored);
    801   WriteInteger(Node, 'MapCell', MapCell.Id);
    802 end;
    803 
    804 constructor TPlayerCell.Create;
    805 begin
    806   MovesFrom := TUnitMoves.Create;
    807   MovesFrom.FreeObjects := False;
    808   MovesTo := TUnitMoves.Create;
    809   MovesTo.FreeObjects := False;
    810   Neighbors := TPlayerCells.Create;
    811   Neighbors.FreeObjects := False;
    812 end;
    813 
    814 destructor TPlayerCell.Destroy;
    815 var
    816   I: Integer;
    817 begin
    818   for I := MovesFrom.Count - 1 downto 0 do
    819     TUnitMove(MovesFrom[I]).List.Remove(TUnitMove(MovesFrom[I]));
    820   FreeAndNil(MovesFrom);
    821   for I := MovesTo.Count - 1 downto 0 do
    822     TUnitMove(MovesTo[I]).List.Remove(TUnitMove(MovesTo[I]));
    823   FreeAndNil(MovesTo);
    824   for I := Neighbors.Count - 1 downto 0 do
    825     if Neighbors[I].Neighbors.Remove(Self) = -1 then
    826       raise Exception.Create(SCellRemoveNeighborError);
    827   FreeAndNil(Neighbors);
    828   inherited Destroy;
    829 end;
    830 
    831 { TPlayerCells }
    832 
    833 function TPlayerCells.FindByCellId(Id: Integer): TPlayerCell;
    834 var
    835   I: Integer;
    836 begin
    837   I := 0;
    838   while (I < Count) and (Items[I].MapCell.Id <> Id) do Inc(I);
    839   if I < Count then Result := Items[I]
    840     else Result := nil;
    841 end;
    842 
    843 function TPlayerCells.SearchCell(Cell: TCell): TPlayerCell;
    844 var
    845   I: Integer;
    846 begin
    847   I := 0;
    848   while (I < Count) and (Items[I].MapCell <> Cell) do Inc(I);
    849   if I < Count then Result := Items[I]
    850     else Result := nil;
    851 end;
    852 
    853 procedure TPlayerCells.LoadFromNode(Node: TDOMNode);
    854 var
    855   Node2: TDOMNode;
    856   NewCell: TPlayerCell;
    857 begin
    858   Count := 0;
    859   Node2 := Node.FirstChild;
    860   while Assigned(Node2) and (Node2.NodeName = 'Cell') do begin
    861     NewCell := TPlayerCell.Create;
    862     NewCell.List := Self;
    863     NewCell.LoadFromNode(Node2);
    864     Add(NewCell);
    865     Node2 := Node2.NextSibling;
    866   end;
    867 end;
    868 
    869 procedure TPlayerCells.SaveToNode(Node: TDOMNode);
    870 var
    871   I: Integer;
    872   NewNode: TDOMNode;
    873 begin
    874   for I := 0 to Count - 1 do begin;
    875     NewNode := Node.OwnerDocument.CreateElement('Cell');
    876     Node.AppendChild(NewNode);
    877     Items[I].SaveToNode(NewNode);
    878   end;
    879 end;
    880 
    881 { TPlayerMap }
    882 
    883 procedure TPlayerMap.PaintCell(Canvas: TCanvas; Pos: TPoint; Text: string;
    884   View: TView; Cell: TPlayerCell);
    885 var
    886   I: Integer;
    887   TextPos: TPoint;
    888   Points: array of Classes.TPoint;
    889   TextSize: TSize;
    890 begin
    891   if Cell.MapCell.Extra = etObjectiveTarget then begin
    892     Text := Text + '!';
    893   end;
    894   with Canvas do begin
    895     if Assigned(View.FocusedCell) and (View.FocusedCell = Cell) then begin
    896       Pen.Color := clYellow;
    897       Pen.Style := psSolid;
    898       Pen.Width := 1;
    899     end else
    900     if Cell.MapCell.Terrain = ttCity then begin
    901       // Cannot set clear border as it will display shifted on gtk2
    902       //Pen.Style := psClear;
    903       Pen.Color := clBlack;
    904       Pen.Style := psSolid;
    905       Pen.Width := 3;
    906     end else begin
    907       // Cannot set clear border as it will display shifted on gtk2
    908       //Pen.Style := psClear;
    909       Pen.Color := Brush.Color;
    910       Pen.Style := psSolid;
    911       Pen.Width := 0;
    912     end;
    913     // Transform view
    914     SetLength(Points, Length(Cell.MapCell.Polygon.Points));
    915     for I := 0 to Length(Points) - 1 do
    916       Points[I] := PointToStdPoint(View.CellToCanvasPos(Cell.MapCell.Polygon.Points[I]));
    917     Brush.Style := bsSolid;
    918     //Polygon(Points, False, 0, Length(Points));
    919     TCanvasEx.PolygonEx(Canvas, Points, False);
    920     //MoveTo(Points[0].X, Points[0].Y);
    921     //LineTo(Points[1].X, Points[1].Y);
    922 
    923     // Show cell text
    924     if (Cell.GetAvialPower <> 0) or (Cell.MapCell.Extra = etObjectiveTarget) then begin
    925       Pen.Style := psSolid;
    926       Font.Color := clWhite;
    927       Brush.Style := bsClear;
    928       Font.Size := Trunc(42 * View.Zoom);
    929       TextPos := View.CellToCanvasPos(Pos);
    930       TextSize := TextExtent(Text);
    931       TCanvasEx.TextOutEx(Canvas, Round(TextPos.X) - TextSize.cx div 2,
    932         Round(TextPos.Y) - TextSize.cy div 2, Text, False);
    933     end;
    934   end;
    935 end;
    936 
    937 function TPlayerMap.PosToCell(Pos: TPoint; View: TView): TPlayerCell;
    938 var
    939   I: Integer;
    940 begin
    941   Result := nil;
    942   for I := 0 to Cells.Count - 1 do
    943   if Cells[I].MapCell.Terrain <> ttVoid then begin
    944     if Cells[I].MapCell.Polygon.IsPointInside(Pos) then begin
    945       Result := Cells[I];
    946       Exit;
    947     end;
    948   end;
    949 end;
    950 
    951 function TPlayerMap.CellToPos(Cell: TPlayerCell): TPoint;
    952 begin
    953   Result := Cell.MapCell.PosPx;
    954 end;
    955 
    956 procedure TPlayerMap.LoadFromNode(Node: TDOMNode);
    957 var
    958   NewNode: TDOMNode;
    959 begin
    960   with Node do begin
    961     NewNode := FindNode('Cells');
    962     if Assigned(NewNode) then
    963       Cells.LoadFromNode(NewNode);
    964   end;
    965 end;
    966 
    967 procedure TPlayerMap.SaveToNode(Node: TDOMNode);
    968 var
    969   NewNode: TDOMNode;
    970 begin
    971   with Node do begin
    972     NewNode := OwnerDocument.CreateElement('Cells');
    973     AppendChild(NewNode);
    974     Cells.SaveToNode(NewNode);
    975   end;
    976 end;
    977 
    978 procedure TPlayerMap.Update;
    979 var
    980   I: Integer;
    981   J: Integer;
    982   OldCount: Integer;
    983 begin
    984   for I := 0 to Cells.Count - 1 do
    985   with TPlayerCell(Cells[I]) do begin
    986     for J := Neighbors.Count - 1 downto 0 do
    987       DisconnectFrom(Neighbors[J]);
    988   end;
    989 
    990   // Update players cells count to map cells count to be 1:1
    991   OldCount := Cells.Count;
    992   Cells.Count := Player.Game.Map.Cells.Count;
    993   for I := OldCount to Cells.Count - 1 do
    994     Cells[I] := TPlayerCell.Create;
    995 
    996   for I := 0 to Player.Game.Map.Cells.Count - 1 do begin
    997     with Cells[I] do begin
    998       List := Cells;
    999       Explored := False;
    1000       InVisibleRange := False;
    1001       MapCell := Player.Game.Map.Cells[I];
    1002       Player.Game.Map.Cells[I].PlayerCell := Cells[I];
    1003     end;
    1004   end;
    1005 
    1006   for I := 0 to Cells.Count - 1 do
    1007   with TPlayerCell(Cells[I]) do begin
    1008     for J := 0 to MapCell.Neighbors.Count - 1 do
    1009       ConnectTo(TCell(MapCell.Neighbors[J]).PlayerCell);
    1010   end;
    1011 end;
    1012 
    1013 constructor TPlayerMap.Create;
    1014 begin
    1015   Cells := TPlayerCells.Create;
    1016   Cells.Map := Self;
    1017 end;
    1018 
    1019 destructor TPlayerMap.Destroy;
    1020 begin
    1021   FreeAndNil(Cells);
    1022   inherited Destroy;
    1023 end;
    1024 
    1025 procedure TPlayerMap.CheckVisibility;
    1026 var
    1027   I: Integer;
    1028   C: Integer;
    1029   NeighCount: Integer;
    1030 begin
    1031   for I := 0 to Cells.Count - 1 do
    1032   with Cells[I] do begin
    1033     NeighCount := 0;
    1034     for C := 0 to MapCell.Neighbors.Count - 1 do
    1035       if MapCell.Neighbors[C].Player = Player then
    1036         Inc(NeighCount);
    1037 
    1038     InVisibleRange := (NeighCount > 0) or (MapCell.Player = Player);
    1039     if InVisibleRange and not Explored then Explored := True;
    1040   end;
    1041 end;
    1042 
    1043 procedure TPlayerMap.Paint(Canvas: TCanvas; View: TView);
    1044 var
    1045   I: Integer;
    1046   Cell: TPlayerCell;
    1047   PosFrom, PosTo: TPoint;
    1048   Angle: Double;
    1049   ArrowCenter: TPoint;
    1050   Move: TUnitMove;
    1051   CellText: string;
    1052   CellLink: TCellLink;
    1053   NeighCell: TCell;
    1054 begin
    1055   with Canvas, View do
    1056   try
    1057     Lock;
    1058     // Draw cell links
    1059     Pen.Color := clBlack;
    1060     Pen.Style := psSolid;
    1061     Pen.Width := 3;
    1062     for CellLink in Player.Game.Map.CellLinks do
    1063     with CellLink do begin
    1064       if Length(Points) >= 2 then begin
    1065         MoveTo(PointToStdPoint(View.CellToCanvasPos(Points[0])));
    1066         for I := 1 to Length(Points) - 1 do
    1067           LineTo(PointToStdPoint(View.CellToCanvasPos(Points[I])));
    1068       end;
    1069     end;
    1070 
    1071     // Draw cells
    1072     for Cell in Cells do begin
    1073       if (Cell.MapCell.Terrain <> ttVoid) and Cell.MapCell.IsVisible(View) then begin
    1074         if Cell.MapCell.Player = Player then
    1075           CellText := IntToStr(Cell.GetAvialPower)
    1076           else CellText := IntToStr(Cell.MapCell.Power);
    1077         if Assigned(SelectedCell) and (SelectedCell = Cell) then
    1078             Brush.Color := clGreen
    1079           else if Assigned(SelectedCell) and Player.Game.Map.IsCellsNeighbor(SelectedCell.MapCell, Cell.MapCell) then
    1080             Brush.Color := clPurple
    1081           else if Player.Game.FogOfWar then begin
    1082             if Cell.InVisibleRange then begin
    1083               Brush.Color := Cell.MapCell.GetColor;
    1084             end else begin
    1085               if Cell.Explored then begin
    1086                 Brush.Color := $404040;
    1087                 CellText := '';
    1088               end else begin
    1089                 Brush.Color := clBlack;
    1090                 CellText := '';
    1091               end;
    1092             end;
    1093           end else Brush.Color := Cell.MapCell.GetColor;
    1094         Player.PlayerMap.PaintCell(Canvas, Cell.MapCell.PosPx, CellText, View, Cell);
    1095       end else
    1096       if Game.FogOfWar and (Cell.MapCell.Terrain = ttVoid) and (not Cell.Explored) then begin
    1097         Brush.Color := clBlack;
    1098         Player.PlayerMap.PaintCell(Canvas, Cell.MapCell.PosPx, '', View, Cell);
    1099       end;
    1100     end;
    1101 
    1102     // Draw links to neighbors
    1103     if Player.Game.DevelMode then
    1104     for Cell in Cells do begin
    1105       for NeighCell in Cell.MapCell.Neighbors do begin
    1106         Pen.Color := clYellow;
    1107         MoveTo(PointToStdPoint(View.CellToCanvasPos(Cell.MapCell.PosPx)));
    1108         LineTo(PointToStdPoint(View.CellToCanvasPos(NeighCell.PosPx)));
    1109       end;
    1110 
    1111       Font.Color := clRed;
    1112       Brush.Style := bsClear;
    1113       TextOut(View.CellToCanvasPos(Cell.MapCell.PosPx).X,
    1114         View.CellToCanvasPos(Cell.MapCell.PosPx).Y, IntToStr(Cell.MapCell.Id));
    1115     end;
    1116 
    1117     // Draw arrows
    1118     Pen.Color := clCream;
    1119     for Move in Player.Moves do begin
    1120       PosFrom := Player.Game.Map.CellToPos(Move.CellFrom.MapCell);
    1121       PosTo := Player.Game.Map.CellToPos(Move.CellTo.MapCell);
    1122       // In Fog of war mode show only
    1123       if Game.FogOfWar and not Cells.SearchCell(Move.CellFrom.MapCell).InVisibleRange and
    1124         not Cells.SearchCell(Move.CellTo.MapCell).InVisibleRange then
    1125         Continue;
    1126       if Move.CountRepeat > 0 then Pen.Width := 2
    1127         else Pen.Width := 1;
    1128       Angle := ArcTan((PosTo.Y - PosFrom.Y) / (PosTo.X - PosFrom.X));
    1129       if (Angle > +Pi) or (Angle < -Pi) then
    1130         raise Exception.Create('Wrong arrow angle ' + FloatToStr(Angle));
    1131 
    1132       if Sign(PosTo.X - PosFrom.X) = -1 then Angle := Angle + Pi;
    1133       ArrowCenter := View.CellToCanvasPos(TPoint.Create(Trunc(PosFrom.X + (PosTo.X - PosFrom.X) / 2),
    1134         Trunc(PosFrom.Y + (PosTo.Y - PosFrom.Y) / 2)));
    1135       Player.Game.Map.DrawArrow(Canvas, View, ArrowCenter,
    1136         Angle, IntToStr(Move.CountOnce));
    1137     end;
    1138   finally
    1139     Unlock;
    1140   end;
    1141143end;
    1142144
    … …  
    1170172//  LCLIntf.Polyline(Canvas.Handle, @Points[0], Length(Points));
    1171173  //Changed;
    1172 end;
    1173 
    1174 
    1175 { TCells }
    1176 
    1177 procedure TCells.FixRefId;
    1178 var
    1179   I: Integer;
    1180 begin
    1181   for I := 0 to Count - 1 do
    1182     Items[I].FixRefId;
    1183 end;
    1184 
    1185 function TCells.FindById(Id: Integer): TCell;
    1186 var
    1187   I: Integer;
    1188 begin
    1189   I := 0;
    1190   while (I < Count) and (Items[I].Id <> Id) do Inc(I);
    1191   if I < Count then Result := Items[I]
    1192     else Result := nil;
    1193 end;
    1194 
    1195 procedure TCells.GetCellsWithWeight(List: TCells; Low, High: Integer);
    1196 var
    1197   Cell: TCell;
    1198 begin
    1199   List.Clear;
    1200   for Cell in Self do
    1201     if (Cell.Terrain <> ttVoid) and (Cell.Weight >= Low) and
    1202       (Cell.Weight <= High) then List.Add(Cell);
    1203 end;
    1204 
    1205 procedure TCells.GetCellsWithExtra(List: TCells; Extra: TExtraType);
    1206 var
    1207   Cell: TCell;
    1208 begin
    1209   List.Clear;
    1210   for Cell in Self do
    1211     if Cell.Extra = Extra then List.Add(Cell);
    1212 end;
    1213 
    1214 procedure TCells.LoadFromNode(Node: TDOMNode);
    1215 var
    1216   Node2: TDOMNode;
    1217   NewCell: TCell;
    1218 begin
    1219   Count := 0;
    1220   Node2 := Node.FirstChild;
    1221   while Assigned(Node2) and (Node2.NodeName = 'Cell') do begin
    1222     NewCell := TCell.Create;
    1223     NewCell.Map := Map;
    1224     NewCell.LoadFromNode(Node2);
    1225     Add(NewCell);
    1226     Node2 := Node2.NextSibling;
    1227   end;
    1228 end;
    1229 
    1230 procedure TCells.SaveToNode(Node: TDOMNode);
    1231 var
    1232   I: Integer;
    1233   NewNode2: TDOMNode;
    1234 begin
    1235   for I := 0 to Count - 1 do
    1236   with Items[I] do begin
    1237     NewNode2 := Node.OwnerDocument.CreateElement('Cell');
    1238     Node.AppendChild(NewNode2);
    1239     SaveToNode(NewNode2);
    1240   end;
    1241 end;
    1242 
    1243 procedure TCells.ClearMark;
    1244 var
    1245   Cell: TCell;
    1246 begin
    1247   for Cell in Self do Cell.Mark := False;
    1248 end;
    1249 
    1250 procedure TCells.ClearWeight;
    1251 var
    1252   Cell: TCell;
    1253 begin
    1254   for Cell in Self do Cell.Weight := 0;
    1255 end;
    1256 
    1257 function TCells.ToString: ansistring;
    1258 var
    1259   C: TCell;
    1260 begin
    1261   Result := '';
    1262   for C in Self do
    1263     Result := Result + IntToStr(C.Id) + ', ';
    1264 end;
    1265 
    1266 { TPlayers }
    1267 
    1268 function TPlayers.GetAliveCount: Integer;
    1269 var
    1270   Player: TPlayer;
    1271 begin
    1272   Result := 0;
    1273   for Player in Self do
    1274     if Player.IsAlive then Inc(Result);
    1275 end;
    1276 
    1277 procedure TPlayers.GetAlivePlayers(Players: TPlayers);
    1278 var
    1279   Player: TPlayer;
    1280 begin
    1281   Players.Clear;
    1282   for Player in Self do
    1283     if Player.IsAlive then Players.Add(Player);
    1284 end;
    1285 
    1286 function TPlayers.FindById(Id: Integer): TPlayer;
    1287 var
    1288   I: Integer;
    1289 begin
    1290   I := 0;
    1291   while (I < Count) and (Items[I].Id <> Id) do Inc(I);
    1292   if I < Count then Result := Items[I]
    1293     else Result := nil;
    1294 end;
    1295 
    1296 procedure TPlayers.New(Name: string; Color: TColor; Mode: TPlayerMode);
    1297 var
    1298   NewPlayer: TPlayer;
    1299 begin
    1300   NewPlayer := TPlayer.Create;
    1301   NewPlayer.Game := Game;
    1302   NewPlayer.Name := Name;
    1303   NewPlayer.Color := Color;
    1304   NewPlayer.Mode := Mode;
    1305   NewPlayer.Id := GetNewPlayerId;
    1306   if Mode = pmComputer then
    1307     NewPlayer.Agressivity := caMedium;
    1308   Add(NewPlayer);
    1309 end;
    1310 
    1311 function TPlayers.GetNewPlayerId: Integer;
    1312 begin
    1313   Result := NewPlayerId;
    1314   Inc(NewPlayerId);
    1315 end;
    1316 
    1317 procedure TPlayers.LoadFromNode(Node: TDOMNode);
    1318 var
    1319   Node2: TDOMNode;
    1320   NewPlayer: TPlayer;
    1321 begin
    1322   Count := 0;
    1323   Node2 := Node.FirstChild;
    1324   while Assigned(Node2) and (Node2.NodeName = 'Player') do begin
    1325     NewPlayer := TPlayer.Create;
    1326     NewPlayer.Game := Game;
    1327     NewPlayer.LoadFromNode(Node2);
    1328     Add(NewPlayer);
    1329     Node2 := Node2.NextSibling;
    1330   end;
    1331 end;
    1332 
    1333 procedure TPlayers.SaveToNode(Node: TDOMNode);
    1334 var
    1335   I: Integer;
    1336   NewNode: TDOMNode;
    1337 begin
    1338   for I := 0 to Count - 1 do begin;
    1339     NewNode := Node.OwnerDocument.CreateElement('Player');
    1340     Node.AppendChild(NewNode);
    1341     Items[I].SaveToNode(NewNode);
    1342   end;
    1343 end;
    1344 
    1345 constructor TPlayers.Create(FreeObjects: Boolean = True);
    1346 begin
    1347   inherited;
    1348   NewPlayerId := 1;
    1349 end;
    1350 
    1351 function TPlayers.GetFirstHuman: TPlayer;
    1352 var
    1353   I: Integer;
    1354 begin
    1355   I := 0;
    1356   while (I < Count) and (Items[I].Mode <> pmHuman) do Inc(I);
    1357   if I < Count then Result := Items[I]
    1358     else Result := nil;
    1359 end;
    1360 
    1361 procedure TPlayers.Assign(Source: TPlayers);
    1362 var
    1363   I: Integer;
    1364 begin
    1365   while Count > Source.Count do
    1366     Delete(Count - 1);
    1367   while Count < Source.Count do
    1368     Add(TPlayer.Create);
    1369   for I := 0 to Count - 1 do begin
    1370     Items[I].Assign(Source[I]);
    1371     Items[I].Game := Game;
    1372   end;
    1373   NewPlayerId := Source.NewPlayerId;
    1374 end;
    1375 
    1376 procedure TPlayers.LoadConfig(Config: TXmlConfig; Path: string);
    1377 var
    1378   I: Integer;
    1379   NewCount: Integer;
    1380 begin
    1381   with Config do begin
    1382     NewCount := GetValue(DOMString(Path + '/Count'), -1);
    1383     NewPlayerId := 1;
    1384     if NewCount >= 2 then begin
    1385       Self.Clear;
    1386       Count := NewCount;
    1387       for I := 0 to Count - 1 do begin
    1388         Items[I] := TPlayer.Create;
    1389         Items[I].Id := GetNewPlayerId;
    1390         Items[I].Game := Game;
    1391         Items[I].LoadConfig(Config, Path + '/Player' + IntToStr(I));
    1392       end;
    1393     end;
    1394   end;
    1395 end;
    1396 
    1397 procedure TPlayers.SaveConfig(Config: TXmlConfig; Path: string);
    1398 var
    1399   I: Integer;
    1400 begin
    1401   for I := 0 to Count - 1 do
    1402     Items[I].SaveConfig(Config, Path + '/Player' + IntToStr(I));
    1403   with Config do begin
    1404     SetValue(DOMString(Path + '/Count'), Count);
    1405   end;
    1406 end;
    1407 
    1408 { TUnitMoves }
    1409 
    1410 function TUnitMoves.SearchByFromTo(CellFrom, CellTo: TPlayerCell): TUnitMove;
    1411 var
    1412   UnitMove: TUnitMove;
    1413 begin
    1414   Result := nil;
    1415   for UnitMove in Self do
    1416   if (UnitMove.CellFrom = CellFrom) and (UnitMove.CellTo = CellTo) then begin
    1417     Result := UnitMove;
    1418     Break;
    1419   end;
    1420 end;
    1421 
    1422 procedure TUnitMoves.LoadFromNode(Node: TDOMNode);
    1423 var
    1424   Node2: TDOMNode;
    1425   NewUnitMove: TUnitMove;
    1426 begin
    1427   Count := 0;
    1428   Node2 := Node.FirstChild;
    1429   while Assigned(Node2) and (Node2.NodeName = 'UnitMove') do begin
    1430     NewUnitMove := TUnitMove.Create;
    1431     NewUnitMove.List := Self;
    1432     NewUnitMove.LoadFromNode(Node2);
    1433     Add(NewUnitMove);
    1434     Node2 := Node2.NextSibling;
    1435   end;
    1436 end;
    1437 
    1438 procedure TUnitMoves.SaveToNode(Node: TDOMNode);
    1439 var
    1440   I: Integer;
    1441   NewNode: TDOMNode;
    1442 begin
    1443   for I := 0 to Count - 1 do begin;
    1444     NewNode := Node.OwnerDocument.CreateElement('UnitMove');
    1445     Node.AppendChild(NewNode);
    1446     TUnitMove(Items[I]).SaveToNode(NewNode);
    1447   end;
    1448 end;
    1449 
    1450 { TMap }
    1451 
    1452 function TMap.GetSize: TPoint;
    1453 begin
    1454   Result:= FSize;
    1455 end;
    1456 
    1457 function TMap.GetPixelRect: TRect;
    1458 begin
    1459   if FPixelRect.Empty then FPixelRect := CalculatePixelRect;
    1460   Result := FPixelRect;
    1461 end;
    1462 
    1463 procedure TMap.SetSize(AValue: TPoint);
    1464 begin
    1465   if (FSize.X <> AValue.X) or (FSize.Y <> AValue.Y) then begin
    1466     FSize := AValue;
    1467   end;
    1468 end;
    1469 
    1470 function CompareCellAngle(const C1, C2: TCell): Integer;
    1471 begin
    1472   if C1.Angle < C2.Angle then Result := -1
    1473   else if C1.Angle > C2.Angle then Result := 1
    1474   else Result := 0;
    1475 end;
    1476 
    1477 procedure TMap.SortNeighborsByAngle;
    1478 var
    1479   Cell: TCell;
    1480   NeighborCell: TCell;
    1481 begin
    1482   for Cell in Cells do begin
    1483     for NeighborCell in Cell.Neighbors do
    1484       NeighborCell.Angle := TLine.Create(Cell.PosPx, NeighborCell.PosPx).GetAngle;
    1485 
    1486     Cell.Neighbors.Sort(CompareCellAngle);
    1487   end;
    1488 end;
    1489 
    1490 procedure TMap.Paint(Canvas: TCanvas; View: TView);
    1491 var
    1492   I: Integer;
    1493   Cell: TCell;
    1494   PosFrom, PosTo: TPoint;
    1495   Angle: Double;
    1496   ArrowCenter: TPoint;
    1497   Move: TUnitMove;
    1498   CellLink: TCellLink;
    1499 begin
    1500   with Canvas, View do
    1501   try
    1502     Lock;
    1503 
    1504     // Draw cell links
    1505     Pen.Color := clBlack;
    1506     Pen.Style := psSolid;
    1507     Pen.Width := 3;
    1508     for CellLink in CellLinks do
    1509     with CellLink do begin
    1510       if Length(Points) >= 2 then begin
    1511         MoveTo(PointToStdPoint(View.CellToCanvasPos(Points[0])));
    1512         for I := 1 to Length(Points) - 1 do
    1513           LineTo(PointToStdPoint(View.CellToCanvasPos(Points[I])));
    1514       end;
    1515     end;
    1516 
    1517     // Draw cells
    1518     for Cell in Cells do begin
    1519       if (Cell.Terrain <> ttVoid) and Cell.IsVisible(View) then begin
    1520         if Assigned(SelectedCell) and (SelectedCell.MapCell = Cell) then
    1521           Brush.Color := clGreen
    1522           else if Assigned(SelectedCell) and IsCellsNeighbor(SelectedCell.MapCell, Cell) then
    1523             Brush.Color := clPurple
    1524           else Brush.Color := Cell.GetColor;
    1525         //Pen.Color := clBlack;
    1526         PaintCell(Canvas, Cell.PosPx, IntToStr(Cell.Power), View, Cell);
    1527       end;
    1528     end;
    1529   finally
    1530     Unlock;
    1531   end;
    1532 end;
    1533 
    1534 function TMap.GetNewCellId: Integer;
    1535 begin
    1536   Result := FNewCellId;
    1537   Inc(FNewCellId);
    1538 end;
    1539 
    1540 function TMap.IsOutsideShape(Coord: TPoint): Boolean;
    1541 var
    1542   Rect: TRect;
    1543   Color: TColor;
    1544   Pos: TPoint;
    1545   Center: TPoint;
    1546 begin
    1547   case Shape of
    1548     msRectangle: Result := False;
    1549     msImage: begin
    1550       Rect := PixelRect;
    1551       with Image.Picture.Bitmap do begin
    1552         Pos := TPoint.Create(Trunc(Coord.X / Rect.Size.X * Width),
    1553           Trunc(Coord.Y / Rect.Size.Y * Height));
    1554         Color := Canvas.Pixels[Pos.X, Pos.Y];
    1555       end;
    1556       Result := Color <> clWhite;
    1557     end;
    1558     msRounded: begin
    1559       Rect := PixelRect;
    1560       Center := Rect.Center;
    1561       Result := Sqr(Coord.X - Center.X) / Sqr(Rect.Size.X div 2) +
    1562         Sqr(Coord.Y - Center.Y) / Sqr(Rect.Size.Y div 2) > 1;
    1563     end
    1564     else Result := False;
    1565   end;
    1566 end;
    1567 
    1568 procedure TMap.DrawArrow(Canvas: TCanvas; View: TView; Pos: TPoint;
    1569   Angle: Double; Text: string);
    1570 var
    1571   Points: array of Classes.TPoint;
    1572   FPoints: array of TPointF;
    1573   I: Integer;
    1574   ArrowSize: TPoint;
    1575 begin
    1576   Canvas.Brush.Color := clWhite;
    1577   Canvas.Pen.Color := clBlack;
    1578   SetLength(Points, 8);
    1579   SetLength(FPoints, 8);
    1580   ArrowSize := TPoint.Create(Trunc(DefaultCellSize.X / 3 * View.Zoom),
    1581     Trunc(DefaultCellSize.Y / 3 * View.Zoom));
    1582   FPoints[0] := TPointF.Create(+0.5 * ArrowSize.X, +0 * ArrowSize.Y);
    1583   FPoints[1] := TPointF.Create(+0 * ArrowSize.X, +0.5 * ArrowSize.Y);
    1584   FPoints[2] := TPointF.Create(+0 * ArrowSize.X, +0.25 * ArrowSize.Y);
    1585   FPoints[3] := TPointF.Create(-0.5 * ArrowSize.X, +0.25 * ArrowSize.Y);
    1586   FPoints[4] := TPointF.Create(-0.5 * ArrowSize.X, -0.25 * ArrowSize.Y);
    1587   FPoints[5] := TPointF.Create(+0 * ArrowSize.X, -0.25 * ArrowSize.Y);
    1588   FPoints[6] := TPointF.Create(+0 * ArrowSize.X, -0.5 * ArrowSize.Y);
    1589   FPoints[7] := TPointF.Create(+0.5 * ArrowSize.X, 0 * ArrowSize.Y);
    1590   // Rotate
    1591   for I := 0 to Length(Points) - 1 do
    1592     FPoints[I] := TPointF.Create(FPoints[I].X * Cos(Angle) - FPoints[I].Y * Sin(Angle),
    1593       FPoints[I].X * Sin(Angle) + FPoints[I].Y * Cos(Angle));
    1594   // Shift
    1595   for I := 0 to Length(Points) - 1 do
    1596     Points[I] := Point(Trunc(FPoints[I].X + Pos.X), Trunc(FPoints[I].Y + Pos.Y));
    1597   with Canvas do begin
    1598     Brush.Style := bsSolid;
    1599     Polygon(Points);
    1600     Brush.Style := bsClear;
    1601     Font.Color := clBlack;
    1602     Font.Size := Trunc(26 * View.Zoom);
    1603     TextOut(Pos.X - TextWidth(Text) div 2,
    1604       Pos.Y - TextHeight(Text) div 2, Text);
    1605     Pen.Width := 1;
    1606   end;
    1607 end;
    1608 
    1609 function TMap.IsCellsNeighbor(Cell1, Cell2: TCell): Boolean;
    1610 begin
    1611   Result := Cell1.Neighbors.IndexOf(Cell2) <> -1;
    1612 end;
    1613 
    1614 function TMap.IsValidIndex(Index: TPoint): Boolean;
    1615 begin
    1616   Result := (Index.X >= 0) and (Index.X < Size.X) and
    1617     (Index.Y >= 0) and (Index.Y < Size.Y);
    1618 end;
    1619 
    1620 procedure TMap.Assign(Source: TMap);
    1621 //var
    1622 //  I: Integer;
    1623 begin
    1624   // Do not assign Game field
    1625   MaxPower := Source.MaxPower;
    1626   Size := Source.Size;
    1627   DefaultCellSize := Source.DefaultCellSize;
    1628   Shape := Source.Shape;
    1629   Image.Picture.Bitmap.Assign(Source.Image.Picture.Bitmap);
    1630 
    1631   // TODO: How to copy cells
    1632   {// Copy all cells
    1633   Cells.Count := 0;
    1634   Cells.Count := Source.Cells.Count;
    1635   for I := 0 to Cells.Count - 1 do begin
    1636     Cells[I] := TCell.Create;
    1637     Cells[I].Map := Self;
    1638     Cells[I].Assign(Source.Cells[I]);
    1639   end;
    1640   }
    1641 end;
    1642 
    1643 procedure TMap.LoadFromFile(FileName: string);
    1644 begin
    1645 
    1646 end;
    1647 
    1648 procedure TMap.SaveToFile(FileName: string);
    1649 begin
    1650 
    1651 end;
    1652 
    1653 procedure TMap.LoadFromNode(Node: TDOMNode);
    1654 var
    1655   Node2: TDOMNode;
    1656 begin
    1657   Size := TPoint.Create(ReadInteger(Node, 'SizeX', 0), ReadInteger(Node, 'SizeY', 0));
    1658   DefaultCellSize.X := ReadInteger(Node, 'DefaultCellSizeX', 1);
    1659   DefaultCellSize.Y := ReadInteger(Node, 'DefaultCellSizeY', 1);
    1660   MaxPower := ReadInteger(Node, 'MaxPower', DefaultMaxPower);
    1661   Shape := TMapShape(ReadInteger(Node, 'Shape', Integer(msRectangle)));
    1662   Node2 := Node.FindNode('Cells');
    1663   if Assigned(Node2) then
    1664     Cells.LoadFromNode(Node2);
    1665   Node2 := Node.FindNode('CellLinks');
    1666   if Assigned(Node2) then
    1667     CellLinks.LoadFromNode(Node2);
    1668   FPixelRect := CalculatePixelRect;
    1669 end;
    1670 
    1671 procedure TMap.SaveToNode(Node: TDOMNode);
    1672 var
    1673   NewNode: TDOMNode;
    1674 begin
    1675   WriteInteger(Node, 'DefaultCellSizeX', DefaultCellSize.X);
    1676   WriteInteger(Node, 'DefaultCellSizeY', DefaultCellSize.Y);
    1677   WriteInteger(Node, 'MaxPower', MaxPower);
    1678   WriteInteger(Node, 'Shape', Integer(Shape));
    1679   WriteInteger(Node, 'SizeX', Size.X);
    1680   WriteInteger(Node, 'SizeY', Size.Y);
    1681   NewNode := Node.OwnerDocument.CreateElement('Cells');
    1682   Node.AppendChild(NewNode);
    1683   Cells.SaveToNode(NewNode);
    1684   NewNode := Node.OwnerDocument.CreateElement('CellLinks');
    1685   Node.AppendChild(NewNode);
    1686   CellLinks.SaveToNode(NewNode);
    1687 end;
    1688 
    1689 function TMap.PosToCell(Pos: TPoint; View: TView): TCell;
    1690 var
    1691   I: Integer;
    1692 begin
    1693   Result := nil;
    1694   for I := 0 to Cells.Count - 1 do
    1695   if Cells[I].Terrain <> ttVoid then begin
    1696     if Cells[I].Polygon.IsPointInside(Pos) then begin
    1697       Result := Cells[I];
    1698       Exit;
    1699     end;
    1700   end;
    1701 end;
    1702 
    1703 function TMap.CellToPos(Cell: TCell): TPoint;
    1704 begin
    1705   Result := Cell.PosPx;
    1706 end;
    1707 
    1708 procedure TMap.Grow(APlayer: TPlayer);
    1709 var
    1710   I: Integer;
    1711   Addition: Integer;
    1712   Dies: Integer;
    1713 begin
    1714   for I := 0 to Cells.Count - 1 do
    1715   with Cells[I] do begin
    1716     if (Player = APlayer) and ((Game.GrowCells = gcPlayerAll) or
    1717     ((Game.GrowCells = gcPlayerCities) and (Terrain = ttCity))) then begin
    1718       if Power < MaxPower then begin
    1719         // Increase units count
    1720         Addition := 0;
    1721         if Game.GrowAmount = gaByOne then begin
    1722           Addition := 1;
    1723         end else
    1724         if Game.GrowAmount = gaBySquareRoot then begin
    1725           Addition := Trunc(Sqrt(Power));
    1726           if Addition = 0 then Addition := 1;
    1727         end;
    1728         Power := Min(Power + Addition, MaxPower);
    1729       end else
    1730       if Power > MaxPower then begin
    1731         // Reduce units count
    1732         // If cell has more then MaxPower units then additional units dies
    1733         // in twice of squeare root of unites over MaxPower
    1734         Dies := 2 * Trunc(Sqrt(Power - MaxPower));
    1735         Power := Max(Power - Dies, 0);
    1736       end;
    1737     end;
    1738   end;
    1739 end;
    1740 
    1741 procedure TMap.PaintCell(Canvas: TCanvas; Pos: TPoint; Text: string; View: TView;
    1742   Cell: TCell);
    1743 var
    1744   I: Integer;
    1745   TextPos: TPoint;
    1746   Points: array of Classes.TPoint;
    1747   TextSize: TSize;
    1748 begin
    1749   if Cell.Extra = etObjectiveTarget then begin
    1750     Text := Text + '!';
    1751   end;
    1752   with Canvas do begin
    1753     if Assigned(View.FocusedCell) and (View.FocusedCell.MapCell = Cell) then begin
    1754       Pen.Color := clYellow;
    1755       Pen.Style := psSolid;
    1756       Pen.Width := 1;
    1757     end else
    1758     if Cell.Terrain = ttCity then begin
    1759       // Cannot set clear border as it will display shifted on gtk2
    1760       //Pen.Style := psClear;
    1761       Pen.Color := clBlack;
    1762       Pen.Style := psSolid;
    1763       Pen.Width := 3;
    1764     end else begin
    1765       // Cannot set clear border as it will display shifted on gtk2
    1766       //Pen.Style := psClear;
    1767       Pen.Color := Brush.Color;
    1768       Pen.Style := psSolid;
    1769       Pen.Width := 0;
    1770     end;
    1771     // Transform view
    1772     SetLength(Points, Length(Cell.Polygon.Points));
    1773     for I := 0 to Length(Points) - 1 do
    1774       Points[I] := PointToStdPoint(View.CellToCanvasPos(Cell.Polygon.Points[I]));
    1775     Brush.Style := bsSolid;
    1776     //Polygon(Points, False, 0, Length(Points));
    1777     TCanvasEx.PolygonEx(Canvas, Points, False);
    1778     //MoveTo(Points[0].X, Points[0].Y);
    1779     //LineTo(Points[1].X, Points[1].Y);
    1780 
    1781     // Show cell text
    1782     if (Cell.Power <> 0) or (Cell.Extra = etObjectiveTarget) then begin
    1783       Pen.Style := psSolid;
    1784       Font.Color := clWhite;
    1785       Brush.Style := bsClear;
    1786       Font.Size := Trunc(42 * View.Zoom);
    1787       TextPos := View.CellToCanvasPos(Pos);
    1788       TextSize := TextExtent(Text);
    1789       TCanvasEx.TextOutEx(Canvas, Round(TextPos.X) - TextSize.cx div 2,
    1790         Round(TextPos.Y) - TextSize.cy div 2, Text, False);
    1791     end;
    1792   end;
    1793 end;
    1794 
    1795 procedure TMap.ComputePlayerStats;
    1796 var
    1797   Cell: TCell;
    1798 begin
    1799   for Cell in Cells do
    1800   with Cell do begin
    1801     if Assigned(Player) then begin
    1802       Inc(Player.TotalCells);
    1803       Inc(Player.TotalUnits, Power);
    1804       if Terrain = ttCity then
    1805         Inc(Player.TotalCities);
    1806       if Extra = etObjectiveTarget then
    1807         Inc(Player.TotalWinObjectiveCells);
    1808     end;
    1809   end;
    1810 end;
    1811 
    1812 procedure TMap.Generate;
    1813 var
    1814   X, Y: Integer;
    1815   NewCell: TCell;
    1816 begin
    1817   Clear;
    1818 
    1819   // Allocate and init new
    1820   Cells.Count := FSize.Y * FSize.X;
    1821   FNewCellId := 1;
    1822   for Y := 0 to FSize.Y - 1 do
    1823   for X := 0 to FSize.X - 1 do begin
    1824     NewCell := TCell.Create;
    1825     NewCell.Map := Self;
    1826     NewCell.PosPx := TPoint.Create(X * DefaultCellSize.X, Y * DefaultCellSize.Y);
    1827     NewCell.Id := GetNewCellId;
    1828     SetLength(NewCell.Polygon.Points, 1);
    1829     NewCell.Polygon.Points[0] := NewCell.PosPx;
    1830     Cells[Y * FSize.X + X] := NewCell;
    1831   end;
    1832   FPixelRect := FPixelRect;
    1833 end;
    1834 
    1835 procedure TMap.MakeSymetric;
    1836 var
    1837   C: Integer;
    1838   I: Integer;
    1839   CellLink: TCellLink;
    1840   OtherCell1: TCell;
    1841   OtherCell2: TCell;
    1842   OppositeCell: TCell;
    1843 begin
    1844   // Generic way to create two sides symetric map independent to shape
    1845   for C := 0 to (Cells.Count div 2) - 1 do begin
    1846     Cells[C].Terrain := Cells[Cells.Count - 1 - C].Terrain;
    1847     Cells[C].Power := Cells[Cells.Count - 1 - C].Power;
    1848 
    1849     for I := Cells[C].Links.Count - 1 downto 0 do begin
    1850       CellLink := Cells[C].Links[I];
    1851 
    1852       // Remove cells on first half of the map
    1853       if (Cells.IndexOf(CellLink.Cells[0]) <= (Cells.Count div 2)) and
    1854       (Cells.IndexOf(CellLink.Cells[1]) <= (Cells.Count div 2)) then
    1855       begin
    1856         CellLinks.Remove(CellLink);
    1857         Continue;
    1858       end;
    1859 
    1860       // Make cross half links symetric
    1861       if (Cells.IndexOf(CellLink.Cells[0]) <= (Cells.Count div 2)) and
    1862       (Cells.IndexOf(CellLink.Cells[1]) >= (Cells.Count div 2)) then begin
    1863         OtherCell1 := Cells[Cells.Count - 1 - Cells.IndexOf(CellLink.Cells[1])];
    1864         OtherCell2 := CellLink.Cells[1];
    1865         CellLinks.Remove(CellLink);
    1866         if not Assigned(CellLinks.FindByCells(OtherCell1, OtherCell2)) then
    1867           CellLinks.AddLink(OtherCell1, OtherCell2);
    1868       end else
    1869       if (Cells.IndexOf(CellLink.Cells[0]) >= (Cells.Count div 2)) and
    1870       (Cells.IndexOf(CellLink.Cells[1]) <= (Cells.Count div 2)) then begin
    1871         OtherCell1 := Cells[Cells.Count - 1 - Cells.IndexOf(CellLink.Cells[0])];
    1872         OtherCell2 := CellLink.Cells[0];
    1873         CellLinks.Remove(CellLink);
    1874         if not Assigned(CellLinks.FindByCells(OtherCell1, OtherCell2)) then
    1875           CellLinks.AddLink(OtherCell1, OtherCell2);
    1876       end;
    1877     end;
    1878   end;
    1879 
    1880   for C := 0 to (Cells.Count div 2) - 1 do begin
    1881     // Make copy of links from second half
    1882     OppositeCell := Cells[Cells.Count - 1 - C];
    1883     for CellLink in OppositeCell.Links do
    1884       if (Cells.IndexOf(CellLink.Cells[0]) > (Cells.Count div 2)) and
    1885       (Cells.IndexOf(CellLink.Cells[1]) > (Cells.Count div 2)) then begin
    1886       OtherCell1 := Cells[Cells.Count - 1 - Cells.IndexOf(CellLink.Cells[0])];
    1887       OtherCell2 := Cells[Cells.Count - 1 - Cells.IndexOf(CellLink.Cells[1])];
    1888       if not Assigned(CellLinks.FindByCells(OtherCell1, OtherCell2)) then
    1889         CellLinks.AddLink(OtherCell1, OtherCell2);
    1890     end;
    1891   end;
    1892 end;
    1893 
    1894 procedure TMap.CreateLinks;
    1895 var
    1896   LastAreaCount: Integer;
    1897 begin
    1898   BuildMapAreas;
    1899   LastAreaCount := -1;
    1900   while (Areas.Count > 1) and (Areas.Count <> LastAreaCount) do begin
    1901     LastAreaCount := Areas.Count;
    1902     BuildBridges;
    1903     BuildMapAreas;
    1904   end;
    1905 end;
    1906 
    1907 procedure TMap.Clear;
    1908 begin
    1909   CellLinks.Clear;
    1910   Cells.Clear;
    1911   FNewCellId := 1;
    1912   FPixelRect.SetEmpty;
    1913 end;
    1914 
    1915 procedure TMap.CheckCells;
    1916 var
    1917   I: Integer;
    1918   J: Integer;
    1919 begin
    1920   for I := 0 to Cells.Count - 1 do begin
    1921     for J := I + 1 to Cells.Count - 1 do begin
    1922       if (Cells[I].Id = Cells[J].Id) then
    1923         raise Exception.Create('Duplicate cells ID ' + IntToStr(I) + ' ' + IntToStr(J));
    1924       if (Cells[I].PosPx = Cells[J].PosPx) then
    1925         raise Exception.Create('Duplicate cells position ' + IntToStr(I) + ' ' + IntToStr(J));
    1926     end;
    1927   end;
    1928 end;
    1929 
    1930 constructor TMap.Create;
    1931 begin
    1932   MaxPower := DefaultMaxPower;
    1933   DefaultCellSize := TPoint.Create(220, 220);
    1934   Cells := TCells.Create;
    1935   Cells.Map := Self;
    1936   Size := TPoint.Create(0, 0);
    1937   Image := TImage.Create(nil);
    1938   CellLinks := TCellLinks.Create;
    1939   CellLinks.Map := Self;
    1940   Areas := TMapAreas.Create;
    1941 end;
    1942 
    1943 destructor TMap.Destroy;
    1944 begin
    1945   Size := TPoint.Create(0, 0);
    1946   FreeAndNil(Areas);
    1947   FreeAndNil(CellLinks);
    1948   FreeAndNil(Image);
    1949   FreeAndNil(Cells);
    1950   inherited Destroy;
    1951 end;
    1952 
    1953 function TMap.CalculatePixelRect: TRect;
    1954 var
    1955   I: Integer;
    1956   CellRect: TRect;
    1957 begin
    1958   Result := TRect.Create(TPoint.Create(0, 0), TPoint.Create(0, 0));
    1959   // This is generic algorithm to determine pixel size of entire map
    1960   for I := 0 to Cells.Count - 1 do begin
    1961     CellRect := Cells[I].Polygon.GetRect;
    1962     if I = 0 then Result := CellRect
    1963       else begin
    1964         Result.P1 := TPoint.Min(Result.P1, CellRect.P1);
    1965         Result.P2 := TPoint.Max(Result.P2, CellRect.P2);
    1966       end;
    1967   end;
    1968 end;
    1969 
    1970 procedure TMap.ForEachCells(Method: TMethod);
    1971 begin
    1972 
    1973 end;
    1974 
    1975 { TUnitMove }
    1976 
    1977 procedure TUnitMove.SetCellFrom(AValue: TPlayerCell);
    1978 begin
    1979   if FCellFrom = AValue then Exit;
    1980   if Assigned(AValue) and not Assigned(FCellFrom) then begin
    1981     AValue.MovesFrom.Add(Self);
    1982   end else
    1983   if not Assigned(AValue) and Assigned(FCellFrom) then begin
    1984     FCellFrom.MovesFrom.Remove(Self);
    1985   end;
    1986   FCellFrom := AValue;
    1987 end;
    1988 
    1989 procedure TUnitMove.SetCellTo(AValue: TPlayerCell);
    1990 begin
    1991   if FCellTo = AValue then Exit;
    1992   if Assigned(AValue) and not Assigned(FCellTo) then begin
    1993     AValue.MovesTo.Add(Self);
    1994   end else
    1995   if not Assigned(AValue) and Assigned(FCellTo) then begin
    1996     FCellTo.MovesTo.Remove(Self);
    1997   end;
    1998   FCellTo := AValue;
    1999 end;
    2000 
    2001 procedure TUnitMove.LoadFromNode(Node: TDOMNode);
    2002 begin
    2003   CountOnce := ReadInteger(Node, 'CountOnce', 0);
    2004   CountRepeat := ReadInteger(Node, 'CountRepeat', 0);
    2005   CellFrom := List.Player.PlayerMap.Cells.FindByCellId(ReadInteger(Node, 'CellFrom', 0));
    2006   CellTo := List.Player.PlayerMap.Cells.FindByCellId(ReadInteger(Node, 'CellTo', 0));
    2007 end;
    2008 
    2009 procedure TUnitMove.SaveToNode(Node: TDOMNode);
    2010 begin
    2011   WriteInteger(Node, 'CountOnce', CountOnce);
    2012   WriteInteger(Node, 'CountRepeat', CountRepeat);
    2013   WriteInteger(Node, 'CellFrom', CellFrom.MapCell.Id);
    2014   WriteInteger(Node, 'CellTo', CellTo.MapCell.Id);
    2015 end;
    2016 
    2017 constructor TUnitMove.Create;
    2018 begin
    2019   List := nil; // Is later set to parent list owning item
    2020   FCellFrom := nil;
    2021   FCellTo := nil;
    2022 end;
    2023 
    2024 destructor TUnitMove.Destroy;
    2025 begin
    2026   CellFrom := nil;
    2027   CellTo := nil;
    2028   List := nil;
    2029   inherited Destroy;
    2030 end;
    2031 
    2032 { TView }
    2033 
    2034 procedure TView.SetZoom(AValue: Double);
    2035 begin
    2036   if FZoom = AValue then Exit;
    2037   if AValue = 0 then
    2038     raise Exception.Create(SZeroZoomNotAlowed);
    2039   FZoom := AValue;
    2040   SourceRect := TRect.CreateBounds(TPoint.Create(Trunc(SourceRect.P1.X + SourceRect.Size.X div 2 - DestRect.Size.X / Zoom / 2),
    2041     Trunc(SourceRect.P1.Y +  SourceRect.Size.Y div 2 - DestRect.Size.Y / Zoom / 2)),
    2042     TPoint.Create(Trunc(DestRect.Size.X / Zoom),
    2043     Trunc(DestRect.Size.Y / Zoom)));
    2044 end;
    2045 
    2046 procedure TView.Clear;
    2047 begin
    2048   FocusedCell := nil;
    2049   SelectedCell := nil;
    2050 end;
    2051 
    2052 procedure TView.SetDestRect(AValue: TRect);
    2053 var
    2054   Diff: TPoint;
    2055 begin
    2056   if FDestRect = AValue then Exit;
    2057   Diff := TPoint.Create(Trunc(DestRect.Size.X / Zoom - AValue.Size.X / Zoom) div 2,
    2058     Trunc(DestRect.Size.Y / Zoom - AValue.Size.Y / Zoom) div 2);
    2059   FDestRect := AValue;
    2060   SourceRect := TRect.CreateBounds(TPoint.Create(SourceRect.P1.X + Diff.X, SourceRect.P1.Y + Diff.Y),
    2061     TPoint.Create(Trunc(DestRect.Size.X / Zoom),
    2062     Trunc(DestRect.Size.Y / Zoom)));
    2063 end;
    2064 
    2065 constructor TView.Create;
    2066 begin
    2067   Zoom := 1.5;
    2068   Clear;
    2069 end;
    2070 
    2071 destructor TView.Destroy;
    2072 begin
    2073   inherited Destroy;
    2074 end;
    2075 
    2076 { TCell }
    2077 
    2078 procedure TCell.SetPower(AValue: Integer);
    2079 begin
    2080   if FPower = AValue then Exit;
    2081   if AValue < 0 then
    2082     raise Exception.Create(SNegativeCellPowerNotAllowed);
    2083   FPower := AValue;
    2084   //Check;
    2085 end;
    2086 
    2087 procedure TCell.ConnectTo(Cell: TCell);
    2088 begin
    2089   // Connect only if already not connected
    2090   if Neighbors.IndexOf(Cell) < 0 then begin
    2091     Cell.Neighbors.Add(Self);
    2092     Neighbors.Add(Cell);
    2093   end;
    2094 end;
    2095 
    2096 procedure TCell.DisconnectFrom(Cell: TCell);
    2097 var
    2098   I: Integer;
    2099 begin
    2100   I := Cell.Neighbors.IndexOf(Self);
    2101   if I >= 0 then Cell.Neighbors.Delete(I) else
    2102     raise Exception.Create('Can''t disconnect neigboring cells.');
    2103   I := Neighbors.IndexOf(Cell);
    2104   if I >= 0 then Neighbors.Delete(I)
    2105     else Exception.Create('Can''t disconnect neigboring cells.');
    2106 end;
    2107 
    2108 function TCell.NeighboringToVoid: Boolean;
    2109 var
    2110   NeighVoidCount: Integer;
    2111   NeighborCell: TCell;
    2112 begin
    2113   NeighVoidCount := 0;
    2114   for NeighborCell in Neighbors do
    2115     if (NeighborCell.Terrain = ttVoid) then Inc(NeighVoidCount);
    2116   Result := NeighVoidCount > 0;
    2117 end;
    2118 
    2119 procedure TCell.SetArea(AValue: TMapArea);
    2120 begin
    2121   if FArea = AValue then Exit;
    2122   if Assigned(FArea) then FArea.Cells.Remove(Self);
    2123   FArea := AValue;
    2124   if Assigned(FArea) then FArea.Cells.Add(Self);
    2125 end;
    2126 
    2127 procedure TCell.SetId(AValue: Integer);
    2128 begin
    2129   if FId = AValue then Exit;
    2130   FId := AValue;
    2131 end;
    2132 
    2133 procedure TCell.AreaExtend;
    2134 var
    2135   NeighborCell: TCell;
    2136 begin
    2137   for NeighborCell in Neighbors do
    2138   if (NeighborCell.Terrain <> ttVoid) and (not Assigned(NeighborCell.Area)) then begin
    2139     NeighborCell.Area := Area;
    2140     NeighborCell.AreaExtend;
    2141   end;
    2142 end;
    2143 
    2144 procedure TCell.FixRefId;
    2145 var
    2146   I: Integer;
    2147 begin
    2148   Player := Map.Game.Players.FindById(PlayerId);
    2149 
    2150   Neighbors.Count := Length(NeighborsId);
    2151   for I := 0 to Length(NeighborsId) - 1 do begin
    2152     Neighbors[I] := Map.Cells.FindById(NeighborsId[I]);
    2153   end;
    2154 end;
    2155 
    2156 procedure TCell.LoadFromNode(Node: TDOMNode);
    2157 var
    2158   Node2: TDOMNode;
    2159   Node3: TDOMNode;
    2160 begin
    2161   Id := ReadInteger(Node, 'Id', 0);
    2162   Power := ReadInteger(Node, 'Power', 0);
    2163   Terrain := TTerrainType(ReadInteger(Node, 'Terrain', Integer(ttVoid)));
    2164   Extra := TExtraType(ReadInteger(Node, 'Extra', Integer(etNone)));
    2165   PosPx.X := ReadInteger(Node, 'PosX', 0);
    2166   PosPx.Y := ReadInteger(Node, 'PosY', 0);
    2167   PlayerId := ReadInteger(Node, 'Player', 0);
    2168 
    2169   Node3 := Node.FindNode('Neighbours');
    2170   if Assigned(Node3) then begin
    2171     SetLength(NeighborsId, 0);
    2172     Node2 := Node3.FirstChild;
    2173     while Assigned(Node2) and (Node2.NodeName = 'Neighbour') do begin
    2174       SetLength(NeighborsId, Length(NeighborsId) + 1);
    2175       NeighborsId[High(NeighborsId)] := ReadInteger(Node2, 'Id', 0);
    2176       Node2 := Node2.NextSibling;
    2177     end;
    2178   end;
    2179 
    2180   Node3 := Node.FindNode('Polygon');
    2181   if Assigned(Node3) then begin
    2182     Polygon.Clear;
    2183     Node2 := Node3.FirstChild;
    2184     while Assigned(Node2) and (Node2.NodeName = 'Point') do begin
    2185       Polygon.AddPoint(TPoint.Create(ReadInteger(Node2, 'X', 0), ReadInteger(Node2, 'Y', 0)));
    2186       Node2 := Node2.NextSibling;
    2187     end;
    2188   end;
    2189 end;
    2190 
    2191 procedure TCell.SaveToNode(Node: TDOMNode);
    2192 var
    2193   NewNode: TDOMNode;
    2194   NewNode2: TDOMNode;
    2195   I: Integer;
    2196 begin
    2197   WriteInteger(Node, 'Id', Id);
    2198   WriteInteger(Node, 'Power', Power);
    2199   WriteInteger(Node, 'Terrain', Integer(Terrain));
    2200   WriteInteger(Node, 'Extra', Integer(Extra));
    2201   WriteInteger(Node, 'PosX', PosPx.X);
    2202   WriteInteger(Node, 'PosY', PosPx.Y);
    2203   if Assigned(Player) then
    2204     WriteInteger(Node, 'Player', Player.Id)
    2205     else WriteInteger(Node, 'Player', 0);
    2206   NewNode := Node.OwnerDocument.CreateElement('Neighbours');
    2207   Node.AppendChild(NewNode);
    2208   for I := 0 to Neighbors.Count - 1 do begin
    2209     NewNode2 := NewNode.OwnerDocument.CreateElement('Neighbour');
    2210     NewNode.AppendChild(NewNode2);
    2211     WriteInteger(NewNode2, 'Id', Neighbors[I].Id);
    2212   end;
    2213   NewNode := Node.OwnerDocument.CreateElement('Polygon');
    2214   Node.AppendChild(NewNode);
    2215   for I := 0 to Length(Polygon.Points) - 1 do begin
    2216     NewNode2 := NewNode.OwnerDocument.CreateElement('Point');
    2217     NewNode.AppendChild(NewNode2);
    2218     WriteInteger(NewNode2, 'X', Polygon.Points[I].X);
    2219     WriteInteger(NewNode2, 'Y', Polygon.Points[I].Y);
    2220   end;
    2221 end;
    2222 
    2223 procedure TCell.Assign(Source: TCell);
    2224 begin
    2225   Id := Source.Id;
    2226   PosPx := Source.PosPx;
    2227   Terrain := Source.Terrain;
    2228   Polygon := Source.Polygon;
    2229   Player := Source.Player;
    2230   Mark := Source.Mark;
    2231   // TODO: How to copy neighbours and moves list
    2232 end;
    2233 
    2234 function TCell.IsVisible(View: TView): Boolean;
    2235 var
    2236   RectPolygon, RectView: TRect;
    2237 begin
    2238   RectPolygon := Polygon.GetRect;
    2239   RectView := View.SourceRect;
    2240   Result := (
    2241     (RectPolygon.P1.X < RectView.P2.X) and
    2242     (RectPolygon.P2.X > RectView.P1.X) and
    2243     (RectPolygon.P1.Y < RectView.P2.Y) and
    2244     (RectPolygon.P2.Y > RectView.P1.Y)
    2245   );
    2246 end;
    2247 
    2248 function TCell.GetColor: TColor;
    2249 begin
    2250   if Assigned(Player) then Result := Player.Color
    2251     else Result := clGray;
    2252 end;
    2253 
    2254 function TCell.ToString: ansistring;
    2255 begin
    2256   Result := IntToStr(Id);
    2257 end;
    2258 
    2259 constructor TCell.Create;
    2260 begin
    2261   FId := -1;
    2262   Player := nil;
    2263   Neighbors := TCells.Create;
    2264   Neighbors.FreeObjects := False;
    2265   Links := TCellLinks.Create;
    2266   Links.FreeObjects := False;
    2267 end;
    2268 
    2269 destructor TCell.Destroy;
    2270 var
    2271   I: Integer;
    2272 begin
    2273   for I := Links.Count - 1 downto 0 do
    2274     FMap.CellLinks.Remove(Links[I]);
    2275   FreeAndNil(Links);
    2276   for I := Neighbors.Count - 1 downto 0 do
    2277     if Neighbors[I].Neighbors.Remove(Self) = -1 then
    2278       raise Exception.Create(SCellRemoveNeighborError);
    2279   FreeAndNil(Neighbors);
    2280   inherited Destroy;
    2281 end;
    2282 
    2283 { TView }
    2284 
    2285 function TView.CanvasToCellPos(Pos: TPoint): TPoint;
    2286 begin
    2287   Result := TPoint.Create(Trunc(Pos.X / Zoom + SourceRect.P1.X),
    2288     Trunc(Pos.Y / Zoom + SourceRect.P1.Y));
    2289 end;
    2290 
    2291 function TView.CellToCanvasPos(Pos: TPoint): TPoint;
    2292 begin
    2293   Result := TPoint.Create(Trunc((Pos.X - SourceRect.P1.X) * Zoom),
    2294     Trunc((Pos.Y - SourceRect.P1.Y) * Zoom));
    2295 end;
    2296 
    2297 function TView.CanvasToCellRect(Pos: TRect): TRect;
    2298 begin
    2299   Result.P1 := CanvasToCellPos(Pos.P1);
    2300   Result.P2 := CanvasToCellPos(Pos.P2);
    2301 end;
    2302 
    2303 function TView.CellToCanvasRect(Pos: TRect): TRect;
    2304 begin
    2305   Result.P1 := CellToCanvasPos(Pos.P1);
    2306   Result.P2 := CellToCanvasPos(Pos.P2);
    2307 end;
    2308 
    2309 procedure TView.Assign(Source: TView);
    2310 begin
    2311   SourceRect := Source.SourceRect;
    2312   FDestRect := Source.DestRect;
    2313   FZoom := Source.Zoom;
    2314   SelectedCell := Source.SelectedCell;
    2315   FocusedCell := Source.FocusedCell;
    2316 end;
    2317 
    2318 { TPlayer }
    2319 
    2320 procedure TPlayer.SetGame(AValue: TGame);
    2321 begin
    2322   if FGame = AValue then Exit;
    2323   FGame := AValue;
    2324   Moves.Game := AValue;
    2325 end;
    2326 
    2327 procedure TPlayer.Clear;
    2328 begin
    2329   TurnStats.Clear;
    2330   Moves.Clear;
    2331 end;
    2332 
    2333 {procedure TPlayer.SetClient(AValue: TClient);
    2334 begin
    2335   if FClient = AValue then Exit;
    2336   if Assigned(FClient) then FClient.FControlPlayer := nil;
    2337   FClient := AValue;
    2338   if Assigned(FClient) then FClient.FControlPlayer := Self;
    2339 end;
    2340 }
    2341 
    2342 procedure TPlayer.LoadFromNode(Node: TDOMNode);
    2343 var
    2344   NewNode: TDOMNode;
    2345 begin
    2346   Id := ReadInteger(Node, 'Id', 0);
    2347   Name := ReadString(Node, 'Name', '');
    2348   Color := ReadInteger(Node, 'Color', clSilver);
    2349   Mode := TPlayerMode(ReadInteger(Node, 'Mode', Integer(pmHuman)));
    2350   StartCell := FGame.Map.Cells.FindById(ReadInteger(Node, 'StartCell', 0));
    2351   StartUnits := ReadInteger(Node, 'StartUnits', 0);
    2352   Agressivity := TComputerAgressivity(ReadInteger(Node, 'Agressivity', Integer(caMedium)));
    2353   Defensive := ReadBoolean(Node, 'Defensive', False);
    2354 
    2355   with Node do begin
    2356     NewNode := FindNode('Map');
    2357     if Assigned(NewNode) then
    2358       PlayerMap.LoadFromNode(NewNode);
    2359     PlayerMap.Update;
    2360   end;
    2361   with Node do begin
    2362     NewNode := FindNode('UnitMoves');
    2363     if Assigned(NewNode) then
    2364       Moves.LoadFromNode(NewNode);
    2365   end;
    2366   with Node do begin
    2367     NewNode := FindNode('TurnStats');
    2368     if Assigned(NewNode) then
    2369       TurnStats.LoadFromNode(NewNode);
    2370   end;
    2371 end;
    2372 
    2373 procedure TPlayer.SaveToNode(Node: TDOMNode);
    2374 var
    2375   NewNode: TDOMNode;
    2376 begin
    2377   WriteInteger(Node, 'Id', Id);
    2378   WriteString(Node, 'Name', Name);
    2379   WriteInteger(Node, 'Color', Color);
    2380   WriteInteger(Node, 'Mode', Integer(Mode));
    2381   WriteInteger(Node, 'StartCell', StartCell.Id);
    2382   WriteInteger(Node, 'StartUnits', StartUnits);
    2383   WriteInteger(Node, 'Agressivity', Integer(Agressivity));
    2384   WriteBoolean(Node, 'Defensive', Defensive);
    2385 
    2386   with Node do begin
    2387     NewNode := OwnerDocument.CreateElement('Map');
    2388     AppendChild(NewNode);
    2389     PlayerMap.SaveToNode(NewNode);
    2390   end;
    2391   with Node do begin
    2392     NewNode := OwnerDocument.CreateElement('UnitMoves');
    2393     AppendChild(NewNode);
    2394     Moves.SaveToNode(NewNode);
    2395   end;
    2396   with Node do begin
    2397     NewNode := OwnerDocument.CreateElement('TurnStats');
    2398     AppendChild(NewNode);
    2399     TurnStats.SaveToNode(NewNode);
    2400   end;
    2401 end;
    2402 
    2403 procedure TPlayer.Paint(Canvas: TCanvas; View: TView);
    2404 begin
    2405   PlayerMap.Paint(Canvas, View);
    2406 end;
    2407 
    2408 constructor TPlayer.Create;
    2409 begin
    2410   Moves := TUnitMoves.Create;
    2411   Moves.Player := Self;
    2412   StartUnits := DefaultPlayerStartUnits;
    2413   StartCell := nil;
    2414   PlayerMap := TPlayerMap.Create;
    2415   PlayerMap.Player := Self;
    2416   TurnStats := TGameTurnStats.Create;
    2417 end;
    2418 
    2419 destructor TPlayer.Destroy;
    2420 begin
    2421   //Client := nil;
    2422   FreeAndNil(TurnStats);
    2423   FreeAndNil(PlayerMap);
    2424   FreeAndNil(Moves);
    2425   inherited Destroy;
    2426 end;
    2427 
    2428 procedure TPlayer.Assign(Source: TPlayer);
    2429 begin
    2430   Id := Source.Id;
    2431   Name := Source.Name;
    2432   Color := Source.Color;
    2433   Mode := Source.Mode;
    2434   Game := Source.Game;
    2435   TotalCells := Source.TotalCells;
    2436   TotalUnits := Source.TotalUnits;
    2437   TotalCities := Source.TotalCities;
    2438   TotalDiscovered := Source.TotalDiscovered;
    2439   TotalWinObjectiveCells := Source.TotalWinObjectiveCells;
    2440   StartUnits := Source.StartUnits;
    2441   StartCell := Source.StartCell;
    2442   Agressivity := Source.Agressivity;
    2443   Defensive := Source.Defensive;
    2444 end;
    2445 
    2446 procedure TPlayer.LoadConfig(Config: TXmlConfig; Path: string);
    2447 begin
    2448   with Config do begin
    2449     Self.Name := string(GetValue(DOMString(Path + '/Name'), ''));
    2450     Color := TColor(GetValue(DOMString(Path + '/Color'), 0));
    2451     StartUnits := GetValue(DOMString(Path + '/StartUnits'), 5);
    2452     Mode := TPlayerMode(GetValue(DOMString(Path + '/Mode'), 0));
    2453     Defensive := GetValue(DOMString(Path + '/Defensive'), False);
    2454     Agressivity := TComputerAgressivity(GetValue(DOMString(Path + '/Agressivity'), 0));
    2455   end;
    2456 end;
    2457 
    2458 procedure TPlayer.SaveConfig(Config: TXmlConfig; Path: string);
    2459 begin
    2460   with Config do begin
    2461     SetValue(DOMString(Path + '/Name'), DOMString(Self.Name));
    2462     SetValue(DOMString(Path + '/Color'), Integer(Color));
    2463     SetValue(DOMString(Path + '/StartUnits'), StartUnits);
    2464     SetValue(DOMString(Path + '/Mode'), Integer(Mode));
    2465     SetValue(DOMString(Path + '/Defensive'), Defensive);
    2466     SetValue(DOMString(Path + '/Agressivity'), Integer(Agressivity));
    2467   end;
    2468 end;
    2469 
    2470 procedure TPlayer.Attack(var AttackPower, DefendPower: Integer);
    2471 var
    2472   AttackerDiceCount: Integer;
    2473   DefenderDiceCount: Integer;
    2474   S: string;
    2475   I: Integer;
    2476   AttackRolls: TFPGList<Integer>;
    2477   DefendRolls: TFPGList<Integer>;
    2478 begin
    2479   AttackRolls := TFPGList<Integer>.Create;
    2480   DefendRolls := TFPGList<Integer>.Create;
    2481   if AttackPower < 1 then
    2482     raise Exception.Create(SAttackerPowerPositive);
    2483   if DefendPower < 0 then
    2484     raise Exception.Create(SDefenderPowerPositive);
    2485   while (AttackPower > 0) and (DefendPower > 0) do begin
    2486     // Risk game rules:
    2487     // Each side do their dice roll and compare result. Defender wins tie.
    2488     // Attacker can use three dices and defender two
    2489     AttackerDiceCount := Min(AttackPower, 3);
    2490     DefenderDiceCount := Min(DefendPower, 2);
    2491     // Roll and sort numbers
    2492     AttackRolls.Count := AttackerDiceCount;
    2493     for I := 0 to AttackerDiceCount - 1 do begin
    2494       AttackRolls[I] := Random(7);
    2495     end;
    2496     AttackRolls.Sort(ComparePointer);
    2497     S := 'Att:';
    2498     for I := 0 to AttackerDiceCount - 1 do
    2499       S := S + IntToStr(Integer(AttackRolls[I])) + ', ';
    2500     DefendRolls.Count := DefenderDiceCount;
    2501     for I := 0 to DefenderDiceCount - 1 do begin
    2502       DefendRolls[I] := Random(7);
    2503     end;
    2504     DefendRolls.Sort(ComparePointer);
    2505     S := S + ' Def:';
    2506     for I := 0 to DefenderDiceCount - 1 do
    2507       S := S + IntToStr(Integer(DefendRolls[I])) + ', ';
    2508     // Resolution
    2509     for I := 0 to Min(AttackerDiceCount, DefenderDiceCount) - 1 do
    2510       if AttackRolls[I] > DefendRolls[I] then Dec(DefendPower)
    2511       else Dec(AttackPower);
    2512   end;
    2513   FreeAndNil(AttackRolls);
    2514   FreeAndNil(DefendRolls);
    2515 end;
    2516 
    2517 function CellCompare(const Item1, Item2: TPlayerCell): Integer;
    2518 begin
    2519   if Item1.MapCell.Power > Item2.MapCell.Power then Result := 1
    2520   else if Item1.MapCell.Power < Item2.MapCell.Power then Result := -1
    2521   else Result := 0;
    2522 end;
    2523 
    2524 function CellCompareDescending(const Item1, Item2: TPlayerCell): Integer;
    2525 begin
    2526   if Item1.MapCell.Power > Item2.MapCell.Power then Result := -1
    2527   else if Item1.MapCell.Power < Item2.MapCell.Power then Result := 1
    2528   else Result := 0;
    2529 end;
    2530 
    2531 { TView }
    2532 
    2533 procedure TView.SelectCell(Pos: TPoint; Player: TPlayer; ShiftState: TShiftState);
    2534 var
    2535   NewSelectedCell: TPlayerCell;
    2536   UnitMove: TUnitMove;
    2537   I: Integer;
    2538 begin
    2539   NewSelectedCell := Player.PlayerMap.PosToCell(CanvasToCellPos(Pos), Self);
    2540   if Assigned(NewSelectedCell) then begin
    2541     if Assigned(SelectedCell) and Game.Map.IsCellsNeighbor(NewSelectedCell.MapCell, SelectedCell.MapCell) then begin
    2542       if ssShift in ShiftState then begin
    2543         // Make maximum unit move without confirmation dialog
    2544         for I := SelectedCell.MovesFrom.Count - 1 downto 0 do begin
    2545           Player.Moves.Remove(SelectedCell.MovesFrom[I]);
    2546         end;
    2547         Game.CurrentPlayer.SetMove(SelectedCell, NewSelectedCell, SelectedCell.MapCell.Power, False);
    2548         SelectedCell := nil;
    2549       end else
    2550       if ssCtrl in ShiftState then begin
    2551         // If CTRL key pressed then storno all moved from selected cell and
    2552         // move all power to new selected cell
    2553         for I := SelectedCell.MovesFrom.Count - 1 downto 0 do
    2554           Player.Moves.Remove(SelectedCell.MovesFrom[I]);
    2555         UnitMove := Game.CurrentPlayer.SetMove(SelectedCell, NewSelectedCell, SelectedCell.MapCell.Power, False);
    2556         if Assigned(UnitMove) then
    2557           UnitMove.CountRepeat := Player.Game.Map.MaxPower;
    2558         if NewSelectedCell.MapCell.Player = Player then SelectedCell := NewSelectedCell
    2559           else SelectedCell := nil;
    2560       end else begin
    2561         Game.CurrentPlayer.SetMove(SelectedCell, NewSelectedCell, SelectedCell.MapCell.Power);
    2562         SelectedCell := nil;
    2563       end;
    2564     end else
    2565     if (NewSelectedCell <> SelectedCell) and (NewSelectedCell.MapCell.Player = Player) then
    2566       SelectedCell := NewSelectedCell
    2567     else
    2568     if (NewSelectedCell = SelectedCell) and (NewSelectedCell.MapCell.Player = Player) then
    2569       SelectedCell := nil;
    2570   end;
    2571 end;
    2572 
    2573 procedure TView.CenterMap;
    2574 var
    2575   MapRect: TRect;
    2576 begin
    2577   MapRect := Game.Map.PixelRect;
    2578   SourceRect := TRect.CreateBounds(TPoint.Create(MapRect.P1.X + MapRect.Size.X div 2 - SourceRect.Size.X div 2,
    2579     MapRect.P1.Y + MapRect.Size.Y div 2 - SourceRect.Size.Y div 2),
    2580     TPoint.Create(SourceRect.Size.X,
    2581     SourceRect.Size.Y));
    2582 end;
    2583 
    2584 procedure TView.CenterPlayerCity(Player: TPlayer);
    2585 begin
    2586   SourceRect := TRect.CreateBounds(TPoint.Create(Player.StartCell.PosPx.X - SourceRect.Size.X div 2,
    2587     Player.StartCell.PosPx.Y - SourceRect.Size.Y div 2),
    2588     TPoint.Create(SourceRect.Size.X,
    2589     SourceRect.Size.Y));
    2590 end;
    2591 
    2592 { TGame }
    2593 
    2594 procedure TPlayer.MoveAll;
    2595 var
    2596   AttackerPower: Integer;
    2597   DefenderPower: Integer;
    2598   UnitCount: Integer;
    2599   UnitMove: TUnitMove;
    2600 begin
    2601   for UnitMove in Moves do
    2602   with UnitMove do begin
    2603   if CountOnce > 0 then begin
    2604     if CellFrom.MapCell.Player = Self then begin
    2605       UnitCount := CountOnce;
    2606       if CountOnce > CellFrom.MapCell.Power then
    2607         UnitCount := CellFrom.MapCell.Power;
    2608       CountOnce := 0;
    2609       if CellTo.MapCell.Player = Self then begin
    2610         // Inner move
    2611         CellTo.MapCell.Power := CellTo.MapCell.Power + UnitCount;
    2612       end else begin
    2613         AttackerPower := UnitCount;
    2614         DefenderPower := CellTo.MapCell.Power;
    2615         Attack(AttackerPower, DefenderPower);
    2616         if DefenderPower = 0 then begin
    2617           // Attacker wins with possible loses
    2618           ClearMovesFromCell(CellTo);
    2619           CellTo.MapCell.Player := Self;
    2620           CellTo.MapCell.Power := AttackerPower;
    2621         end else
    2622         if AttackerPower = 0 then begin
    2623           // Defender wins with possible loses
    2624           CellTo.MapCell.Power := DefenderPower;
    2625         end else
    2626           raise Exception.Create(SUnfinishedBattle);
    2627       end;
    2628       CellFrom.MapCell.Power := CellFrom.MapCell.Power - UnitCount;
    2629     end;
    2630     end;
    2631   end;
    2632 
    2633   RemoveEmptyUnitMoves;
    2634 end;
    2635 
    2636 procedure TPlayer.ReduceMovesPower;
    2637 var
    2638   UnitMove: TUnitMove;
    2639   Power: Integer;
    2640 begin
    2641   // Power of cell can be reduced by unsucessful enemy attack
    2642   for UnitMove in Moves do begin
    2643     Power := UnitMove.CellFrom.GetAvialPower;
    2644     if Power < 0 then begin
    2645       if Abs(Power) < UnitMove.CountOnce then
    2646         UnitMove.CountOnce := UnitMove.CountOnce - Abs(Power)
    2647         else UnitMove.CountOnce := 0;
    2648     end;
    2649   end;
    2650 end;
    2651 
    2652 procedure TPlayer.RemoveInvalidMoves;
    2653 var
    2654   I: Integer;
    2655 begin
    2656   for I := Moves.Count - 1 downto 0 do
    2657     if Moves[I].CellFrom.MapCell.Player <> Self then
    2658       Moves.Delete(I);
    2659 end;
    2660 
    2661 procedure TPlayer.ClearMovesFromCell(Cell: TPlayerCell);
    2662 var
    2663   I: Integer;
    2664 begin
    2665   for I := Cell.MovesFrom.Count - 1 downto 0 do
    2666     Cell.MovesFrom.Delete(I);
    2667 end;
    2668 
    2669 function TPlayer.SetMove(CellFrom, CellTo: TPlayerCell; Power: Integer; Confirmation: Boolean = True): TUnitMove;
    2670 var
    2671   NewMove: TUnitMove;
    2672   CountOnce: Integer;
    2673   CountRepeat: Integer;
    2674   Confirm: Boolean;
    2675 begin
    2676   if CellFrom.MapCell.Player <> Self then
    2677     raise Exception.Create('Can''t set move of other player.');
    2678   Confirm := True;
    2679   Result := Moves.SearchByFromTo(CellFrom, CellTo);
    2680 
    2681   if Assigned(Result) then begin
    2682     CountOnce := Result.CountOnce;
    2683     CountRepeat := Result.CountRepeat;
    2684     if (Mode = pmHuman) and Confirmation and
    2685       Assigned(FOnMove) then
    2686         FOnMove(CellFrom, CellTo, CountOnce, CountRepeat, True, Confirm);
    2687   end else begin
    2688     CountOnce := Power;
    2689     CountRepeat := 0;
    2690     if (Mode = pmHuman) and Confirmation and
    2691       Assigned(FOnMove) then
    2692         FOnMove(CellFrom, CellTo, CountOnce, CountRepeat, False, Confirm);
    2693   end;
    2694   if Confirm then begin
    2695     if Assigned(Result) then begin
    2696       // Already have such move
    2697       if (CountOnce = 0) and (CountRepeat = 0) then begin
    2698           Result.List.Remove(Result);
    2699         end else begin
    2700           Result.CountOnce := CountOnce;
    2701           Result.CountRepeat := CountRepeat;
    2702           CheckCounterMove(Result);
    2703         end;
    2704     end else begin
    2705       // Add new move
    2706       if (CountOnce > 0) or (CountRepeat > 0) then begin
    2707         NewMove := TUnitMove.Create;
    2708         NewMove.List := Moves;
    2709         NewMove.CellFrom := CellFrom;
    2710         NewMove.CellTo := CellTo;
    2711         NewMove.CountOnce := CountOnce;
    2712         NewMove.CountRepeat := CountRepeat;
    2713         Moves.Add(NewMove);
    2714         Result := NewMove;
    2715         CheckCounterMove(NewMove);
    2716       end;
    2717     end;
    2718     if Assigned(Game.FOnMoveUpdated) then Game.FOnMoveUpdated(Result);
    2719   end;
    2720 end;
    2721 
    2722 procedure TPlayer.UpdateRepeatMoves;
    2723 var
    2724   Move: TUnitMove;
    2725 begin
    2726   for Move in Moves do
    2727   with Move do begin
    2728     if CellFrom.MapCell.Player = Self then
    2729       if CountRepeat <= CellFrom.GetAvialPower then
    2730         CountOnce := CountRepeat
    2731         else CountOnce := CellFrom.GetAvialPower;
    2732   end;
    2733   RemoveEmptyUnitMoves;
    2734 end;
    2735 
    2736 procedure TPlayer.RemoveEmptyUnitMoves;
    2737 var
    2738   I: Integer;
    2739 begin
    2740   // Remove empty moves
    2741   for I := Moves.Count - 1 downto 0 do
    2742   if (TUnitMove(Moves[I]).CellFrom.MapCell.Player = Self) and
    2743     (TUnitMove(Moves[I]).CountOnce = 0) and (TUnitMove(Moves[I]).CountRepeat = 0) then
    2744     Moves.Delete(I);
    2745 end;
    2746 
    2747 procedure TPlayer.Reset;
    2748 begin
    2749   Moves.Clear;
    2750   PlayerMap.Cells.Clear;
    2751   TotalUnits := 0;
    2752   TotalCells := 0;
    2753   TotalCities := 0;
    2754   TotalDiscovered := 0;
    2755   TotalWinObjectiveCells := 0;
    2756   TurnStats.Clear;
    2757   StartCell := nil;
    2758 end;
    2759 
    2760 procedure TPlayer.Surrender;
    2761 var
    2762   I: Integer;
    2763 begin
    2764   Moves.Clear;
    2765   for I := 0 to PlayerMap.Cells.Count - 1 do
    2766     if PlayerMap.Cells[I].MapCell.Player = Self then
    2767       PlayerMap.Cells[I].MapCell.Player := nil;
    2768 end;
    2769 
    2770 function TPlayer.IsAlive: Boolean;
    2771 begin
    2772   Result := (TotalCells > 0) and Assigned(StartCell);
    2773 end;
    2774 
    2775 procedure TPlayer.CheckCounterMove(Move: TUnitMove);
    2776 var
    2777   CounterMove: TUnitMove;
    2778 begin
    2779   CounterMove := Moves.SearchByFromTo(Move.CellTo, Move.CellFrom);
    2780   if Assigned(CounterMove) then begin
    2781     // For now, just remove counter move
    2782     Moves.Remove(CounterMove);
    2783   end;
    2784 end;
    2785 
    2786 procedure TPlayer.SetMode(AValue: TPlayerMode);
    2787 begin
    2788   if FMode = AValue then Exit;
    2789   FMode := AValue;
    2790 end;
    2791 
    2792 { TMap }
    2793 
    2794 function TMap.SearchDifferentCellArea(List: TCells; SourceArea, DestArea: TMapArea): TCell;
    2795 var
    2796   NewList: TCells;
    2797   NewListVoid: TCells;
    2798   I: Integer;
    2799   C: Integer;
    2800 begin
    2801   Result := nil;
    2802   NewList := TCells.Create;
    2803   NewList.FreeObjects := False;
    2804   NewListVoid := TCells.Create;
    2805   NewListVoid.FreeObjects := False;
    2806 
    2807   for C := 0 to List.Count - 1 do
    2808   with List[C] do begin
    2809     for I := 0 to Neighbors.Count - 1 do
    2810     with Neighbors[I] do
    2811     if (not Mark) and (Terrain <> ttVoid) and (Area <> SourceArea) and ((DestArea = nil) or (DestArea = Area)) then begin
    2812       NewList.Add(List[C].Neighbors[I]);
    2813       Mark := True;
    2814     end else
    2815     if (not Mark) and (Terrain = ttVoid) then begin
    2816       NewListVoid.Add(List[C].Neighbors[I]);
    2817       Mark := True;
    2818     end;
    2819   end;
    2820 
    2821   if NewList.Count > 0 then begin
    2822     // We found cell with different area
    2823     Result := NewList[Random(NewList.Count)];
    2824   end else
    2825   if NewListVoid.Count > 0 then begin
    2826     // Cell was not found but we have more void cells to check
    2827     Result := SearchDifferentCellArea(NewListVoid, SourceArea, DestArea);
    2828   end;
    2829 
    2830   FreeAndNil(NewListVoid);
    2831   FreeAndNil(NewList);
    2832 end;
    2833 
    2834 procedure TMap.BuildBridges;
    2835 var
    2836   List: TCells;
    2837   BorderList: TCells;
    2838   Cell: TCell;
    2839   FoundCell1: TCell;
    2840   FoundCell2: TCell;
    2841   I: Integer;
    2842   J: Integer;
    2843 begin
    2844   List := TCells.Create;
    2845   List.FreeObjects := False;
    2846 
    2847   BorderList := TCells.Create;
    2848   BorderList.FreeObjects := False;
    2849 
    2850   // Build area bridges
    2851   if Areas.Count > 1 then
    2852   for I := 0 to Areas.Count - 1 do
    2853   with TMapArea(Areas[I]) do begin
    2854     GetBorderCells(BorderList);
    2855     if BorderList.Count > 0 then
    2856     for J := 0 to 4 do begin
    2857 
    2858     Cell := BorderList[Random(BorderList.Count)];
    2859     List.Clear;
    2860     List.Add(Cell);
    2861 
    2862     Map.Cells.ClearMark;
    2863 
    2864     // Find nearest cell with different area
    2865     FoundCell1 := SearchDifferentCellArea(List, TMapArea(Map.Areas[I]), nil);
    2866     if Assigned(FoundCell1) then begin
    2867       // Again find back nearest cell with different area.
    2868       // This will ensure that both cells are closest ones
    2869 
    2870       Map.Cells.ClearMark;
    2871       List[0] := FoundCell1;
    2872       FoundCell2 := SearchDifferentCellArea(List, FoundCell1.Area, TMapArea(Map.Areas[I]));
    2873       if Assigned(FoundCell2) then begin
    2874         // Check if link doesn't exist already
    2875         if not Assigned(FoundCell1.Links.FindByCells(FoundCell1, FoundCell2)) then begin
    2876           Map.CellLinks.AddLink(FoundCell1, FoundCell2);
    2877           Inc(BridgeCount);
    2878         end;
    2879       end;
    2880     end;
    2881     end;
    2882   end;
    2883   FreeAndNil(List);
    2884   FreeAndNil(BorderList);
    2885 end;
    2886 
    2887 procedure TMap.BuildMapAreas;
    2888 var
    2889   C: Integer;
    2890   NewArea: TMapArea;
    2891 begin
    2892   for C := 0 to Cells.Count - 1 do
    2893   with Cells[C] do
    2894     Area := nil;
    2895   Areas.Clear;
    2896   for C := 0 to Cells.Count - 1 do
    2897   with Cells[C] do
    2898   if (Terrain <> ttVoid) and (not Assigned(Area)) then begin
    2899     NewArea := TMapArea.Create;
    2900     NewArea.Id := Map.Areas.Count;
    2901     NewArea.Map := Map;
    2902     Areas.Add(NewArea);
    2903     Area := NewArea;
    2904     AreaExtend;
    2905   end;
    2906174end;
    2907175
    … …  
    3365633  // Finalize current player
    3366634  CurrentPlayer.MoveAll;
    3367   Map.Grow(CurrentPlayer);
     635  CurrentPlayer.Grow;
    3368636  CurrentPlayer.UpdateRepeatMoves;
    3369637  ComputePlayerStats;
    … …  
    3426694    R := True;
    3427695    for I := 0 to Cells.Count - 1 do begin
    3428       if I = 0 then Player := Cells[I].Player;
     696      if I = 0 then Player := TPlayer(Cells[I].Player);
    3429697      if not Assigned(Cells[I].Player) then begin
    3430698        R := False;
    … …  
    3533801end;
    3534802
    3535 { TPlayers }
    3536 
    3537 function TPlayers.GetAlivePlayers: TPlayerArray;
    3538 var
    3539   Player: TPlayer;
    3540 begin
    3541   SetLength(Result, 0);
    3542   for Player in Self do
    3543     if Player.IsAlive then begin
    3544       SetLength(Result, Length(Result) + 1);
    3545       Result[Length(Result) - 1] := Player;
    3546     end;
    3547 end;
    3548 
    3549 function TPlayers.GetAlivePlayersWithCities: TPlayerArray;
    3550 var
    3551   Player: TPlayer;
    3552 begin
    3553   SetLength(Result, 0);
    3554   for Player in Self do
    3555     if Player.TotalCities > 0 then begin
    3556       SetLength(Result, Length(Result) + 1);
    3557       Result[Length(Result) - 1] := Player;
    3558     end;
    3559 end;
    3560 
    3561803end.
Note: See TracChangeset for help on using the changeset viewer.