source: trunk/Game.pas

Last change on this file was 415, checked in by chronos, 6 months ago
  • Fixed: Do not show player win dialog if there is only one player in the game.
File size: 33.7 KB
Line 
1unit Game;
2
3interface
4
5uses
6 Classes, SysUtils, ExtCtrls, Graphics, XMLConf, XMLRead, XMLWrite, Forms,
7 DOM, Math, LazFileUtils, XML, Dialogs, LCLType, LCLIntf, Building, Geometry,
8 Player, Map, MapType, Units, GameSystem;
9
10const
11 DefaultPlayerStartUnits = 5;
12 MinPlayerCount = 1;
13 MaxPlayerCount = 12;
14 GameFileExt = '.xtg';
15
16type
17 TGame = class;
18
19 { TCanvasEx }
20
21 TCanvasEx = class(TCanvas)
22 class procedure TextOutEx(Canvas: TCanvas; X,Y: Integer; const Text: string; MovePen: Boolean = True);
23 class procedure PolygonEx(Canvas: TCanvas; const Points: array of Classes.TPoint; Winding: Boolean);
24 class procedure PolyLineEx(Canvas: TCanvas; const Points: array of Classes.TPoint);
25 class procedure EllipseEx(Canvas: TCanvas; const ARect: TRect);
26 end;
27
28 TWinEvent = procedure(Player: TPlayer) of object;
29 TGrowAmount = (gaByOne, gaBySquareRoot);
30 TGrowCells = (gcNone, gcPlayerCities, gcPlayerAll);
31 TWinObjective = (woNone, woDefeatAllOponents, woDefeatAllOponentsCities,
32 woSpecialCaptureCell, woStayAliveForDefinedTurns, woCaptureEntireMap);
33
34 { TGame }
35
36 TGame = class
37 private
38 FMapType: TMapType;
39 FOnChange: TNotifyEvent;
40 FOnMoveUpdated: TMoveUpdatedEvent;
41 FOnNewTurn: TNotifyEvent;
42 FOnPlayerChange: TNotifyEvent;
43 FOnStart: TNotifyEvent;
44 FOnWin: TWinEvent;
45 FRunning: Boolean;
46 LoadedImageFileName: string;
47 ProbabilityMatrix: array of array of Single;
48 procedure RecordTurnStats;
49 procedure SetMapType(AValue: TMapType);
50 procedure SetRunning(AValue: Boolean);
51 procedure BuildTerrain;
52 procedure PlaceUnits;
53 procedure PlaceCities;
54 procedure InitPlayers;
55 procedure SelectPlayerStartCell(Player: TPlayer);
56 procedure CalculatePlayersDistance;
57 procedure PropagatePlayerDistance(List: TCells);
58 procedure InitDefaultPlayers;
59 procedure WinObjectiveMapPrepare;
60 procedure BuildCity(Cell: TCell);
61 procedure DoChange;
62 public
63 GameSystem: TGameSystem;
64 FileName: string;
65 DevelMode: Boolean;
66 Players: TPlayers;
67 Units: TUnits;
68 Buildings: TBuildings;
69 Map: TMap;
70 MapImageFileName: string;
71 VoidEnabled: Boolean;
72 VoidPercentage: Integer;
73 SymetricMap: Boolean;
74 CyclicMap: Boolean;
75 GrowCells: TGrowCells;
76 GrowAmount: TGrowAmount;
77 CityEnabled: Boolean;
78 CityPercentage: Integer;
79 CurrentPlayer: TPlayer;
80 TurnCounter: Integer;
81 WinObjective: TWinObjective;
82 SpecialCaptureCellCount: Integer;
83 StayAliveForDefinedTurns: Integer;
84 MaxNeutralUnits: Integer;
85 FogOfWar: Boolean;
86 BridgeEnabled: Boolean;
87 MaxPower: Integer;
88 StoredRandSeed: Cardinal;
89 GeneratePlayers: Boolean;
90 procedure Assign(Source: TGame);
91 function AttackProbability(AttackCount, DefendCount: Integer): Double;
92 procedure LoadConfig(Config: TXmlConfig; Path: string);
93 procedure SaveConfig(Config: TXmlConfig; Path: string);
94 procedure LoadFromFile(FileName: string);
95 procedure SaveToFile(FileName: string);
96 function ToString: string; override;
97 procedure ComputePlayerStats;
98 procedure NextPlayer;
99 procedure CheckWinObjective;
100 constructor Create;
101 destructor Destroy; override;
102 procedure Clear;
103 procedure New;
104 procedure EndGame(Winner: TPlayer = nil);
105 function Compare(Game: TGame): Boolean;
106 property Running: Boolean read FRunning write SetRunning;
107 property MapType: TMapType read FMapType write SetMapType;
108 published
109 property OnMoveUpdated: TMoveUpdatedEvent read FOnMoveUpdated write FOnMoveUpdated;
110 property OnWin: TWinEvent read FOnWin write FOnWin;
111 property OnNewTurn: TNotifyEvent read FOnNewTurn write FOnNewTurn;
112 property OnPlayerChange: TNotifyEvent read FOnPlayerChange write FOnPlayerChange;
113 property OnStart: TNotifyEvent read FOnStart write FOnStart;
114 property OnChange: TNotifyEvent read FOnChange write FOnChange;
115 end;
116
117var
118 PlayerModeText: array[TPlayerMode] of string;
119
120const
121 ComputerAggroProbability: array[TComputerAgressivity] of Single = (0.9, 0.7, 0.5);
122
123procedure InitStrings;
124
125resourcestring
126 SPlayer = 'Player';
127 SSpectator = 'Spectator';
128
129
130implementation
131
132uses
133 TurnStats, UnitKind;
134
135resourcestring
136 SMinimumPlayers = 'You need at least one player';
137 SHuman = 'Human';
138 SComputer = 'Computer';
139 SWrongFileFormat = 'Wrong file format';
140 SNewGameFile = 'New game' + GameFileExt;
141 SUnsupportedMapType = 'Unsupported map type';
142
143procedure InitStrings;
144begin
145 PlayerModeText[pmHuman] := SHuman;
146 PlayerModeText[pmComputer] := SComputer;
147end;
148
149function HalfColor(Color: TColor): TColor;
150begin
151 Result :=
152 ((((Color shr 0) and $ff) shr 1) shl 0) or
153 ((((Color shr 8) and $ff) shr 1) shl 8) or
154 ((((Color shr 16) and $ff) shr 1) shl 16) or
155 ((((Color shr 24) and $ff) shr 0) shl 24);
156end;
157
158{ TCanvasEx }
159
160class procedure TCanvasEx.TextOutEx(Canvas: TCanvas; X, Y: Integer; const Text: string;
161 MovePen: Boolean);
162var
163 Flags : Cardinal;
164begin
165 with Canvas do begin
166 Changing;
167 RequiredState([csHandleValid, csFontValid, csBrushValid]);
168 Flags := 0;
169 if TextStyle.Opaque then
170 Flags := ETO_Opaque;
171 ExtUTF8Out(Handle, X, Y, Flags, nil, PChar(Text), Length(Text), nil);
172 if MovePen then MoveTo(X + TextWidth(Text), Y);
173 Changed;
174 end;
175end;
176
177class procedure TCanvasEx.PolygonEx(Canvas: TCanvas; const Points: array of Classes.TPoint; Winding: Boolean);
178begin
179 //Changing;
180 //RequiredState([csHandleValid, csBrushValid, csPenValid]);
181 //Canvas.Brush.Style := bsClear;
182 LCLIntf.Polygon(Canvas.Handle, @Points[0], Length(Points), Winding);
183// SetLength(Points, Length(Points) + 1);
184// Points[Length(Points) - 1] = Points[0];
185// LCLIntf.Polyline(Canvas.Handle, @Points[0], Length(Points));
186 //Changed;
187end;
188
189class procedure TCanvasEx.PolyLineEx(Canvas: TCanvas;
190 const Points: array of Classes.TPoint);
191begin
192 LCLIntf.Polyline(Canvas.Handle, @Points[0], Length(Points));
193end;
194
195class procedure TCanvasEx.EllipseEx(Canvas: TCanvas; const ARect: TRect);
196begin
197 LCLIntf.Ellipse(Canvas.Handle, ARect.P1.X, ARect.P1.Y, ARect.P2.X, ARect.P2.Y);
198end;
199
200{ TGame }
201
202function TGame.AttackProbability(AttackCount, DefendCount: Integer): Double;
203var
204 OA, OD: Integer;
205 Len: Integer;
206 I: Integer;
207begin
208 if AttackCount < 0 then raise Exception.Create('Attack power needs to be possitive' + IntToStr(AttackCount));
209 if AttackCount = 0 then begin
210 Result := 0;
211 Exit;
212 end;
213 if DefendCount < 0 then raise Exception.Create('Defend power needs to be possitive but is ' + IntToStr(DefendCount));
214 if DefendCount = 0 then begin
215 Result := 1;
216 Exit;
217 end;
218
219 // Enlarge probability cache table on demand
220 if Length(ProbabilityMatrix) < AttackCount then begin
221 SetLength(ProbabilityMatrix, AttackCount);
222 end;
223 if Length(ProbabilityMatrix[AttackCount - 1]) < DefendCount then begin
224 Len := Length(ProbabilityMatrix[AttackCount - 1]);
225 SetLength(ProbabilityMatrix[AttackCount - 1], DefendCount);
226 for I := Len to Length(ProbabilityMatrix[AttackCount - 1]) - 1 do
227 ProbabilityMatrix[AttackCount - 1][I] := -1;
228 end;
229
230 if ProbabilityMatrix[AttackCount - 1, DefendCount - 1] <> -1 then begin
231 // Use cached value
232 Result := ProbabilityMatrix[AttackCount - 1, DefendCount - 1];
233 Exit;
234 end else Result := 1;
235
236 OA := Min(AttackCount, 3);
237 OD := Min(DefendCount, 2);
238
239 if (OA = 1) and (OD = 1) then
240 Result := 0.4167 * AttackProbability(AttackCount, DefendCount - 1) +
241 0.5833 * AttackProbability(AttackCount - 1, DefendCount)
242 else if (OA = 2) and (OD = 1) then
243 Result := 0.5787 * AttackProbability(AttackCount, DefendCount - 1) +
244 0.4213 * AttackProbability(AttackCount - 1, DefendCount)
245 else if (OA = 3) and (OD = 1) then
246 Result := 0.6597 * AttackProbability(AttackCount, DefendCount - 1) +
247 0.3403 * AttackProbability(AttackCount - 1, DefendCount)
248 else if (OA = 1) and (OD = 2) then
249 Result := 0.2546 * AttackProbability(AttackCount, DefendCount - 1) +
250 0.7454 * AttackProbability(AttackCount - 1, DefendCount)
251 else if (OA = 2) and (OD = 2) then
252 Result := 0.2276 * AttackProbability(AttackCount, DefendCount - 2) +
253 0.4483 * AttackProbability(AttackCount - 2, DefendCount) +
254 0.3241 * AttackProbability(AttackCount - 1, DefendCount - 1)
255 else if (OA = 3) and (OD = 2) then
256 Result := 0.3717 * AttackProbability(AttackCount, DefendCount - 2) +
257 0.2926 * AttackProbability(AttackCount - 2, DefendCount) +
258 0.3358 * AttackProbability(AttackCount - 1, DefendCount - 1);
259 ProbabilityMatrix[AttackCount - 1, DefendCount - 1] := Result;
260end;
261
262procedure TGame.SetMapType(AValue: TMapType);
263var
264 OldMap: TMap;
265begin
266 if FMapType = AValue then Exit;
267 OldMap := Map;
268 case AValue of
269 mtNone: Map := TMap.Create;
270 mtHexagonVertical: Map := THexMapVertical.Create;
271 mtSquare: Map := TSquareMap.Create;
272 mtTriangle: Map := TTriangleMap.Create;
273 mtRandom: Map := TVoronoiMap.Create;
274 mtIsometric: Map := TIsometricMap.Create;
275 mtHexagonHorizontal: Map := THexMapHorizontal.Create;
276 else raise Exception.Create(SUnsupportedMapType);
277 end;
278 Map.Game := Self;
279 Map.Assign(OldMap);
280 FreeAndNil(OldMap);
281 FMapType := AValue;
282end;
283
284procedure TGame.SetRunning(AValue: Boolean);
285begin
286 if FRunning = AValue then Exit;
287 if AValue then begin
288 if Players.Count < 1 then raise Exception.Create(SMinimumPlayers);
289 FRunning := AValue;
290 end else begin
291 FRunning := AValue;
292 if Assigned(FOnStart) then FOnStart(Self);
293 end;
294end;
295
296procedure TGame.BuildTerrain;
297var
298 Cell: TCell;
299begin
300 // Load map image
301 if (Map.Shape = msImage) then begin
302 if LoadedImageFileName <> MapImageFileName then begin
303 LoadedImageFileName := MapImageFileName;
304 if FileExists(MapImageFileName) then begin
305 Map.Image.Picture.LoadFromFile(MapImageFileName)
306 end else begin
307 LoadedImageFileName := '';
308 Map.Image.Picture.Clear;
309 end;
310 end;
311 end;
312
313 // Randomize map terrain
314 for Cell in Map.Cells do
315 with Cell do begin
316 if (VoidEnabled and (Random < VoidPercentage / 100)) or
317 (Map.IsOutsideShape(PosPx)) then Terrain := ttVoid
318 else Terrain := ttNormal;
319 end;
320end;
321
322procedure TGame.PlaceUnits;
323var
324 Cell: TCell;
325 NewPower: Integer;
326begin
327 if GameSystem.UnitKinds.Count = 0 then Exit;
328
329 for Cell in Map.Cells do
330 with Cell do begin
331 NewPower := Random(MaxNeutralUnits + 1);
332 if (NewPower > 0) and not Assigned(OneUnit) then begin
333 OneUnit := Units.AddNew(GameSystem.UnitKinds[0], NewPower);
334 end;
335 Player := nil;
336 end;
337end;
338
339procedure TGame.PlaceCities;
340var
341 Cell: TCell;
342begin
343 for Cell in Map.Cells do
344 with Cell do begin
345 if (Terrain = ttNormal) and CityEnabled and (Random < CityPercentage / 100) then begin
346 BuildCity(Cell);
347 end;
348 end;
349end;
350
351procedure TGame.InitPlayers;
352var
353 I: Integer;
354 Player: TPlayer;
355begin
356 if not GeneratePlayers then Exit;
357
358 for I := 0 to Players.Count - 1 do begin
359 Players[I].Reset;
360 Players[I].StartCell := nil;
361 end;
362 for I := 0 to Players.Count - 1 do
363 with Players[I] do begin
364 Player := Players[I];
365 PlayerMap.Update;
366 if (Map.Size.X > 0) and (Map.Size.Y > 0) then begin
367 SelectPlayerStartCell(Player);
368 if Assigned(Player.StartCell) then begin
369 if SymetricMap and (I = 1) then
370 StartCell := Map.Cells[Map.Cells.Count - 1 - Map.Cells.IndexOf(Players[0].StartCell)];
371
372 if CityEnabled then BuildCity(StartCell);
373 StartCell.Player := Player;
374 if GameSystem.UnitKinds.Count > 0 then begin
375 if not Assigned(StartCell.OneUnit) then
376 StartCell.OneUnit := Self.Units.AddNew(GameSystem.UnitKinds[0], Player.StartUnits);
377 StartCell.OneUnit.Power := Player.StartUnits;
378 StartCell.OneUnit.Kind := GameSystem.UnitKinds[0];
379 StartCell.OneUnit.Player := Player;
380 end;
381 end;
382 end;
383 InitUnitMoves;
384 PlayerMap.CheckVisibility;
385 end;
386end;
387
388procedure TGame.SelectPlayerStartCell(Player: TPlayer);
389var
390 LongestDistance: Integer;
391 Cell: TCell;
392 List: TCells;
393 I: Integer;
394begin
395 with Player do begin
396 Map.Cells.ClearMark;
397 Map.Cells.ClearWeight;
398 CalculatePlayersDistance;
399
400 // Calculate longest distance
401 LongestDistance := 0;
402 for Cell in Map.Cells do
403 if (Cell.Terrain <> ttVoid) and (Cell.Weight > LongestDistance) then
404 LongestDistance := Cell.Weight;
405
406 List := TCells.Create;
407 try
408 List.OwnsObjects := False;
409 Map.Cells.GetCellsWithWeight(List, Round(LongestDistance * 0.6), Round(LongestDistance * 0.8));
410
411 // Remove cells already allocated to different player
412 for I := List.Count - 1 downto 0 do
413 if Assigned(List[I].Player) then
414 List.Delete(I);
415
416 if List.Count > 0 then
417 StartCell := List[Random(List.Count)];
418 finally
419 FreeAndNil(List);
420 end;
421 end;
422end;
423
424procedure TGame.CalculatePlayersDistance;
425var
426 Player: TPlayer;
427 List: TCells;
428 I: Integer;
429begin
430 for I := 0 to Players.Count - 1 do begin
431 Player := Players[I];
432 if Assigned(Player.StartCell) then begin
433 Player.StartCell.Weight := 1;
434 Player.StartCell.Mark := True;
435 List := TCells.Create;
436 List.OwnsObjects := False;
437 List.Add(Player.StartCell);
438 PropagatePlayerDistance(List);
439 FreeAndNil(List);
440 end;
441 end;
442end;
443
444procedure TGame.PropagatePlayerDistance(List: TCells);
445var
446 NeighborCell: TCell;
447 NeighborList: TCells;
448 Cell: TCell;
449begin
450 NeighborList := TCells.Create;
451 NeighborList.OwnsObjects := False;
452
453 for Cell in List do begin
454 for NeighborCell in Cell.Neighbors do begin
455 if (NeighborCell.Terrain <> ttVoid) and
456 ((not NeighborCell.Mark) or (NeighborCell.Weight > Cell.Weight + 1)) then begin
457 NeighborCell.Weight := Cell.Weight + 1;
458 NeighborCell.Mark := True;
459 NeighborList.Add(NeighborCell);
460 end;
461 end;
462 end;
463 if NeighborList.Count > 0 then
464 PropagatePlayerDistance(NeighborList);
465 FreeAndNil(NeighborList);
466end;
467
468procedure TGame.InitDefaultPlayers;
469begin
470 Players.Clear;
471 Players.New(SPlayer + ' 1', clBlue, pmHuman);
472 Players.New(SPlayer + ' 2', clRed, pmComputer);
473end;
474
475procedure TGame.WinObjectiveMapPrepare;
476var
477 Cell: TCell;
478 Cells: TCells;
479 I: Integer;
480begin
481 if WinObjective = woSpecialCaptureCell then begin
482 Cells := TCells.Create(False);
483 for I := 0 to Map.Cells.Count - 1 do
484 if (Map.Cells[I].Terrain <> ttVoid) and (Map.Cells[I].Extra <> etObjectiveTarget) then
485 Cells.Add(Map.Cells[I]);
486
487 for I := 0 to SpecialCaptureCellCount - 1 do begin
488 if Cells.Count = 0 then Break;
489 Cell := Cells[Random(Cells.Count)];
490 Cell.Extra := etObjectiveTarget;
491 Cells.Remove(Cell);
492 end;
493 Cells.Free;
494 end;
495end;
496
497procedure TGame.BuildCity(Cell: TCell);
498var
499 CityBuildingKind: TBuildingKind;
500begin
501 CityBuildingKind := GameSystem.BuildingKinds.FindBySpecialType(stCity);
502 if not Assigned(CityBuildingKind) then begin
503 CityBuildingKind := GameSystem.BuildingKinds.AddItem('City');
504 CityBuildingKind.SpecialType := stCity;
505 end;
506 if not Assigned(Cell.Building) then begin
507 Cell.Building := Buildings.AddItem('City');
508 Cell.Building.Kind := CityBuildingKind;
509 Cell.Building.Game := Self;
510 end;
511end;
512
513procedure TGame.DoChange;
514begin
515 if Assigned(FOnChange) then
516 FOnChange(Self);
517end;
518
519procedure TGame.Assign(Source: TGame);
520begin
521 StoredRandSeed := Source.StoredRandSeed;
522 DevelMode := Source.DevelMode;
523 Players.Assign(Source.Players);
524 Buildings.Assign(Source.Buildings);
525 MapType := Source.MapType;
526 Map.Assign(Source.Map);
527 MapImageFileName := Source.MapImageFileName;
528 LoadedImageFileName := Source.LoadedImageFileName;
529 VoidEnabled := Source.VoidEnabled;
530 VoidPercentage := Source.VoidPercentage;
531 SymetricMap := Source.SymetricMap;
532 CyclicMap := Source.CyclicMap;
533 GrowCells := Source.GrowCells;
534 GrowAmount := Source.GrowAmount;
535 CityEnabled := Source.CityEnabled;
536 CityPercentage := Source.CityPercentage;
537 TurnCounter := Source.TurnCounter;
538 WinObjective := Source.WinObjective;
539 SpecialCaptureCellCount := Source.SpecialCaptureCellCount;
540 StayAliveForDefinedTurns := Source.StayAliveForDefinedTurns;
541 MaxNeutralUnits := Source.MaxNeutralUnits;
542 FileName := Source.FileName;
543 FogOfWar := Source.FogOfWar;
544 BridgeEnabled := Source.BridgeEnabled;
545 MaxPower := Source.MaxPower;
546 GameSystem.Assign(Source.GameSystem);
547end;
548
549procedure TGame.SaveConfig(Config: TXmlConfig; Path: string);
550begin
551 with Config do begin
552 SetValue(DOMString(Path + '/RandSeed'), DOMString(IntToStr(StoredRandSeed)));
553 SetValue(DOMString(Path + '/GridType'), Integer(MapType));
554 SetValue(DOMString(Path + '/MapImage'), DOMString(MapImageFileName));
555 SetValue(DOMString(Path + '/SymetricMap'), SymetricMap);
556 SetValue(DOMString(Path + '/CyclicMap'), CyclicMap);
557 SetValue(DOMString(Path + '/FogOfWar'), FogOfWar);
558 SetValue(DOMString(Path + '/VoidEnabled'), VoidEnabled);
559 SetValue(DOMString(Path + '/VoidPercentage'), VoidPercentage);
560 SetValue(DOMString(Path + '/MapSizeX'), Map.Size.X);
561 SetValue(DOMString(Path + '/MapSizeY'), Map.Size.Y);
562 SetValue(DOMString(Path + '/MapShape'), Integer(Map.Shape));
563 SetValue(DOMString(Path + '/CityEnabled'), CityEnabled);
564 SetValue(DOMString(Path + '/CityPercentage'), CityPercentage);
565 SetValue(DOMString(Path + '/BridgeEnabled'), BridgeEnabled);
566 SetValue(DOMString(Path + '/GrowAmount'), Integer(GrowAmount));
567 SetValue(DOMString(Path + '/GrowCells'), Integer(GrowCells));
568 SetValue(DOMString(Path + '/WinObjective'), Integer(WinObjective));
569 SetValue(DOMString(Path + '/StayAliveForDefinedTurns'), StayAliveForDefinedTurns);
570 SetValue(DOMString(Path + '/SpecialCaptureCellCount'), SpecialCaptureCellCount);
571 SetValue(DOMString(Path + '/MaxNeutralUnits'), MaxNeutralUnits);
572 SetValue(DOMString(Path + '/MaxPower'), MaxPower);
573 Players.SaveConfig(Config, Path + '/Players');
574 SetValue(DOMString(Path + '/GameSystemName'), DOMString(GameSystem.GetName));
575 end;
576end;
577
578procedure TGame.LoadConfig(Config: TXmlConfig; Path: string);
579var
580 Value: Integer;
581 ValueInt64: Int64;
582begin
583 with Config do begin
584 if TryStrToInt64(string(GetValue(DOMString(Path + '/RandSeed'), DOMString(IntToStr(StoredRandSeed)))), ValueInt64) then
585 StoredRandSeed := ValueInt64;
586 MapType := TMapType(GetValue(DOMString(Path + '/GridType'), Integer(MapType)));
587 Map.Size := TPoint.Create(GetValue(DOMString(Path + '/MapSizeX'), Map.Size.X),
588 GetValue(DOMString(Path + '/MapSizeY'), Map.Size.Y));
589 MapImageFileName := string(GetValue(DOMString(Path + '/MapImage'), DOMString(MapImageFileName)));
590 SymetricMap := GetValue(DOMString(Path + '/SymetricMap'), SymetricMap);
591 CyclicMap := GetValue(DOMString(Path + '/CyclicMap'), CyclicMap);
592 FogOfWar := GetValue(DOMString(Path + '/FogOfWar'), FogOfWar);
593 VoidEnabled := GetValue(DOMString(Path + '/VoidEnabled'), VoidEnabled);
594 VoidPercentage := GetValue(DOMString(Path + '/VoidPercentage'), VoidPercentage);
595 Value := GetValue(DOMString(Path + '/MapShape'), Integer(Map.Shape));
596 if (Value >= Integer(Low(TMapShape))) and (Value <= Integer(High(TMapShape))) then
597 Map.Shape := TMapShape(Value) else Map.Shape := Low(TMapShape);
598 CityEnabled := GetValue(DOMString(Path + '/CityEnabled'), CityEnabled);
599 CityPercentage := GetValue(DOMString(Path + '/CityPercentage'), CityPercentage);
600 BridgeEnabled := GetValue(DOMString(Path + '/BridgeEnabled'), BridgeEnabled);
601 Value := GetValue(DOMString(Path + '/GrowAmount'), Integer(GrowAmount));
602 if (Value >= Integer(Low(TGrowAmount))) and (Value <= Integer(High(TGrowAmount))) then
603 GrowAmount := TGrowAmount(Value) else GrowAmount := Low(TGrowAmount);
604 Value := GetValue(DOMString(Path + '/GrowCells'), Integer(GrowCells));
605 if (Value >= Integer(Low(TGrowCells))) and (Value <= Integer(High(TGrowCells))) then
606 GrowCells := TGrowCells(Value) else GrowCells := Low(TGrowCells);
607 Value := GetValue(DOMString(Path + '/WinObjective'), Integer(WinObjective));
608 if (Value >= Integer(Low(TWinObjective))) and (Value <= Integer(High(TWinObjective))) then
609 WinObjective := TWinObjective(Value) else WinObjective := Low(TWinObjective);
610 StayAliveForDefinedTurns := GetValue(DOMString(Path + '/StayAliveForDefinedTurns'), StayAliveForDefinedTurns);
611 SpecialCaptureCellCount := GetValue(DOMString(Path + '/SpecialCaptureCellCount'), SpecialCaptureCellCount);
612 MaxNeutralUnits := GetValue(DOMString(Path + '/MaxNeutralUnits'), MaxNeutralUnits);
613 MaxPower := GetValue(DOMString(Path + '/MaxPower'), MaxPower);
614 Players.LoadConfig(Config, Path + '/Players');
615 end;
616end;
617
618procedure TGame.LoadFromFile(FileName: string);
619var
620 NewNode: TDOMNode;
621 Doc: TXMLDocument;
622 RootNode: TDOMNode;
623 I: Integer;
624begin
625 ReadXMLFile(Doc, FileName);
626 Self.FileName := FileName;
627 Clear;
628 with Doc do try
629 if Doc.DocumentElement.NodeName <> 'XtacticsGame' then
630 raise Exception.Create(SWrongFileFormat);
631 RootNode := Doc.DocumentElement;
632 with RootNode do begin
633 StoredRandSeed := ReadInt64(RootNode, 'RandSeed', 0);
634 MapType := TMapType(ReadInteger(RootNode, 'MapType', Integer(mtNone)));
635 SymetricMap := ReadBoolean(RootNode, 'SymetricMap', False);
636 CyclicMap := ReadBoolean(RootNode, 'CyclicMap', False);
637 FogOfWar := ReadBoolean(RootNode, 'FogOfWar', False);
638 VoidEnabled := ReadBoolean(RootNode, 'VoidEnabled', False);
639 VoidPercentage := ReadInteger(RootNode, 'VoidPercentage', 0);
640 MaxNeutralUnits := ReadInteger(RootNode, 'MaxNeutralUnits', 3);
641 MaxPower := ReadInteger(RootNode, 'MaxPower', DefaultMaxPower);
642 GrowCells := TGrowCells(ReadInteger(RootNode, 'GrowCells', Integer(gcNone)));
643 GrowAmount := TGrowAmount(ReadInteger(RootNode, 'GrowAmount', Integer(gaByOne)));
644 CityEnabled := ReadBoolean(RootNode, 'CityEnabled', False);
645 CityPercentage := ReadInteger(RootNode, 'CityPercentage', 0);
646 BridgeEnabled := ReadBoolean(RootNode, 'BridgeEnabled', False);
647 TurnCounter := ReadInteger(RootNode, 'TurnCounter', 0);
648 WinObjective := TWinObjective(ReadInteger(RootNode, 'WinObjective', Integer(woDefeatAllOponents)));
649 StayAliveForDefinedTurns := ReadInteger(RootNode, 'StayAliveForDefinedTurns', 10);
650
651 NewNode := FindNode('GameSystem');
652 if Assigned(NewNode) then
653 GameSystem.LoadFromNode(NewNode);
654
655 NewNode := FindNode('Map');
656 if Assigned(NewNode) then
657 Map.LoadFromNode(NewNode);
658
659 NewNode := FindNode('Players');
660 if Assigned(NewNode) then
661 Players.LoadFromNode(NewNode);
662 CurrentPlayer := Players.FindById(ReadInteger(RootNode, 'CurrentPlayer', -1));
663
664 if not Assigned(CurrentPlayer) and (Players.Count > 0) then CurrentPlayer := Players[0];
665
666 NewNode := FindNode('Units');
667 if Assigned(NewNode) then
668 Units.LoadFromNode(NewNode);
669
670 NewNode := FindNode('Buildings');
671 if Assigned(NewNode) then
672 Buildings.LoadFromNode(NewNode);
673
674 Map.Cells.FixRefId;
675 Units.FixRefId;
676
677 for I := 0 to Players.Count - 1 do begin
678 Players[I].PlayerMap.Update;
679 Players[I].PlayerMap.CheckVisibility;
680 end;
681 ComputePlayerStats;
682 Running := ReadBoolean(RootNode, 'Running', True);
683 end;
684 finally
685 FreeAndNil(Doc);
686 end;
687 DoChange;
688end;
689
690procedure TGame.SaveToFile(FileName: string);
691var
692 NewNode: TDOMNode;
693 Doc: TXMLDocument;
694 RootNode: TDOMNode;
695begin
696 Self.FileName := FileName;
697 Doc := TXMLDocument.Create;
698 with Doc do try
699 RootNode := CreateElement('XtacticsGame');
700 AppendChild(RootNode);
701 with RootNode do begin
702 StoredRandSeed := RandSeed;
703 WriteInt64(RootNode, 'RandSeed', StoredRandSeed);
704 WriteInteger(RootNode, 'MapType', Integer(MapType));
705 WriteBoolean(RootNode, 'SymetricMap', SymetricMap);
706 WriteBoolean(RootNode, 'CyclicMap', CyclicMap);
707 WriteBoolean(RootNode, 'FogOfWar', FogOfWar);
708 WriteBoolean(RootNode, 'VoidEnabled', VoidEnabled);
709 WriteInteger(RootNode, 'VoidPercentage', VoidPercentage);
710 WriteInteger(RootNode, 'MaxNeutralUnits', MaxNeutralUnits);
711 WriteInteger(RootNode, 'MaxPower', MaxPower);
712 WriteInteger(RootNode, 'GrowCells', Integer(GrowCells));
713 WriteInteger(RootNode, 'GrowAmount', Integer(GrowAmount));
714 WriteBoolean(RootNode, 'CityEnabled', CityEnabled);
715 WriteInteger(RootNode, 'CityPercentage', CityPercentage);
716 WriteBoolean(RootNode, 'BridgeEnabled', BridgeEnabled);
717 WriteInteger(RootNode, 'TurnCounter', TurnCounter);
718 WriteInteger(RootNode, 'WinObjective', Integer(WinObjective));
719 WriteInteger(RootNode, 'StayAliveForDefinedTurns', StayAliveForDefinedTurns);
720 WriteBoolean(RootNode, 'Running', Running);
721 WriteInteger(RootNode, 'CurrentPlayer', CurrentPlayer.Id);
722
723 Units.RecalculateItemsId;
724 Players.RecalculateItemsId;
725 Buildings.RecalculateItemsId;
726
727 NewNode := OwnerDocument.CreateElement('GameSystem');
728 AppendChild(NewNode);
729 GameSystem.SaveToNode(NewNode);
730
731 NewNode := OwnerDocument.CreateElement('Map');
732 AppendChild(NewNode);
733 Map.SaveToNode(NewNode);
734
735 NewNode := OwnerDocument.CreateElement('Players');
736 AppendChild(NewNode);
737 Players.SaveToNode(NewNode);
738
739 NewNode := OwnerDocument.CreateElement('Units');
740 AppendChild(NewNode);
741 Units.SaveToNode(NewNode);
742
743 NewNode := OwnerDocument.CreateElement('Buildings');
744 AppendChild(NewNode);
745 Buildings.SaveToNode(NewNode);
746 end;
747 if ExtractFileDir(FileName) <> '' then
748 ForceDirectories(ExtractFileDir(FileName));
749 WriteXMLFile(Doc, FileName);
750 finally
751 FreeAndNil(Doc);
752 end;
753end;
754
755function TGame.ToString: string;
756begin
757 Result := 'StoredRandSeed: ' + IntToStr(StoredRandSeed) + LineEnding;
758 Result := Result + 'MapType: ' + IntToStr(Integer(MapType)) + LineEnding;
759 Result := Result + 'SymetricMap: ' + BoolToStr(SymetricMap) + LineEnding;
760 Result := Result + 'CyclicMap: ' + BoolToStr(CyclicMap) + LineEnding;
761 Result := Result + 'FogOfWar: ' + BoolToStr(FogOfWar) + LineEnding;
762 Result := Result + 'VoidEnabled: ' + BoolToStr(VoidEnabled) + LineEnding;
763 Result := Result + 'VoidPercentage: ' + IntToStr(VoidPercentage) + LineEnding;
764 Result := Result + 'MaxNeutralUnits: ' + IntToStr(MaxNeutralUnits) + LineEnding;
765 Result := Result + 'MaxPower: ' + IntToStr(MaxPower) + LineEnding;
766 Result := Result + 'GrowCells: ' + IntToStr(Integer(GrowCells)) + LineEnding;
767 Result := Result + 'GrowAmount: ' + IntToStr(Integer(GrowAmount)) + LineEnding;
768 Result := Result + 'CityEnabled: ' + BoolToStr(CityEnabled) + LineEnding;
769 Result := Result + 'CityPercentage: ' + IntToStr(CityPercentage) + LineEnding;
770 Result := Result + 'BridgeEnabled: ' + BoolToStr(BridgeEnabled) + LineEnding;
771 Result := Result + 'TurnCounter: ' + IntToStr(TurnCounter) + LineEnding;
772 Result := Result + 'WinObjective: ' + IntToStr(Integer(WinObjective)) + LineEnding;
773 Result := Result + 'StayAliveForDefinedTurns: ' + IntToStr(StayAliveForDefinedTurns) + LineEnding;
774 Result := Result + 'Running: ' + BoolToStr(Running) + LineEnding;
775 Result := Result + 'GameSystem: ' + LineEnding + GameSystem.ToString + LineEnding;
776 Result := Result + 'Map: ' + LineEnding + Map.ToString + LineEnding;
777 Result := Result + 'Players: ' + LineEnding + Players.ToString + LineEnding;
778 Result := Result + 'Units: ' + LineEnding + Units.ToString + LineEnding;
779end;
780
781procedure TGame.ComputePlayerStats;
782var
783 I: Integer;
784 J: Integer;
785begin
786 for I := 0 to Players.Count - 1 do
787 with Players[I] do begin
788 TotalUnits := 0;
789 TotalCells := 0;
790 TotalCities := 0;
791 TotalWinObjectiveCells := 0;
792 TotalDiscovered := 0;
793 for J := 0 to PlayerMap.Cells.Count - 1 do
794 with PlayerMap.Cells[J] do begin
795 if Explored then Inc(TotalDiscovered);
796 end;
797 end;
798
799 Map.ComputePlayerStats;
800end;
801
802procedure TGame.RecordTurnStats;
803var
804 I: Integer;
805 NewStat: TGameTurnStat;
806begin
807 for I := 0 to Players.Count - 1 do
808 with Players[I] do begin
809 NewStat := TGameTurnStat.Create;
810 NewStat.DiscoveredCells := TotalDiscovered;
811 NewStat.OccupiedCells := TotalCells;
812 NewStat.Units := TotalUnits;
813 NewStat.Cities := TotalCities;
814 NewStat.WinObjectiveCells := TotalWinObjectiveCells;
815 TurnStats.Add(NewStat);
816 end;
817end;
818
819procedure TGame.NextPlayer;
820var
821 AlivePlayers: TPlayers;
822 NewPlayerIndex: Integer;
823begin
824 {$IFDEF DEBUG}
825 Map.CheckCells;
826 {$ENDIF}
827
828 // Finalize current player
829 CurrentPlayer.MoveAll;
830 CurrentPlayer.Grow;
831 CurrentPlayer.UpdateEmptyCellsNeutral;
832 CurrentPlayer.RemoveEmptyUnits;
833 CurrentPlayer.UpdateRepeatMoves;
834 ComputePlayerStats;
835
836 // Select new player from alive players
837 AlivePlayers := TPlayers.Create(False);
838 try
839 Players.GetAlivePlayers(AlivePlayers);
840 NewPlayerIndex := AlivePlayers.IndexOf(CurrentPlayer) + 1;
841 if NewPlayerIndex >= AlivePlayers.Count then begin
842 // Start of turn
843 Inc(TurnCounter);
844 RecordTurnStats;
845 if Assigned(FOnNewTurn) then
846 FOnNewTurn(Self);
847 NewPlayerIndex := NewPlayerIndex mod AlivePlayers.Count;
848 end;
849 CurrentPlayer := AlivePlayers[NewPlayerIndex];
850 finally
851 AlivePlayers.Free;
852 end;
853
854 if Assigned(FOnPlayerChange) then
855 FOnPlayerChange(Self);
856 CheckWinObjective;
857 CurrentPlayer.PlayerMap.CheckVisibility;
858 CurrentPlayer.ReduceMovesPower;
859 CurrentPlayer.RemoveInvalidMoves;
860 CurrentPlayer.InitUnitMoves;
861 DoChange;
862end;
863
864procedure TGame.CheckWinObjective;
865var
866 AlivePlayers: TPlayerArray;
867 Winner: TPlayer;
868 Cells: TCells;
869 Player: TPlayer;
870 R: Boolean;
871 I: Integer;
872begin
873 Winner := nil;
874 if (WinObjective = woDefeatAllOponents) and (Players.Count > 1) then begin
875 AlivePlayers := Players.GetAlivePlayers;
876 if (Length(AlivePlayers) <= 1) then begin
877 if Length(AlivePlayers) > 0 then Winner := AlivePlayers[0];
878 EndGame(Winner);
879 end;
880 end else
881 if WinObjective = woDefeatAllOponentsCities then begin
882 AlivePlayers := Players.GetAlivePlayersWithCities;
883 if (Length(AlivePlayers) <= 1) then begin
884 if Length(AlivePlayers) > 0 then Winner := AlivePlayers[0];
885 EndGame(Winner);
886 end;
887 end else
888 if WinObjective = woSpecialCaptureCell then begin
889 Cells := TCells.Create(False);
890 Map.Cells.GetCellsWithExtra(Cells, etObjectiveTarget);
891 R := True;
892 for I := 0 to Cells.Count - 1 do begin
893 if I = 0 then Player := TPlayer(Cells[I].Player);
894 if not Assigned(Cells[I].Player) then begin
895 R := False;
896 Break;
897 end;
898 if (Cells[I].Player <> Player) then begin
899 R := False;
900 Break;
901 end;
902 end;
903 if R then EndGame(Player);
904 Cells.Free;
905 end else
906 if WinObjective = woStayAliveForDefinedTurns then begin
907 if TurnCounter > StayAliveForDefinedTurns then
908 EndGame(nil);
909 end else
910 if WinObjective = woCaptureEntireMap then begin
911 Player := nil;
912 for I := 0 to Map.Cells.Count - 1 do
913 if TCell(Map.Cells[I]).Terrain <> ttVoid then begin
914 if (TCell(Map.Cells[I]).Player <> nil) then begin
915 if Player = nil then begin
916 // First player found
917 Player := TPlayer(TCell(Map.Cells[I]).Player);
918 end else
919 if Player <> TCell(Map.Cells[I]).Player then begin
920 // Multiple players still alive
921 Player := nil;
922 Break;
923 end;
924 end else begin
925 // Neutral cell
926 Player := nil;
927 Break;
928 end;
929 end;
930 if Player <> nil then
931 EndGame(Player);
932 end;
933end;
934
935constructor TGame.Create;
936begin
937 GameSystem := TGameSystem.Create;
938 Units := TUnits.Create;
939 Units.Game := Self;
940 Buildings := TBuildings.Create;
941 Buildings.Game := Self;
942 Map := TMap.Create;
943 Map.Game := Self;
944 Players := TPlayers.Create;
945 Players.Game := Self;
946
947 GeneratePlayers := True;
948 StoredRandSeed := RandSeed;
949 MapImageFileName := '';
950 MapType := mtHexagonVertical;
951 Map.Size := TPoint.Create(10, 10);
952
953 CityPercentage := 20;
954 VoidEnabled := True;
955 VoidPercentage := 20;
956 MaxPower := DefaultMaxPower;
957 MaxNeutralUnits := Min(4, MaxPower);
958 BridgeEnabled := True;
959 MaxNeutralUnits := 5;
960 MaxPower := 99;
961 SpecialCaptureCellCount := 1;
962 StayAliveForDefinedTurns := 20;
963 WinObjective := woDefeatAllOponents;
964 GrowCells := gcPlayerAll;
965 GrowAmount := gaBySquareRoot;
966
967 InitDefaultPlayers;
968end;
969
970destructor TGame.Destroy;
971begin
972 FreeAndNil(Players);
973 FreeAndNil(Map);
974 FreeAndNil(Buildings);
975 FreeAndNil(Units);
976 FreeAndNil(GameSystem);
977 inherited;
978end;
979
980procedure TGame.Clear;
981var
982 I: Integer;
983begin
984 for I := 0 to Players.Count - 1 do Players[I].Clear;
985 Map.Clear;
986 Units.Clear;
987 Buildings.Clear;
988end;
989
990procedure TGame.New;
991begin
992 Clear;
993 RandSeed := StoredRandSeed;
994 FileName := SNewGameFile;
995 TurnCounter := 1;
996
997 Map.Cyclic := CyclicMap;
998 Map.Generate;
999 Map.MaxPower := MaxPower;
1000 BuildTerrain;
1001 PlaceUnits;
1002 PlaceCities;
1003 WinObjectiveMapPrepare;
1004
1005 // Build bridges
1006 if BridgeEnabled then Map.CreateLinks;
1007
1008 if SymetricMap then begin
1009 Map.MakeSymetric;
1010 if BridgeEnabled then Map.CreateLinks;
1011 end;
1012
1013 InitPlayers;
1014 if Players.Count > 0 then CurrentPlayer := Players[0]
1015 else CurrentPlayer := nil;
1016
1017 ComputePlayerStats;
1018 DoChange;
1019end;
1020
1021procedure TGame.EndGame(Winner: TPlayer = nil);
1022begin
1023 Running := False;
1024 if Assigned(OnWin) then OnWin(Winner);
1025 DoChange;
1026end;
1027
1028function TGame.Compare(Game: TGame): Boolean;
1029begin
1030 Result := (StoredRandSeed = Game.StoredRandSeed) and
1031 (DevelMode = Game.DevelMode) and
1032 Players.Compare(Game.Players) and
1033 (MapType = Game.MapType) and
1034 Map.Compare(Game.Map) and
1035 (MapImageFileName = Game.MapImageFileName) and
1036 (VoidEnabled = Game.VoidEnabled) and
1037 (VoidPercentage = Game.VoidPercentage) and
1038 (SymetricMap = Game.SymetricMap) and
1039 (CyclicMap = Game.CyclicMap) and
1040 (GrowCells = Game.GrowCells) and
1041 (GrowAmount = Game.GrowAmount) and
1042 (CityEnabled = Game.CityEnabled) and
1043 (CityPercentage = Game.CityPercentage) and
1044 (TurnCounter = Game.TurnCounter) and
1045 (WinObjective = Game.WinObjective) and
1046 (SpecialCaptureCellCount = Game.SpecialCaptureCellCount) and
1047 (StayAliveForDefinedTurns = Game.StayAliveForDefinedTurns) and
1048 (MaxNeutralUnits = Game.MaxNeutralUnits) and
1049 (FileName = Game.FileName) and
1050 (FogOfWar = Game.FogOfWar) and
1051 (BridgeEnabled = Game.BridgeEnabled) and
1052 (MaxPower = Game.MaxPower) and
1053 GameSystem.Compare(Game.GameSystem);
1054end;
1055
1056end.
Note: See TracBrowser for help on using the repository browser.