Cleanup

src/Dodge/Annotation.hs

@@ -45,13 +45,13 @@ anoToRoomTree anos = case anos of
     [AnoApplyInt i f] -> f i
     [SetLabel i randrm] -> do
         rm <- randrm
-        return . connectRoom $ rm & rmLabel ?~ i
+        return . singleUseAll $ rm & rmLabel ?~ i
     [UseLabel i randrm] -> do
         rm <- randrm
-        return $ connectRoom $ rm & rmTakeFrom ?~ i
+        return $ singleUseAll $ rm & rmTakeFrom ?~ i
     [ChainAnos ass] -> do
         rms <- mapM anoToRoomTree ass
-        return $ linkEitherTrees rms
+        return $ chainUses rms
     [OrAno as] -> do
         a <- takeOne as
         anoToRoomTree a
@@ -60,7 +60,7 @@ anoToRoomTree anos = case anos of
     [FirstWeapon] -> do
         branchWP <- branchRectWith weaponRoom
         blockedC <- longBlockedCorridor
-        join $ takeOne $ return (appendEitherTree branchWP [blockedC]) : replicate 5 weaponRoom
+        join $ takeOne $ return (passUntilUseAll branchWP [blockedC]) : replicate 5 weaponRoom
     [EndRoom] -> fmap (pure . UseAll) (telRoomLev 1)
     (SpecificRoom rt:_) -> rt
     (BossAno cr : _) -> do

src/Dodge/Annotation/Data.hs

@@ -5,7 +5,6 @@ import Dodge.Data
 import Dodge.Room
 import Dodge.Tree.Compose.Data
 
-import Data.Tree
 import Control.Monad.State
 import Control.Lens
 data Annotation g

src/Dodge/Floor.hs

@@ -94,7 +94,7 @@ initialAnoTree = padSucWithCorridors $ treeFromTrunk
 {- | A test level tree. -}
 initialRoomTree :: RandomGen g => State g (Tree Room)
 initialRoomTree = do
-    expandTreeBy id <$> mapM anoToRoomTree initialAnoTree
+    expandTree <$> mapM anoToRoomTree initialAnoTree
 
 layoutLevelFromSeed :: Int -> Int -> IO [Room]
 layoutLevelFromSeed i seed = do

src/Dodge/Room/Branch.hs

@@ -21,7 +21,5 @@ branchRectWith t = do
     y <- state $ randomR (100,200)
     b <- t
     root <- randomiseOutLinks $ roomRectAutoLinks x y
-    return $ Node (PassDown root) [Node (UseAll door) [], rToL <$> treeFromTrunk [PassDown door] b]
+    return $ Node (PassDown root) [Node (UseAll door) [], changeToPassDown <$> 
-  where 
+        treeFromTrunk [PassDown door] b]
-    rToL (UseAll r) = PassDown r
-    rToL (PassDown r)  = PassDown r

src/Dodge/Room/RoadBlock.hs

@@ -14,7 +14,6 @@ import Dodge.RandomHelp
 import Dodge.Creature
 import Dodge.Tree
 
-import Data.Tree
 import Control.Monad.State
 import Control.Lens
 import System.Random

src/Dodge/Room/Room.hs

@@ -77,7 +77,7 @@ glassLesson = do
     corridors <- replicateM i $ PassDown <$> randomiseOutLinks corridor
     return $ Node (PassDown botRoom) [singleUseNone door,uppers, treeFromPost (PassDown door : corridors) $ UseAll door]
   where 
-    uppers = Node (PassDown door) [deadRoom topRoom]
+    uppers = Node (PassDown door) [singleUseNone topRoom]
     botRoom = set rmPmnts botplmnts $ roomRect 200 200 1 1
     topRoom = set rmPmnts topplmnts $ roomRect 200 200 1 1
     botplmnts = 
@@ -171,7 +171,7 @@ miniRoom3 = do
                      ,sPS cp (pi/8+7*pi/4) b
                      ,sPS (V2 (w/2) (h/2)) 0 putLamp
                      ]
