unit uBinPacker;

interface

// implements a maxrects packer with best short side fit heuristic

type Rectangle = record

    x, y, width, height: LongInt;

    UserData: Pointer;

end;

type Size = record

    width, height: LongInt;

    UserData: Pointer;

end;

type PRectangle = ^Rectangle;

type PSize = ^Size;

type RectangleList = record

    data: PRectangle;

    count: LongInt;

    size: LongInt;

end;

type SizeList = record

    data: PSize;

    count: LongInt;

    size: LongInt;

end;

type Atlas = record

    width, height: Longint;

    freeRectangles: RectangleList;

    usedRectangles: RectangleList;

end;

function atlasInsertAdaptive(var a: Atlas; sz: Size; var output: Rectangle): boolean;

function atlasInsertSet(var a: Atlas; var input: SizeList; var outputs: RectangleList): boolean;

function atlasNew(width, height: LongInt): Atlas;

procedure atlasDelete(var a: Atlas);

procedure atlasReset(var a: Atlas);

procedure rectangleListInit(var list: RectangleList);

procedure rectangleListRemoveAt(var list: RectangleList; index: LongInt);

procedure rectangleListAdd(var list: RectangleList; r: Rectangle);

procedure rectangleListClear(var list: RectangleList);

procedure sizeListInit(var list: SizeList);

procedure sizeListRemoveAt(var list: SizeList; index: LongInt);

procedure sizeListAdd(var list: SizeList; s: Size); overload;

procedure sizeListAdd(var list: SizeList; width, height: LongInt; UserData: Pointer); overload;

procedure sizeListClear(var list: SizeList);

implementation

uses Math; // for min/max

procedure rectangleListRemoveAt(var list: RectangleList; index: LongInt);

var

    i: Integer;

begin

    i:=index;

    while (i + 1 < list.count) do

    begin

        list.data[i]:=list.data[i + 1];

        inc(i);

    end;

    dec(list.count);

end;

procedure rectangleListAdd(var list: RectangleList; r: Rectangle);

begin

    if list.count >= list.size then

    begin

        inc(list.size, 512);

        ReAllocMem(list.data, sizeof(Rectangle) * list.size);

    end;

    list.data[list.count]:=r;

    inc(list.count);

end;

procedure rectangleListInit(var list: RectangleList);

begin

    list.data:= nil;

    list.count:= 0;

    list.size:= 0;

end;

procedure rectangleListClear(var list: RectangleList);

begin

    FreeMem(list.data);

    list.count:= 0;

    list.size:= 0;

end;

procedure sizeListRemoveAt(var list: SizeList; index: LongInt);

begin

    list.data[index]:= list.data[list.count - 1];

    dec(list.count);

end;

procedure sizeListAdd(var list: SizeList; s: Size); overload;

begin

    if list.count >= list.size then

    begin

        inc(list.size, 512);

        ReAllocMem(list.data, sizeof(Size) * list.size);

    end;

    list.data[list.count]:=s;

    inc(list.count);

end;

procedure sizeListAdd(var list: SizeList; width, height: LongInt; UserData: Pointer); overload;

var

    sz: Size;

begin

    sz.width:= width;

    sz.height:= height;

    sz.UserData:= UserData;

    sizeListAdd(list, sz);

end;

procedure sizeListInit(var list: SizeList);

begin

    list.data:= nil;

    list.count:= 0;

    list.size:= 0;

end;

procedure sizeListClear(var list: SizeList);

begin

    FreeMem(list.data);

    list.count:= 0;

    list.size:= 0;

end;

function isContainedIn(a, b: Rectangle): boolean;

begin

    isContainedIn:= (a.x >= b.x) and (a.y >= b.y)

                and (a.x + a.width <= b.x + b.width)

                and (a.y + a.height <= b.y + b.height);

end;

function findPositionForNewNodeBestShortSideFit(var list: RectangleList; width, height: LongInt; 

     var bestShortSideFit, bestLongSideFit: LongInt): Rectangle;

var

    bestNode: Rectangle;

    i: Integer;

    ri: Rectangle;

    leftoverHoriz, leftoverVert, shortSideFit, longSideFit: Longint;

