{- |
Given a tree of rooms, tries to shift them into place in such a way that their
links connect and that none of them clip.
Returns a list; after this step the structure is determined by the actual positions of rooms.
 -}
module Dodge.Layout.Tree.Shift
    ( shiftRoomTreeSearchAll
    , shiftExpandTree
    ) where
import Dodge.Room.Data
import Dodge.Room.Link
import Dodge.Layout.Tree.Polymorphic
import Geometry.ConvexPoly
--import Geometry.Data

import Data.Tree
import Data.Sequence hiding (zipWith)
import Data.List (delete)
import Data.Maybe (listToMaybe)
import Control.Lens hiding (Empty, (<|) , (|>))
{- | All: Depth first search of trees of rooms, produces a list of lists of rooms that are not clipping.  -}
shiftRoomTreeSearchAll 
    :: [ConvexPoly]       -- ^ Clipping bounds
    -> Seq (Tree Room)  -- ^ Rooms to be added
    -> [[Room]]
shiftRoomTreeSearchAll _ Empty = [[]]
shiftRoomTreeSearchAll bs (Node r ts :<| ts')
    | roomIsClipping = [] -- this is called too often, but whatever
    | otherwise = case ts of
        [] -> (r :) <$> shiftRoomTreeSearchAll newBounds ts'
        (s:ss) -> concatMap (\l -> shiftRoomTreeSearchAll bs (Node (rm l) ss <| (ts' |> f l s))) ls
  where
    convexBounds = map pointsToPoly $ _rmBound r
    ls = init $ _rmLinks r
    newBounds = convexBounds ++ bs
    roomIsClipping = or (convexPolysOverlap <$> convexBounds <*> bs)
    rm l = r & rmLinks %~ delete l
    f l = applyToRoot (shiftRoomToLink l)
{- |
Depth first search of trees of rooms, maybe produces a list rooms that are not clipping.
 -}
shiftExpandTree :: Tree Room -> Maybe [Room]
shiftExpandTree = listToMaybe . shiftRoomTreeSearchAll [] . singleton