module Dodge.RoomLink where
import Dodge.LevelGen.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 f = rmLinks %~ restrictLinkType InLink f

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

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

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
    }
lnkBothAnd :: RoomLinkType -> (Point2,Float) -> RoomLink
lnkBothAnd rlt (p,a) = RoomLink 
    {_rlType = S.fromList [OutLink,InLink,rlt]
    ,_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