- Timestamp:
- Sep 19, 2018, 2:05:52 PM (6 years ago)
- Location:
- trunk
- Files:
-
- 3 added
- 17 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/Forms/UFormCharts.pas
r208 r231 34 34 35 35 uses 36 UCore, UGame ;36 UCore, UGame, UPlayer; 37 37 38 38 resourcestring -
trunk/Forms/UFormClient.pas
r227 r231 8 8 Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls, 9 9 UGame, LCLType, Menus, ActnList, ComCtrls, dateutils, XMLConf, DOM, 10 UGeometry, UGameClient, UGameProtocol, UThreading ;10 UGeometry, UGameClient, UGameProtocol, UThreading, UPlayer, UClientGUI; 11 11 12 12 const … … 69 69 procedure Timer1Timer(Sender: TObject); 70 70 private 71 FClient: TClient ;71 FClient: TClientGUI; 72 72 TempBitmap: TBitmap; 73 73 StartMousePoint: TPoint; … … 80 80 TimerPeriod: TDateTime; 81 81 TurnActive: Boolean; 82 procedure SetClient(AValue: TClient );82 procedure SetClient(AValue: TClientGUI); 83 83 procedure DoClientChange(Sender: TObject); 84 84 procedure DoGameEnd(Sender: TObject); … … 94 94 procedure UpdateInterface; 95 95 procedure Redraw; 96 property Client: TClient read FClient write SetClient;96 property Client: TClientGUI read FClient write SetClient; 97 97 end; 98 98 … … 178 178 TempBitmap.Canvas.Brush.Color := BackGroundColor; //clBackground; //PaintBox1.GetColorResolvingParent; 179 179 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); 182 181 PaintBox1.Canvas.Draw(0, 0, TempBitmap); 183 182 end else begin … … 186 185 PaintBox1.Canvas.FillRect(0, 0, PaintBox1.Width, PaintBox1.Height); 187 186 {$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) 190 188 end; 191 189 end; … … 227 225 end; 228 226 229 procedure TFormClient.SetClient(AValue: TClient );227 procedure TFormClient.SetClient(AValue: TClientGUI); 230 228 begin 231 229 if FClient = AValue then Exit; … … 474 472 with Core.Game do 475 473 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))); 477 475 //else Cell := Client.Game.Map.PosToCell(Client.View.CanvasToCellPos(TPoint.Create(X, Y)), Client.View); 478 476 if Assigned(Cell) then begin -
trunk/Forms/UFormNew.pas
r229 r231 7 7 uses 8 8 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; 11 11 12 12 type -
trunk/Forms/UFormPlayer.pas
r188 r231 7 7 uses 8 8 Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, 9 ColorBox, Menus, Spin, UGame ;9 ColorBox, Menus, Spin, UGame, UPlayer; 10 10 11 11 type -
trunk/Forms/UFormPlayersStats.pas
r208 r231 39 39 40 40 uses 41 UCore ;41 UCore, UPlayer; 42 42 43 43 {$R *.lfm} -
trunk/Forms/UFormUnitMoves.pas
r228 r231 29 29 30 30 uses 31 UGame, UCore ;31 UGame, UCore, UPlayer; 32 32 33 33 {$R *.lfm} -
trunk/Languages/xtactics.cs.po
r229 r231 755 755 msgid "Repeat count" 756 756 msgstr "Počet opakovaně" 757 758 #: uclientgui.swrongarrowangle 759 msgid "Wrong arrow angle %s" 760 msgstr "" 761 762 #: uclientgui.szerozoomnotalowed 763 #, fuzzy 764 msgctxt "uclientgui.szerozoomnotalowed" 765 msgid "Zero zoom not allowed" 766 msgstr "Nulové přiblížení není povoleno" 757 767 758 768 #: ucore.sendgame … … 968 978 msgstr "Člověk" 969 979 970 #: ugame.sattackerpowerpositive971 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.scellremoveneighborerror976 msgid "Can't remove cell from neighbour cell"977 msgstr "Nelze odstranit buňku ze sousední buňky"978 979 980 #: ugame.scomputer 980 981 msgctxt "ugame.scomputer" … … 982 983 msgstr "Počítač" 983 984 984 #: ugame.sdefenderpowerpositive985 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 988 985 #: ugame.shuman 989 986 msgctxt "ugame.shuman" … … 995 992 msgstr "Potřebujete alespoň dva hráče" 996 993 997 #: ugame.snegativecellpowernotallowed998 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 1001 994 #: ugame.snewgamefile 1002 995 msgid "New game.xtg" … … 1012 1005 msgstr "Divák" 1013 1006 1014 #: ugame.sunfinishedbattle1015 msgid "Unfinished battle"1016 msgstr "Neukončená bitva"1017 1018 1007 #: ugame.sunitpowermismatch 1019 1008 msgid "Unit move power mismatch. Cell power is %d but %d moved away." … … 1024 1013 msgstr "Chybný formát souboru" 1025 1014 1026 #: ugame.szerozoomnotalowed 1027 msgid "Zero zoom not allowed" 1028 msgstr "Nulové přiblížení není povoleno" 1015 #: umap.scellremoveneighborerror 1016 #, fuzzy 1017 msgctxt "umap.scellremoveneighborerror" 1018 msgid "Can't remove cell from neighbour cell" 1019 msgstr "Nelze odstranit buňku ze sousední buňky" 1020 1021 #: umap.snegativecellpowernotallowed 1022 #, fuzzy 1023 msgctxt "umap.snegativecellpowernotallowed" 1024 msgid "Not allowed to substract power under zero to negative value" 1025 msgstr "Není povoleno odečíst sílu pod nulu do záporné hodnoty" 1026 1027 #: uplayer.sattackerpowerpositive 1028 #, fuzzy 1029 msgctxt "uplayer.sattackerpowerpositive" 1030 msgid "Attacker power have to be higher then 0." 1031 msgstr "Síla útočníka musí být větší než 0." 1032 1033 #: uplayer.sdefenderpowerpositive 1034 #, fuzzy 1035 msgctxt "uplayer.sdefenderpowerpositive" 1036 msgid "Defender power have to be higher then or equal to 0." 1037 msgstr "Síla obránce musí být vyšší než nebo rovna nule." 1038 1039 #: uplayer.sunfinishedbattle 1040 #, fuzzy 1041 msgctxt "uplayer.sunfinishedbattle" 1042 msgid "Unfinished battle" 1043 msgstr "Neukončená bitva" 1029 1044 1030 1045 #: uvarblockserializer.serrorgetvarsize -
trunk/Languages/xtactics.po
r229 r231 739 739 #: tformunitmoves.listview1.columns[3].caption 740 740 msgid "Repeat count" 741 msgstr "" 742 743 #: uclientgui.swrongarrowangle 744 msgid "Wrong arrow angle %s" 745 msgstr "" 746 747 #: uclientgui.szerozoomnotalowed 748 msgctxt "uclientgui.szerozoomnotalowed" 749 msgid "Zero zoom not allowed" 741 750 msgstr "" 742 751 … … 947 956 msgstr "" 948 957 949 #: ugame.sattackerpowerpositive950 msgctxt "ugame.sattackerpowerpositive"951 msgid "Attacker power have to be higher then 0."952 msgstr ""953 954 #: ugame.scellremoveneighborerror955 msgid "Can't remove cell from neighbour cell"956 msgstr ""957 958 958 #: ugame.scomputer 959 959 msgctxt "ugame.scomputer" … … 961 961 msgstr "" 962 962 963 #: ugame.sdefenderpowerpositive964 msgid "Defender power have to be higher then or equal to 0."965 msgstr ""966 967 963 #: ugame.shuman 968 964 msgctxt "ugame.shuman" … … 974 970 msgstr "" 975 971 976 #: ugame.snegativecellpowernotallowed977 msgid "Not allowed to substract power under zero to negative value"978 msgstr ""979 980 972 #: ugame.snewgamefile 981 973 msgid "New game.xtg" … … 991 983 msgstr "" 992 984 993 #: ugame.sunfinishedbattle994 msgid "Unfinished battle"995 msgstr ""996 997 985 #: ugame.sunitpowermismatch 998 986 msgid "Unit move power mismatch. Cell power is %d but %d moved away." … … 1003 991 msgstr "" 1004 992 1005 #: ugame.szerozoomnotalowed 1006 msgid "Zero zoom not allowed" 993 #: umap.scellremoveneighborerror 994 msgid "Can't remove cell from neighbour cell" 995 msgstr "" 996 997 #: umap.snegativecellpowernotallowed 998 msgid "Not allowed to substract power under zero to negative value" 999 msgstr "" 1000 1001 #: uplayer.sattackerpowerpositive 1002 msgid "Attacker power have to be higher then 0." 1003 msgstr "" 1004 1005 #: uplayer.sdefenderpowerpositive 1006 msgid "Defender power have to be higher then or equal to 0." 1007 msgstr "" 1008 1009 #: uplayer.sunfinishedbattle 1010 msgid "Unfinished battle" 1007 1011 msgstr "" 1008 1012 -
trunk/UClientAI.pas
r223 r231 6 6 7 7 uses 8 Classes, SysUtils, UGameClient, UGame, Math ;8 Classes, SysUtils, UGameClient, UGame, Math, UPlayer, UMap; 9 9 10 10 type … … 232 232 if (TargetCells[C].GetAvialPower + TargetCells[C].GetAttackPower + MovedPower) > Game.Map.MaxPower then 233 233 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); 235 235 end; 236 236 end; … … 311 311 // Fallback 312 312 for I := MovesTo.Count - 1 downto 0 do 313 MapCell.Player.Moves.Remove(MovesTo[I]);313 TPlayer(MapCell.Player).Moves.Remove(MovesTo[I]); 314 314 for I := 0 to Neighbors.Count - 1 do 315 315 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); 317 317 Break; 318 318 end; -
trunk/UCore.lfm
r222 r231 3 3 OnDestroy = DataModuleDestroy 4 4 OldCreateOrder = False 5 Height = 8116 HorizontalOffset = 4247 VerticalOffset = 3 748 Width = 1 2589 PPI = 1 445 Height = 676 6 HorizontalOffset = 353 7 VerticalOffset = 312 8 Width = 1048 9 PPI = 120 10 10 object ActionListMain: TActionList 11 11 Images = ImageListSmall 12 left = 1 3713 top = 6012 left = 114 13 top = 50 14 14 object AExit: TAction 15 15 Caption = 'Exit' … … 105 105 end 106 106 object ImageListSmall: TImageList 107 left = 786108 top = 420107 left = 655 108 top = 350 109 109 Bitmap = { 110 110 4C690C00000010000000100000000000000000000000E3AA4BD6E5B35EFFE3B1 … … 498 498 POFilesFolder = 'Languages' 499 499 OnTranslate = CoolTranslator1Translate 500 left = 1 37501 top = 436500 left = 114 501 top = 363 502 502 end 503 503 object ImageListLarge: TImageList 504 504 Height = 32 505 505 Width = 32 506 left = 786507 top = 2 86506 left = 655 507 top = 238 508 508 Bitmap = { 509 509 4C690C0000002000000020000000000000000000000000000000E2AA4B36E2A9 … … 2050 2050 RootName = 'CONFIG' 2051 2051 ReadOnly = False 2052 left = 1 372053 top = 5562052 left = 114 2053 top = 463 2054 2054 end 2055 2055 object OpenDialog1: TOpenDialog 2056 2056 DefaultExt = '.xtmap' 2057 left = 11262058 top = 2 922057 left = 938 2058 top = 243 2059 2059 end 2060 2060 object SaveDialog1: TSaveDialog 2061 2061 DefaultExt = '.xtmap' 2062 left = 11262063 top = 1 662062 left = 938 2063 top = 138 2064 2064 end 2065 2065 object ApplicationInfo: TApplicationInfo … … 2078 2078 RegistryRoot = rrKeyCurrentUser 2079 2079 License = 'CC0' 2080 left = 1 372081 top = 1 802080 left = 114 2081 top = 150 2082 2082 end 2083 2083 object PersistentForm: TPersistentForm 2084 2084 MinVisiblePart = 50 2085 2085 EntireVisible = False 2086 left = 7802087 top = 6002086 left = 650 2087 top = 500 2088 2088 end 2089 2089 object ScaleDPI1: TScaleDPI 2090 2090 AutoDetect = False 2091 left = 1 362092 top = 6762091 left = 113 2092 top = 563 2093 2093 end 2094 2094 object LastOpenedList1: TLastOpenedList 2095 2095 MaxCount = 10 2096 2096 OnChange = LastOpenedList1Change 2097 left = 1 372098 top = 3002097 left = 114 2098 top = 250 2099 2099 end 2100 2100 end -
trunk/UCore.pas
r227 r231 8 8 Classes, SysUtils, XMLConf, FileUtil, ActnList, Controls, Dialogs, Forms, 9 9 UGame, UApplicationInfo, UPersistentForm, UScaleDPI, UCoolTranslator, 10 URegistry, ULastOpenedList, Registry, Menus, UFormClient, 10 URegistry, ULastOpenedList, Registry, Menus, UFormClient, UPlayer, 11 11 UGameServer, UGameClient, fgl, UServerList; 12 12 … … 115 115 uses 116 116 UFormMain, UFormNew, UFormSettings, UFormAbout, UClientAI, UFormKeyShortcuts, 117 UFormHelp, UFormCharts, UFormUnitMoves, UFormPlayersStats ;117 UFormHelp, UFormCharts, UFormUnitMoves, UFormPlayersStats, UClientGUI; 118 118 119 119 const … … 248 248 begin 249 249 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; 252 258 end; 253 259 … … 469 475 NewClient := LocalClients.New(Name); 470 476 NewClient.ControlPlayer := Player; 471 NewClient.View.Clear;472 NewClient.View.Zoom := 1;477 TClientGUI(NewClient).View.Clear; 478 TClientGUI(NewClient).View.Zoom := 1; 473 479 NewClient.LocalServer := Server; 474 480 NewClient.ConnectType := ctLocal; 475 481 NewClient.Active := True; 476 482 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; 479 485 end else 480 486 if Mode = pmComputer then begin 481 487 NewClient := TComputer.Create; 482 NewClient.Game := Game;488 NewClient.Game := TGame(Game); 483 489 NewClient.Name := Name; 484 490 LocalClients.Add(NewClient); … … 537 543 begin 538 544 Form := TFormClient.Create(nil); 539 Form.Client := LocalClients.New(SSpectator);545 Form.Client := TClientGUI(LocalClients.New(SSpectator)); 540 546 Form.Client.LocalServer := Server; 541 547 Form.Client.ConnectType := ctLocal; … … 566 572 NewClient := LocalClients.New(Name); 567 573 NewClient.ControlPlayer := Player; 568 NewClient.View.Clear;569 NewClient.View.Zoom := 1;574 TClientGUI(NewClient).View.Clear; 575 TClientGUI(NewClient).View.Zoom := 1; 570 576 NewClient.LocalServer := Server; 571 577 NewClient.ConnectType := ctLocal; 572 578 NewClient.Active := True; 573 579 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; 576 582 end else 577 583 if Mode = pmComputer then begin 578 584 NewClient := TComputer.Create; 579 NewClient.Game := Game;585 NewClient.Game := TGame(Game); 580 586 NewClient.Name := Name; 581 587 LocalClients.Add(NewClient); … … 607 613 if Game.CurrentPlayer.Mode = pmHuman then begin 608 614 PlayerClient := LocalClients.SearchPlayer(Game.CurrentPlayer); 609 if Assigned(PlayerClient) then FormClient.Client := PlayerClient;615 if Assigned(PlayerClient) then FormClient.Client := TClientGUI(PlayerClient); 610 616 end; 611 617 -
trunk/UGame.pas
r229 r231 8 8 Classes, SysUtils, ExtCtrls, Graphics, XMLConf, XMLRead, XMLWrite, Forms, 9 9 DOM, Math, LazFileUtils, UXMLUtils, Dialogs, Types, LCLType, LCLIntf, fgl, 10 UGeometry ;10 UGeometry, UPlayer, UMap, UMapType; 11 11 12 12 const 13 13 DefaultPlayerStartUnits = 5; 14 SquareCellMulX = 1.05;15 SquareCellMulY = 1.05;16 TriangleCellMulX = 0.55;17 TriangleCellMulY = 1.05;18 14 MaxPlayerCount = 8; 19 DefaultMaxPower = 99;20 15 21 16 type 22 17 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 = class41 private42 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 public50 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 value58 Weight: Integer; // Temporary value59 Angle: Double; // Temporary value60 PlayerCell: Pointer; // Temporary value61 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 = class102 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 = class124 Cell1: TCell;125 Cell2: TCell;126 Distance: Double;127 Angle: Double;128 end;129 130 { TView }131 132 TView = class133 private134 FDestRect: TRect;135 FZoom: Double;136 procedure SetDestRect(AValue: TRect);137 procedure SetZoom(AValue: Double);138 public139 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;157 18 158 19 { TCanvasEx } … … 162 23 class procedure PolygonEx(Canvas: TCanvas; const Points: array of Classes.TPoint; Winding: Boolean); 163 24 end; 164 165 TMapShape = (msRectangle, msImage, msRounded);166 167 { TMapArea }168 169 TMapArea = class170 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 = class185 private186 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 protected197 FPixelRect: TRect;198 FNewCellId: Integer;199 function GetNewCellId: Integer; virtual;200 procedure SortNeighborsByAngle;201 public202 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 = class242 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 = class272 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 = class290 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 = class316 private317 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 public331 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 public370 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 = class391 private392 FCellFrom: TPlayerCell;393 FCellTo: TPlayerCell;394 procedure SetCellFrom(AValue: TPlayerCell);395 procedure SetCellTo(AValue: TPlayerCell);396 public397 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;419 25 420 26 TWinEvent = procedure(Player: TPlayer) of object; … … 506 112 507 113 procedure InitStrings; 508 function CellCompare(const Item1, Item2: TPlayerCell): Integer;509 function CellCompareDescending(const Item1, Item2: TPlayerCell): Integer;510 114 511 115 resourcestring … … 515 119 516 120 implementation 517 518 uses519 UMap;520 121 521 122 resourcestring … … 524 125 SComputer = 'Computer'; 525 126 SWrongFileFormat = 'Wrong file format'; 526 SUnfinishedBattle = 'Unfinished battle';527 127 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.';533 128 SUnitPowerMismatch = 'Unit move power mismatch. Cell power is %d but %d moved away.'; 534 129 … … 546 141 ((((Color shr 16) and $ff) shr 1) shl 16) or 547 142 ((((Color shr 24) and $ff) shr 0) shl 24); 548 end;549 550 function ComparePointer(const Item1, Item2: Integer): Integer;551 begin552 Result := -CompareValue(Item1, Item2);553 end;554 555 556 { TGameTurnStat }557 558 procedure TGameTurnStat.LoadFromNode(Node: TDOMNode);559 begin560 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 begin569 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 var580 Node2: TDOMNode;581 NewTurnStat: TGameTurnStat;582 begin583 Count := 0;584 Node2 := Node.FirstChild;585 while Assigned(Node2) and (Node2.NodeName = 'TurnStat') do begin586 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 var595 I: Integer;596 NewNode: TDOMNode;597 begin598 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 var609 Node2: TDOMNode;610 Node3: TDOMNode;611 begin612 Node3 := Node.FindNode('Points');613 if Assigned(Node3) then begin614 SetLength(Points, 0);615 Node2 := Node3.FirstChild;616 while Assigned(Node2) and (Node2.NodeName = 'Point') do begin617 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 var627 NewNode: TDOMNode;628 NewNode2: TDOMNode;629 I: Integer;630 begin631 NewNode := Node.OwnerDocument.CreateElement('Points');632 Node.AppendChild(NewNode);633 for I := 0 to Length(Points) - 1 do begin634 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 begin643 Cells := TCells.Create;644 Cells.FreeObjects := False;645 end;646 647 destructor TCellLink.Destroy;648 var649 I: Integer;650 begin651 for I := 0 to Cells.Count - 1 do begin652 if Cells[I].Neighbors.Remove(Cells[1 - I]) = -1 then653 raise Exception.Create(SCellRemoveNeighborError);654 if Cells[I].Links.Remove(Self) = -1 then655 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 var665 I: Integer;666 begin667 I := 0;668 while (I < Count) do begin669 if ((TCellLink(Items[I]).Cells[0] = Cell1) and (TCellLink(Items[I]).Cells[1] = Cell2)) or670 ((TCellLink(Items[I]).Cells[0] = Cell2) and (TCellLink(Items[I]).Cells[1] = Cell1)) then671 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 begin680 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 var696 Node2: TDOMNode;697 NewCell: TCellLink;698 begin699 Count := 0;700 Node2 := Node.FirstChild;701 while Assigned(Node2) and (Node2.NodeName = 'CellLink') do begin702 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 var712 I: Integer;713 NewNode2: TDOMNode;714 begin715 for I := 0 to Count - 1 do716 with TCellLink(Items[I]) do begin717 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 var727 Cell: TCell;728 begin729 List.Clear;730 Map.Cells.ClearMark;731 for Cell in Cells do begin732 if Cell.NeighboringToVoid and (Cell.Area = Self) and (not Cell.Mark) then begin733 List.Add(Cell);734 Cell.Mark := True;735 end;736 end;737 end;738 739 constructor TMapArea.Create;740 begin741 Cells := TCells.Create;742 Cells.FreeObjects := False;743 end;744 745 destructor TMapArea.Destroy;746 begin747 FreeAndNil(Cells);748 inherited Destroy;749 end;750 751 { TPlayerCell }752 753 procedure TPlayerCell.LoadFromNode(Node: TDOMNode);754 begin755 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 begin761 if (Cell.Neighbors.IndexOf(Self) = -1) and762 (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 var770 I: Integer;771 begin772 I := Cell.Neighbors.IndexOf(Self);773 if I >= 0 then Cell.Neighbors.Delete(I) else774 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 var782 UnitMove: TUnitMove;783 begin784 Result := MapCell.Power;785 for UnitMove in MovesFrom do786 Result := Result - UnitMove.CountOnce;787 end;788 789 function TPlayerCell.GetAttackPower: Integer;790 var791 I: Integer;792 begin793 Result := 0;794 for I := 0 to MovesTo.Count - 1 do795 Result := Result + TUnitMove(MovesTo[I]).CountOnce;796 end;797 798 procedure TPlayerCell.SaveToNode(Node: TDOMNode);799 begin800 WriteBoolean(Node, 'Explored', Explored);801 WriteInteger(Node, 'MapCell', MapCell.Id);802 end;803 804 constructor TPlayerCell.Create;805 begin806 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 var816 I: Integer;817 begin818 for I := MovesFrom.Count - 1 downto 0 do819 TUnitMove(MovesFrom[I]).List.Remove(TUnitMove(MovesFrom[I]));820 FreeAndNil(MovesFrom);821 for I := MovesTo.Count - 1 downto 0 do822 TUnitMove(MovesTo[I]).List.Remove(TUnitMove(MovesTo[I]));823 FreeAndNil(MovesTo);824 for I := Neighbors.Count - 1 downto 0 do825 if Neighbors[I].Neighbors.Remove(Self) = -1 then826 raise Exception.Create(SCellRemoveNeighborError);827 FreeAndNil(Neighbors);828 inherited Destroy;829 end;830 831 { TPlayerCells }832 833 function TPlayerCells.FindByCellId(Id: Integer): TPlayerCell;834 var835 I: Integer;836 begin837 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 var845 I: Integer;846 begin847 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 var855 Node2: TDOMNode;856 NewCell: TPlayerCell;857 begin858 Count := 0;859 Node2 := Node.FirstChild;860 while Assigned(Node2) and (Node2.NodeName = 'Cell') do begin861 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 var871 I: Integer;872 NewNode: TDOMNode;873 begin874 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 var886 I: Integer;887 TextPos: TPoint;888 Points: array of Classes.TPoint;889 TextSize: TSize;890 begin891 if Cell.MapCell.Extra = etObjectiveTarget then begin892 Text := Text + '!';893 end;894 with Canvas do begin895 if Assigned(View.FocusedCell) and (View.FocusedCell = Cell) then begin896 Pen.Color := clYellow;897 Pen.Style := psSolid;898 Pen.Width := 1;899 end else900 if Cell.MapCell.Terrain = ttCity then begin901 // Cannot set clear border as it will display shifted on gtk2902 //Pen.Style := psClear;903 Pen.Color := clBlack;904 Pen.Style := psSolid;905 Pen.Width := 3;906 end else begin907 // Cannot set clear border as it will display shifted on gtk2908 //Pen.Style := psClear;909 Pen.Color := Brush.Color;910 Pen.Style := psSolid;911 Pen.Width := 0;912 end;913 // Transform view914 SetLength(Points, Length(Cell.MapCell.Polygon.Points));915 for I := 0 to Length(Points) - 1 do916 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 text924 if (Cell.GetAvialPower <> 0) or (Cell.MapCell.Extra = etObjectiveTarget) then begin925 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 var939 I: Integer;940 begin941 Result := nil;942 for I := 0 to Cells.Count - 1 do943 if Cells[I].MapCell.Terrain <> ttVoid then begin944 if Cells[I].MapCell.Polygon.IsPointInside(Pos) then begin945 Result := Cells[I];946 Exit;947 end;948 end;949 end;950 951 function TPlayerMap.CellToPos(Cell: TPlayerCell): TPoint;952 begin953 Result := Cell.MapCell.PosPx;954 end;955 956 procedure TPlayerMap.LoadFromNode(Node: TDOMNode);957 var958 NewNode: TDOMNode;959 begin960 with Node do begin961 NewNode := FindNode('Cells');962 if Assigned(NewNode) then963 Cells.LoadFromNode(NewNode);964 end;965 end;966 967 procedure TPlayerMap.SaveToNode(Node: TDOMNode);968 var969 NewNode: TDOMNode;970 begin971 with Node do begin972 NewNode := OwnerDocument.CreateElement('Cells');973 AppendChild(NewNode);974 Cells.SaveToNode(NewNode);975 end;976 end;977 978 procedure TPlayerMap.Update;979 var980 I: Integer;981 J: Integer;982 OldCount: Integer;983 begin984 for I := 0 to Cells.Count - 1 do985 with TPlayerCell(Cells[I]) do begin986 for J := Neighbors.Count - 1 downto 0 do987 DisconnectFrom(Neighbors[J]);988 end;989 990 // Update players cells count to map cells count to be 1:1991 OldCount := Cells.Count;992 Cells.Count := Player.Game.Map.Cells.Count;993 for I := OldCount to Cells.Count - 1 do994 Cells[I] := TPlayerCell.Create;995 996 for I := 0 to Player.Game.Map.Cells.Count - 1 do begin997 with Cells[I] do begin998 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 do1007 with TPlayerCell(Cells[I]) do begin1008 for J := 0 to MapCell.Neighbors.Count - 1 do1009 ConnectTo(TCell(MapCell.Neighbors[J]).PlayerCell);1010 end;1011 end;1012 1013 constructor TPlayerMap.Create;1014 begin1015 Cells := TPlayerCells.Create;1016 Cells.Map := Self;1017 end;1018 1019 destructor TPlayerMap.Destroy;1020 begin1021 FreeAndNil(Cells);1022 inherited Destroy;1023 end;1024 1025 procedure TPlayerMap.CheckVisibility;1026 var1027 I: Integer;1028 C: Integer;1029 NeighCount: Integer;1030 begin1031 for I := 0 to Cells.Count - 1 do1032 with Cells[I] do begin1033 NeighCount := 0;1034 for C := 0 to MapCell.Neighbors.Count - 1 do1035 if MapCell.Neighbors[C].Player = Player then1036 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 var1045 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 begin1055 with Canvas, View do1056 try1057 Lock;1058 // Draw cell links1059 Pen.Color := clBlack;1060 Pen.Style := psSolid;1061 Pen.Width := 3;1062 for CellLink in Player.Game.Map.CellLinks do1063 with CellLink do begin1064 if Length(Points) >= 2 then begin1065 MoveTo(PointToStdPoint(View.CellToCanvasPos(Points[0])));1066 for I := 1 to Length(Points) - 1 do1067 LineTo(PointToStdPoint(View.CellToCanvasPos(Points[I])));1068 end;1069 end;1070 1071 // Draw cells1072 for Cell in Cells do begin1073 if (Cell.MapCell.Terrain <> ttVoid) and Cell.MapCell.IsVisible(View) then begin1074 if Cell.MapCell.Player = Player then1075 CellText := IntToStr(Cell.GetAvialPower)1076 else CellText := IntToStr(Cell.MapCell.Power);1077 if Assigned(SelectedCell) and (SelectedCell = Cell) then1078 Brush.Color := clGreen1079 else if Assigned(SelectedCell) and Player.Game.Map.IsCellsNeighbor(SelectedCell.MapCell, Cell.MapCell) then1080 Brush.Color := clPurple1081 else if Player.Game.FogOfWar then begin1082 if Cell.InVisibleRange then begin1083 Brush.Color := Cell.MapCell.GetColor;1084 end else begin1085 if Cell.Explored then begin1086 Brush.Color := $404040;1087 CellText := '';1088 end else begin1089 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 else1096 if Game.FogOfWar and (Cell.MapCell.Terrain = ttVoid) and (not Cell.Explored) then begin1097 Brush.Color := clBlack;1098 Player.PlayerMap.PaintCell(Canvas, Cell.MapCell.PosPx, '', View, Cell);1099 end;1100 end;1101 1102 // Draw links to neighbors1103 if Player.Game.DevelMode then1104 for Cell in Cells do begin1105 for NeighCell in Cell.MapCell.Neighbors do begin1106 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 arrows1118 Pen.Color := clCream;1119 for Move in Player.Moves do begin1120 PosFrom := Player.Game.Map.CellToPos(Move.CellFrom.MapCell);1121 PosTo := Player.Game.Map.CellToPos(Move.CellTo.MapCell);1122 // In Fog of war mode show only1123 if Game.FogOfWar and not Cells.SearchCell(Move.CellFrom.MapCell).InVisibleRange and1124 not Cells.SearchCell(Move.CellTo.MapCell).InVisibleRange then1125 Continue;1126 if Move.CountRepeat > 0 then Pen.Width := 21127 else Pen.Width := 1;1128 Angle := ArcTan((PosTo.Y - PosFrom.Y) / (PosTo.X - PosFrom.X));1129 if (Angle > +Pi) or (Angle < -Pi) then1130 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 finally1139 Unlock;1140 end;1141 143 end; 1142 144 … … 1170 172 // LCLIntf.Polyline(Canvas.Handle, @Points[0], Length(Points)); 1171 173 //Changed; 1172 end;1173 1174 1175 { TCells }1176 1177 procedure TCells.FixRefId;1178 var1179 I: Integer;1180 begin1181 for I := 0 to Count - 1 do1182 Items[I].FixRefId;1183 end;1184 1185 function TCells.FindById(Id: Integer): TCell;1186 var1187 I: Integer;1188 begin1189 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 var1197 Cell: TCell;1198 begin1199 List.Clear;1200 for Cell in Self do1201 if (Cell.Terrain <> ttVoid) and (Cell.Weight >= Low) and1202 (Cell.Weight <= High) then List.Add(Cell);1203 end;1204 1205 procedure TCells.GetCellsWithExtra(List: TCells; Extra: TExtraType);1206 var1207 Cell: TCell;1208 begin1209 List.Clear;1210 for Cell in Self do1211 if Cell.Extra = Extra then List.Add(Cell);1212 end;1213 1214 procedure TCells.LoadFromNode(Node: TDOMNode);1215 var1216 Node2: TDOMNode;1217 NewCell: TCell;1218 begin1219 Count := 0;1220 Node2 := Node.FirstChild;1221 while Assigned(Node2) and (Node2.NodeName = 'Cell') do begin1222 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 var1232 I: Integer;1233 NewNode2: TDOMNode;1234 begin1235 for I := 0 to Count - 1 do1236 with Items[I] do begin1237 NewNode2 := Node.OwnerDocument.CreateElement('Cell');1238 Node.AppendChild(NewNode2);1239 SaveToNode(NewNode2);1240 end;1241 end;1242 1243 procedure TCells.ClearMark;1244 var1245 Cell: TCell;1246 begin1247 for Cell in Self do Cell.Mark := False;1248 end;1249 1250 procedure TCells.ClearWeight;1251 var1252 Cell: TCell;1253 begin1254 for Cell in Self do Cell.Weight := 0;1255 end;1256 1257 function TCells.ToString: ansistring;1258 var1259 C: TCell;1260 begin1261 Result := '';1262 for C in Self do1263 Result := Result + IntToStr(C.Id) + ', ';1264 end;1265 1266 { TPlayers }1267 1268 function TPlayers.GetAliveCount: Integer;1269 var1270 Player: TPlayer;1271 begin1272 Result := 0;1273 for Player in Self do1274 if Player.IsAlive then Inc(Result);1275 end;1276 1277 procedure TPlayers.GetAlivePlayers(Players: TPlayers);1278 var1279 Player: TPlayer;1280 begin1281 Players.Clear;1282 for Player in Self do1283 if Player.IsAlive then Players.Add(Player);1284 end;1285 1286 function TPlayers.FindById(Id: Integer): TPlayer;1287 var1288 I: Integer;1289 begin1290 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 var1298 NewPlayer: TPlayer;1299 begin1300 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 then1307 NewPlayer.Agressivity := caMedium;1308 Add(NewPlayer);1309 end;1310 1311 function TPlayers.GetNewPlayerId: Integer;1312 begin1313 Result := NewPlayerId;1314 Inc(NewPlayerId);1315 end;1316 1317 procedure TPlayers.LoadFromNode(Node: TDOMNode);1318 var1319 Node2: TDOMNode;1320 NewPlayer: TPlayer;1321 begin1322 Count := 0;1323 Node2 := Node.FirstChild;1324 while Assigned(Node2) and (Node2.NodeName = 'Player') do begin1325 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 var1335 I: Integer;1336 NewNode: TDOMNode;1337 begin1338 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 begin1347 inherited;1348 NewPlayerId := 1;1349 end;1350 1351 function TPlayers.GetFirstHuman: TPlayer;1352 var1353 I: Integer;1354 begin1355 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 var1363 I: Integer;1364 begin1365 while Count > Source.Count do1366 Delete(Count - 1);1367 while Count < Source.Count do1368 Add(TPlayer.Create);1369 for I := 0 to Count - 1 do begin1370 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 var1378 I: Integer;1379 NewCount: Integer;1380 begin1381 with Config do begin1382 NewCount := GetValue(DOMString(Path + '/Count'), -1);1383 NewPlayerId := 1;1384 if NewCount >= 2 then begin1385 Self.Clear;1386 Count := NewCount;1387 for I := 0 to Count - 1 do begin1388 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 var1399 I: Integer;1400 begin1401 for I := 0 to Count - 1 do1402 Items[I].SaveConfig(Config, Path + '/Player' + IntToStr(I));1403 with Config do begin1404 SetValue(DOMString(Path + '/Count'), Count);1405 end;1406 end;1407 1408 { TUnitMoves }1409 1410 function TUnitMoves.SearchByFromTo(CellFrom, CellTo: TPlayerCell): TUnitMove;1411 var1412 UnitMove: TUnitMove;1413 begin1414 Result := nil;1415 for UnitMove in Self do1416 if (UnitMove.CellFrom = CellFrom) and (UnitMove.CellTo = CellTo) then begin1417 Result := UnitMove;1418 Break;1419 end;1420 end;1421 1422 procedure TUnitMoves.LoadFromNode(Node: TDOMNode);1423 var1424 Node2: TDOMNode;1425 NewUnitMove: TUnitMove;1426 begin1427 Count := 0;1428 Node2 := Node.FirstChild;1429 while Assigned(Node2) and (Node2.NodeName = 'UnitMove') do begin1430 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 var1440 I: Integer;1441 NewNode: TDOMNode;1442 begin1443 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 begin1454 Result:= FSize;1455 end;1456 1457 function TMap.GetPixelRect: TRect;1458 begin1459 if FPixelRect.Empty then FPixelRect := CalculatePixelRect;1460 Result := FPixelRect;1461 end;1462 1463 procedure TMap.SetSize(AValue: TPoint);1464 begin1465 if (FSize.X <> AValue.X) or (FSize.Y <> AValue.Y) then begin1466 FSize := AValue;1467 end;1468 end;1469 1470 function CompareCellAngle(const C1, C2: TCell): Integer;1471 begin1472 if C1.Angle < C2.Angle then Result := -11473 else if C1.Angle > C2.Angle then Result := 11474 else Result := 0;1475 end;1476 1477 procedure TMap.SortNeighborsByAngle;1478 var1479 Cell: TCell;1480 NeighborCell: TCell;1481 begin1482 for Cell in Cells do begin1483 for NeighborCell in Cell.Neighbors do1484 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 var1492 I: Integer;1493 Cell: TCell;1494 PosFrom, PosTo: TPoint;1495 Angle: Double;1496 ArrowCenter: TPoint;1497 Move: TUnitMove;1498 CellLink: TCellLink;1499 begin1500 with Canvas, View do1501 try1502 Lock;1503 1504 // Draw cell links1505 Pen.Color := clBlack;1506 Pen.Style := psSolid;1507 Pen.Width := 3;1508 for CellLink in CellLinks do1509 with CellLink do begin1510 if Length(Points) >= 2 then begin1511 MoveTo(PointToStdPoint(View.CellToCanvasPos(Points[0])));1512 for I := 1 to Length(Points) - 1 do1513 LineTo(PointToStdPoint(View.CellToCanvasPos(Points[I])));1514 end;1515 end;1516 1517 // Draw cells1518 for Cell in Cells do begin1519 if (Cell.Terrain <> ttVoid) and Cell.IsVisible(View) then begin1520 if Assigned(SelectedCell) and (SelectedCell.MapCell = Cell) then1521 Brush.Color := clGreen1522 else if Assigned(SelectedCell) and IsCellsNeighbor(SelectedCell.MapCell, Cell) then1523 Brush.Color := clPurple1524 else Brush.Color := Cell.GetColor;1525 //Pen.Color := clBlack;1526 PaintCell(Canvas, Cell.PosPx, IntToStr(Cell.Power), View, Cell);1527 end;1528 end;1529 finally1530 Unlock;1531 end;1532 end;1533 1534 function TMap.GetNewCellId: Integer;1535 begin1536 Result := FNewCellId;1537 Inc(FNewCellId);1538 end;1539 1540 function TMap.IsOutsideShape(Coord: TPoint): Boolean;1541 var1542 Rect: TRect;1543 Color: TColor;1544 Pos: TPoint;1545 Center: TPoint;1546 begin1547 case Shape of1548 msRectangle: Result := False;1549 msImage: begin1550 Rect := PixelRect;1551 with Image.Picture.Bitmap do begin1552 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: begin1559 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 end1564 else Result := False;1565 end;1566 end;1567 1568 procedure TMap.DrawArrow(Canvas: TCanvas; View: TView; Pos: TPoint;1569 Angle: Double; Text: string);1570 var1571 Points: array of Classes.TPoint;1572 FPoints: array of TPointF;1573 I: Integer;1574 ArrowSize: TPoint;1575 begin1576 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 // Rotate1591 for I := 0 to Length(Points) - 1 do1592 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 // Shift1595 for I := 0 to Length(Points) - 1 do1596 Points[I] := Point(Trunc(FPoints[I].X + Pos.X), Trunc(FPoints[I].Y + Pos.Y));1597 with Canvas do begin1598 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 begin1611 Result := Cell1.Neighbors.IndexOf(Cell2) <> -1;1612 end;1613 1614 function TMap.IsValidIndex(Index: TPoint): Boolean;1615 begin1616 Result := (Index.X >= 0) and (Index.X < Size.X) and1617 (Index.Y >= 0) and (Index.Y < Size.Y);1618 end;1619 1620 procedure TMap.Assign(Source: TMap);1621 //var1622 // I: Integer;1623 begin1624 // Do not assign Game field1625 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 cells1632 {// Copy all cells1633 Cells.Count := 0;1634 Cells.Count := Source.Cells.Count;1635 for I := 0 to Cells.Count - 1 do begin1636 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 begin1645 1646 end;1647 1648 procedure TMap.SaveToFile(FileName: string);1649 begin1650 1651 end;1652 1653 procedure TMap.LoadFromNode(Node: TDOMNode);1654 var1655 Node2: TDOMNode;1656 begin1657 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) then1664 Cells.LoadFromNode(Node2);1665 Node2 := Node.FindNode('CellLinks');1666 if Assigned(Node2) then1667 CellLinks.LoadFromNode(Node2);1668 FPixelRect := CalculatePixelRect;1669 end;1670 1671 procedure TMap.SaveToNode(Node: TDOMNode);1672 var1673 NewNode: TDOMNode;1674 begin1675 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 var1691 I: Integer;1692 begin1693 Result := nil;1694 for I := 0 to Cells.Count - 1 do1695 if Cells[I].Terrain <> ttVoid then begin1696 if Cells[I].Polygon.IsPointInside(Pos) then begin1697 Result := Cells[I];1698 Exit;1699 end;1700 end;1701 end;1702 1703 function TMap.CellToPos(Cell: TCell): TPoint;1704 begin1705 Result := Cell.PosPx;1706 end;1707 1708 procedure TMap.Grow(APlayer: TPlayer);1709 var1710 I: Integer;1711 Addition: Integer;1712 Dies: Integer;1713 begin1714 for I := 0 to Cells.Count - 1 do1715 with Cells[I] do begin1716 if (Player = APlayer) and ((Game.GrowCells = gcPlayerAll) or1717 ((Game.GrowCells = gcPlayerCities) and (Terrain = ttCity))) then begin1718 if Power < MaxPower then begin1719 // Increase units count1720 Addition := 0;1721 if Game.GrowAmount = gaByOne then begin1722 Addition := 1;1723 end else1724 if Game.GrowAmount = gaBySquareRoot then begin1725 Addition := Trunc(Sqrt(Power));1726 if Addition = 0 then Addition := 1;1727 end;1728 Power := Min(Power + Addition, MaxPower);1729 end else1730 if Power > MaxPower then begin1731 // Reduce units count1732 // If cell has more then MaxPower units then additional units dies1733 // in twice of squeare root of unites over MaxPower1734 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 var1744 I: Integer;1745 TextPos: TPoint;1746 Points: array of Classes.TPoint;1747 TextSize: TSize;1748 begin1749 if Cell.Extra = etObjectiveTarget then begin1750 Text := Text + '!';1751 end;1752 with Canvas do begin1753 if Assigned(View.FocusedCell) and (View.FocusedCell.MapCell = Cell) then begin1754 Pen.Color := clYellow;1755 Pen.Style := psSolid;1756 Pen.Width := 1;1757 end else1758 if Cell.Terrain = ttCity then begin1759 // Cannot set clear border as it will display shifted on gtk21760 //Pen.Style := psClear;1761 Pen.Color := clBlack;1762 Pen.Style := psSolid;1763 Pen.Width := 3;1764 end else begin1765 // Cannot set clear border as it will display shifted on gtk21766 //Pen.Style := psClear;1767 Pen.Color := Brush.Color;1768 Pen.Style := psSolid;1769 Pen.Width := 0;1770 end;1771 // Transform view1772 SetLength(Points, Length(Cell.Polygon.Points));1773 for I := 0 to Length(Points) - 1 do1774 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 text1782 if (Cell.Power <> 0) or (Cell.Extra = etObjectiveTarget) then begin1783 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 var1797 Cell: TCell;1798 begin1799 for Cell in Cells do1800 with Cell do begin1801 if Assigned(Player) then begin1802 Inc(Player.TotalCells);1803 Inc(Player.TotalUnits, Power);1804 if Terrain = ttCity then1805 Inc(Player.TotalCities);1806 if Extra = etObjectiveTarget then1807 Inc(Player.TotalWinObjectiveCells);1808 end;1809 end;1810 end;1811 1812 procedure TMap.Generate;1813 var1814 X, Y: Integer;1815 NewCell: TCell;1816 begin1817 Clear;1818 1819 // Allocate and init new1820 Cells.Count := FSize.Y * FSize.X;1821 FNewCellId := 1;1822 for Y := 0 to FSize.Y - 1 do1823 for X := 0 to FSize.X - 1 do begin1824 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 var1837 C: Integer;1838 I: Integer;1839 CellLink: TCellLink;1840 OtherCell1: TCell;1841 OtherCell2: TCell;1842 OppositeCell: TCell;1843 begin1844 // Generic way to create two sides symetric map independent to shape1845 for C := 0 to (Cells.Count div 2) - 1 do begin1846 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 begin1850 CellLink := Cells[C].Links[I];1851 1852 // Remove cells on first half of the map1853 if (Cells.IndexOf(CellLink.Cells[0]) <= (Cells.Count div 2)) and1854 (Cells.IndexOf(CellLink.Cells[1]) <= (Cells.Count div 2)) then1855 begin1856 CellLinks.Remove(CellLink);1857 Continue;1858 end;1859 1860 // Make cross half links symetric1861 if (Cells.IndexOf(CellLink.Cells[0]) <= (Cells.Count div 2)) and1862 (Cells.IndexOf(CellLink.Cells[1]) >= (Cells.Count div 2)) then begin1863 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)) then1867 CellLinks.AddLink(OtherCell1, OtherCell2);1868 end else1869 if (Cells.IndexOf(CellLink.Cells[0]) >= (Cells.Count div 2)) and1870 (Cells.IndexOf(CellLink.Cells[1]) <= (Cells.Count div 2)) then begin1871 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)) then1875 CellLinks.AddLink(OtherCell1, OtherCell2);1876 end;1877 end;1878 end;1879 1880 for C := 0 to (Cells.Count div 2) - 1 do begin1881 // Make copy of links from second half1882 OppositeCell := Cells[Cells.Count - 1 - C];1883 for CellLink in OppositeCell.Links do1884 if (Cells.IndexOf(CellLink.Cells[0]) > (Cells.Count div 2)) and1885 (Cells.IndexOf(CellLink.Cells[1]) > (Cells.Count div 2)) then begin1886 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)) then1889 CellLinks.AddLink(OtherCell1, OtherCell2);1890 end;1891 end;1892 end;1893 1894 procedure TMap.CreateLinks;1895 var1896 LastAreaCount: Integer;1897 begin1898 BuildMapAreas;1899 LastAreaCount := -1;1900 while (Areas.Count > 1) and (Areas.Count <> LastAreaCount) do begin1901 LastAreaCount := Areas.Count;1902 BuildBridges;1903 BuildMapAreas;1904 end;1905 end;1906 1907 procedure TMap.Clear;1908 begin1909 CellLinks.Clear;1910 Cells.Clear;1911 FNewCellId := 1;1912 FPixelRect.SetEmpty;1913 end;1914 1915 procedure TMap.CheckCells;1916 var1917 I: Integer;1918 J: Integer;1919 begin1920 for I := 0 to Cells.Count - 1 do begin1921 for J := I + 1 to Cells.Count - 1 do begin1922 if (Cells[I].Id = Cells[J].Id) then1923 raise Exception.Create('Duplicate cells ID ' + IntToStr(I) + ' ' + IntToStr(J));1924 if (Cells[I].PosPx = Cells[J].PosPx) then1925 raise Exception.Create('Duplicate cells position ' + IntToStr(I) + ' ' + IntToStr(J));1926 end;1927 end;1928 end;1929 1930 constructor TMap.Create;1931 begin1932 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 begin1945 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 var1955 I: Integer;1956 CellRect: TRect;1957 begin1958 Result := TRect.Create(TPoint.Create(0, 0), TPoint.Create(0, 0));1959 // This is generic algorithm to determine pixel size of entire map1960 for I := 0 to Cells.Count - 1 do begin1961 CellRect := Cells[I].Polygon.GetRect;1962 if I = 0 then Result := CellRect1963 else begin1964 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 begin1972 1973 end;1974 1975 { TUnitMove }1976 1977 procedure TUnitMove.SetCellFrom(AValue: TPlayerCell);1978 begin1979 if FCellFrom = AValue then Exit;1980 if Assigned(AValue) and not Assigned(FCellFrom) then begin1981 AValue.MovesFrom.Add(Self);1982 end else1983 if not Assigned(AValue) and Assigned(FCellFrom) then begin1984 FCellFrom.MovesFrom.Remove(Self);1985 end;1986 FCellFrom := AValue;1987 end;1988 1989 procedure TUnitMove.SetCellTo(AValue: TPlayerCell);1990 begin1991 if FCellTo = AValue then Exit;1992 if Assigned(AValue) and not Assigned(FCellTo) then begin1993 AValue.MovesTo.Add(Self);1994 end else1995 if not Assigned(AValue) and Assigned(FCellTo) then begin1996 FCellTo.MovesTo.Remove(Self);1997 end;1998 FCellTo := AValue;1999 end;2000 2001 procedure TUnitMove.LoadFromNode(Node: TDOMNode);2002 begin2003 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 begin2011 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 begin2019 List := nil; // Is later set to parent list owning item2020 FCellFrom := nil;2021 FCellTo := nil;2022 end;2023 2024 destructor TUnitMove.Destroy;2025 begin2026 CellFrom := nil;2027 CellTo := nil;2028 List := nil;2029 inherited Destroy;2030 end;2031 2032 { TView }2033 2034 procedure TView.SetZoom(AValue: Double);2035 begin2036 if FZoom = AValue then Exit;2037 if AValue = 0 then2038 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 begin2048 FocusedCell := nil;2049 SelectedCell := nil;2050 end;2051 2052 procedure TView.SetDestRect(AValue: TRect);2053 var2054 Diff: TPoint;2055 begin2056 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 begin2067 Zoom := 1.5;2068 Clear;2069 end;2070 2071 destructor TView.Destroy;2072 begin2073 inherited Destroy;2074 end;2075 2076 { TCell }2077 2078 procedure TCell.SetPower(AValue: Integer);2079 begin2080 if FPower = AValue then Exit;2081 if AValue < 0 then2082 raise Exception.Create(SNegativeCellPowerNotAllowed);2083 FPower := AValue;2084 //Check;2085 end;2086 2087 procedure TCell.ConnectTo(Cell: TCell);2088 begin2089 // Connect only if already not connected2090 if Neighbors.IndexOf(Cell) < 0 then begin2091 Cell.Neighbors.Add(Self);2092 Neighbors.Add(Cell);2093 end;2094 end;2095 2096 procedure TCell.DisconnectFrom(Cell: TCell);2097 var2098 I: Integer;2099 begin2100 I := Cell.Neighbors.IndexOf(Self);2101 if I >= 0 then Cell.Neighbors.Delete(I) else2102 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 var2110 NeighVoidCount: Integer;2111 NeighborCell: TCell;2112 begin2113 NeighVoidCount := 0;2114 for NeighborCell in Neighbors do2115 if (NeighborCell.Terrain = ttVoid) then Inc(NeighVoidCount);2116 Result := NeighVoidCount > 0;2117 end;2118 2119 procedure TCell.SetArea(AValue: TMapArea);2120 begin2121 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 begin2129 if FId = AValue then Exit;2130 FId := AValue;2131 end;2132 2133 procedure TCell.AreaExtend;2134 var2135 NeighborCell: TCell;2136 begin2137 for NeighborCell in Neighbors do2138 if (NeighborCell.Terrain <> ttVoid) and (not Assigned(NeighborCell.Area)) then begin2139 NeighborCell.Area := Area;2140 NeighborCell.AreaExtend;2141 end;2142 end;2143 2144 procedure TCell.FixRefId;2145 var2146 I: Integer;2147 begin2148 Player := Map.Game.Players.FindById(PlayerId);2149 2150 Neighbors.Count := Length(NeighborsId);2151 for I := 0 to Length(NeighborsId) - 1 do begin2152 Neighbors[I] := Map.Cells.FindById(NeighborsId[I]);2153 end;2154 end;2155 2156 procedure TCell.LoadFromNode(Node: TDOMNode);2157 var2158 Node2: TDOMNode;2159 Node3: TDOMNode;2160 begin2161 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 begin2171 SetLength(NeighborsId, 0);2172 Node2 := Node3.FirstChild;2173 while Assigned(Node2) and (Node2.NodeName = 'Neighbour') do begin2174 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 begin2182 Polygon.Clear;2183 Node2 := Node3.FirstChild;2184 while Assigned(Node2) and (Node2.NodeName = 'Point') do begin2185 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 var2193 NewNode: TDOMNode;2194 NewNode2: TDOMNode;2195 I: Integer;2196 begin2197 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) then2204 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 begin2209 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 begin2216 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 begin2225 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 list2232 end;2233 2234 function TCell.IsVisible(View: TView): Boolean;2235 var2236 RectPolygon, RectView: TRect;2237 begin2238 RectPolygon := Polygon.GetRect;2239 RectView := View.SourceRect;2240 Result := (2241 (RectPolygon.P1.X < RectView.P2.X) and2242 (RectPolygon.P2.X > RectView.P1.X) and2243 (RectPolygon.P1.Y < RectView.P2.Y) and2244 (RectPolygon.P2.Y > RectView.P1.Y)2245 );2246 end;2247 2248 function TCell.GetColor: TColor;2249 begin2250 if Assigned(Player) then Result := Player.Color2251 else Result := clGray;2252 end;2253 2254 function TCell.ToString: ansistring;2255 begin2256 Result := IntToStr(Id);2257 end;2258 2259 constructor TCell.Create;2260 begin2261 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 var2271 I: Integer;2272 begin2273 for I := Links.Count - 1 downto 0 do2274 FMap.CellLinks.Remove(Links[I]);2275 FreeAndNil(Links);2276 for I := Neighbors.Count - 1 downto 0 do2277 if Neighbors[I].Neighbors.Remove(Self) = -1 then2278 raise Exception.Create(SCellRemoveNeighborError);2279 FreeAndNil(Neighbors);2280 inherited Destroy;2281 end;2282 2283 { TView }2284 2285 function TView.CanvasToCellPos(Pos: TPoint): TPoint;2286 begin2287 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 begin2293 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 begin2299 Result.P1 := CanvasToCellPos(Pos.P1);2300 Result.P2 := CanvasToCellPos(Pos.P2);2301 end;2302 2303 function TView.CellToCanvasRect(Pos: TRect): TRect;2304 begin2305 Result.P1 := CellToCanvasPos(Pos.P1);2306 Result.P2 := CellToCanvasPos(Pos.P2);2307 end;2308 2309 procedure TView.Assign(Source: TView);2310 begin2311 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 begin2322 if FGame = AValue then Exit;2323 FGame := AValue;2324 Moves.Game := AValue;2325 end;2326 2327 procedure TPlayer.Clear;2328 begin2329 TurnStats.Clear;2330 Moves.Clear;2331 end;2332 2333 {procedure TPlayer.SetClient(AValue: TClient);2334 begin2335 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 var2344 NewNode: TDOMNode;2345 begin2346 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 begin2356 NewNode := FindNode('Map');2357 if Assigned(NewNode) then2358 PlayerMap.LoadFromNode(NewNode);2359 PlayerMap.Update;2360 end;2361 with Node do begin2362 NewNode := FindNode('UnitMoves');2363 if Assigned(NewNode) then2364 Moves.LoadFromNode(NewNode);2365 end;2366 with Node do begin2367 NewNode := FindNode('TurnStats');2368 if Assigned(NewNode) then2369 TurnStats.LoadFromNode(NewNode);2370 end;2371 end;2372 2373 procedure TPlayer.SaveToNode(Node: TDOMNode);2374 var2375 NewNode: TDOMNode;2376 begin2377 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 begin2387 NewNode := OwnerDocument.CreateElement('Map');2388 AppendChild(NewNode);2389 PlayerMap.SaveToNode(NewNode);2390 end;2391 with Node do begin2392 NewNode := OwnerDocument.CreateElement('UnitMoves');2393 AppendChild(NewNode);2394 Moves.SaveToNode(NewNode);2395 end;2396 with Node do begin2397 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 begin2405 PlayerMap.Paint(Canvas, View);2406 end;2407 2408 constructor TPlayer.Create;2409 begin2410 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 begin2421 //Client := nil;2422 FreeAndNil(TurnStats);2423 FreeAndNil(PlayerMap);2424 FreeAndNil(Moves);2425 inherited Destroy;2426 end;2427 2428 procedure TPlayer.Assign(Source: TPlayer);2429 begin2430 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 begin2448 with Config do begin2449 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 begin2460 with Config do begin2461 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 var2472 AttackerDiceCount: Integer;2473 DefenderDiceCount: Integer;2474 S: string;2475 I: Integer;2476 AttackRolls: TFPGList<Integer>;2477 DefendRolls: TFPGList<Integer>;2478 begin2479 AttackRolls := TFPGList<Integer>.Create;2480 DefendRolls := TFPGList<Integer>.Create;2481 if AttackPower < 1 then2482 raise Exception.Create(SAttackerPowerPositive);2483 if DefendPower < 0 then2484 raise Exception.Create(SDefenderPowerPositive);2485 while (AttackPower > 0) and (DefendPower > 0) do begin2486 // Risk game rules:2487 // Each side do their dice roll and compare result. Defender wins tie.2488 // Attacker can use three dices and defender two2489 AttackerDiceCount := Min(AttackPower, 3);2490 DefenderDiceCount := Min(DefendPower, 2);2491 // Roll and sort numbers2492 AttackRolls.Count := AttackerDiceCount;2493 for I := 0 to AttackerDiceCount - 1 do begin2494 AttackRolls[I] := Random(7);2495 end;2496 AttackRolls.Sort(ComparePointer);2497 S := 'Att:';2498 for I := 0 to AttackerDiceCount - 1 do2499 S := S + IntToStr(Integer(AttackRolls[I])) + ', ';2500 DefendRolls.Count := DefenderDiceCount;2501 for I := 0 to DefenderDiceCount - 1 do begin2502 DefendRolls[I] := Random(7);2503 end;2504 DefendRolls.Sort(ComparePointer);2505 S := S + ' Def:';2506 for I := 0 to DefenderDiceCount - 1 do2507 S := S + IntToStr(Integer(DefendRolls[I])) + ', ';2508 // Resolution2509 for I := 0 to Min(AttackerDiceCount, DefenderDiceCount) - 1 do2510 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 begin2519 if Item1.MapCell.Power > Item2.MapCell.Power then Result := 12520 else if Item1.MapCell.Power < Item2.MapCell.Power then Result := -12521 else Result := 0;2522 end;2523 2524 function CellCompareDescending(const Item1, Item2: TPlayerCell): Integer;2525 begin2526 if Item1.MapCell.Power > Item2.MapCell.Power then Result := -12527 else if Item1.MapCell.Power < Item2.MapCell.Power then Result := 12528 else Result := 0;2529 end;2530 2531 { TView }2532 2533 procedure TView.SelectCell(Pos: TPoint; Player: TPlayer; ShiftState: TShiftState);2534 var2535 NewSelectedCell: TPlayerCell;2536 UnitMove: TUnitMove;2537 I: Integer;2538 begin2539 NewSelectedCell := Player.PlayerMap.PosToCell(CanvasToCellPos(Pos), Self);2540 if Assigned(NewSelectedCell) then begin2541 if Assigned(SelectedCell) and Game.Map.IsCellsNeighbor(NewSelectedCell.MapCell, SelectedCell.MapCell) then begin2542 if ssShift in ShiftState then begin2543 // Make maximum unit move without confirmation dialog2544 for I := SelectedCell.MovesFrom.Count - 1 downto 0 do begin2545 Player.Moves.Remove(SelectedCell.MovesFrom[I]);2546 end;2547 Game.CurrentPlayer.SetMove(SelectedCell, NewSelectedCell, SelectedCell.MapCell.Power, False);2548 SelectedCell := nil;2549 end else2550 if ssCtrl in ShiftState then begin2551 // If CTRL key pressed then storno all moved from selected cell and2552 // move all power to new selected cell2553 for I := SelectedCell.MovesFrom.Count - 1 downto 0 do2554 Player.Moves.Remove(SelectedCell.MovesFrom[I]);2555 UnitMove := Game.CurrentPlayer.SetMove(SelectedCell, NewSelectedCell, SelectedCell.MapCell.Power, False);2556 if Assigned(UnitMove) then2557 UnitMove.CountRepeat := Player.Game.Map.MaxPower;2558 if NewSelectedCell.MapCell.Player = Player then SelectedCell := NewSelectedCell2559 else SelectedCell := nil;2560 end else begin2561 Game.CurrentPlayer.SetMove(SelectedCell, NewSelectedCell, SelectedCell.MapCell.Power);2562 SelectedCell := nil;2563 end;2564 end else2565 if (NewSelectedCell <> SelectedCell) and (NewSelectedCell.MapCell.Player = Player) then2566 SelectedCell := NewSelectedCell2567 else2568 if (NewSelectedCell = SelectedCell) and (NewSelectedCell.MapCell.Player = Player) then2569 SelectedCell := nil;2570 end;2571 end;2572 2573 procedure TView.CenterMap;2574 var2575 MapRect: TRect;2576 begin2577 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 begin2586 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 var2596 AttackerPower: Integer;2597 DefenderPower: Integer;2598 UnitCount: Integer;2599 UnitMove: TUnitMove;2600 begin2601 for UnitMove in Moves do2602 with UnitMove do begin2603 if CountOnce > 0 then begin2604 if CellFrom.MapCell.Player = Self then begin2605 UnitCount := CountOnce;2606 if CountOnce > CellFrom.MapCell.Power then2607 UnitCount := CellFrom.MapCell.Power;2608 CountOnce := 0;2609 if CellTo.MapCell.Player = Self then begin2610 // Inner move2611 CellTo.MapCell.Power := CellTo.MapCell.Power + UnitCount;2612 end else begin2613 AttackerPower := UnitCount;2614 DefenderPower := CellTo.MapCell.Power;2615 Attack(AttackerPower, DefenderPower);2616 if DefenderPower = 0 then begin2617 // Attacker wins with possible loses2618 ClearMovesFromCell(CellTo);2619 CellTo.MapCell.Player := Self;2620 CellTo.MapCell.Power := AttackerPower;2621 end else2622 if AttackerPower = 0 then begin2623 // Defender wins with possible loses2624 CellTo.MapCell.Power := DefenderPower;2625 end else2626 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 var2638 UnitMove: TUnitMove;2639 Power: Integer;2640 begin2641 // Power of cell can be reduced by unsucessful enemy attack2642 for UnitMove in Moves do begin2643 Power := UnitMove.CellFrom.GetAvialPower;2644 if Power < 0 then begin2645 if Abs(Power) < UnitMove.CountOnce then2646 UnitMove.CountOnce := UnitMove.CountOnce - Abs(Power)2647 else UnitMove.CountOnce := 0;2648 end;2649 end;2650 end;2651 2652 procedure TPlayer.RemoveInvalidMoves;2653 var2654 I: Integer;2655 begin2656 for I := Moves.Count - 1 downto 0 do2657 if Moves[I].CellFrom.MapCell.Player <> Self then2658 Moves.Delete(I);2659 end;2660 2661 procedure TPlayer.ClearMovesFromCell(Cell: TPlayerCell);2662 var2663 I: Integer;2664 begin2665 for I := Cell.MovesFrom.Count - 1 downto 0 do2666 Cell.MovesFrom.Delete(I);2667 end;2668 2669 function TPlayer.SetMove(CellFrom, CellTo: TPlayerCell; Power: Integer; Confirmation: Boolean = True): TUnitMove;2670 var2671 NewMove: TUnitMove;2672 CountOnce: Integer;2673 CountRepeat: Integer;2674 Confirm: Boolean;2675 begin2676 if CellFrom.MapCell.Player <> Self then2677 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 begin2682 CountOnce := Result.CountOnce;2683 CountRepeat := Result.CountRepeat;2684 if (Mode = pmHuman) and Confirmation and2685 Assigned(FOnMove) then2686 FOnMove(CellFrom, CellTo, CountOnce, CountRepeat, True, Confirm);2687 end else begin2688 CountOnce := Power;2689 CountRepeat := 0;2690 if (Mode = pmHuman) and Confirmation and2691 Assigned(FOnMove) then2692 FOnMove(CellFrom, CellTo, CountOnce, CountRepeat, False, Confirm);2693 end;2694 if Confirm then begin2695 if Assigned(Result) then begin2696 // Already have such move2697 if (CountOnce = 0) and (CountRepeat = 0) then begin2698 Result.List.Remove(Result);2699 end else begin2700 Result.CountOnce := CountOnce;2701 Result.CountRepeat := CountRepeat;2702 CheckCounterMove(Result);2703 end;2704 end else begin2705 // Add new move2706 if (CountOnce > 0) or (CountRepeat > 0) then begin2707 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 var2724 Move: TUnitMove;2725 begin2726 for Move in Moves do2727 with Move do begin2728 if CellFrom.MapCell.Player = Self then2729 if CountRepeat <= CellFrom.GetAvialPower then2730 CountOnce := CountRepeat2731 else CountOnce := CellFrom.GetAvialPower;2732 end;2733 RemoveEmptyUnitMoves;2734 end;2735 2736 procedure TPlayer.RemoveEmptyUnitMoves;2737 var2738 I: Integer;2739 begin2740 // Remove empty moves2741 for I := Moves.Count - 1 downto 0 do2742 if (TUnitMove(Moves[I]).CellFrom.MapCell.Player = Self) and2743 (TUnitMove(Moves[I]).CountOnce = 0) and (TUnitMove(Moves[I]).CountRepeat = 0) then2744 Moves.Delete(I);2745 end;2746 2747 procedure TPlayer.Reset;2748 begin2749 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 var2762 I: Integer;2763 begin2764 Moves.Clear;2765 for I := 0 to PlayerMap.Cells.Count - 1 do2766 if PlayerMap.Cells[I].MapCell.Player = Self then2767 PlayerMap.Cells[I].MapCell.Player := nil;2768 end;2769 2770 function TPlayer.IsAlive: Boolean;2771 begin2772 Result := (TotalCells > 0) and Assigned(StartCell);2773 end;2774 2775 procedure TPlayer.CheckCounterMove(Move: TUnitMove);2776 var2777 CounterMove: TUnitMove;2778 begin2779 CounterMove := Moves.SearchByFromTo(Move.CellTo, Move.CellFrom);2780 if Assigned(CounterMove) then begin2781 // For now, just remove counter move2782 Moves.Remove(CounterMove);2783 end;2784 end;2785 2786 procedure TPlayer.SetMode(AValue: TPlayerMode);2787 begin2788 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 var2796 NewList: TCells;2797 NewListVoid: TCells;2798 I: Integer;2799 C: Integer;2800 begin2801 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 do2808 with List[C] do begin2809 for I := 0 to Neighbors.Count - 1 do2810 with Neighbors[I] do2811 if (not Mark) and (Terrain <> ttVoid) and (Area <> SourceArea) and ((DestArea = nil) or (DestArea = Area)) then begin2812 NewList.Add(List[C].Neighbors[I]);2813 Mark := True;2814 end else2815 if (not Mark) and (Terrain = ttVoid) then begin2816 NewListVoid.Add(List[C].Neighbors[I]);2817 Mark := True;2818 end;2819 end;2820 2821 if NewList.Count > 0 then begin2822 // We found cell with different area2823 Result := NewList[Random(NewList.Count)];2824 end else2825 if NewListVoid.Count > 0 then begin2826 // Cell was not found but we have more void cells to check2827 Result := SearchDifferentCellArea(NewListVoid, SourceArea, DestArea);2828 end;2829 2830 FreeAndNil(NewListVoid);2831 FreeAndNil(NewList);2832 end;2833 2834 procedure TMap.BuildBridges;2835 var2836 List: TCells;2837 BorderList: TCells;2838 Cell: TCell;2839 FoundCell1: TCell;2840 FoundCell2: TCell;2841 I: Integer;2842 J: Integer;2843 begin2844 List := TCells.Create;2845 List.FreeObjects := False;2846 2847 BorderList := TCells.Create;2848 BorderList.FreeObjects := False;2849 2850 // Build area bridges2851 if Areas.Count > 1 then2852 for I := 0 to Areas.Count - 1 do2853 with TMapArea(Areas[I]) do begin2854 GetBorderCells(BorderList);2855 if BorderList.Count > 0 then2856 for J := 0 to 4 do begin2857 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 area2865 FoundCell1 := SearchDifferentCellArea(List, TMapArea(Map.Areas[I]), nil);2866 if Assigned(FoundCell1) then begin2867 // Again find back nearest cell with different area.2868 // This will ensure that both cells are closest ones2869 2870 Map.Cells.ClearMark;2871 List[0] := FoundCell1;2872 FoundCell2 := SearchDifferentCellArea(List, FoundCell1.Area, TMapArea(Map.Areas[I]));2873 if Assigned(FoundCell2) then begin2874 // Check if link doesn't exist already2875 if not Assigned(FoundCell1.Links.FindByCells(FoundCell1, FoundCell2)) then begin2876 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 var2889 C: Integer;2890 NewArea: TMapArea;2891 begin2892 for C := 0 to Cells.Count - 1 do2893 with Cells[C] do2894 Area := nil;2895 Areas.Clear;2896 for C := 0 to Cells.Count - 1 do2897 with Cells[C] do2898 if (Terrain <> ttVoid) and (not Assigned(Area)) then begin2899 NewArea := TMapArea.Create;2900 NewArea.Id := Map.Areas.Count;2901 NewArea.Map := Map;2902 Areas.Add(NewArea);2903 Area := NewArea;2904 AreaExtend;2905 end;2906 174 end; 2907 175 … … 3365 633 // Finalize current player 3366 634 CurrentPlayer.MoveAll; 3367 Map.Grow(CurrentPlayer);635 CurrentPlayer.Grow; 3368 636 CurrentPlayer.UpdateRepeatMoves; 3369 637 ComputePlayerStats; … … 3426 694 R := True; 3427 695 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); 3429 697 if not Assigned(Cells[I].Player) then begin 3430 698 R := False; … … 3533 801 end; 3534 802 3535 { TPlayers }3536 3537 function TPlayers.GetAlivePlayers: TPlayerArray;3538 var3539 Player: TPlayer;3540 begin3541 SetLength(Result, 0);3542 for Player in Self do3543 if Player.IsAlive then begin3544 SetLength(Result, Length(Result) + 1);3545 Result[Length(Result) - 1] := Player;3546 end;3547 end;3548 3549 function TPlayers.GetAlivePlayersWithCities: TPlayerArray;3550 var3551 Player: TPlayer;3552 begin3553 SetLength(Result, 0);3554 for Player in Self do3555 if Player.TotalCities > 0 then begin3556 SetLength(Result, Length(Result) + 1);3557 Result[Length(Result) - 1] := Player;3558 end;3559 end;3560 3561 803 end. -
trunk/UGameClient.pas
r223 r231 7 7 uses 8 8 Classes, SysUtils, UGame, Forms, fgl, UGameProtocol, UGameServer, UCommThread, 9 UThreading, UCommFrame ;9 UThreading, UCommFrame, UMap, UPlayer; 10 10 11 11 type … … 32 32 procedure SetControlPlayer(AValue: TPlayer); 33 33 procedure SetForm(AValue: TForm); 34 procedure SetGame(AValue: TGame);35 34 procedure PlayerMove(CellFrom, CellTo: TPlayerCell; var CountOnce, CountRepeat: Integer; 36 35 Update: Boolean; var Confirm: Boolean); 37 36 procedure SetOnMove(AValue: TMoveEvent); 38 37 protected 38 procedure SetGame(AValue: TGame); virtual; 39 39 procedure ReceiveCmd(Command: TCommand; DataOut, DataIn: TStream); virtual; 40 40 procedure DoTurnStartHandler(Sender: TObject); virtual; … … 47 47 public 48 48 Name: string; 49 View: TView;50 49 LocalServer: TServer; 51 50 RemoteAddress: string; … … 54 53 Protocol: TGameProtocolClient; 55 54 procedure DoChange; 56 constructor Create; 55 constructor Create; virtual; 57 56 destructor Destroy; override; 58 57 property ControlPlayer: TPlayer read FControlPlayer write SetControlPlayer; … … 81 80 implementation 82 81 82 uses 83 UClientGUI; 84 83 85 { TClients } 84 86 85 87 function TClients.New(Name: string): TClient; 86 88 begin 87 Result := TClient .Create;89 Result := TClientGUI.Create; 88 90 Result.Game := Game; 89 91 Result.Name := Name; … … 115 117 if FGame = AValue then Exit; 116 118 FGame := AValue; 117 View.Game := AValue;118 119 end; 119 120 … … 233 234 CommFrame := TCommFrame.Create(nil); 234 235 FControlPlayer := nil; 235 View := TView.Create;236 236 Protocol := TGameProtocolClient.Create; 237 237 Protocol.OnTurnStart := DoTurnStartHandler; … … 245 245 Form := nil; 246 246 ControlPlayer := nil; 247 FreeAndNil(View);248 247 FreeAndNil(Protocol); 249 248 FreeAndNil(CommThread); -
trunk/UGameServer.pas
r220 r231 6 6 7 7 uses 8 Classes, SysUtils, UGame, DOM, XMLConf, fgl, UGameProtocol, UCommFrame ;8 Classes, SysUtils, UGame, DOM, XMLConf, fgl, UGameProtocol, UCommFrame, UPlayer; 9 9 10 10 type -
trunk/UMapType.pas
r230 r231 1 unit UMap ;1 unit UMapType; 2 2 3 3 {$mode delphi} … … 6 6 7 7 uses 8 Classes, SysUtils, UGame, XMLRead, XMLWrite, DOM, UGeometry, fgl; 8 Classes, SysUtils, XMLRead, XMLWrite, DOM, UGeometry, fgl, UMap; 9 10 const 11 SquareCellMulX = 1.05; 12 SquareCellMulY = 1.05; 13 TriangleCellMulX = 0.55; 14 TriangleCellMulY = 1.05; 9 15 10 16 type … … 374 380 end; 375 381 376 // Compute polygon cat outby all other cells382 // Compute polygon by catting out map area by all other cells 377 383 for Cell in Cells do begin 378 384 Cell.Polygon := TPolygon.Create(TRect.Create(TPoint.Create(0, 0), -
trunk/xtactics.lpi
r213 r231 104 104 </Item7> 105 105 </RequiredPackages> 106 <Units Count="3 0">106 <Units Count="33"> 107 107 <Unit0> 108 108 <Filename Value="xtactics.lpr"/> … … 170 170 </Unit9> 171 171 <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"/> 174 177 </Unit10> 175 178 <Unit11> 176 <Filename Value="Forms/UForm Charts.pas"/>177 <IsPartOfProject Value="True"/> 178 <ComponentName Value="Form Charts"/>179 <Filename Value="Forms/UFormUnitMoves.pas"/> 180 <IsPartOfProject Value="True"/> 181 <ComponentName Value="FormUnitMoves"/> 179 182 <HasResources Value="True"/> 180 183 <ResourceBaseClass Value="Form"/> 181 184 </Unit11> 182 185 <Unit12> 183 <Filename Value="Forms/UForm UnitMoves.pas"/>184 <IsPartOfProject Value="True"/> 185 <ComponentName Value="Form UnitMoves"/>186 <Filename Value="Forms/UFormChat.pas"/> 187 <IsPartOfProject Value="True"/> 188 <ComponentName Value="FormChat"/> 186 189 <HasResources Value="True"/> 187 190 <ResourceBaseClass Value="Form"/> 188 191 </Unit12> 189 192 <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"/> 195 195 </Unit13> 196 196 <Unit14> 197 <Filename Value="U TCP.pas"/>197 <Filename Value="UServerList.pas"/> 198 198 <IsPartOfProject Value="True"/> 199 199 </Unit14> 200 200 <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"/> 203 206 </Unit15> 204 207 <Unit16> 205 <Filename Value="Forms/UForm Client.pas"/>206 <IsPartOfProject Value="True"/> 207 <ComponentName Value="Form Client"/>208 <Filename Value="Forms/UFormPlayersStats.pas"/> 209 <IsPartOfProject Value="True"/> 210 <ComponentName Value="FormPlayersStats"/> 208 211 <HasResources Value="True"/> 209 212 <ResourceBaseClass Value="Form"/> 210 213 </Unit16> 211 214 <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"/> 217 217 </Unit17> 218 218 <Unit18> 219 <Filename Value="UGame Server.pas"/>219 <Filename Value="UGameClient.pas"/> 220 220 <IsPartOfProject Value="True"/> 221 221 </Unit18> 222 222 <Unit19> 223 <Filename Value="UGame Client.pas"/>223 <Filename Value="UGameProtocol.pas"/> 224 224 <IsPartOfProject Value="True"/> 225 225 </Unit19> 226 226 <Unit20> 227 <Filename Value=" UGameProtocol.pas"/>227 <Filename Value="Packages/PinConnection/UCommPin.pas"/> 228 228 <IsPartOfProject Value="True"/> 229 229 </Unit20> 230 230 <Unit21> 231 <Filename Value=" Packages/PinConnection/UCommPin.pas"/>231 <Filename Value="UGeometry.pas"/> 232 232 <IsPartOfProject Value="True"/> 233 233 </Unit21> 234 234 <Unit22> 235 <Filename Value="UGeometry .pas"/>235 <Filename Value="UGeometryClasses.pas"/> 236 236 <IsPartOfProject Value="True"/> 237 237 </Unit22> 238 238 <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"/> 241 244 </Unit23> 242 245 <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"/> 248 248 </Unit24> 249 249 <Unit25> 250 <Filename Value="U ClientAI.pas"/>250 <Filename Value="UGameConnection.pas"/> 251 251 <IsPartOfProject Value="True"/> 252 252 </Unit25> 253 253 <Unit26> 254 <Filename Value=" UGameConnection.pas"/>254 <Filename Value="Packages/PinConnection/UCommThread.pas"/> 255 255 <IsPartOfProject Value="True"/> 256 256 </Unit26> 257 257 <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"/> 260 263 </Unit27> 261 264 <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"/> 267 267 </Unit28> 268 268 <Unit29> 269 <Filename Value=" Packages/PinConnection/UCommFrame.pas"/>269 <Filename Value="UMapType.pas"/> 270 270 <IsPartOfProject Value="True"/> 271 271 </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> 272 284 </Units> 273 285 </ProjectOptions> -
trunk/xtactics.lpr
r222 r231 11 11 CoolTranslator, TemplateGenerics 12 12 { you can add units after this }, 13 SysUtils, UFormMain, CoolStreaming ;13 SysUtils, UFormMain, CoolStreaming, UMap, UPlayer, UClientGUI; 14 14 15 15 {$R *.res}
Note:
See TracChangeset
for help on using the changeset viewer.