Changeset 103 for trunk

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:

• UCore.pas (modified) (4 diffs)
• UGame.pas (modified) (21 diffs)
• xtactics.lpi (modified) (2 diffs)

trunk/UCore.pas

@@ -130 +130 @@
 
 procedure TCore.Delay(Time: Integer);
-var
-  I: Integer;
 const
   Slice = 50; // ms
@@ -226 +224 @@
 procedure TCore.AGameEndTurnExecute(Sender: TObject);
 var
-  I: Integer;
   Computer: TComputer;
 begin
@@ -355 +352 @@
   CommandLineParams;
 
-  with Core.ScaleDPI1 do
+  {$IFDEF DEBUG}
+  {with Core.ScaleDPI1 do
   if (DesignDPI.X <> DPI.X) or (DesignDPI.Y <> DPI.Y) then begin
     //ApplyToAll(DesignDPI);
@@ -367 +365 @@
     ScaleImageList(Core.ImageListLarge, DesignDPI);
   end;
+  }
+  {$ENDIF}
 
   if Game.FileName = '' then begin

trunk/UGame.pas

@@ -58 +58 @@
     Neighbors: TCells;
     Mark: Boolean;
+    Links: TCellLinks;
     procedure AreaExtend;
     procedure FixRefId;
@@ -91 +92 @@
   TCellLink = class
     Points: array of TPoint;
-    Cell1: TCell;
-    Cell2: TCell;
+    Cells: TCells;
+    Map: TMap;
     procedure LoadFromNode(Node: TDOMNode);
     procedure SaveToNode(Node: TDOMNode);
+    constructor Create;
+    destructor Destroy; override;
   end;
 
@@ -101 +104 @@
   TCellLinks = class(TObjectList)
     Map: TMap;
+    function FindByCells(Cell1, Cell2: TCell): TCellLink;
     procedure LoadFromNode(Node: TDOMNode);
     procedure SaveToNode(Node: TDOMNode);
@@ -154 +158 @@
 
   TMapAreas = class(TObjectList)
-
   end;
 
@@ -544 +547 @@
 end;
 
+constructor TCellLink.Create;
+begin
+  Cells := TCells.Create;
+  Cells.OwnsObjects := False;
+end;
+
+destructor TCellLink.Destroy;
+var
+  I: Integer;
+  LastState: Boolean;
+begin
+  for I := 0 to Cells.Count - 1 do begin
+    if TCell(Cells[I]).Neighbors.Remove(TCell(Cells[1 - I])) = -1 then
+      raise Exception.Create('Can''t remove cell from neighbour cell');
+    if TCell(Cells[I]).Links.Remove(Self) = -1 then
+      raise Exception.Create('Can''t remove cell from neighbour cell');
+  end;
+  FreeAndNil(Cells);
+  if Assigned(Map) then begin
+    // To remove itself from list we need disable owning to not be called twice
+    try
+      LastState := Map.CellLinks.OwnsObjects;
+      Map.CellLinks.OwnsObjects := False;
+      Map.CellLinks.Remove(Self);
+    finally
+      Map.CellLinks.OwnsObjects := LastState;
+    end;
+  end;
+  inherited Destroy;
+end;
+
 { TCellLinks }
+
+function TCellLinks.FindByCells(Cell1, Cell2: TCell): TCellLink;
+var
+  I: Integer;
+begin
+  I := 0;
+  while (I < Count) do begin
+    if (TCellLink(Items[I]).Cells[0] = Cell1) and (TCellLink(Items[I]).Cells[1] = Cell2) then
+      Break;
+    if (TCellLink(Items[I]).Cells[0] = Cell2) and (TCellLink(Items[I]).Cells[1] = Cell1) then
+      Break;
+    Inc(I);
+  end;
+  if I < Count then Result := TCellLink(Items[I])
+    else Result := nil;
+end;
 
 procedure TCellLinks.LoadFromNode(Node: TDOMNode);
@@ -585 +635 @@
   List.Clear;
 
-  // Unset mark for all cells
-  for I := 0 to Map.Cells.Count - 1 do
-    TCell(Map.Cells[I]).Mark := False;
+  Map.Cells.ClearMark;
 
   for I := 0 to Cells.Count - 1 do
@@ -611 +659 @@
 destructor TMapArea.Destroy;
 begin
-  Cells.Free;
+  FreeAndNil(Cells);
   inherited Destroy;
 end;
@@ -721 +769 @@
 destructor TPlayerMap.Destroy;
 begin
-  Cells.Free;
+  FreeAndNil(Cells);
   inherited Destroy;
 end;
@@ -1116 +1164 @@
   DefaultCellSize := Source.DefaultCellSize;
   Shape := Source.Shape;
-  //FSize := Source.Size;
-
-  // Copy all cells
-  (*
+  Image.Picture.Bitmap.Assign(Source.Image.Picture.Bitmap);
+
+  // TODO: How to copy cells
+  {// Copy all cells
   Cells.Count := 0;
   Cells.Count := Source.Cells.Count;
   for I := 0 to Cells.Count - 1 do begin
     Cells[I] := TCell.Create;
+    TCell(Cells[I]).Map := Self;
     TCell(Cells[I]).Assign(TCell(Source.Cells[I]));
   end;
-  *)
+  }
 end;
 
@@ -1315 +1364 @@
 destructor TMap.Destroy;
 begin
-  Areas.Free;
-  CellLinks.Free;
-  Image.Free;
   Size := Point(0, 0);
+  FreeAndNil(Areas);
+  FreeAndNil(CellLinks);
+  FreeAndNil(Image);
   FreeAndNil(Cells);
   inherited Destroy;
