Changeset 342 for trunk

Timestamp:

Dec 22, 2024, 10:52:26 AM (10 hours ago)

Author:

chronos

Message:

• Added: More tests.

Location:

trunk

Files:

• Game.pas (modified) (8 diffs)
• GameSystem.pas (modified) (3 diffs)
• ItemList.pas (modified) (7 diffs)
• Map.pas (modified) (3 diffs)
• Player.pas (modified) (1 diff)
• Tests.pas (modified) (4 diffs)
• Units.pas (moved) (moved from trunk/Unit.pas ) (1 diff)
• xtactics.lpi (modified) (1 diff)

trunk/Game.pas

@@ -6 +6 @@
   Classes, SysUtils, ExtCtrls, Graphics, XMLConf, XMLRead, XMLWrite, Forms,
   DOM, Math, LazFileUtils, XML, Dialogs, LCLType, LCLIntf, Building, Geometry,
-  Player, Map, MapType, &Unit, GameSystem;
+  Player, Map, MapType, Units, GameSystem;
 
 const
@@ -49 +49 @@
     procedure SetRunning(AValue: Boolean);
     procedure BuildTerrain;
+    procedure PlaceUnits;
     procedure PlaceCities;
     procedure InitPlayers;
@@ -91 +92 @@
     procedure LoadFromFile(FileName: string);
     procedure SaveToFile(FileName: string);
+    function ToString: string; override;
     procedure ComputePlayerStats;
     procedure NextPlayer;
@@ -301 +303 @@
     (Map.IsOutsideShape(PosPx)) then Terrain := ttVoid
       else Terrain := ttNormal;
+  end;
+end;
+
+procedure TGame.PlaceUnits;
+var
+  Cell: TCell;
+  NewPower: Integer;
+begin
+  if GameSystem.UnitKinds.Count = 0 then Exit;
+
+  for Cell in Map.Cells do
+  with Cell do begin
     NewPower := Random(MaxNeutralUnits + 1);
     if (NewPower > 0) and not Assigned(OneUnit) then begin
@@ -348 +362 @@
         end;
         StartCell.Player := Player;
-        if not Assigned(StartCell.OneUnit) then
-          StartCell.OneUnit := Self.Units.AddNew(TUnitKind(GameSystem.UnitKinds[0]), Player.StartUnits);
-        StartCell.OneUnit.Power := Player.StartUnits;
-        StartCell.OneUnit.Kind := TUnitKind(GameSystem.UnitKinds[0]);
-        StartCell.OneUnit.Player := Player;
+        if GameSystem.UnitKinds.Count > 0 then begin
+          if not Assigned(StartCell.OneUnit) then
+            StartCell.OneUnit := Self.Units.AddNew(TUnitKind(GameSystem.UnitKinds[0]), Player.StartUnits);
+          StartCell.OneUnit.Power := Player.StartUnits;
+          StartCell.OneUnit.Kind := TUnitKind(GameSystem.UnitKinds[0]);
+          StartCell.OneUnit.Player := Player;
+        end;
       end;
     end;
@@ -694 +710 @@
 end;
 
+function TGame.ToString: string;
+begin
+  Result := 'StoredRandSeed: ' + IntToStr(StoredRandSeed) + LineEnding;
+  Result := Result + 'MapType: ' + IntToStr(Integer(MapType)) + LineEnding;
+  Result := Result + 'SymetricMap: ' + BoolToStr(SymetricMap) + LineEnding;
+  Result := Result + 'CyclicMap: ' + BoolToStr(CyclicMap) + LineEnding;
+  Result := Result + 'FogOfWar: ' + BoolToStr(FogOfWar) + LineEnding;
+  Result := Result + 'VoidEnabled: ' + BoolToStr(VoidEnabled) + LineEnding;
+  Result := Result + 'VoidPercentage: ' + IntToStr(VoidPercentage) + LineEnding;
+  Result := Result + 'MaxNeutralUnits: ' + IntToStr(MaxNeutralUnits) + LineEnding;
+  Result := Result + 'MaxPower: ' + IntToStr(MaxPower) + LineEnding;
+  Result := Result + 'GrowCells: ' + IntToStr(Integer(GrowCells)) + LineEnding;
+  Result := Result + 'GrowAmount: ' + IntToStr(Integer(GrowAmount)) + LineEnding;
+  Result := Result + 'CityEnabled: ' + BoolToStr(CityEnabled) + LineEnding;
+  Result := Result + 'CityPercentage: ' + IntToStr(CityPercentage) + LineEnding;
+  Result := Result + 'BridgeEnabled: ' + BoolToStr(BridgeEnabled) + LineEnding;
+  Result := Result + 'TurnCounter: ' + IntToStr(TurnCounter) + LineEnding;
+  Result := Result + 'WinObjective: ' + IntToStr(Integer(WinObjective)) + LineEnding;
+  Result := Result + 'StayAliveForDefinedTurns: ' + IntToStr(StayAliveForDefinedTurns) + LineEnding;
+  Result := Result + 'Running: ' + BoolToStr(Running) + LineEnding;
+  Result := Result + 'GameSystem: ' + LineEnding + GameSystem.ToString + LineEnding;
+  Result := Result + 'Map: ' + LineEnding + Map.ToString + LineEnding;
+  Result := Result + 'Players: ' + LineEnding + Players.ToString + LineEnding;
+  Result := Result + 'Units: ' + LineEnding + Units.ToString + LineEnding;
+end;
+
 procedure TGame.ComputePlayerStats;
 var
