Changeset 147


Ignore:
Timestamp:
Nov 12, 2017, 4:29:53 PM (7 years ago)
Author:
chronos
Message:
  • Modified: Implemented better algorithm for initialization of players start cell to maintain minimal distance between players.
Location:
trunk
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • trunk/Languages/xtactics.cs.po

    r145 r147  
    621621msgstr "Člověk"
    622622
    623 #: ugame.scannotsetplayerstartcells
    624 msgid "Cannot choose start cell for player"
    625 msgstr "Nelze vybrat počáteční buňky hráčů."
    626 
    627623#: ugame.scomputer
    628624msgctxt "ugame.scomputer"
  • trunk/Languages/xtactics.po

    r145 r147  
    599599msgstr ""
    600600
    601 #: ugame.scannotsetplayerstartcells
    602 msgid "Cannot choose start cell for player"
    603 msgstr ""
    604 
    605601#: ugame.scomputer
    606602msgctxt "ugame.scomputer"
  • trunk/UGame.pas

    r146 r147  
    5858    NeighborsId: array of Integer;
    5959    Neighbors: TCells;
    60     Mark: Boolean;
     60    Mark: Boolean; // Temporary value
     61    Weight: Integer; // Temporary value
    6162    Links: TCellLinks;
     63    function NeighboringToVoid: Boolean;
    6264    procedure AreaExtend;
    6365    procedure FixRefId;
     
    8486    procedure FixRefId;
    8587    function FindById(Id: Integer): TCell;
     88    procedure GetCellsWithWeight(List: TCells; Low, High: Integer);
    8689    procedure LoadFromNode(Node: TDOMNode);
    8790    procedure SaveToNode(Node: TDOMNode);
    8891    procedure ClearMark;
     92    procedure ClearWeight;
    8993  end;
    9094
     
    418422    procedure InitClients;
    419423    procedure SelectPlayerStartCell(Player: TPlayer);
     424    procedure CalculatePlayersDistance;
     425    procedure PropagatePlayerDistance(List: TCells);
    420426  public
    421427    Players: TPlayers;
     
    488494  SHuman = 'Human';
    489495  SComputer = 'Computer';
    490   SCannotSetPlayerStartCells = 'Cannot choose start cell for player';
    491496  SWrongFileFormat = 'Wrong file format';
    492497  SUnfinishedBattle = 'Unfinished battle';
     
    774779procedure TMapArea.GetBorderCells(List: TCells);
    775780var
    776   I: Integer;
    777   J: Integer;
    778   NeighVoidCount: Integer;
     781  Cell: TCell;
    779782begin
    780783  List.Clear;
    781 
    782784  Map.Cells.ClearMark;
    783 
    784   for I := 0 to Cells.Count - 1 do
    785   with TCell(Cells[I]) do begin
    786     NeighVoidCount := 0;
    787     for J := 0 to Neighbors.Count - 1 do
    788     with TCell(Neighbors[J]) do
    789       if (Terrain = ttVoid) then Inc(NeighVoidCount);
    790 
    791     if (NeighVoidCount > 0) and (Area = Self) and (not Mark) then begin
    792         List.Add(TCell(Self.Cells[I]));
    793         Mark := True;
    794       end;
     785  for Cell in Cells do begin
     786    if Cell.NeighboringToVoid and (Cell.Area = Self) and (not Cell.Mark) then begin
     787      List.Add(Cell);
     788      Cell.Mark := True;
     789    end;
    795790  end;
    796791end;
     
    10651060end;
    10661061
     1062procedure TCells.GetCellsWithWeight(List: TCells; Low, High: Integer);
     1063var
     1064  Cell: TCell;
     1065begin
     1066  List.Clear;
     1067  for Cell in Self do
     1068    if (Cell.Terrain <> ttVoid) and (Cell.Weight >= Low) and
     1069      (Cell.Weight <= High) then List.Add(Cell);
     1070end;
     1071
    10671072procedure TCells.LoadFromNode(Node: TDOMNode);
    10681073var
     
    10961101procedure TCells.ClearMark;
    10971102var
    1098   I: Integer;
    1099 begin
    1100   for I := 0 to Count - 1 do
    1101     TCell(Items[I]).Mark := False;
     1103  Cell: TCell;
     1104begin
     1105  for Cell in Self do Cell.Mark := False;
     1106end;
     1107
     1108procedure TCells.ClearWeight;
     1109var
     1110  Cell: TCell;
     1111begin
     1112  for Cell in Self do Cell.Weight := 0;
    11021113end;
    11031114
     
    16741685end;
    16751686
     1687function TCell.NeighboringToVoid: Boolean;
     1688var
     1689  NeighVoidCount: Integer;
     1690  NeighborCell: TCell;
     1691begin
     1692  NeighVoidCount := 0;
     1693  for NeighborCell in Neighbors do
     1694    if (NeighborCell.Terrain = ttVoid) then Inc(NeighVoidCount);
     1695  Result := NeighVoidCount > 0;
     1696end;
     1697
    16761698procedure TCell.SetArea(AValue: TMapArea);
    16771699begin
     
    16841706procedure TCell.AreaExtend;
    16851707var
    1686   I: Integer;
    1687 begin
    1688   for I := 0 to Neighbors.Count - 1 do
    1689   with TCell(Neighbors[I]) do
    1690   if (Terrain <> ttVoid) and (not Assigned(Area)) then begin
    1691     Area := Self.Area;
    1692     AreaExtend;
     1708  NeighborCell: TCell;
     1709begin
     1710  for NeighborCell in Neighbors do
     1711  if (NeighborCell.Terrain <> ttVoid) and (not Assigned(NeighborCell.Area)) then begin
     1712    NeighborCell.Area := Area;
     1713    NeighborCell.AreaExtend;
    16931714  end;
    16941715end;
     
    17021723  Neighbors.Count := Length(NeighborsId);
    17031724  for I := 0 to Length(NeighborsId) - 1 do begin
    1704      Neighbors[I] := Map.Cells.FindById(NeighborsId[I]);
     1725    Neighbors[I] := Map.Cells.FindById(NeighborsId[I]);
    17051726  end;
    17061727end;
     
    27512772      FoundCell2 := SearchDifferentCellArea(List, FoundCell1.Area, TMapArea(Map.Areas[I]));
    27522773      if Assigned(FoundCell2) then begin
    2753         // Check if link not exists already
     2774        // Check if link doesn't exist already
    27542775        if not Assigned(FoundCell1.Links.FindByCells(FoundCell1, FoundCell2)) then begin
    27552776          NewLink := TCellLink.Create;
     
    27882809  with TCell(Map.Cells[C]) do
    27892810  if (Terrain <> ttVoid) and (not Assigned(Area)) then begin
    2790     NewArea := TMapArea(Map.Areas[Map.Areas.Add(TMapArea.Create)]);
     2811    NewArea := TMapArea.Create;
    27912812    NewArea.Id := Map.Areas.Count;
    27922813    NewArea.Map := Map;
     2814    Map.Areas.Add(NewArea);
    27932815    Area := NewArea;
    27942816    AreaExtend;
     
    28202842procedure TGame.SelectPlayerStartCell(Player: TPlayer);
    28212843var
    2822   Counter: Integer;
     2844  LongestDistance: Integer;
     2845  Cell: TCell;
     2846  List: TCells;
    28232847begin
    28242848  with Player do begin
    2825     // Try to obtain start cell for each player
    2826     StartCell := nil;
    2827     Counter := 0;
    2828     while not Assigned(StartCell) or Assigned(StartCell.Player) or
    2829     (StartCell.Terrain = ttVoid) do begin
    2830       StartCell := TCell(Map.Cells[Random(Map.Cells.Count)]);
    2831       Inc(Counter);
    2832       if Counter > 100 then
    2833         raise Exception.Create(SCannotSetPlayerStartCells);
    2834     end;
    2835   end;
     2849    Map.Cells.ClearMark;
     2850    Map.Cells.ClearWeight;
     2851    CalculatePlayersDistance;
     2852
     2853    // Calculate longest distance
     2854    LongestDistance := 0;
     2855    for Cell in Map.Cells do
     2856      if (Cell.Terrain <> ttVoid) and (Cell.Weight > LongestDistance) then
     2857        LongestDistance := Cell.Weight;
     2858
     2859    List := TCells.Create;
     2860    List.FreeObjects := False;
     2861    Map.Cells.GetCellsWithWeight(List, Round(LongestDistance * 0.6), Round(LongestDistance * 0.8));
     2862    StartCell := List[Random(List.Count)];
     2863    FreeAndNil(List);
     2864  end;
     2865end;
     2866
     2867procedure TGame.CalculatePlayersDistance;
     2868var
     2869  Player: TPlayer;
     2870  List: TCells;
     2871begin
     2872  for Player in Players do
     2873  if Assigned(Player.StartCell) then begin
     2874    Player.StartCell.Weight := 1;
     2875    Player.StartCell.Mark := True;
     2876    List := TCells.Create;
     2877    List.FreeObjects := False;
     2878    List.Add(Player.StartCell);
     2879    PropagatePlayerDistance(List);
     2880    FreeAndNil(List);
     2881  end;
     2882end;
     2883
     2884procedure TGame.PropagatePlayerDistance(List: TCells);
     2885var
     2886  NeighborCell: TCell;
     2887  NeighborList: TCells;
     2888  Cell: TCell;
     2889begin
     2890  NeighborList := TCells.Create;
     2891  NeighborList.FreeObjects := False;
     2892
     2893  for Cell in List do begin
     2894    for NeighborCell in Cell.Neighbors do begin
     2895      if (NeighborCell.Terrain <> ttVoid) and
     2896        ((not NeighborCell.Mark) or (NeighborCell.Weight > Cell.Weight + 1)) then begin
     2897        NeighborCell.Weight := Cell.Weight + 1;
     2898        NeighborCell.Mark := True;
     2899        NeighborList.Add(NeighborCell);
     2900      end;
     2901    end;
     2902  end;
     2903  if NeighborList.Count > 0 then
     2904    PropagatePlayerDistance(NeighborList);
     2905  FreeAndNil(NeighborList);
    28362906end;
    28372907
     
    31493219  C: Integer;
    31503220  LastAreaCount: Integer;
     3221  Player: TPlayer;
    31513222begin
    31523223  FileName := SNewGameFile;
     
    31773248  end;
    31783249
    3179   for I := 0 to Players.Count - 1 do
    3180   with TPlayer(Players[I]) do begin
     3250  for Player in Players do Player.StartCell := nil;
     3251  I := 0;
     3252  for Player in Players do
     3253  with Player do begin
    31813254    Clear;
    31823255    PlayerMap.Update;
    31833256    if (Map.Size.X > 0) and (Map.Size.Y > 0) then begin
    3184       SelectPlayerStartCell(TPlayer(Players[I]));
     3257      SelectPlayerStartCell(Player);
    31853258      if SymetricMap and (I = 1) then
    31863259        StartCell := TCell(Map.Cells[Map.Cells.Count - 1 - Map.Cells.IndexOf(TPlayer(Players[0]).StartCell)]);
    31873260
    31883261      StartCell.Terrain := ttCity;
    3189       StartCell.Player := TPlayer(Players[I]);
    3190       StartCell.Power := TPlayer(Players[I]).StartUnits;
     3262      StartCell.Player := Player;
     3263      StartCell.Power := Player.StartUnits;
    31913264    end;
    31923265    PlayerMap.CheckVisibility;
     3266    Inc(I);
    31933267  end;
    31943268  if Players.Count > 0 then CurrentPlayer := TPlayer(Players[0])
  • trunk/xtactics.lpi

    r145 r147  
    277277        <StackChecks Value="True"/>
    278278      </Checks>
     279      <VerifyObjMethodCallValidity Value="True"/>
    279280    </CodeGeneration>
    280281    <Linking>
Note: See TracChangeset for help on using the changeset viewer.