Created
April 21, 2020 03:21
-
-
Save tobischw/573963a4d67429f8f8b264cb2642dde1 to your computer and use it in GitHub Desktop.
2D BinPack in Elm (currently broken)
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
-- 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 }) | |
} |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment