Add fallback placement for falled link based placement spots

src/Dodge/Floor.hs

@@ -35,10 +35,7 @@ initialRoomTree = do
         t = treeFromTrunk 
             [[StartRoom]
             ,[Corridor]
-            ,[AirlockAno]
+            ,[SpecificRoom $ fmap connectRoom glassSwitchBackCrits]
-            ,[Corridor]
-            ,[Corridor]
-            ,[SpecificRoom $ fmap connectRoom glassSwitchBack]
             ,[Corridor]
             ,[SpecificRoom $ return $ connectRoom lasTunnel ]
             ,[Corridor]

src/Dodge/Layout.hs

@@ -7,8 +7,6 @@ import Dodge.LevelGen.Data
 import Dodge.LevelGen.StaticWalls
 import Dodge.LevelGen.Pathing
 import Dodge.Wall.Zone
-import Dodge.Placements.Spot
-import Dodge.RandomHelp
 import Dodge.Zone
 import Dodge.GameRoom
 import Dodge.Bounds
@@ -28,7 +26,7 @@ import Tile
 import Polyhedra
 import Polyhedra.Data
 
-import Data.List (nubBy, partition,mapAccumR)
+import Data.List (nubBy)
 import Control.Monad.State
 import Control.Lens
 import System.Random
@@ -43,7 +41,8 @@ generateLevelFromRoomList :: State StdGen [Room] -> World -> World
 generateLevelFromRoomList gr w 
     = initWallZoning 
     . setupWorldBounds
-    . flip (foldr $ flip placeSpot) plmnts
+    -- . flip (foldr $ flip placeSpot) plmnts
+    . flip (foldl' placeSpot) plmnts
     $ w { _walls        = wallsFromRooms rs
         , _floorTiles   = floorsFromRooms rs
         , _gameRooms    = gameRoomsFromRooms rs
@@ -54,42 +53,9 @@ generateLevelFromRoomList gr w
     path = pairsToGraph dist pairPath
     pairPath = concatMap _rmPath rs
     plmnts = concatMap (\rm -> map (rm,) (_rmPS rm)) rs
-    --plmnts = concat . snd $ mapAccumR assignPlacementSpots (_randGen w) rs
     rs = zipWith addTile zs . evalState gr $ _randGen w
     zs = map fromIntegral $ randomRs (0,63::Int) $ _randGen w
 
--- the idea is to allow use of link coordinates for placements
--- though the implementation is clunky
--- this should PutNothing if there are no links available
--- first it takes the random placements and derandomises them
--- then it deals with link placement spots
--- TODO use state monad here
-assignPlacementSpots :: StdGen -> Room -> (StdGen, [(Room,Placement)])
-assignPlacementSpots g rm = (g'
-    , map (rm,) 
-    $ plmnts ++ updatedLnkPlmnts
-    )
-  where
-    (unrandPlmnts, g'') = runState (mapM (derandPlacement rm) (_rmPS rm)) g
-    (lnkplmnts, plmnts) = partition islnk unrandPlmnts
-    islnk Placement{_placementSpot=PSLnk{}} = True
-    islnk _ = False
-    (shuffledLnks,g') = runState (shuffle $ _rmLinks rm) g''
-    (_,updatedLnkPlmnts) = mapAccumR f (map (invShiftLinkBy $ _rmShift rm) shuffledLnks) lnkplmnts
-    f lnks plmnt =
-        let (x:xs,ys) = partition (_psLinkTest $ _placementSpot plmnt) lnks
-            thepair = _psLinkShift (_placementSpot plmnt) x
-        in (xs++ys, updatePS (updatePSLnkUsing thepair) plmnt)
-
--- I do not see an obvious way to push randomn placement spots down into recursive placements
--- So these currently only work for the "top" level
-derandPlacement :: Room -> Placement -> State StdGen Placement
-derandPlacement rm (RandomPlacement x) = derandPlacement rm =<< x
-derandPlacement rm (Placement (PSRoomRand i) pstype cont) = do
-    ps <- _rmRandPSs rm !! i
-    return (Placement (uncurry PS ps) pstype cont)
-derandPlacement _ x = return x
-
 updatePSLnkUsing :: (Point2,Float) -> PlacementSpot -> PlacementSpot
 updatePSLnkUsing pf PSLnk{_psLinkShift=f} = uncurry PS $ f pf
 updatePSLnkUsing _ ps = ps

src/Dodge/LevelGen.hs

@@ -26,6 +26,8 @@ import Control.Monad.State
 import Control.Lens
 import qualified Data.IntSet as IS
 
+-- potential failure cases: randomising using an already set link position
+-- others?
 placeSpot :: World -> (Room , Placement) -> World
 placeSpot w (rm, plmnt@Placement{_placementSpot=PSRoomRand i}) =
     let (ps,g) = runState (_rmRandPSs rm !! i) $_randGen w
@@ -40,20 +42,24 @@ placeSpot w (rm, plmnt@Placement{}) =
 placeSpot w (rm, PlacementUsingPos p subpl) = placeSpot w (rm, subpl (shiftPoint3By shift p))
   where
     shift = _rmShift rm
--- random placements SHOULD be dealt with already (see assignPlacementSpots)
 placeSpot w (rm, RandomPlacement rplmnt) = placeSpot (w & randGen .~ g) (rm, plmnt)
   where
     (plmnt, g) = runState rplmnt (_randGen w)
 
--- ok, this is unsafe, but whatever
+-- this should be woven into placeSpot
 assignPSToLnk :: Room -> Placement -> World -> World
-assignPSToLnk rm plmnt w = placeSpot (w & randGen .~ g) (rm, updatePS (f lnk) plmnt)
+assignPSToLnk rm plmnt w = case lnks of
+    (lnk:_) -> placeSpot (w & randGen .~ g) (rm, updatePS (f lnk) plmnt)
+    [] -> case fallback of
+        Nothing -> w
+        Just plmnt' -> placeSpot w (rm,plmnt')
   where
     rps = _placementSpot plmnt
+    fallback = _psFallback rps
     test = _psLinkTest rps
-    (lnk:_,g) = runState (shuffle $ filter test $ map (invShiftLinkBy $ _rmShift rm) $ _rmLinks rm) 
+    (lnks,g) = runState (shuffle $ filter test $ map (invShiftLinkBy $ _rmShift rm) $ _rmLinks rm) 
         $ _randGen w
-    f x (PSLnk t s)
+    f x (PSLnk t s _)
         | t x = uncurry PS $ s x
     f _ ps = ps
     invShiftLinkBy :: (Point2,Float) -> (Point2,Float) -> (Point2,Float)

src/Dodge/LevelGen/Data.hs

@@ -32,6 +32,7 @@ data PlacementSpot
     = PS { _psPos :: Point2 , _psRot :: Float }
     | PSLnk { _psLinkTest :: (Point2,Float) -> Bool
             , _psLinkShift :: (Point2,Float) -> (Point2,Float)
+            , _psFallback :: Maybe Placement
             }
     | PSRoomRand
         { _psRoomRandPointNum :: Int }

src/Dodge/Placements/Button.hs

@@ -30,4 +30,4 @@ putLitButtonID' col f subpl
   where
     changeLight lsid = lightSources . ix lsid . lsIntensity .~ V3 0 0.5 0
     ls = defaultLS { _lsRad = 75 , _lsIntensity = V3 0.5 0 0 }
-    thePS = PSLnk f (\(p,a)->(p,a))
+    thePS = PSLnk f id Nothing

src/Dodge/Placements/LightSource.hs

@@ -95,12 +95,12 @@ mountLightA = redMID mountLightAID
 mountLightACond :: ((Point2,Float) -> Bool) -> Placement
 mountLightACond f = updatePSToLevel 2 (const thePS) $ mountLightA 0 (V3 0 (-40) 40)
   where
-    thePS = PSLnk f (\(p,a)->(p,a))
+    thePS = PSLnk f id Nothing
 
 mountLightVCond :: ((Point2,Float) -> Bool) -> Placement
 mountLightVCond f = updatePSToLevel 2 (const thePS) $ mountLightV 0 (V3 0 (-20) 40)
   where
-    thePS = PSLnk f id
+    thePS = PSLnk f id Nothing
 
 mntLight :: Point2 -> Point2 -> Placement
 mntLight a b = RandomPlacement $ takeOne

src/Dodge/Room.hs

@@ -78,24 +78,6 @@ roomPillars = over rmLinks init $ set rmPS plmnts $ roomRect 240 240 2 2
 branchWith :: Room -> [Tree Room] -> Tree (Either Room Room)
 branchWith r ts = Node (Left r) $ return (Right door) : fmap (fmap Left) ts
 
-glassSwitchBack :: RandomGen g => State g Room
-glassSwitchBack = do
-    wth <- state $ randomR (200,400)
-    hgt <- state $ randomR (400,600)
-    wllen <- state $ randomR (60,wth/2-40)
-    let hf = hgt/5
-    let plmnts = 
-            [windowLine (V2 (wth-60   )    hf ) (V2 wllen  hf   )
-            ,windowLine (V2 (wth-wllen) (2*hf)) (V2 60    (2*hf))
-            ,windowLine (V2 (wth-60   ) (3*hf)) (V2 wllen (3*hf))
-            ,windowLine (V2 (wth-wllen) (4*hf)) (V2 60    (4*hf))
-            ,blockLine (V2          0  (1*hf)) (V2 wllen (1*hf))
-            ,blockLine (V2 (wth-wllen) (2*hf)) (V2   wth (2*hf))
-            ,blockLine (V2          0  (3*hf)) (V2 wllen (3*hf))
-            ,blockLine (V2 (wth-wllen) (4*hf)) (V2   wth (4*hf))
-            , sPS (V2 (wth/2) (hgt/2)) 0 putLamp
-            ]
-    return $ set rmPS plmnts $ roomRect wth hgt 2 6
 
 manyDoors :: Int -> Tree (Either Room Room)
 manyDoors i = treeFromPost (replicate i (Left door)) $ Right door
@@ -128,33 +110,45 @@ glassLesson = do
             ]
         ]
 
-glassSwitchback1 :: RandomGen g => State g Room
+glassSwitchBack :: RandomGen g => State g Room
-glassSwitchback1 = do
+glassSwitchBack = do
     wth <- state $ randomR (200,400)
     hgt <- state $ randomR (400,600)
     wllen <- state $ randomR (60,wth/2-40)
     let hf = hgt/5
-    cry <- randomRanges [--50+2*hf,30+3*hf
+        con1 (V2 _ y,_) = y < 0.5*hgt 
-                        50+3*hf,30+4*hf
+        plmnts = 
-                        ,50+4*hf,30+5*hf
+            [ mntLightLnkCond con1
+            , mntLightLnkCond (not . con1)
+            ,windowLine (V2 (wth-60   )    hf ) (V2 wllen  hf   )
+            ,windowLine (V2 (wth-wllen) (2*hf)) (V2 60    (2*hf))
+            ,windowLine (V2 (wth-60   ) (3*hf)) (V2 wllen (3*hf))
+            ,windowLine (V2 (wth-wllen) (4*hf)) (V2 60    (4*hf))
+            ,blockLine (V2          0  (1*hf)) (V2 wllen (1*hf))
+            ,blockLine (V2 (wth-wllen) (2*hf)) (V2   wth (2*hf))
+            ,blockLine (V2          0  (3*hf)) (V2 wllen (3*hf))
+            ,blockLine (V2 (wth-wllen) (4*hf)) (V2   wth (4*hf))
+            , sPS (V2 (wth/2) (hgt/2)) 0 putLamp
+            ]
+    let northPSs = do
+            cry <- randomRanges [3*hf+10,4*hf-10
+                                ,4*hf+10,5*hf-10
                                 ]
             crx <- state $ randomR (wllen,wth-(wllen+40))
-    let plmnts = [windowLine (V2 (wth-60) (     40+hf)) (V2 wllen (40+hf))
+            return (V2 crx cry,1.5*pi)
-                 ,windowLine (V2 (wth-wllen) (40+2*hf)) (V2 60    (40+2*hf))
+        midPS = return (V2 (wth-20) (hgt/2+40), pi)
-                 ,windowLine (V2 (wth-60) (   40+3*hf)) (V2 wllen (40+3*hf))
+    return $ roomRect wth hgt 2 4
-                 ,windowLine (V2 (wth-wllen) (40+4*hf)) (V2 60    (40+4*hf))
+        & rmPS .~ plmnts
-                 ,sPS (V2 crx cry) 0 $ PutCrit miniGunCrit
+        & rmRandPSs .~ [northPSs,midPS]
-                 ,sPS (V2 (wth-20) (hgt/2+40)) 0 randC1
+
-                 ,sPS (V2 (wth/2) (hgt/2)) 0 putLamp
+glassSwitchBackCrits :: RandomGen g => State g Room
-                 ,blockLine (V2          0  ( 40+1*hf)) (V2 wllen (40+1*hf))
+glassSwitchBackCrits = glassSwitchBack 
-                 ,blockLine (V2 (wth-wllen) ( 40+2*hf)) (V2   wth (40+2*hf))
+    <&> rmPS %~ ([Placement (PSRoomRand 0) (PutCrit miniGunCrit) (const Nothing)
-                 ,blockLine (V2          0  ( 40+3*hf)) (V2 wllen (40+3*hf))
+                , Placement (PSRoomRand 1) randC1 (const Nothing)
-                 ,blockLine (V2 (wth-wllen) ( 40+4*hf)) (V2   wth (40+4*hf))
+                ] ++)
-                 ]
-    return $ set rmPS plmnts $ shiftRoomBy (V2 0 40,0) $ roomRect wth hgt 2 4
 
 miniTree2 :: RandomGen g => State g (Tree (Either Room Room))
-miniTree2 = glassSwitchback1 
+miniTree2 = glassSwitchBackCrits 
     >>= randomiseOutLinks 
     >>= changeLinkTo (\p -> (sndV2 . fst) p < 70) 
     <&> flip branchWith (replicate 3 $ treeFromPost [door,corridor] critInDeadEnd)