source: tags/1.4.0/Game.pas

Last change on this file was 409, checked in by chronos, 2 weeks ago

Merged revision(s) 403-408 from trunk:

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