1 unit uBinPacker;

     2 

     3 interface

     4 

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

     6 

     7 type Rectangle = record

     8     x, y, width, height: LongInt;

     9     UserData: Pointer;

    10 end;

    11 

    12 type Size = record

    13     width, height: LongInt;

    14     UserData: Pointer;

    15 end;

    16 

    17 type PRectangle = ^Rectangle;

    18 type PSize = ^Size;

    19 

    20 type RectangleList = record

    21     data: PRectangle;

    22     count: LongInt;

    23     size: LongInt;

    24 end;

    25 

    26 type SizeList = record

    27     data: PSize;

    28     count: LongInt;

    29     size: LongInt;

    30 end;

    31 

    32 type Atlas = record

    33     width, height: Longint;

    34     freeRectangles: RectangleList;

    35     usedRectangles: RectangleList;

    36 end;

    37 

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

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

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

    41 procedure atlasDelete(var a: Atlas);

    42 procedure atlasReset(var a: Atlas);

    43 

    44 procedure rectangleListInit(var list: RectangleList);

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

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

    47 procedure rectangleListClear(var list: RectangleList);

    48 procedure sizeListInit(var list: SizeList);

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

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

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

    52 procedure sizeListClear(var list: SizeList);

    53 

    54 implementation

    55 

    56 uses Math; // for min/max

    57 

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

    59 var

    60     i: Integer;

    61 begin

    62     i:=index;

    63     while (i + 1 < list.count) do

    64     begin

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

    66         inc(i);

    67     end;

    68     dec(list.count);

    69 end;

    70 

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

    72 begin

    73     if list.count >= list.size then

    74     begin

    75         inc(list.size, 512);

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

    77     end;

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

    79     inc(list.count);

    80 end;

    81 

    82 procedure rectangleListInit(var list: RectangleList);

    83 begin

    84     list.data:= nil;

    85     list.count:= 0;

    86     list.size:= 0;

    87 end;

    88 

    89 procedure rectangleListClear(var list: RectangleList);

    90 begin

    91     FreeMem(list.data);

    92     list.count:= 0;

    93     list.size:= 0;

    94 end;

    95 

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

    97 begin

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

    99     dec(list.count);

   100 end;

   101 

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

   103 begin

   104     if list.count >= list.size then

   105     begin

   106         inc(list.size, 512);

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

   108     end;

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

   110     inc(list.count);

   111 end;

   112 

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

   114 var

   115     sz: Size;

   116 begin

   117     sz.width:= width;

   118     sz.height:= height;

   119     sz.UserData:= UserData;

   120     sizeListAdd(list, sz);

   121 end;

   122 

   123 procedure sizeListInit(var list: SizeList);

   124 begin

   125     list.data:= nil;

   126     list.count:= 0;

   127     list.size:= 0;

   128 end;

   129 

   130 procedure sizeListClear(var list: SizeList);

   131 begin

   132     FreeMem(list.data);

   133     list.count:= 0;

   134     list.size:= 0;

   135 end;

   136 

   137 

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

   139 begin

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

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

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

   143 end;

   144 

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

   146      var bestShortSideFit, bestLongSideFit: LongInt): Rectangle;

   147 var

   148     bestNode: Rectangle;

   149     i: Integer;

   150     ri: Rectangle;

   151     leftoverHoriz, leftoverVert, shortSideFit, longSideFit: Longint;

   152 begin

   153     bestNode.x:= 0;

   154     bestNode.y:= 0;

   155     bestNode.width:= 0;

   156     bestNode.height:= 0;

   157     bestShortSideFit:= $7FFFFFFF;

   158 

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

   160     begin

   161         ri:= list.data[i];

   162 

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

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

   165         begin

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

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

   168             shortSideFit:= Min(leftoverHoriz, leftoverVert);

   169             longSideFit:= Max(leftoverHoriz, leftoverVert);

   170 

   171             if (shortSideFit < bestShortSideFit) or

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

   173             begin

   174                 bestNode.x:= ri.x;

   175                 bestNode.y:= ri.y;

   176                 bestNode.width:= width;

   177                 bestNode.height:= height;

   178                 bestShortSideFit:= shortSideFit;

   179                 bestLongSideFit:= longSideFit;

   180             end;

   181         end;

   182 

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

   184         begin

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

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

   187             shortSideFit:= Min(leftoverHoriz, leftoverVert);

   188             longSideFit:= Max(leftoverHoriz, leftoverVert);

   189 

   190             if (shortSideFit < bestShortSideFit) or

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

   192             begin

   193                 bestNode.x:= ri.x;

   194                 bestNode.y:= ri.y;

   195                 bestNode.width:= height;

   196                 bestNode.height:= width;

   197                 bestShortSideFit:= shortSideFit;

   198                 bestLongSideFit:= longSideFit;

   199             end;

   200         end;

   201     end;

   202 

   203     findPositionForNewNodeBestShortSideFit:= bestNode;

   204 end;

   205 

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

   207 var

   208     newNode: Rectangle;

   209 begin

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

   211 

   212     // Cannot fit the current rectangle.

   213     if newNode.height = 0 then

   214     begin

   215         score1:= $7FFFFFFF;

   216         score2:= $7FFFFFFF;

   217     end;

   218 

   219     scoreRect:= newNode;

   220 end;

   221 

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

   223 var

   224     newNode: Rectangle;

   225 begin

   226     // Test with SAT if the rectangles even intersect.

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

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

   229     begin

   230         splitFreeNode:=false;

   231         exit;

   232     end;

   233 

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

   235     begin

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

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

   238         begin

   239             newNode:= freeNode;

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

   241             rectangleListAdd(freeRectangles, newNode);

   242         end;

   243 

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

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

   246         begin

   247             newNode:= freeNode;

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

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

   250             rectangleListAdd(freeRectangles, newNode);

   251         end;

   252     end;

   253 

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

   255     begin

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

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

   258         begin

   259             newNode:= freeNode;

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

   261             rectangleListAdd(freeRectangles, newNode);

   262         end;

   263 

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

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

   266         begin

   267             newNode:= freeNode;

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

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

   270             rectangleListAdd(freeRectangles, newNode);

   271         end;

   272   end;

   273 

   274   splitFreeNode:= true;

   275 end;

   276 

   277 procedure pruneFreeList(var freeRectangles: RectangleList);

   278 var

   279   i, j: LongInt;

   280 begin

   281     // Go through each pair and remove any rectangle that is redundant.

   282     i:= 0;

   283     while i < freeRectangles.count do

   284     begin

   285         j:= i + 1;

   286         while j < freeRectangles.count do

   287         begin  

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

   289             begin

   290                 rectangleListRemoveAt(freeRectangles, i);

   291                 dec(i);

   292                 break;

   293             end;

   294 

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

   296                 rectangleListRemoveAt(freeRectangles, j)

   297             else

   298                 inc(j);

   299         end;

   300         inc(i);

   301     end;

   302 end;

   303 

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

   305 var

   306     newNode: Rectangle;

   307     score1, score2: LongInt;

   308     numRectanglesToProcess: LongInt;

   309     i: LongInt;

   310 begin

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

   312     if newNode.height = 0 then

   313     begin

   314         output:= newNode;

   315         output.UserData:= nil;

   316         atlasInsertAdaptive:= false;

   317         exit;

   318     end;

   319 

   320     numRectanglesToProcess:= a.freeRectangles.count;

   321 

   322     i:=0;

   323     while i < numRectanglesToProcess do

   324     begin

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

   326         begin

   327             rectangleListRemoveAt(a.freeRectangles, i);

   328             dec(numRectanglesToProcess);

   329         end

   330         else

   331             inc(i);

   332     end;

   333     

   334     pruneFreeList(a.freeRectangles);

   335     newNode.UserData:= sz.UserData;

   336     rectangleListAdd(a.usedRectangles, newNode);

   337     output:= newNode;

   338     atlasInsertAdaptive:= true;

   339 end;

   340 

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

   342 var

   343     numRectanglesToProcess: LongInt;

   344     i: LongInt;

   345 begin

   346     numRectanglesToProcess:= a.freeRectangles.Count;

   347 

   348     i:= 0;

   349     while i < numRectanglesToProcess do

   350     begin

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

   352             inc(i)

   353         else

   354         begin

   355             rectangleListRemoveAt(a.freeRectangles, i);

   356             dec(numRectanglesToProcess);

   357         end;

   358     end;

   359 

   360     pruneFreeList(a.freeRectangles);

   361     rectangleListAdd(a.usedRectangles, node);

   362 end;

   363 

   364 

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

   366 var

   367     bestScore1, bestScore2, bestRectIndex: LongInt;

   368     score1, score2: LongInt;

   369     bestNode, newNode: Rectangle;

   370     i: LongInt;

   371     sz: Size;

   372 begin

   373     atlasInsertSet:= false;

   374 

   375     while input.count > 0 do

   376     begin

   377         bestScore1:= $7FFFFFFF;

   378         bestScore2:= $7FFFFFFF;

   379         bestRectIndex:= -1;

   380     

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

   382         begin

   383             sz:= input.data[i];

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

   385 

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

   387                 continue;

   388 

   389             bestScore1:= score1;

   390             bestScore2:= score2;

   391             bestNode:= newNode;

   392             bestRectIndex:= i;

   393         end;

   394 

   395         if bestRectIndex = -1 then

   396             exit;

   397 

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

   399         placeRect(a, bestNode);

   400         rectangleListAdd(outputs, bestNode);

   401         sizeListRemoveAt(input, bestRectIndex);

   402     end;

   403     atlasInsertSet:= true;

   404 end;

   405 

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

   407 var

   408     a: Atlas;

   409     r: Rectangle;

   410 begin

   411     rectangleListInit(a.freeRectangles);

   412     rectangleListInit(a.usedRectangles);

   413 

   414     a.width:= width;

   415     a.height:= height;

   416     r.x:= 0;

   417     r.y:= 0;

   418     r.width:= width;

   419     r.height:= height;

   420     rectangleListAdd(a.freeRectangles, r);

   421 

   422     atlasNew:=a;

   423 end;

   424 

   425 procedure atlasDelete(var a: atlas);

   426 begin

   427     rectangleListClear(a.freeRectangles);

   428     rectangleListClear(a.usedRectangles);

   429 end;

   430 

   431 procedure atlasReset(var a: atlas);

   432 begin

   433     atlasDelete(a);

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

   435 end;

   436 

   437 begin

   438 end.