From 8356496a7f732187301379a4708f23d7face9bb3 Mon Sep 17 00:00:00 2001
From: justin <justin.g.kruger@gmail.com>
Date: Mon, 15 Nov 2021 00:56:25 +0000
Subject: [PATCH] Move toward not shifting rooms during generation

---
 src/Dodge/Layout.hs            |  4 +++-
 src/Dodge/Layout/Tree/Shift.hs |  9 +++++----
 src/Dodge/Room/Link.hs         | 19 +++++++++++++++++--
 src/Dodge/Room/Start.hs        |  4 ++--
 4 files changed, 27 insertions(+), 9 deletions(-)

diff --git a/src/Dodge/Layout.hs b/src/Dodge/Layout.hs
index 317e9a5d2..360d92a11 100644
--- a/src/Dodge/Layout.hs
+++ b/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
diff --git a/src/Dodge/Layout/Tree/Shift.hs b/src/Dodge/Layout/Tree/Shift.hs
index a3c63490f..146d1a702 100644
--- a/src/Dodge/Layout/Tree/Shift.hs
+++ b/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
diff --git a/src/Dodge/Room/Link.hs b/src/Dodge/Room/Link.hs
index 13fa37a66..2db737a97 100644
--- a/src/Dodge/Room/Link.hs
+++ b/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)
diff --git a/src/Dodge/Room/Start.hs b/src/Dodge/Room/Start.hs
index 1b4452f10..0f704500a 100644
--- a/src/Dodge/Room/Start.hs
+++ b/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) )