38 lines
1.2 KiB
Haskell
38 lines
1.2 KiB
Haskell
--{-# LANGUAGE TupleSections #-}
|
|
{- | Annotating tree structures with desired properties for rooms. -}
|
|
module Dodge.Annotation
|
|
( module Dodge.Annotation.Data
|
|
, module Dodge.Annotation
|
|
) where
|
|
import Dodge.Cleat
|
|
import RandomHelp
|
|
import Dodge.Tree
|
|
import Dodge.Data
|
|
import Dodge.Annotation.Data
|
|
import LensHelp
|
|
|
|
--import Control.Lens
|
|
import Data.Maybe
|
|
|
|
annoToRoomTree :: Annotation -> State (StdGen,Int) MTRS
|
|
annoToRoomTree an = case an of
|
|
AnTree t -> zoom _1 t
|
|
AnRoom r -> MTree "SingleRoom" . NodeTree . pure . (rmClusterStatus . csLinks . at OnwardCluster ?~ ()) <$> zoom _1 r <*> return []
|
|
OnwardList ans -> do
|
|
mts <- mapM annoToRoomTree ans
|
|
return $ foldr1 attachOnward' mts
|
|
IntAnno f -> do
|
|
(g,i) <- get
|
|
put (g,i+1)
|
|
annoToRoomTree (f i)
|
|
ModifyTree f a -> f <$> annoToRoomTree a
|
|
PassthroughLockKeyLists ls ks i -> zoom _1 $ do
|
|
(functionlockroom,randomitemidentity) <- takeOne ls
|
|
lr <- functionlockroom i
|
|
ii <- randomitemidentity
|
|
keyroom <- fromJust $ lookup ii ks
|
|
return $ MTree ("PassthroughLockKeyLists-"++show ii)
|
|
(NodeMTree $ MTree "RassThroughLockKeyLists" (NodeMTree lr) [MBranch (toLabel i) keyroom])
|
|
[]
|
|
|