Changeset 147

Timestamp:

Nov 12, 2017, 4:29:53 PM (6 years ago)

Author:

chronos

Message:

• Modified: Implemented better algorithm for initialization of players start cell to maintain minimal distance between players.

Location:

trunk

Files:

• Languages/xtactics.cs.po (modified) (1 diff)
• Languages/xtactics.po (modified) (1 diff)
• UGame.pas (modified) (15 diffs)
• xtactics.lpi (modified) (1 diff)

trunk/Languages/xtactics.cs.po

@@ -621 +621 @@
 msgstr "Člověk"
 
-#: ugame.scannotsetplayerstartcells
-msgid "Cannot choose start cell for player"
-msgstr "Nelze vybrat počáteční buňky hráčů."
-
 #: ugame.scomputer
 msgctxt "ugame.scomputer"

trunk/Languages/xtactics.po

@@ -599 +599 @@
 msgstr ""
 
-#: ugame.scannotsetplayerstartcells
-msgid "Cannot choose start cell for player"
-msgstr ""
-
 #: ugame.scomputer
 msgctxt "ugame.scomputer"

trunk/UGame.pas

@@ -58 +58 @@
     NeighborsId: array of Integer;
     Neighbors: TCells;
-    Mark: Boolean;
+    Mark: Boolean; // Temporary value
+    Weight: Integer; // Temporary value
     Links: TCellLinks;
+    function NeighboringToVoid: Boolean;
     procedure AreaExtend;
     procedure FixRefId;
@@ -84 +86 @@
     procedure FixRefId;
     function FindById(Id: Integer): TCell;
+    procedure GetCellsWithWeight(List: TCells; Low, High: Integer);
     procedure LoadFromNode(Node: TDOMNode);
     procedure SaveToNode(Node: TDOMNode);
     procedure ClearMark;
+    procedure ClearWeight;
   end;
 
@@ -418 +422 @@
     procedure InitClients;
     procedure SelectPlayerStartCell(Player: TPlayer);
+    procedure CalculatePlayersDistance;
+    procedure PropagatePlayerDistance(List: TCells);
   public
     Players: TPlayers;
@@ -488 +494 @@
   SHuman = 'Human';
   SComputer = 'Computer';
-  SCannotSetPlayerStartCells = 'Cannot choose start cell for player';
   SWrongFileFormat = 'Wrong file format';
   SUnfinishedBattle = 'Unfinished battle';
@@ -774 +779 @@
 procedure TMapArea.GetBorderCells(List: TCells);
 var
-  I: Integer;
-  J: Integer;
-  NeighVoidCount: Integer;
+  Cell: TCell;
 begin
   List.Clear;
-
   Map.Cells.ClearMark;
-
-  for I := 0 to Cells.Count - 1 do
-  with TCell(Cells[I]) do begin
-    NeighVoidCount := 0;
-    for J := 0 to Neighbors.Count - 1 do
-    with TCell(Neighbors[J]) do
-      if (Terrain = ttVoid) then Inc(NeighVoidCount);
-
-    if (NeighVoidCount > 0) and (Area = Self) and (not Mark) then begin
-        List.Add(TCell(Self.Cells[I]));
-        Mark := True;
-      end;
+  for Cell in Cells do begin
+    if Cell.NeighboringToVoid and (Cell.Area = Self) and (not Cell.Mark) then begin
+      List.Add(Cell);
+      Cell.Mark := True;
+    end;
   end;
 end;
@@ -1065 +1060 @@
 end;
 
+procedure TCells.GetCellsWithWeight(List: TCells; Low, High: Integer);
+var
+  Cell: TCell;
+begin
+  List.Clear;
+  for Cell in Self do
+    if (Cell.Terrain <> ttVoid) and (Cell.Weight >= Low) and
+      (Cell.Weight <= High) then List.Add(Cell);
+end;
+
 procedure TCells.LoadFromNode(Node: TDOMNode);
 var
@@ -1096 +1101 @@
 procedure TCells.ClearMark;
 var
-  I: Integer;
-begin
-  for I := 0 to Count - 1 do
-    TCell(Items[I]).Mark := False;
+  Cell: TCell;
+begin
+  for Cell in Self do Cell.Mark := False;
+end;
+
+procedure TCells.ClearWeight;
+var
+  Cell: TCell;
+begin
+  for Cell in Self do Cell.Weight := 0;
 end;
 
@@ -1674 +1685 @@
 end;
 
+function TCell.NeighboringToVoid: Boolean;
+var
+  NeighVoidCount: Integer;
+  NeighborCell: TCell;
+begin
+  NeighVoidCount := 0;
+  for NeighborCell in Neighbors do
+    if (NeighborCell.Terrain = ttVoid) then Inc(NeighVoidCount);
+  Result := NeighVoidCount > 0;
+end;
+
 procedure TCell.SetArea(AValue: TMapArea);
 begin
@@ -1684 +1706 @@
 procedure TCell.AreaExtend;
 var
-  I: Integer;
-begin
-  for I := 0 to Neighbors.Count - 1 do
-  with TCell(Neighbors[I]) do
-  if (Terrain <> ttVoid) and (not Assigned(Area)) then begin
-    Area := Self.Area;
-    AreaExtend;
+  NeighborCell: TCell;
+begin
+  for NeighborCell in Neighbors do
+  if (NeighborCell.Terrain <> ttVoid) and (not Assigned(NeighborCell.Area)) then begin
+    NeighborCell.Area := Area;
+    NeighborCell.AreaExtend;
   end;
 end;
