Improve rooms, make consumable use type

src/Dodge/Room/Containing.hs

@@ -0,0 +1,20 @@
+module Dodge.Room.Containing where
+import Dodge.Data
+import Dodge.Tree
+import Dodge.LevelGen.Data
+import Dodge.RandomHelp
+import Dodge.Room.Procedural
+import Dodge.Room.Tanks
+--import Dodge.Item.Equipment
+
+import System.Random
+import Control.Monad.State
+
+
+roomsContaining :: RandomGen g => [Creature] -> [Item] -> State g (SubCompTree Room)
+roomsContaining crs its = do
+    endroom <- join $ takeOne
+        [ randomFourCornerRoomCrsIts crs its 
+        , tanksRoom crs its
+        ]
+    return $ treeFromPost [] $ UseAll endroom

src/Dodge/Room/Door.hs

@@ -20,6 +20,7 @@ door = defaultRoom
     , _rmPath  = [(V2 20 35,V2 20 5)]
 -- door extends into side walls (for shadows as rendered 12/03)
     , _rmPmnts = [putAutoDoor (V2 0 20) (V2 40 20)]
+    , _rmName = "autoDoor"
 -- note no bounds
     }
   where 

src/Dodge/Room/Procedural.hs

@@ -67,15 +67,16 @@ roomRect x y xn yn = defaultRoom
   where 
     yd = (y - 40) / fromIntegral yn
     xd = (x - 40) / fromIntegral xn
-    elnks = zip (map (+.+ V2 0 20) $ gridPoints  0  1      yd (yn+1))  (repeat ( pi/2)) 
-    wlnks = zip (map (+.+ V2 x 20) $ gridPoints  0  1      yd (yn+1))  (repeat (-pi/2)) 
-    nlnks = zip (map (+.+ V2 20 y) $ gridPoints xd (xn+1)  0  1     )  (repeat      0 ) 
-    slnks = zip (map (+.+ V2 20 0) $ gridPoints xd (xn+1)  0  1     )  (repeat     pi ) 
-    lnks = zipWith (m North FromWest) [0..] nlnks 
-        ++ zipWith (m East FromSouth) [0..] elnks
-        ++ zipWith (m West FromSouth) [0..] wlnks
-        ++ zipWith (m South FromWest) [0..] slnks
-    m edge = lnkBothAnd' (OnEdge edge)
+    somelnks poffset ps a = zip (map (+.+ poffset) ps) (repeat a)
+    elnks = somelnks (V2 0 20) (gridPoints  0  1      yd (yn+1))  ( pi/2) 
+    wlnks = somelnks (V2 x 20) (gridPoints  0  1      yd (yn+1))  (-pi/2) 
+    nlnks = somelnks (V2 20 y) (gridPoints xd (xn+1)  0  1     )       0  
+    slnks = somelnks (V2 20 0) (gridPoints xd (xn+1)  0  1     )      pi  
+    lnks = m North FromWest nlnks
+        ++ m East FromSouth elnks
+        ++ m West FromSouth wlnks
+        ++ m South FromWest slnks
+    m edge edgefrom = zipWith (lnkBothAnd' (OnEdge edge) edgefrom) [0..]
     pth  = linksAndPath' lnks $ map (bimap (+.+ V2 20 20) (+.+ V2 20 20)) (makeGrid xd xn yd yn)
     posps = map (+.+ V2 20 20) $ gridPoints xd (xn+1) yd (yn+1)
     interposps = map (+.+ V2 (20 + xd/2) (20 + yd/2)) $ gridPoints xd xn yd yn

src/Dodge/Room/RezBox.hs

@@ -40,6 +40,7 @@ rezBox ls = roomRect 40 60 1 1
     & rmPmnts .~ [ sPS (V2 20 1) 0 $ PutLS ls]
     & restrictInLinks  (\(V2 _ h,_)-> h < 1)
     & restrictOutLinks (\(V2 _ h,_)-> h > 59)
+    & rmName .~ "rezBox"
 
 rezBoxesWp :: RandomGen g => State g (SubCompTree Room)
 rezBoxesWp = do

src/Dodge/Room/Start.hs

@@ -4,6 +4,7 @@ import Dodge.LevelGen.Data
 --import Dodge.PlacementSpot
 import Dodge.Room.RunPast
 import Dodge.Room.Tanks
+import Dodge.Room.Containing
 --import Dodge.RoomLink
 --import Dodge.Data
 --import Dodge.Default
@@ -56,6 +57,7 @@ startRoom i = join $ uncurry takeOneWeighted $ unzip
     , (,) 1 rezBoxThenWeaponRoom
     , (,) one rezBoxesWpCrit
     , (,) 1 $ runPastStart i
+    , (,) 5 $ startCrafts >>= roomsContaining [] >>= rezBoxThenRooms
     ]
   where
     one = 1::Float
@@ -87,6 +89,16 @@ rezBoxThenWeaponRoom = do
     rcol <- rezColor
     treeFromTrunk [PassDown $ rezBox rcol,PassDown door] <$> weaponRoom
 
+rezBoxThenRoom :: RandomGen g => Room -> State g (SubCompTree Room)
+rezBoxThenRoom r = do
+    rcol <- rezColor
+    treeFromTrunk [PassDown $ rezBox rcol,PassDown door] <$> (return $ singleUseAll r)
+
+rezBoxThenRooms :: RandomGen g => SubCompTree Room -> State g (SubCompTree Room)
+rezBoxThenRooms r = do
+    rcol <- rezColor
+    return . treeFromTrunk [PassDown $ rezBox rcol,PassDown door] $ r
+
 startCrafts :: RandomGen g => State g [Item]
 startCrafts = takeOne $ map (map makeTypeCraft)
     [ [PIPE,PIPE,HARDWARE]

src/Dodge/Room/Tanks.hs

@@ -48,3 +48,4 @@ tanksRoom crs its = do
             ++ replicate ntanks thetank
 --            , sps0 $ PutShape $ colorSH orange $ pipePP 2 (V3 50 50 25) (V3 50 120 25)
     return $ room & rmPmnts .++~ plmnts
+        & rmName .~ "tanksRoom"