close Warning: Can't synchronize with repository "(default)" (No changeset 184 in the repository). Look in the Trac log for more information.

source: tags/1.2.0/UGame.pas

Last change on this file was 158, checked in by chronos, 6 years ago
  • Fixed: Show error message if not all players were placed to the map.
File size: 100.4 KB
Line 
1unit UGame;
2
3{$mode delphi}{$H+}
4
5interface
6
7uses
8 Classes, SysUtils, ExtCtrls, Graphics, XMLConf, XMLRead, XMLWrite,
9 DOM, Math, LazFileUtils, UXMLUtils, Dialogs, Types, LCLType, LCLIntf, fgl;
10
11const
12 DefaultPlayerStartUnits = 5;
13 HexCellMulX = 1.12;
14 HexCellMulY = 1.292;
15 SquareCellMulX = 1.05;
16 SquareCellMulY = 1.05;
17 TriangleCellMulX = 0.55;
18 TriangleCellMulY = 1.05;
19 MaxPlayerCount = 8;
20
21type
22 TGame = class;
23 TPlayer = class;
24 TView = class;
25 TUnitMoves = class;
26 TCells = class;
27 TMap = class;
28 TCellLinks = class;
29 TMapArea = class;
30 TClient = class;
31
32 TFloatPoint = record
33 X, Y: Double;
34 end;
35
36 TPointArray = array of TPoint;
37
38 TTerrainType = (ttVoid, ttNormal, ttCity);
39
40 { TCell }
41
42 TCell = class
43 private
44 FArea: TMapArea;
45 FMap: TMap;
46 FPower: Integer;
47 procedure SetArea(AValue: TMapArea);
48 procedure SetPower(AValue: Integer);
49 public
50 Id: Integer;
51 PosPx: TPoint;
52 Polygon: TPointArray;
53 Terrain: TTerrainType;
54 PlayerId: Integer;
55 Player: TPlayer;
56 MovesFrom: TUnitMoves;
57 MovesTo: TUnitMoves;
58 NeighborsId: array of Integer;
59 Neighbors: TCells;
60 Mark: Boolean; // Temporary value
61 Weight: Integer; // Temporary value
62 Links: TCellLinks;
63 procedure Check;
64 function NeighboringToVoid: Boolean;
65 procedure AreaExtend;
66 procedure FixRefId;
67 procedure LoadFromNode(Node: TDOMNode);
68 procedure SaveToNode(Node: TDOMNode);
69 procedure Assign(Source: TCell);
70 function IsVisible(View: TView): Boolean;
71 function GetColor: TColor;
72 function GetAvialPower: Integer;
73 function GetAttackPower: Integer;
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 LoadFromNode(Node: TDOMNode);
92 procedure SaveToNode(Node: TDOMNode);
93 procedure ClearMark;
94 procedure ClearWeight;
95 end;
96
97 { TCellLink }
98
99 TCellLink = class
100 Points: array of TPoint;
101 Cells: TCells;
102 Map: TMap;
103 procedure LoadFromNode(Node: TDOMNode);
104 procedure SaveToNode(Node: TDOMNode);
105 constructor Create;
106 destructor Destroy; override;
107 end;
108
109 { TCellLinks }
110
111 TCellLinks = class(TFPGObjectList<TCellLink>)
112 Map: TMap;
113 function FindByCells(Cell1, Cell2: TCell): TCellLink;
114 function AddLink(Cell1, Cell2: TCell): TCellLink;
115 procedure LoadFromNode(Node: TDOMNode);
116 procedure SaveToNode(Node: TDOMNode);
117 end;
118
119 { TView }
120
121 TView = class
122 private
123 FDestRect: TRect;
124 FZoom: Double;
125 procedure SetDestRect(AValue: TRect);
126 procedure SetZoom(AValue: Double);
127 public
128 Game: TGame;
129 SourceRect: TRect;
130 FocusedCell: TCell;
131 SelectedCell: TCell;
132 procedure Clear;
133 constructor Create;
134 destructor Destroy; override;
135 procedure SelectCell(Pos: TPoint; Player: TPlayer; ShiftState: TShiftState);
136 procedure CenterMap;
137 procedure CenterPlayerCity(Player: TPlayer);
138 function CanvasToCellPos(Pos: TPoint): TPoint;
139 function CellToCanvasPos(Pos: TPoint): TPoint;
140 function CanvasToCellRect(Pos: TRect): TRect;
141 function CellToCanvasRect(Pos: TRect): TRect;
142 procedure Assign(Source: TView);
143 property DestRect: TRect read FDestRect write SetDestRect;
144 property Zoom: Double read FZoom write SetZoom;
145 end;
146
147 { TCanvasEx }
148
149 TCanvasEx = class(TCanvas)
150 class procedure TextOutEx(Canvas: TCanvas; X,Y: Integer; const Text: string; MovePen: Boolean = True);
151 class procedure PolygonEx(Canvas: TCanvas; const Points: array of TPoint; Winding: Boolean);
152 end;
153
154 TMapShape = (msRectangle, msImage, msRounded);
155
156 { TMapArea }
157
158 TMapArea = class
159 Id: Integer;
160 Map: TMap;
161 BridgeCount: Integer;
162 Cells: TCells;
163 procedure GetBorderCells(List: TCells);
164 constructor Create;
165 destructor Destroy; override;
166 end;
167
168 TMapAreas = class(TFPGObjectList<TMapArea>)
169 end;
170
171 { TMap }
172
173 TMap = class
174 private
175 FSize: TPoint;
176 function GetSize: TPoint; virtual;
177 procedure PaintCell(Canvas: TCanvas; Pos: TPoint; Text: string; View: TView;
178 Cell: TCell);
179 procedure DrawArrow(Canvas: TCanvas; View: TView; Pos: TPoint; Angle: Double;
180 Text: string);
181 function SearchDifferentCellArea(List: TCells; SourceArea,
182 DestArea: TMapArea): TCell;
183 procedure SetSize(AValue: TPoint); virtual;
184 protected
185 FPixelRect: TRect;
186 FNewCellId: Integer;
187 function GetNewCellId: Integer; virtual;
188 public
189 Game: TGame;
190 MaxPower: Integer;
191 DefaultCellSize: TPoint;
192 Cells: TCells;
193 Shape: TMapShape;
194 Image: TImage;
195 CellLinks: TCellLinks;
196 Areas: TMapAreas;
197 function IsOutsideShape(Coord: TPoint): Boolean; virtual;
198 function IsCellsNeighbor(Cell1, Cell2: TCell): Boolean; virtual;
199 function IsValidIndex(Index: TPoint): Boolean; virtual;
200 procedure Assign(Source: TMap); virtual;
201 procedure LoadFromFile(FileName: string); virtual;
202 procedure SaveToFile(FileName: string); virtual;
203 procedure LoadFromNode(Node: TDOMNode);
204 procedure SaveToNode(Node: TDOMNode);
205 function PosToCell(Pos: TPoint; View: TView): TCell; virtual;
206 function CellToPos(Cell: TCell): TPoint; virtual;
207 procedure Grow(APlayer: TPlayer); virtual;
208 procedure ComputePlayerStats; virtual;
209 procedure Generate; virtual;
210 procedure BuildMapAreas;
211 procedure BuildBridges;
212 procedure MakeSymetric;
213 procedure CreateLinks;
214 procedure Clear;
215 constructor Create; virtual;
216 destructor Destroy; override;
217 procedure Paint(Canvas: TCanvas; View: TView); virtual;
218 function CalculatePixelRect: TRect; virtual;
219 procedure ForEachCells(Method: TMethod); virtual;
220 property Size: TPoint read GetSize write SetSize;
221 property PixelRect: TRect read FPixelRect;
222 end;
223
224 TPlayerCells = class;
225 TPlayerMap = class;
226
227 { TPlayerCell }
228
229 TPlayerCell = class
230 Explored: Boolean;
231 InVisibleRange: Boolean;
232 MapCell: TCell;
233 List: TPlayerCells;
234 procedure LoadFromNode(Node: TDOMNode);
235 procedure SaveToNode(Node: TDOMNode);
236 end;
237
238 { TPlayerCells }
239
240 TPlayerCells = class(TFPGObjectList<TPlayerCell>)
241 Map: TPlayerMap;
242 function SearchCell(Cell: TCell): TPlayerCell;
243 procedure LoadFromNode(Node: TDOMNode);
244 procedure SaveToNode(Node: TDOMNode);
245 end;
246
247 { TPlayerMap }
248
249 TPlayerMap = class
250 Cells: TPlayerCells;
251 Player: TPlayer;
252 procedure LoadFromNode(Node: TDOMNode);
253 procedure SaveToNode(Node: TDOMNode);
254 procedure Update;
255 constructor Create;
256 destructor Destroy; override;
257 procedure CheckVisibility;
258 procedure Paint(Canvas: TCanvas; View: TView);
259 end;
260
261 { TGameTurnStat }
262
263 TGameTurnStat = class
264 OccupiedCells: Integer;
265 Units: Integer;
266 DiscoveredCells: Integer;
267 Cities: Integer;
268 procedure LoadFromNode(Node: TDOMNode);
269 procedure SaveToNode(Node: TDOMNode);
270 end;
271
272 { TGameTurnStats }
273
274 TGameTurnStats = class(TFPGObjectList<TGameTurnStat>)
275 procedure LoadFromNode(Node: TDOMNode);
276 procedure SaveToNode(Node: TDOMNode);
277 end;
278
279 TPlayerMode = (pmHuman, pmComputer);
280 TComputerAgressivity = (caLow, caMedium, caHigh);
281 TComputer = class;
282 TUnitMove = class;
283
284 { TPlayer }
285
286 TPlayer = class
287 private
288 FClient: TClient;
289 FGame: TGame;
290 FMode: TPlayerMode;
291 procedure SetClient(AValue: TClient);
292 procedure SetGame(AValue: TGame);
293 procedure Attack(var AttackPower, DefendPower: Integer);
294 procedure ClearMovesFromCell(Cell: TCell);
295 procedure MoveAll;
296 procedure ReduceMovesPower;
297 procedure CheckCounterMove(Move: TUnitMove);
298 procedure SetMode(AValue: TPlayerMode);
299 function SetMove(CellFrom, CellTo: TCell; Power: Integer; Confirmation: Boolean = True): TUnitMove;
300 procedure UpdateRepeatMoves;
301 procedure RemoveEmptyUnitMoves;
302 public
303 Id: Integer;
304 Name: string;
305 Color: TColor;
306 TotalUnits: Integer;
307 TotalCells: Integer;
308 TotalCities: Integer;
309 TotalDiscovered: Integer;
310 StartUnits: Integer;
311 StartCell: TCell;
312 PlayerMap: TPlayerMap;
313 Defensive: Boolean;
314 Agressivity: TComputerAgressivity;
315 TurnStats: TGameTurnStats;
316 Moves: TUnitMoves;
317 Computer: TComputer;
318 function IsAlive: Boolean;
319 procedure Clear;
320 procedure LoadFromNode(Node: TDOMNode);
321 procedure SaveToNode(Node: TDOMNode);
322 procedure Paint(Canvas: TCanvas; View: TView);
323 constructor Create;
324 destructor Destroy; override;
325 procedure Assign(Source: TPlayer);
326 procedure LoadConfig(Config: TXmlConfig; Path: string);
327 procedure SaveConfig(Config: TXmlConfig; Path: string);
328 property Game: TGame read FGame write SetGame;
329 property Client: TClient read FClient write SetClient;
330 property Mode: TPlayerMode read FMode write SetMode;
331 end;
332
333 { TComputer }
334
335 TComputer = class
336 Game: TGame;
337 //Targets: TFPGObjectList<TPlayer>;
338 CellProcessDirection: Boolean;
339 Player: TPlayer;
340 procedure AttackNeutral;
341 procedure AttackPlayers;
342 procedure InnerMoves;
343 procedure IncreaseMoves;
344 procedure Process;
345 procedure FallBack;
346 function AttackersCount(Cell: TCell): Integer;
347 end;
348
349 TPlayerArray = array of TPlayer;
350
351 { TPlayers }
352
353 TPlayers = class(TFPGObjectList<TPlayer>)
354 public
355 Game: TGame;
356 NewPlayerId: Integer;
357 function GetAliveCount: Integer;
358 function FindById(Id: Integer): TPlayer;
359 procedure New(Name: string; Color: TColor; Mode: TPlayerMode);
360 function GetNewPlayerId: Integer;
361 procedure LoadFromNode(Node: TDOMNode);
362 procedure SaveToNode(Node: TDOMNode);
363 constructor Create;
364 function GetFirstHuman: TPlayer;
365 procedure Assign(Source: TPlayers);
366 procedure LoadConfig(Config: TXmlConfig; Path: string);
367 procedure SaveConfig(Config: TXmlConfig; Path: string);
368 function GetAlivePlayers: TPlayerArray;
369 function GetAlivePlayersWithCities: TPlayerArray;
370 end;
371
372 { TUnitMove }
373
374 TUnitMove = class
375 private
376 FCellFrom: TCell;
377 FCellTo: TCell;
378 procedure SetCellFrom(AValue: TCell);
379 procedure SetCellTo(AValue: TCell);
380 public
381 List: TUnitMoves;
382 CountOnce: Integer;
383 CountRepeat: Integer;
384 procedure LoadFromNode(Node: TDOMNode);
385 procedure SaveToNode(Node: TDOMNode);
386 constructor Create;
387 destructor Destroy; override;
388 property CellFrom: TCell read FCellFrom write SetCellFrom;
389 property CellTo: TCell read FCellTo write SetCellTo;
390 end;
391
392 { TUnitMoves }
393
394 TUnitMoves = class(TFPGObjectList<TUnitMove>)
395 Game: TGame;
396 function SearchByFromTo(CellFrom, CellTo: TCell): TUnitMove;
397 procedure LoadFromNode(Node: TDOMNode);
398 procedure SaveToNode(Node: TDOMNode);
399 end;
400
401 { TClient }
402
403 TClient = class
404 private
405 FGame: TGame;
406 FControlPlayer: TPlayer;
407 procedure SetControlPlayer(AValue: TPlayer);
408 procedure SetGame(AValue: TGame);
409 public
410 Name: string;
411 View: TView;
412 constructor Create;
413 destructor Destroy; override;
414 property ControlPlayer: TPlayer read FControlPlayer write SetControlPlayer;
415 property Game: TGame read FGame write SetGame;
416 end;
417
418 { TClients }
419
420 TClients = class(TFPGObjectList<TClient>)
421 Game: TGame;
422 procedure New(Name: string);
423 end;
424
425 { TGame }
426
427 TMoveEvent = procedure(CellFrom, CellTo: TCell; var CountOnce, CountRepeat: Integer;
428 Update: Boolean; var Confirm: Boolean) of object;
429 TMoveUpdatedEvent = procedure(UnitMove: TUnitMove) of object;
430
431 TWinEvent = procedure(Player: TPlayer) of object;
432 TGrowAmount = (gaByOne, gaBySquareRoot);
433 TGrowCells = (gcNone, gcPlayerCities, gcPlayerAll);
434 TMapType = (mtNone, mtHexagon, mtSquare, mtTriangle, mtVoronoi);
435 TWinObjective = (woDefeatAllOponents, woDefeatAllOponentsCities,
436 woSpecialCaptureCell, woStayAliveForDefinedTurns);
437
438 TGame = class
439 private
440 FMapType: TMapType;
441 FOnMove: TMoveEvent;
442 FOnMoveUpdated: TMoveUpdatedEvent;
443 FOnNewTurn: TNotifyEvent;
444 FOnPlayerChange: TNotifyEvent;
445 FOnWin: TWinEvent;
446 FRunning: Boolean;
447 LoadedImageFileName: string;
448 ProbabilityMatrix: array of array of Single;
449 procedure RecordTurnStats;
450 procedure SetMapType(AValue: TMapType);
451 procedure SetRunning(AValue: Boolean);
452 procedure BuildTerrain;
453 procedure InitClients;
454 procedure SelectPlayerStartCell(Player: TPlayer);
455 procedure CalculatePlayersDistance;
456 procedure PropagatePlayerDistance(List: TCells);
457 procedure InitDefaultPlayersSetting;
458 public
459 Players: TPlayers;
460 PlayersSetting: TPlayers;
461 Clients: TClients;
462 Map: TMap;
463 MapImageFileName: string;
464 VoidEnabled: Boolean;
465 VoidPercentage: Integer;
466 SymetricMap: Boolean;
467 GrowCells: TGrowCells;
468 GrowAmount: TGrowAmount;
469 CityEnabled: Boolean;
470 CityPercentage: Integer;
471 CurrentPlayer: TPlayer;
472 TurnCounter: Integer;
473 WinObjective: TWinObjective;
474 SpecialCaptureCell: TCell;
475 StayAliveForDefinedTurns: Integer;
476 MaxNeutralUnits: Integer;
477 FileName: string;
478 FogOfWar: Boolean;
479 BridgeEnabled: Boolean;
480 function AttackProbability(AttackCount, DefendCount: Integer): Double;
481 procedure LoadConfig(Config: TXmlConfig; Path: string);
482 procedure SaveConfig(Config: TXmlConfig; Path: string);
483 procedure LoadFromFile(FileName: string);
484 procedure SaveToFile(FileName: string);
485 procedure ComputePlayerStats;
486 procedure NextTurn;
487 procedure CheckWinObjective;
488 constructor Create;
489 destructor Destroy; override;
490 procedure Clear;
491 procedure New;
492 procedure EndGame(Winner: TPlayer = nil);
493 property Running: Boolean read FRunning write SetRunning;
494 property MapType: TMapType read FMapType write SetMapType;
495 published
496 property OnMove: TMoveEvent read FOnMove write FOnMove;
497 property OnMoveUpdated: TMoveUpdatedEvent read FOnMoveUpdated write FOnMoveUpdated;
498 property OnWin: TWinEvent read FOnWin write FOnWin;
499 property OnNewTurn: TNotifyEvent read FOnNewTurn write FOnNewTurn;
500 property OnPlayerChange: TNotifyEvent read FOnPlayerChange write FOnPlayerChange;
501 end;
502
503var
504 PlayerModeText: array[TPlayerMode] of string;
505
506const
507 clOrange = $009Aff;
508 PlayerColors: array[0..7] of TColor = (clBlue, clRed, clGreen, clOrange,
509 clPurple, clMaroon, clAqua, clFuchsia);
510 ComputerAggroProbability: array[TComputerAgressivity] of Single = (0.9, 0.7, 0.5);
511
512procedure InitStrings;
513function FloatPoint(AX, AY: Double): TFloatPoint;
514
515resourcestring
516 SPlayer = 'Player';
517
518
519implementation
520
521uses
522 UMap;
523
524resourcestring
525 SMinimumPlayers = 'You need at least two players';
526 SHuman = 'Human';
527 SComputer = 'Computer';
528 SWrongFileFormat = 'Wrong file format';
529 SUnfinishedBattle = 'Unfinished battle';
530 SNewGameFile = 'New game.xtg';
531 SZeroZoomNotAlowed = 'Zero zoom not allowed';
532 SCellRemoveNeighborError = 'Can''t remove cell from neighbour cell';
533 SNegativeCellPowerNotAllowed = 'Not allowed to substract power under zero to negative value';
534 SAttackerPowerPositive = 'Attacker power have to be higher then 0.';
535 SDefenderPowerPositive = 'Defender power have to be higher then or equal to 0.';
536 SUnitPowerMismatch = 'Unit move power mismatch. Cell power is %d but %d moved away.';
537
538procedure InitStrings;
539begin
540 PlayerModeText[pmHuman] := SHuman;
541 PlayerModeText[pmComputer] := SComputer;
542end;
543
544function FloatPoint(AX, AY: Double): TFloatPoint;
545begin
546 Result.X := AX;
547 Result.Y := AY;
548end;
549
550function RectEquals(A, B: TRect): Boolean;
551begin
552 Result := (A.Left = B.Left) and (A.Top = B.Top) and
553 (A.Right = B.Right) and (A.Bottom = B.Bottom);
554end;
555
556function PtInRect(const Rect: TRect; Pos: TPoint): Boolean;
557begin
558 Result := (Pos.X >= Rect.Left) and (Pos.Y >= Rect.Top) and
559 (Pos.X <= Rect.Right) and (Pos.Y <= Rect.Bottom);
560end;
561
562function PtInPoly(const Points: array of TPoint; Pos: TPoint): Boolean;
563var
564 Count, K, J : Integer;
565begin
566 Result := False;
567 Count := Length(Points) ;
568 J := Count - 1;
569 for K := 0 to Count - 1 do begin
570 if ((Points[K].Y <= Pos.Y) and (Pos.Y < Points[J].Y)) or
571 ((Points[J].Y <= Pos.Y) and (Pos.Y < Points[K].Y)) then
572 begin
573 if (Pos.X < (Points[j].X - Points[K].X) *
574 (Pos.Y - Points[K].Y) /
575 (Points[j].Y - Points[K].Y) + Points[K].X) then
576 Result := not Result;
577 end;
578 J := K;
579 end;
580end;
581
582function GetPolygonRect(Polygon: array of TPoint): TRect;
583var
584 I: Integer;
585begin
586 Result := Rect(High(Integer), High(Integer),
587 Low(Integer), Low(Integer));
588 for I := 0 to Length(Polygon) - 1 do
589 with Polygon[I] do begin
590 if X > Result.Right then
591 Result.Right := X;
592 if X < Result.Left then
593 Result.Left := X;
594 if Y > Result.Bottom then
595 Result.Bottom := Y;
596 if Y < Result.Top then
597 Result.Top := Y;
598 end;
599end;
600
601function HalfColor(Color: TColor): TColor;
602begin
603 Result :=
604 ((((Color shr 0) and $ff) shr 1) shl 0) or
605 ((((Color shr 8) and $ff) shr 1) shl 8) or
606 ((((Color shr 16) and $ff) shr 1) shl 16) or
607 ((((Color shr 24) and $ff) shr 0) shl 24);
608end;
609
610{ TGameTurnStat }
611
612procedure TGameTurnStat.LoadFromNode(Node: TDOMNode);
613begin
614 OccupiedCells := ReadInteger(Node, 'OccupiedCells', 0);
615 Units := ReadInteger(Node, 'Units', 0);
616 DiscoveredCells := ReadInteger(Node, 'DiscoveredCells', 0);
617 Cities := ReadInteger(Node, 'Cities', 0);
618end;
619
620procedure TGameTurnStat.SaveToNode(Node: TDOMNode);
621begin
622 WriteInteger(Node, 'OccupiedCells', OccupiedCells);
623 WriteInteger(Node, 'Units', Units);
624 WriteInteger(Node, 'DiscoveredCells', DiscoveredCells);
625 WriteInteger(Node, 'Cities', Cities);
626end;
627
628{ TGameTurnStats }
629
630procedure TGameTurnStats.LoadFromNode(Node: TDOMNode);
631var
632 Node2: TDOMNode;
633 NewTurnStat: TGameTurnStat;
634begin
635 Count := 0;
636 Node2 := Node.FirstChild;
637 while Assigned(Node2) and (Node2.NodeName = 'TurnStat') do begin
638 NewTurnStat := TGameTurnStat.Create;
639 NewTurnStat.LoadFromNode(Node2);
640 Add(NewTurnStat);
641 Node2 := Node2.NextSibling;
642 end;
643end;
644
645procedure TGameTurnStats.SaveToNode(Node: TDOMNode);
646var
647 I: Integer;
648 NewNode: TDOMNode;
649begin
650 for I := 0 to Count - 1 do begin;
651 NewNode := Node.OwnerDocument.CreateElement('TurnStat');
652 Node.AppendChild(NewNode);
653 TGameTurnStat(Items[I]).SaveToNode(NewNode);
654 end;
655end;
656
657{ TClients }
658
659procedure TClients.New(Name: string);
660var
661 NewClient: TClient;
662begin
663 NewClient := TClient.Create;
664 NewClient.Game := Game;
665 NewClient.Name := Name;
666 Add(NewClient);
667end;
668
669{ TClient }
670
671procedure TClient.SetGame(AValue: TGame);
672begin
673 if FGame = AValue then Exit;
674 FGame := AValue;
675 View.Game := AValue;
676end;
677
678procedure TClient.SetControlPlayer(AValue: TPlayer);
679begin
680 if FControlPlayer = AValue then Exit;
681 if Assigned(FControlPlayer) then
682 FControlPlayer.FClient := nil;
683 FControlPlayer := AValue;
684 if Assigned(FControlPlayer) then
685 FControlPlayer.FClient := Self;
686end;
687
688constructor TClient.Create;
689begin
690 View := TView.Create;
691end;
692
693destructor TClient.Destroy;
694begin
695 ControlPlayer := nil;
696 FreeAndNil(View);
697 inherited Destroy;
698end;
699
700{ TCellLink }
701
702procedure TCellLink.LoadFromNode(Node: TDOMNode);
703var
704 Node2: TDOMNode;
705 Node3: TDOMNode;
706begin
707 Node3 := Node.FindNode('Points');
708 if Assigned(Node3) then begin
709 SetLength(Points, 0);
710 Node2 := Node3.FirstChild;
711 while Assigned(Node2) and (Node2.NodeName = 'Point') do begin
712 SetLength(Points, Length(Points) + 1);
713 Points[High(Points)].X := ReadInteger(Node2, 'X', 0);
714 Points[High(Points)].Y := ReadInteger(Node2, 'Y', 0);
715 Node2 := Node2.NextSibling;
716 end;
717 end;
718end;
719
720procedure TCellLink.SaveToNode(Node: TDOMNode);
721var
722 NewNode: TDOMNode;
723 NewNode2: TDOMNode;
724 I: Integer;
725begin
726 NewNode := Node.OwnerDocument.CreateElement('Points');
727 Node.AppendChild(NewNode);
728 for I := 0 to Length(Points) - 1 do begin
729 NewNode2 := NewNode.OwnerDocument.CreateElement('Point');
730 NewNode.AppendChild(NewNode2);
731 WriteInteger(NewNode2, 'X', Points[I].X);
732 WriteInteger(NewNode2, 'Y', Points[I].Y);
733 end;
734end;
735
736constructor TCellLink.Create;
737begin
738 Cells := TCells.Create;
739 Cells.FreeObjects := False;
740end;
741
742destructor TCellLink.Destroy;
743var
744 I: Integer;
745begin
746 for I := 0 to Cells.Count - 1 do begin
747 if TCell(Cells[I]).Neighbors.Remove(TCell(Cells[1 - I])) = -1 then
748 raise Exception.Create(SCellRemoveNeighborError);
749 if TCell(Cells[I]).Links.Remove(Self) = -1 then
750 raise Exception.Create(SCellRemoveNeighborError);
751 end;
752 FreeAndNil(Cells);
753 inherited Destroy;
754end;
755
756{ TCellLinks }
757
758function TCellLinks.FindByCells(Cell1, Cell2: TCell): TCellLink;
759var
760 I: Integer;
761begin
762 I := 0;
763 while (I < Count) do begin
764 if ((TCellLink(Items[I]).Cells[0] = Cell1) and (TCellLink(Items[I]).Cells[1] = Cell2)) or
765 ((TCellLink(Items[I]).Cells[0] = Cell2) and (TCellLink(Items[I]).Cells[1] = Cell1)) then
766 Break;
767 Inc(I);
768 end;
769 if I < Count then Result := TCellLink(Items[I])
770 else Result := nil;
771end;
772
773function TCellLinks.AddLink(Cell1, Cell2: TCell): TCellLink;
774begin
775 Result := TCellLink.Create;
776 Cell1.Neighbors.Add(Cell2);
777 Cell1.Links.Add(Result);
778 Cell2.Neighbors.Add(Cell1);
779 Cell2.Links.Add(Result);
780 SetLength(Result.Points, 2);
781 Result.Cells.Add(Cell1);
782 Result.Points[0] := Cell1.PosPx;
783 Result.Cells.Add(Cell2);
784 Result.Points[1] := Cell2.PosPx;
785 Result.Map := Map;
786 Map.CellLinks.Add(Result);
787end;
788
789procedure TCellLinks.LoadFromNode(Node: TDOMNode);
790var
791 Node2: TDOMNode;
792 NewCell: TCellLink;
793begin
794 Count := 0;
795 Node2 := Node.FirstChild;
796 while Assigned(Node2) and (Node2.NodeName = 'CellLink') do begin
797 NewCell := TCellLink.Create;
798 //NewCell.Map := Map;
799 NewCell.LoadFromNode(Node2);
800 Add(NewCell);
801 Node2 := Node2.NextSibling;
802 end;
803end;
804
805procedure TCellLinks.SaveToNode(Node: TDOMNode);
806var
807 I: Integer;
808 NewNode2: TDOMNode;
809begin
810 for I := 0 to Count - 1 do
811 with TCellLink(Items[I]) do begin
812 NewNode2 := Node.OwnerDocument.CreateElement('CellLink');
813 Node.AppendChild(NewNode2);
814 SaveToNode(NewNode2);
815 end;
816end;
817
818{ TMapArea }
819
820procedure TMapArea.GetBorderCells(List: TCells);
821var
822 Cell: TCell;
823begin
824 List.Clear;
825 Map.Cells.ClearMark;
826 for Cell in Cells do begin
827 if Cell.NeighboringToVoid and (Cell.Area = Self) and (not Cell.Mark) then begin
828 List.Add(Cell);
829 Cell.Mark := True;
830 end;
831 end;
832end;
833
834constructor TMapArea.Create;
835begin
836 Cells := TCells.Create;
837 Cells.FreeObjects := False;
838end;
839
840destructor TMapArea.Destroy;
841begin
842 FreeAndNil(Cells);
843 inherited Destroy;
844end;
845
846{ TPlayerCell }
847
848procedure TPlayerCell.LoadFromNode(Node: TDOMNode);
849begin
850 Explored := ReadBoolean(Node, 'Explored', False);
851 MapCell := List.Map.Player.Game.Map.Cells.FindById(ReadInteger(Node, 'MapCell', 0));
852end;
853
854procedure TPlayerCell.SaveToNode(Node: TDOMNode);
855begin
856 WriteBoolean(Node, 'Explored', Explored);
857 WriteInteger(Node, 'MapCell', MapCell.Id);
858end;
859
860{ TPlayerCells }
861
862function TPlayerCells.SearchCell(Cell: TCell): TPlayerCell;
863var
864 I: Integer;
865begin
866 I := 0;
867 while (I < Count) and (TPlayerCell(Items[I]).MapCell <> Cell) do Inc(I);
868 if I < Count then Result := TPlayerCell(Items[I])
869 else Result := nil;
870end;
871
872procedure TPlayerCells.LoadFromNode(Node: TDOMNode);
873var
874 Node2: TDOMNode;
875 NewCell: TPlayerCell;
876begin
877 Count := 0;
878 Node2 := Node.FirstChild;
879 while Assigned(Node2) and (Node2.NodeName = 'Cell') do begin
880 NewCell := TPlayerCell.Create;
881 NewCell.List := Self;
882 NewCell.LoadFromNode(Node2);
883 Add(NewCell);
884 Node2 := Node2.NextSibling;
885 end;
886end;
887
888procedure TPlayerCells.SaveToNode(Node: TDOMNode);
889var
890 I: Integer;
891 NewNode: TDOMNode;
892begin
893 for I := 0 to Count - 1 do begin;
894 NewNode := Node.OwnerDocument.CreateElement('Cell');
895 Node.AppendChild(NewNode);
896 TPlayerCell(Items[I]).SaveToNode(NewNode);
897 end;
898end;
899
900{ TPlayerMap }
901
902procedure TPlayerMap.LoadFromNode(Node: TDOMNode);
903var
904 NewNode: TDOMNode;
905begin
906 with Node do begin
907 NewNode := FindNode('Cells');
908 if Assigned(NewNode) then
909 Cells.LoadFromNode(NewNode);
910 end;
911end;
912
913procedure TPlayerMap.SaveToNode(Node: TDOMNode);
914var
915 NewNode: TDOMNode;
916begin
917 with Node do begin
918 NewNode := OwnerDocument.CreateElement('Cells');
919 AppendChild(NewNode);
920 Cells.SaveToNode(NewNode);
921 end;
922end;
923
924procedure TPlayerMap.Update;
925var
926 I: Integer;
927 OldCount: Integer;
928begin
929 // Update players cells count to map cells count to be 1:1
930 OldCount := Cells.Count;
931 Cells.Count := Player.Game.Map.Cells.Count;
932 for I := OldCount to Cells.Count - 1 do
933 Cells[I] := TPlayerCell.Create;
934
935 for I := 0 to Cells.Count - 1 do
936 with TPlayerCell(Cells[I]) do begin
937 List := Cells;
938 Explored := False;
939 InVisibleRange := False;
940 MapCell := TCell(Player.Game.Map.Cells[I]);
941 end;
942end;
943
944constructor TPlayerMap.Create;
945begin
946 Cells := TPlayerCells.Create;
947 Cells.Map := Self;
948end;
949
950destructor TPlayerMap.Destroy;
951begin
952 FreeAndNil(Cells);
953 inherited Destroy;
954end;
955
956procedure TPlayerMap.CheckVisibility;
957var
958 I: Integer;
959 C: Integer;
960 NeighCount: Integer;
961begin
962 for I := 0 to Cells.Count - 1 do
963 with TPlayerCell(Cells[I]) do begin
964 NeighCount := 0;
965 for C := 0 to MapCell.Neighbors.Count - 1 do
966 if TCell(MapCell.Neighbors[C]).Player = Player then
967 Inc(NeighCount);
968
969 InVisibleRange := (NeighCount > 0) or (TCell(MapCell).Player = Player);
970 if InVisibleRange and not Explored then Explored := True;
971 end;
972end;
973
974procedure TPlayerMap.Paint(Canvas: TCanvas; View: TView);
975var
976 I: Integer;
977 Cell: TPlayerCell;
978 PosFrom, PosTo: TPoint;
979 Angle: Double;
980 ArrowCenter: TPoint;
981 Move: TUnitMove;
982 CellText: string;
983 CellLink: TCellLink;
984begin
985 with Canvas, View do
986 try
987 Lock;
988 // Draw cell links
989 Pen.Color := clBlack;
990 Pen.Style := psSolid;
991 Pen.Width := 3;
992 for CellLink in Player.Game.Map.CellLinks do
993 with CellLink do begin
994 if Length(Points) >= 2 then begin
995 MoveTo(View.CellToCanvasPos(Points[0]));
996 for I := 1 to Length(Points) - 1 do
997 LineTo(View.CellToCanvasPos(Points[I]));
998 end;
999 end;
1000
1001 // Draw cells
1002 for Cell in Cells do begin
1003 if (Cell.MapCell.Terrain <> ttVoid) and Cell.MapCell.IsVisible(View) then begin
1004 if Cell.MapCell.Player = Player then
1005 CellText := IntToStr(Cell.MapCell.GetAvialPower)
1006 else CellText := IntToStr(Cell.MapCell.Power);
1007 if Assigned(SelectedCell) and (SelectedCell = Cell.MapCell) then
1008 Brush.Color := clGreen
1009 else if Assigned(SelectedCell) and Player.Game.Map.IsCellsNeighbor(SelectedCell, Cell.MapCell) then
1010 Brush.Color := clPurple
1011 else if Player.Game.FogOfWar then begin
1012 if Cell.InVisibleRange then begin
1013 Brush.Color := Cell.MapCell.GetColor;
1014 end else begin
1015 if Cell.Explored then begin
1016 Brush.Color := $404040;
1017 CellText := '';
1018 end else begin
1019 Brush.Color := clBlack;
1020 CellText := '';
1021 end;
1022 end;
1023 end else Brush.Color := Cell.MapCell.GetColor;
1024 Player.Game.Map.PaintCell(Canvas, Cell.MapCell.PosPx, CellText, View, Cell.MapCell);
1025 end else
1026 if Game.FogOfWar and (Cell.MapCell.Terrain = ttVoid) and (not Cell.Explored) then begin
1027 Brush.Color := clBlack;
1028 Player.Game.Map.PaintCell(Canvas, Cell.MapCell.PosPx, '', View, Cell.MapCell);
1029 end;
1030 end;
1031
1032 // Draw arrows
1033 Pen.Color := clCream;
1034 for Move in Player.Moves do begin
1035 PosFrom := Player.Game.Map.CellToPos(Move.CellFrom);
1036 PosTo := Player.Game.Map.CellToPos(Move.CellTo);
1037 // In Fog of war mode show only
1038 if Game.FogOfWar and not Cells.SearchCell(Move.CellFrom).InVisibleRange and
1039 not Cells.SearchCell(Move.CellTo).InVisibleRange then
1040 Continue;
1041 if Move.CountRepeat > 0 then Pen.Width := 2
1042 else Pen.Width := 1;
1043 Angle := ArcTan((PosTo.Y - PosFrom.Y) / (PosTo.X - PosFrom.X));
1044 if Sign(PosTo.X - PosFrom.X) = -1 then Angle := Angle + Pi;
1045 ArrowCenter := View.CellToCanvasPos(Point(Trunc(PosFrom.X + (PosTo.X - PosFrom.X) / 2),
1046 Trunc(PosFrom.Y + (PosTo.Y - PosFrom.Y) / 2)));
1047 Player.Game.Map.DrawArrow(Canvas, View, ArrowCenter,
1048 Angle, IntToStr(Move.CountOnce));
1049 end;
1050 finally
1051 Unlock;
1052 end;
1053end;
1054
1055{ TCanvasEx }
1056
1057class procedure TCanvasEx.TextOutEx(Canvas: TCanvas; X, Y: Integer; const Text: string;
1058 MovePen: Boolean);
1059var
1060 Flags : Cardinal;
1061begin
1062 with Canvas do begin
1063 Changing;
1064 RequiredState([csHandleValid, csFontValid, csBrushValid]);
1065 Flags := 0;
1066 if TextStyle.Opaque then
1067 Flags := ETO_Opaque;
1068 ExtUTF8Out(Handle, X, Y, Flags, nil, PChar(Text), Length(Text), nil);
1069 if MovePen then MoveTo(X + TextWidth(Text), Y);
1070 Changed;
1071 end;
1072end;
1073
1074class procedure TCanvasEx.PolygonEx(Canvas: TCanvas; const Points: array of TPoint; Winding: Boolean);
1075begin
1076 //Changing;
1077 //RequiredState([csHandleValid, csBrushValid, csPenValid]);
1078 LCLIntf.Polygon(Canvas.Handle, @Points[0], Length(Points), Winding);
1079 //Changed;
1080end;
1081
1082
1083{ TCells }
1084
1085procedure TCells.FixRefId;
1086var
1087 I: Integer;
1088begin
1089 for I := 0 to Count - 1 do
1090 TCell(Items[I]).FixRefId;
1091end;
1092
1093function TCells.FindById(Id: Integer): TCell;
1094var
1095 I: Integer;
1096begin
1097 I := 0;
1098 while (I < Count) and (TCell(Items[I]).Id <> Id) do Inc(I);
1099 if I < Count then Result := TCell(Items[I])
1100 else Result := nil;
1101end;
1102
1103procedure TCells.GetCellsWithWeight(List: TCells; Low, High: Integer);
1104var
1105 Cell: TCell;
1106begin
1107 List.Clear;
1108 for Cell in Self do
1109 if (Cell.Terrain <> ttVoid) and (Cell.Weight >= Low) and
1110 (Cell.Weight <= High) then List.Add(Cell);
1111end;
1112
1113procedure TCells.LoadFromNode(Node: TDOMNode);
1114var
1115 Node2: TDOMNode;
1116 NewCell: TCell;
1117begin
1118 Count := 0;
1119 Node2 := Node.FirstChild;
1120 while Assigned(Node2) and (Node2.NodeName = 'Cell') do begin
1121 NewCell := TCell.Create;
1122 NewCell.Map := Map;
1123 NewCell.LoadFromNode(Node2);
1124 Add(NewCell);
1125 Node2 := Node2.NextSibling;
1126 end;
1127end;
1128
1129procedure TCells.SaveToNode(Node: TDOMNode);
1130var
1131 I: Integer;
1132 NewNode2: TDOMNode;
1133begin
1134 for I := 0 to Count - 1 do
1135 with TCell(Items[I]) do begin
1136 NewNode2 := Node.OwnerDocument.CreateElement('Cell');
1137 Node.AppendChild(NewNode2);
1138 SaveToNode(NewNode2);
1139 end;
1140end;
1141
1142procedure TCells.ClearMark;
1143var
1144 Cell: TCell;
1145begin
1146 for Cell in Self do Cell.Mark := False;
1147end;
1148
1149procedure TCells.ClearWeight;
1150var
1151 Cell: TCell;
1152begin
1153 for Cell in Self do Cell.Weight := 0;
1154end;
1155
1156{ TPlayers }
1157
1158function TPlayers.GetAliveCount: Integer;
1159var
1160 Player: TPlayer;
1161begin
1162 Result := 0;
1163 for Player in Self do
1164 if Player.IsAlive then Inc(Result);
1165end;
1166
1167function TPlayers.FindById(Id: Integer): TPlayer;
1168var
1169 I: Integer;
1170begin
1171 I := 0;
1172 while (I < Count) and (TPlayer(Items[I]).Id <> Id) do Inc(I);
1173 if I < Count then Result := TPlayer(Items[I])
1174 else Result := nil;
1175end;
1176
1177procedure TPlayers.New(Name: string; Color: TColor; Mode: TPlayerMode);
1178var
1179 NewPlayer: TPlayer;
1180begin
1181 NewPlayer := TPlayer.Create;
1182 NewPlayer.Game := Game;
1183 NewPlayer.Name := Name;
1184 NewPlayer.Color := Color;
1185 NewPlayer.Mode := Mode;
1186 NewPlayer.Id := GetNewPlayerId;
1187 if Mode = pmComputer then
1188 NewPlayer.Agressivity := caMedium;
1189 Add(NewPlayer);
1190end;
1191
1192function TPlayers.GetNewPlayerId: Integer;
1193begin
1194 Result := NewPlayerId;
1195 Inc(NewPlayerId);
1196end;
1197
1198procedure TPlayers.LoadFromNode(Node: TDOMNode);
1199var
1200 Node2: TDOMNode;
1201 NewPlayer: TPlayer;
1202begin
1203 Count := 0;
1204 Node2 := Node.FirstChild;
1205 while Assigned(Node2) and (Node2.NodeName = 'Player') do begin
1206 NewPlayer := TPlayer.Create;
1207 NewPlayer.Game := Game;
1208 NewPlayer.LoadFromNode(Node2);
1209 Add(NewPlayer);
1210 Node2 := Node2.NextSibling;
1211 end;
1212end;
1213
1214procedure TPlayers.SaveToNode(Node: TDOMNode);
1215var
1216 I: Integer;
1217 NewNode: TDOMNode;
1218begin
1219 for I := 0 to Count - 1 do begin;
1220 NewNode := Node.OwnerDocument.CreateElement('Player');
1221 Node.AppendChild(NewNode);
1222 TPlayer(Items[I]).SaveToNode(NewNode);
1223 end;
1224end;
1225
1226constructor TPlayers.Create;
1227begin
1228 inherited Create;
1229 NewPlayerId := 1;
1230end;
1231
1232function TPlayers.GetFirstHuman: TPlayer;
1233var
1234 I: Integer;
1235begin
1236 I := 0;
1237 while (I < Count) and (TPlayer(Items[I]).Mode <> pmHuman) do Inc(I);
1238 if I < Count then Result := TPlayer(Items[I])
1239 else Result := nil;
1240end;
1241
1242procedure TPlayers.Assign(Source: TPlayers);
1243var
1244 I: Integer;
1245begin
1246 while Count > Source.Count do
1247 Delete(Count - 1);
1248 while Count < Source.Count do
1249 Add(TPlayer.Create);
1250 for I := 0 to Count - 1 do begin
1251 TPlayer(Items[I]).Assign(TPlayer(Source[I]));
1252 TPlayer(Items[I]).Game := Game;
1253 end;
1254 NewPlayerId := Source.NewPlayerId;
1255end;
1256
1257procedure TPlayers.LoadConfig(Config: TXmlConfig; Path: string);
1258var
1259 I: Integer;
1260 NewCount: Integer;
1261begin
1262 with Config do begin
1263 NewCount := GetValue(DOMString(Path + '/Count'), -1);
1264 NewPlayerId := 1;
1265 if NewCount >= 2 then begin
1266 Self.Clear;
1267 Count := NewCount;
1268 for I := 0 to Count - 1 do begin
1269 Items[I] := TPlayer.Create;
1270 TPlayer(Items[I]).Id := GetNewPlayerId;
1271 TPlayer(Items[I]).Game := Game;
1272 TPlayer(Items[I]).LoadConfig(Config, Path + '/Player' + IntToStr(I));
1273 end;
1274 end;
1275 end;
1276end;
1277
1278procedure TPlayers.SaveConfig(Config: TXmlConfig; Path: string);
1279var
1280 I: Integer;
1281begin
1282 for I := 0 to Count - 1 do
1283 TPlayer(Items[I]).SaveConfig(Config, Path + '/Player' + IntToStr(I));
1284 with Config do begin
1285 SetValue(DOMString(Path + '/Count'), Count);
1286 end;
1287end;
1288
1289{ TUnitMoves }
1290
1291function TUnitMoves.SearchByFromTo(CellFrom, CellTo: TCell): TUnitMove;
1292var
1293 UnitMove: TUnitMove;
1294begin
1295 Result := nil;
1296 for UnitMove in Self do
1297 if (UnitMove.CellFrom = CellFrom) and (UnitMove.CellTo = CellTo) then begin
1298 Result := UnitMove;
1299 Break;
1300 end;
1301end;
1302
1303procedure TUnitMoves.LoadFromNode(Node: TDOMNode);
1304var
1305 Node2: TDOMNode;
1306 NewUnitMove: TUnitMove;
1307begin
1308 Count := 0;
1309 Node2 := Node.FirstChild;
1310 while Assigned(Node2) and (Node2.NodeName = 'UnitMove') do begin
1311 NewUnitMove := TUnitMove.Create;
1312 NewUnitMove.List := Self;
1313 NewUnitMove.LoadFromNode(Node2);
1314 Add(NewUnitMove);
1315 Node2 := Node2.NextSibling;
1316 end;
1317end;
1318
1319procedure TUnitMoves.SaveToNode(Node: TDOMNode);
1320var
1321 I: Integer;
1322 NewNode: TDOMNode;
1323begin
1324 for I := 0 to Count - 1 do begin;
1325 NewNode := Node.OwnerDocument.CreateElement('UnitMove');
1326 Node.AppendChild(NewNode);
1327 TUnitMove(Items[I]).SaveToNode(NewNode);
1328 end;
1329end;
1330
1331{ TMap }
1332
1333function TMap.GetSize: TPoint;
1334begin
1335 Result:= FSize;
1336end;
1337
1338procedure TMap.SetSize(AValue: TPoint);
1339begin
1340 if (FSize.X <> AValue.X) or (FSize.Y <> AValue.Y) then begin
1341 FSize := AValue;
1342 Generate;
1343 end;
1344end;
1345
1346function TMap.GetNewCellId: Integer;
1347begin
1348 Result := FNewCellId;
1349 Inc(FNewCellId);
1350end;
1351
1352function TMap.IsOutsideShape(Coord: TPoint): Boolean;
1353var
1354 Rect: TRect;
1355 Color: TColor;
1356 Pos: TPoint;
1357 Center: TPoint;
1358begin
1359 case Shape of
1360 msRectangle: Result := False;
1361 msImage: begin
1362 Rect := PixelRect;
1363 with Image.Picture.Bitmap do begin
1364 Pos := Point(Trunc(Coord.X / (Rect.Right - Rect.Left) * Width),
1365 Trunc(Coord.Y / (Rect.Bottom - Rect.Top) * Height));
1366 Color := Canvas.Pixels[Pos.X, Pos.Y];
1367 end;
1368 Result := Color <> clWhite;
1369 end;
1370 msRounded: begin
1371 Rect := PixelRect;
1372 Center := Point(Rect.Left + (Rect.Right - Rect.Left) div 2,
1373 Rect.Top + (Rect.Bottom - Rect.Top) div 2);
1374 Result := Sqr(Coord.X - Center.X) / Sqr((Rect.Right - Rect.Left) div 2) +
1375 Sqr(Coord.Y - Center.Y) / Sqr((Rect.Bottom - Rect.Top) div 2) > 1;
1376 end
1377 else Result := False;
1378 end;
1379end;
1380
1381procedure TMap.DrawArrow(Canvas: TCanvas; View: TView; Pos: TPoint;
1382 Angle: Double; Text: string);
1383var
1384 Points: array of TPoint;
1385 FPoints: array of TFloatPoint;
1386 I: Integer;
1387 ArrowSize: TPoint;
1388begin
1389 Canvas.Brush.Color := clWhite;
1390 Canvas.Pen.Color := clBlack;
1391 SetLength(Points, 8);
1392 SetLength(FPoints, 8);
1393 ArrowSize := Point(Trunc(DefaultCellSize.X / 3 * View.Zoom),
1394 Trunc(DefaultCellSize.Y / 3 * View.Zoom));
1395 FPoints[0] := FloatPoint(+0.5 * ArrowSize.X, +0 * ArrowSize.Y);
1396 FPoints[1] := FloatPoint(+0 * ArrowSize.X, +0.5 * ArrowSize.Y);
1397 FPoints[2] := FloatPoint(+0 * ArrowSize.X, +0.25 * ArrowSize.Y);
1398 FPoints[3] := FloatPoint(-0.5 * ArrowSize.X, +0.25 * ArrowSize.Y);
1399 FPoints[4] := FloatPoint(-0.5 * ArrowSize.X, -0.25 * ArrowSize.Y);
1400 FPoints[5] := FloatPoint(+0 * ArrowSize.X, -0.25 * ArrowSize.Y);
1401 FPoints[6] := FloatPoint(+0 * ArrowSize.X, -0.5 * ArrowSize.Y);
1402 FPoints[7] := FloatPoint(+0.5 * ArrowSize.X, 0 * ArrowSize.Y);
1403 // Rotate
1404 for I := 0 to Length(Points) - 1 do
1405 FPoints[I] := FloatPoint(FPoints[I].X * Cos(Angle) - FPoints[I].Y * Sin(Angle),
1406 FPoints[I].X * Sin(Angle) + FPoints[I].Y * Cos(Angle));
1407 // Shift
1408 for I := 0 to Length(Points) - 1 do
1409 Points[I] := Point(Trunc(FPoints[I].X + Pos.X), Trunc(FPoints[I].Y + Pos.Y));
1410 with Canvas do begin
1411 Brush.Style := bsSolid;
1412 Polygon(Points);
1413 Brush.Style := bsClear;
1414 Font.Color := clBlack;
1415 Font.Size := Trunc(26 * View.Zoom);
1416 TextOut(Pos.X - TextWidth(Text) div 2,
1417 Pos.Y - TextHeight(Text) div 2, Text);
1418 Pen.Width := 1;
1419 end;
1420end;
1421
1422function TMap.IsCellsNeighbor(Cell1, Cell2: TCell): Boolean;
1423begin
1424 Result := Cell1.Neighbors.IndexOf(Cell2) <> -1;
1425end;
1426
1427function TMap.IsValidIndex(Index: TPoint): Boolean;
1428begin
1429 Result := False;
1430end;
1431
1432procedure TMap.Assign(Source: TMap);
1433//var
1434// I: Integer;
1435begin
1436 MaxPower := Source.MaxPower;
1437 Game := Source.Game;
1438 Size := Source.Size;
1439 DefaultCellSize := Source.DefaultCellSize;
1440 Shape := Source.Shape;
1441 Image.Picture.Bitmap.Assign(Source.Image.Picture.Bitmap);
1442
1443 // TODO: How to copy cells
1444 {// Copy all cells
1445 Cells.Count := 0;
1446 Cells.Count := Source.Cells.Count;
1447 for I := 0 to Cells.Count - 1 do begin
1448 Cells[I] := TCell.Create;
1449 TCell(Cells[I]).Map := Self;
1450 TCell(Cells[I]).Assign(TCell(Source.Cells[I]));
1451 end;
1452 }
1453end;
1454
1455procedure TMap.LoadFromFile(FileName: string);
1456begin
1457
1458end;
1459
1460procedure TMap.SaveToFile(FileName: string);
1461begin
1462
1463end;
1464
1465procedure TMap.LoadFromNode(Node: TDOMNode);
1466var
1467 Node2: TDOMNode;
1468begin
1469 Size := Point(ReadInteger(Node, 'SizeX', 0), ReadInteger(Node, 'SizeY', 0));
1470 DefaultCellSize.X := ReadInteger(Node, 'DefaultCellSizeX', 1);
1471 DefaultCellSize.Y := ReadInteger(Node, 'DefaultCellSizeY', 1);
1472 MaxPower := ReadInteger(Node, 'MaxPower', 99);
1473 Shape := TMapShape(ReadInteger(Node, 'Shape', Integer(msRectangle)));
1474 Node2 := Node.FindNode('Cells');
1475 if Assigned(Node2) then
1476 Cells.LoadFromNode(Node2);
1477 Node2 := Node.FindNode('CellLinks');
1478 if Assigned(Node2) then
1479 CellLinks.LoadFromNode(Node2);
1480end;
1481
1482procedure TMap.SaveToNode(Node: TDOMNode);
1483var
1484 NewNode: TDOMNode;
1485begin
1486 WriteInteger(Node, 'DefaultCellSizeX', DefaultCellSize.X);
1487 WriteInteger(Node, 'DefaultCellSizeY', DefaultCellSize.Y);
1488 WriteInteger(Node, 'MaxPower', MaxPower);
1489 WriteInteger(Node, 'Shape', Integer(Shape));
1490 WriteInteger(Node, 'SizeX', Size.X);
1491 WriteInteger(Node, 'SizeY', Size.Y);
1492 NewNode := Node.OwnerDocument.CreateElement('Cells');
1493 Node.AppendChild(NewNode);
1494 Cells.SaveToNode(NewNode);
1495 NewNode := Node.OwnerDocument.CreateElement('CellLinks');
1496 Node.AppendChild(NewNode);
1497 CellLinks.SaveToNode(NewNode);
1498end;
1499
1500function TMap.PosToCell(Pos: TPoint; View: TView): TCell;
1501var
1502 I: Integer;
1503begin
1504 Result := nil;
1505 for I := 0 to Cells.Count - 1 do
1506 if TCell(Cells[I]).Terrain <> ttVoid then begin
1507 if PtInPoly(TCell(Cells[I]).Polygon, Pos) then begin
1508 Result := TCell(Cells[I]);
1509 Exit;
1510 end;
1511 end;
1512end;
1513
1514function TMap.CellToPos(Cell: TCell): TPoint;
1515begin
1516 Result := Cell.PosPx;
1517end;
1518
1519procedure TMap.Grow(APlayer: TPlayer);
1520var
1521 I: Integer;
1522 Addition: Integer;
1523 Dies: Integer;
1524begin
1525 for I := 0 to Cells.Count - 1 do
1526 with TCell(Cells[I]) do begin
1527 if (Player = APlayer) and ((Game.GrowCells = gcPlayerAll) or
1528 ((Game.GrowCells = gcPlayerCities) and (Terrain = ttCity))) then begin
1529 if Power < MaxPower then begin
1530 // Increase units count
1531 if Game.GrowAmount = gaByOne then Addition := 1
1532 else if Game.GrowAmount = gaBySquareRoot then begin
1533 Addition := Trunc(Sqrt(Power));
1534 if Addition = 0 then Addition := 1;
1535 end;
1536 Power := Min(Power + Addition, MaxPower);
1537 end else
1538 if Power > MaxPower then begin
1539 // Reduce units count
1540 // If cell has more then MaxPower units then additional units dies
1541 // in twice of squeare root of unites over MaxPower
1542 Dies := 2 * Trunc(Sqrt(Power - MaxPower));
1543 Power := Max(Power - Dies, 0);
1544 end;
1545 end;
1546 end;
1547end;
1548
1549procedure TMap.PaintCell(Canvas: TCanvas; Pos: TPoint; Text: string; View: TView;
1550 Cell: TCell);
1551var
1552 I: Integer;
1553 TextPos: TPoint;
1554 Points: array of TPoint;
1555 TextSize: TSize;
1556begin
1557 with Canvas do begin
1558 if Assigned(View.FocusedCell) and (View.FocusedCell = Cell) then begin
1559 Pen.Color := clYellow;
1560 Pen.Style := psSolid;
1561 Pen.Width := 1;
1562 end else
1563 if Cell.Terrain = ttCity then begin
1564 // Cannot set clear border as it will display shifted on gtk2
1565 //Pen.Style := psClear;
1566 Pen.Color := clBlack;
1567 Pen.Style := psSolid;
1568 Pen.Width := 3;
1569 end else begin
1570 // Cannot set clear border as it will display shifted on gtk2
1571 //Pen.Style := psClear;
1572 Pen.Color := Brush.Color;
1573 Pen.Style := psSolid;
1574 Pen.Width := 0;
1575 end;
1576 // Transform view
1577 SetLength(Points, Length(Cell.Polygon));
1578 for I := 0 to Length(Points) - 1 do
1579 Points[I] := View.CellToCanvasPos(Cell.Polygon[I]);
1580 Brush.Style := bsSolid;
1581 //Polygon(Points, False, 0, Length(Points));
1582 TCanvasEx.PolygonEx(Canvas, Points, False);
1583 //MoveTo(Points[0].X, Points[0].Y);
1584 //LineTo(Points[1].X, Points[1].Y);
1585
1586 // Show cell text
1587 if Text <> '0' then begin
1588 Pen.Style := psSolid;
1589 Font.Color := clWhite;
1590 Brush.Style := bsClear;
1591 Font.Size := Trunc(42 * View.Zoom);
1592 TextPos := View.CellToCanvasPos(Pos);
1593 TextSize := TextExtent(Text);
1594 TCanvasEx.TextOutEx(Canvas, Round(TextPos.X) - TextSize.cx div 2,
1595 Round(TextPos.Y) - TextSize.cy div 2, Text, False);
1596 end;
1597 end;
1598end;
1599
1600procedure TMap.ComputePlayerStats;
1601var
1602 Cell: TCell;
1603begin
1604 for Cell in Cells do
1605 with Cell do begin
1606 if Assigned(Player) then begin
1607 Player.TotalCells := Player.TotalCells + 1;
1608 Player.TotalUnits := Player.TotalUnits + Power;
1609 if Terrain = ttCity then
1610 Player.TotalCities := Player.TotalCities + 1;
1611 end;
1612 end;
1613end;
1614
1615procedure TMap.Generate;
1616var
1617 X, Y: Integer;
1618 NewCell: TCell;
1619begin
1620 Clear;
1621
1622 // Allocate and init new
1623 Cells.Count := FSize.Y * FSize.X;
1624 FNewCellId := 1;
1625 for Y := 0 to FSize.Y - 1 do
1626 for X := 0 to FSize.X - 1 do begin
1627 NewCell := TCell.Create;
1628 NewCell.Map := Self;
1629 NewCell.PosPx := Point(X * DefaultCellSize.X, Y * DefaultCellSize.Y);
1630 NewCell.Id := GetNewCellId;
1631 SetLength(NewCell.Polygon, 1);
1632 NewCell.Polygon[0] := NewCell.PosPx;
1633 Cells[Y * FSize.X + X] := NewCell;
1634 end;
1635 FPixelRect := CalculatePixelRect;
1636end;
1637
1638procedure TMap.MakeSymetric;
1639var
1640 C: Integer;
1641 I: Integer;
1642 CellLink: TCellLink;
1643 OtherCell1: TCell;
1644 OtherCell2: TCell;
1645 OppositeCell: TCell;
1646begin
1647 // Generic way to create two sides symetric map independent to shape
1648 for C := 0 to (Cells.Count div 2) - 1 do begin
1649 TCell(Cells[C]).Terrain := TCell(Cells[Cells.Count - 1 - C]).Terrain;
1650 TCell(Cells[C]).Power := TCell(Cells[Cells.Count - 1 - C]).Power;
1651
1652 for I := TCell(Cells[C]).Links.Count - 1 downto 0 do begin
1653 CellLink := TCell(Cells[C]).Links[I];
1654
1655 // Remove cells on first half of the map
1656 if (Cells.IndexOf(CellLink.Cells[0]) <= (Cells.Count div 2)) and
1657 (Cells.IndexOf(CellLink.Cells[1]) <= (Cells.Count div 2)) then
1658 begin
1659 CellLinks.Remove(CellLink);
1660 Continue;
1661 end;
1662
1663 // Make cross half links symetric
1664 if (Cells.IndexOf(CellLink.Cells[0]) <= (Cells.Count div 2)) and
1665 (Cells.IndexOf(CellLink.Cells[1]) >= (Cells.Count div 2)) then begin
1666 OtherCell1 := Cells[Cells.Count - 1 - Cells.IndexOf(CellLink.Cells[1])];
1667 OtherCell2 := CellLink.Cells[1];
1668 CellLinks.Remove(CellLink);
1669 if not Assigned(CellLinks.FindByCells(OtherCell1, OtherCell2)) then
1670 CellLinks.AddLink(OtherCell1, OtherCell2);
1671 end else
1672 if (Cells.IndexOf(CellLink.Cells[0]) >= (Cells.Count div 2)) and
1673 (Cells.IndexOf(CellLink.Cells[1]) <= (Cells.Count div 2)) then begin
1674 OtherCell1 := Cells[Cells.Count - 1 - Cells.IndexOf(CellLink.Cells[0])];
1675 OtherCell2 := CellLink.Cells[0];
1676 CellLinks.Remove(CellLink);
1677 if not Assigned(CellLinks.FindByCells(OtherCell1, OtherCell2)) then
1678 CellLinks.AddLink(OtherCell1, OtherCell2);
1679 end;
1680 end;
1681 end;
1682
1683 for C := 0 to (Cells.Count div 2) - 1 do begin
1684 // Make copy of links from second half
1685 OppositeCell := TCell(Cells[Cells.Count - 1 - C]);
1686 for CellLink in OppositeCell.Links do
1687 if (Cells.IndexOf(CellLink.Cells[0]) > (Cells.Count div 2)) and
1688 (Cells.IndexOf(CellLink.Cells[1]) > (Cells.Count div 2)) then begin
1689 OtherCell1 := Cells[Cells.Count - 1 - Cells.IndexOf(CellLink.Cells[0])];
1690 OtherCell2 := Cells[Cells.Count - 1 - Cells.IndexOf(CellLink.Cells[1])];
1691 if not Assigned(CellLinks.FindByCells(OtherCell1, OtherCell2)) then
1692 CellLinks.AddLink(OtherCell1, OtherCell2);
1693 end;
1694 end;
1695end;
1696
1697procedure TMap.CreateLinks;
1698var
1699 LastAreaCount: Integer;
1700begin
1701 BuildMapAreas;
1702 LastAreaCount := -1;
1703 while (Areas.Count > 1) and (Areas.Count <> LastAreaCount) do begin
1704 LastAreaCount := Areas.Count;
1705 BuildBridges;
1706 BuildMapAreas;
1707 end;
1708end;
1709
1710procedure TMap.Clear;
1711begin
1712 CellLinks.Clear;
1713 Cells.Clear;
1714 FNewCellId := 1;
1715end;
1716
1717constructor TMap.Create;
1718begin
1719 MaxPower := 99;
1720 DefaultCellSize := Point(220, 220);
1721 Cells := TCells.Create;
1722 Cells.Map := Self;
1723 Size := Point(0, 0);
1724 Image := TImage.Create(nil);
1725 CellLinks := TCellLinks.Create;
1726 CellLinks.Map := Self;
1727 Areas := TMapAreas.Create;
1728end;
1729
1730destructor TMap.Destroy;
1731begin
1732 Size := Point(0, 0);
1733 FreeAndNil(Areas);
1734 FreeAndNil(CellLinks);
1735 FreeAndNil(Image);
1736 FreeAndNil(Cells);
1737 inherited Destroy;
1738end;
1739
1740function TMap.CalculatePixelRect: TRect;
1741var
1742 I: Integer;
1743 CellRect: TRect;
1744begin
1745 Result := Rect(0, 0, 0, 0);
1746 // This is generic algorithm to determine pixel size of entire map
1747 for I := 0 to Cells.Count - 1 do begin
1748 CellRect := GetPolygonRect(TCell(Cells[I]).Polygon);
1749 if I = 0 then Result := CellRect
1750 else begin
1751 if CellRect.Right > Result.Right then Result.Right := CellRect.Right;
1752 if CellRect.Bottom > Result.Bottom then Result.Bottom := CellRect.Bottom;
1753 if CellRect.Left < Result.Left then Result.Left := CellRect.Left;
1754 if CellRect.Top < Result.Top then Result.Top := CellRect.Top;
1755 end;
1756 end;
1757end;
1758
1759procedure TMap.ForEachCells(Method: TMethod);
1760begin
1761
1762end;
1763
1764{ TUnitMove }
1765
1766procedure TUnitMove.SetCellFrom(AValue: TCell);
1767begin
1768 if FCellFrom = AValue then Exit;
1769 if Assigned(AValue) and not Assigned(FCellFrom) then begin
1770 AValue.MovesFrom.Add(Self);
1771 end else
1772 if not Assigned(AValue) and Assigned(FCellFrom) then begin
1773 FCellFrom.MovesFrom.Remove(Self);
1774 end;
1775 FCellFrom := AValue;
1776end;
1777
1778procedure TUnitMove.SetCellTo(AValue: TCell);
1779begin
1780 if FCellTo = AValue then Exit;
1781 if Assigned(AValue) and not Assigned(FCellTo) then begin
1782 AValue.MovesTo.Add(Self);
1783 end else
1784 if not Assigned(AValue) and Assigned(FCellTo) then begin
1785 FCellTo.MovesTo.Remove(Self);
1786 end;
1787 FCellTo := AValue;
1788end;
1789
1790procedure TUnitMove.LoadFromNode(Node: TDOMNode);
1791begin
1792 CountOnce := ReadInteger(Node, 'CountOnce', 0);
1793 CountRepeat := ReadInteger(Node, 'CountRepeat', 0);
1794 CellFrom := List.Game.Map.Cells.FindById(ReadInteger(Node, 'CellFrom', 0));
1795 CellTo := List.Game.Map.Cells.FindById(ReadInteger(Node, 'CellTo', 0));
1796end;
1797
1798procedure TUnitMove.SaveToNode(Node: TDOMNode);
1799begin
1800 WriteInteger(Node, 'CountOnce', CountOnce);
1801 WriteInteger(Node, 'CountRepeat', CountRepeat);
1802 WriteInteger(Node, 'CellFrom', CellFrom.Id);
1803 WriteInteger(Node, 'CellTo', CellTo.Id);
1804end;
1805
1806constructor TUnitMove.Create;
1807begin
1808 List := nil; // Is later set to parent list owning item
1809 FCellFrom := nil;
1810 FCellTo := nil;
1811end;
1812
1813destructor TUnitMove.Destroy;
1814begin
1815 CellFrom := nil;
1816 CellTo := nil;
1817 List := nil;
1818 inherited Destroy;
1819end;
1820
1821{ TView }
1822
1823procedure TView.SetZoom(AValue: Double);
1824begin
1825 if FZoom = AValue then Exit;
1826 if AValue = 0 then
1827 raise Exception.Create(SZeroZoomNotAlowed);
1828 FZoom := AValue;
1829 SourceRect := Bounds(Trunc(SourceRect.Left + (SourceRect.Right - SourceRect.Left) div 2 - (DestRect.Right - DestRect.Left) / Zoom / 2),
1830 Trunc(SourceRect.Top + (SourceRect.Bottom - SourceRect.Top) div 2 - (DestRect.Bottom - DestRect.Top) / Zoom / 2),
1831 Trunc((DestRect.Right - DestRect.Left) / Zoom),
1832 Trunc((DestRect.Bottom - DestRect.Top) / Zoom));
1833end;
1834
1835procedure TView.Clear;
1836begin
1837 FocusedCell := nil;
1838 SelectedCell := nil;
1839end;
1840
1841procedure TView.SetDestRect(AValue: TRect);
1842var
1843 Diff: TPoint;
1844begin
1845 if RectEquals(FDestRect, AValue) then Exit;
1846 Diff := Point(Trunc((DestRect.Right - DestRect.Left) / Zoom - (AValue.Right - AValue.Left) / Zoom) div 2,
1847 Trunc((DestRect.Bottom - DestRect.Top) / Zoom - (AValue.Bottom - AValue.Top) / Zoom) div 2);
1848 FDestRect := AValue;
1849 SourceRect := Bounds(SourceRect.Left + Diff.X, SourceRect.Top + Diff.Y,
1850 Trunc((DestRect.Right - DestRect.Left) / Zoom),
1851 Trunc((DestRect.Bottom - DestRect.Top) / Zoom));
1852end;
1853
1854constructor TView.Create;
1855begin
1856 Zoom := 1.5;
1857 Clear;
1858end;
1859
1860destructor TView.Destroy;
1861begin
1862 inherited Destroy;
1863end;
1864
1865{ TCell }
1866
1867procedure TCell.SetPower(AValue: Integer);
1868begin
1869 if FPower = AValue then Exit;
1870 if AValue < 0 then
1871 raise Exception.Create(SNegativeCellPowerNotAllowed);
1872 FPower := AValue;
1873 //Check;
1874end;
1875
1876procedure TCell.Check;
1877var
1878 AvailPower: Integer;
1879begin
1880 AvailPower := GetAvialPower;
1881 if AvailPower < 0 then
1882 raise Exception.Create(Format(SUnitPowerMismatch, [Power, -(AvailPower - Power)]));
1883end;
1884
1885function TCell.NeighboringToVoid: Boolean;
1886var
1887 NeighVoidCount: Integer;
1888 NeighborCell: TCell;
1889begin
1890 NeighVoidCount := 0;
1891 for NeighborCell in Neighbors do
1892 if (NeighborCell.Terrain = ttVoid) then Inc(NeighVoidCount);
1893 Result := NeighVoidCount > 0;
1894end;
1895
1896procedure TCell.SetArea(AValue: TMapArea);
1897begin
1898 if FArea = AValue then Exit;
1899 if Assigned(FArea) then FArea.Cells.Remove(Self);
1900 FArea := AValue;
1901 if Assigned(FArea) then FArea.Cells.Add(Self);
1902end;
1903
1904procedure TCell.AreaExtend;
1905var
1906 NeighborCell: TCell;
1907begin
1908 for NeighborCell in Neighbors do
1909 if (NeighborCell.Terrain <> ttVoid) and (not Assigned(NeighborCell.Area)) then begin
1910 NeighborCell.Area := Area;
1911 NeighborCell.AreaExtend;
1912 end;
1913end;
1914
1915procedure TCell.FixRefId;
1916var
1917 I: Integer;
1918begin
1919 Player := Map.Game.Players.FindById(PlayerId);
1920
1921 Neighbors.Count := Length(NeighborsId);
1922 for I := 0 to Length(NeighborsId) - 1 do begin
1923 Neighbors[I] := Map.Cells.FindById(NeighborsId[I]);
1924 end;
1925end;
1926
1927procedure TCell.LoadFromNode(Node: TDOMNode);
1928var
1929 Node2: TDOMNode;
1930 Node3: TDOMNode;
1931begin
1932 Id := ReadInteger(Node, 'Id', 0);
1933 Power := ReadInteger(Node, 'Power', 0);
1934 Terrain := TTerrainType(ReadInteger(Node, 'Terrain', Integer(ttVoid)));
1935 PosPx.X := ReadInteger(Node, 'PosX', 0);
1936 PosPx.Y := ReadInteger(Node, 'PosY', 0);
1937 PlayerId := ReadInteger(Node, 'Player', 0);
1938
1939 Node3 := Node.FindNode('Neighbours');
1940 if Assigned(Node3) then begin
1941 SetLength(NeighborsId, 0);
1942 Node2 := Node3.FirstChild;
1943 while Assigned(Node2) and (Node2.NodeName = 'Neighbour') do begin
1944 SetLength(NeighborsId, Length(NeighborsId) + 1);
1945 NeighborsId[High(NeighborsId)] := ReadInteger(Node2, 'Id', 0);
1946 Node2 := Node2.NextSibling;
1947 end;
1948 end;
1949
1950 Node3 := Node.FindNode('Polygon');
1951 if Assigned(Node3) then begin
1952 SetLength(Polygon, 0);
1953 Node2 := Node3.FirstChild;
1954 while Assigned(Node2) and (Node2.NodeName = 'Point') do begin
1955 SetLength(Polygon, Length(Polygon) + 1);
1956 Polygon[High(Polygon)].X := ReadInteger(Node2, 'X', 0);
1957 Polygon[High(Polygon)].Y := ReadInteger(Node2, 'Y', 0);
1958 Node2 := Node2.NextSibling;
1959 end;
1960 end;
1961end;
1962
1963procedure TCell.SaveToNode(Node: TDOMNode);
1964var
1965 NewNode: TDOMNode;
1966 NewNode2: TDOMNode;
1967 I: Integer;
1968begin
1969 WriteInteger(Node, 'Id', Id);
1970 WriteInteger(Node, 'Power', Power);
1971 WriteInteger(Node, 'Terrain', Integer(Terrain));
1972 WriteInteger(Node, 'PosX', PosPx.X);
1973 WriteInteger(Node, 'PosY', PosPx.Y);
1974 if Assigned(Player) then
1975 WriteInteger(Node, 'Player', Player.Id)
1976 else WriteInteger(Node, 'Player', 0);
1977 NewNode := Node.OwnerDocument.CreateElement('Neighbours');
1978 Node.AppendChild(NewNode);
1979 for I := 0 to Neighbors.Count - 1 do begin
1980 NewNode2 := NewNode.OwnerDocument.CreateElement('Neighbour');
1981 NewNode.AppendChild(NewNode2);
1982 WriteInteger(NewNode2, 'Id', TCell(Neighbors[I]).Id);
1983 end;
1984 NewNode := Node.OwnerDocument.CreateElement('Polygon');
1985 Node.AppendChild(NewNode);
1986 for I := 0 to Length(Polygon) - 1 do begin
1987 NewNode2 := NewNode.OwnerDocument.CreateElement('Point');
1988 NewNode.AppendChild(NewNode2);
1989 WriteInteger(NewNode2, 'X', Polygon[I].X);
1990 WriteInteger(NewNode2, 'Y', Polygon[I].Y);
1991 end;
1992end;
1993
1994procedure TCell.Assign(Source: TCell);
1995begin
1996 Id := Source.Id;
1997 PosPx := Source.PosPx;
1998 Terrain := Source.Terrain;
1999 Polygon := Source.Polygon;
2000 Player := Source.Player;
2001 Mark := Source.Mark;
2002 // TODO: How to copy neighbours and moves list
2003end;
2004
2005function TCell.IsVisible(View: TView): Boolean;
2006var
2007 RectA, RectB: TRect;
2008begin
2009 RectA := GetPolygonRect(Polygon);
2010 RectB := View.SourceRect;
2011 Result := ((RectA.Left < RectB.Right) and (RectA.Right > RectB.Left) and
2012 (RectA.Top < RectB.Bottom) and (RectA.Bottom > RectB.Top));
2013end;
2014
2015function TCell.GetColor: TColor;
2016begin
2017 if Assigned(Player) then Result := Player.Color
2018 else Result := clGray;
2019end;
2020
2021function TCell.GetAvialPower: Integer;
2022var
2023 UnitMove: TUnitMove;
2024begin
2025 Result := Power;
2026 for UnitMove in MovesFrom do
2027 Result := Result - UnitMove.CountOnce;
2028end;
2029
2030function TCell.GetAttackPower: Integer;
2031var
2032 I: Integer;
2033begin
2034 Result := 0;
2035 for I := 0 to MovesTo.Count - 1 do
2036 Result := Result + TUnitMove(MovesTo[I]).CountOnce;
2037end;
2038
2039function TCell.ToString: ansistring;
2040begin
2041 Result := IntToStr(Id);
2042end;
2043
2044constructor TCell.Create;
2045begin
2046 Player := nil;
2047 Neighbors := TCells.Create;
2048 Neighbors.FreeObjects := False;
2049 MovesFrom := TUnitMoves.Create;
2050 MovesFrom.FreeObjects := False;
2051 MovesTo := TUnitMoves.Create;
2052 MovesTo.FreeObjects := False;
2053 Links := TCellLinks.Create;
2054 Links.FreeObjects := False;
2055end;
2056
2057destructor TCell.Destroy;
2058var
2059 I: Integer;
2060begin
2061 for I := MovesFrom.Count - 1 downto 0 do
2062 TUnitMove(MovesFrom[I]).List.Remove(TUnitMove(MovesFrom[I]));
2063 FreeAndNil(MovesFrom);
2064 for I := MovesTo.Count - 1 downto 0 do
2065 TUnitMove(MovesTo[I]).List.Remove(TUnitMove(MovesTo[I]));
2066 FreeAndNil(MovesTo);
2067 for I := Links.Count - 1 downto 0 do
2068 FMap.CellLinks.Remove(Links[I]);
2069 FreeAndNil(Links);
2070 for I := Neighbors.Count - 1 downto 0 do
2071 if TCell(Neighbors[I]).Neighbors.Remove(Self) = -1 then
2072 raise Exception.Create(SCellRemoveNeighborError);
2073 FreeAndNil(Neighbors);
2074 inherited Destroy;
2075end;
2076
2077{ TPlayer }
2078
2079function TView.CanvasToCellPos(Pos: TPoint): TPoint;
2080begin
2081 Result := Point(Trunc(Pos.X / Zoom + SourceRect.Left),
2082 Trunc(Pos.Y / Zoom + SourceRect.Top));
2083end;
2084
2085function TView.CellToCanvasPos(Pos: TPoint): TPoint;
2086begin
2087 Result := Point(Trunc((Pos.X - SourceRect.Left) * Zoom),
2088 Trunc((Pos.Y - SourceRect.Top) * Zoom));
2089end;
2090
2091function TView.CanvasToCellRect(Pos: TRect): TRect;
2092begin
2093 Result.TopLeft := CanvasToCellPos(Pos.TopLeft);
2094 Result.BottomRight := CanvasToCellPos(Pos.BottomRight);
2095end;
2096
2097function TView.CellToCanvasRect(Pos: TRect): TRect;
2098begin
2099 Result.TopLeft := CellToCanvasPos(Pos.TopLeft);
2100 Result.BottomRight := CellToCanvasPos(Pos.BottomRight);
2101end;
2102
2103procedure TView.Assign(Source: TView);
2104begin
2105 SourceRect := Source.SourceRect;
2106 FDestRect := Source.DestRect;
2107 FZoom := Source.Zoom;
2108 SelectedCell := Source.SelectedCell;
2109 FocusedCell := Source.FocusedCell;
2110end;
2111
2112procedure TPlayer.SetGame(AValue: TGame);
2113begin
2114 if FGame = AValue then Exit;
2115 FGame := AValue;
2116 Moves.Game := AValue;
2117 Computer.Game := AValue;
2118end;
2119
2120procedure TPlayer.Clear;
2121begin
2122 TurnStats.Clear;
2123 Moves.Clear;
2124end;
2125
2126procedure TPlayer.SetClient(AValue: TClient);
2127begin
2128 if FClient=AValue then Exit;
2129 if Assigned(FClient) then FClient.FControlPlayer := nil;
2130 FClient := AValue;
2131 if Assigned(FClient) then FClient.FControlPlayer := Self;
2132end;
2133
2134procedure TPlayer.LoadFromNode(Node: TDOMNode);
2135var
2136 NewNode: TDOMNode;
2137begin
2138 Id := ReadInteger(Node, 'Id', 0);
2139 Name := ReadString(Node, 'Name', '');
2140 Color := ReadInteger(Node, 'Color', clSilver);
2141 Mode := TPlayerMode(ReadInteger(Node, 'Mode', Integer(pmHuman)));
2142 StartCell := FGame.Map.Cells.FindById(ReadInteger(Node, 'StartCell', 0));
2143 StartUnits := ReadInteger(Node, 'StartUnits', 0);
2144 Agressivity := TComputerAgressivity(ReadInteger(Node, 'Agressivity', Integer(caMedium)));
2145 Defensive := ReadBoolean(Node, 'Defensive', False);
2146
2147 with Node do begin
2148 NewNode := FindNode('Map');
2149 if Assigned(NewNode) then
2150 PlayerMap.LoadFromNode(NewNode);
2151 end;
2152 with Node do begin
2153 NewNode := FindNode('UnitMoves');
2154 if Assigned(NewNode) then
2155 Moves.LoadFromNode(NewNode);
2156 end;
2157 with Node do begin
2158 NewNode := FindNode('TurnStats');
2159 if Assigned(NewNode) then
2160 TurnStats.LoadFromNode(NewNode);
2161 end;
2162end;
2163
2164procedure TPlayer.SaveToNode(Node: TDOMNode);
2165var
2166 NewNode: TDOMNode;
2167begin
2168 WriteInteger(Node, 'Id', Id);
2169 WriteString(Node, 'Name', Name);
2170 WriteInteger(Node, 'Color', Color);
2171 WriteInteger(Node, 'Mode', Integer(Mode));
2172 WriteInteger(Node, 'StartCell', StartCell.Id);
2173 WriteInteger(Node, 'StartUnits', StartUnits);
2174 WriteInteger(Node, 'Agressivity', Integer(Agressivity));
2175 WriteBoolean(Node, 'Defensive', Defensive);
2176
2177 with Node do begin
2178 NewNode := OwnerDocument.CreateElement('Map');
2179 AppendChild(NewNode);
2180 PlayerMap.SaveToNode(NewNode);
2181 end;
2182 with Node do begin
2183 NewNode := OwnerDocument.CreateElement('UnitMoves');
2184 AppendChild(NewNode);
2185 Moves.SaveToNode(NewNode);
2186 end;
2187 with Node do begin
2188 NewNode := OwnerDocument.CreateElement('TurnStats');
2189 AppendChild(NewNode);
2190 TurnStats.SaveToNode(NewNode);
2191 end;
2192end;
2193
2194function CellCompare(const Item1, Item2: TCell): Integer;
2195begin
2196 if Item1.Power > Item2.Power then Result := 1
2197 else if Item1.Power < Item2.Power then Result := -1
2198 else Result := 0;
2199end;
2200
2201function CellCompareDescending(const Item1, Item2: TCell): Integer;
2202begin
2203 if Item1.Power > Item2.Power then Result := -1
2204 else if Item1.Power < Item2.Power then Result := 1
2205 else Result := 0;
2206end;
2207
2208procedure TComputer.AttackNeutral;
2209var
2210 AllCells: TCells;
2211 TotalPower: Integer;
2212 AttackPower: Integer;
2213 TotalAttackPower: Integer;
2214 CanAttack: Integer;
2215 TargetCells: TCells;
2216 Cell: TCell;
2217 NeighborCell: TCell;
2218const
2219 AttackDiff = 1;
2220begin
2221 AllCells := Game.Map.Cells;
2222 TargetCells := TCells.Create;
2223 TargetCells.FreeObjects := False;
2224
2225 // Get list of all attack target cells
2226 for Cell in AllCells do
2227 with Cell do begin
2228 if (Terrain <> ttVoid) and (Player = nil) then begin
2229 CanAttack := 0;
2230 for NeighborCell in Neighbors do
2231 if NeighborCell.Player = Game.CurrentPlayer then begin
2232 Inc(CanAttack);
2233 end;
2234 if CanAttack > 0 then TargetCells.Add(Cell);
2235 end;
2236 end;
2237
2238 // Sort ascending to attack cells with lower power first
2239 // Low power cells are better for expanding our teritorry
2240 TargetCells.Sort(CellCompare);
2241
2242 for Cell in TargetCells do
2243 with Cell do begin
2244 // Attack to not owned cell yet
2245 // Count own possible power
2246 TotalPower := 0;
2247 for NeighborCell in Neighbors do
2248 if NeighborCell.Player = Game.CurrentPlayer then
2249 TotalPower := TotalPower + NeighborCell.GetAvialPower;
2250
2251 // Attack if target is weaker
2252 if TotalPower >= (Power + AttackDiff) then begin
2253 TotalAttackPower := 0;
2254 for NeighborCell in Neighbors do
2255 if NeighborCell.Player = Game.CurrentPlayer then begin
2256 // Use only necessary power
2257 AttackPower := Power - TotalAttackPower + AttackDiff;
2258 if NeighborCell.GetAvialPower < AttackPower then
2259 AttackPower := NeighborCell.GetAvialPower;
2260 Self.Player.SetMove(NeighborCell, Cell, AttackPower, False);
2261 TotalAttackPower := TotalAttackPower + AttackPower;
2262 end;
2263 end;
2264 end;
2265
2266 FreeAndNil(TargetCells);
2267end;
2268
2269procedure TComputer.AttackPlayers;
2270var
2271 AllCells: TCells;
2272 TotalPower: Integer;
2273 AttackPower: Integer;
2274 TotalAttackPower: Integer;
2275 CanAttack: Integer;
2276 TargetCells: TCells;
2277 TargetCell: TCell;
2278 NeighborCell: TCell;
2279begin
2280 if Game.CurrentPlayer.Defensive then Exit;
2281
2282 AllCells := Game.Map.Cells;
2283 TargetCells := TCells.Create;
2284 TargetCells.FreeObjects := False;
2285
2286 // Get list of all attack target cells
2287 for TargetCell in AllCells do begin
2288 if (TargetCell.Terrain <> ttVoid) and (TargetCell.Player <> Player) and
2289 (TargetCell.Player <> nil) then begin
2290 CanAttack := 0;
2291 for NeighborCell in TargetCell.Neighbors do
2292 if NeighborCell.Player = Player then begin
2293 Inc(CanAttack);
2294 end;
2295 if CanAttack > 0 then TargetCells.Add(TargetCell);
2296 end;
2297 end;
2298
2299 // Sort descending to attack cells with higher power first
2300 // Higher power enemy cells can grow faster and is more dangerous
2301 TargetCells.Sort(CellCompareDescending);
2302
2303 for TargetCell in TargetCells do begin
2304 // Attack to not owned cell yet
2305 // Count own possible power
2306 TotalPower := 0;
2307 for NeighborCell in TargetCell.Neighbors do
2308 if NeighborCell.Player = Player then begin
2309 TotalPower := TotalPower + NeighborCell.GetAvialPower;
2310 end;
2311 // Attack if target is weaker
2312 if Game.AttackProbability(TotalPower, TargetCell.Power) >=
2313 ComputerAggroProbability[Player.Agressivity] then begin
2314 // Try to limit total attacking power to necessary minimum
2315 while Game.AttackProbability(TotalPower - 1, TargetCell.Power) >=
2316 ComputerAggroProbability[Player.Agressivity] do
2317 Dec(TotalPower);
2318
2319 // Collect required attack units from our cells
2320 TotalAttackPower := 0;
2321 for NeighborCell in TargetCell.Neighbors do
2322 if NeighborCell.Player = Player then begin
2323 // Use only necessary power
2324 AttackPower := TotalPower - TotalAttackPower;
2325 if NeighborCell.GetAvialPower < AttackPower then
2326 AttackPower := NeighborCell.GetAvialPower;
2327 Self.Player.SetMove(NeighborCell, TargetCell, AttackPower, False);
2328 TotalAttackPower := TotalAttackPower + AttackPower;
2329 if TotalAttackPower >= TotalPower then Break;
2330 end;
2331 end;
2332 end;
2333
2334 FreeAndNil(TargetCells);
2335end;
2336
2337procedure TComputer.InnerMoves;
2338var
2339 AllCells: TCells;
2340 I, J: Integer;
2341 C: Integer;
2342 CanAttack: Integer;
2343 TargetCells: TCells;
2344 NewTargetCells: TCells;
2345 Cells2: TCells;
2346 MovedPower: Integer;
2347begin
2348 // We need to move available power to borders to be available for attacks
2349 // or defense
2350 AllCells := Game.Map.Cells;
2351 TargetCells := TCells.Create;
2352 TargetCells.FreeObjects := False;
2353 NewTargetCells := TCells.Create;
2354 NewTargetCells.FreeObjects := False;
2355
2356 // Get list of all enemy border cells
2357 for C := 0 to AllCells.Count - 1 do
2358 with TCell(AllCells[C]) do begin
2359 if (Player <> Game.CurrentPlayer) and (Player <> nil) and (Terrain <> ttVoid) then begin
2360 CanAttack := 0;
2361 for I := 0 to Neighbors.Count - 1 do
2362 if ((TCell(Neighbors[I]).Player = Game.CurrentPlayer) or
2363 (TCell(Neighbors[I]).Player = nil)) and (TCell(Neighbors[I]).Terrain <> ttVoid) then begin
2364 Inc(CanAttack);
2365 end;
2366 if CanAttack > 0 then TargetCells.Add(AllCells[C]);
2367 end;
2368 end;
2369
2370 if CellProcessDirection then begin
2371 // Reverse array
2372 for I := 0 to (TargetCells.Count div 2) - 1 do
2373 TargetCells.Exchange(I, TargetCells.Count - 1 - I);
2374 end;
2375
2376 Game.Map.Cells.ClearMark;
2377
2378 while TargetCells.Count > 0 do begin
2379 // Set mark for selected border cells
2380 for C := 0 to TargetCells.Count - 1 do
2381 TCell(TargetCells[C]).Mark := True;
2382
2383 // Move all power from unmarked cells and mark them
2384 NewTargetCells.Count := 0;
2385 for C := 0 to TargetCells.Count - 1 do
2386 with TCell(TargetCells[C]) do begin
2387 for I := 0 to Neighbors.Count - 1 do begin
2388 if (TCell(Neighbors[I]).Terrain <> ttVoid) and (not TCell(Neighbors[I]).Mark) then begin
2389 if (TCell(TargetCells[C]).Player = Game.CurrentPlayer) and
2390 (TCell(Neighbors[I]).Player = Game.CurrentPlayer) then begin
2391 // Do not take units from front line
2392 Cells2 := TCell(Neighbors[I]).Neighbors;
2393 CanAttack := 0;
2394 for J := 0 to Cells2.Count - 1 do
2395 if ((TCell(Cells2[J]).Player <> Game.CurrentPlayer) or (TCell(Cells2[J]).Player = nil))
2396 and (TCell(Cells2[J]).Terrain <> ttVoid) then begin
2397 Inc(CanAttack);
2398 end;
2399 if CanAttack = 0 then begin
2400 MovedPower := TCell(Neighbors[I]).GetAvialPower;
2401 if (TCell(TargetCells[C]).GetAvialPower + TCell(TargetCells[C]).GetAttackPower + MovedPower) > Game.Map.MaxPower then
2402 MovedPower := Game.Map.MaxPower - TCell(TargetCells[C]).GetAvialPower - TCell(TargetCells[C]).GetAttackPower;
2403 Player.SetMove(TCell(Neighbors[I]), TCell(TargetCells[C]), MovedPower, False);
2404 end;
2405 end;
2406 TCell(Neighbors[I]).Mark := True;
2407 NewTargetCells.Add(TCell(Neighbors[I]));
2408 end;
2409 end;
2410 end;
2411
2412 // Use source cells NewTargetCells as new TargetCells
2413 FreeAndNil(TargetCells);
2414 TargetCells := NewTargetCells;
2415 NewTargetCells := TCells.Create;
2416 NewTargetCells.FreeObjects := False;
2417 end;
2418
2419 FreeAndNil(TargetCells);
2420 FreeAndNil(NewTargetCells);
2421end;
2422
2423procedure TComputer.IncreaseMoves;
2424var
2425 Move: TUnitMove;
2426 AvailPower: Integer;
2427begin
2428 // If available power remains then use all for existed unit moves
2429 for Move in Player.Moves do
2430 with Move do begin
2431 if CellFrom.GetAvialPower > 0 then begin
2432 AvailPower := CellFrom.GetAvialPower;
2433 CountOnce := CountOnce + Min(AvailPower div CellFrom.MovesFrom.Count, AvailPower);
2434 end;
2435 end;
2436end;
2437
2438procedure TComputer.Process;
2439begin
2440 AttackPlayers;
2441 AttackNeutral;
2442 InnerMoves;
2443 IncreaseMoves;
2444 //FallBack;
2445 CellProcessDirection := not CellProcessDirection;
2446end;
2447
2448procedure TComputer.FallBack;
2449var
2450 C: Integer;
2451 I: Integer;
2452 AllCells: TCells;
2453 BorderCells: TCells;
2454 EnemyPower: Integer;
2455begin
2456 BorderCells := TCells.Create;
2457 BorderCells.FreeObjects := False;
2458 AllCells := Game.Map.Cells;
2459
2460 // Get list of border cells
2461 for C := 0 to AllCells.Count - 1 do
2462 with TCell(AllCells[C]) do begin
2463 if (Terrain <> ttVoid) and (Player = Game.CurrentPlayer) then begin
2464 if AttackersCount(TCell(AllCells[C])) > 0 then
2465 BorderCells.Add(AllCells[C]);
2466 end;
2467 end;
2468
2469 // Move all units back to inner area from weak border cells
2470 for C := 0 to BorderCells.Count - 1 do
2471 with TCell(BorderCells[C]) do begin
2472 // Calculate enemy power
2473 // TODO: Do not sum different enemy power to one value
2474 EnemyPower := 0;
2475 for I := 0 to Neighbors.Count - 1 do
2476 if (TCell(Neighbors[I]).Player <> Game.CurrentPlayer) and (TCell(Neighbors[I]).Player <> nil) then begin
2477 Inc(EnemyPower, TCell(Neighbors[I]).Power);
2478 end;
2479 if EnemyPower > (GetAvialPower + GetAttackPower) then begin
2480 // Fallback
2481 for I := MovesTo.Count - 1 downto 0 do
2482 Player.Moves.Remove(MovesTo[I]);
2483 for I := 0 to Neighbors.Count - 1 do
2484 if (TCell(Neighbors[I]).Player = Player) and (AttackersCount(TCell(Neighbors[I])) = 0) then begin
2485 Player.SetMove(TCell(BorderCells[C]), TCell(Neighbors[I]), GetAvialPower, False);
2486 Break;
2487 end;
2488 end;
2489 end;
2490
2491 FreeAndNil(BorderCells);
2492end;
2493
2494function TComputer.AttackersCount(Cell: TCell): Integer;
2495var
2496 I: Integer;
2497begin
2498 Result := 0;
2499 for I := 0 to Cell.Neighbors.Count - 1 do
2500 if (TCell(Cell.Neighbors[I]).Player <> Game.CurrentPlayer) and
2501 (TCell(Cell.Neighbors[I]).Player <> nil) then begin
2502 Inc(Result);
2503 end;
2504end;
2505
2506procedure TView.SelectCell(Pos: TPoint; Player: TPlayer; ShiftState: TShiftState);
2507var
2508 NewSelectedCell: TCell;
2509 UnitMove: TUnitMove;
2510 I: Integer;
2511begin
2512 NewSelectedCell := Game.Map.PosToCell(CanvasToCellPos(Pos), Self);
2513 if Assigned(NewSelectedCell) then begin
2514 if Assigned(SelectedCell) and Game.Map.IsCellsNeighbor(NewSelectedCell, SelectedCell) then begin
2515 if ssShift in ShiftState then begin
2516 // Make maximum unit move without confirmation dialog
2517 for I := SelectedCell.MovesFrom.Count - 1 downto 0 do begin
2518 Player.Moves.Remove(SelectedCell.MovesFrom[I]);
2519 end;
2520 Game.CurrentPlayer.SetMove(SelectedCell, NewSelectedCell, SelectedCell.Power, False);
2521 SelectedCell := nil;
2522 end else
2523 if ssCtrl in ShiftState then begin
2524 // If CTRL key pressed then storno all moved from selected cell and
2525 // move all power to new selected cell
2526 for I := SelectedCell.MovesFrom.Count - 1 downto 0 do
2527 Player.Moves.Remove(SelectedCell.MovesFrom[I]);
2528 UnitMove := Game.CurrentPlayer.SetMove(SelectedCell, NewSelectedCell, SelectedCell.Power, False);
2529 if Assigned(UnitMove) then
2530 UnitMove.CountRepeat := Player.Game.Map.MaxPower;
2531 if NewSelectedCell.Player = Player then SelectedCell := NewSelectedCell
2532 else SelectedCell := nil;
2533 end else begin
2534 Game.CurrentPlayer.SetMove(SelectedCell, NewSelectedCell, SelectedCell.Power);
2535 SelectedCell := nil;
2536 end;
2537 end else
2538 if (NewSelectedCell <> SelectedCell) and (NewSelectedCell.Player = Player) then
2539 SelectedCell := NewSelectedCell
2540 else
2541 if (NewSelectedCell = SelectedCell) and (NewSelectedCell.Player = Player) then
2542 SelectedCell := nil;
2543 end;
2544end;
2545
2546procedure TView.CenterMap;
2547var
2548 MapRect: TRect;
2549begin
2550 MapRect := Game.Map.PixelRect;
2551 SourceRect := Bounds(MapRect.Left + (MapRect.Right - MapRect.Left) div 2 - (SourceRect.Right - SourceRect.Left) div 2,
2552 MapRect.Top + (MapRect.Bottom - MapRect.Top) div 2 - (SourceRect.Bottom - SourceRect.Top) div 2,
2553 SourceRect.Right - SourceRect.Left,
2554 SourceRect.Bottom - SourceRect.Top);
2555end;
2556
2557procedure TView.CenterPlayerCity(Player: TPlayer);
2558begin
2559 SourceRect := Bounds(Player.StartCell.PosPx.X - (SourceRect.Right - SourceRect.Left) div 2,
2560 Player.StartCell.PosPx.Y - (SourceRect.Bottom - SourceRect.Top) div 2,
2561 SourceRect.Right - SourceRect.Left,
2562 SourceRect.Bottom - SourceRect.Top);
2563end;
2564
2565procedure TPlayer.Paint(Canvas: TCanvas; View: TView);
2566begin
2567 PlayerMap.Paint(Canvas, View);
2568end;
2569
2570constructor TPlayer.Create;
2571begin
2572 Moves := TUnitMoves.Create;
2573 StartUnits := DefaultPlayerStartUnits;
2574 StartCell := nil;
2575 PlayerMap := TPlayerMap.Create;
2576 PlayerMap.Player := Self;
2577 TurnStats := TGameTurnStats.Create;
2578 Computer := TComputer.Create;
2579 Computer.Player := Self;
2580end;
2581
2582destructor TPlayer.Destroy;
2583begin
2584 Client := nil;
2585 FreeAndNil(Computer);
2586 FreeAndNil(TurnStats);
2587 FreeAndNil(PlayerMap);
2588 FreeAndNil(Moves);
2589 inherited Destroy;
2590end;
2591
2592procedure TPlayer.Assign(Source: TPlayer);
2593begin
2594 Id := Source.Id;
2595 Name := Source.Name;
2596 Color := Source.Color;
2597 Mode := Source.Mode;
2598 Game := Source.Game;
2599 TotalCells := Source.TotalCells;
2600 TotalUnits := Source.TotalUnits;
2601 StartUnits := Source.StartUnits;
2602 StartCell := Source.StartCell;
2603 Agressivity := Source.Agressivity;
2604 Defensive := Source.Defensive;
2605 Computer.Game := Source.Computer.Game;
2606 Computer.CellProcessDirection := Source.Computer.CellProcessDirection;
2607end;
2608
2609procedure TPlayer.LoadConfig(Config: TXmlConfig; Path: string);
2610begin
2611 with Config do begin
2612 Self.Name := string(GetValue(DOMString(Path + '/Name'), ''));
2613 Color := TColor(GetValue(DOMString(Path + '/Color'), 0));
2614 StartUnits := GetValue(DOMString(Path + '/StartUnits'), 5);
2615 Mode := TPlayerMode(GetValue(DOMString(Path + '/Mode'), 0));
2616 Defensive := GetValue(DOMString(Path + '/Defensive'), False);
2617 Agressivity := TComputerAgressivity(GetValue(DOMString(Path + '/Agressivity'), 0));
2618 end;
2619end;
2620
2621procedure TPlayer.SaveConfig(Config: TXmlConfig; Path: string);
2622begin
2623 with Config do begin
2624 SetValue(DOMString(Path + '/Name'), DOMString(Self.Name));
2625 SetValue(DOMString(Path + '/Color'), Integer(Color));
2626 SetValue(DOMString(Path + '/StartUnits'), StartUnits);
2627 SetValue(DOMString(Path + '/Mode'), Integer(Mode));
2628 SetValue(DOMString(Path + '/Defensive'), Defensive);
2629 SetValue(DOMString(Path + '/Agressivity'), Integer(Agressivity));
2630 end;
2631end;
2632
2633{ TGame }
2634
2635function ComparePointer(const Item1, Item2: Integer): Integer;
2636begin
2637 Result := -CompareValue(Item1, Item2);
2638end;
2639
2640procedure TPlayer.Attack(var AttackPower, DefendPower: Integer);
2641var
2642 AttackerDiceCount: Integer;
2643 DefenderDiceCount: Integer;
2644 S: string;
2645 I: Integer;
2646 AttackRolls: TFPGList<Integer>;
2647 DefendRolls: TFPGList<Integer>;
2648begin
2649 AttackRolls := TFPGList<Integer>.Create;
2650 DefendRolls := TFPGList<Integer>.Create;
2651 if AttackPower < 1 then
2652 raise Exception.Create(SAttackerPowerPositive);
2653 if DefendPower < 0 then
2654 raise Exception.Create(SDefenderPowerPositive);
2655 while (AttackPower > 0) and (DefendPower > 0) do begin
2656 // Risk game rules:
2657 // Each side do their dice roll and compare result. Defender wins tie.
2658 // Attacker can use three dices and defender two
2659 AttackerDiceCount := Min(AttackPower, 3);
2660 DefenderDiceCount := Min(DefendPower, 2);
2661 // Roll and sort numbers
2662 AttackRolls.Count := AttackerDiceCount;
2663 for I := 0 to AttackerDiceCount - 1 do begin
2664 AttackRolls[I] := Random(7);
2665 end;
2666 AttackRolls.Sort(ComparePointer);
2667 S := 'Att:';
2668 for I := 0 to AttackerDiceCount - 1 do
2669 S := S + IntToStr(Integer(AttackRolls[I])) + ', ';
2670 DefendRolls.Count := DefenderDiceCount;
2671 for I := 0 to DefenderDiceCount - 1 do begin
2672 DefendRolls[I] := Random(7);
2673 end;
2674 DefendRolls.Sort(ComparePointer);
2675 S := S + ' Def:';
2676 for I := 0 to DefenderDiceCount - 1 do
2677 S := S + IntToStr(Integer(DefendRolls[I])) + ', ';
2678 // Resolution
2679 for I := 0 to Min(AttackerDiceCount, DefenderDiceCount) - 1 do
2680 if AttackRolls[I] > DefendRolls[I] then Dec(DefendPower)
2681 else Dec(AttackPower);
2682 end;
2683 FreeAndNil(AttackRolls);
2684 FreeAndNil(DefendRolls);
2685end;
2686
2687function TGame.AttackProbability(AttackCount, DefendCount: Integer): Double;
2688var
2689 OA, OD: Integer;
2690 Len: Integer;
2691 I: Integer;
2692begin
2693 if AttackCount = 0 then begin
2694 Result := 0;
2695 Exit;
2696 end;
2697 if DefendCount = 0 then begin
2698 Result := 1;
2699 Exit;
2700 end;
2701
2702 // Enlarge probability cache table on demand
2703 if Length(ProbabilityMatrix) < AttackCount then begin
2704 SetLength(ProbabilityMatrix, AttackCount);
2705 end;
2706 if Length(ProbabilityMatrix[AttackCount - 1]) < DefendCount then begin
2707 Len := Length(ProbabilityMatrix[AttackCount - 1]);
2708 SetLength(ProbabilityMatrix[AttackCount - 1], DefendCount);
2709 for I := Len to Length(ProbabilityMatrix[AttackCount - 1]) - 1 do
2710 ProbabilityMatrix[AttackCount - 1][I] := -1;
2711 end;
2712
2713 if ProbabilityMatrix[AttackCount - 1, DefendCount - 1] <> -1 then begin
2714 // Use cached value
2715 Result := ProbabilityMatrix[AttackCount - 1, DefendCount - 1];
2716 Exit;
2717 end else Result := 1;
2718
2719 OA := Min(AttackCount, 3);
2720 OD := Min(DefendCount, 2);
2721
2722 if (OA = 1) and (OD = 1) then
2723 Result := 0.4167 * AttackProbability(AttackCount, DefendCount - 1) +
2724 0.5833 * AttackProbability(AttackCount - 1, DefendCount)
2725 else if (OA = 2) and (OD = 1) then
2726 Result := 0.5787 * AttackProbability(AttackCount, DefendCount - 1) +
2727 0.4213 * AttackProbability(AttackCount - 1, DefendCount)
2728 else if (OA = 3) and (OD = 1) then
2729 Result := 0.6597 * AttackProbability(AttackCount, DefendCount - 1) +
2730 0.3403 * AttackProbability(AttackCount - 1, DefendCount)
2731 else if (OA = 1) and (OD = 2) then
2732 Result := 0.2546 * AttackProbability(AttackCount, DefendCount - 1) +
2733 0.7454 * AttackProbability(AttackCount - 1, DefendCount)
2734 else if (OA = 2) and (OD = 2) then
2735 Result := 0.2276 * AttackProbability(AttackCount, DefendCount - 2) +
2736 0.4483 * AttackProbability(AttackCount - 2, DefendCount) +
2737 0.3241 * AttackProbability(AttackCount - 1, DefendCount - 1)
2738 else if (OA = 3) and (OD = 2) then
2739 Result := 0.3717 * AttackProbability(AttackCount, DefendCount - 2) +
2740 0.2926 * AttackProbability(AttackCount - 2, DefendCount) +
2741 0.3358 * AttackProbability(AttackCount - 1, DefendCount - 1);
2742 ProbabilityMatrix[AttackCount - 1, DefendCount - 1] := Result;
2743end;
2744
2745procedure TPlayer.MoveAll;
2746var
2747 AttackerPower: Integer;
2748 DefenderPower: Integer;
2749 UnitCount: Integer;
2750 UnitMove: TUnitMove;
2751begin
2752 for UnitMove in Moves do
2753 with UnitMove do begin
2754 if CountOnce > 0 then begin
2755 if CellFrom.Player = Self then begin
2756 UnitCount := CountOnce;
2757 if CountOnce > CellFrom.Power then
2758 UnitCount := CellFrom.Power;
2759 CountOnce := 0;
2760 if CellTo.Player = Self then begin
2761 // Inner move
2762 CellTo.Power := CellTo.Power + UnitCount;
2763 end else begin
2764 AttackerPower := UnitCount;
2765 DefenderPower := CellTo.Power;
2766 Attack(AttackerPower, DefenderPower);
2767 if DefenderPower = 0 then begin
2768 // Attacker wins with possible loses
2769 ClearMovesFromCell(CellTo);
2770 CellTo.Player := Self;
2771 CellTo.Power := AttackerPower;
2772 end else
2773 if AttackerPower = 0 then begin
2774 // Defender wins with possible loses
2775 CellTo.Power := DefenderPower;
2776 end else
2777 raise Exception.Create(SUnfinishedBattle);
2778 end;
2779 CellFrom.Power := CellFrom.Power - UnitCount;
2780 end;
2781 end;
2782 end;
2783
2784 RemoveEmptyUnitMoves;
2785end;
2786
2787procedure TPlayer.ReduceMovesPower;
2788var
2789 UnitMove: TUnitMove;
2790 Power: Integer;
2791begin
2792 // Power of cell can be reduced by unsucessful enemy attack
2793 for UnitMove in Moves do begin
2794 Power := UnitMove.CellFrom.GetAvialPower;
2795 if Power < 0 then begin
2796 if Abs(Power) <= UnitMove.CountOnce then
2797 UnitMove.CountOnce := UnitMove.CountOnce - Abs(Power)
2798 end;
2799 end;
2800end;
2801
2802procedure TPlayer.ClearMovesFromCell(Cell: TCell);
2803var
2804 I: Integer;
2805begin
2806 if Assigned(Cell.Player) then
2807 for I := Cell.Player.Moves.Count - 1 downto 0 do
2808 if TUnitMove(Cell.Player.Moves[I]).CellFrom = Cell then
2809 Cell.Player.Moves.Delete(I);
2810end;
2811
2812procedure TGame.SetMapType(AValue: TMapType);
2813var
2814 OldMap: TMap;
2815begin
2816 if FMapType = AValue then Exit;
2817 OldMap := Map;
2818 case AValue of
2819 mtNone: Map := TMap.Create;
2820 mtHexagon: Map := THexMap.Create;
2821 mtSquare: Map := TSquareMap.Create;
2822 mtTriangle: Map := TTriangleMap.Create;
2823 mtVoronoi: Map := TVoronoiMap.Create;
2824 else Map := TMap.Create;
2825 end;
2826 Map.Assign(OldMap);
2827 FreeAndNil(OldMap);
2828 FMapType := AValue;
2829end;
2830
2831function TPlayer.SetMove(CellFrom, CellTo: TCell; Power: Integer; Confirmation: Boolean = True): TUnitMove;
2832var
2833 NewMove: TUnitMove;
2834 CountOnce: Integer;
2835 CountRepeat: Integer;
2836 Confirm: Boolean;
2837begin
2838 Confirm := True;
2839 Result := Moves.SearchByFromTo(CellFrom, CellTo);
2840
2841 if Assigned(Result) then begin
2842 CountOnce := Result.CountOnce;
2843 CountRepeat := Result.CountRepeat;
2844 if (Mode = pmHuman) and Confirmation and
2845 Assigned(Game.FOnMove) then Game.FOnMove(CellFrom, CellTo, CountOnce, CountRepeat, True, Confirm);
2846 end else begin
2847 CountOnce := Power;
2848 CountRepeat := 0;
2849 if (Mode = pmHuman) and Confirmation and
2850 Assigned(Game.FOnMove) then Game.FOnMove(CellFrom, CellTo, CountOnce, CountRepeat, False, Confirm);
2851 end;
2852 if Confirm then begin
2853 if Assigned(Result) then begin
2854 // Already have such move
2855 if (CountOnce = 0) and (CountRepeat = 0) then begin
2856 Result.List.Remove(Result);
2857 end else begin
2858 Result.CountOnce := CountOnce;
2859 Result.CountRepeat := CountRepeat;
2860 CheckCounterMove(Result);
2861 end;
2862 end else begin
2863 // Add new move
2864 if (CountOnce > 0) or (CountRepeat > 0) then begin
2865 NewMove := TUnitMove.Create;
2866 NewMove.List := Moves;
2867 NewMove.CellFrom := CellFrom;
2868 NewMove.CellTo := CellTo;
2869 NewMove.CountOnce := CountOnce;
2870 NewMove.CountRepeat := CountRepeat;
2871 Moves.Add(NewMove);
2872 Result := NewMove;
2873 CheckCounterMove(NewMove);
2874 end;
2875 end;
2876 CellFrom.Check;
2877 if Assigned(Game.FOnMoveUpdated) then Game.FOnMoveUpdated(Result);
2878 end;
2879end;
2880
2881procedure TGame.SetRunning(AValue: Boolean);
2882var
2883 I: Integer;
2884begin
2885 if FRunning = AValue then Exit;
2886 if AValue then begin
2887 if Players.Count < 2 then raise Exception.Create(SMinimumPlayers);
2888 FRunning := AValue;
2889 end else begin
2890 FRunning := AValue;
2891 for I := 0 to Clients.Count - 1 do
2892 with TClient(Clients[I]) do begin
2893 View.Clear;
2894 end;
2895 end;
2896end;
2897
2898procedure TPlayer.UpdateRepeatMoves;
2899var
2900 Move: TUnitMove;
2901begin
2902 for Move in Moves do
2903 with Move do begin
2904 if CellFrom.Player = Self then
2905 if CountRepeat <= CellFrom.GetAvialPower then
2906 CountOnce := CountRepeat
2907 else CountOnce := CellFrom.GetAvialPower;
2908 end;
2909 RemoveEmptyUnitMoves;
2910end;
2911
2912procedure TPlayer.RemoveEmptyUnitMoves;
2913var
2914 I: Integer;
2915begin
2916 // Remove empty moves
2917 for I := Moves.Count - 1 downto 0 do
2918 if (TUnitMove(Moves[I]).CellFrom.Player = Self) and
2919 (TUnitMove(Moves[I]).CountOnce = 0) and (TUnitMove(Moves[I]).CountRepeat = 0) then
2920 Moves.Delete(I);
2921end;
2922
2923function TPlayer.IsAlive: Boolean;
2924begin
2925 Result := (TotalCells > 0) and Assigned(StartCell);
2926end;
2927
2928procedure TPlayer.CheckCounterMove(Move: TUnitMove);
2929var
2930 CounterMove: TUnitMove;
2931begin
2932 CounterMove := Moves.SearchByFromTo(Move.CellTo, Move.CellFrom);
2933 if Assigned(CounterMove) then begin
2934 // For now, just remove counter move
2935 Moves.Remove(CounterMove);
2936 end;
2937end;
2938
2939procedure TPlayer.SetMode(AValue: TPlayerMode);
2940begin
2941 if FMode = AValue then Exit;
2942 FMode := AValue;
2943end;
2944
2945function TMap.SearchDifferentCellArea(List: TCells; SourceArea, DestArea: TMapArea): TCell;
2946var
2947 NewList: TCells;
2948 NewListVoid: TCells;
2949 I: Integer;
2950 C: Integer;
2951begin
2952 Result := nil;
2953 NewList := TCells.Create;
2954 NewList.FreeObjects := False;
2955 NewListVoid := TCells.Create;
2956 NewListVoid.FreeObjects := False;
2957
2958 for C := 0 to List.Count - 1 do
2959 with TCell(List[C]) do begin
2960 for I := 0 to Neighbors.Count - 1 do
2961 with TCell(Neighbors[I]) do
2962 if (not Mark) and (Terrain <> ttVoid) and (Area <> SourceArea) and ((DestArea = nil) or (DestArea = Area)) then begin
2963 NewList.Add(TCell(TCell(List[C]).Neighbors[I]));
2964 Mark := True;
2965 end else
2966 if (not Mark) and (Terrain = ttVoid) then begin
2967 NewListVoid.Add(TCell(TCell(List[C]).Neighbors[I]));
2968 Mark := True;
2969 end;
2970 end;
2971
2972 if NewList.Count > 0 then begin
2973 // We found cell with different area
2974 Result := TCell(NewList[Random(NewList.Count)]);
2975 end else
2976 if NewListVoid.Count > 0 then begin
2977 // Cell was not found but we have more void cells to check
2978 Result := SearchDifferentCellArea(NewListVoid, SourceArea, DestArea);
2979 end;
2980
2981 FreeAndNil(NewListVoid);
2982 FreeAndNil(NewList);
2983end;
2984
2985procedure TGame.BuildTerrain;
2986var
2987 Cell: TCell;
2988begin
2989 if (Map.Shape = msImage) and FileExists(MapImageFileName) and
2990 (LoadedImageFileName <> MapImageFileName) then begin
2991 LoadedImageFileName := MapImageFileName;
2992 Map.Image.Picture.LoadFromFile(MapImageFileName);
2993 end;
2994
2995 // Randomize map terrain
2996 for Cell in Map.Cells do
2997 with Cell do begin
2998 if (VoidEnabled and (Random < VoidPercentage / 100)) or
2999 (Map.IsOutsideShape(PosPx)) then Terrain := ttVoid
3000 else begin
3001 if CityEnabled and (Random < CityPercentage / 100) then Terrain := ttCity
3002 else Terrain := ttNormal;
3003 end;
3004 Power := Random(MaxNeutralUnits + 1);
3005 Player := nil;
3006 end;
3007end;
3008
3009procedure TMap.BuildBridges;
3010var
3011 List: TCells;
3012 BorderList: TCells;
3013 Cell: TCell;
3014 FoundCell1: TCell;
3015 FoundCell2: TCell;
3016 I: Integer;
3017 J: Integer;
3018begin
3019 List := TCells.Create;
3020 List.FreeObjects := False;
3021
3022 BorderList := TCells.Create;
3023 BorderList.FreeObjects := False;
3024
3025 // Build area bridges
3026 if Areas.Count > 1 then
3027 for I := 0 to Areas.Count - 1 do
3028 with TMapArea(Areas[I]) do begin
3029 GetBorderCells(BorderList);
3030 for J := 0 to 4 do begin
3031
3032 Cell := TCell(BorderList[Random(BorderList.Count)]);
3033 List.Clear;
3034 List.Add(Cell);
3035
3036 Map.Cells.ClearMark;
3037
3038 // Find nearest cell with different area
3039 FoundCell1 := SearchDifferentCellArea(List, TMapArea(Map.Areas[I]), nil);
3040 if Assigned(FoundCell1) then begin
3041 // Again find back nearest cell with different area.
3042 // This will ensure that both cells are closest ones
3043
3044 Map.Cells.ClearMark;
3045 List[0] := FoundCell1;
3046 FoundCell2 := SearchDifferentCellArea(List, FoundCell1.Area, TMapArea(Map.Areas[I]));
3047 if Assigned(FoundCell2) then begin
3048 // Check if link doesn't exist already
3049 if not Assigned(FoundCell1.Links.FindByCells(FoundCell1, FoundCell2)) then begin
3050 Map.CellLinks.AddLink(FoundCell1, FoundCell2);
3051 Inc(BridgeCount);
3052 end;
3053 end;
3054 end;
3055 end;
3056
3057 end;
3058 FreeAndNil(List);
3059 FreeAndNil(BorderList);
3060end;
3061
3062procedure TMap.BuildMapAreas;
3063var
3064 C: Integer;
3065 NewArea: TMapArea;
3066begin
3067 for C := 0 to Cells.Count - 1 do
3068 with TCell(Cells[C]) do
3069 Area := nil;
3070 Areas.Clear;
3071 for C := 0 to Cells.Count - 1 do
3072 with TCell(Cells[C]) do
3073 if (Terrain <> ttVoid) and (not Assigned(Area)) then begin
3074 NewArea := TMapArea.Create;
3075 NewArea.Id := Map.Areas.Count;
3076 NewArea.Map := Map;
3077 Areas.Add(NewArea);
3078 Area := NewArea;
3079 AreaExtend;
3080 end;
3081end;
3082
3083procedure TGame.InitClients;
3084var
3085 Client: TClient;
3086 Player: TPlayer;
3087begin
3088 Clients.Clear;
3089 Clients.New('Spectator');
3090
3091 for Player in Players do
3092 with Player do
3093 if Mode = pmHuman then begin
3094 Clients.New(Player.Name);
3095 Player.Client := TClient(Clients.Last);
3096 end;
3097
3098 for Client in Clients do
3099 with Client do begin
3100 View.Clear;
3101 View.Zoom := 1;
3102 if Assigned(ControlPlayer) and Assigned(ControlPlayer.StartCell) then
3103 View.CenterPlayerCity(ControlPlayer)
3104 else View.CenterMap;
3105 end;
3106end;
3107
3108procedure TGame.SelectPlayerStartCell(Player: TPlayer);
3109var
3110 LongestDistance: Integer;
3111 Cell: TCell;
3112 List: TCells;
3113 I: Integer;
3114begin
3115 with Player do begin
3116 Map.Cells.ClearMark;
3117 Map.Cells.ClearWeight;
3118 CalculatePlayersDistance;
3119
3120 // Calculate longest distance
3121 LongestDistance := 0;
3122 for Cell in Map.Cells do
3123 if (Cell.Terrain <> ttVoid) and (Cell.Weight > LongestDistance) then
3124 LongestDistance := Cell.Weight;
3125
3126 List := TCells.Create;
3127 try
3128 List.FreeObjects := False;
3129 Map.Cells.GetCellsWithWeight(List, Round(LongestDistance * 0.6), Round(LongestDistance * 0.8));
3130
3131 // Remove cells already allocated to different player
3132 for I := List.Count - 1 downto 0 do
3133 if Assigned(TCell(List[I]).Player) then
3134 List.Delete(I);
3135
3136 if List.Count > 0 then
3137 StartCell := List[Random(List.Count)];
3138 finally
3139 FreeAndNil(List);
3140 end;
3141 end;
3142end;
3143
3144procedure TGame.CalculatePlayersDistance;
3145var
3146 Player: TPlayer;
3147 List: TCells;
3148begin
3149 for Player in Players do
3150 if Assigned(Player.StartCell) then begin
3151 Player.StartCell.Weight := 1;
3152 Player.StartCell.Mark := True;
3153 List := TCells.Create;
3154 List.FreeObjects := False;
3155 List.Add(Player.StartCell);
3156 PropagatePlayerDistance(List);
3157 FreeAndNil(List);
3158 end;
3159end;
3160
3161procedure TGame.PropagatePlayerDistance(List: TCells);
3162var
3163 NeighborCell: TCell;
3164 NeighborList: TCells;
3165 Cell: TCell;
3166begin
3167 NeighborList := TCells.Create;
3168 NeighborList.FreeObjects := False;
3169
3170 for Cell in List do begin
3171 for NeighborCell in Cell.Neighbors do begin
3172 if (NeighborCell.Terrain <> ttVoid) and
3173 ((not NeighborCell.Mark) or (NeighborCell.Weight > Cell.Weight + 1)) then begin
3174 NeighborCell.Weight := Cell.Weight + 1;
3175 NeighborCell.Mark := True;
3176 NeighborList.Add(NeighborCell);
3177 end;
3178 end;
3179 end;
3180 if NeighborList.Count > 0 then
3181 PropagatePlayerDistance(NeighborList);
3182 FreeAndNil(NeighborList);
3183end;
3184
3185procedure TGame.InitDefaultPlayersSetting;
3186begin
3187 PlayersSetting.Clear;
3188 PlayersSetting.New(SPlayer + ' 1', clBlue, pmHuman);
3189 PlayersSetting.New(SPlayer + ' 2', clRed, pmComputer);
3190end;
3191
3192procedure TGame.SaveConfig(Config: TXmlConfig; Path: string);
3193begin
3194 with Config do begin
3195 SetValue(DOMString(Path + '/GridType'), Integer(MapType));
3196 SetValue(DOMString(Path + '/MapImage'), DOMString(MapImageFileName));
3197 SetValue(DOMString(Path + '/SymetricMap'), SymetricMap);
3198 SetValue(DOMString(Path + '/FogOfWar'), FogOfWar);
3199 SetValue(DOMString(Path + '/VoidEnabled'), VoidEnabled);
3200 SetValue(DOMString(Path + '/VoidPercentage'), VoidPercentage);
3201 SetValue(DOMString(Path + '/MapSizeX'), Map.Size.X);
3202 SetValue(DOMString(Path + '/MapSizeY'), Map.Size.Y);
3203 SetValue(DOMString(Path + '/MapShape'), Integer(Map.Shape));
3204 SetValue(DOMString(Path + '/CityEnabled'), CityEnabled);
3205 SetValue(DOMString(Path + '/CityPercentage'), CityPercentage);
3206 SetValue(DOMString(Path + '/BridgeEnabled'), BridgeEnabled);
3207 SetValue(DOMString(Path + '/GrowAmount'), Integer(GrowAmount));
3208 SetValue(DOMString(Path + '/GrowCells'), Integer(GrowCells));
3209 SetValue(DOMString(Path + '/WinObjective'), Integer(WinObjective));
3210 PlayersSetting.SaveConfig(Config, Path + '/Players');
3211 end;
3212end;
3213
3214procedure TGame.LoadConfig(Config: TXmlConfig; Path: string);
3215var
3216 Value: Integer;
3217begin
3218 with Config do begin
3219 MapType := TMapType(GetValue(DOMString(Path + '/GridType'), Integer(mtHexagon)));
3220 MapImageFileName := string(GetValue(DOMString(Path + '/MapImage'), DOMString(MapImageFileName)));
3221 SymetricMap := GetValue(DOMString(Path + '/SymetricMap'), False);
3222 FogOfWar := GetValue(DOMString(Path + '/FogOfWar'), False);
3223 VoidEnabled := GetValue(DOMString(Path + '/VoidEnabled'), True);
3224 VoidPercentage := GetValue(DOMString(Path + '/VoidPercentage'), 20);
3225 Map.Size := Point(GetValue(DOMString(Path + '/MapSizeX'), 10),
3226 GetValue(DOMString(Path + '/MapSizeY'), 10));
3227 Value := GetValue(DOMString(Path + '/MapShape'), 0);
3228 if (Value >= Integer(Low(TMapShape))) and (Value <= Integer(High(TMapShape))) then
3229 Map.Shape := TMapShape(Value) else Map.Shape := Low(TMapShape);
3230 CityEnabled := GetValue(DOMString(Path + '/CityEnabled'), False);
3231 CityPercentage := GetValue(DOMString(Path + '/CityPercentage'), 10);
3232 BridgeEnabled := GetValue(DOMString(Path + '/BridgeEnabled'), True);
3233 Value := GetValue(DOMString(Path + '/GrowAmount'), Integer(gaBySquareRoot));
3234 if (Value >= Integer(Low(TGrowAmount))) and (Value <= Integer(High(TGrowAmount))) then
3235 GrowAmount := TGrowAmount(Value) else GrowAmount := Low(TGrowAmount);
3236 Value := GetValue(DOMString(Path + '/GrowCells'), Integer(gcPlayerAll));
3237 if (Value >= Integer(Low(TGrowCells))) and (Value <= Integer(High(TGrowCells))) then
3238 GrowCells := TGrowCells(Value) else GrowCells := Low(TGrowCells);
3239 Value := GetValue(DOMString(Path + '/WinObjective'), Integer(woDefeatAllOponents));
3240 if (Value >= Integer(Low(TWinObjective))) and (Value <= Integer(High(TWinObjective))) then
3241 WinObjective := TWinObjective(Value) else WinObjective := Low(TWinObjective);
3242 PlayersSetting.LoadConfig(Config, Path + '/Players');
3243 end;
3244end;
3245
3246procedure TGame.LoadFromFile(FileName: string);
3247var
3248 NewNode: TDOMNode;
3249 Doc: TXMLDocument;
3250 RootNode: TDOMNode;
3251 I: Integer;
3252begin
3253 Self.FileName := FileName;
3254 Clear;
3255 ReadXMLFile(Doc, FileName);
3256 with Doc do try
3257 if Doc.DocumentElement.NodeName <> 'XtacticsGame' then
3258 raise Exception.Create(SWrongFileFormat);
3259 RootNode := Doc.DocumentElement;
3260 with RootNode do begin
3261 SymetricMap := ReadBoolean(RootNode, 'SymetricMap', False);
3262 FogOfWar := ReadBoolean(RootNode, 'FogOfWar', False);
3263 VoidEnabled := ReadBoolean(RootNode, 'VoidEnabled', False);
3264 VoidPercentage := ReadInteger(RootNode, 'VoidPercentage', 0);
3265 MaxNeutralUnits := ReadInteger(RootNode, 'MaxNeutralUnits', 3);
3266 GrowCells := TGrowCells(ReadInteger(RootNode, 'GrowCells', Integer(gcNone)));
3267 GrowAmount := TGrowAmount(ReadInteger(RootNode, 'GrowAmount', Integer(gaByOne)));
3268 CityEnabled := ReadBoolean(RootNode, 'CityEnabled', False);
3269 CityPercentage := ReadInteger(RootNode, 'CityPercentage', 0);
3270 BridgeEnabled := ReadBoolean(RootNode, 'BridgeEnabled', False);
3271 TurnCounter := ReadInteger(RootNode, 'TurnCounter', 0);
3272 WinObjective := TWinObjective(ReadInteger(RootNode, 'WinObjective', Integer(woDefeatAllOponents)));
3273 ReadInteger(RootNode, 'StayAliveForDefinedTurns', StayAliveForDefinedTurns);
3274
3275 NewNode := FindNode('Map');
3276 if Assigned(NewNode) then
3277 Map.LoadFromNode(NewNode);
3278
3279 NewNode := FindNode('Players');
3280 if Assigned(NewNode) then
3281 Players.LoadFromNode(NewNode);
3282 if Players.Count > 0 then CurrentPlayer := TPlayer(Players[0])
3283 else CurrentPlayer := nil;
3284
3285 InitClients;
3286 Map.Cells.FixRefId;
3287
3288 for I := 0 to Players.Count - 1 do begin
3289 TPlayer(Players[I]).PlayerMap.Update;
3290 TPlayer(Players[I]).PlayerMap.CheckVisibility;
3291 end;
3292 Running := ReadBoolean(RootNode, 'Running', True);
3293 end;
3294 finally
3295 FreeAndNil(Doc);
3296 end;
3297end;
3298
3299procedure TGame.SaveToFile(FileName: string);
3300var
3301 NewNode: TDOMNode;
3302 Doc: TXMLDocument;
3303 RootNode: TDOMNode;
3304begin
3305 Self.FileName := FileName;
3306 Doc := TXMLDocument.Create;
3307 with Doc do try
3308 RootNode := CreateElement('XtacticsGame');
3309 AppendChild(RootNode);
3310 with RootNode do begin
3311 WriteBoolean(RootNode, 'SymetricMap', SymetricMap);
3312 WriteBoolean(RootNode, 'FogOfWar', FogOfWar);
3313 WriteBoolean(RootNode, 'VoidEnabled', VoidEnabled);
3314 WriteInteger(RootNode, 'VoidPercentage', VoidPercentage);
3315 WriteInteger(RootNode, 'MaxNeutralUnits', MaxNeutralUnits);
3316 WriteInteger(RootNode, 'GrowCells', Integer(GrowCells));
3317 WriteInteger(RootNode, 'GrowAmount', Integer(GrowAmount));
3318 WriteBoolean(RootNode, 'CityEnabled', CityEnabled);
3319 WriteInteger(RootNode, 'CityPercentage', CityPercentage);
3320 WriteBoolean(RootNode, 'BridgeEnabled', BridgeEnabled);
3321 WriteInteger(RootNode, 'TurnCounter', TurnCounter);
3322 WriteInteger(RootNode, 'WinObjective', Integer(WinObjective));
3323 WriteInteger(RootNode, 'StayAliveForDefinedTurns', StayAliveForDefinedTurns);
3324 WriteBoolean(RootNode, 'Running', Running);
3325
3326 NewNode := OwnerDocument.CreateElement('Map');
3327 AppendChild(NewNode);
3328 Map.SaveToNode(NewNode);
3329
3330 NewNode := OwnerDocument.CreateElement('Players');
3331 AppendChild(NewNode);
3332 Players.SaveToNode(NewNode);
3333 end;
3334 ForceDirectoriesUTF8(ExtractFileDir(FileName));
3335 WriteXMLFile(Doc, FileName);
3336 finally
3337 FreeAndNil(Doc);
3338 end;
3339end;
3340
3341procedure TGame.ComputePlayerStats;
3342var
3343 I: Integer;
3344 J: Integer;
3345begin
3346 for I := 0 to Players.Count - 1 do
3347 with TPlayer(Players[I]) do begin
3348 TotalUnits := 0;
3349 TotalCells := 0;
3350 TotalCities := 0;
3351
3352 TotalDiscovered := 0;
3353 for J := 0 to PlayerMap.Cells.Count - 1 do
3354 with TPlayerCell(PlayerMap.Cells[J]) do begin
3355 if Explored then Inc(TotalDiscovered);
3356 end;
3357 end;
3358
3359 Map.ComputePlayerStats;
3360end;
3361
3362procedure TGame.RecordTurnStats;
3363var
3364 I: Integer;
3365 NewStat: TGameTurnStat;
3366begin
3367 for I := 0 to Players.Count - 1 do
3368 with TPlayer(Players[I]) do begin
3369 NewStat := TGameTurnStat.Create;
3370 NewStat.DiscoveredCells := TotalDiscovered;
3371 NewStat.OccupiedCells := TotalCells;
3372 NewStat.Units := TotalUnits;
3373 NewStat.Cities := TotalCities;
3374 TurnStats.Add(NewStat);
3375 end;
3376end;
3377
3378function TPlayers.GetAlivePlayers: TPlayerArray;
3379var
3380 Player: TPlayer;
3381begin
3382 SetLength(Result, 0);
3383 for Player in Self do
3384 if Player.IsAlive then begin
3385 SetLength(Result, Length(Result) + 1);
3386 Result[Length(Result) - 1] := Player;
3387 end;
3388end;
3389
3390function TPlayers.GetAlivePlayersWithCities: TPlayerArray;
3391var
3392 Player: TPlayer;
3393begin
3394 SetLength(Result, 0);
3395 for Player in Self do
3396 if Player.TotalCities > 0 then begin
3397 SetLength(Result, Length(Result) + 1);
3398 Result[Length(Result) - 1] := Player;
3399 end;
3400end;
3401
3402procedure TGame.NextTurn;
3403var
3404 PrevPlayer: TPlayer;
3405begin
3406 //TODO CurrentPlayer.View.SelectedCell := nil;
3407 CurrentPlayer.MoveAll;
3408 Map.Grow(CurrentPlayer);
3409 CurrentPlayer.UpdateRepeatMoves;
3410 ComputePlayerStats;
3411 PrevPlayer := CurrentPlayer;
3412 // Skip dead players
3413 repeat
3414 CurrentPlayer := TPlayer(Players[(Players.IndexOf(CurrentPlayer) + 1) mod Players.Count]);
3415 if Assigned(FOnPlayerChange) then
3416 FOnPlayerChange(Self);
3417 until CurrentPlayer.IsAlive;
3418 if Players.IndexOf(CurrentPlayer) < Players.IndexOf(PrevPlayer) then begin
3419 Inc(TurnCounter);
3420 RecordTurnStats;
3421 if Assigned(FOnNewTurn) then
3422 FOnNewTurn(Self);
3423 end;
3424 CheckWinObjective;
3425 CurrentPlayer.PlayerMap.CheckVisibility;
3426 CurrentPlayer.ReduceMovesPower;
3427 // For computers take view from previous human
3428 //if CurrentPlayer.Mode = pmComputer then CurrentPlayer.View.Assign(PrevPlayer.View);
3429end;
3430
3431procedure TGame.CheckWinObjective;
3432var
3433 AlivePlayers: TPlayerArray;
3434 Winner: TPlayer;
3435begin
3436 Winner := nil;
3437 if WinObjective = woDefeatAllOponents then begin
3438 AlivePlayers := Players.GetAlivePlayers;
3439 if (Length(AlivePlayers) <= 1) then begin
3440 if Length(AlivePlayers) > 0 then Winner := TPlayer(AlivePlayers[0]);
3441 EndGame(Winner);
3442 end;
3443 end else
3444 if WinObjective = woDefeatAllOponentsCities then begin
3445 AlivePlayers := Players.GetAlivePlayersWithCities;
3446 if (Length(AlivePlayers) <= 1) then begin
3447 if Length(AlivePlayers) > 0 then Winner := TPlayer(AlivePlayers[0]);
3448 EndGame(Winner);
3449 end;
3450 end else
3451 if WinObjective = woSpecialCaptureCell then begin
3452 if Assigned(SpecialCaptureCell) and Assigned(SpecialCaptureCell.Player) then
3453 EndGame(SpecialCaptureCell.Player);
3454 end else
3455 if WinObjective = woStayAliveForDefinedTurns then begin
3456 // TODO: Not only one can win but multiple human players can survive.
3457 if TurnCounter > StayAliveForDefinedTurns then
3458 EndGame(nil);
3459 end;
3460end;
3461
3462constructor TGame.Create;
3463begin
3464 Map := TMap.Create;
3465 Players := TPlayers.Create;
3466 Players.Game := Self;
3467 PlayersSetting := TPlayers.Create;
3468 PlayersSetting.Game := Self;
3469 Clients := TClients.Create;
3470 Clients.Game := Self;
3471
3472 MapImageFileName := 'Images/Maps/WorldMap.png';
3473 Randomize;
3474 InitDefaultPlayersSetting;
3475
3476 VoidEnabled := True;
3477 VoidPercentage := 20;
3478 MaxNeutralUnits := 4;
3479
3480 Map.Game := Self;
3481 Map.Size := Point(3, 3);
3482end;
3483
3484destructor TGame.Destroy;
3485begin
3486 FreeAndNil(Clients);
3487 FreeAndNil(PlayersSetting);
3488 FreeAndNil(Players);
3489 FreeAndNil(Map);
3490 inherited Destroy;
3491end;
3492
3493procedure TGame.Clear;
3494begin
3495 Clients.Clear;
3496 Players.Clear;
3497 Map.Clear;
3498end;
3499
3500procedure TGame.New;
3501var
3502 I: Integer;
3503 Player: TPlayer;
3504begin
3505 Clear;
3506 FileName := SNewGameFile;
3507 TurnCounter := 1;
3508
3509 Map.Generate;
3510 BuildTerrain;
3511
3512 // Build bridges
3513 if BridgeEnabled then Map.CreateLinks;
3514
3515 if SymetricMap then begin
3516 Map.MakeSymetric;
3517 if BridgeEnabled then Map.CreateLinks;
3518 end;
3519
3520 Players.Assign(PlayersSetting);
3521 for Player in Players do Player.StartCell := nil;
3522 I := 0;
3523 for Player in Players do
3524 with Player do begin
3525 PlayerMap.Update;
3526 if (Map.Size.X > 0) and (Map.Size.Y > 0) then begin
3527 SelectPlayerStartCell(Player);
3528 if Assigned(Player.StartCell) then begin
3529 if SymetricMap and (I = 1) then
3530 StartCell := TCell(Map.Cells[Map.Cells.Count - 1 - Map.Cells.IndexOf(TPlayer(Players[0]).StartCell)]);
3531
3532 StartCell.Terrain := ttCity;
3533 StartCell.Player := Player;
3534 StartCell.Power := Player.StartUnits;
3535 end;
3536 end;
3537 PlayerMap.CheckVisibility;
3538 Inc(I);
3539 end;
3540 if Players.Count > 0 then CurrentPlayer := TPlayer(Players[0])
3541 else CurrentPlayer := nil;
3542
3543 InitClients;
3544 ComputePlayerStats;
3545end;
3546
3547procedure TGame.EndGame(Winner: TPlayer = nil);
3548begin
3549 Running := False;
3550 if Assigned(OnWin) and Assigned(Winner) then OnWin(Winner);
3551end;
3552
3553procedure TMap.Paint(Canvas: TCanvas; View: TView);
3554var
3555 I: Integer;
3556 Cell: TCell;
3557 PosFrom, PosTo: TPoint;
3558 Angle: Double;
3559 ArrowCenter: TPoint;
3560 Move: TUnitMove;
3561 CellLink: TCellLink;
3562begin
3563 with Canvas, View do
3564 try
3565 Lock;
3566
3567 // Draw cell links
3568 Pen.Color := clBlack;
3569 Pen.Style := psSolid;
3570 Pen.Width := 3;
3571 for CellLink in CellLinks do
3572 with CellLink do begin
3573 if Length(Points) >= 2 then begin
3574 MoveTo(View.CellToCanvasPos(Points[0]));
3575 for I := 1 to Length(Points) - 1 do
3576 LineTo(View.CellToCanvasPos(Points[I]));
3577 end;
3578 end;
3579
3580 // Draw cells
3581 for Cell in Cells do begin
3582 if (Cell.Terrain <> ttVoid) and Cell.IsVisible(View) then begin
3583 if Assigned(SelectedCell) and (SelectedCell = Cell) then
3584 Brush.Color := clGreen
3585 else if Assigned(SelectedCell) and IsCellsNeighbor(SelectedCell, Cell) then
3586 Brush.Color := clPurple
3587 else Brush.Color := Cell.GetColor;
3588 //Pen.Color := clBlack;
3589 PaintCell(Canvas, Cell.PosPx, IntToStr(Cell.GetAvialPower), View, Cell);
3590 end;
3591
3592 end;
3593
3594 // Draw arrows
3595 Pen.Color := clCream;
3596 for Move in Game.CurrentPlayer.Moves do begin
3597 PosFrom := CellToPos(Move.CellFrom);
3598 PosTo := CellToPos(Move.CellTo);
3599 if Move.CountRepeat > 0 then Pen.Width := 2
3600 else Pen.Width := 1;
3601 Angle := ArcTan((PosTo.Y - PosFrom.Y) / (PosTo.X - PosFrom.X));
3602 if Sign(PosTo.X - PosFrom.X) = -1 then Angle := Angle + Pi;
3603 ArrowCenter := View.CellToCanvasPos(Point(Trunc(PosFrom.X + (PosTo.X - PosFrom.X) / 2),
3604 Trunc(PosFrom.Y + (PosTo.Y - PosFrom.Y) / 2)));
3605 DrawArrow(Canvas, View, ArrowCenter,
3606 Angle, IntToStr(Move.CountOnce));
3607 end;
3608 finally
3609 Unlock;
3610 end;
3611end;
3612
3613end.
Note: See TracBrowser for help on using the repository browser.