begin

    bestNode.x:= 0;

    bestNode.y:= 0;

    bestNode.width:= 0;

    bestNode.height:= 0;

    bestShortSideFit:= $7FFFFFFF;

    for i:=0 to pred(list.count) do

    begin

        ri:= list.data[i];

        // Try to place the rectangle in upright (non-flipped) orientation.

        if (ri.width >= width) and (ri.height >= height) then

        begin

            leftoverHoriz:= Abs(ri.width - width);

            leftoverVert:= Abs(ri.height - height);

            shortSideFit:= Min(leftoverHoriz, leftoverVert);

            longSideFit:= Max(leftoverHoriz, leftoverVert);

            if (shortSideFit < bestShortSideFit) or

              ((shortSideFit = bestShortSideFit) and (longSideFit < bestLongSideFit)) then

            begin

                bestNode.x:= ri.x;

                bestNode.y:= ri.y;

                bestNode.width:= width;

                bestNode.height:= height;

                bestShortSideFit:= shortSideFit;

                bestLongSideFit:= longSideFit;

            end;

        end;

        if (ri.width >= height) and (ri.height >= width) then

        begin

            leftoverHoriz:= Abs(ri.width - height);

            leftoverVert:= Abs(ri.height - width);

            shortSideFit:= Min(leftoverHoriz, leftoverVert);

            longSideFit:= Max(leftoverHoriz, leftoverVert);

            if (shortSideFit < bestShortSideFit) or

              ((shortSideFit = bestShortSideFit) and (longSideFit < bestLongSideFit)) then

            begin

                bestNode.x:= ri.x;

                bestNode.y:= ri.y;

                bestNode.width:= height;

                bestNode.height:= width;

                bestShortSideFit:= shortSideFit;

                bestLongSideFit:= longSideFit;

            end;

        end;

    end;

    findPositionForNewNodeBestShortSideFit:= bestNode;

end;

function scoreRect(var list: RectangleList; width, height: LongInt; var score1, score2: LongInt): Rectangle;

var

    newNode: Rectangle;

begin

    newNode:= findPositionForNewNodeBestShortSideFit(list, width, height, score1, score2);

    // Cannot fit the current rectangle.

    if newNode.height = 0 then

    begin

        score1:= $7FFFFFFF;

        score2:= $7FFFFFFF;

    end;

    scoreRect:= newNode;

end;

function splitFreeNode(var freeRectangles: RectangleList; freeNode, usedNode: Rectangle): boolean;

var

    newNode: Rectangle;

begin

    // Test with SAT if the rectangles even intersect.

    if (usedNode.x >= freeNode.x + freeNode.width) or (usedNode.x + usedNode.width <= freeNode.x) or

       (usedNode.y >= freeNode.y + freeNode.height) or (usedNode.y + usedNode.height <= freeNode.y) then

    begin

        splitFreeNode:=false;

        exit;

    end;

    if (usedNode.x < freeNode.x + freeNode.width) and (usedNode.x + usedNode.width > freeNode.x) then

    begin

        // New node at the top side of the used node.

        if (usedNode.y > freeNode.y) and (usedNode.y < freeNode.y + freeNode.height) then

        begin

            newNode:= freeNode;

            newNode.height:= usedNode.y - newNode.y;

            rectangleListAdd(freeRectangles, newNode);

        end;

        // New node at the bottom side of the used node.

        if (usedNode.y + usedNode.height < freeNode.y + freeNode.height) then

        begin

            newNode:= freeNode;

            newNode.y:= usedNode.y + usedNode.height;

            newNode.height:= freeNode.y + freeNode.height - (usedNode.y + usedNode.height);

            rectangleListAdd(freeRectangles, newNode);

        end;

    end;

    if (usedNode.y < freeNode.y + freeNode.height) and (usedNode.y + usedNode.height > freeNode.y) then

    begin

        // New node at the left side of the used node.

        if (usedNode.x > freeNode.x) and (usedNode.y < freeNode.y + freeNode.width) then

        begin

            newNode:= freeNode;

            newNode.width:= usedNode.x - newNode.x;

            rectangleListAdd(freeRectangles, newNode);

        end;

        // New node at the right side of the used node.

        if (usedNode.x + usedNode.width < freeNode.x + freeNode.width) then

        begin

            newNode:= freeNode;

            newNode.x:= usedNode.x + usedNode.width;

            newNode.width:= freeNode.x + freeNode.width - (usedNode.x + usedNode.width);

            rectangleListAdd(freeRectangles, newNode);

        end;

  end;

  splitFreeNode:= true;

