tobischw · April 21, 2020 03:21 · Apr 21, 2020
diff --git a/BinPack.elm b/BinPack.elm
@@ -0,0 +1,106 @@
+-- This is just a really basic bin packer that does not allow for automatic resizing (yet)!
+-- See: https://codeincomplete.com/articles/bin-packing/
+
+
+module BinPack exposing (..)
+
+import Dict exposing (Dict)
+import List.Extra exposing (..)
+import Maybe.Extra exposing (..)
+
+
+type alias Node =
+    { x : Float
+    , y : Float
+    , w : Float
+    , h : Float
+    , used : Bool
+    , down : Maybe ChildNode
+    , right : Maybe ChildNode
+    }
+
+
+type ChildNode
+    = ChildNode Node
+
+
+
+-- This is the actual function being called in Main.elm
+
+
+pack : List Node -> Float -> Float -> List Node
+pack blocks width height =
+    let
+        root =
+            { x = 0, y = 0, w = width, h = height, used = False, down = Nothing, right = Nothing }
+
+        packing =
+           -- This is what I am partially struggling with, I am not sure if there's a better way.
+           -- We do need to sort by height.
+            List.map (fitBlock root) (blocks |> List.sortBy .h)
+    in
+    values packing
+
+
+fitBlock : Node -> Node -> Maybe Node
+fitBlock root block =
+    let
+        node =
+            findNode (Just root) block.w block.h
+    in
+    case node of
+        Just found ->
+            Just (splitNode found block.w block.h)
+
+        _ ->
+            Nothing
+
+
+findNode : Maybe Node -> Float -> Float -> Maybe Node
+findNode maybeRoot w h =
+    case maybeRoot of
+        Just root ->
+            if root.used then
+                let
+                    rightNode =
+                        findNode (unwrapChildNode root.right) w h
+
+                    downNode =
+                        findNode (unwrapChildNode root.down) w h
+                in
+                orLazy rightNode (\() -> downNode)
+
+            else if w <= root.w && h <= root.h then
+                Just root
+
+            else
+                Nothing
+
+        _ ->
+            Nothing
+
+
+
+-- I was struggling with this function especially, but it seems to work.
+-- I am sure there's a better way.
+
+
+unwrapChildNode : Maybe ChildNode -> Maybe Node
+unwrapChildNode node =
+    case node of
+        Just unwrap ->
+            case unwrap of
+                ChildNode final ->
+                    Just final
+
+        _ ->
+            Nothing
+
+
+splitNode : Node -> Float -> Float -> Node
+splitNode node w h =
+    { node
+        | used = True
+        , down = Just (ChildNode { x = node.x, y = node.y + h, w = node.w, h = node.h - h, used = False, down = Nothing, right = Nothing })
+        , right = Just (ChildNode { x = node.x + w, y = node.y, w = node.w - w, h = h, used = False, down = Nothing, right = Nothing })
+    }
No results found