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 :
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 LinesWhile qSortBox( A )h < Middle
While Middle < qSortBox( B )h
To While qSortBox( A )h > Middle
While Middle > qSortBox( B )h