unit BinPacking.MaxRectsBinPack;

{$mode delphi}{$H+}
interface

uses
  Types,
  Math, Classes, fgl;

type
  /// <summary>
  ///   Specifies the different heuristic rules that can be used when deciding where to place a new rectangle.
  /// </summary>
  TFreeRectChoiceHeuristic = (
    /// <summary>
    /// BSSF: Positions the rectangle against the short side of a free rectangle into which it fits the best.
    /// </summary>
    frchRectBestShortSideFit,
    /// <summary>
    /// BLSF: Positions the rectangle against the long side of a free rectangle into which it fits the best.
    /// </summary>
    frchRectBestLongSideFit,
    /// <summary>
    ///   BAF: Positions the rectangle into the smallest free rect into which it fits.
    /// </summary>
    frchRectBestAreaFit,
    /// <summary>
    ///   BL: Does the Tetris placement.
    /// </summary>
    frchRectBottomLeftRule,
    /// <summary>
    ///   CP: Choosest the placement where the rectangle touches other rects as much as possible.
    /// </summary>
    frchRectContactPointRule
    );

  /// <summary>
  /// MaxRectsBinPack implements the MAXRECTS data structure and different bin packing algorithms that
  /// use this structure.
  /// </summary>
  TMaxRectsBinPack = class
  private
    binWidth: integer;
    binHeight: integer;
    binAllowFlip: boolean;
    usedRectangles: TFPGList<TRect>;
    freeRectangles: TFPGList<TRect>;

    /// <summary>
    /// Computes the placement score for placing the given rectangle with the given method.
    /// @return
    /// </summary>
    /// <param name="score1">
    /// The primary placement score will be outputted here.
    /// </param>
    /// <param name="score2">
    /// The secondary placement score will be outputted here. This isu sed to break ties.
    /// </param>
    /// <returns>
    /// This struct identifies where the rectangle would be placed if it were placed.
    /// </returns>
    function ScoreRect(Width, Height: integer; method: TFreeRectChoiceHeuristic;
      var score1: integer; var score2: integer): TRect;

    /// <summary>
    /// Places the given rectangle into the bin.
    /// </summary>
    procedure PlaceRect(const node: PRect; var dst: TFPGList<TRect>);

    /// <summary>
    /// Computes the placement score for the -CP variant.
    /// </summary>
    function ContactPointScoreNode(x, y, Width, Height: integer): integer;

    function FindPositionForNewNodeBottomLeft(Width, Height: integer;
      var bestY: integer; var bestX: integer): TRect;
    function FindPositionForNewNodeBestShortSideFit(Width, Height: integer;
      var bestShortSideFit: integer; var bestLongSideFit: integer): TRect;
    function FindPositionForNewNodeBestLongSideFit(Width, Height: integer;
      var bestShortSideFit: integer; var bestLongSideFit: integer): TRect;
    function FindPositionForNewNodeBestAreaFit(Width, Height: integer;
      var bestAreaFit: integer; var bestShortSideFit: integer): TRect;
    function FindPositionForNewNodeContactPoint(Width, Height: integer;
      var bestContactScore: integer): TRect;

    /// <returns>
    ///   True if the free node was split.
    /// </returns>
    function SplitFreeNode(freeNode: TRect; const usedNode: PRect): boolean;

    /// <summary>
    ///   Goes through the free rectangle list and removes any redundant entries.
    /// </summary>
    procedure PruneFreeList;
  public
    /// <summary>
    /// Instantiates a bin of size (0,0). Call Init to create a new bin.
    /// </summary>
    constructor Create; overload;

    /// <summary>
    /// Instantiates a bin of the given size.
    /// @param
    /// </summary>
    /// <param name="allowFlip">
    /// Specifies whether the packing algorithm is allowed to rotate the input rectangles by 90 degrees to consider a better placement.
    /// </param>
    constructor Create(Width, Height: integer; allowFlip: boolean = True); overload;

    /// <summary>
    /// (Re)initializes the packer to an empty bin of width x height units. Call whenever
    /// you need to restart with a new bin.
    /// </summary>
    procedure Init(Width, Height: integer; allowFlip: boolean = True);

    /// <summary>
    /// Inserts the given list of rectangles in an offline/batch mode, possibly rotated.
    /// </summary>
    /// <param name="rects">
    /// The list of rectangles to insert. This vector will be destroyed in the process.
    /// </param>
    /// <param name="dst" >
    /// This list will contain the packed rectangles. The indices will not correspond to that of rects.
    /// </param>
    /// <param name="method">
    ///   The rectangle placement rule to use when packing.
    /// </param>
    procedure Insert(var rects: TFPGList<TRect>; var dst: TFPGList<TRect>;
      method: TFreeRectChoiceHeuristic); overload;


    /// <summary>
    /// Inserts a single rectangle into the bin, possibly rotated.
    /// </summary>
    function Insert(Width, Height: integer; method: TFreeRectChoiceHeuristic): TRect;
      overload;

    /// <summary>
    ///   Computes the ratio of used surface area to the total bin area.
    /// </summary>
    function Occupancy: single;

    property Width: integer read binWidth;
    property Height: integer read binHeight;

    property AllowFlip: boolean read binAllowFlip;
    property URectangles: TFPGList<TRect> read usedRectangles;
  end;

