1 | unit UGame;
|
---|
2 |
|
---|
3 | {$mode delphi}{$H+}
|
---|
4 |
|
---|
5 | interface
|
---|
6 |
|
---|
7 | uses
|
---|
8 | Classes, SysUtils, ExtCtrls, Graphics, XMLConf, XMLRead, XMLWrite, Forms,
|
---|
9 | DOM, Math, LazFileUtils, UXMLUtils, Dialogs, LCLType, LCLIntf, fgl,
|
---|
10 | UGeometry, UPlayer, UMap, UMapType;
|
---|
11 |
|
---|
12 | const
|
---|
13 | DefaultPlayerStartUnits = 5;
|
---|
14 | MaxPlayerCount = 8;
|
---|
15 |
|
---|
16 | type
|
---|
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 |
|
---|
105 | var
|
---|
106 | PlayerModeText: array[TPlayerMode] of string;
|
---|
107 |
|
---|
108 | const
|
---|
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 |
|
---|
114 | procedure InitStrings;
|
---|
115 |
|
---|
116 | resourcestring
|
---|
117 | SPlayer = 'Player';
|
---|
118 | SSpectator = 'Spectator';
|
---|
119 |
|
---|
120 |
|
---|
121 | implementation
|
---|
122 |
|
---|
123 | resourcestring
|
---|
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 |
|
---|
131 | procedure InitStrings;
|
---|
132 | begin
|
---|
133 | PlayerModeText[pmHuman] := SHuman;
|
---|
134 | PlayerModeText[pmComputer] := SComputer;
|
---|
135 | end;
|
---|
136 |
|
---|
137 | function HalfColor(Color: TColor): TColor;
|
---|
138 | begin
|
---|
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);
|
---|
144 | end;
|
---|
145 |
|
---|
146 | { TCanvasEx }
|
---|
147 |
|
---|
148 | class procedure TCanvasEx.TextOutEx(Canvas: TCanvas; X, Y: Integer; const Text: string;
|
---|
149 | MovePen: Boolean);
|
---|
150 | var
|
---|
151 | Flags : Cardinal;
|
---|
152 | begin
|
---|
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;
|
---|
163 | end;
|
---|
164 |
|
---|
165 | class procedure TCanvasEx.PolygonEx(Canvas: TCanvas; const Points: array of Classes.TPoint; Winding: Boolean);
|
---|
166 | begin
|
---|
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;
|
---|
175 | end;
|
---|
176 |
|
---|
177 | { TGame }
|
---|
178 |
|
---|
179 | function TGame.AttackProbability(AttackCount, DefendCount: Integer): Double;
|
---|
180 | var
|
---|
181 | OA, OD: Integer;
|
---|
182 | Len: Integer;
|
---|
183 | I: Integer;
|
---|
184 | begin
|
---|
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;
|
---|
237 | end;
|
---|
238 |
|
---|
239 | procedure TGame.SetMapType(AValue: TMapType);
|
---|
240 | var
|
---|
241 | OldMap: TMap;
|
---|
242 | begin
|
---|
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;
|
---|
258 | end;
|
---|
259 |
|
---|
260 | procedure TGame.SetRunning(AValue: Boolean);
|
---|
261 | begin
|
---|
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;
|
---|
270 | end;
|
---|
271 |
|
---|
272 | procedure TGame.BuildTerrain;
|
---|
273 | var
|
---|
274 | Cell: TCell;
|
---|
275 | begin
|
---|
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;
|
---|
288 | end;
|
---|
289 |
|
---|
290 | procedure TGame.PostConfig;
|
---|
291 | begin
|
---|
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;
|
---|
297 | end;
|
---|
298 |
|
---|
299 | procedure TGame.SelectPlayerStartCell(Player: TPlayer);
|
---|
300 | var
|
---|
301 | LongestDistance: Integer;
|
---|
302 | Cell: TCell;
|
---|
303 | List: TCells;
|
---|
304 | I: Integer;
|
---|
305 | begin
|
---|
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;
|
---|
333 | end;
|
---|
334 |
|
---|
335 | procedure TGame.CalculatePlayersDistance;
|
---|
336 | var
|
---|
337 | Player: TPlayer;
|
---|
338 | List: TCells;
|
---|
339 | begin
|
---|
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;
|
---|
350 | end;
|
---|
351 |
|
---|
352 | procedure TGame.PropagatePlayerDistance(List: TCells);
|
---|
353 | var
|
---|
354 | NeighborCell: TCell;
|
---|
355 | NeighborList: TCells;
|
---|
356 | Cell: TCell;
|
---|
357 | begin
|
---|
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);
|
---|
374 | end;
|
---|
375 |
|
---|
376 | procedure TGame.InitDefaultPlayers;
|
---|
377 | begin
|
---|
378 | Players.Clear;
|
---|
379 | Players.New(SPlayer + ' 1', clBlue, pmHuman);
|
---|
380 | Players.New(SPlayer + ' 2', clRed, pmComputer);
|
---|
381 | end;
|
---|
382 |
|
---|
383 | procedure TGame.WinObjectiveMapPrepare;
|
---|
384 | var
|
---|
385 | Cell: TCell;
|
---|
386 | Cells: TCells;
|
---|
387 | I: Integer;
|
---|
388 | begin
|
---|
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;
|
---|
403 | end;
|
---|
404 |
|
---|
405 | procedure TGame.Assign(Source: TGame);
|
---|
406 | begin
|
---|
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;
|
---|
429 | end;
|
---|
430 |
|
---|
431 | procedure TGame.SaveConfig(Config: TXmlConfig; Path: string);
|
---|
432 | begin
|
---|
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;
|
---|
454 | end;
|
---|
455 |
|
---|
456 | procedure TGame.LoadConfig(Config: TXmlConfig; Path: string);
|
---|
457 | var
|
---|
458 | Value: Integer;
|
---|
459 | begin
|
---|
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;
|
---|
489 | end;
|
---|
490 |
|
---|
491 | procedure TGame.LoadFromFile(FileName: string);
|
---|
492 | var
|
---|
493 | NewNode: TDOMNode;
|
---|
494 | Doc: TXMLDocument;
|
---|
495 | RootNode: TDOMNode;
|
---|
496 | I: Integer;
|
---|
497 | begin
|
---|
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;
|
---|
545 | end;
|
---|
546 |
|
---|
547 | procedure TGame.SaveToFile(FileName: string);
|
---|
548 | var
|
---|
549 | NewNode: TDOMNode;
|
---|
550 | Doc: TXMLDocument;
|
---|
551 | RootNode: TDOMNode;
|
---|
552 | begin
|
---|
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;
|
---|
591 | end;
|
---|
592 |
|
---|
593 | procedure TGame.ComputePlayerStats;
|
---|
594 | var
|
---|
595 | I: Integer;
|
---|
596 | J: Integer;
|
---|
597 | begin
|
---|
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;
|
---|
612 | end;
|
---|
613 |
|
---|
614 | procedure TGame.RecordTurnStats;
|
---|
615 | var
|
---|
616 | I: Integer;
|
---|
617 | NewStat: TGameTurnStat;
|
---|
618 | begin
|
---|
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;
|
---|
629 | end;
|
---|
630 |
|
---|
631 | procedure TGame.NextPlayer;
|
---|
632 | var
|
---|
633 | AlivePlayers: TPlayers;
|
---|
634 | NewPlayerIndex: Integer;
|
---|
635 | begin
|
---|
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);
|
---|
672 | end;
|
---|
673 |
|
---|
674 | procedure TGame.CheckWinObjective;
|
---|
675 | var
|
---|
676 | AlivePlayers: TPlayerArray;
|
---|
677 | Winner: TPlayer;
|
---|
678 | Cells: TCells;
|
---|
679 | Player: TPlayer;
|
---|
680 | R: Boolean;
|
---|
681 | I: Integer;
|
---|
682 | begin
|
---|
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;
|
---|
720 | end;
|
---|
721 |
|
---|
722 | constructor TGame.Create;
|
---|
723 | begin
|
---|
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);
|
---|
739 | end;
|
---|
740 |
|
---|
741 | destructor TGame.Destroy;
|
---|
742 | begin
|
---|
743 | FreeAndNil(Players);
|
---|
744 | FreeAndNil(Map);
|
---|
745 | inherited Destroy;
|
---|
746 | end;
|
---|
747 |
|
---|
748 | procedure TGame.Clear;
|
---|
749 | var
|
---|
750 | I: Integer;
|
---|
751 | begin
|
---|
752 | for I := 0 to Players.Count - 1 do Players[I].Clear;
|
---|
753 | Map.Clear;
|
---|
754 | end;
|
---|
755 |
|
---|
756 | procedure TGame.New;
|
---|
757 | var
|
---|
758 | I: Integer;
|
---|
759 | Player: TPlayer;
|
---|
760 | begin
|
---|
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;
|
---|
802 | end;
|
---|
803 |
|
---|
804 | procedure TGame.EndGame(Winner: TPlayer = nil);
|
---|
805 | begin
|
---|
806 | Running := False;
|
---|
807 | if Assigned(OnWin) then OnWin(Winner);
|
---|
808 | end;
|
---|
809 |
|
---|
810 | end.
|
---|