@@ -1702 +1723 @@
   Neighbors.Count := Length(NeighborsId);
   for I := 0 to Length(NeighborsId) - 1 do begin
-     Neighbors[I] := Map.Cells.FindById(NeighborsId[I]);
+    Neighbors[I] := Map.Cells.FindById(NeighborsId[I]);
   end;
 end;
@@ -2751 +2772 @@
       FoundCell2 := SearchDifferentCellArea(List, FoundCell1.Area, TMapArea(Map.Areas[I]));
       if Assigned(FoundCell2) then begin
-        // Check if link not exists already
+        // Check if link doesn't exist already
         if not Assigned(FoundCell1.Links.FindByCells(FoundCell1, FoundCell2)) then begin
           NewLink := TCellLink.Create;
@@ -2788 +2809 @@
   with TCell(Map.Cells[C]) do
   if (Terrain <> ttVoid) and (not Assigned(Area)) then begin
-    NewArea := TMapArea(Map.Areas[Map.Areas.Add(TMapArea.Create)]);
+    NewArea := TMapArea.Create;
     NewArea.Id := Map.Areas.Count;
     NewArea.Map := Map;
+    Map.Areas.Add(NewArea);
     Area := NewArea;
     AreaExtend;
@@ -2820 +2842 @@
 procedure TGame.SelectPlayerStartCell(Player: TPlayer);
 var
-  Counter: Integer;
+  LongestDistance: Integer;
+  Cell: TCell;
+  List: TCells;
 begin
   with Player do begin
-    // Try to obtain start cell for each player
-    StartCell := nil;
-    Counter := 0;
-    while not Assigned(StartCell) or Assigned(StartCell.Player) or
-    (StartCell.Terrain = ttVoid) do begin
-      StartCell := TCell(Map.Cells[Random(Map.Cells.Count)]);
-      Inc(Counter);
-      if Counter > 100 then
-        raise Exception.Create(SCannotSetPlayerStartCells);
-    end;
-  end;
+    Map.Cells.ClearMark;
+    Map.Cells.ClearWeight;
+    CalculatePlayersDistance;
+
+    // Calculate longest distance
+    LongestDistance := 0;
+    for Cell in Map.Cells do
+      if (Cell.Terrain <> ttVoid) and (Cell.Weight > LongestDistance) then
+        LongestDistance := Cell.Weight;
+
+    List := TCells.Create;
+    List.FreeObjects := False;
+    Map.Cells.GetCellsWithWeight(List, Round(LongestDistance * 0.6), Round(LongestDistance * 0.8));
+    StartCell := List[Random(List.Count)];
+    FreeAndNil(List);
+  end;
+end;
+
+procedure TGame.CalculatePlayersDistance;
+var
+  Player: TPlayer;
+  List: TCells;
+begin
+  for Player in Players do
+  if Assigned(Player.StartCell) then begin
+    Player.StartCell.Weight := 1;
+    Player.StartCell.Mark := True;
+    List := TCells.Create;
+    List.FreeObjects := False;
+    List.Add(Player.StartCell);
+    PropagatePlayerDistance(List);
+    FreeAndNil(List);
+  end;
+end;
+
+procedure TGame.PropagatePlayerDistance(List: TCells);
+var
+  NeighborCell: TCell;
+  NeighborList: TCells;
+  Cell: TCell;
+begin
+  NeighborList := TCells.Create;
+  NeighborList.FreeObjects := False;
+
+  for Cell in List do begin
+    for NeighborCell in Cell.Neighbors do begin
+      if (NeighborCell.Terrain <> ttVoid) and
+        ((not NeighborCell.Mark) or (NeighborCell.Weight > Cell.Weight + 1)) then begin
+        NeighborCell.Weight := Cell.Weight + 1;
+        NeighborCell.Mark := True;
+        NeighborList.Add(NeighborCell);
+      end;
+    end;
+  end;
+  if NeighborList.Count > 0 then
+    PropagatePlayerDistance(NeighborList);
+  FreeAndNil(NeighborList);
 end;
 
@@ -3149 +3219 @@
   C: Integer;
   LastAreaCount: Integer;
+  Player: TPlayer;
 begin
   FileName := SNewGameFile;
@@ -3177 +3248 @@
   end;
 
-  for I := 0 to Players.Count - 1 do
-  with TPlayer(Players[I]) do begin
+  for Player in Players do Player.StartCell := nil;
+  I := 0;
+  for Player in Players do
+  with Player do begin
     Clear;
     PlayerMap.Update;
     if (Map.Size.X > 0) and (Map.Size.Y > 0) then begin
-      SelectPlayerStartCell(TPlayer(Players[I]));
+      SelectPlayerStartCell(Player);
       if SymetricMap and (I = 1) then
         StartCell := TCell(Map.Cells[Map.Cells.Count - 1 - Map.Cells.IndexOf(TPlayer(Players[0]).StartCell)]);
 
       StartCell.Terrain := ttCity;
-      StartCell.Player := TPlayer(Players[I]);
-      StartCell.Power := TPlayer(Players[I]).StartUnits;
+      StartCell.Player := Player;
+      StartCell.Power := Player.StartUnits;
     end;
     PlayerMap.CheckVisibility;
+    Inc(I);
   end;
   if Players.Count > 0 then CurrentPlayer := TPlayer(Players[0])

trunk/xtactics.lpi

@@ -277 +277 @@
         <StackChecks Value="True"/>
       </Checks>
+      <VerifyObjMethodCallValidity Value="True"/>
     </CodeGeneration>
     <Linking>