implementation


/// <summary>
/// Returns 0 if the two intervals i1 and i2 are disjoint, or the length of their overlap otherwise.
/// </summary>
function CommonIntervalLength(i1start, i1end, i2start, i2end: integer): integer;
begin
  if (i1end < i2start) or (i2end < i1start) then
    Exit(0);
  Result := min(i1end, i2end) - max(i1start, i2start);
end;



{ TMaxRectsBinPack }

constructor TMaxRectsBinPack.Create;
begin
  binWidth := 0;
  binHeight := 0;
  usedRectangles := TFPGList<TRect>.Create;
  freeRectangles := TFPGList<TRect>.Create;
end;


function TMaxRectsBinPack.ContactPointScoreNode(x, y, Width, Height: integer): integer;
var
  score: integer;
  I: integer;
begin
  score := 0;

  if (x = 0) or (x + Width = binWidth) then
    score := score + Height;
  if (y = 0) or (y + Height = binHeight) then
    score := score + Width;

  for I := 0 to usedRectangles.Count - 1 do
  begin
    if (usedRectangles[i].Left = x + Width) or (usedRectangles[i].Left +
      usedRectangles[i].Width = x) then
      score := score + CommonIntervalLength(usedRectangles[i].Top,
        usedRectangles[i].Top + usedRectangles[i].Height, y, y + Height);
    if (usedRectangles[i].Top = y + Height) or (usedRectangles[i].Top +
      usedRectangles[i].Height = y) then
      score := score + CommonIntervalLength(usedRectangles[i].Left,
        usedRectangles[i].Left + usedRectangles[i].Width, x, x + Width);
  end;

  Result := score;
end;

constructor TMaxRectsBinPack.Create(Width, Height: integer; allowFlip: boolean);
begin
  Create;
  Init(Width, Height, allowFlip);
end;

function TMaxRectsBinPack.FindPositionForNewNodeBestAreaFit(Width, Height: integer;
  var bestAreaFit, bestShortSideFit: integer): TRect;
var
  bestNode: TRect;
  I: integer;
  areaFit: integer;
  leftoverHoriz: integer;
  leftoverVert: integer;
  shortSideFit: integer;
begin
  bestNode := TRect.Empty;

  bestAreaFit := MaxInt;
  bestShortSideFit := MaxInt;

  for I := 0 to freeRectangles.Count - 1 do
  begin
    areaFit := freeRectangles[i].Width * freeRectangles[i].Height - Width * Height;

    // Try to place the rectangle in upright (non-flipped) orientation.
    if (freeRectangles[i].Width >= Width) and (freeRectangles[i].Height >= Height) then
    begin
      leftoverHoriz := abs(freeRectangles[i].Width - Width);
      leftoverVert := abs(freeRectangles[i].Height - Height);
      shortSideFit := min(leftoverHoriz, leftoverVert);

      if (areaFit < bestAreaFit) or ((areaFit = bestAreaFit) and
        (shortSideFit < bestShortSideFit)) then
      begin
        bestNode.Left := freeRectangles[i].Left;
        bestNode.Top := freeRectangles[i].Top;
        bestNode.Width := Width;
        bestNode.Height := Height;
        bestShortSideFit := shortSideFit;
        bestAreaFit := areaFit;
      end;
    end;
    if binAllowFlip and (freeRectangles[i].Width >= Height) and
      (freeRectangles[i].Height >= Width) then
    begin
      leftoverHoriz := abs(freeRectangles[i].Width - Height);
      leftoverVert := abs(freeRectangles[i].Height - Width);
      shortSideFit := min(leftoverHoriz, leftoverVert);

      if (areaFit < bestAreaFit) or ((areaFit = bestAreaFit) and
        (shortSideFit < bestShortSideFit)) then
      begin
        bestNode.Left := freeRectangles[i].Left;
        bestNode.Top := freeRectangles[i].Top;
        bestNode.Width := Height;
        bestNode.Height := Width;
        bestShortSideFit := shortSideFit;
        bestAreaFit := areaFit;
      end;
    end;
  end;
  Result := bestNode;
