diff -r ad4b6c2b09e8 -r 18430abfbcd2 hedgewars/uBinPacker.pas
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/hedgewars/uBinPacker.pas	Mon Jun 25 12:01:19 2012 +0200
@@ -0,0 +1,438 @@
+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.