{- |
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 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 :<| tseq)
--    | roomIsClipping = [] -- this is called too often--might get memoized?
--    | otherwise = case ts of
--        [] -> (r :) <$> shiftRoomTreeSearchAll newBounds tseq
--        (s:ss) -> concatMap (\l -> shiftRoomTreeSearchAll bs (Node (useLink l) ss <| (tseq |> f l s))) ls
    = case ts of
        [] | roomIsClipping -> []
        [] -> (r :) <$> shiftRoomTreeSearchAll newBounds tseq
        (s:ss) -> concatMap (\l -> shiftRoomTreeSearchAll bs (Node (useLink l) ss <| (tseq |> f l s))) ls
  where
    convexBounds = map pointsToPoly $ _rmBound r
    ls = init $ _rmLinks r
    newBounds = convexBounds ++ bs
    roomIsClipping = or (convexPolysOverlap <$> convexBounds <*> bs)
    useLink l = r & rmLinks %~ delete l
        & rmUsedLinks %~ (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 = fmap (map setLastLinkToUsed) . listToMaybe . shiftRoomTreeSearchAll [] . singleton
  where
    setLastLinkToUsed rm = case _rmLinks rm of
        (_:_) -> rm
            & rmLinks %~ init
            & rmUsedLinks %~ (last (_rmLinks rm) :)
        _ -> rm