end;

function TMaxRectsBinPack.FindPositionForNewNodeBestLongSideFit(Width, Height: integer;
  var bestShortSideFit, bestLongSideFit: integer): TRect;
var
  bestNode: TRect;
  I: integer;
  leftoverHoriz: integer;
  leftoverVert: integer;
  shortSideFit: integer;
  longSideFit: integer;
begin
  bestNode := TRect.Empty;
  bestShortSideFit := MaxInt;
  bestLongSideFit := MaxInt;

  for I := 0 to freeRectangles.Count - 1 do
  begin
    // Try to place the rectangle in upright (non-flipped) orientation.
    if (freeRectangles[i].Width >= Width) and (freeRectangles[i].Height >= Height) then
    begin
      leftoverHoriz := abs(freeRectangles[i].Width - Width);
      leftoverVert := abs(freeRectangles[i].Height - Height);
      shortSideFit := Math.min(leftoverHoriz, leftoverVert);
      longSideFit := Math.max(leftoverHoriz, leftoverVert);

      if (longSideFit < bestLongSideFit) or ((longSideFit = bestLongSideFit) and
        (shortSideFit < bestShortSideFit)) then
      begin
        bestNode.Left := freeRectangles[i].Left;
        bestNode.Top := freeRectangles[i].Top;
        bestNode.Width := Width;
        bestNode.Height := Height;
        bestShortSideFit := shortSideFit;
        bestLongSideFit := longSideFit;
      end;
    end;
    if binAllowFlip and (freeRectangles[i].Width >= Height) and
      (freeRectangles[i].Height >= Width) then
    begin
      leftoverHoriz := abs(freeRectangles[i].Width - Height);
      leftoverVert := abs(freeRectangles[i].Height - Width);
      shortSideFit := Math.min(leftoverHoriz, leftoverVert);
      longSideFit := Math.max(leftoverHoriz, leftoverVert);

      if (longSideFit < bestLongSideFit) or ((longSideFit = bestLongSideFit) and
        (shortSideFit < bestShortSideFit)) then
      begin
        bestNode.Left := freeRectangles[i].Left;
        bestNode.Top := freeRectangles[i].Top;
        bestNode.Width := Height;
        bestNode.Height := Width;
        bestShortSideFit := shortSideFit;
        bestLongSideFit := longSideFit;
      end;
    end;
  end;

  Result := bestNode;
end;

function TMaxRectsBinPack.FindPositionForNewNodeBestShortSideFit(Width, Height: integer;
  var bestShortSideFit, bestLongSideFit: integer): TRect;
var
  bestNode: TRect;
  I: integer;
  leftoverHoriz: integer;
  leftoverVert: integer;
  shortSideFit: integer;
  longSideFit: integer;
  flippedLeftoverHoriz: integer;
  flippedLeftoverVert: integer;
  flippedShortSideFit: integer;
  flippedLongSideFit: integer;
