Fix bug not adding last positioned room to list

src/Dodge/Base.hs

@@ -34,6 +34,9 @@ safeHead :: [a] -> Maybe a
 safeHead (x:_) = Just x
 safeHead _ = Nothing
 
+errorHead :: String -> [a] -> a
+errorHead _ (x:_) = x
+errorHead s [] = error s
 
 you :: World -> Creature
 you w = _creatures w IM.! _yourID w

src/Dodge/Floor.hs

@@ -47,12 +47,12 @@ initialAnoTree = padSucWithCorridors $ treeFromTrunk
 --        ]
 --     ]
 --    ,[SpecificRoom $ return $ connectRoom lasTunnel ]
-    ,[SpecificRoom $ fmap singleUseAll slowDoorRoom ]
+--    ,[SpecificRoom $ fmap singleUseAll slowDoorRoom ]
-    ,[Corridor]
+--    ,[Corridor]
-    ,[Corridor]
+--    ,[Corridor]
-    ,[SpecificRoom $ fmap singleUseAll roomCCrits]
+--    ,[SpecificRoom $ fmap singleUseAll roomCCrits]
-    ,[AirlockAno]
+--    ,[AirlockAno]
-    ,[Corridor]
+--    ,[Corridor]
 ------    ,[SpecificRoom roomCCrits]
 ------    ,[Corridor]
 ------    ,[SpecificRoom . pure . pure . UseAll $ roomGlassOctogon 400 
@@ -113,6 +113,7 @@ layoutLevelFromSeed i seed = do
                 ++ " attempt(s), Successful generation of level with seed " 
                 ++ show seed
             --return (fmap setLastLinkToUsed rs)
+            putStrLn $ show (Prelude.length rs) ++ " rooms in total"
             return rs
         Nothing -> do
             putStr $ "Level generation with seed " ++ show seed ++ " failed: "

src/Dodge/LockAndKey.hs

@@ -16,11 +16,14 @@ import Control.Monad.State
 lockRoomKeyItems :: RandomGen g => [ (Int -> State g (SubCompTree Room) , State g ItemIdentity ) ]
 lockRoomKeyItems = 
     [ (lasCenSensEdge, takeOne [Launcher] )
+--    , (const $ fmap singleUseAll slowDoorRoom, return MiniGun)
     ]
 
 itemRooms :: RandomGen g => [(ItemIdentity, State g (SubCompTree Room))]
 itemRooms = 
-    [ (Launcher , corridorBoss launcherCrit ) ]
+    [ (Launcher , corridorBoss launcherCrit ) 
+ --   , (MiniGun  , join $ takeOne [roomMiniIntro, minigunFakeout] )
+    ]
 
 corridorBoss :: RandomGen g => Creature -> State g (SubCompTree Room)
 corridorBoss cr = do

src/Dodge/Room/Start.hs

@@ -32,8 +32,8 @@ import Control.Lens
 import System.Random
 --import qualified Data.IntMap.Strict as IM
 
-minigunfakeout :: RandomGen g => State g (SubCompTree Room)
+minigunFakeout :: RandomGen g => State g (SubCompTree Room)
-minigunfakeout = do
+minigunFakeout = do
     rcol <- rezColor
     ncor <- state $ randomR (0,2)
     roomwithmini <- randomiseAllLinks $ roomRectAutoLinks 150 150

src/Dodge/Tree/Compose.hs

@@ -11,6 +11,7 @@ module Dodge.Tree.Compose
     ) where
 import Dodge.Tree.Compose.Data
 import Dodge.Tree.Polymorphic
+import Dodge.Base
 import Data.Tree
 
 expandTree :: CompTree a -> Tree a
@@ -24,7 +25,8 @@ expandTree (Node root extChildren) = case root of
             $ map (:[]) extChildren ++ repeat []
 
 overwriteLabel :: Int -> (a -> ComposingNode a) -> SubCompTree a -> [SubCompTree a] -> SubCompTree a
-overwriteLabel i f t ts = head $ updateSingleNode islabel update t
+overwriteLabel i f t ts = errorHead ("tried to overwriteLabel " ++ show i)
+    $ updateSingleNode islabel update t
   where
     islabel (UseLabel j _) | i == j = True
     islabel _ = False

src/Dodge/Tree/Shift.hs

@@ -29,16 +29,13 @@ posRms :: [ConvexPoly]
     -> Seq (Tree RoomInt)
     -> IO (Maybe [Room])
 posRms bounds (parent,_) _ [] st = case st of
-    Empty -> return $ Just []
+    Empty -> return $ Just [parent]
     Node childi ts :<| tseq 
         -> fmap (finalLinksUpdate parent:) <$> posRms bounds childi 0 ts tseq
-posRms bounds parenti@(pr,i) numChild (t@(Node (cr,i') _):ts) tseq = do
+posRms bounds parenti numChild (t@(Node childi _):ts) tseq = do
-    putStr $ rpns 20 (_rmName cr ++ "-" ++ show i')
+    printInfo parenti numChild childi
-          ++ rpns 9 (" child " ++ show numChild )
-          ++ rpns 25 (" of " ++ _rmName pr ++ "-" ++ show i )
     tryLinks (0::Int) (init $ _rmLinks parent)
   where
-    rpns x s = rightPadNoSquash x ' ' s
     parent = fst parenti
     tryLinks _ [] = putStrLn "all links tried" >> return Nothing
     tryLinks j (l:ls) 
@@ -48,11 +45,9 @@ posRms bounds parenti@(pr,i) numChild (t@(Node (cr,i') _):ts) tseq = do
             mayrs <- posRms (convexBounds ++ bounds) 
                 (first upr parenti) (numChild + 1) ts (tseq |> shiftedt)
             case mayrs of
-                --Nothing -> putStr ("Backtracking to room " ++ show i' ++ ": ") >> tryLinks (j+1) ls
                 Nothing -> do
-                    putStr $ "Backtracking to " ++ rpns 20 (_rmName cr ++ "-" ++ show i')
+                    putStr "Backtrack: " 
-                        ++ rpns 9 (" child " ++ show numChild )
+                    printInfo parenti numChild childi
-                        ++ rpns 25 (" of " ++ _rmName pr ++ "-" ++ show i )
                     tryLinks (j+1) ls
                 Just rs -> return (Just rs)
       where
@@ -63,6 +58,14 @@ posRms bounds parenti@(pr,i) numChild (t@(Node (cr,i') _):ts) tseq = do
         r' = doRoomShift . fst $ rootLabel shiftedt
         shiftedt = applyToRoot (first $ shiftRoomShiftToLink l') t
 
+printInfo :: RoomInt -> Int -> RoomInt -> IO ()
+printInfo (parentrm,parenti) childn (childrm,childi) = do
+    putStr $ rpns 20 (_rmName childrm ++ "-" ++ show childi)
+          ++ rpns 9 (" child " ++ show childn )
+          ++ rpns 25 (" of " ++ _rmName parentrm ++ "-" ++ show parenti )
+  where
+    rpns x s = rightPadNoSquash x ' ' s
+
 doLnkEff :: (Point2,Float) -> Room -> Room
 doLnkEff x rm = case _rmLinkEff rm of
     (eff:effs) -> eff x $ rm & rmLinkEff .~ effs