@@ -905 +947 @@
   Map.MaxPower := MaxPower;
   BuildTerrain;
+  PlaceUnits;
   PlaceCities;
   WinObjectiveMapPrepare;
@@ -931 +974 @@
 function TGame.Compare(Game: TGame): Boolean;
 begin
-  Result := BridgeEnabled = Game.BridgeEnabled;
+  Result := (StoredRandSeed = Game.StoredRandSeed) and
+    (DevelMode = Game.DevelMode) and
+    Players.Compare(Game.Players) and
+    (MapType = Game.MapType) and
+    Map.Compare(Game.Map) and
+    (MapImageFileName = Game.MapImageFileName) and
+    (VoidEnabled = Game.VoidEnabled) and
+    (VoidPercentage = Game.VoidPercentage) and
+    (SymetricMap = Game.SymetricMap) and
+    (CyclicMap = Game.CyclicMap) and
+    (GrowCells = Game.GrowCells) and
+    (GrowAmount = Game.GrowAmount) and
+    (CityEnabled = Game.CityEnabled) and
+    (CityPercentage = Game.CityPercentage) and
+    (TurnCounter = Game.TurnCounter) and
+    (WinObjective = Game.WinObjective) and
+    (SpecialCaptureCellCount = Game.SpecialCaptureCellCount) and
+    (StayAliveForDefinedTurns = Game.StayAliveForDefinedTurns) and
+    (MaxNeutralUnits = Game.MaxNeutralUnits) and
+    (FileName = Game.FileName) and
+    (FogOfWar = Game.FogOfWar) and
+    (BridgeEnabled = Game.BridgeEnabled) and
+    (MaxPower = Game.MaxPower) and
+    GameSystem.Compare(Game.GameSystem);
 end;
 

trunk/GameSystem.pas

@@ -4 +4 @@
 
 uses
-  Classes, SysUtils, Generics.Collections, &Unit, DOM, XMLRead, XMLWrite, XML,
+  Classes, SysUtils, Generics.Collections, Units, DOM, XMLRead, XMLWrite, XML,
   XMLConf, FileUtil, LazFileUtils, MapType, Nation, Building, ItemList, UnitKind;
 
@@ -27 +27 @@
     function GetName: string;
     procedure Assign(Source: TGameSystem);
+    function Compare(GameSystem: TGameSystem): Boolean;
     procedure LoadFromNode(Node: TDOMNode);
     procedure SaveToNode(Node: TDOMNode);
@@ -133 +134 @@
   BuildingKinds.Assign(Source.BuildingKinds);
   Nations.Assign(Source.Nations);
+end;
+
+function TGameSystem.Compare(GameSystem: TGameSystem): Boolean;
+begin
+  Result := (FileName = GameSystem.FileName) and
+    (UnitsMoveImmediately = GameSystem.UnitsMoveImmediately) and
+    (MaxPlayerCount = GameSystem.MaxPlayerCount) and
+    (UnitsSplitMerge = GameSystem.UnitsSplitMerge) and
+    (EmptyCellsNeutral = GameSystem.EmptyCellsNeutral) and
+    (PreferedMapType = GameSystem.PreferedMapType); // and
+    //(UnitKinds.Assign(GameSystem.UnitKinds) and
+    //(BuildingKinds.Assign(GameSystem.BuildingKinds) and
+    //(Nations.Assign(GameSystem.Nations);
 end;
 

