Allow for rooms to inherit floor tiling from parents

src/Dodge/Layout.hs

@@ -2,6 +2,7 @@
 module Dodge.Layout 
     ( generateLevelFromRoomList
     ) where
+import Data.Tile
 import Dodge.Data
 import Dodge.Path
 import Dodge.ShiftPoint
@@ -46,9 +47,9 @@ generateLevelFromRoomList gr' w
     . doExtendedPlacements
     . doIndividualPlacements
 --    . flip (mapAccumR doRoomPlacements) (IM.elems rs')
+    . setFloors
     . worldToGenWorld rs'
     $ w { _walls        = wallsFromRooms rs
-        , _floorTiles   = floorsFromRooms rs
         , _gameRooms    = gameRoomsFromRooms (IM.elems rs')
         , _pathGraph    = path
         , _pathGraphP   = pairPath
@@ -57,12 +58,38 @@ generateLevelFromRoomList gr' w
     path = pairsToGraph dist pairPath
     pairPath = concatMap _rmPath rs
     rs = map doRoomShift $ IM.elems rs'
-    rs'= mapM (shuffleRoomPos >=> addRandomTile) gr' & evalState $ _randGen w
+    --rs'= mapM (shuffleRoomPos >=> addRandomTile) gr' & evalState $ _randGen w
+    rs'= mapM shuffleRoomPos gr' & evalState $ _randGen w
 
-addRandomTile :: RandomGen g => Room -> State g Room
-addRandomTile r = do
-    z <- state $ randomR (0,63)
-    return $ addTile z r
+putFloorTiles :: GenWorld -> GenWorld
+putFloorTiles gw = gw & gWorld . floorTiles .~ floorsFromGenWorld gw
+
+setFloors :: GenWorld -> GenWorld
+setFloors gw = putFloorTiles $ setTiles gw
+--setFloors gw = setTiles gw
+
+-- note the order of traversal of the rooms is important
+-- hence the reverse
+-- this is not ideal: should do this in some more sensible way
+setTiles :: GenWorld -> GenWorld
+setTiles gw = foldr setTile gw . reverse . IM.elems $ _gRooms gw
+
+setTile :: Room -> GenWorld -> GenWorld
+setTile r gw = -- gw & gRooms . ix (fromJust (_rmMID r)) . rmFloor .~ Tiled [Tile poly 0 (V2 1 0) 16]
+        case _rmFloor r of
+    Tiled {} -> gw
+    InheritFloor -> gw & gRooms . ix (fromJust (_rmMID r)) . rmFloor .~ Tiled [t & tilePoly .~ poly]
+  where
+    t = case _rmMParent r of
+        Nothing -> Tile poly (V2 0 0) (V2 1 0) 16
+        Just pid -> head $ _tiles $ _rmFloor $ _gRooms gw IM.! pid
+    rp = _rmPolys r
+    poly = orderPolygon . convexHullSafe . nubBy ((==) `on` roundPoint2) $ concat rp
+
+--addRandomTile :: RandomGen g => Room -> State g Room
+--addRandomTile r = do
+--    z <- state $ randomR (0,63)
+--    return $ addTile z r
 
 shuffleRoomPos :: RandomGen g => Room -> State g Room
 shuffleRoomPos rm = do
@@ -206,7 +233,15 @@ gameRoomFromRoom rm = GameRoom
     getDir _ = 0 -- fallback
 
 floorsFromRooms :: [Room] -> [(Point3,Point3)]
-floorsFromRooms = concatMap (concatMap tToRender . _rmFloor)
+floorsFromRooms = concatMap (concatMap tToRender . getTiles . _rmFloor . doRoomShift)
+
+floorsFromGenWorld :: GenWorld -> [(Point3,Point3)]
+floorsFromGenWorld = floorsFromRooms . IM.elems . _gRooms 
+
+getTiles :: Floor -> [Tile]
+getTiles fl = case fl of
+    Tiled xs -> xs
+    _ -> error "tiles not correctly set for some room"
 
 --divideWall :: Wall -> [Wall]
 --divideWall wl
@@ -246,10 +281,10 @@ floorsFromRooms = concatMap (concatMap tToRender . _rmFloor)
 --      where 
 --        (p,a) = last $ _rmLinks r
 
-addTile :: Float -> Room -> Room
-addTile z r
-    | not (null (_rmFloor r)) || null rp = r
-    | otherwise = r & rmFloor .~ [makeTileFromPoly poly z]
-  where
-    rp = _rmPolys r
-    poly = orderPolygon . convexHullSafe . nubBy ((==) `on` roundPoint2) $ concat rp
+--addTile :: Float -> Room -> Room
+--addTile z r
+--    | not (null (_rmFloor r)) || null rp = r
+--    | otherwise = r & rmFloor .~ [makeTileFromPoly poly z]
+--  where
+--    rp = _rmPolys r
+--    poly = orderPolygon . convexHullSafe . nubBy ((==) `on` roundPoint2) $ concat rp