Move toward not shifting rooms during generation

src/Dodge/Layout.hs

@@ -12,6 +12,7 @@ import Dodge.Wall.Zone
 import Dodge.GameRoom
 import Dodge.Bounds
 import Dodge.Default.Wall
+import Dodge.Room.Link
 import Geometry
 import qualified IntMapHelp as IM
 import Tile
@@ -26,7 +27,7 @@ import Data.Maybe
 import Data.Function
 
 generateLevelFromRoomList :: [Room] -> World -> World
-generateLevelFromRoomList gr w 
+generateLevelFromRoomList gr' w 
     = initWallZoning 
     . setupWorldBounds
     . placeWires
@@ -44,6 +45,7 @@ generateLevelFromRoomList gr w
     pairPath = concatMap _rmPath rs
     rs = zipWith addTile zs gr
     zs = map fromIntegral $ randomRs (0,63::Int) $ _randGen w
+    gr = map doRoomShift gr'
 
 placeWires :: (World,[Room])-> World
 placeWires (w,rms) = foldr placeRoomWires w rms

src/Dodge/Layout/Tree/Shift.hs

@@ -21,8 +21,8 @@ positionRooms (Node (r,i) ts) = posRms (map pointsToPoly $ _rmBound r) (r,i) ts
 
 type RoomInt = (Room,Int)
 
-posRms
-    :: [ConvexPoly]
+
+posRms :: [ConvexPoly]
     -> RoomInt
     -> [Tree RoomInt]
     -> Seq (Tree RoomInt)
@@ -32,7 +32,7 @@ posRms bounds (rtoadd,_) [] (Node (r,i) ts :<| tseq)
     = fmap (finalLinksUpdate rtoadd:) <$> posRms bounds (r,i) ts tseq
 posRms bounds (r,i) (t@(Node (_,i') _):ts) tseq = do
     putStr $ "Trying to place room " ++ show i' ++ ": "
-    tryLinks (0::Int) (_rmLinks r)
+    tryLinks (0::Int) (_rmLinks $ doRoomShift r)
   where
     tryLinks _ [] = do
         putStrLn "all links tried"
@@ -41,7 +41,7 @@ posRms bounds (r,i) (t@(Node (_,i') _):ts) tseq = do
         | clipping   = tryLinks (j+1) ls
         | otherwise = do
             putStrLn $ "placing at link " ++ show j
-            mayrs <- posRms (convexBounds ++ bounds) newr ts (tseq |> shiftedt)
+            mayrs <- posRms (convexBounds ++ bounds) newr ts (tseq |> shiftedt')
             case mayrs of
                 Nothing -> do putStr ("Backtracking to room " ++ show i' ++ ": ") >> tryLinks (j+1) ls
                 Just rs -> return (Just rs)
@@ -51,6 +51,7 @@ posRms bounds (r,i) (t@(Node (_,i') _):ts) tseq = do
         newr = (lnkEff l $ r & rmLinks %~ delete l & rmPos %~ (uncurry (OutLink j) l :)
             , i)
         shiftedt@(Node (r',_) _) = applyToRoot (first $ shiftRoomToLink l) t
+        shiftedt'@(Node (r'',_) _) = applyToRoot (first $ shiftRoomShiftToLink l) t
 
 lnkEff :: (Point2,Float) -> Room -> Room
 lnkEff x rm = case _rmLinkEff rm of

src/Dodge/Room/Link.hs

@@ -5,7 +5,9 @@ The last link in the list is considered the incoming link, the other links are
 the outgoing links.  -}
 module Dodge.Room.Link
     ( shiftRoomToLink
+    , shiftRoomShiftToLink
     , shiftRoomBy
+    , doRoomShift
     , randomiseAllLinks
     , filterLinks
     , changeLinkTo
@@ -73,11 +75,12 @@ shiftRoomToLink l r
     = shiftRoomBy l 
     . shiftRoomBy (V2 0 0       , pi-a)  
     $ shiftRoomBy (V2 0 0 -.- p , 0) 
---    . shiftRoomBy (V2 0 0 -.- rotateV (pi-a) p , 0) 
---    $ shiftRoomBy (V2 0 0                      ,pi-a)  
     r
   where 
     (p,a) = last $ _rmLinks r
+doRoomShift :: Room -> Room
+doRoomShift rm = shiftRoomBy (_rmShift rm) rm & rmShift .~ _rmShift rm
+
 -- NOTE placements, when placed, will be shifted by the value _rmShift
 shiftRoomBy :: (Point2,Float) -> Room -> Room
 shiftRoomBy shift r = r
@@ -92,6 +95,18 @@ shiftRoomBy shift r = r
         . (tileX    %~ shiftPointBy shift         )
         )
     & rmViewpoints %~ map (shiftPointBy shift)
+shiftRoomShiftToLink :: (Point2,Float) -> Room -> Room
+shiftRoomShiftToLink l r 
+    = shiftRoomShiftBy l 
+    . shiftRoomShiftBy (V2 0 0       , pi-a)  
+    $ shiftRoomShiftBy (V2 0 0 -.- p , 0) 
+    r
+  where 
+    (p,a) = last $ _rmLinks r
+-- NOTE placements, when placed, will be shifted by the value _rmShift
+shiftRoomShiftBy :: (Point2,Float) -> Room -> Room
+shiftRoomShiftBy shift r = r
+    & rmShift %~ shiftLinkBy shift
 
 shiftLinkBy :: (Point2,Float) -> (Point2,Float) -> (Point2,Float)
 shiftLinkBy (pos,rot) (p,r) = (shiftPointBy (pos,rot) p, r + rot)

src/Dodge/Room/Start.hs

@@ -38,8 +38,8 @@ startRoom = do
             ]
     treeFromPost [Left rezBox, Left door] . Right 
         <$> randomiseOutLinks 
-            (shiftRoomBy (V2 (-20) (-20),0) 
+            ((shiftRoomBy (V2 (-20) (-20),0) 
             $ roomRectAutoLinks w h & rmPmnts %~ (plmnts ++) 
                 & rmStartWires .~ IM.fromList [(0,RoomWire (V2   0   0) 0)]
                 & rmEndWires   .~ IM.fromList [(0,RoomWire (V2 500 500) 0)]
-            )
+            ) & rmShift .~ (0,0) )