Changeset 103


Ignore:
Timestamp:
Dec 27, 2014, 12:01:08 PM (10 years ago)
Author:
chronos
Message:
  • Fixed: CellLinks deallocation if map size changed and cells were regenerated.
Location:
trunk
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • trunk/UCore.pas

    r100 r103  
    130130
    131131procedure TCore.Delay(Time: Integer);
    132 var
    133   I: Integer;
    134132const
    135133  Slice = 50; // ms
     
    226224procedure TCore.AGameEndTurnExecute(Sender: TObject);
    227225var
    228   I: Integer;
    229226  Computer: TComputer;
    230227begin
     
    355352  CommandLineParams;
    356353
    357   with Core.ScaleDPI1 do
     354  {$IFDEF DEBUG}
     355  {with Core.ScaleDPI1 do
    358356  if (DesignDPI.X <> DPI.X) or (DesignDPI.Y <> DPI.Y) then begin
    359357    //ApplyToAll(DesignDPI);
     
    367365    ScaleImageList(Core.ImageListLarge, DesignDPI);
    368366  end;
     367  }
     368  {$ENDIF}
    369369
    370370  if Game.FileName = '' then begin
  • trunk/UGame.pas

    r102 r103  
    5858    Neighbors: TCells;
    5959    Mark: Boolean;
     60    Links: TCellLinks;
    6061    procedure AreaExtend;
    6162    procedure FixRefId;
     
    9192  TCellLink = class
    9293    Points: array of TPoint;
    93     Cell1: TCell;
    94     Cell2: TCell;
     94    Cells: TCells;
     95    Map: TMap;
    9596    procedure LoadFromNode(Node: TDOMNode);
    9697    procedure SaveToNode(Node: TDOMNode);
     98    constructor Create;
     99    destructor Destroy; override;
    97100  end;
    98101
     
    101104  TCellLinks = class(TObjectList)
    102105    Map: TMap;
     106    function FindByCells(Cell1, Cell2: TCell): TCellLink;
    103107    procedure LoadFromNode(Node: TDOMNode);
    104108    procedure SaveToNode(Node: TDOMNode);
     
    154158
    155159  TMapAreas = class(TObjectList)
    156 
    157160  end;
    158161
     
    544547end;
    545548
     549constructor TCellLink.Create;
     550begin
     551  Cells := TCells.Create;
     552  Cells.OwnsObjects := False;
     553end;
     554
     555destructor TCellLink.Destroy;
     556var
     557  I: Integer;
     558  LastState: Boolean;
     559begin
     560  for I := 0 to Cells.Count - 1 do begin
     561    if TCell(Cells[I]).Neighbors.Remove(TCell(Cells[1 - I])) = -1 then
     562      raise Exception.Create('Can''t remove cell from neighbour cell');
     563    if TCell(Cells[I]).Links.Remove(Self) = -1 then
     564      raise Exception.Create('Can''t remove cell from neighbour cell');
     565  end;
     566  FreeAndNil(Cells);
     567  if Assigned(Map) then begin
     568    // To remove itself from list we need disable owning to not be called twice
     569    try
     570      LastState := Map.CellLinks.OwnsObjects;
     571      Map.CellLinks.OwnsObjects := False;
     572      Map.CellLinks.Remove(Self);
     573    finally
     574      Map.CellLinks.OwnsObjects := LastState;
     575    end;
     576  end;
     577  inherited Destroy;
     578end;
     579
    546580{ TCellLinks }
     581
     582function TCellLinks.FindByCells(Cell1, Cell2: TCell): TCellLink;
     583var
     584  I: Integer;
     585begin
     586  I := 0;
     587  while (I < Count) do begin
     588    if (TCellLink(Items[I]).Cells[0] = Cell1) and (TCellLink(Items[I]).Cells[1] = Cell2) then
     589      Break;
     590    if (TCellLink(Items[I]).Cells[0] = Cell2) and (TCellLink(Items[I]).Cells[1] = Cell1) then
     591      Break;
     592    Inc(I);
     593  end;
     594  if I < Count then Result := TCellLink(Items[I])
     595    else Result := nil;
     596end;
    547597
    548598procedure TCellLinks.LoadFromNode(Node: TDOMNode);
     
    585635  List.Clear;
    586636
    587   // Unset mark for all cells
    588   for I := 0 to Map.Cells.Count - 1 do
    589     TCell(Map.Cells[I]).Mark := False;
     637  Map.Cells.ClearMark;
    590638
    591639  for I := 0 to Cells.Count - 1 do
     
    611659destructor TMapArea.Destroy;
    612660begin
    613   Cells.Free;
     661  FreeAndNil(Cells);
    614662  inherited Destroy;
    615663end;
     
    721769destructor TPlayerMap.Destroy;
    722770begin
    723   Cells.Free;
     771  FreeAndNil(Cells);
    724772  inherited Destroy;
    725773end;
     
    11161164  DefaultCellSize := Source.DefaultCellSize;
    11171165  Shape := Source.Shape;
    1118   //FSize := Source.Size;
    1119 
    1120   // Copy all cells
    1121   (*
     1166  Image.Picture.Bitmap.Assign(Source.Image.Picture.Bitmap);
     1167
     1168  // TODO: How to copy cells
     1169  {// Copy all cells
    11221170  Cells.Count := 0;
    11231171  Cells.Count := Source.Cells.Count;
    11241172  for I := 0 to Cells.Count - 1 do begin
    11251173    Cells[I] := TCell.Create;
     1174    TCell(Cells[I]).Map := Self;
    11261175    TCell(Cells[I]).Assign(TCell(Source.Cells[I]));
    11271176  end;
    1128   *)
     1177  }
    11291178end;
    11301179
     
    13151364destructor TMap.Destroy;
    13161365begin
    1317   Areas.Free;
    1318   CellLinks.Free;
    1319   Image.Free;
    13201366  Size := Point(0, 0);
     1367  FreeAndNil(Areas);
     1368  FreeAndNil(CellLinks);
     1369  FreeAndNil(Image);
    13211370  FreeAndNil(Cells);
    13221371  inherited Destroy;
     
    15751624  Terrain := Source.Terrain;
    15761625  Polygon := Source.Polygon;
     1626  Player := Source.Player;
     1627  Mark := Source.Mark;
    15771628  // TODO: How to copy neighbours and moves list
    15781629end;
     
    16221673  MovesTo := TUnitMoves.Create;
    16231674  MovesTo.OwnsObjects := False;
     1675  Links := TCellLinks.Create;
     1676  Links.OwnsObjects := False;
    16241677end;
    16251678
     
    16341687    TUnitMove(MovesTo[I]).Free;
    16351688  FreeAndNil(MovesTo);
     1689  for I := Links.Count - 1 downto 0 do
     1690    TCellLink(Links[I]).Free;
     1691  FreeAndNil(Links);
     1692  for I := Neighbors.Count - 1 downto 0 do
     1693    if TCell(Neighbors[I]).Neighbors.Remove(Self) = -1 then
     1694      raise Exception.Create('Can''t remove cell from neighbour cell');
    16361695  FreeAndNil(Neighbors);
    16371696  inherited Destroy;
     
    19051964  end;
    19061965
    1907   // Unset mark for all cells
    1908   for C := 0 to AllCells.Count - 1 do
    1909     TCell(AllCells[C]).Mark := False;
     1966  Game.Map.Cells.ClearMark;
    19101967
    19111968  while TargetCells.Count > 0 do begin
     
    24722529var
    24732530  List: TCells;
     2531  BorderList: TCells;
    24742532  Cell: TCell;
    24752533  FoundCell1: TCell;
     
    24792537  NewLink: TCellLink;
    24802538begin
     2539  List := TCells.Create;
     2540  List.OwnsObjects := False;
     2541
     2542  BorderList := TCells.Create;
     2543  BorderList.OwnsObjects := False;
     2544
    24812545  // Build area bridges
    24822546  if Map.Areas.Count > 1 then
    24832547  for I := 0 to Map.Areas.Count - 1 do
    24842548  with TMapArea(Map.Areas[I]) do begin
    2485     List := TCells.Create;
    2486     List.OwnsObjects := False;
    2487     GetBorderCells(List);
    2488     Cell := TCell(List[Random(List.Count)]);
     2549    GetBorderCells(BorderList);
     2550    for J := 0 to 1 do begin
     2551
     2552    Cell := TCell(BorderList[Random(BorderList.Count)]);
    24892553    List.Clear;
    24902554    List.Add(Cell);
     
    25022566      FoundCell2 := SearchDifferentCellArea(List, FoundCell1.Area, TMapArea(Map.Areas[I]));
    25032567      if Assigned(FoundCell2) then begin
    2504         FoundCell1.Neighbors.Add(FoundCell2);
    2505         FoundCell2.Neighbors.Add(FoundCell1);
    2506         NewLink := TCellLink.Create;
    2507         SetLength(NewLink.Points, 2);
    2508         NewLink.Cell1 := FoundCell2;
    2509         NewLink.Points[0] := FoundCell2.PosPx;
    2510         NewLink.Cell2 := FoundCell1;
    2511         NewLink.Points[1] := FoundCell1.PosPx;
    2512         Map.CellLinks.Add(NewLink);
    2513         Inc(BridgeCount);
     2568        // Check if link not exists already
     2569        if not Assigned(FoundCell1.Links.FindByCells(FoundCell1, FoundCell2)) then begin
     2570          NewLink := TCellLink.Create;
     2571          FoundCell1.Neighbors.Add(FoundCell2);
     2572          FoundCell1.Links.Add(NewLink);
     2573          FoundCell2.Neighbors.Add(FoundCell1);
     2574          FoundCell2.Links.Add(NewLink);
     2575          SetLength(NewLink.Points, 2);
     2576          NewLink.Cells.Add(FoundCell1);
     2577          NewLink.Points[0] := FoundCell1.PosPx;
     2578          NewLink.Cells.Add(FoundCell2);
     2579          NewLink.Points[1] := FoundCell2.PosPx;
     2580          NewLink.Map := Map;
     2581          Map.CellLinks.Add(NewLink);
     2582          Inc(BridgeCount);
     2583        end;
    25142584      end;
    25152585    end;
    2516 
    2517     List.Free;
    2518   end;
     2586    end;
     2587
     2588  end;
     2589  List.Free;
     2590  BorderList.Free;
    25192591end;
    25202592
     
    25612633
    25622634procedure TGame.LoadConfig(Config: TXmlConfig; Path: string);
    2563 var
    2564   P: TPoint;
    25652635begin
    25662636  with Config do begin
     
    26432713  Doc: TXMLDocument;
    26442714  RootNode: TDOMNode;
    2645   I: Integer;
    26462715begin
    26472716  Self.FileName := FileName;
     
    28202889
    28212890  BuildTerrain;
     2891
     2892  // Build bridges
     2893
    28222894  if BridgeEnabled then begin
    2823     // Connect all areas to all cells be accessible
    2824     for I := 0 to Map.CellLinks.Count - 1 do
    2825     with TCellLink(Map.CellLinks[I]) do begin
    2826       Cell1.Neighbors.Remove(Cell2);
    2827       Cell2.Neighbors.Remove(Cell1);
    2828     end;
    28292895    Map.CellLinks.Clear;
    28302896    BuildMapAreas;
     
    28362902    end;
    28372903  end;
     2904
    28382905
    28392906  if SymetricMap then begin
  • trunk/xtactics.lpi

    r102 r103  
    1818      <StringTable ProductVersion=""/>
    1919    </VersionInfo>
     20    <MacroValues Count="2">
     21      <Macro2 Name="LCLWidgetType" Value="qt"/>
     22    </MacroValues>
    2023    <BuildModes Count="2">
    2124      <Item1 Name="Debug" Default="True"/>
     
    5861        </CompilerOptions>
    5962      </Item2>
     63      <SharedMatrixOptions Count="2">
     64        <Item1 ID="345389164333" Modes="Debug" Type="IDEMacro"/>
     65        <Item2 ID="462723536445" Modes="Debug" Type="IDEMacro" MacroName="LCLWidgetType" Value="qt"/>
     66      </SharedMatrixOptions>
    6067    </BuildModes>
    6168    <PublishOptions>
Note: See TracChangeset for help on using the changeset viewer.