[bb] Box Packing by fredborg [ 1+ years ago ]

[BlitzBot]

Title : Box Packing
Author : fredborg
Posted : 1+ years ago

Description : An ultra fast method of packing boxes/rectangles. Could be used to pack several images into one big image, or pack a lightmap, or your suitcase!

It works best with a large amount of boxes with little variation in size, as it can waste a bit of space otherwise.
If the boxes vary a lot in size, it might be an idea to rotate them so that they are all wider than they are tall, or vice versa.

Packs a million boxes/rects in 4-5 seconds. That's 1000000 boxes!!!

The QuickSort is modified from Noel Cowers code archive entry!

Code :

Code (blitzbasic) Select Expand

Type box
Field id,x,y,w,h
End Type

Dim qSortBox.box(0)
Function QuickSortBoxes(l=-1,r=-1)

If l = -1
count = 0
For box.box = Each box
count = count + 1
Next
Dim qSortBox(count-1)
box.box = First box
For i = 0 To count-1
qSortBox(i) = box
box = After box
Next
l = 0
r = count-1
EndIf

Local A, B, SwapA#, SwapB#, Middle#
A = L
B = R

Middle = qSortBox( (L+R)/2 )h

While True

While qSortBox( A )h < Middle
A = A + 1
If A > R Then Exit
Wend

While  Middle < qSortBox( B )h
B = B - 1
If B < 0 Then Exit
Wend

If A > B Then Exit

box.box = qSortBox( A )
qSortBox( A ) = qSortBox( B )
qSortBox( B ) = box

A = A + 1
B = B - 1

If B < 0 Then Exit

Wend

If L < B Then QuickSortBoxes( L, B )
If A < R Then QuickSortBoxes( A, R )

If count>0
Insert qSortBox(0) Before First box
box.box = First box
For i = 1 To count-1
Insert qSortBox(i) After box
box = qSortBox(i)
Next
EndIf

End Function

Dim AlignMinY(0)
Function boxAlign()
;Purpose: align boxes
;Parameters: None
;return: None

QuickSortBoxes()

maxx = GraphicsWidth()
maxy = GraphicsHeight()

Dim AlignMinY(maxx)

For box.box = Each box
box2.box = After box
If box2<>Null
box2x = boxx+boxw
If box2x+box2w>maxx
box2x = 0
EndIf
EndIf
Next

For box.box = Each box
; Find the minimum y position for this box
miny = 0
For x = boxx To boxx+boxw-1
If AlignMinY(x)>miny Then miny = AlignMinY(x)
Next
boxy = miny

; Set the minimum y to the bottom edge of the box, for it's entire width
miny = boxy+boxh
For x = boxx To boxx+boxw-1
AlignMinY(x) = miny
Next
Next

End Function

.MAIN
Graphics 800,800,16,2
SetBuffer(BackBuffer())

SeedRnd MilliSecs()

;make some random sized boxes
For loop = 1 To 10000
box.box = New box
boxid=loop
boxw=Rnd(50)+10
boxh=Rnd(50)+10
Next

starttime=MilliSecs()
boxAlign()
stoptime=MilliSecs()-starttime

;display the boxes
boxarea# = 0
maxy = 0
maxx = 0
For box.box = Each box
Color 63,127,255
Rect boxx,boxy+16,boxw,boxh,False
boxarea = boxarea + boxw*boxh
If boxy+boxh>maxy Then maxy = boxy+boxh
If boxx+boxw>maxx Then maxx = boxx+boxw
Next
totarea# = maxx*maxy

Color 0,0,0
Rect 0,0,GraphicsWidth(),10,True
Color 255,255,255
Text GraphicsWidth()/2,0,"Boxes - "+(loop-1)+" | Time - "+stoptime+"ms | Area usage - "+((boxarea*100)/totarea)+"%",True

Flip()
WaitKey()
End

Comments :


Techlord(Posted 1+ years ago)

 In some cases it is better to sort from the largest to the smallest box. As in my case, sorting large images last resulted in undesired clipping.  To sort from large to small, you simply change a couple of lines in the QuickSortBoxes Function.Change Lines

Code Select Expand

While qSortBox( A )h < Middle

Code Select Expand

While  Middle < qSortBox( B )hTo

Code Select Expand

While qSortBox( A )h > Middle

Code Select Expand

While  Middle > qSortBox( B )h