114 lines
4.0 KiB
Haskell
114 lines
4.0 KiB
Haskell
{- 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
|
|
( shiftRoomToLink
|
|
, shiftRoomBy
|
|
, randomiseAllLinks
|
|
, filterLinks
|
|
, changeLinkTo
|
|
, changeLinkFrom
|
|
, randomiseOutLinks
|
|
, randomiseLinksBy
|
|
, invShiftLinkBy
|
|
, setLastLinkToUsed
|
|
) where
|
|
import Dodge.LevelGen
|
|
import Dodge.Room.Data
|
|
import Dodge.RandomHelp
|
|
import Geometry
|
|
import Data.Tile
|
|
|
|
import System.Random
|
|
import Control.Monad.State
|
|
import Control.Lens
|
|
import Data.List
|
|
{- 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 first link in the list with one that satisfies a given property.
|
|
- Does not change the last link in the list -}
|
|
changeLinkFrom :: RandomGen g => ((Point2,Float) -> Bool) -> Room -> State g Room
|
|
changeLinkFrom cond r = do
|
|
let (possibleLnks,otherLnks) = partition cond . init $ _rmLinks r
|
|
newLnks <- shuffle possibleLnks
|
|
return $ r {_rmLinks = newLnks ++ otherLnks ++ [last $ _rmLinks r]}
|
|
{- | Swaps the last link in the list with one that satisfies a given
|
|
- property (it might swap with itself). Unsafe.
|
|
- Be careful about calling this after changeLinkFrom. -}
|
|
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 , pi-a)
|
|
$ shiftRoomBy (V2 0 0 -.- p , 0)
|
|
-- . shiftRoomBy (V2 0 0 -.- rotateV (pi-a) p , 0)
|
|
-- $ shiftRoomBy (V2 0 0 ,pi-a)
|
|
r
|
|
where
|
|
(p,a) = last $ _rmLinks r
|
|
-- NOTE placements are shifted by the room shift
|
|
shiftRoomBy :: (Point2,Float) -> Room -> Room
|
|
shiftRoomBy shift r = r
|
|
& rmPolys %~ fmap (map (shiftPointBy shift))
|
|
& rmLinks %~ fmap (shiftLinkBy shift)
|
|
& rmPath %~ map (shiftPathBy shift)
|
|
& rmBound %~ fmap (map (shiftPointBy shift))
|
|
& rmShift %~ shiftLinkBy shift
|
|
& rmFloor %~ map
|
|
( (tilePoly %~ map (shiftPointBy shift))
|
|
. (tileZero %~ shiftPointBy shift )
|
|
. (tileX %~ shiftPointBy shift )
|
|
)
|
|
& rmViewpoints %~ map (shiftPointBy shift)
|
|
|
|
shiftLinkBy :: (Point2,Float) -> (Point2,Float) -> (Point2,Float)
|
|
shiftLinkBy (pos,rot) (p,r) = (shiftPointBy (pos,rot) p, r + rot)
|
|
|
|
invShiftLinkBy :: (Point2,Float) -> (Point2,Float) -> (Point2,Float)
|
|
invShiftLinkBy (pos,rot) (p,r) = (invShiftPointBy (pos,rot) p, r - rot)
|
|
|
|
shiftPathBy
|
|
:: (Point2,Float)
|
|
-> (Point2,Point2)
|
|
-> (Point2,Point2)
|
|
shiftPathBy s (p1,p2) = (shiftPointBy s p1, shiftPointBy s p2)
|
|
|
|
setLastLinkToUsed :: Room -> Room
|
|
setLastLinkToUsed rm = case _rmLinks rm of
|
|
(_:_) -> rm
|
|
& rmLinks %~ init
|
|
& rmPos %~ (uncurry InLink (last (_rmLinks rm)) :)
|
|
_ -> rm
|