begin
  bestNode := TRect.Empty;
  bestShortSideFit := MaxInt;
  bestLongSideFit := MaxInt;

  for I := 0 to freeRectangles.Count - 1 do
  begin
    // Try to place the rectangle in upright (non-flipped) orientation.
    if (freeRectangles[i].Width >= Width) and (freeRectangles[i].Height >= Height) then
    begin
      leftoverHoriz := Abs(freeRectangles[i].Width - Width);
      leftoverVert := Abs(freeRectangles[i].Height - Height);
      shortSideFit := Min(leftoverHoriz, leftoverVert);
      longSideFit := Max(leftoverHoriz, leftoverVert);

      if (shortSideFit < bestShortSideFit) or
        ((shortSideFit = bestShortSideFit) and (longSideFit < bestLongSideFit)) then
      begin
        bestNode.Left := freeRectangles[i].Left;
        bestNode.Top := freeRectangles[i].Top;
        bestNode.Width := Width;
        bestNode.Height := Height;
        bestShortSideFit := shortSideFit;
        bestLongSideFit := longSideFit;
      end;
    end;
    if binAllowFlip and (freeRectangles[i].Width >= Height) and
      (freeRectangles[i].Height >= Width) then
    begin
      flippedLeftoverHoriz := abs(freeRectangles[i].Width - Height);
      flippedLeftoverVert := abs(freeRectangles[i].Height - Width);
      flippedShortSideFit := Math.Min(flippedLeftoverHoriz, flippedLeftoverVert);
      flippedLongSideFit := Math.Max(flippedLeftoverHoriz, flippedLeftoverVert);

      if (flippedShortSideFit < bestShortSideFit) or
        ((flippedShortSideFit = bestShortSideFit) and (flippedLongSideFit <
        bestLongSideFit)) then
      begin
        bestNode.Left := freeRectangles[i].Left;
        bestNode.Top := freeRectangles[i].Top;
        bestNode.Width := Height;
        bestNode.Height := Width;
        bestShortSideFit := flippedShortSideFit;
        bestLongSideFit := flippedLongSideFit;
      end;
    end;
  end;
  Result := bestNode;

end;

function TMaxRectsBinPack.FindPositionForNewNodeBottomLeft(Width, Height: integer;
  var bestY, bestX: integer): TRect;
var
  bestNode: TRect;
  I: integer;
  topSideY: integer;
begin
  bestNode := TRect.Empty;
  bestY := MaxInt;
  bestX := MaxInt;

  for I := 0 to freeRectangles.Count - 1 do
  begin
    // Try to place the rectangle in upright (non-flipped) orientation.
    if (freeRectangles[i].Width >= Width) and (freeRectangles[i].Height >= Height) then
    begin
      topSideY := freeRectangles[i].Top + Height;
      if (topSideY < bestY) or ((topSideY = bestY) and
        (freeRectangles[i].Left < bestX)) then
      begin
        bestNode.Left := freeRectangles[i].Left;
        bestNode.Top := freeRectangles[i].Top;
        bestNode.Width := Width;
        bestNode.Height := Height;
        bestY := topSideY;
        bestX := freeRectangles[i].Left;
      end;
    end;
    if binAllowFlip and (freeRectangles[i].Width >= Height) and
      (freeRectangles[i].Height >= Width) then
    begin
      topSideY := freeRectangles[i].Top + Width;
      if (topSideY < bestY) or ((topSideY = bestY) and
        (freeRectangles[i].Left < bestX)) then
      begin
        bestNode.left := freeRectangles[i].Left;
        bestNode.Top := freeRectangles[i].Top;
        bestNode.Width := Height;
        bestNode.Height := Width;
        bestY := topSideY;
        bestX := freeRectangles[i].Left;
      end;
    end;
  end;

  Result := bestNode;

end;

function TMaxRectsBinPack.FindPositionForNewNodeContactPoint(Width, Height: integer;
  var bestContactScore: integer): TRect;
var
  bestNode: TRect;
  I: integer;
  score: integer;
begin
  bestNode := TRect.Empty;
  bestContactScore := -1;

  for I := 0 to freeRectangles.Count - 1 do
  begin
    // Try to place the rectangle in upright (non-flipped) orientation.
    if (freeRectangles[i].Width >= Width) and (freeRectangles[i].Height >= Height) then
    begin
      score := ContactPointScoreNode(freeRectangles[i].Left, freeRectangles[i].Top,
        Width, Height);
      if (score > bestContactScore) then
      begin
        bestNode.Left := freeRectangles[i].Left;
        bestNode.Top := freeRectangles[i].Top;
        bestNode.Width := Width;
        bestNode.Height := Height;
        bestContactScore := score;
      end;
    end;
    if (freeRectangles[i].Width >= Height) and (freeRectangles[i].Height >= Width) then
    begin
      score := ContactPointScoreNode(freeRectangles[i].Left, freeRectangles[i].Top,
        Height, Width);
      if (score > bestContactScore) then
      begin
        bestNode.Left := freeRectangles[i].Left;
        bestNode.Top := freeRectangles[i].Top;
        bestNode.Width := Height;
        bestNode.Height := Width;
        bestContactScore := score;
      end;
    end;
  end;
  Result := bestNode;
