{- 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
    , moveRoomBy
    , shiftLinkBy
    , doRoomShift
    , shuffleLinks
    , restrictRMInLinksPD
    ) where
import Dodge.ShiftPoint
--import Dodge.Placement.PlaceSpot
import Dodge.Placement.Shift
--import Dodge.LevelGen.Data
import Dodge.Data
import RandomHelp
import Geometry
import Data.Tile
import Dodge.RoomLink

import Control.Lens
import qualified Data.Set as S

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

{- 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 = rmLinks %%~ shuffle

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  %~ S.map (shiftPathBy shift)
    & rmBound %~ fmap (map (shiftPointBy shift))
    & rmShift %~ shiftPosDirBy shift
    & rmFloor . tiles %~ map 
        ( (tilePoly %~ map (shiftPointBy shift))
        . (tileZero %~ shiftPointBy shift      )
        . (tileX    %~ shiftPointBy shift      )
        )
    & rmViewpoints %~ map (shiftPointBy shift)

moveRoomBy :: (Point2,Float) -> Room -> Room
moveRoomBy shift r = r
    & rmPolys %~ fmap (map (shiftPointBy shift))
    & rmLinks %~ fmap (shiftLinkBy shift)
    & rmPath  %~ S.map (shiftPathBy shift)
    & rmBound %~ fmap (map (shiftPointBy shift))
    & rmPmnts %~ map (shiftPlacement shift)
    & rmFloor . tiles %~ map 
        ( (tilePoly %~ map (shiftPointBy shift))
        . (tileZero %~ shiftPointBy shift      )
        . (tileX    %~ shiftPointBy shift      )
        )
    & rmViewpoints %~ map (shiftPointBy shift)
    & rmPos %~ map ( ( rpPos %~ shiftPointBy shift ) . (rpDir +~ snd 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 = 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) = sp1 `seq` sp2 `seq` (sp1, sp2)
  where
    sp1 = shiftPointBy s p1
    sp2 = shiftPointBy s p2
