Changeset 231 for trunk


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.
Location:
trunk
Files:
3 added
17 edited

Legend:

Unmodified
Added
Removed
  • trunk/Forms/UFormCharts.pas

    r208 r231  
    3434
    3535uses
    36   UCore, UGame;
     36  UCore, UGame, UPlayer;
    3737
    3838resourcestring
  • trunk/Forms/UFormClient.pas

    r227 r231  
    88  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
    99  UGame, LCLType, Menus, ActnList, ComCtrls, dateutils, XMLConf, DOM,
    10   UGeometry, UGameClient, UGameProtocol, UThreading;
     10  UGeometry, UGameClient, UGameProtocol, UThreading, UPlayer, UClientGUI;
    1111
    1212const
     
    6969    procedure Timer1Timer(Sender: TObject);
    7070  private
    71     FClient: TClient;
     71    FClient: TClientGUI;
    7272    TempBitmap: TBitmap;
    7373    StartMousePoint: TPoint;
     
    8080    TimerPeriod: TDateTime;
    8181    TurnActive: Boolean;
    82     procedure SetClient(AValue: TClient);
     82    procedure SetClient(AValue: TClientGUI);
    8383    procedure DoClientChange(Sender: TObject);
    8484    procedure DoGameEnd(Sender: TObject);
     
    9494    procedure UpdateInterface;
    9595    procedure Redraw;
    96     property Client: TClient read FClient write SetClient;
     96    property Client: TClientGUI read FClient write SetClient;
    9797  end;
    9898
     
    178178      TempBitmap.Canvas.Brush.Color := BackGroundColor; //clBackground; //PaintBox1.GetColorResolvingParent;
    179179      TempBitmap.Canvas.FillRect(0, 0, PaintBox1.Width, PaintBox1.Height);
    180       if Assigned(ControlPlayer) then ControlPlayer.Paint(TempBitmap.Canvas, View)
    181         else Core.Game.Map.Paint(TempBitmap.Canvas, View);
     180      Client.Paint(TempBitmap.Canvas, View);
    182181      PaintBox1.Canvas.Draw(0, 0, TempBitmap);
    183182    end else begin
     
    186185      PaintBox1.Canvas.FillRect(0, 0, PaintBox1.Width, PaintBox1.Height);
    187186      {$endif}
    188       if Assigned(ControlPlayer) then ControlPlayer.Paint(PaintBox1.Canvas, View)
    189         else Core.Game.Map.Paint(PaintBox1.Canvas, View);
     187      Client.Paint(PaintBox1.Canvas, View)
    190188    end;
    191189  end;
     
    227225end;
    228226
    229 procedure TFormClient.SetClient(AValue: TClient);
     227procedure TFormClient.SetClient(AValue: TClientGUI);
    230228begin
    231229  if FClient = AValue then Exit;
     
    474472    with Core.Game do
    475473      if Assigned(Client.ControlPlayer) then
    476         Cell := Client.ControlPlayer.PlayerMap.PosToCell(Client.View.CanvasToCellPos(TPoint.Create(X, Y)), Client.View);
     474        Cell := Client.ControlPlayer.PlayerMap.PosToCell(Client.View.CanvasToCellPos(TPoint.Create(X, Y)));
    477475        //else Cell := Client.Game.Map.PosToCell(Client.View.CanvasToCellPos(TPoint.Create(X, Y)), Client.View);
    478476    if Assigned(Cell) then begin
  • trunk/Forms/UFormNew.pas

    r229 r231  
    77uses
    88  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
    9   ComCtrls, Spin, ExtCtrls, ActnList, ExtDlgs, Menus, UGame, UGeometry,
    10   UGameServer, UServerList;
     9  ComCtrls, Spin, ExtCtrls, ActnList, ExtDlgs, Menus, UGame, UGeometry, UPlayer,
     10  UGameServer, UServerList, UMap;
    1111
    1212type
  • trunk/Forms/UFormPlayer.pas

    r188 r231  
    77uses
    88  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
    9   ColorBox, Menus, Spin, UGame;
     9  ColorBox, Menus, Spin, UGame, UPlayer;
    1010
    1111type
  • trunk/Forms/UFormPlayersStats.pas

    r208 r231  
    3939
    4040uses
    41   UCore;
     41  UCore, UPlayer;
    4242
    4343{$R *.lfm}
  • trunk/Forms/UFormUnitMoves.pas

    r228 r231  
    2929
    3030uses
    31   UGame, UCore;
     31  UGame, UCore, UPlayer;
    3232
    3333{$R *.lfm}
  • trunk/Languages/xtactics.cs.po

    r229 r231  
    755755msgid "Repeat count"
    756756msgstr "Počet opakovaně"
     757
     758#: uclientgui.swrongarrowangle
     759msgid "Wrong arrow angle %s"
     760msgstr ""
     761
     762#: uclientgui.szerozoomnotalowed
     763#, fuzzy
     764msgctxt "uclientgui.szerozoomnotalowed"
     765msgid "Zero zoom not allowed"
     766msgstr "Nulové přiblížení není povoleno"
    757767
    758768#: ucore.sendgame
     
    968978msgstr "Člověk"
    969979
    970 #: ugame.sattackerpowerpositive
    971 msgctxt "ugame.sattackerpowerpositive"
    972 msgid "Attacker power have to be higher then 0."
    973 msgstr "Síla útočníka musí být větší než 0."
    974 
    975 #: ugame.scellremoveneighborerror
    976 msgid "Can't remove cell from neighbour cell"
    977 msgstr "Nelze odstranit buňku ze sousední buňky"
    978 
    979980#: ugame.scomputer
    980981msgctxt "ugame.scomputer"
     
    982983msgstr "Počítač"
    983984
    984 #: ugame.sdefenderpowerpositive
    985 msgid "Defender power have to be higher then or equal to 0."
    986 msgstr "Síla obránce musí být vyšší než nebo rovna nule."
    987 
    988985#: ugame.shuman
    989986msgctxt "ugame.shuman"
     
    995992msgstr "Potřebujete alespoň dva hráče"
    996993
    997 #: ugame.snegativecellpowernotallowed
    998 msgid "Not allowed to substract power under zero to negative value"
    999 msgstr "Není povoleno odečíst sílu pod nulu do záporné hodnoty"
    1000 
    1001994#: ugame.snewgamefile
    1002995msgid "New game.xtg"
     
    10121005msgstr "Divák"
    10131006
    1014 #: ugame.sunfinishedbattle
    1015 msgid "Unfinished battle"
    1016 msgstr "Neukončená bitva"
    1017 
    10181007#: ugame.sunitpowermismatch
    10191008msgid "Unit move power mismatch. Cell power is %d but %d moved away."
     
    10241013msgstr "Chybný formát souboru"
    10251014
    1026 #: ugame.szerozoomnotalowed
    1027 msgid "Zero zoom not allowed"
    1028 msgstr "Nulové přiblížení není povoleno"
     1015#: umap.scellremoveneighborerror
     1016#, fuzzy
     1017msgctxt "umap.scellremoveneighborerror"
     1018msgid "Can't remove cell from neighbour cell"
     1019msgstr "Nelze odstranit buňku ze sousední buňky"
     1020
     1021#: umap.snegativecellpowernotallowed
     1022#, fuzzy
     1023msgctxt "umap.snegativecellpowernotallowed"
     1024msgid "Not allowed to substract power under zero to negative value"
     1025msgstr "Není povoleno odečíst sílu pod nulu do záporné hodnoty"
     1026
     1027#: uplayer.sattackerpowerpositive
     1028#, fuzzy
     1029msgctxt "uplayer.sattackerpowerpositive"
     1030msgid "Attacker power have to be higher then 0."
     1031msgstr "Síla útočníka musí být větší než 0."
     1032
     1033#: uplayer.sdefenderpowerpositive
     1034#, fuzzy
     1035msgctxt "uplayer.sdefenderpowerpositive"
     1036msgid "Defender power have to be higher then or equal to 0."
     1037msgstr "Síla obránce musí být vyšší než nebo rovna nule."
     1038
     1039#: uplayer.sunfinishedbattle
     1040#, fuzzy
     1041msgctxt "uplayer.sunfinishedbattle"
     1042msgid "Unfinished battle"
     1043msgstr "Neukončená bitva"
    10291044
    10301045#: uvarblockserializer.serrorgetvarsize
  • trunk/Languages/xtactics.po

    r229 r231  
    739739#: tformunitmoves.listview1.columns[3].caption
    740740msgid "Repeat count"
     741msgstr ""
     742
     743#: uclientgui.swrongarrowangle
     744msgid "Wrong arrow angle %s"
     745msgstr ""
     746
     747#: uclientgui.szerozoomnotalowed
     748msgctxt "uclientgui.szerozoomnotalowed"
     749msgid "Zero zoom not allowed"
    741750msgstr ""
    742751
     
    947956msgstr ""
    948957
    949 #: ugame.sattackerpowerpositive
    950 msgctxt "ugame.sattackerpowerpositive"
    951 msgid "Attacker power have to be higher then 0."
    952 msgstr ""
    953 
    954 #: ugame.scellremoveneighborerror
    955 msgid "Can't remove cell from neighbour cell"
    956 msgstr ""
    957 
    958958#: ugame.scomputer
    959959msgctxt "ugame.scomputer"
     
    961961msgstr ""
    962962
    963 #: ugame.sdefenderpowerpositive
    964 msgid "Defender power have to be higher then or equal to 0."
    965 msgstr ""
    966 
    967963#: ugame.shuman
    968964msgctxt "ugame.shuman"
     
    974970msgstr ""
    975971
    976 #: ugame.snegativecellpowernotallowed
    977 msgid "Not allowed to substract power under zero to negative value"
    978 msgstr ""
    979 
    980972#: ugame.snewgamefile
    981973msgid "New game.xtg"
     
    991983msgstr ""
    992984
    993 #: ugame.sunfinishedbattle
    994 msgid "Unfinished battle"
    995 msgstr ""
    996 
    997985#: ugame.sunitpowermismatch
    998986msgid "Unit move power mismatch. Cell power is %d but %d moved away."
     
    1003991msgstr ""
    1004992
    1005 #: ugame.szerozoomnotalowed
    1006 msgid "Zero zoom not allowed"
     993#: umap.scellremoveneighborerror
     994msgid "Can't remove cell from neighbour cell"
     995msgstr ""
     996
     997#: umap.snegativecellpowernotallowed
     998msgid "Not allowed to substract power under zero to negative value"
     999msgstr ""
     1000
     1001#: uplayer.sattackerpowerpositive
     1002msgid "Attacker power have to be higher then 0."
     1003msgstr ""
     1004
     1005#: uplayer.sdefenderpowerpositive
     1006msgid "Defender power have to be higher then or equal to 0."
     1007msgstr ""
     1008
     1009#: uplayer.sunfinishedbattle
     1010msgid "Unfinished battle"
    10071011msgstr ""
    10081012
  • trunk/UClientAI.pas

    r223 r231  
    66
    77uses
    8   Classes, SysUtils, UGameClient, UGame, Math;
     8  Classes, SysUtils, UGameClient, UGame, Math, UPlayer, UMap;
    99
    1010type
     
    232232              if (TargetCells[C].GetAvialPower + TargetCells[C].GetAttackPower + MovedPower) > Game.Map.MaxPower then
    233233                MovedPower := Game.Map.MaxPower - TargetCells[C].GetAvialPower - TargetCells[C].GetAttackPower;
    234               MapCell.Player.SetMove(Neighbors[I], TargetCells[C], MovedPower, False);
     234              TPlayer(MapCell.Player).SetMove(Neighbors[I], TargetCells[C], MovedPower, False);
    235235            end;
    236236          end;
     
    311311      // Fallback
    312312      for I := MovesTo.Count - 1 downto 0 do
    313         MapCell.Player.Moves.Remove(MovesTo[I]);
     313        TPlayer(MapCell.Player).Moves.Remove(MovesTo[I]);
    314314      for I := 0 to Neighbors.Count - 1 do
    315315      if (Neighbors[I].MapCell.Player = MapCell.Player) and (AttackersCount(Neighbors[I]) = 0) then begin
    316         MapCell.Player.SetMove(BorderCells[C], Neighbors[I], GetAvialPower, False);
     316        TPlayer(MapCell.Player).SetMove(BorderCells[C], Neighbors[I], GetAvialPower, False);
    317317        Break;
    318318      end;
  • trunk/UCore.lfm

    r222 r231  
    33  OnDestroy = DataModuleDestroy
    44  OldCreateOrder = False
    5   Height = 811
    6   HorizontalOffset = 424
    7   VerticalOffset = 374
    8   Width = 1258
    9   PPI = 144
     5  Height = 676
     6  HorizontalOffset = 353
     7  VerticalOffset = 312
     8  Width = 1048
     9  PPI = 120
    1010  object ActionListMain: TActionList
    1111    Images = ImageListSmall
    12     left = 137
    13     top = 60
     12    left = 114
     13    top = 50
    1414    object AExit: TAction
    1515      Caption = 'Exit'
     
    105105  end
    106106  object ImageListSmall: TImageList
    107     left = 786
    108     top = 420
     107    left = 655
     108    top = 350
    109109    Bitmap = {
    110110      4C690C00000010000000100000000000000000000000E3AA4BD6E5B35EFFE3B1
     
    498498    POFilesFolder = 'Languages'
    499499    OnTranslate = CoolTranslator1Translate
    500     left = 137
    501     top = 436
     500    left = 114
     501    top = 363
    502502  end
    503503  object ImageListLarge: TImageList
    504504    Height = 32
    505505    Width = 32
    506     left = 786
    507     top = 286
     506    left = 655
     507    top = 238
    508508    Bitmap = {
    509509      4C690C0000002000000020000000000000000000000000000000E2AA4B36E2A9
     
    20502050    RootName = 'CONFIG'
    20512051    ReadOnly = False
    2052     left = 137
    2053     top = 556
     2052    left = 114
     2053    top = 463
    20542054  end
    20552055  object OpenDialog1: TOpenDialog
    20562056    DefaultExt = '.xtmap'
    2057     left = 1126
    2058     top = 292
     2057    left = 938
     2058    top = 243
    20592059  end
    20602060  object SaveDialog1: TSaveDialog
    20612061    DefaultExt = '.xtmap'
    2062     left = 1126
    2063     top = 166
     2062    left = 938
     2063    top = 138
    20642064  end
    20652065  object ApplicationInfo: TApplicationInfo
     
    20782078    RegistryRoot = rrKeyCurrentUser
    20792079    License = 'CC0'
    2080     left = 137
    2081     top = 180
     2080    left = 114
     2081    top = 150
    20822082  end
    20832083  object PersistentForm: TPersistentForm
    20842084    MinVisiblePart = 50
    20852085    EntireVisible = False
    2086     left = 780
    2087     top = 600
     2086    left = 650
     2087    top = 500
    20882088  end
    20892089  object ScaleDPI1: TScaleDPI
    20902090    AutoDetect = False
    2091     left = 136
    2092     top = 676
     2091    left = 113
     2092    top = 563
    20932093  end
    20942094  object LastOpenedList1: TLastOpenedList
    20952095    MaxCount = 10
    20962096    OnChange = LastOpenedList1Change
    2097     left = 137
    2098     top = 300
     2097    left = 114
     2098    top = 250
    20992099  end
    21002100end
  • trunk/UCore.pas

    r227 r231  
    88  Classes, SysUtils, XMLConf, FileUtil, ActnList, Controls, Dialogs, Forms,
    99  UGame, UApplicationInfo, UPersistentForm, UScaleDPI, UCoolTranslator,
    10   URegistry, ULastOpenedList, Registry, Menus, UFormClient,
     10  URegistry, ULastOpenedList, Registry, Menus, UFormClient, UPlayer,
    1111  UGameServer, UGameClient, fgl, UServerList;
    1212
     
    115115uses
    116116  UFormMain, UFormNew, UFormSettings, UFormAbout, UClientAI, UFormKeyShortcuts,
    117   UFormHelp, UFormCharts, UFormUnitMoves, UFormPlayersStats;
     117  UFormHelp, UFormCharts, UFormUnitMoves, UFormPlayersStats, UClientGUI;
    118118
    119119const
     
    248248begin
    249249  FirstHuman := Game.Players.GetFirstHuman;
    250   if Assigned(FirstHuman) then FormClient.Client := LocalClients.SearchPlayer(FirstHuman)
    251     else FormClient.Client := TClient(LocalClients.First);
     250  if Assigned(FirstHuman) then FormClient.Client := TClientGUI(LocalClients.SearchPlayer(FirstHuman))
     251    else begin
     252      FormClient.Client := TClientGUI(LocalClients.New(SSpectator));
     253      FormClient.Client.LocalServer := Server;
     254      FormClient.Client.ConnectType := ctLocal;
     255      FormClient.Client.Active := True;
     256      FormClient.AZoomAll.Execute;
     257    end;
    252258end;
    253259
     
    469475    NewClient := LocalClients.New(Name);
    470476    NewClient.ControlPlayer := Player;
    471     NewClient.View.Clear;
    472     NewClient.View.Zoom := 1;
     477    TClientGUI(NewClient).View.Clear;
     478    TClientGUI(NewClient).View.Zoom := 1;
    473479    NewClient.LocalServer := Server;
    474480    NewClient.ConnectType := ctLocal;
    475481    NewClient.Active := True;
    476482    if Assigned(NewClient.ControlPlayer.StartCell) then
    477       NewClient.View.CenterPlayerCity(NewClient.ControlPlayer)
    478       else NewClient.View.CenterMap;
     483      TClientGUI(NewClient).View.CenterPlayerCity(NewClient.ControlPlayer)
     484      else TClientGUI(NewClient).View.CenterMap;
    479485  end else
    480486  if Mode = pmComputer then begin
    481487    NewClient := TComputer.Create;
    482     NewClient.Game := Game;
     488    NewClient.Game := TGame(Game);
    483489    NewClient.Name := Name;
    484490    LocalClients.Add(NewClient);
     
    537543begin
    538544  Form := TFormClient.Create(nil);
    539   Form.Client := LocalClients.New(SSpectator);
     545  Form.Client := TClientGUI(LocalClients.New(SSpectator));
    540546  Form.Client.LocalServer := Server;
    541547  Form.Client.ConnectType := ctLocal;
     
    566572    NewClient := LocalClients.New(Name);
    567573    NewClient.ControlPlayer := Player;
    568     NewClient.View.Clear;
    569     NewClient.View.Zoom := 1;
     574    TClientGUI(NewClient).View.Clear;
     575    TClientGUI(NewClient).View.Zoom := 1;
    570576    NewClient.LocalServer := Server;
    571577    NewClient.ConnectType := ctLocal;
    572578    NewClient.Active := True;
    573579    if Assigned(NewClient.ControlPlayer.StartCell) then
    574       NewClient.View.CenterPlayerCity(NewClient.ControlPlayer)
    575       else NewClient.View.CenterMap;
     580      TClientGUI(NewClient).View.CenterPlayerCity(NewClient.ControlPlayer)
     581      else TClientGUI(NewClient).View.CenterMap;
    576582  end else
    577583  if Mode = pmComputer then begin
    578584    NewClient := TComputer.Create;
    579     NewClient.Game := Game;
     585    NewClient.Game := TGame(Game);
    580586    NewClient.Name := Name;
    581587    LocalClients.Add(NewClient);
     
    607613    if Game.CurrentPlayer.Mode = pmHuman then begin
    608614      PlayerClient := LocalClients.SearchPlayer(Game.CurrentPlayer);
    609       if Assigned(PlayerClient) then FormClient.Client := PlayerClient;
     615      if Assigned(PlayerClient) then FormClient.Client := TClientGUI(PlayerClient);
    610616    end;
    611617
  • 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.
  • trunk/UGameClient.pas

    r223 r231  
    77uses
    88  Classes, SysUtils, UGame, Forms, fgl, UGameProtocol, UGameServer, UCommThread,
    9   UThreading, UCommFrame;
     9  UThreading, UCommFrame, UMap, UPlayer;
    1010
    1111type
     
    3232    procedure SetControlPlayer(AValue: TPlayer);
    3333    procedure SetForm(AValue: TForm);
    34     procedure SetGame(AValue: TGame);
    3534    procedure PlayerMove(CellFrom, CellTo: TPlayerCell; var CountOnce, CountRepeat: Integer;
    3635      Update: Boolean; var Confirm: Boolean);
    3736    procedure SetOnMove(AValue: TMoveEvent);
    3837  protected
     38    procedure SetGame(AValue: TGame); virtual;
    3939    procedure ReceiveCmd(Command: TCommand; DataOut, DataIn: TStream); virtual;
    4040    procedure DoTurnStartHandler(Sender: TObject); virtual;
     
    4747  public
    4848    Name: string;
    49     View: TView;
    5049    LocalServer: TServer;
    5150    RemoteAddress: string;
     
    5453    Protocol: TGameProtocolClient;
    5554    procedure DoChange;
    56     constructor Create;
     55    constructor Create; virtual;
    5756    destructor Destroy; override;
    5857    property ControlPlayer: TPlayer read FControlPlayer write SetControlPlayer;
     
    8180implementation
    8281
     82uses
     83  UClientGUI;
     84
    8385{ TClients }
    8486
    8587function TClients.New(Name: string): TClient;
    8688begin
    87   Result := TClient.Create;
     89  Result := TClientGUI.Create;
    8890  Result.Game := Game;
    8991  Result.Name := Name;
     
    115117  if FGame = AValue then Exit;
    116118  FGame := AValue;
    117   View.Game := AValue;
    118119end;
    119120
     
    233234  CommFrame := TCommFrame.Create(nil);
    234235  FControlPlayer := nil;
    235   View := TView.Create;
    236236  Protocol := TGameProtocolClient.Create;
    237237  Protocol.OnTurnStart := DoTurnStartHandler;
     
    245245  Form := nil;
    246246  ControlPlayer := nil;
    247   FreeAndNil(View);
    248247  FreeAndNil(Protocol);
    249248  FreeAndNil(CommThread);
  • trunk/UGameServer.pas

    r220 r231  
    66
    77uses
    8   Classes, SysUtils, UGame, DOM, XMLConf, fgl, UGameProtocol, UCommFrame;
     8  Classes, SysUtils, UGame, DOM, XMLConf, fgl, UGameProtocol, UCommFrame, UPlayer;
    99
    1010type
  • trunk/UMapType.pas

    r230 r231  
    1 unit UMap;
     1unit UMapType;
    22
    33{$mode delphi}
     
    66
    77uses
    8   Classes, SysUtils, UGame, XMLRead, XMLWrite, DOM, UGeometry, fgl;
     8  Classes, SysUtils, XMLRead, XMLWrite, DOM, UGeometry, fgl, UMap;
     9
     10const
     11  SquareCellMulX = 1.05;
     12  SquareCellMulY = 1.05;
     13  TriangleCellMulX = 0.55;
     14  TriangleCellMulY = 1.05;
    915
    1016type
     
    374380  end;
    375381
    376   // Compute polygon cat out by all other cells
     382  // Compute polygon by catting out map area by all other cells
    377383  for Cell in Cells do begin
    378384    Cell.Polygon := TPolygon.Create(TRect.Create(TPoint.Create(0, 0),
  • trunk/xtactics.lpi

    r213 r231  
    104104      </Item7>
    105105    </RequiredPackages>
    106     <Units Count="30">
     106    <Units Count="33">
    107107      <Unit0>
    108108        <Filename Value="xtactics.lpr"/>
     
    170170      </Unit9>
    171171      <Unit10>
    172         <Filename Value="UMap.pas"/>
    173         <IsPartOfProject Value="True"/>
     172        <Filename Value="Forms/UFormCharts.pas"/>
     173        <IsPartOfProject Value="True"/>
     174        <ComponentName Value="FormCharts"/>
     175        <HasResources Value="True"/>
     176        <ResourceBaseClass Value="Form"/>
    174177      </Unit10>
    175178      <Unit11>
    176         <Filename Value="Forms/UFormCharts.pas"/>
    177         <IsPartOfProject Value="True"/>
    178         <ComponentName Value="FormCharts"/>
     179        <Filename Value="Forms/UFormUnitMoves.pas"/>
     180        <IsPartOfProject Value="True"/>
     181        <ComponentName Value="FormUnitMoves"/>
    179182        <HasResources Value="True"/>
    180183        <ResourceBaseClass Value="Form"/>
    181184      </Unit11>
    182185      <Unit12>
    183         <Filename Value="Forms/UFormUnitMoves.pas"/>
    184         <IsPartOfProject Value="True"/>
    185         <ComponentName Value="FormUnitMoves"/>
     186        <Filename Value="Forms/UFormChat.pas"/>
     187        <IsPartOfProject Value="True"/>
     188        <ComponentName Value="FormChat"/>
    186189        <HasResources Value="True"/>
    187190        <ResourceBaseClass Value="Form"/>
    188191      </Unit12>
    189192      <Unit13>
    190         <Filename Value="Forms/UFormChat.pas"/>
    191         <IsPartOfProject Value="True"/>
    192         <ComponentName Value="FormChat"/>
    193         <HasResources Value="True"/>
    194         <ResourceBaseClass Value="Form"/>
     193        <Filename Value="UTCP.pas"/>
     194        <IsPartOfProject Value="True"/>
    195195      </Unit13>
    196196      <Unit14>
    197         <Filename Value="UTCP.pas"/>
     197        <Filename Value="UServerList.pas"/>
    198198        <IsPartOfProject Value="True"/>
    199199      </Unit14>
    200200      <Unit15>
    201         <Filename Value="UServerList.pas"/>
    202         <IsPartOfProject Value="True"/>
     201        <Filename Value="Forms/UFormClient.pas"/>
     202        <IsPartOfProject Value="True"/>
     203        <ComponentName Value="FormClient"/>
     204        <HasResources Value="True"/>
     205        <ResourceBaseClass Value="Form"/>
    203206      </Unit15>
    204207      <Unit16>
    205         <Filename Value="Forms/UFormClient.pas"/>
    206         <IsPartOfProject Value="True"/>
    207         <ComponentName Value="FormClient"/>
     208        <Filename Value="Forms/UFormPlayersStats.pas"/>
     209        <IsPartOfProject Value="True"/>
     210        <ComponentName Value="FormPlayersStats"/>
    208211        <HasResources Value="True"/>
    209212        <ResourceBaseClass Value="Form"/>
    210213      </Unit16>
    211214      <Unit17>
    212         <Filename Value="Forms/UFormPlayersStats.pas"/>
    213         <IsPartOfProject Value="True"/>
    214         <ComponentName Value="FormPlayersStats"/>
    215         <HasResources Value="True"/>
    216         <ResourceBaseClass Value="Form"/>
     215        <Filename Value="UGameServer.pas"/>
     216        <IsPartOfProject Value="True"/>
    217217      </Unit17>
    218218      <Unit18>
    219         <Filename Value="UGameServer.pas"/>
     219        <Filename Value="UGameClient.pas"/>
    220220        <IsPartOfProject Value="True"/>
    221221      </Unit18>
    222222      <Unit19>
    223         <Filename Value="UGameClient.pas"/>
     223        <Filename Value="UGameProtocol.pas"/>
    224224        <IsPartOfProject Value="True"/>
    225225      </Unit19>
    226226      <Unit20>
    227         <Filename Value="UGameProtocol.pas"/>
     227        <Filename Value="Packages/PinConnection/UCommPin.pas"/>
    228228        <IsPartOfProject Value="True"/>
    229229      </Unit20>
    230230      <Unit21>
    231         <Filename Value="Packages/PinConnection/UCommPin.pas"/>
     231        <Filename Value="UGeometry.pas"/>
    232232        <IsPartOfProject Value="True"/>
    233233      </Unit21>
    234234      <Unit22>
    235         <Filename Value="UGeometry.pas"/>
     235        <Filename Value="UGeometryClasses.pas"/>
    236236        <IsPartOfProject Value="True"/>
    237237      </Unit22>
    238238      <Unit23>
    239         <Filename Value="UGeometryClasses.pas"/>
    240         <IsPartOfProject Value="True"/>
     239        <Filename Value="Forms/UFormServer.pas"/>
     240        <IsPartOfProject Value="True"/>
     241        <ComponentName Value="FormServer"/>
     242        <HasResources Value="True"/>
     243        <ResourceBaseClass Value="Form"/>
    241244      </Unit23>
    242245      <Unit24>
    243         <Filename Value="Forms/UFormServer.pas"/>
    244         <IsPartOfProject Value="True"/>
    245         <ComponentName Value="FormServer"/>
    246         <HasResources Value="True"/>
    247         <ResourceBaseClass Value="Form"/>
     246        <Filename Value="UClientAI.pas"/>
     247        <IsPartOfProject Value="True"/>
    248248      </Unit24>
    249249      <Unit25>
    250         <Filename Value="UClientAI.pas"/>
     250        <Filename Value="UGameConnection.pas"/>
    251251        <IsPartOfProject Value="True"/>
    252252      </Unit25>
    253253      <Unit26>
    254         <Filename Value="UGameConnection.pas"/>
     254        <Filename Value="Packages/PinConnection/UCommThread.pas"/>
    255255        <IsPartOfProject Value="True"/>
    256256      </Unit26>
    257257      <Unit27>
    258         <Filename Value="Packages/PinConnection/UCommThread.pas"/>
    259         <IsPartOfProject Value="True"/>
     258        <Filename Value="Forms/UFormKeyShortcuts.pas"/>
     259        <IsPartOfProject Value="True"/>
     260        <ComponentName Value="FormKeyShortcuts"/>
     261        <HasResources Value="True"/>
     262        <ResourceBaseClass Value="Form"/>
    260263      </Unit27>
    261264      <Unit28>
    262         <Filename Value="Forms/UFormKeyShortcuts.pas"/>
    263         <IsPartOfProject Value="True"/>
    264         <ComponentName Value="FormKeyShortcuts"/>
    265         <HasResources Value="True"/>
    266         <ResourceBaseClass Value="Form"/>
     265        <Filename Value="Packages/PinConnection/UCommFrame.pas"/>
     266        <IsPartOfProject Value="True"/>
    267267      </Unit28>
    268268      <Unit29>
    269         <Filename Value="Packages/PinConnection/UCommFrame.pas"/>
     269        <Filename Value="UMapType.pas"/>
    270270        <IsPartOfProject Value="True"/>
    271271      </Unit29>
     272      <Unit30>
     273        <Filename Value="UMap.pas"/>
     274        <IsPartOfProject Value="True"/>
     275      </Unit30>
     276      <Unit31>
     277        <Filename Value="UPlayer.pas"/>
     278        <IsPartOfProject Value="True"/>
     279      </Unit31>
     280      <Unit32>
     281        <Filename Value="UClientGUI.pas"/>
     282        <IsPartOfProject Value="True"/>
     283      </Unit32>
    272284    </Units>
    273285  </ProjectOptions>
  • trunk/xtactics.lpr

    r222 r231  
    1111  CoolTranslator, TemplateGenerics
    1212  { you can add units after this },
    13   SysUtils, UFormMain, CoolStreaming;
     13  SysUtils, UFormMain, CoolStreaming, UMap, UPlayer, UClientGUI;
    1414
    1515{$R *.res}
Note: See TracChangeset for help on using the changeset viewer.