{-
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
    where
import Dodge.LevelGen
import Dodge.LevelGen.Data
import Dodge.Room.Data
import Dodge.RandomHelp
import Geometry

import System.Random
import Control.Monad.State
import Control.Lens
import Data.List (delete)

{- Shuffle the initial links of a room randomly. -}
randomiseOutLinks :: RandomGen g => Room -> State g Room
randomiseOutLinks r = do
    newLinks <- shuffle $ init $ _rmLinks r
    return $ r {_rmLinks = newLinks ++ [last $ _rmLinks r]}

{- Shuffle all links of a room randomly. -}
randomiseAllLinks :: RandomGen g => Room -> State g Room
randomiseAllLinks r = do
    newLinks <- shuffle $ _rmLinks r
    return $ r {_rmLinks = newLinks}

filterLinks :: RandomGen g => ((Point2,Float) -> Bool) -> Room -> State g Room
filterLinks cond r = do
    newLinks <- shuffle $ filter cond $ init $ _rmLinks r
    return $ r {_rmLinks = newLinks ++ [last $ _rmLinks r]}

changeLinkTo :: RandomGen g => ((Point2,Float) -> Bool) -> Room -> State g Room
changeLinkTo cond r = do
    l <- takeOne $ filter cond $ _rmLinks r
    let newLinks = delete l (_rmLinks r) ++ [l]
    return $ r {_rmLinks = newLinks}

{- | Move a room so that the last link in '_rmLinks' 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 ((0,0) -.- (rotateV (pi-a) p),0) 
    $ shiftRoomBy ((0,0),pi-a)  r
  where 
    (p,a) = last $ _rmLinks r

shiftRoomBy :: (Point2,Float) -> Room -> Room
shiftRoomBy shift@(pos,rot) r = 
   over rmPolys (fmap (map (shiftPointBy shift)))
   $ over rmLinks (fmap (shiftLinkBy shift))
   $ over rmPath (map (shiftPathPointBy shift))
   $ over rmPS (fmap (shiftPSBy shift))
   $ over rmBound (map (shiftPointBy shift))
   r

shiftLinkBy (pos,rot) (p,r) = (shiftPointBy (pos,rot) p, r + rot)
shiftPSBy (pos,rot) ps = case ps of
    PS {} -> over psPos (shiftPointBy (pos,rot))
                            $ over psRot (+rot)
                            ps

shiftPathPointBy s (p1,p2) = (shiftPointBy s p1, shiftPointBy s p2)