-        fmap connectRoom $ randomiseOutLinks $ set rmPmnts plmnts $ roomRectAutoLinks w h
+        fmap singleUseAll $ randomiseOutLinks $ set rmPmnts plmnts $ roomRectAutoLinks w h
 
 rot90Around :: Point2 -> Point2 -> Point2
 rot90Around cen p = cen +.+ vNormal (p -.- cen)
@@ -179,17 +179,9 @@ rot90Around cen p = cen +.+ vNormal (p -.- cen)
 -- So, the idea is to attach outer children to the bottommost right nodes
 -- inside an inner tree
 roomMiniIntro :: RandomGen g => State g (SubCompTree Room)
-roomMiniIntro = fmap (g . expandTreeBy f) $ sequence $ treeFromPost
+roomMiniIntro = do
-    [return $ connectRoom door
+    midroom <- join $ takeOne [miniTree2,glassLesson]
-    ,join $ takeOne [miniTree2,glassLesson]
+    return $ chainUses $ [return $ UseAll door, midroom,return $ UseAll corridor]
-    ]
-    $ connectRoom <$> randomiseOutLinks corridor
-  where 
-    f (Node (UseAll x) xs) = Node (UseAll (UseAll x)) $ map f xs
-    f (Node (PassDown x) xs) = Node (PassDown (PassDown x)) $ map f xs
-    g (Node (UseAll x) []) = Node (UseAll x) []
-    g (Node (UseAll x) xs) = Node (PassDown x) $ map g xs
-    g (Node y ys) = Node y $ map g ys
 
 roomCenterPillar :: RandomGen g => State g Room
 roomCenterPillar = changeLinkTo ((\p -> dist p (V2 120 0) < 10) . fst) 
@@ -272,7 +264,7 @@ weaponEmptyRoom = do
             ,mntLightLnkCond unusedLnkToPS
             ]
     treeFromTrunk [PassDown corridor] 
-        <$> ((fmap connectRoom . randomiseOutLinks) =<< 
+        <$> ((fmap singleUseAll . randomiseOutLinks) =<< 
         changeLinkTo ((\p -> dist p (V2 (w/2) 0) < 10) . fst) (set rmPmnts plmnts $ roomRect w h 2 2)
         )
      
@@ -285,14 +277,14 @@ weaponUnderCrits = do
             ]
     let continuationRoom = treeFromTrunk 
             [PassDown corridorN,PassDown corridorN] 
-            (connectRoom (set rmPmnts plmnts corridorN))
+            (singleUseAll (set rmPmnts plmnts corridorN))
     rcp <- roomCenterPillar
     deadEndRoom' <- takeOne [roomPillars,rcp]
     junctionRoom <- takeOne [PassDown tEast,PassDown tWest]
     return $ treeFromTrunk [PassDown corridorN,PassDown corridorN] 
                        $ Node junctionRoom
                               [continuationRoom
-                              ,deadRoom deadEndRoom'
+                              ,singleUseNone deadEndRoom'
                               ]
 
 weaponBehindPillar :: RandomGen g => State g (SubCompTree Room)
@@ -310,7 +302,7 @@ weaponBehindPillar  = do
       [PassDown corridor
       ,PassDown $ over rmLinks tail $ over rmPmnts (++ plmnts1) rcp
       ]
-      (connectRoom $ set rmPmnts [sPS (V2 20 60) (negate $ pi/2) randC1] corridorN)
+      (singleUseAll $ set rmPmnts [sPS (V2 20 60) (negate $ pi/2) randC1] corridorN)
 
 weaponBetweenPillars :: RandomGen g => State g (SubCompTree Room)
 weaponBetweenPillars = do
@@ -324,7 +316,7 @@ weaponBetweenPillars = do
             ,sPS crPos2 (d crPos2) randC1
             ]
         theRoom = roomPillars & rmPmnts %~ (++ plmnts)
-    (fmap connectRoom . randomiseOutLinks) =<< filterLinks f theRoom
+    (fmap singleUseAll . randomiseOutLinks) =<< filterLinks f theRoom
   where 
     f (_,a) = a == 0
 
@@ -336,8 +328,8 @@ weaponLongCorridor = do
         ]
     i1 <- state $ randomR (2,5)
     i2 <- state $ randomR (2,5)
