{- Concerns link pairs of rooms.
Link pairs determine where rooms can attach to each other; each pair consists
of a position and a rotation.
The last link in the list is considered the incoming link, the other links are
the outgoing links.  -}
module Dodge.Room.Link
    ( shiftRoomShiftToLink
    , shiftRoomBy
    , shiftLinkBy
    , doRoomShift
    , sortOutLinksOn
    , filterSortOutLinksOn
    , randomiseAllLinks
    , shuffleLinks
    , filterLinks
    , changeLinkTo
    , changeLinkFrom
    , randomiseOutLinks
    , chooseOneInLink
    ) where
import Dodge.Placement.PlaceSpot
import Dodge.LevelGen.Data
import Dodge.RandomHelp
import Geometry
import Data.Tile
import Dodge.RoomLink

import System.Random
import Control.Monad.State
import Control.Lens
import Data.List
import qualified Data.Set as S
--import System.Random

chooseOneInLink :: RandomGen g => Room -> State g Room
chooseOneInLink r = restrictToFstInLink <$> shuffleLinks r

restrictToFstInLink :: Room -> Room
restrictToFstInLink = rmLinks %~ f
  where
    f (rl:xs) | S.member InLink (_rlType rl) = rl : restrictLinkType InLink (const False) xs
        | otherwise = rl : f xs
    f [] = []

{- Shuffle the initial links of a room randomly. -}
randomiseOutLinks :: RandomGen g => Room -> State g Room
randomiseOutLinks r = do
    let (outs,xs) = partition (S.member OutLink . _rlType) $ _rmLinks r
    newLinks <- shuffle outs
    return $ r {_rmLinks = newLinks ++ xs }

sortOutLinksOn :: Ord b => ((Point2,Float) -> b) -> Room -> Room
sortOutLinksOn f = overLnkType OutLink $ sortOn (f . lnkPosDir)

filterSortOutLinksOn :: Ord b => ((Point2,Float) -> Bool) -> ((Point2,Float) -> b) -> Room -> Room
filterSortOutLinksOn test f = overLnkType OutLink dosort
  where
    dosort [] = []
    dosort xs = let (ys,zs) = partition (test . lnkPosDir) xs
        in sortOn (f . lnkPosDir) ys ++ zs

{- Shuffle the order of all links of a room randomly. 
 - Note this does not change their types. -}
randomiseAllLinks :: RandomGen g => Room -> State g Room
randomiseAllLinks r = do
    newLinks <- shuffle $ _rmLinks r
    return $ r {_rmLinks = newLinks }
{- Shuffle the order of all links of a room randomly. 
 - Note this does not change their types. -}
shuffleLinks :: RandomGen g => Room -> State g Room
shuffleLinks r = do
    newLinks <- shuffle $ _rmLinks r
    return $ r {_rmLinks = newLinks }

--randomiseLinksBy 
--    :: ( [(Point2,Float)] -> State g [(Point2,Float)] )
--    -> Room
--    -> State g Room
--randomiseLinksBy f r = do
--    newLinks <- f $ _rmOutLinks r ++ _rmInLinks r
--    return $ r {_rmOutLinks = init newLinks
--                , _rmInLinks = [last newLinks]
--                }

filterLinks :: RandomGen g => ((Point2,Float) -> Bool) -> Room -> State g Room
filterLinks cond r = do
    newLinks <- shuffle $ filter (cond . lnkPosDir) $ _rmLinks r
    return $ r {_rmLinks = newLinks}
{- | Swaps the first link in the list with one that satisfies a given property.
 - Does not change the last link in the list -}
-- TODO replace all instances of this with something more sensible
changeLinkFrom :: RandomGen g => ((Point2,Float) -> Bool) -> Room -> State g Room
changeLinkFrom cond r = do
    let (possibleLnks,otherLnks) = partition (cond . lnkPosDir) $ _rmLinks r
    newLnks <- shuffle possibleLnks
    return $ r {_rmLinks = newLnks ++ otherLnks}
{- | Swaps the last link in the list with one that satisfies a given
 - property (it might swap with itself). Unsafe. 
 - Be careful about calling this after changeLinkFrom. -}
-- TODO replace with something more sensible
changeLinkTo :: RandomGen g => ((Point2,Float) -> Bool) -> Room -> State g Room
changeLinkTo cond r = do
    let alllinks = _rmLinks r
    l <- takeOne $ filter (cond . lnkPosDir) alllinks
    let l' = l & rlType .~ S.singleton InLink
    let newLinks = delete l alllinks
    return $ r & rmLinks .~ (l':newLinks)
{- | Move a room so that the first link in '_rmInLinks' lines up to 
an external point and direction.
This is intended to work when the external point is an outgoing link from another room.
-}
--shiftRoomToLink :: (Point2,Float) -> Room -> Room
--shiftRoomToLink l r 
--    = shiftRoomBy l 
--    . shiftRoomBy (V2 0 0       , pi-a)  
--    $ shiftRoomBy (V2 0 0 -.- p , 0) 
--    r
--  where 
--    (p,a) = lnkPosDir $ head $ _rmInLinks r

doRoomShift :: Room -> Room
doRoomShift rm = shiftRoomBy (_rmShift rm) rm & rmShift .~ _rmShift rm

-- NOTE placements, when placed, will be shifted by the value _rmShift
shiftRoomBy :: (Point2,Float) -> Room -> Room
shiftRoomBy shift r = r
    & rmPolys %~ fmap (map (shiftPointBy shift))
    & rmLinks %~ fmap (shiftLinkBy shift)
    & rmPath  %~ map (shiftPathBy shift)
    & rmBound %~ fmap (map (shiftPointBy shift))
    & rmShift %~ shiftPosDirBy shift
    & rmFloor %~ map 
        ( (tilePoly %~ map (shiftPointBy shift))
        . (tileZero %~ shiftPointBy shift    )
        . (tileX    %~ shiftPointBy shift         )
        )
    & rmViewpoints %~ map (shiftPointBy shift)

shiftRoomShiftToLink :: (Point2,Float) -> (Point2,Float) -> Room -> Room
shiftRoomShiftToLink l inlink r 
    = shiftRoomShiftBy l 
    . shiftRoomShiftBy (V2 0 0       , pi-a)  
    $ shiftRoomShiftBy (V2 0 0 -.- p , 0) 
    r
  where 
    (p,a) = inlink
-- NOTE placements, when placed, will be shifted by the value _rmShift
shiftRoomShiftBy :: (Point2,Float) -> Room -> Room
shiftRoomShiftBy shift r = r
    & rmShift %~ shiftPosDirBy shift

shiftPosDirBy :: (Point2,Float) -> (Point2,Float) -> (Point2,Float)
shiftPosDirBy (pos,rot) (p,r) = (shiftPointBy (pos,rot) p, r + rot)

shiftLinkBy :: (Point2,Float) -> RoomLink -> RoomLink
shiftLinkBy (pos,rot) = overLnkPosDir f
  where
    f (p,r) = (shiftPointBy (pos,rot) p, r + rot)

shiftPathBy  :: (Point2,Float) -> (Point2,Point2) -> (Point2,Point2) 
shiftPathBy s (p1,p2) = (shiftPointBy s p1, shiftPointBy s p2)