Start to implement lock and key system

src/Dodge/Layout/Tree/Annotate.hs

@@ -11,6 +11,7 @@ import Dodge.Room.Procedural
 import Dodge.Room.Branch
 import Dodge.Room.Door
 import Dodge.Room.Boss
+import Dodge.Room.Treasure
 import Dodge.Room.Link
 import Dodge.Room.Data
 import Dodge.Room
@@ -34,7 +35,7 @@ data Annotation g
     | OrAno [[Annotation g]]
     | SpecificRoom (State g (Tree (Either Room Room)))
     | BossAno Creature
-    | TreasureAno [Creature] Item
+    | TreasureAno [Creature] [Item]
 
 addLock :: RandomGen g => Int -> Tree [Annotation g] -> State g (Tree [Annotation g])
 addLock i t = do
@@ -49,12 +50,13 @@ randomPadCorridors :: RandomGen g => Tree [Annotation g] -> State g (Tree [Annot
 randomPadCorridors  (Node x xs) = do
     n <- state $ randomR (1, 3)
     xs' <- mapM randomPadCorridors xs
-    return $ treeTrunk (replicate n [Corridor]) (Node x xs')
+    return $ treeFromTrunk (replicate n [Corridor]) (Node x xs')
 
 roomThenCorridor :: RandomGen g => Room -> State g (Tree (Either Room Room))
 roomThenCorridor theRoom = fmap (\r -> Node (Left theRoom) [(pure . Right) r]) 
                                 (randomiseOutLinks corridor)
 
+
 annoToRoomTree :: RandomGen g => [Annotation g] -> State g (Tree (Either Room Room))
 annoToRoomTree [OrAno as] = do
     a <- takeOne as
@@ -74,6 +76,8 @@ annoToRoomTree [StartRoom] = do
     fmap (pure . Right) $ randomiseOutLinks (shiftRoomBy ((-20,-20),0) $ roomRectAutoLinks w h)
 annoToRoomTree (SpecificRoom rt:_) = rt
 annoToRoomTree (BossAno cr : _) = branchRectWith . fmap (pure . Left) $ bossRoom cr
+annoToRoomTree (TreasureAno crs loot : _) =
+    branchRectWith . fmap (pure . Left) $ lootRoom crs loot
 annoToRoomTree _ = do
     w <- state $ randomR (100,400)
     h <- state $ randomR (200,400)

src/Dodge/Layout/Tree/Polymorphic.hs

@@ -1,3 +1,12 @@
+{-
+Helpers for the manipulation of rose trees.
+Throughout, the _trunk_ refers to successive first children in the tree.
+For example, in the tree 
+
+>   Node a [ Node b [], Node c [Node d []] ]
+
+the nodes in the trunk are [a,b] (note that d is not the first child of b).
+ -}
 module Dodge.Layout.Tree.Polymorphic
     where
 import Dodge.RandomHelp
@@ -10,20 +19,20 @@ import System.Random
 Creates a linear tree.
 Safe.
 -}
-treePost :: [a] -> a -> Tree a
-treePost []     y = Node y []
-treePost (x:xs) y = Node x [treePost xs y]
+treeFromPost :: [a] -> a -> Tree a
+treeFromPost []     y = Node y []
+treeFromPost (x:xs) y = Node x [treeFromPost xs y]
 
 {-
 Creates a tree with one trunk branch, 
 input as a list, that ends in another tree.
 -}
-treeTrunk 
+treeFromTrunk 
     :: [a]      -- ^ The trunk
     -> Tree a   -- ^ The end of the tree
     -> Tree a
-treeTrunk [] t     = t
-treeTrunk (x:xs) t = Node x [treeTrunk xs t]
+treeFromTrunk [] t     = t
+treeFromTrunk (x:xs) t = Node x [treeFromTrunk xs t]
 
 {-
 Applies a function to the root of a tree.
@@ -43,6 +52,15 @@ applyToNode (i:is) f (Node x xs) = Node x (ys ++ [applyToNode is f z] ++ zs)
   where
     (ys, z:zs) = splitAt i xs
 
+{-
+Applies a function to the first node along a trunk that satisfies a given property.
+-}
+applyToSubTrunkBy :: (a -> Bool) -> (Tree a -> Tree a) -> Tree a -> Tree a
+applyToSubTrunkBy cond f (Node x (t:ts))
+    | cond x    = f (Node x (t:ts))
+    | otherwise = Node x (applyToSubTrunkBy cond f t : ts)
+applyToSubTrunkBy _ _ t = t
+
 zipTree :: Tree a -> Tree b -> Tree (a,b)
 zipTree (Node x xs) (Node y ys) = Node (x,y) $ zipWith zipTree xs ys
 
@@ -79,7 +97,7 @@ applyToRandomNode f t = do
     return $ applyToNode p f t
 
 {-
-Add a forest to the end of a tree.
+Add a forest to the end of a tree (along the trunk).
 -}
 addToTrunk :: Tree a -> [Tree a] -> Tree a
 addToTrunk (Node x []) f = Node x f