Changeset 407

Timestamp:

Jan 8, 2025, 10:18:12 AM (37 hours ago)

Author:

chronos

Message:

• Fixed: Cell cities were not correctly stored the saved game.
• Fixed: ItemList references were loaded by item index instead of item id.

Location:

trunk

Files:

• Building.pas (modified) (4 diffs)
• Core.pas (modified) (1 diff)
• Game.pas (modified) (9 diffs)
• Map.pas (modified) (4 diffs)
• Packages/Common/ItemList.pas (modified) (9 diffs)

trunk/Building.pas

@@ -39 +39 @@
   public
     Kind: TBuildingKind;
+    Game: TObject; // TGame
+    class function GetFields: TItemFields; override;
+    procedure GetValue(Index: Integer; out Value); override;
+    procedure SetValue(Index: Integer; var Value); override;
+    function GetReferenceList(Index: Integer): TBaseItemList; override;
     procedure Assign(Source: TItem); override;
     property MapCell: TObject read FMapCell write SetMapCell; // TMapCell;
@@ -47 +52 @@
   TBuildings = class(TItemList<TBuilding>)
     Game: TObject; // TGame;
+    function CreateItem(Name: string = ''): TBuilding; override;
+    procedure Assign(Source: TItemList<TBuilding>); override;
   end;
 
@@ -64 +71 @@
 
 uses
-  Map;
+  Map, Game;
 
 { TBuilding }
@@ -80 +87 @@
 end;
 
+class function TBuilding.GetFields: TItemFields;
+var
+  Field: TItemField;
+begin
+  Result := inherited;
+  Field := Result.AddField(2, 'Kind', SBuildingKind, dtReference);
+end;
+
+procedure TBuilding.GetValue(Index: Integer; out Value);
+begin
+  if Index = 1 then string(Value) := Name
+  else if Index = 2 then TBuildingKind(Value) := Kind
+  else inherited;
+end;
+
+procedure TBuilding.SetValue(Index: Integer; var Value);
+begin
+  if Index = 1 then Name := string(Value)
+  else if Index = 2 then Kind := TBuildingKind(Value)
+  else inherited;
+end;
+
+function TBuilding.GetReferenceList(Index: Integer): TBaseItemList;
+begin
+  if Index = 2 then Result := TGame(Game).GameSystem.BuildingKinds.BaseItemList
+  else Result := nil;
+end;
+
 procedure TBuilding.Assign(Source: TItem);
 begin
   inherited;
   Kind := TBuilding(Source).Kind;
+end;
+
+{ TBuildings }
+
+function TBuildings.CreateItem(Name: string): TBuilding;
+begin
+  Result := inherited;
+  Result.Game := Game;
+end;
+
+procedure TBuildings.Assign(Source: TItemList<TBuilding>);
+var
+  I: Integer;
+begin
+  inherited;
+  for I := 0 to Count - 1 do
+    Items[I].Game := Game;
 end;
 

trunk/Core.pas

@@ -284 +284 @@
   if not Assigned(Game.CurrentPlayer) then
     Game.CurrentPlayer := Game.Players.GetFirstHuman;
-  if Assigned(Game.CurrentPlayer) then begin
+  if Assigned(Game.CurrentPlayer) and (Game.CurrentPlayer.Mode = pmHuman) then begin
     FormMain.FormClient.Client := TClientGUI(LocalClients.SearchPlayer(Game.CurrentPlayer));
   end else begin

trunk/Game.pas

@@ -58 +58 @@
     procedure InitDefaultPlayers;
     procedure WinObjectiveMapPrepare;
+    procedure BuildCity(Cell: TCell);
   public
     GameSystem: TGameSystem;
@@ -342 +343 @@
   with Cell do begin
     if (Terrain = ttNormal) and CityEnabled and (Random < CityPercentage / 100) then begin
