{- | 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.
Creates a list of rooms; after this step the structure is determined by the actual positions of rooms.  -}
module Dodge.Tree.Shift
    ( positionRoomsFromTree
    ) where
import Dodge.LevelGen.Data
import Dodge.Room.Link
import Dodge.Tree.Polymorphic
import Geometry.ConvexPoly
import Geometry.Data
import Padding

import Data.Tree
import Data.Sequence hiding (zipWith)
import Data.List (delete)
import Data.Bifunctor
import Control.Lens hiding (Empty, (<|) , (|>))

type RoomInt = (Room,Int)

positionRoomsFromTree :: Tree RoomInt -> IO (Maybe [Room])
positionRoomsFromTree (Node (r,i) ts) = posRms (map pointsToPoly $ _rmBound r) (r,i) 0 ts Empty

posRms :: [ConvexPoly]
    -> RoomInt
    -> Int -- ^ the number of children already placed
    -> [Tree RoomInt]
    -> Seq (Tree RoomInt)
    -> IO (Maybe [Room])
posRms bounds (parent,_) _ [] st = case st of
    Empty -> return $ Just [parent]
    Node childi ts :<| tseq 
        -> fmap (finalLinksUpdate parent:) <$> posRms bounds childi 0 ts tseq
posRms bounds parenti numChild (t@(Node childi _):ts) tseq = do
    printInfo parenti numChild childi
    tryLinks (0::Int) (init $ _rmLinks parent)
  where
    parent = fst parenti
    tryLinks _ [] = putStrLn "all links tried" >> return Nothing
    tryLinks j (l:ls) 
        | clipping  = tryLinks (j+1) ls
        | otherwise = do
            putStrLn $ "placed at link " ++ show j
            mayrs <- posRms (convexBounds ++ bounds) 
                (first upr parenti) (numChild + 1) ts (tseq |> shiftedt)
            case mayrs of
                Nothing -> do
                    putStr "Backtrack: " 
                    printInfo parenti numChild childi
                    tryLinks (j+1) ls
                Just rs -> return (Just rs)
      where
        convexBounds = map pointsToPoly $ _rmBound r'
        clipping = or (convexPolysOverlap <$> convexBounds <*> bounds)
        upr rm = doLnkEff l $ rm & rmLinks %~ delete l & rmPos %~ (uncurry (UsedOutLink numChild) l :)
        l' = shiftLinkBy (_rmShift parent) l
        r' = doRoomShift . fst $ rootLabel shiftedt
        shiftedt = applyToRoot (first $ shiftRoomShiftToLink l') t

printInfo :: RoomInt -> Int -> RoomInt -> IO ()
printInfo (parentrm,parenti) childn (childrm,childi) = do
    putStr $ rpns 20 (_rmName childrm ++ "-" ++ show childi)
          ++ rpns 9 (" child " ++ show childn )
          ++ rpns 25 (" of " ++ _rmName parentrm ++ "-" ++ show parenti )
  where
    rpns x s = rightPadNoSquash x ' ' s

doLnkEff :: (Point2,Float) -> Room -> Room
doLnkEff x rm = case _rmLinkEff rm of
    (eff:effs) -> eff x $ rm & rmLinkEff .~ effs
    _ -> rm