source: trunk/Game.pas

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