source: tags/1.3.0/UGame.pas

Last change on this file was 251, checked in by chronos, 7 years ago
  • Added: Menu icons for players stats and help.
  • Fixed: Force directory creation only if directory is specified on game save.
File size: 25.1 KB
Line 
1unit UGame;
2
3{$mode delphi}{$H+}
4
5interface
6
7uses
8 Classes, SysUtils, ExtCtrls, Graphics, XMLConf, XMLRead, XMLWrite, Forms,
9 DOM, Math, LazFileUtils, UXMLUtils, Dialogs, LCLType, LCLIntf, fgl,
10 UGeometry, UPlayer, UMap, UMapType;
11
12const
13 DefaultPlayerStartUnits = 5;
14 MaxPlayerCount = 8;
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 end;
25
26 TWinEvent = procedure(Player: TPlayer) of object;
27 TGrowAmount = (gaByOne, gaBySquareRoot);
28 TGrowCells = (gcNone, gcPlayerCities, gcPlayerAll);
29 TMapType = (mtNone, mtHexagon, mtSquare, mtTriangle, mtVoronoi, mtIsometric);
30 TWinObjective = (woDefeatAllOponents, woDefeatAllOponentsCities,
31 woSpecialCaptureCell, woStayAliveForDefinedTurns);
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 SelectPlayerStartCell(Player: TPlayer);
52 procedure CalculatePlayersDistance;
53 procedure PropagatePlayerDistance(List: TCells);
54 procedure InitDefaultPlayers;
55 procedure WinObjectiveMapPrepare;
56 public
57 DevelMode: Boolean;
58 Players: TPlayers;
59 Map: TMap;
60 MapImageFileName: string;
61 VoidEnabled: Boolean;
62 VoidPercentage: Integer;
63 SymetricMap: Boolean;
64 CyclicMap: Boolean;
65 GrowCells: TGrowCells;
66 GrowAmount: TGrowAmount;
67 CityEnabled: Boolean;
68 CityPercentage: Integer;
69 CurrentPlayer: TPlayer;
70 TurnCounter: Integer;
71 WinObjective: TWinObjective;
72 SpecialCaptureCellCount: Integer;
73 StayAliveForDefinedTurns: Integer;
74 MaxNeutralUnits: Integer;
75 FileName: string;
76 FogOfWar: Boolean;
77 BridgeEnabled: Boolean;
78 MaxPower: Integer;
79 procedure PostConfig;
80 procedure Assign(Source: TGame);
81 function AttackProbability(AttackCount, DefendCount: Integer): Double;
82 procedure LoadConfig(Config: TXmlConfig; Path: string);
83 procedure SaveConfig(Config: TXmlConfig; Path: string);
84 procedure LoadFromFile(FileName: string);
85 procedure SaveToFile(FileName: string);
86 procedure ComputePlayerStats;
87 procedure NextPlayer;
88 procedure CheckWinObjective;
89 constructor Create;
90 destructor Destroy; override;
91 procedure Clear;
92 procedure New;
93 procedure EndGame(Winner: TPlayer = nil);
94 property Running: Boolean read FRunning write SetRunning;
95 property MapType: TMapType read FMapType write SetMapType;
96 published
97 property OnMoveUpdated: TMoveUpdatedEvent read FOnMoveUpdated write FOnMoveUpdated;
98 property OnWin: TWinEvent read FOnWin write FOnWin;
99 property OnNewTurn: TNotifyEvent read FOnNewTurn write FOnNewTurn;
100 property OnPlayerChange: TNotifyEvent read FOnPlayerChange write FOnPlayerChange;
101 property OnStart: TNotifyEvent read FOnStart write FOnStart;
102 property OnChange: TNotifyEvent read FOnChange write FOnChange;
103 end;
104
105var
106 PlayerModeText: array[TPlayerMode] of string;
107
108const
109 clOrange = $009Aff;
110 PlayerColors: array[0..7] of TColor = (clBlue, clRed, clGreen, clOrange,
111 clPurple, clMaroon, clAqua, clFuchsia);
112 ComputerAggroProbability: array[TComputerAgressivity] of Single = (0.9, 0.7, 0.5);
113
114procedure InitStrings;
115
116resourcestring
117 SPlayer = 'Player';
118 SSpectator = 'Spectator';
119
120
121implementation
122
123resourcestring
124 SMinimumPlayers = 'You need at least two players';
125 SHuman = 'Human';
126 SComputer = 'Computer';
127 SWrongFileFormat = 'Wrong file format';
128 SNewGameFile = 'New game.xtg';
129 SUnsupportedMapType = 'Unsupported map type';
130
131procedure InitStrings;
132begin
133 PlayerModeText[pmHuman] := SHuman;
134 PlayerModeText[pmComputer] := SComputer;
135end;
136
137function HalfColor(Color: TColor): TColor;
138begin
139 Result :=
140 ((((Color shr 0) and $ff) shr 1) shl 0) or
141 ((((Color shr 8) and $ff) shr 1) shl 8) or
142 ((((Color shr 16) and $ff) shr 1) shl 16) or
143 ((((Color shr 24) and $ff) shr 0) shl 24);
144end;
145
146{ TCanvasEx }
147
148class procedure TCanvasEx.TextOutEx(Canvas: TCanvas; X, Y: Integer; const Text: string;
149 MovePen: Boolean);
150var
151 Flags : Cardinal;
152begin
153 with Canvas do begin
154 Changing;
155 RequiredState([csHandleValid, csFontValid, csBrushValid]);
156 Flags := 0;
157 if TextStyle.Opaque then
158 Flags := ETO_Opaque;
159 ExtUTF8Out(Handle, X, Y, Flags, nil, PChar(Text), Length(Text), nil);
160 if MovePen then MoveTo(X + TextWidth(Text), Y);
161 Changed;
162 end;
163end;
164
165class procedure TCanvasEx.PolygonEx(Canvas: TCanvas; const Points: array of Classes.TPoint; Winding: Boolean);
166begin
167 //Changing;
168 //RequiredState([csHandleValid, csBrushValid, csPenValid]);
169 //Canvas.Brush.Style := bsClear;
170 LCLIntf.Polygon(Canvas.Handle, @Points[0], Length(Points), Winding);
171// SetLength(Points, Length(Points) + 1);
172// Points[Length(Points) - 1] = Points[0];
173// LCLIntf.Polyline(Canvas.Handle, @Points[0], Length(Points));
174 //Changed;
175end;
176
177{ TGame }
178
179function TGame.AttackProbability(AttackCount, DefendCount: Integer): Double;
180var
181 OA, OD: Integer;
182 Len: Integer;
183 I: Integer;
184begin
185 if AttackCount < 0 then raise Exception.Create('Attack power needs to be possitive' + IntToStr(AttackCount));
186 if AttackCount = 0 then begin
187 Result := 0;
188 Exit;
189 end;
190 if DefendCount < 0 then raise Exception.Create('Defend power needs to be possitive but is ' + IntToStr(DefendCount));
191 if DefendCount = 0 then begin
192 Result := 1;
193 Exit;
194 end;
195
196 // Enlarge probability cache table on demand
197 if Length(ProbabilityMatrix) < AttackCount then begin
198 SetLength(ProbabilityMatrix, AttackCount);
199 end;
200 if Length(ProbabilityMatrix[AttackCount - 1]) < DefendCount then begin
201 Len := Length(ProbabilityMatrix[AttackCount - 1]);
202 SetLength(ProbabilityMatrix[AttackCount - 1], DefendCount);
203 for I := Len to Length(ProbabilityMatrix[AttackCount - 1]) - 1 do
204 ProbabilityMatrix[AttackCount - 1][I] := -1;
205 end;
206
207 if ProbabilityMatrix[AttackCount - 1, DefendCount - 1] <> -1 then begin
208 // Use cached value
209 Result := ProbabilityMatrix[AttackCount - 1, DefendCount - 1];
210 Exit;
211 end else Result := 1;
212
213 OA := Min(AttackCount, 3);
214 OD := Min(DefendCount, 2);
215
216 if (OA = 1) and (OD = 1) then
217 Result := 0.4167 * AttackProbability(AttackCount, DefendCount - 1) +
218 0.5833 * AttackProbability(AttackCount - 1, DefendCount)
219 else if (OA = 2) and (OD = 1) then
220 Result := 0.5787 * AttackProbability(AttackCount, DefendCount - 1) +
221 0.4213 * AttackProbability(AttackCount - 1, DefendCount)
222 else if (OA = 3) and (OD = 1) then
223 Result := 0.6597 * AttackProbability(AttackCount, DefendCount - 1) +
224 0.3403 * AttackProbability(AttackCount - 1, DefendCount)
225 else if (OA = 1) and (OD = 2) then
226 Result := 0.2546 * AttackProbability(AttackCount, DefendCount - 1) +
227 0.7454 * AttackProbability(AttackCount - 1, DefendCount)
228 else if (OA = 2) and (OD = 2) then
229 Result := 0.2276 * AttackProbability(AttackCount, DefendCount - 2) +
230 0.4483 * AttackProbability(AttackCount - 2, DefendCount) +
231 0.3241 * AttackProbability(AttackCount - 1, DefendCount - 1)
232 else if (OA = 3) and (OD = 2) then
233 Result := 0.3717 * AttackProbability(AttackCount, DefendCount - 2) +
234 0.2926 * AttackProbability(AttackCount - 2, DefendCount) +
235 0.3358 * AttackProbability(AttackCount - 1, DefendCount - 1);
236 ProbabilityMatrix[AttackCount - 1, DefendCount - 1] := Result;
237end;
238
239procedure TGame.SetMapType(AValue: TMapType);
240var
241 OldMap: TMap;
242begin
243 if FMapType = AValue then Exit;
244 OldMap := Map;
245 case AValue of
246 mtNone: Map := TMap.Create;
247 mtHexagon: Map := THexMap.Create;
248 mtSquare: Map := TSquareMap.Create;
249 mtTriangle: Map := TTriangleMap.Create;
250 mtVoronoi: Map := TVoronoiMap.Create;
251 mtIsometric: Map := TIsometricMap.Create;
252 else raise Exception.Create(SUnsupportedMapType);
253 end;
254 Map.Game := Self;
255 Map.Assign(OldMap);
256 FreeAndNil(OldMap);
257 FMapType := AValue;
258end;
259
260procedure TGame.SetRunning(AValue: Boolean);
261begin
262 if FRunning = AValue then Exit;
263 if AValue then begin
264 if Players.Count < 2 then raise Exception.Create(SMinimumPlayers);
265 FRunning := AValue;
266 end else begin
267 FRunning := AValue;
268 if Assigned(FOnStart) then FOnStart(Self);
269 end;
270end;
271
272procedure TGame.BuildTerrain;
273var
274 Cell: TCell;
275begin
276 // Randomize map terrain
277 for Cell in Map.Cells do
278 with Cell do begin
279 if (VoidEnabled and (Random < VoidPercentage / 100)) or
280 (Map.IsOutsideShape(PosPx)) then Terrain := ttVoid
281 else begin
282 if CityEnabled and (Random < CityPercentage / 100) then Terrain := ttCity
283 else Terrain := ttNormal;
284 end;
285 Power := Random(MaxNeutralUnits + 1);
286 Player := nil;
287 end;
288end;
289
290procedure TGame.PostConfig;
291begin
292 if (Map.Shape = msImage) and FileExists(MapImageFileName) and
293 (LoadedImageFileName <> MapImageFileName) then begin
294 LoadedImageFileName := MapImageFileName;
295 Map.Image.Picture.LoadFromFile(MapImageFileName);
296 end;
297end;
298
299procedure TGame.SelectPlayerStartCell(Player: TPlayer);
300var
301 LongestDistance: Integer;
302 Cell: TCell;
303 List: TCells;
304 I: Integer;
305begin
306 with Player do begin
307 Map.Cells.ClearMark;
308 Map.Cells.ClearWeight;
309 CalculatePlayersDistance;
310
311 // Calculate longest distance
312 LongestDistance := 0;
313 for Cell in Map.Cells do
314 if (Cell.Terrain <> ttVoid) and (Cell.Weight > LongestDistance) then
315 LongestDistance := Cell.Weight;
316
317 List := TCells.Create;
318 try
319 List.FreeObjects := False;
320 Map.Cells.GetCellsWithWeight(List, Round(LongestDistance * 0.6), Round(LongestDistance * 0.8));
321
322 // Remove cells already allocated to different player
323 for I := List.Count - 1 downto 0 do
324 if Assigned(List[I].Player) then
325 List.Delete(I);
326
327 if List.Count > 0 then
328 StartCell := List[Random(List.Count)];
329 finally
330 FreeAndNil(List);
331 end;
332 end;
333end;
334
335procedure TGame.CalculatePlayersDistance;
336var
337 Player: TPlayer;
338 List: TCells;
339begin
340 for Player in Players do
341 if Assigned(Player.StartCell) then begin
342 Player.StartCell.Weight := 1;
343 Player.StartCell.Mark := True;
344 List := TCells.Create;
345 List.FreeObjects := False;
346 List.Add(Player.StartCell);
347 PropagatePlayerDistance(List);
348 FreeAndNil(List);
349 end;
350end;
351
352procedure TGame.PropagatePlayerDistance(List: TCells);
353var
354 NeighborCell: TCell;
355 NeighborList: TCells;
356 Cell: TCell;
357begin
358 NeighborList := TCells.Create;
359 NeighborList.FreeObjects := False;
360
361 for Cell in List do begin
362 for NeighborCell in Cell.Neighbors do begin
363 if (NeighborCell.Terrain <> ttVoid) and
364 ((not NeighborCell.Mark) or (NeighborCell.Weight > Cell.Weight + 1)) then begin
365 NeighborCell.Weight := Cell.Weight + 1;
366 NeighborCell.Mark := True;
367 NeighborList.Add(NeighborCell);
368 end;
369 end;
370 end;
371 if NeighborList.Count > 0 then
372 PropagatePlayerDistance(NeighborList);
373 FreeAndNil(NeighborList);
374end;
375
376procedure TGame.InitDefaultPlayers;
377begin
378 Players.Clear;
379 Players.New(SPlayer + ' 1', clBlue, pmHuman);
380 Players.New(SPlayer + ' 2', clRed, pmComputer);
381end;
382
383procedure TGame.WinObjectiveMapPrepare;
384var
385 Cell: TCell;
386 Cells: TCells;
387 I: Integer;
388begin
389 if WinObjective = woSpecialCaptureCell then begin
390 Cells := TCells.Create(False);
391 for I := 0 to Map.Cells.Count - 1 do
392 if (Map.Cells[I].Terrain <> ttVoid) and (Map.Cells[I].Extra <> etObjectiveTarget) then
393 Cells.Add(Map.Cells[I]);
394
395 for I := 0 to SpecialCaptureCellCount - 1 do begin
396 if Cells.Count = 0 then Break;
397 Cell := Cells[Random(Cells.Count)];
398 Cell.Extra := etObjectiveTarget;
399 Cells.Remove(Cell);
400 end;
401 Cells.Free;
402 end;
403end;
404
405procedure TGame.Assign(Source: TGame);
406begin
407 DevelMode := Source.DevelMode;
408 Players.Assign(Source.Players);
409 MapType := Source.MapType;
410 Map.Assign(Source.Map);
411 MapImageFileName := Source.MapImageFileName;
412 VoidEnabled := Source.VoidEnabled;
413 VoidPercentage := Source.VoidPercentage;
414 SymetricMap := Source.SymetricMap;
415 CyclicMap := Source.CyclicMap;
416 GrowCells := Source.GrowCells;
417 GrowAmount := Source.GrowAmount;
418 CityEnabled := Source.CityEnabled;
419 CityPercentage := Source.CityPercentage;
420 TurnCounter := Source.TurnCounter;
421 WinObjective := Source.WinObjective;
422 SpecialCaptureCellCount := Source.SpecialCaptureCellCount;
423 StayAliveForDefinedTurns := Source.StayAliveForDefinedTurns;
424 MaxNeutralUnits := Source.MaxNeutralUnits;
425 FileName := Source.FileName;
426 FogOfWar := Source.FogOfWar;
427 BridgeEnabled := Source.BridgeEnabled;
428 MaxPower := Source.MaxPower;
429end;
430
431procedure TGame.SaveConfig(Config: TXmlConfig; Path: string);
432begin
433 with Config do begin
434 SetValue(DOMString(Path + '/GridType'), Integer(MapType));
435 SetValue(DOMString(Path + '/MapImage'), DOMString(MapImageFileName));
436 SetValue(DOMString(Path + '/SymetricMap'), SymetricMap);
437 SetValue(DOMString(Path + '/CyclicMap'), CyclicMap);
438 SetValue(DOMString(Path + '/FogOfWar'), FogOfWar);
439 SetValue(DOMString(Path + '/VoidEnabled'), VoidEnabled);
440 SetValue(DOMString(Path + '/VoidPercentage'), VoidPercentage);
441 SetValue(DOMString(Path + '/MapSizeX'), Map.Size.X);
442 SetValue(DOMString(Path + '/MapSizeY'), Map.Size.Y);
443 SetValue(DOMString(Path + '/MapShape'), Integer(Map.Shape));
444 SetValue(DOMString(Path + '/CityEnabled'), CityEnabled);
445 SetValue(DOMString(Path + '/CityPercentage'), CityPercentage);
446 SetValue(DOMString(Path + '/BridgeEnabled'), BridgeEnabled);
447 SetValue(DOMString(Path + '/GrowAmount'), Integer(GrowAmount));
448 SetValue(DOMString(Path + '/GrowCells'), Integer(GrowCells));
449 SetValue(DOMString(Path + '/WinObjective'), Integer(WinObjective));
450 SetValue(DOMString(Path + '/StayAliveForDefinedTurns'), StayAliveForDefinedTurns);
451 SetValue(DOMString(Path + '/SpecialCaptureCellCount'), SpecialCaptureCellCount);
452 Players.SaveConfig(Config, Path + '/Players');
453 end;
454end;
455
456procedure TGame.LoadConfig(Config: TXmlConfig; Path: string);
457var
458 Value: Integer;
459begin
460 with Config do begin
461 MapType := TMapType(GetValue(DOMString(Path + '/GridType'), Integer(mtHexagon)));
462 Map.Size := TPoint.Create(GetValue(DOMString(Path + '/MapSizeX'), 10),
463 GetValue(DOMString(Path + '/MapSizeY'), 10));
464 MapImageFileName := string(GetValue(DOMString(Path + '/MapImage'), DOMString(MapImageFileName)));
465 SymetricMap := GetValue(DOMString(Path + '/SymetricMap'), False);
466 CyclicMap := GetValue(DOMString(Path + '/CyclicMap'), False);
467 FogOfWar := GetValue(DOMString(Path + '/FogOfWar'), False);
468 VoidEnabled := GetValue(DOMString(Path + '/VoidEnabled'), True);
469 VoidPercentage := GetValue(DOMString(Path + '/VoidPercentage'), 20);
470 Value := GetValue(DOMString(Path + '/MapShape'), 0);
471 if (Value >= Integer(Low(TMapShape))) and (Value <= Integer(High(TMapShape))) then
472 Map.Shape := TMapShape(Value) else Map.Shape := Low(TMapShape);
473 CityEnabled := GetValue(DOMString(Path + '/CityEnabled'), False);
474 CityPercentage := GetValue(DOMString(Path + '/CityPercentage'), 10);
475 BridgeEnabled := GetValue(DOMString(Path + '/BridgeEnabled'), True);
476 Value := GetValue(DOMString(Path + '/GrowAmount'), Integer(gaBySquareRoot));
477 if (Value >= Integer(Low(TGrowAmount))) and (Value <= Integer(High(TGrowAmount))) then
478 GrowAmount := TGrowAmount(Value) else GrowAmount := Low(TGrowAmount);
479 Value := GetValue(DOMString(Path + '/GrowCells'), Integer(gcPlayerAll));
480 if (Value >= Integer(Low(TGrowCells))) and (Value <= Integer(High(TGrowCells))) then
481 GrowCells := TGrowCells(Value) else GrowCells := Low(TGrowCells);
482 Value := GetValue(DOMString(Path + '/WinObjective'), Integer(woDefeatAllOponents));
483 if (Value >= Integer(Low(TWinObjective))) and (Value <= Integer(High(TWinObjective))) then
484 WinObjective := TWinObjective(Value) else WinObjective := Low(TWinObjective);
485 StayAliveForDefinedTurns := GetValue(DOMString(Path + '/StayAliveForDefinedTurns'), 20);
486 SpecialCaptureCellCount := GetValue(DOMString(Path + '/SpecialCaptureCellCount'), 1);
487 Players.LoadConfig(Config, Path + '/Players');
488 end;
489end;
490
491procedure TGame.LoadFromFile(FileName: string);
492var
493 NewNode: TDOMNode;
494 Doc: TXMLDocument;
495 RootNode: TDOMNode;
496 I: Integer;
497begin
498 ReadXMLFile(Doc, FileName);
499 Self.FileName := FileName;
500 Clear;
501 with Doc do try
502 if Doc.DocumentElement.NodeName <> 'XtacticsGame' then
503 raise Exception.Create(SWrongFileFormat);
504 RootNode := Doc.DocumentElement;
505 with RootNode do begin
506 MapType := TMapType(ReadInteger(RootNode, 'MapType', Integer(mtNone)));
507 SymetricMap := ReadBoolean(RootNode, 'SymetricMap', False);
508 CyclicMap := ReadBoolean(RootNode, 'CyclicMap', False);
509 FogOfWar := ReadBoolean(RootNode, 'FogOfWar', False);
510 VoidEnabled := ReadBoolean(RootNode, 'VoidEnabled', False);
511 VoidPercentage := ReadInteger(RootNode, 'VoidPercentage', 0);
512 MaxNeutralUnits := ReadInteger(RootNode, 'MaxNeutralUnits', 3);
513 MaxPower := ReadInteger(RootNode, 'MaxPower', DefaultMaxPower);
514 GrowCells := TGrowCells(ReadInteger(RootNode, 'GrowCells', Integer(gcNone)));
515 GrowAmount := TGrowAmount(ReadInteger(RootNode, 'GrowAmount', Integer(gaByOne)));
516 CityEnabled := ReadBoolean(RootNode, 'CityEnabled', False);
517 CityPercentage := ReadInteger(RootNode, 'CityPercentage', 0);
518 BridgeEnabled := ReadBoolean(RootNode, 'BridgeEnabled', False);
519 TurnCounter := ReadInteger(RootNode, 'TurnCounter', 0);
520 WinObjective := TWinObjective(ReadInteger(RootNode, 'WinObjective', Integer(woDefeatAllOponents)));
521 ReadInteger(RootNode, 'StayAliveForDefinedTurns', StayAliveForDefinedTurns);
522
523 NewNode := FindNode('Map');
524 if Assigned(NewNode) then
525 Map.LoadFromNode(NewNode);
526
527 NewNode := FindNode('Players');
528 if Assigned(NewNode) then
529 Players.LoadFromNode(NewNode);
530 if Players.Count > 0 then CurrentPlayer := Players[0]
531 else CurrentPlayer := nil;
532
533 Map.Cells.FixRefId;
534
535 for I := 0 to Players.Count - 1 do begin
536 Players[I].PlayerMap.Update;
537 Players[I].PlayerMap.CheckVisibility;
538 end;
539 ComputePlayerStats;
540 Running := ReadBoolean(RootNode, 'Running', True);
541 end;
542 finally
543 FreeAndNil(Doc);
544 end;
545end;
546
547procedure TGame.SaveToFile(FileName: string);
548var
549 NewNode: TDOMNode;
550 Doc: TXMLDocument;
551 RootNode: TDOMNode;
552begin
553 Self.FileName := FileName;
554 Doc := TXMLDocument.Create;
555 with Doc do try
556 RootNode := CreateElement('XtacticsGame');
557 AppendChild(RootNode);
558 with RootNode do begin
559 WriteInteger(RootNode, 'MapType', Integer(MapType));
560 WriteBoolean(RootNode, 'SymetricMap', SymetricMap);
561 WriteBoolean(RootNode, 'CyclicMap', CyclicMap);
562 WriteBoolean(RootNode, 'FogOfWar', FogOfWar);
563 WriteBoolean(RootNode, 'VoidEnabled', VoidEnabled);
564 WriteInteger(RootNode, 'VoidPercentage', VoidPercentage);
565 WriteInteger(RootNode, 'MaxNeutralUnits', MaxNeutralUnits);
566 WriteInteger(RootNode, 'MaxPower', MaxPower);
567 WriteInteger(RootNode, 'GrowCells', Integer(GrowCells));
568 WriteInteger(RootNode, 'GrowAmount', Integer(GrowAmount));
569 WriteBoolean(RootNode, 'CityEnabled', CityEnabled);
570 WriteInteger(RootNode, 'CityPercentage', CityPercentage);
571 WriteBoolean(RootNode, 'BridgeEnabled', BridgeEnabled);
572 WriteInteger(RootNode, 'TurnCounter', TurnCounter);
573 WriteInteger(RootNode, 'WinObjective', Integer(WinObjective));
574 WriteInteger(RootNode, 'StayAliveForDefinedTurns', StayAliveForDefinedTurns);
575 WriteBoolean(RootNode, 'Running', Running);
576
577 NewNode := OwnerDocument.CreateElement('Map');
578 AppendChild(NewNode);
579 Map.SaveToNode(NewNode);
580
581 NewNode := OwnerDocument.CreateElement('Players');
582 AppendChild(NewNode);
583 Players.SaveToNode(NewNode);
584 end;
585 if ExtractFileDir(FileName) <> '' then
586 ForceDirectoriesUTF8(ExtractFileDir(FileName));
587 WriteXMLFile(Doc, FileName);
588 finally
589 FreeAndNil(Doc);
590 end;
591end;
592
593procedure TGame.ComputePlayerStats;
594var
595 I: Integer;
596 J: Integer;
597begin
598 for I := 0 to Players.Count - 1 do
599 with Players[I] do begin
600 TotalUnits := 0;
601 TotalCells := 0;
602 TotalCities := 0;
603 TotalWinObjectiveCells := 0;
604 TotalDiscovered := 0;
605 for J := 0 to PlayerMap.Cells.Count - 1 do
606 with PlayerMap.Cells[J] do begin
607 if Explored then Inc(TotalDiscovered);
608 end;
609 end;
610
611 Map.ComputePlayerStats;
612end;
613
614procedure TGame.RecordTurnStats;
615var
616 I: Integer;
617 NewStat: TGameTurnStat;
618begin
619 for I := 0 to Players.Count - 1 do
620 with Players[I] do begin
621 NewStat := TGameTurnStat.Create;
622 NewStat.DiscoveredCells := TotalDiscovered;
623 NewStat.OccupiedCells := TotalCells;
624 NewStat.Units := TotalUnits;
625 NewStat.Cities := TotalCities;
626 NewStat.WinObjectiveCells := TotalWinObjectiveCells;
627 TurnStats.Add(NewStat);
628 end;
629end;
630
631procedure TGame.NextPlayer;
632var
633 AlivePlayers: TPlayers;
634 NewPlayerIndex: Integer;
635begin
636 {$IFDEF DEBUG}
637 Map.CheckCells;
638 {$ENDIF}
639
640 // Finalize current player
641 CurrentPlayer.MoveAll;
642 CurrentPlayer.Grow;
643 CurrentPlayer.UpdateRepeatMoves;
644 ComputePlayerStats;
645
646 // Select new player from alive players
647 AlivePlayers := TPlayers.Create(False);
648 try
649 Players.GetAlivePlayers(AlivePlayers);
650 NewPlayerIndex := AlivePlayers.IndexOf(CurrentPlayer) + 1;
651 if NewPlayerIndex >= AlivePlayers.Count then begin
652 // Start of turn
653 Inc(TurnCounter);
654 RecordTurnStats;
655 if Assigned(FOnNewTurn) then
656 FOnNewTurn(Self);
657 NewPlayerIndex := NewPlayerIndex mod AlivePlayers.Count;
658 end;
659 CurrentPlayer := AlivePlayers[NewPlayerIndex];
660 finally
661 AlivePlayers.Free;
662 end;
663
664 if Assigned(FOnPlayerChange) then
665 FOnPlayerChange(Self);
666 CheckWinObjective;
667 CurrentPlayer.PlayerMap.CheckVisibility;
668 CurrentPlayer.ReduceMovesPower;
669 CurrentPlayer.RemoveInvalidMoves;
670 if Assigned(FOnChange) then
671 FOnChange(Self);
672end;
673
674procedure TGame.CheckWinObjective;
675var
676 AlivePlayers: TPlayerArray;
677 Winner: TPlayer;
678 Cells: TCells;
679 Player: TPlayer;
680 R: Boolean;
681 I: Integer;
682begin
683 Winner := nil;
684 if WinObjective = woDefeatAllOponents then begin
685 AlivePlayers := Players.GetAlivePlayers;
686 if (Length(AlivePlayers) <= 1) then begin
687 if Length(AlivePlayers) > 0 then Winner := AlivePlayers[0];
688 EndGame(Winner);
689 end;
690 end else
691 if WinObjective = woDefeatAllOponentsCities then begin
692 AlivePlayers := Players.GetAlivePlayersWithCities;
693 if (Length(AlivePlayers) <= 1) then begin
694 if Length(AlivePlayers) > 0 then Winner := AlivePlayers[0];
695 EndGame(Winner);
696 end;
697 end else
698 if WinObjective = woSpecialCaptureCell then begin
699 Cells := TCells.Create(False);
700 Map.Cells.GetCellsWithExtra(Cells, etObjectiveTarget);
701 R := True;
702 for I := 0 to Cells.Count - 1 do begin
703 if I = 0 then Player := TPlayer(Cells[I].Player);
704 if not Assigned(Cells[I].Player) then begin
705 R := False;
706 Break;
707 end;
708 if (Cells[I].Player <> Player) then begin
709 R := False;
710 Break;
711 end;
712 end;
713 if R then EndGame(Player);
714 Cells.Free;
715 end else
716 if WinObjective = woStayAliveForDefinedTurns then begin
717 if TurnCounter > StayAliveForDefinedTurns then
718 EndGame(nil);
719 end;
720end;
721
722constructor TGame.Create;
723begin
724 Map := TMap.Create;
725 Players := TPlayers.Create;
726 Players.Game := Self;
727
728 MapImageFileName := 'Images/Maps/WorldMap.png';
729 Randomize;
730 InitDefaultPlayers;
731
732 VoidEnabled := True;
733 VoidPercentage := 20;
734 MaxPower := DefaultMaxPower;
735 MaxNeutralUnits := Min(4, MaxPower);
736
737 Map.Game := Self;
738 Map.Size := TPoint.Create(3, 3);
739end;
740
741destructor TGame.Destroy;
742begin
743 FreeAndNil(Players);
744 FreeAndNil(Map);
745 inherited Destroy;
746end;
747
748procedure TGame.Clear;
749var
750 I: Integer;
751begin
752 for I := 0 to Players.Count - 1 do Players[I].Clear;
753 Map.Clear;
754end;
755
756procedure TGame.New;
757var
758 I: Integer;
759 Player: TPlayer;
760begin
761 Clear;
762 FileName := SNewGameFile;
763 TurnCounter := 1;
764
765 Map.Cyclic := CyclicMap;
766 Map.Generate;
767 Map.MaxPower := MaxPower;
768 BuildTerrain;
769 WinObjectiveMapPrepare;
770
771 // Build bridges
772 if BridgeEnabled then Map.CreateLinks;
773
774 if SymetricMap then begin
775 Map.MakeSymetric;
776 if BridgeEnabled then Map.CreateLinks;
777 end;
778
779 for Player in Players do Player.StartCell := nil;
780 I := 0;
781 for Player in Players do
782 with Player do begin
783 PlayerMap.Update;
784 if (Map.Size.X > 0) and (Map.Size.Y > 0) then begin
785 SelectPlayerStartCell(Player);
786 if Assigned(Player.StartCell) then begin
787 if SymetricMap and (I = 1) then
788 StartCell := Map.Cells[Map.Cells.Count - 1 - Map.Cells.IndexOf(Players[0].StartCell)];
789
790 StartCell.Terrain := ttCity;
791 StartCell.Player := Player;
792 StartCell.Power := Player.StartUnits;
793 end;
794 end;
795 PlayerMap.CheckVisibility;
796 Inc(I);
797 end;
798 if Players.Count > 0 then CurrentPlayer := Players[0]
799 else CurrentPlayer := nil;
800
801 ComputePlayerStats;
802end;
803
804procedure TGame.EndGame(Winner: TPlayer = nil);
805begin
806 Running := False;
807 if Assigned(OnWin) then OnWin(Winner);
808end;
809
810end.
Note: See TracBrowser for help on using the repository browser.