-    let branch1 = treeFromTrunk (replicate i1 $ PassDown corridorN) (connectRoom $ putCrs connectingRoom)
+    let branch1 = treeFromTrunk (replicate i1 $ PassDown corridorN) (singleUseAll $ putCrs connectingRoom)
-    let branch2 = treeFromTrunk (replicate i2 $ PassDown corridorN) (deadRoom $ putWp corridor)
+    let branch2 = treeFromTrunk (replicate i2 $ PassDown corridorN) (singleUseNone $ putWp corridor)
     return $ Node (PassDown root) [branch1,branch2]
       where 
         putCrs = over rmPmnts (++ [sPS (V2 10 40) (-pi/2) randC1 ,sPS (V2 (-10) 40) (-pi/2) randC1 ])
@@ -512,4 +504,4 @@ spawnerRoom = do
     roomWithSpawner <- roomC x y <&> 
         rmPmnts %~ (spNoID (PSRoomRand 0) (PutCrit spawnerCrit) :)
     aRoom <- airlock
-    return $ treeFromTrunk [PassDown aRoom,PassDown corridor] $ connectRoom roomWithSpawner
+    return $ treeFromTrunk [PassDown aRoom,PassDown corridor] $ singleUseAll roomWithSpawner

src/Dodge/Room/Start.hs

@@ -80,11 +80,12 @@ rezThenLasTurret = do
     cenroom <- randomiseOutLinks $ centralLasTurret {_rmLabel = Just 0}
     let doorroom = switchDoorRoom {_rmTakeFrom = Just 0}
         contTree = treeFromPost [PassDown cenroom,PassDown doorroom] (UseAll door)
-    return $ rbox `appendEitherTree` [contTree]
+    return $ rbox `passUntilUseAll` [contTree]
 
 startRoom :: RandomGen g => Int -> State g (SubCompTree Room)
 startRoom i = join $ takeOne 