trunk/ItemList.pas

@@ -41 +41 @@
   private
     procedure AssignValue(Source: TItem; Field: TItemField);
+    function CompareValue(Item: TItem; Field: TItemField): Boolean;
     procedure LoadValueFromNode(Node: TDOMNode; Field: TItemField); virtual;
     procedure SaveValueToNode(Node: TDOMNode; Field: TItemField); virtual;
@@ -64 +65 @@
     procedure SetValueReference(Index: Integer; Value: TItem);
     procedure Assign(Source: TItem); virtual;
+    function Compare(Item: TItem): Boolean; virtual;
+    function ToString: string; override;
     procedure LoadFromNode(Node: TDOMNode); virtual;
     procedure SaveToNode(Node: TDOMNode); virtual;
@@ -88 +91 @@
     function FindByName(Name: string): TItem;
     function GetNewId: Integer;
+    function ToString: string; override;
     procedure Assign(Source: TItemList); virtual;
+    function Compare(ItemList: TItemList): Boolean; virtual;
     function AddItem(Name: string = ''): TItem; virtual;
     function CreateItem(Name: string = ''): TItem; virtual;
@@ -150 +155 @@
 end;
 
+function TItemList.Compare(ItemList: TItemList): Boolean;
+var
+  I: Integer;
+begin
+  Result := Count = ItemList.Count;
+  if not Result then Exit;
+  for I := 0 to Count - 1 do begin
+    Result := Result and TItem(Items[I]).Compare(ItemList.Items[I]);
+    if not Result then Break;
+  end;
+end;
+
 function TItemList.AddItem(Name: string): TItem;
 begin
@@ -269 +286 @@
 end;
 
+function TItemList.ToString: string;
+var
+  I: Integer;
+begin
+  Result := '';
+  for I := 0 to Count - 1 do
+  with TItem(Items[I]) do begin
+    Result := Result + ToString + LineEnding;
+  end;
+end;
+
 { TItemFields }
 
@@ -312 +340 @@
   if Field.DataType = dtReference then begin
     SetValueReference(Field.Index, Source.GetValueReference(Field.Index));
+  end else
+    raise Exception.Create(Format(SUnsupportedDataType, [DataTypeStr[Field.DataType]]));
+end;
+
+function TItem.CompareValue(Item: TItem; Field: TItemField): Boolean;
+begin
+  if Field.DataType = dtString then begin
+    Result := GetValueString(Field.Index) = Item.GetValueString(Field.Index);
+  end else
+  if Field.DataType = dtColor then begin
+    Result := GetValueColor(Field.Index) = Item.GetValueColor(Field.Index);
+  end else
+  if Field.DataType = dtInteger then begin
+    Result := GetValueInteger(Field.Index) = Item.GetValueInteger(Field.Index);
+  end else
+  if Field.DataType = dtBoolean then begin
+    Result := GetValueBoolean(Field.Index) = Item.GetValueBoolean(Field.Index);
+  end else
+  if Field.DataType = dtEnumeration then begin
+    Result := GetValueEnumeration(Field.Index) = Item.GetValueEnumeration(Field.Index);
+  end else
+  if Field.DataType = dtReference then begin
+    Result := GetValueReference(Field.Index) = Item.GetValueReference(Field.Index);
   end else
     raise Exception.Create(Format(SUnsupportedDataType, [DataTypeStr[Field.DataType]]));
@@ -503 +554 @@
 end;
 
+function TItem.Compare(Item: TItem): Boolean;
+var
+  I: Integer;
+  Fields: TItemFields;
+begin
+  Result := True;
+  Result := Result and (Id = Item.Id);
+  if Item is ClassType then begin
+    Fields := GetFields;
+    try
+      for I := 0 to Fields.Count - 1 do begin
+        Result := Result and CompareValue(Item, Fields[I]);
+        if not Result then Break;
+      end;
+    finally
+      Fields.Free;
+    end;
+  end;
+end;
+
+function TItem.ToString: string;
+var
+  Fields: TItemFields;
+  I: Integer;
+begin
+  Result := 'Id: ' + IntToStr(Id) + LineEnding;
+  Fields := GetFields;
+  try
+    for I := 0 to Fields.Count - 1 do begin
+      Result := Result + Fields[I].SysName + ': ' + GetValueAsText(Fields[I].Index) + LineEnding;
+    end;
+  finally
+    Fields.Free;
+  end;
+end;
+
 procedure TItem.LoadFromNode(Node: TDOMNode);
 var

