module Dodge.RoomLink 
    ( muout
    , muin
    , outLink
    , inLink
    , restrictLinkType
    , overLnkType
    , lnkPosDir
    , overLnkPosDir
    , toBothLnk
    , rmInLinks
    , rmOutLinks
    , setOutLinksPD
    , setOutLinksByType
    , setInLinksPD
    , restrictOutLinks
    , restrictInLinks
    , setOutLinks
    , setInLinks
    , setInLinksByType
    , setLinkType
    , getLinksOfType
    , swapInOutLinks
    ) where
--import Dodge.LevelGen.Data
import Dodge.Data
import Geometry

import Data.List (partition)
import qualified Data.Set as S
import Control.Lens

restrictLinkType :: RoomLinkType -> ((Point2,Float) -> Bool) -> [RoomLink] -> [RoomLink]
restrictLinkType rlt f = map g
  where
    g rl | f $ rlPosDir rl  = rl
         | otherwise        = rl & rlType %~ S.delete rlt

getLinksOfType :: RoomLinkType -> [RoomLink] -> [RoomLink]
getLinksOfType lt = filter (S.member lt . _rlType)

restrictInLinks :: ((Point2,Float) -> Bool) -> Room -> Room
restrictInLinks = over rmLinks . restrictLinkType InLink

restrictOutLinks :: ((Point2,Float) -> Bool) -> Room -> Room
restrictOutLinks f = rmLinks %~ restrictLinkType OutLink f

setOutLinks :: (RoomLink -> Bool) -> [RoomLink] -> [RoomLink]
setOutLinks = setLinkType OutLink

setInLinks :: (RoomLink -> Bool) -> [RoomLink] -> [RoomLink]
setInLinks = setLinkType InLink

setInLinksByType :: RoomLinkType -> [RoomLink] -> [RoomLink]
setInLinksByType lt = setInLinks (\rl -> lt `S.member` _rlType rl)

setOutLinksByType :: RoomLinkType -> [RoomLink] -> [RoomLink]
setOutLinksByType lt = setOutLinks (\rl -> lt `S.member` _rlType rl)

setLinkType :: RoomLinkType -> (RoomLink -> Bool) -> [RoomLink] -> [RoomLink]
setLinkType rlt f = map g
  where
    g rl | f rl  = rl & rlType %~ S.insert rlt
         | otherwise        = rl & rlType %~ S.delete rlt

setLinkTypePD :: RoomLinkType -> ((Point2,Float) -> Bool) -> [RoomLink] -> [RoomLink]
setLinkTypePD rlt f = map g
  where
    g rl | f $ rlPosDir rl  = rl & rlType %~ S.insert rlt
         | otherwise        = rl & rlType %~ S.delete rlt

setInLinksPD :: ((Point2,Float) -> Bool) -> Room -> Room
setInLinksPD f = rmLinks %~ setLinkTypePD InLink f

setOutLinksPD :: ((Point2,Float) -> Bool) -> Room -> Room
setOutLinksPD f = rmLinks %~ setLinkTypePD OutLink f

swapInOutLinks :: Room -> Room
swapInOutLinks = rmLinks %~ map (rlType %~ S.map f)
  where
    f InLink = OutLink
    f OutLink = InLink
    f x = x

overLnkType :: RoomLinkType -> ([RoomLink] -> [RoomLink]) -> Room -> Room
overLnkType lt f = rmLinks %~ g
  where
    g lnks = let (xs,ys) = partition (S.member lt . _rlType) lnks
        in f xs ++ ys

rlPosDir :: RoomLink -> (Point2,Float)
rlPosDir rl = (_rlPos rl, _rlDir rl)

lnkPosDir :: RoomLink -> (Point2,Float)
lnkPosDir rl = (_rlPos rl, _rlDir rl)

overLnkPosDir :: ((Point2,Float) -> (Point2,Float)) -> RoomLink -> RoomLink
overLnkPosDir f rl = rl & rlPos .~ p & rlDir .~ a
  where
    (p,a) = f (_rlPos rl,_rlDir rl)

outLink :: Point2 -> Float -> RoomLink
outLink p a = RoomLink
    {_rlType = S.singleton OutLink
    ,_rlPos = p 
    , _rlDir = a
    }
inLink :: Point2 -> Float -> RoomLink
inLink p a = RoomLink
    {_rlType = S.singleton InLink
    ,_rlPos = p 
    , _rlDir = a
    }

toBothLnk :: (Point2,Float) -> RoomLink
toBothLnk (p,a) = RoomLink 
    { _rlType = S.fromList [OutLink,InLink]
    , _rlPos = p 
    , _rlDir = a
    }
muout :: [(Point2,Float)] -> [RoomLink]
muout = map (uncurry outLink)
muin :: [(Point2,Float)] -> [RoomLink]
muin = map (uncurry inLink)

rmLinksOfType :: RoomLinkType -> Room -> [RoomLink]
rmLinksOfType lt = filter (S.member lt . _rlType) . _rmLinks
rmOutLinks,rmInLinks :: Room -> [RoomLink]
rmOutLinks = rmLinksOfType OutLink
rmInLinks = rmLinksOfType InLink