-      Building := Buildings.AddItem('City');
-      Building.Kind := GameSystem.BuildingKinds.FindBySpecialType(stCity);
+      BuildCity(Cell);
     end;
   end;
@@ -369 +369 @@
           StartCell := Map.Cells[Map.Cells.Count - 1 - Map.Cells.IndexOf(Players[0].StartCell)];
 
-        if CityEnabled then begin
-          StartCell.Building := Buildings.AddItem('City');
-          StartCell.Building.Kind := GameSystem.BuildingKinds.FindBySpecialType(stCity);
-        end;
+        if CityEnabled then BuildCity(StartCell);
         StartCell.Player := Player;
         if GameSystem.UnitKinds.Count > 0 then begin
@@ -497 +494 @@
 end;
 
+procedure TGame.BuildCity(Cell: TCell);
+var
+  CityBuildingKind: TBuildingKind;
+begin
+  CityBuildingKind := GameSystem.BuildingKinds.FindBySpecialType(stCity);
+  if not Assigned(CityBuildingKind) then begin
+    CityBuildingKind := GameSystem.BuildingKinds.AddItem('City');
+    CityBuildingKind.SpecialType := stCity;
+  end;
+  if not Assigned(Cell.Building) then begin
+    Cell.Building := Buildings.AddItem('City');
+    Cell.Building.Kind := CityBuildingKind;
+    Cell.Building.Game := Self;
+  end;
+end;
+
 procedure TGame.Assign(Source: TGame);
 begin
@@ -502 +515 @@
   DevelMode := Source.DevelMode;
   Players.Assign(Source.Players);
+  Buildings.Assign(Source.Buildings);
   MapType := Source.MapType;
   Map.Assign(Source.Map);
@@ -647 +661 @@
         Units.LoadFromNode(NewNode);
 
+      NewNode := FindNode('Buildings');
+      if Assigned(NewNode) then
+        Buildings.LoadFromNode(NewNode);
+
       Map.Cells.FixRefId;
       Units.FixRefId;
@@ -697 +715 @@
       Units.RecalculateItemsId;
       Players.RecalculateItemsId;
+      Buildings.RecalculateItemsId;
 
       NewNode := OwnerDocument.CreateElement('GameSystem');
@@ -713 +732 @@
       AppendChild(NewNode);
       Units.SaveToNode(NewNode);
+
+      NewNode := OwnerDocument.CreateElement('Buildings');
+      AppendChild(NewNode);
+      Buildings.SaveToNode(NewNode);
     end;
     if ExtractFileDir(FileName) <> '' then
@@ -955 +978 @@
   Map.Clear;
   Units.Clear;
+  Buildings.Clear;
 end;
 

trunk/Map.pas

@@ -48 +48 @@
     Extra: TExtraType;
     OneUnitId: Integer; // Temporary value
+    BuildingId: Integer; // Temporary value
     function Compare(Cell: TCell): Boolean;
     procedure ConnectTo(Cell: TCell);
@@ -1064 +1065 @@
   end else Player := nil;
 
+  if BuildingId <> 0 then begin
+    Building := TGame(Map.Game).Buildings.FindById(BuildingId);
+    if not Assigned(Building) then
+      raise Exception.Create('Referenced building id ' + IntToStr(BuildingId) + ' not found.');
+  end else Building := nil;
+
   if OneUnitId <> 0 then begin
     OneUnit := TGame(Map.Game).Units.FindById(OneUnitId);
@@ -1095 +1102 @@
   PosPx.Y := ReadInteger(Node, 'PosY', 0);
   PlayerId := ReadInteger(Node, 'Player', 0);
+  BuildingId := ReadInteger(Node, 'Building', 0);
 
   Node3 := Node.FindNode('Neighbours');
@@ -1135 +1143 @@
     WriteInteger(Node, 'Player', TPlayer(Player).Id)
     else WriteInteger(Node, 'Player', 0);
