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.0.0/UGame.pas

Last change on this file was 117, checked in by chronos, 7 years ago

Version 1.0.0

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