Fix inherited tile positioning

src/Data/Tile.hs

@@ -17,11 +17,12 @@ data Tile = Tile
     { _tilePoly :: [Point2]
     , -- | point in the world where tile texture is 0,0
       _tileZero :: Point2
-    , -- | world position one along in the X direction, note this also set the scale of the
-      -- texture
+    , -- | world position one along in the X direction
+      -- note this also sets the scale of the texture
       -- this has to be a position because it is shifted
       _tileTangentPos :: Point2
     , _tileArrayZ :: Float
+    , _tileZeroShift :: Maybe Point2A
     }
     deriving (Eq, Ord, Show)
 

src/Dodge/Layout.hs

@@ -73,9 +73,15 @@ setTile r gw = case _rmFloor r of
     InheritFloor ->
         gw & genRooms . 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 $ _genRooms gw IM.! pid
+    t = fromMaybe (Tile poly (V2 0 0) (V2 1 0) 16 Nothing) $ do
+            pid <- r ^. rmMParent
+            rm <- gw ^? genRooms . ix pid
+            (gw ^? genRooms . ix pid . rmFloor . tiles . ix 0)
+                <&> tileZeroShift ?~ _rmShift rm
+            
+--    t = case _rmMParent r of
+--        Nothing -> Tile poly (V2 0 0) (V2 1 0) 16
+--        Just pid -> head $ _tiles $ _rmFloor $ _genRooms gw IM.! pid
     poly =
         orderPolygon
             . convexHullSafe

src/Dodge/Room/Link.hs

@@ -42,14 +42,24 @@ shiftRoomBy shift r =
         & rmPath %~ S.map (shiftPathBy shift)
         & rmBound %~ fmap (map (shiftPointBy shift))
         & rmShift %~ shiftPosDirBy shift
-        & rmFloor . tiles
-            %~ map
-                ( (tilePoly %~ map (shiftPointBy shift))
-                    . (tileZero %~ shiftPointBy shift)
-                    . (tileTangentPos %~ shiftPointBy shift)
-                )
+        & rmFloor . tiles . each %~ shiftTile shift
+--            %~ map
+--                ( (tilePoly %~ map (shiftPointBy shift))
+--                    . (tileZero %~ shiftPointBy shift)
+--                    . (tileTangentPos %~ shiftPointBy shift)
+--                )
         & rmViewpoints %~ map (shiftPointBy shift)
 
+shiftTile :: Point2A -> Tile -> Tile
+shiftTile shift tl = case tl ^. tileZeroShift of
+    Nothing -> tl & tilePoly . each %~ shiftPointBy shift
+        & tileZero %~ shiftPointBy shift
+        & tileTangentPos %~ shiftPointBy shift
+    Just s -> tl & tilePoly . each %~ shiftPointBy shift
+        & tileZero %~ shiftPointBy s
+        & tileTangentPos %~ shiftPointBy s
+
+
 moveRoomBy :: (Point2, Float) -> Room -> Room
 moveRoomBy shift r =
     r

src/Dodge/Room/Procedural.hs

@@ -56,6 +56,7 @@ roomRect x y xn yn =
                     , _tileZero = 0
                     , _tileTangentPos = V2 baseFloorTileSize 0
                     , _tileArrayZ = 16
+                    , _tileZeroShift = Nothing
                     }
                 ]
         , _rmRandPSs = [psRandRanges (10, x -10) (10, y -10) (0, 2 * pi)]

src/Tile.hs

@@ -38,6 +38,7 @@ makeTileFromPoly poly z =
         , _tileZero = c
         , _tileTangentPos = c + (baseFloorTileSize *.* normalizeV (d -.- c))
         , _tileArrayZ = z
+        , _tileZeroShift = Nothing
         }
   where
     (c : d : _) = poly