{- 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 Geometry.Data import Data.Tile 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} randomiseLinksBy :: ( [(Point2,Float)] -> State g [(Point2,Float)] ) -> Room -> State g Room randomiseLinksBy f r = do newLinks <- f $ _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]} {- | Swaps the last link in the list with one that satisfies a given - property (it might swap with itself). Unsafe. -} 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 (V2 0 0 -.- rotateV (pi-a) p , 0) $ shiftRoomBy (V2 0 0 ,pi-a) r where (p,a) = last $ _rmLinks r shiftRoomBy :: (Point2,Float) -> Room -> Room shiftRoomBy shift r = r & rmPolys %~ fmap (map (shiftPointBy shift)) & rmLinks %~ fmap (shiftLinkBy shift) & rmPath %~ map (shiftPathPointBy shift) & rmPS %~ fmap (shiftPSBy shift) & rmBound %~ fmap (map (shiftPointBy shift)) & rmFloor %~ map ( (tilePoly %~ map (shiftPointBy shift)) . (tileCenter %~ shiftPointBy shift ) . (tileX %~ shiftPointBy shift ) . (tileY %~ shiftPointBy shift ) ) shiftLinkBy :: (Point2,Float) -> (Point2,Float) -> (Point2,Float) shiftLinkBy (pos,rot) (p,r) = (shiftPointBy (pos,rot) p, r + rot) shiftPSBy :: (Point2,Float) -> Placement -> Placement shiftPSBy (pos,rot) ps = ps & placementSpot . psPos %~ shiftPointBy (pos,rot) & placementSpot . psRot %~ (+ rot) shiftPathPointBy :: (Point2,Float) -> (Point2,Point2) -> (Point2,Point2) shiftPathPointBy s (p1,p2) = (shiftPointBy s p1, shiftPointBy s p2)