-    [ minigunfakeout
+    [-- roomMiniIntro
+    minigunfakeout
     , rezBoxesWp
     , rezBoxesThenWeaponRoom
     , rezBoxThenWeaponRoom
@@ -96,7 +97,7 @@ runPastStart :: RandomGen g => Int -> State g (SubCompTree Room)
 runPastStart i = do
     s <- rezBoxStart
     rp <- runPastRoom i
-    return $ s `appendEitherTree` [rp]
+    return $ s `passUntilUseAll` [rp]
 
 rezBoxStart :: RandomGen g => State g (SubCompTree Room)
 rezBoxStart = do
@@ -135,7 +136,7 @@ rezBoxesThenWeaponRoom :: RandomGen g => State g (SubCompTree Room)
 rezBoxesThenWeaponRoom = do
     rboxes <- rezBoxes
     wroom  <- weaponRoom
-    return $ rboxes `appendEitherTree` [wroom]
+    return $ rboxes `passUntilUseAll` [wroom]
 
 rezBoxThenWeaponRoom :: RandomGen g => State g (SubCompTree Room)
 rezBoxThenWeaponRoom = do

src/Dodge/Tree/Compose.hs

@@ -1,17 +1,12 @@
 {-| Combining and composing trees of trees.  -}
 module Dodge.Tree.Compose
-    ( expandTreeBy
+    ( expandTree
-    , appendEitherTree
-    , connectRoom
-    , connectTrunk
-    , deadRoom
-    , linkEitherTrees
-    , expandTree
     , singleUseAll
     , singleUseNone
     , passUntilUseAll
     , chainUses
     , useAllAtEnd
+    , changeToPassDown
     ) where
 import Dodge.Tree.Compose.Data
 import Data.Tree
@@ -25,95 +20,25 @@ expandTree (Node root extChildren) = case root of
     Node (SplitDown x)  xs  -> Node x $ map expandTree $ zipWith Node xs 
             $ map (:[]) extChildren ++ repeat []
 
-expandTreeBy
-    :: (a -> SubCompTree b) -- ^ Node function
-    -> Tree a                   -- ^ Base tree
-    -> Tree b
-expandTreeBy f (Node x []) = fmap _unCompose (f x)
-expandTreeBy f (Node x xs) = appendAndRemove $ f x
-  where
-    appendAndRemove (Node (PassDown y) ys) = Node y (map appendAndRemove ys)
-    appendAndRemove (Node (UseAll y)   _ ) = Node y (map (expandTreeBy f) xs)
-    
-
----- | 'Left' elements get new children as given by the node function, 
----- 'Right' elements inherit the children from the base tree
---expandTreeBy 
---    :: (a -> Tree (Either b b)) -- ^ Node function
---    -> Tree a                   -- ^ Base tree
---    -> Tree b
---expandTreeBy f (Node x []) = fmap removeEither (f x)
---expandTreeBy f (Node x xs) = appendAndRemove $ f x
---  where
---    appendAndRemove (Node (Left y)  ys) = Node y (map appendAndRemove ys)
---    appendAndRemove (Node (Right y) _ ) = Node y (map (expandTreeBy f) xs)
-
--- | Appends a second either forest at the 'Right' elements of a first either
--- tree.
--- Makes such 'Right' elements into 'Left's.
---appendEitherTree 
---    :: Tree (Either a a)    -- ^ The first tree
---    -> [Tree (Either a a)]    -- ^ The forest to append
---    -> Tree (Either a a)
---appendEitherTree (Node (Left x) ts) ts'  = Node (Left x) $ map (`appendEitherTree` ts') ts
---appendEitherTree (Node (Right x) _) ts' = Node (Left x) ts'
-
-appendEitherTree = passUntilUseAll
-
 passUntilUseAll :: SubCompTree a -> [SubCompTree a] -> SubCompTree a
 passUntilUseAll (Node (UseAll x) _) ts' = Node (PassDown x) ts'
 passUntilUseAll (Node cn ts) ts' = Node (PassDown (_unCompose cn)) $ map (`passUntilUseAll` ts') ts
 
---linkEitherTrees :: [Tree (Either a a)] -> Tree (Either a a)
---linkEitherTrees (t:s:ts) = linkEitherTrees (appendEitherTree t [s]:ts)
---linkEitherTrees [t] = t
---linkEitherTrees [] = error "tried to concatenate an empty list of either trees"
-
-linkEitherTrees = chainUses
-
 chainUses :: [SubCompTree a] -> SubCompTree a
 chainUses (t:s:ts) = chainUses (passUntilUseAll t [s]:ts)
 chainUses [t] = t
 chainUses []  = error "tried to concatenate an empty list of SubCompTrees"
 
-removeEither = _unCompose
-
--- this is _unCompose
---removeEither :: Either p p -> p
---removeEither (Left y)  = y
---removeEither (Right y) = y
-
-{-  |
-Make a singleton connection of an Either Tree.
--}
---connectRoom :: a -> Tree (Either a a)
---connectRoom r = Node (Right r) [] 
-
-connectRoom = singleUseAll
-
 singleUseAll :: a -> Tree (ComposingNode a)
 singleUseAll x = Node (UseAll x) []
 
-{-  |
-Make a single Either connection at the end of a tree.
--}
---connectTrunk :: Tree a -> Tree (Either a a)
---connectTrunk (Node x (t:ts)) = Node (Left x) (connectTrunk t : map (fmap Left) ts)
---connectTrunk (Node x []) = Node (Right x) []
---
-connectTrunk = useAllAtEnd
 useAllAtEnd :: Tree a -> SubCompTree a
 useAllAtEnd tree = case tree of
     Node x (t:ts)   -> Node (PassDown x) (useAllAtEnd t : map (fmap UseNone) ts)
     Node x []       -> Node (UseAll x) []
 
-{- |
-Make a singleton dead end of an Either Tree.
--}
---deadRoom :: a -> Tree (Either a a)
---deadRoom r = Node (Left r) []
-
-deadRoom = singleUseNone
-
 singleUseNone :: a -> SubCompTree a
 singleUseNone x = Node (UseNone x) []
+
+changeToPassDown :: ComposingNode a -> ComposingNode a
+changeToPassDown x = PassDown (_unCompose x)