close Warning: Can't synchronize with repository "(default)" (No changeset 184 in the repository). Look in the Trac log for more information.

Changeset 157


Ignore:
Timestamp:
Nov 16, 2017, 10:32:12 PM (6 years ago)
Author:
chronos
Message:
  • Fixed: Build cell bridges correctly if symetric map is selected.
Location:
trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • trunk/Forms/UFormMain.lfm

    r148 r157  
    3636    Height = 557
    3737    Top = 0
    38     Width = 80
     38    Width = 32
    3939    Align = alLeft
    4040    ButtonHeight = 32
     
    114114  end
    115115  object PaintBox1: TPaintBox
    116     Left = 80
     116    Left = 32
    117117    Height = 557
    118118    Top = 0
    119     Width = 695
     119    Width = 743
    120120    Align = alClient
    121121    OnMouseDown = PaintBox1MouseDown
  • trunk/UGame.pas

    r156 r157  
    9898
    9999  TCellLink = class
     100    Allocated: Boolean;
    100101    Points: array of TPoint;
    101102    Cells: TCells;
     
    179180    procedure DrawArrow(Canvas: TCanvas; View: TView; Pos: TPoint; Angle: Double;
    180181      Text: string);
     182    function SearchDifferentCellArea(List: TCells; SourceArea,
     183      DestArea: TMapArea): TCell;
    181184    procedure SetSize(AValue: TPoint); virtual;
    182185  protected
     
    205208    procedure ComputePlayerStats; virtual;
    206209    procedure Generate; virtual;
     210    procedure BuildMapAreas;
     211    procedure BuildBridges;
    207212    procedure MakeSymetric;
     213    procedure CreateLinks;
    208214    procedure Clear;
    209215    constructor Create; virtual;
     
    438444    procedure SetMapType(AValue: TMapType);
    439445    procedure SetRunning(AValue: Boolean);
    440     function SearchDifferentCellArea(List: TCells; SourceArea, DestArea: TMapArea): TCell;
    441446    procedure BuildTerrain;
    442     procedure BuildBridges;
    443     procedure BuildMapAreas;
    444447    procedure InitClients;
    445448    procedure SelectPlayerStartCell(Player: TPlayer);
     
    729732constructor TCellLink.Create;
    730733begin
     734  Allocated := True;
    731735  Cells := TCells.Create;
    732736  Cells.FreeObjects := False;
     
    735739destructor TCellLink.Destroy;
    736740var
     741  Links: TCellLinks;
     742  FirstLink: TCellLink;
    737743  I: Integer;
    738744begin
     
    740746    if TCell(Cells[I]).Neighbors.Remove(TCell(Cells[1 - I])) = -1 then
    741747      raise Exception.Create(SCellRemoveNeighborError);
     748    Links := TCell(Cells[I]).Links;
     749    if Links.Count > 0 then
     750    FirstLink := TCellLink(Links[0]);
    742751    if TCell(Cells[I]).Links.Remove(Self) = -1 then
    743752      raise Exception.Create(SCellRemoveNeighborError);
    744753  end;
    745754  FreeAndNil(Cells);
     755  Allocated := False;
    746756  inherited Destroy;
    747757end;
     
    755765  I := 0;
    756766  while (I < Count) do begin
    757     if (TCellLink(Items[I]).Cells[0] = Cell1) and (TCellLink(Items[I]).Cells[1] = Cell2) then
    758       Break;
    759     if (TCellLink(Items[I]).Cells[0] = Cell2) and (TCellLink(Items[I]).Cells[1] = Cell1) then
     767    if ((TCellLink(Items[I]).Cells[0] = Cell1) and (TCellLink(Items[I]).Cells[1] = Cell2)) or
     768    ((TCellLink(Items[I]).Cells[0] = Cell2) and (TCellLink(Items[I]).Cells[1] = Cell1)) then
    760769      Break;
    761770    Inc(I);
     
    13551364    msRounded: begin
    13561365      Rect := GetPixelRect;
    1357       Center := Point(Rect.Left + Rect.Width div 2, Rect.Top + Rect.Height div 2);
    1358       Result := Sqr(Coord.X - Center.X) / Sqr(Rect.Width div 2) +
    1359         Sqr(Coord.Y - Center.Y) / Sqr(Rect.Height div 2) > 1;
     1366      Center := Point(Rect.Left + (Rect.Right - Rect.Left) div 2,
     1367        Rect.Top + (Rect.Bottom - Rect.Top) div 2);
     1368      Result := Sqr(Coord.X - Center.X) / Sqr((Rect.Right - Rect.Left) div 2) +
     1369        Sqr(Coord.Y - Center.Y) / Sqr((Rect.Bottom - Rect.Top) div 2) > 1;
    13601370    end
    13611371    else Result := False;
     
    16201630var
    16211631  C: Integer;
     1632  I: Integer;
    16221633  CellLink: TCellLink;
    16231634  OtherCell1: TCell;
     
    16301641    TCell(Cells[C]).Power := TCell(Cells[Cells.Count - 1 - C]).Power;
    16311642
    1632     Continue; // TODO
    1633 
    1634     for CellLink in TCell(Cells[C]).Links do
    1635       CellLinks.Remove(CellLink);
    1636     TCell(Cells[C]).Links.Clear;
     1643    for I := TCell(Cells[C]).Links.Count - 1 downto 0 do begin
     1644      CellLink := TCell(Cells[C]).Links[I];
     1645
     1646      // Remove cells on first half of the map
     1647      if (Cells.IndexOf(CellLink.Cells[0]) <= (Cells.Count div 2)) and
     1648      (Cells.IndexOf(CellLink.Cells[1]) <= (Cells.Count div 2)) then
     1649      begin
     1650        CellLinks.Remove(CellLink);
     1651        Continue;
     1652      end;
     1653
     1654      // Make cross half links symetric
     1655      if (Cells.IndexOf(CellLink.Cells[0]) <= (Cells.Count div 2)) and
     1656      (Cells.IndexOf(CellLink.Cells[1]) >= (Cells.Count div 2)) then begin
     1657        OtherCell1 := Cells[Cells.Count - 1 - Cells.IndexOf(CellLink.Cells[1])];
     1658        OtherCell2 := CellLink.Cells[1];
     1659        CellLinks.Remove(CellLink);
     1660        if not Assigned(CellLinks.FindByCells(OtherCell1, OtherCell2)) then
     1661          CellLinks.AddLink(OtherCell1, OtherCell2);
     1662      end else
     1663      if (Cells.IndexOf(CellLink.Cells[0]) >= (Cells.Count div 2)) and
     1664      (Cells.IndexOf(CellLink.Cells[1]) <= (Cells.Count div 2)) then begin
     1665        OtherCell1 := Cells[Cells.Count - 1 - Cells.IndexOf(CellLink.Cells[0])];
     1666        OtherCell2 := CellLink.Cells[0];
     1667        CellLinks.Remove(CellLink);
     1668        if not Assigned(CellLinks.FindByCells(OtherCell1, OtherCell2)) then
     1669          CellLinks.AddLink(OtherCell1, OtherCell2);
     1670      end;
     1671    end;
     1672  end;
     1673
     1674  for C := 0 to (Cells.Count div 2) - 1 do begin
     1675    // Make copy of links from second half
    16371676    OppositeCell := TCell(Cells[Cells.Count - 1 - C]);
    1638     for CellLink in OppositeCell.Links do begin
     1677    for CellLink in OppositeCell.Links do
     1678      if (Cells.IndexOf(CellLink.Cells[0]) > (Cells.Count div 2)) and
     1679      (Cells.IndexOf(CellLink.Cells[1]) > (Cells.Count div 2)) then begin
    16391680      OtherCell1 := Cells[Cells.Count - 1 - Cells.IndexOf(CellLink.Cells[0])];
    16401681      OtherCell2 := Cells[Cells.Count - 1 - Cells.IndexOf(CellLink.Cells[1])];
    1641       CellLinks.AddLink(OtherCell1, OtherCell2);
    1642     end;
     1682      if not Assigned(CellLinks.FindByCells(OtherCell1, OtherCell2)) then
     1683        CellLinks.AddLink(OtherCell1, OtherCell2);
     1684    end;
     1685  end;
     1686end;
     1687
     1688procedure TMap.CreateLinks;
     1689var
     1690  LastAreaCount: Integer;
     1691begin
     1692  BuildMapAreas;
     1693  LastAreaCount := -1;
     1694  while (Areas.Count > 1) and (Areas.Count <> LastAreaCount) do begin
     1695    LastAreaCount := Areas.Count;
     1696    BuildBridges;
     1697    BuildMapAreas;
    16431698  end;
    16441699end;
     
    28742929end;
    28752930
    2876 function TGame.SearchDifferentCellArea(List: TCells; SourceArea, DestArea: TMapArea): TCell;
     2931function TMap.SearchDifferentCellArea(List: TCells; SourceArea, DestArea: TMapArea): TCell;
    28772932var
    28782933  NewList: TCells;
     
    29382993end;
    29392994
    2940 procedure TGame.BuildBridges;
     2995procedure TMap.BuildBridges;
    29412996var
    29422997  List: TCells;
     
    29553010
    29563011  // Build area bridges
    2957   if Map.Areas.Count > 1 then
    2958   for I := 0 to Map.Areas.Count - 1 do
    2959   with TMapArea(Map.Areas[I]) do begin
     3012  if Areas.Count > 1 then
     3013  for I := 0 to Areas.Count - 1 do
     3014  with TMapArea(Areas[I]) do begin
    29603015    GetBorderCells(BorderList);
    29613016    for J := 0 to 1 do begin
     
    29913046end;
    29923047
    2993 procedure TGame.BuildMapAreas;
     3048procedure TMap.BuildMapAreas;
    29943049var
    29953050  C: Integer;
    29963051  NewArea: TMapArea;
    29973052begin
    2998   for C := 0 to Map.Cells.Count - 1 do
    2999   with TCell(Map.Cells[C]) do
     3053  for C := 0 to Cells.Count - 1 do
     3054  with TCell(Cells[C]) do
    30003055    Area := nil;
    3001   Map.Areas.Clear;
    3002   for C := 0 to Map.Cells.Count - 1 do
    3003   with TCell(Map.Cells[C]) do
     3056  Areas.Clear;
     3057  for C := 0 to Cells.Count - 1 do
     3058  with TCell(Cells[C]) do
    30043059  if (Terrain <> ttVoid) and (not Assigned(Area)) then begin
    30053060    NewArea := TMapArea.Create;
    30063061    NewArea.Id := Map.Areas.Count;
    30073062    NewArea.Map := Map;
    3008     Map.Areas.Add(NewArea);
     3063    Areas.Add(NewArea);
    30093064    Area := NewArea;
    30103065    AreaExtend;
     
    34233478var
    34243479  I: Integer;
    3425   LastAreaCount: Integer;
    34263480  Player: TPlayer;
    34273481begin
     
    34343488
    34353489  // Build bridges
    3436   if BridgeEnabled then begin
    3437     BuildMapAreas;
    3438     LastAreaCount := -1;
    3439     while (Map.Areas.Count > 1) and (Map.Areas.Count <> LastAreaCount) do begin
    3440       LastAreaCount := Map.Areas.Count;
    3441       BuildBridges;
    3442       BuildMapAreas;
    3443     end;
    3444   end;
    3445 
    3446   if SymetricMap then Map.MakeSymetric;
     3490  if BridgeEnabled then Map.CreateLinks;
     3491
     3492  if SymetricMap then begin
     3493    Map.MakeSymetric;
     3494    if BridgeEnabled then Map.CreateLinks;
     3495  end;
    34473496
    34483497  Players.Assign(PlayersSetting);
Note: See TracChangeset for help on using the changeset viewer.