32 lines
809 B
Haskell
32 lines
809 B
Haskell
--{-# LANGUAGE TupleSections #-}
|
|
module Dodge.Cleat (
|
|
toLabel,
|
|
cleatOnward,
|
|
cleatSide,
|
|
rToOnward,
|
|
cleatLabel,
|
|
) where
|
|
|
|
import Control.Lens
|
|
import qualified Data.Set as S
|
|
import Data.Tree
|
|
import Dodge.Data.GenWorld
|
|
import Dodge.Tree.Compose
|
|
|
|
toLabel :: Int -> Room -> Maybe Room
|
|
toLabel i rm
|
|
| LabelCluster i `elem` rm ^?! rmClusterStatus . csLinks = Just rm
|
|
| otherwise = Nothing
|
|
|
|
rToOnward :: Monad m => String -> Tree Room -> m (MetaTree Room String)
|
|
rToOnward s = return . tToBTree s
|
|
|
|
cleatOnward :: Room -> Room
|
|
cleatOnward = rmClusterStatus . csLinks .~ S.singleton OnwardCluster
|
|
|
|
cleatSide :: Room -> Room
|
|
cleatSide = rmClusterStatus . csLinks . at SideCluster ?~ ()
|
|
|
|
cleatLabel :: Int -> Room -> Room
|
|
cleatLabel i = rmClusterStatus . csLinks .~ S.singleton (LabelCluster i)
|