{- 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 Control.Lens
import qualified Data.Set as S
import Data.Tile
import Dodge.Data.GenWorld
import Dodge.Placement.Shift
import Dodge.RoomLink
import Dodge.ShiftPoint
import Geometry
import RandomHelp
import Data.Maybe

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 . each . each %~ shiftPointBy shift
        & rmLinks . each %~ shiftLinkBy shift
        & rmPath %~ S.map (shiftPathBy shift)
        & rmBound . each . each %~ shiftPointBy shift
        & rmShift %~ shiftPosDirBy shift
        & rmFloor . tiles . each %~ shiftTile shift
        & rmViewpoints . each %~ shiftPointBy shift

shiftTile :: Point2A -> Tile -> Tile
shiftTile shift tl = tl
    & tilePoly . each %~ shiftPointBy shift
    & tileZero %~ shiftPointBy s
    & tileTangentPos %~ shiftPointBy s
  where
    s = fromMaybe shift $ tl ^. tileZeroShift 

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)
                    . (tileTangentPos %~ 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 (0, pi - a)
        $ shiftRoomShiftBy (- 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