@@ -1575 +1624 @@
   Terrain := Source.Terrain;
   Polygon := Source.Polygon;
+  Player := Source.Player;
+  Mark := Source.Mark;
   // TODO: How to copy neighbours and moves list
 end;
@@ -1622 +1673 @@
   MovesTo := TUnitMoves.Create;
   MovesTo.OwnsObjects := False;
+  Links := TCellLinks.Create;
+  Links.OwnsObjects := False;
 end;
 
@@ -1634 +1687 @@
     TUnitMove(MovesTo[I]).Free;
   FreeAndNil(MovesTo);
+  for I := Links.Count - 1 downto 0 do
+    TCellLink(Links[I]).Free;
+  FreeAndNil(Links);
+  for I := Neighbors.Count - 1 downto 0 do
+    if TCell(Neighbors[I]).Neighbors.Remove(Self) = -1 then
+      raise Exception.Create('Can''t remove cell from neighbour cell');
   FreeAndNil(Neighbors);
   inherited Destroy;
@@ -1905 +1964 @@
   end;
 
-  // Unset mark for all cells
-  for C := 0 to AllCells.Count - 1 do
-    TCell(AllCells[C]).Mark := False;
+  Game.Map.Cells.ClearMark;
 
   while TargetCells.Count > 0 do begin
@@ -2472 +2529 @@
 var
   List: TCells;
+  BorderList: TCells;
   Cell: TCell;
   FoundCell1: TCell;
@@ -2479 +2537 @@
   NewLink: TCellLink;
 begin
+  List := TCells.Create;
+  List.OwnsObjects := False;
+
+  BorderList := TCells.Create;
+  BorderList.OwnsObjects := False;
+
   // Build area bridges
   if Map.Areas.Count > 1 then
   for I := 0 to Map.Areas.Count - 1 do
   with TMapArea(Map.Areas[I]) do begin
-    List := TCells.Create;
-    List.OwnsObjects := False;
-    GetBorderCells(List);
-    Cell := TCell(List[Random(List.Count)]);
+    GetBorderCells(BorderList);
+    for J := 0 to 1 do begin
+
+    Cell := TCell(BorderList[Random(BorderList.Count)]);
     List.Clear;
     List.Add(Cell);
@@ -2502 +2566 @@
       FoundCell2 := SearchDifferentCellArea(List, FoundCell1.Area, TMapArea(Map.Areas[I]));
       if Assigned(FoundCell2) then begin
-        FoundCell1.Neighbors.Add(FoundCell2);
-        FoundCell2.Neighbors.Add(FoundCell1);
-        NewLink := TCellLink.Create;
-        SetLength(NewLink.Points, 2);
-        NewLink.Cell1 := FoundCell2;
-        NewLink.Points[0] := FoundCell2.PosPx;
-        NewLink.Cell2 := FoundCell1;
-        NewLink.Points[1] := FoundCell1.PosPx;
-        Map.CellLinks.Add(NewLink);
-        Inc(BridgeCount);
+        // Check if link not exists already
+        if not Assigned(FoundCell1.Links.FindByCells(FoundCell1, FoundCell2)) then begin
+          NewLink := TCellLink.Create;
+          FoundCell1.Neighbors.Add(FoundCell2);
+          FoundCell1.Links.Add(NewLink);
+          FoundCell2.Neighbors.Add(FoundCell1);
+          FoundCell2.Links.Add(NewLink);
+          SetLength(NewLink.Points, 2);
+          NewLink.Cells.Add(FoundCell1);
+          NewLink.Points[0] := FoundCell1.PosPx;
+          NewLink.Cells.Add(FoundCell2);
+          NewLink.Points[1] := FoundCell2.PosPx;
+          NewLink.Map := Map;
+          Map.CellLinks.Add(NewLink);
+          Inc(BridgeCount);
+        end;
       end;
     end;
-
-    List.Free;
-  end;
+    end;
+
+  end;
+  List.Free;
+  BorderList.Free;
 end;
 
@@ -2561 +2633 @@
 
 procedure TGame.LoadConfig(Config: TXmlConfig; Path: string);
-var
-  P: TPoint;
 begin
   with Config do begin
@@ -2643 +2713 @@
   Doc: TXMLDocument;
   RootNode: TDOMNode;
-  I: Integer;
 begin
   Self.FileName := FileName;
@@ -2820 +2889 @@
 
   BuildTerrain;
+
+  // Build bridges
+
   if BridgeEnabled then begin
-    // Connect all areas to all cells be accessible
-    for I := 0 to Map.CellLinks.Count - 1 do
-    with TCellLink(Map.CellLinks[I]) do begin
-      Cell1.Neighbors.Remove(Cell2);
-      Cell2.Neighbors.Remove(Cell1);
-    end;
     Map.CellLinks.Clear;
     BuildMapAreas;
@@ -2836 +2902 @@
     end;
   end;
+
 
   if SymetricMap then begin

trunk/xtactics.lpi

@@ -18 +18 @@
       <StringTable ProductVersion=""/>
     </VersionInfo>
+    <MacroValues Count="2">
+      <Macro2 Name="LCLWidgetType" Value="qt"/>
+    </MacroValues>
     <BuildModes Count="2">
       <Item1 Name="Debug" Default="True"/>
@@ -58 +61 @@
         </CompilerOptions>
       </Item2>
+      <SharedMatrixOptions Count="2">
+        <Item1 ID="345389164333" Modes="Debug" Type="IDEMacro"/>
+        <Item2 ID="462723536445" Modes="Debug" Type="IDEMacro" MacroName="LCLWidgetType" Value="qt"/>
+      </SharedMatrixOptions>
     </BuildModes>
     <PublishOptions>