Crap.elm

import Mouse

main = drawNodes <~ foldp (flip applyMovement [0]) forest mouseShift

forest : Forest Rect
forest = [
    Rect (-200, 200) (100, 20) `nodes`
        [ Rect (100, 0) (75, 18) `nodes`
            [ leaf <| Rect (0, -60) (60, 15)
            , leaf <| Rect (0, -30) (60, 12)
            ]

        , Rect (0, -30) (75, 18) `nodes`
            [ leaf <| Rect (0, -60) (60, 15)
            , leaf <| Rect (0, -30) (60, 12)
            ]
        ]
    ]

----

both2 op (x, y) (a, b) = (op x a, op y b)
both  op (x, y)        = (op x,   op y)

(+.) = both2 (+)

(x, y) `between` ((a, b), (c, d)) = and
    [ x >= a && x <= c
    , y >= b && y <= d
    ]

data Side = W | S | A | D

type Point = (Int, Int)
type Size  = (Int, Int)

type Rect = 
    { point : Point
    , size  : Size
    --, from  : Side
    --, to    : Side
    }

data Tree a
    = Tree { payload : a, children : Forest a }

last2 : a -> (a, a) -> (a, a)
last2 x (_, a) = (a, x)

diff : (Point, Point) -> Point
diff (a, b) = both2 (-) a b

mouseShift : Signal Point
mouseShift = keepWhen Mouse.isDown (0, 0) (diff <~ (foldp last2 ((0, 0), (0, 0)) Mouse.position))

drawNodes : Forest Rect -> Element
drawNodes forest =
    collage 500 500 <| map drawTree forest

drawTree : Tree Rect -> Form
drawTree (Tree {payload, children}) =
    move' payload.point <| toForm <| collage 500 500
        [ filled red <| rect' payload.size
        , toForm <| drawNodes children
        ]

rect' : (Int, Int) -> Shape
rect' (x, y) = toFloat x `rect` toFloat y

move' : (Int, Int) -> Form -> Form
move' (x, y) = move (toFloat x, toFloat y)

type Forest a = [Tree a]

type Path = [Int]

applyMovement shift path forest =
    modifyAt path (shiftRect shift) forest

shiftRect move box = { box | point <- add move box.point }

add (x, y) (a, b) = (-x + a, y + b)

pathToClicked point forest = search (within point) forest

within pt box = pt `between` (box.point, both2 (+) box.point box.size)

searchTree : (a -> Bool) -> Tree a -> Maybe Path
searchTree pred (Tree {payload, children}) = if
    | pred payload -> Just []
    | otherwise    ->
        searchForest 0 pred children

searchForest : Int -> (a -> Bool) -> Forest a -> Maybe Path
searchForest index pred forest = case forest of
    tree :: rest -> case searchTree pred tree of
        Just result -> Just (index :: result)
        Nothing     -> searchForest (index + 1) pred rest

    [] ->
        Nothing

search : (a -> Bool) -> Forest a -> Path
search p f = case searchForest 0 p f of
    Just x -> x
    Nothing -> []

inside : Point -> Rect -> Bool
inside pt box = 
    pt `between` (box.point, box.point +. box.size)

leaf : a -> Tree a
leaf x = Tree { payload = x, children = [] }

nodes : a -> Forest a -> Tree a
nodes x xs = Tree { payload = x, children = xs }

testForest : Forest Int
testForest =
    [ leaf 0
    , nodes 2
        [ leaf 4
        , leaf 3
        ]
    , leaf 5
    ]

modifyAt : Path -> (a -> a) -> Forest a -> Forest a
modifyAt path transform trees = case path of
    [] ->
        trees

    [index] ->
        let (before, it :: after) = breakAt index trees in

        concat [before, [onPayload transform it], after]

    index :: rest ->
        let (before, Tree rec :: after) = breakAt index trees in

        concat [before, [Tree { rec | children <- modifyAt rest transform rec.children }], after]        

onPayload : (a -> a) -> Tree a -> Tree a
onPayload transform (Tree tree) = 
    Tree { tree | payload <- transform tree.payload }

breakAt index list =
    (take index list, drop index list)

odd x = x `mod` 2 == 1