100 lines
3.1 KiB
Haskell
100 lines
3.1 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
|
|
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)
|