end;

procedure pruneFreeList(var freeRectangles: RectangleList);

var

  i, j: LongInt;

begin

    // 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 (isContainedIn(freeRectangles.data[i], freeRectangles.data[j])) then

            begin

                rectangleListRemoveAt(freeRectangles, i);

                dec(i);

                break;

            end;

            if (isContainedIn(freeRectangles.data[j], freeRectangles.data[i])) then

                rectangleListRemoveAt(freeRectangles, j)

            else

                inc(j);

        end;

        inc(i);

    end;

end;

function atlasInsertAdaptive(var a: Atlas; sz: Size; var output: Rectangle): boolean;

var

    newNode: Rectangle;

    score1, score2: LongInt;

    numRectanglesToProcess: LongInt;

    i: LongInt;

begin

    newNode:= findPositionForNewNodeBestShortSideFit(a.freeRectangles, sz.width, sz.height, score1, score2);

    if newNode.height = 0 then

    begin

        output:= newNode;

        output.UserData:= nil;

        atlasInsertAdaptive:= false;

        exit;

    end;

    numRectanglesToProcess:= a.freeRectangles.count;

    i:=0;

    while i < numRectanglesToProcess do

    begin

        if splitFreeNode(a.freeRectangles, a.freeRectangles.data[i], newNode) then

        begin

            rectangleListRemoveAt(a.freeRectangles, i);

            dec(numRectanglesToProcess);

        end

        else

            inc(i);

    end;

    pruneFreeList(a.freeRectangles);

    newNode.UserData:= sz.UserData;

    rectangleListAdd(a.usedRectangles, newNode);

    output:= newNode;

    atlasInsertAdaptive:= true;

end;

procedure placeRect(var a: Atlas; node: Rectangle);

var

    numRectanglesToProcess: LongInt;

    i: LongInt;

begin

    numRectanglesToProcess:= a.freeRectangles.Count;

    i:= 0;

    while i < numRectanglesToProcess do

    begin

        if not splitFreeNode(a.freeRectangles, a.freeRectangles.data[i], node) then

            inc(i)

        else

        begin

            rectangleListRemoveAt(a.freeRectangles, i);

            dec(numRectanglesToProcess);

        end;

    end;

    pruneFreeList(a.freeRectangles);

    rectangleListAdd(a.usedRectangles, node);

end;

function atlasInsertSet(var a: Atlas; var input: SizeList; var outputs: RectangleList): boolean;

var

    bestScore1, bestScore2, bestRectIndex: LongInt;

    score1, score2: LongInt;

    bestNode, newNode: Rectangle;

    i: LongInt;

    sz: Size;

begin

    atlasInsertSet:= false;

    while input.count > 0 do

    begin

        bestScore1:= $7FFFFFFF;

        bestScore2:= $7FFFFFFF;

        bestRectIndex:= -1;

        for i:=0 to pred(input.count) do

        begin

            sz:= input.data[i];

            newNode:= scoreRect(a.freeRectangles, sz.width, sz.height, score1, score2);

            if (score1 >= bestScore1) and ((score1 <> bestScore1) or (score2 >= bestScore2)) then

                continue;

            bestScore1:= score1;

            bestScore2:= score2;

            bestNode:= newNode;

            bestRectIndex:= i;

        end;

        if bestRectIndex = -1 then

            exit;

        bestNode.UserData:= input.data[bestRectIndex].UserData;

        placeRect(a, bestNode);

        rectangleListAdd(outputs, bestNode);

        sizeListRemoveAt(input, bestRectIndex);

    end;

    atlasInsertSet:= true;

end;

function atlasNew(width, height: LongInt): Atlas;

var

    a: Atlas;

    r: Rectangle;

begin

    rectangleListInit(a.freeRectangles);

    rectangleListInit(a.usedRectangles);

    a.width:= width;

    a.height:= height;

    r.x:= 0;

    r.y:= 0;

    r.width:= width;

    r.height:= height;

    rectangleListAdd(a.freeRectangles, r);

    atlasNew:=a;

end;

procedure atlasDelete(var a: atlas);

begin

    rectangleListClear(a.freeRectangles);

    rectangleListClear(a.usedRectangles);

end;

procedure atlasReset(var a: atlas);

begin

    atlasDelete(a);

    a:=atlasNew(a.width, a.height);

end;

begin

end.