end;

procedure TMaxRectsBinPack.Init(Width, Height: integer; allowFlip: boolean);
var
  rect: TRect;
begin
  binAllowFlip := allowFlip;
  binWidth := Width;
  binHeight := Height;

  rect := TRect.Create(0, 0, Width, Height);

  usedRectangles.Clear;
  freeRectangles.Clear;
  freeRectangles.Add(rect);
end;

function TMaxRectsBinPack.Insert(Width, Height: integer;
  method: TFreeRectChoiceHeuristic): TRect;
var
  newNode: TRect;
  score1: integer;
  score2: integer;
  numRectanglesToProcess: integer;
  I: integer;
begin
  // Unused in this function. We don't need to know the score after finding the position.
  score1 := MaxInt;
  score2 := MaxInt;
  case method of
    frchRectBestShortSideFit:
      newNode := FindPositionForNewNodeBestShortSideFit(Width, Height, score1, score2);
    frchRectBottomLeftRule:
      newNode := FindPositionForNewNodeBottomLeft(Width, Height, score1, score2);
    frchRectContactPointRule:
      newNode := FindPositionForNewNodeContactPoint(Width, Height, score1);
    frchRectBestLongSideFit:
      newNode := FindPositionForNewNodeBestLongSideFit(Width, Height, score1, score2);
    else
      newNode := FindPositionForNewNodeBestAreaFit(Width, Height, score1, score2);
  end;

  if newNode.Height = 0 then
    Exit(newNode);

  numRectanglesToProcess := freeRectangles.Count;
  I := 0;
  while I < numRectanglesToProcess do
  begin
    if SplitFreeNode(freeRectangles[I], @newNode) then
    begin
      freeRectangles.Remove(freeRectangles[I]);
      Dec(I);
      Dec(numRectanglesToProcess);
    end;
    Inc(I);
  end;

  PruneFreeList();

  usedRectangles.Add(newNode);
  Result := newNode;
end;

function TMaxRectsBinPack.Occupancy: single;
var
  usedSurfaceArea: cardinal;
  I: integer;
begin
  usedSurfaceArea := 0;

  for I := 0 to usedRectangles.Count - 1 do
    usedSurfaceArea := usedSurfaceArea + (usedRectangles[i].Width *
      usedRectangles[i].Height);

  Result := usedSurfaceArea / (binWidth * binHeight);
end;

procedure TMaxRectsBinPack.PlaceRect(const node: PRect; var dst: TFPGList<TRect>);
var
  numRectanglesToProcess: integer;
  I: integer;
begin
  numRectanglesToProcess := freeRectangles.Count;
  I := 0;
  while I < numRectanglesToProcess do
  begin
    if SplitFreeNode(freeRectangles[I], node) then
    begin
      freeRectangles.Remove(freeRectangles[I]);
      Dec(I);
      Dec(numRectanglesToProcess);
    end;
    Inc(I);
  end;

  PruneFreeList();

  usedRectangles.Add(node^);
  dst.Add(node^);
end;

procedure TMaxRectsBinPack.PruneFreeList;
var
  I: integer;
  J: integer;
begin
  ///  Would be nice to do something like this, to avoid a Theta(n^2) loop through each pair.
  ///  But unfortunately it doesn't quite cut it, since we also want to detect containment.
  ///  Perhaps there's another way to do this faster than Theta(n^2).

  /// Go through each pair and remove any rectangle that is redundant.
  I := 0;
  while I < freeRectangles.Count do
  begin
    J := I + 1;
    while J < freeRectangles.Count do
    begin
      if freeRectangles[J].Contains(freeRectangles[I]) then
      begin
        freeRectangles.Remove(freeRectangles[I]);
        Dec(I);
        Break;
      end;
      if freeRectangles[I].Contains(freeRectangles[J]) then
      begin
        freeRectangles.Remove(freeRectangles[J]);
        Dec(J);
      end;
      Inc(J);
    end;
    Inc(I);
  end;
end;

function TMaxRectsBinPack.ScoreRect(Width, Height: integer;
  method: TFreeRectChoiceHeuristic; var score1, score2: integer): TRect;
var
  newNode: TRect;