trunk/Map.pas

@@ -5 +5 @@
 uses
   Classes, SysUtils, Graphics, ExtCtrls, Geometry, DOM, Generics.Collections,
-  Generics.Defaults, Building, XML, &Unit;
+  Generics.Defaults, Building, XML, Units;
 
 const
@@ -162 +162 @@
     function IsValidIndex(Index: TPoint): Boolean; virtual;
     procedure Assign(Source: TMap); virtual;
+    function Compare(Map: TMap): Boolean;
     procedure LoadFromFile(FileName: string); virtual;
     procedure SaveToFile(FileName: string); virtual;
@@ -539 +540 @@
 end;
 
+function TMap.Compare(Map: TMap): Boolean;
+begin
+  Result := True;
+end;
+
 procedure TMap.LoadFromFile(FileName: string);
 begin

trunk/Player.pas

@@ -5 +5 @@
 uses
   Classes, SysUtils, Graphics, Map, DOM, Generics.Collections, Generics.Defaults,
-  XMLConf, XML, Math, Geometry, &Unit, Nation, ItemList, TurnStats;
+  XMLConf, XML, Math, Geometry, Units, Nation, ItemList, TurnStats;
 
 type

trunk/Tests.pas

@@ -17 +17 @@
   end;
 
+  { TTestCaseMap }
+
+  TTestCaseMap = class(TTestCase)
+    Game: TGame;
+    procedure Run; override;
+    constructor Create; override;
+    destructor Destroy; override;
+  end;
+
 function GetTestCases: TTestCases;
 
 
 implementation
+
+uses
+  Geometry, MapType, Map;
 
 function GetTestCases: TTestCases;
@@ -27 +39 @@
   with Result do begin
     with TTestCaseGame(AddNew('Load and save', TTestCaseGame)) do begin
-
+    end;
+    with TTestCaseMap(AddNew('Map cells connection', TTestCaseMap)) do begin
     end;
   end;
@@ -44 +57 @@
   Game2.LoadFromFile(FileName);
   Evaluate(Game2.Compare(Game));
+  Log := 'Game1: ' + LineEnding + Game.ToString + LineEnding +
+    'Game2: ' + LineEnding + Game2.ToString + LineEnding;
   Game2.Free;
 end;
@@ -59 +74 @@
 end;
 
+{ TTestCaseMap }
+
+procedure TTestCaseMap.Run;
+var
+  X, Y: Integer;
+  Connected: Boolean;
+  Cell: TCell;
+  Expected: Integer;
+const
+  Size = 10;
+begin
+  Connected := True;
+  Game.Map.Size := TPoint.Create(Size, Size);
+  Game.MapType := mtSquare;
+  Game.New;
+  for Y := 0 to Size - 1 do
+  for X := 0 to Size - 1 do begin
+    Cell := Game.Map.Cells[X + Y * Size];
+    Expected := 4;
+    if (X = 0) or (X = Size - 1) then Dec(Expected);
+    if (Y = 0) or (Y = Size - 1) then Dec(Expected);
+    if Cell.Neighbors.Count <> Expected then begin
+      Log := Log + 'Cell ' + IntToStr(X + Y * Size) + ' expected neighbors count ' +
+        IntToStr(Expected) + ' but is ' + IntToStr(Cell.Neighbors.Count) + LineEnding;
+      if not Connected then Break;
+    end;
+  end;
+  Evaluate(Connected);
+end;
+
+constructor TTestCaseMap.Create;
+begin
+  inherited;
+  Game := TGame.Create;
+end;
+
+destructor TTestCaseMap.Destroy;
+begin
+  FreeAndNil(Game);
+  inherited;
+end;
+
 end.
 

trunk/Units.pas

@@ -1 @@
-unit &Unit;
+unit Units;
 
 interface

trunk/xtactics.lpi

@@ -260 +260 @@
       </Unit26>
       <Unit27>
-        <Filename Value="Unit.pas"/>
-        <IsPartOfProject Value="True"/>
-        <UnitName Value="&amp;Unit"/>
+        <Filename Value="Units.pas"/>
+        <IsPartOfProject Value="True"/>
       </Unit27>
       <Unit28>