40 lines
1.3 KiB
Haskell
40 lines
1.3 KiB
Haskell
--{-# LANGUAGE TupleSections #-}
|
|
|
|
-- | Annotating tree structures with desired properties for rooms.
|
|
module Dodge.Annotation (
|
|
module Dodge.Annotation.Data,
|
|
module Dodge.Annotation,
|
|
) where
|
|
|
|
import Data.Maybe
|
|
import Dodge.Annotation.Data
|
|
import Dodge.Cleat
|
|
--import Dodge.Data.GenWorld
|
|
import Dodge.Tree
|
|
import LensHelp
|
|
import RandomHelp
|
|
|
|
annoToRoomTree :: Annotation -> State LayoutVars MTRS
|
|
annoToRoomTree an = case an of
|
|
AnTree t -> 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
|
|
-- LayVars g i <- get
|
|
-- put $ LayVars g (i + 1)
|
|
-- annoToRoomTree (f i)
|
|
--PassthroughLockKeyLists ls ks i -> zoom lyGen $ do
|
|
PassthroughLockKeyLists ls ks -> do
|
|
i <- nextLayoutInt
|
|
(functionlockroom, randomitemidentity) <- takeOne ls
|
|
lr <- zoom lyGen $ functionlockroom i
|
|
ii <- zoom lyGen randomitemidentity
|
|
keyroom <- zoom lyGen . fromJust $ lookup ii ks
|
|
return $
|
|
MTree
|
|
("PassthroughLockKeyLists-" ++ show ii)
|
|
(NodeMTree $ MTree "RassThroughLockKeyLists" (NodeMTree lr) [MBranch (toLabel i) keyroom])
|
|
[]
|