use AppleScript version "2.4"
use framework "Foundation"
use scripting additions

–Packaging Target Area
set binSizeX to 600
set binSizeY to 600

set packRes to packKeynoteObjectsOnCurrentSlide(binSizeX, binSizeY) of me

on packKeynoteObjectsOnCurrentSlide(binSizeX, binSizeY)
　　set {tList, a0List} to retRectsFromKeynote() of me
　　
　　set aList to sortList2DDecending(a0List, {"myWidth", "myHeight", "myArea"}) of me –Sorting key is Width(main) and Area(sub) and Height(sub)
　　
　　set aRes to twoDBinPacking(binSizeX, binSizeY, aList) of me
　　if aRes = false then return false
　　
　　tell application "Keynote"
　　　　tell front document
　　　　　　tell current slide
　　　　　　　　repeat with i in aRes
　　　　　　　　　　set {posX, posY} to myPos of i
　　　　　　　　　　set itemIndex to myID of i
　　　　　　　　　　set aDeg to myDegree of i
　　　　　　　　　　
　　　　　　　　　　–sample data {itemCounter:5, myWidth:573, myHeight:52, myArea:29796}
　　　　　　　　　　set anObjID to itemCounter of (item itemIndex of aList)
　　　　　　　　　　
　　　　　　　　　　set rotation of iWork item anObjID to aDeg
　　　　　　　　　　set position of iWork item anObjID to {posX, posY}
　　　　　　　　end repeat
　　　　　　end tell
　　　　end tell
　　end tell
　　
　　return true
end packKeynoteObjectsOnCurrentSlide

on twoDBinPacking(binSizeX as integer, binSizeY as integer, boxList as list)
　　set aParamList to {binSizeX, binSizeY}
　　
　　repeat with i in boxList
　　　　–copy i to {tmpID, tmpX, tmpY, tmpArea}
　　　　— {itemCounter:iCount, myWidth:aWidth, myHeight:aHeight, myArea:anArea}
　　　　set tmpID to itemCounter of i
　　　　set tmpX to myWidth of i
　　　　set tmpY to myHeight of i
　　　　set tmpArea to myArea of i
　　　　
　　　　set aParamList to aParamList & tmpX
　　　　set aParamList to aParamList & tmpY
　　end repeat
　　
　　set aParam to retDelimitedText(aParamList, " ") of me
　　–> "800 800 340 243 340 73 340 73 155 240 147 125 147 125 147 125 147 125"
　　
　　–Parameters for result parsing
　　set s1Str to "Packed to (x,y)=("
　　set s2Str to ")"
　　set s3Str to ","
　　
　　set cpuRes to CPU type of (system info)
　　if cpuRes begins with "ARM" then
　　　　set exName to "arm"
　　else if cpuRes begins with "Intel" then
　　　　set exName to "x86"
　　end if
　　
　　set binName to "BinPackTest_" & exName
　　set aPath to POSIX path of (path to resource binName)
　　
　　try
　　　　set aRes to do shell script quoted form of aPath & " " & aParam
　　on error
　　　　return false
　　end try
　　
　　if aRes does not end with "Done. All rectangles packed." then return false
　　
　　set aList to paragraphs of aRes
　　
　　set bList to {}
　　set aCount to 1
　　repeat with i in aList
　　　　set j to contents of i
　　　　if j begins with "Packing rectangle of size " and j does not contain "Failed!" then
　　　　　　set xyRes to pickUpFromToStrAndParse(j, s1Str, s2Str, s3Str) of me
　　　　　　
　　　　　　–RectangleBinPackがオブジェクトの回転をサポートしているため、その対処
　　　　　　if xyRes is not equal to false then
　　　　　　　　set s11Str to "(w,h)=("
　　　　　　　　set s12Str to ")"
　　　　　　　　set s13Str to ","
　　　　　　　　
　　　　　　　　set whRes to pickUpFromToStrAndParse(j, s11Str, s12Str, s13Str) of me
　　　　　　　　set tmpBox to item aCount of boxList
　　　　　　　　
　　　　　　　　— {itemCounter:5, myWidth:573, myHeight:52, myArea:29796}
　　　　　　　　–copy tmpBox to {tmpID, tmpX, tmpY, tmpArea}
　　　　　　　　set tmpID to itemCounter of tmpBox
　　　　　　　　set tmpX to myWidth of tmpBox
　　　　　　　　set tmpY to myHeight of tmpBox
　　　　　　　　set tmpArea to myArea of tmpBox
　　　　　　　　
　　　　　　　　if whRes = {tmpX, tmpY} then
　　　　　　　　　　set aDeg to 0
　　　　　　　　else if whRes = {tmpY, tmpX} then
　　　　　　　　　　set aDeg to 90
　　　　　　　　else
　　　　　　　　　　return false
　　　　　　　　end if
　　　　　　　　
　　　　　　　　set the end of bList to {myPos:xyRes, myID:aCount, myDegree:aDeg}
　　　　　　end if
　　　　　　set aCount to aCount + 1
　　　　end if
　　end repeat
　　
　　return bList
end twoDBinPacking

on pickUpFromToStrAndParse(aStr as string, s1Str as string, s2Str as string, s3Str as string)
　　set a1Offset to offset of s1Str in aStr
　　if a1Offset = 0 then return false
　　set bStr to text (a1Offset + (length of s1Str)) thru -1 of aStr
　　
　　set a2Offset to offset of s2Str in bStr
　　if a2Offset = 0 then return false
　　
　　set cStr to text 1 thru (a2Offset – (length of s2Str)) of bStr
　　set {x, y} to parseByDelim(cStr, s3Str) of me
　　
　　return {x as integer, y as integer}
end pickUpFromToStrAndParse

on parseByDelim(aData, aDelim)
　　set curDelim to AppleScript’s text item delimiters
　　set AppleScript’s text item delimiters to aDelim
　　set dList to text items of aData
　　set AppleScript’s text item delimiters to curDelim
　　return dList
end parseByDelim

–リストを指定デリミタでテキスト化
on retDelimitedText(aList, aNewDelim)
　　set aText to ""
　　set curDelim to AppleScript’s text item delimiters
　　set AppleScript’s text item delimiters to aNewDelim
　　set aText to aList as text
　　set AppleScript’s text item delimiters to curDelim
　　return aText
end retDelimitedText

on retRectsFromKeynote()
　　tell application "Keynote"
　　　　tell front document
　　　　　　tell current slide
　　　　　　　　set tList to every iWork item
　　　　　　　　set bList to {}
　　　　　　　　set iCount to 1
　　　　　　　　
　　　　　　　　repeat with i in tList
　　　　　　　　　　set aWidth to width of i
　　　　　　　　　　set aHeight to height of i
　　　　　　　　　　set {xPos, yPos} to position of i
　　　　　　　　　　set anArea to aWidth * aHeight
　　　　　　　　　　
　　　　　　　　　　set the end of bList to {itemCounter:iCount, myWidth:aWidth, myHeight:aHeight, myArea:anArea}
　　　　　　　　　　set iCount to iCount + 1
　　　　　　　　end repeat
　　　　　　　　
　　　　　　　　return {tList, bList}
　　　　　　end tell
　　　　end tell
　　end tell
end retRectsFromKeynote

–入れ子のリストを降順ソート
on sortList2DDecending(a, keyLabelList)
　　set fLen to length of keyLabelList
　　set fList to {}
　　
　　repeat fLen times
　　　　set the end of fList to false
　　end repeat
　　
　　return cocoaSortListAscending(a, keyLabelList, fList) of me
end sortList2DDecending