Add rooms, placements and room positions

src/Dodge/Room/Procedural.hs

@@ -4,6 +4,7 @@ module Dodge.Room.Procedural
     ( roomRect
     , roomRectAutoLinks
     , randomFourCornerRoom
+    , randomFourCornerRoomCrsIts
     , centerVaultRoom
     , combineRooms
     , linksAndPath
@@ -32,11 +33,13 @@ import Geometry
 import Picture
 import Data.Tile
 
+import qualified Data.Set as S
 import qualified Data.IntMap.Strict as IM
 import Control.Lens
 import Control.Monad
 import Control.Monad.State
 import System.Random
+-- This will need a cleanup, but it might change a bit first
 {- A simple rectangular room with a light in the center.
 Creates links and pathfinding graph.  -}
 roomRect
@@ -49,7 +52,8 @@ roomRect x y xn yn = defaultRoom
     { _rmPolys = [rectNSWE  y 0 0 x ]
     , _rmLinks = lnks
     , _rmPath  = concatMap doublePair pth
-    , _rmPos   = map (`UnusedSpot` 0) posps
+    , _rmPos   = map (\pd -> UnusedSpot pd 0 $ S.singleton RoomPosOnPath) posps
+        ++ map (\pd -> UnusedSpot pd 0 $ S.singleton RoomPosOffPath) interposps
     , _rmPmnts    = []
     , _rmBound = [rectNSWE (y+5) (-5) (-5) (x+5)]
     , _rmFloor = Tiled [Tile 
@@ -67,10 +71,14 @@ roomRect x y xn yn = defaultRoom
     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 = m North nlnks ++ m East elnks ++ m West wlnks ++ m South slnks
-    m edge = map (lnkBothAnd (OnEdge edge))
+    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)
     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
 {- Creates a rectangular room, automatically creates links and pathfinding graph at a sensible size.  -}
 -- it is not clear to me that this works for very small rooms (but it does seem
 -- to do so)
@@ -80,7 +88,8 @@ roomRectAutoLinks x y = (roomRect x y xn yn)
   where
     xn = max 1 $ (ceiling x - 40) `div` 60
     yn = max 1 $ (ceiling y - 40) `div` 60
-    plmnts = [mntLightLnkCond unusedLnkToPS ]
+    plmnts = [mntLightLnkCond unusedLnkToPS
+        , mntLightLnkCond unusedLnkToPS ]
 {- Combines two rooms into one room.
  - will have to work out exactly what to do with combining links
 Mostly involves concatenation.  -}
@@ -193,9 +202,10 @@ fillNothingPlacements pst r = foldr fillNothingPlacement r pst
 {- | Randomise the ordering of placements in a room.
 Useful for randomising the position of generic placements such as 'PutNothing'. -}
 shufflePlacements :: RandomGen g => Room -> State g Room
-shufflePlacements r = do
-    newPSs <- shuffle $ _rmPmnts r
-    return $ r & rmPmnts .~ newPSs
+shufflePlacements = rmPmnts shuffle
+--shufflePlacements r = do
+--    newPSs <- shuffle $ _rmPmnts r
+--    return $ r & rmPmnts .~ newPSs
 {- | A randomly generate room based on four randomly generated corners. 
 Tight corridors, random placements. -}
 randomFourCornerRoom :: RandomGen g => [Item] -> State g Room
@@ -211,6 +221,18 @@ randomFourCornerRoom its = do
         . foldr1 combineRooms
         $ zipWith (\r a -> moveRoomBy (V2 0 0,a) r) corners [0,pi/2,pi,3*pi/2]
         )
+{- | A randomly generate room based on four randomly generated corners. 
+Tight corridors. -}
+randomFourCornerRoomCrsIts :: RandomGen g => [Creature] -> [Item] -> State g Room
+randomFourCornerRoomCrsIts crits its = do
+    corners <- replicateM 4 . join $ takeOne [quarterRoomTri 100, quarterRoomSquare 100]
+    itms <- shuffle its
+    randomiseAllLinks . fillNothingPlacements (map PutCrit crits ++ map PutFlIt itms) =<< 
+        ( shufflePlacements
+        . over rmPmnts ( sps0 putLamp :)
+        . foldr1 combineRooms
+        $ zipWith (\r a -> moveRoomBy (V2 0 0,a) r) corners [0,pi/2,pi,3*pi/2]
+        )
 {- | Creates room with a central vault with doors around it.  -}
 centerVaultRoom
     :: Float    -- ^ Width