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

source: trunk/UGame.pas

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