+  if Assigned(Building) then
+    WriteInteger(Node, 'Building', Building.Id)
+    else WriteInteger(Node, 'Building', 0);
   NewNode := Node.OwnerDocument.CreateElement('Neighbours');
   Node.AppendChild(NewNode);

trunk/Packages/Common/ItemList.pas

@@ -83 +83 @@
   public
   type
-    TAddEvent = function (constref AValue: TItem): SizeInt of object;
+    TAddEvent = function(constref AValue: TItem): SizeInt of object;
     TGetCountEvent = function: SizeInt of object;
     TSetItemEvent = procedure(Index: SizeInt; AValue: TItem) of object;
-    TGetNameEvent = procedure (out Name: string) of object;
+    TGetNameEvent = procedure(out Name: string) of object;
     TGetItemEvent = function(Index: SizeInt): TItem of object;
     TGetItemFieldsEvent = function: TItemFields of object;
     TRemoveEvent = function(constref AValue: TItem): SizeInt of object;
-    TGetNextAvailableNameEvent = procedure (Name: string; out NewName: string) of object;
+    TGetNextAvailableNameEvent = procedure(Name: string; out NewName: string) of object;
     TCreateItemEvent = function(Name: string = ''): TItem of object;
+    TFindByIdEvent = function(Id: Integer): TItem of object;
   private
     FOnAdd: TAddEvent;
     FOnCreateItem: TCreateItemEvent;
+    FOnFindById: TFindByIdEvent;
     FOnGetCount: TGetCountEvent;
     FOnGetItem: TGetItemEvent;
@@ -112 +114 @@
     function GetNextAvailableName(Name: string): string;
     function GetItemFields: TItemFields;
+    function FindById(Id: Integer): TItem;
     property Count: SizeInt read GetCount;
     property Items[Index: SizeInt]: TItem read GetItem write SetItem; default;
@@ -125 +128 @@
     property OnCreateItem: TCreateItemEvent read FOnCreateItem
       write FOnCreateItem;
+    property OnFindById: TFindByIdEvent read FOnFindById
+      write FOnFindById;
   end;
 
@@ -141 +146 @@
     function BaseGetItemFields: TItemFields;
     function BaseCreateItem(Name: string = ''): TItem;
+    function BaseFindById(Id: Integer): TItem;
     procedure BaseGetNextAvailableName(Name: string; out NewName: string);
   public
@@ -245 +251 @@
 end;
 
+function TItemList<T>.BaseFindById(Id: Integer): TItem;
+begin
+  Result := FindById(Id);
+end;
+
 procedure TItemList<T>.LoadFromNode(Node: TDOMNode);
 var
@@ -286 +297 @@
   FBaseItemList.OnGetNextAvailableName := BaseGetNextAvailableName;
   FBaseItemList.OnGetName := BaseGetName;
+  FBaseItemList.OnFindById := BaseFindById;
   NewId := 1;
 end;
@@ -483 +495 @@
   ReadId: Integer;
   ReferenceList: TBaseItemList;
+  RefItem: TItem;
 begin
   if Field.DataType = dtString then begin
@@ -503 +516 @@
     ReferenceList := GetReferenceList(Field.Index);
     if (ReadId > 0) and Assigned(ReferenceList) then
-      SetValueReference(Field.Index, TItem(ReferenceList[ReadId]));
+      RefItem := ReferenceList.FindById(ReadId);
+      if Assigned(RefItem) then
+        SetValueReference(Field.Index, RefItem)
+        else raise Exception.Create('Reference id ' + IntToStr(ReadId) + ' not found.');
   end else
     raise Exception.Create(Format(SUnsupportedDataType, [DataTypeStr[Field.DataType]]));
@@ -817 +833 @@
 end;
 
+function TBaseItemList.FindById(Id: Integer): TItem;
+begin
+  if Assigned(FOnFindById) then Result := FOnFindById(Id)
+    else raise Exception.Create('Undefined FindById handler');
+end;
+
 end.