begin
  score1 := MaxInt;
  score2 := MaxInt;
  case method of
    frchRectBestShortSideFit: newNode :=
        FindPositionForNewNodeBestShortSideFit(Width, Height, score1, score2);
    frchRectBestLongSideFit: newNode :=
        FindPositionForNewNodeBestLongSideFit(Width, Height, score1, score2);
    frchRectBestAreaFit: newNode :=
        FindPositionForNewNodeBestAreaFit(Width, Height, score1, score2);
    frchRectBottomLeftRule: newNode :=
        FindPositionForNewNodeBottomLeft(Width, Height, score1, score2);
    frchRectContactPointRule:
    begin
      newNode := FindPositionForNewNodeContactPoint(Width, Height, score1);
      score1 := -score1;
      // Reverse since we are minimizing, but for contact point score bigger is better.
    end;
  end;

  // Cannot fit the current rectangle.
  if newNode.Height = 0 then
  begin
    score1 := MaxInt;
    score2 := MaxInt;
  end;

  Result := newNode;
end;

function TMaxRectsBinPack.SplitFreeNode(freeNode: TRect; const usedNode: PRect): boolean;
var
  newNode: TRect;
begin
  // Test with SAT if the rectangles even intersect.
  if (usedNode.Left >= freeNode.Left + freeNode.Width) or
    (usedNode.Left + usedNode.Width <= freeNode.Left) or
    (usedNode.Top >= freeNode.Top + freeNode.Height) or
    (usedNode.Top + usedNode.Height <= freeNode.Top) then
    Exit(False);

  if (usedNode.Left < freeNode.Left + freeNode.Width) and
    (usedNode.Left + usedNode.Width > freeNode.Left) then
  begin
    // New node at the top side of the used node.
    if (usedNode.Top > freeNode.Top) and (usedNode.TOp < freeNode.Top +
      freeNode.Height) then
    begin
      newNode := freeNode;
      newNode.Height := usedNode.Top - newNode.Top;
      freeRectangles.Add(newNode);
    end;

    // New node at the bottom side of the used node.
    if (usedNode.Top + usedNode.Height < freeNode.Top + freeNode.Height) then
    begin
      newNode := freeNode;
      newNode.Top := usedNode.Top + usedNode.Height;
      newNode.Height := freeNode.Top + freeNode.Height - (usedNode.Top + usedNode.Height);
      freeRectangles.Add(newNode);
    end;
  end;

  if (usedNode.Top < freeNode.Top + freeNode.Height) and
    (usedNode.Top + usedNode.Height > freeNode.Top) then
  begin
    // New node at the left side of the used node.
    if (usedNode.Left > freeNode.Left) and (usedNode.Left < freeNode.Left +
      freeNode.Width) then
    begin
      newNode := freeNode;
      newNode.Width := usedNode.Left - newNode.Left;
      freeRectangles.Add(newNode);
    end;

    // New node at the right side of the used node.
    if (usedNode.Left + usedNode.Width < freeNode.Left + freeNode.Width) then
    begin
      newNode := freeNode;
      newNode.Left := usedNode.Left + usedNode.Width;
      newNode.Width := freeNode.Left + freeNode.Width - (usedNode.Left + usedNode.Width);
      freeRectangles.Add(newNode);
    end;
  end;

  Result := True;
end;

procedure TMaxRectsBinPack.Insert(var rects, dst: TFPGList<TRect>;
  method: TFreeRectChoiceHeuristic);
var
  score1: integer;
  score2: integer;
  bestRectIndex: integer;
  bestNode: TRect;
  I: integer;
  bestScore1: integer;
  bestScore2: integer;
  newNode: TRect;
begin
  dst.Clear;

  while (rects.Count > 0) do
  begin
    bestScore1 := MaxInt;
    bestScore2 := MaxInt;
    bestRectIndex := -1;
    for I := 0 to rects.Count - 1 do
    begin
      score1 := MaxInt;
      score2 := MaxInt;
      newNode := ScoreRect(rects[i].Width, rects[i].Height, method, score1, score2);
      if (score1 < bestScore1) or ((score1 = bestScore1) and (score2 < bestScore2)) then
      begin
        bestScore1 := score1;
        bestScore2 := score2;
        bestNode := newNode;
        bestRectIndex := I;
      end;
    end;
    if bestRectIndex = -1 then
      Exit;

    PlaceRect(@bestNode, dst);
    rects.Remove(rects[bestRectIndex]);
  end;
end;

end.