Minor cleanup

src/Dodge/Floor.hs

@@ -36,8 +36,7 @@ initialAnoTree = padSucWithCorridors $ treeFromTrunk
         [[SetLabel 0 $ return $ roomRectAutoLinks 100 100 
                     & rmExtPmnt ?~ externalButton red 
                         (anyLnkInPS 5 & psLnkRoomEff .~ (putWireStart 0 . extractRoomPos) )
---                    & rmStartWires .~ IM.fromList [(0,RoomWire 0 0)]
-                    & rmLinkEff .~ [putWireEndInvRmShift 0]
+                    & rmLinkEff .~ [putWireEnd 0]
          ]
         ,[UseLabel 0 $ return switchDoorRoom]
         ]

src/Dodge/Layout.hs

@@ -16,6 +16,7 @@ import Dodge.Room.Link
 import Geometry
 import qualified IntMapHelp as IM
 import Tile
+import Dodge.RandomHelp
 
 import Data.List (nubBy)
 import Data.Traversable
@@ -25,6 +26,7 @@ import Data.Foldable
 import qualified Control.Foldl as L
 import Data.Maybe
 import Data.Function
+import Control.Monad.State
 
 generateLevelFromRoomList :: [Room] -> World -> World
 generateLevelFromRoomList gr' w 
@@ -45,7 +47,12 @@ generateLevelFromRoomList gr' w
     pairPath = concatMap _rmPath rs
     zs = map fromIntegral $ randomRs (0,63::Int) $ _randGen w
     rs = map doRoomShift rs'
-    rs' = zipWith addTile zs gr'
+    rs' = mapM shuffleRoomPos (zipWith addTile zs gr') & evalState $ _randGen w
+
+shuffleRoomPos :: RandomGen g => Room -> State g Room
+shuffleRoomPos rm = do
+    newPos <- shuffle $ _rmPos rm
+    return $ rm & rmPos .~ newPos
 
 placeWires :: (World,[Room])-> World
 placeWires (w,rms) = foldr placeRoomWires w rms

src/Dodge/Layout/Tree/Shift.hs

@@ -29,15 +29,16 @@ posRms :: [ConvexPoly]
 posRms _ _ [] Empty = return $ Just []
 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
+posRms bounds (parent,i) (t@(Node (_,i') _):ts) tseq = do
     putStr $ "Trying to place room " ++ show i' ++ ": "
-    tryLinks (0::Int) (_rmLinks $ doRoomShift r)
+    --tryLinks (0::Int) (_rmLinks $ doRoomShift parent)
+    tryLinks (0::Int) (_rmLinks parent)
   where
     tryLinks _ [] = do
         putStrLn "all links tried"
         return Nothing
     tryLinks j (l:ls) 
-        | clipping   = tryLinks (j+1) ls
+        | clipping  = tryLinks (j+1) ls
         | otherwise = do
             putStrLn $ "placing at link " ++ show j
             mayrs <- posRms (convexBounds ++ bounds) newr ts (tseq |> shiftedt')
@@ -47,10 +48,11 @@ posRms bounds (r,i) (t@(Node (_,i') _):ts) tseq = do
       where
         convexBounds = map pointsToPoly $ _rmBound r'
         clipping = or (convexPolysOverlap <$> convexBounds <*> bounds)
-        newr = (lnkEff l $ r & rmLinks %~ delete l & rmPos %~ (uncurry (OutLink j) l :)
+        newr = (lnkEff l $ parent & rmLinks %~ delete l & rmPos %~ (uncurry (OutLink j) l :)
             , i)
-        (Node (r',_) _) = applyToRoot (first $ shiftRoomToLink l) t
-        shiftedt' = applyToRoot (first $ shiftRoomShiftToLink l) t
+        l' = shiftLinkBy (_rmShift parent) l
+        (Node (r',_) _) = applyToRoot (first $ shiftRoomToLink l') t
+        shiftedt' = applyToRoot (first $ shiftRoomShiftToLink l') t
 
 lnkEff :: (Point2,Float) -> Room -> Room
 lnkEff x rm = case _rmLinkEff rm of

src/Dodge/Room/Link.hs

@@ -7,6 +7,7 @@ module Dodge.Room.Link
     ( shiftRoomToLink
     , shiftRoomShiftToLink
     , shiftRoomBy
+    , shiftLinkBy
     , doRoomShift
     , randomiseAllLinks
     , filterLinks

src/Dodge/Wire.hs

@@ -1,17 +1,12 @@
 module Dodge.Wire where
 import Dodge.LevelGen.Data
-import Dodge.Room.Link
 import Geometry
 
 import qualified Data.IntMap.Strict as IM
 import Control.Lens
 
-putWireEndInvRmShift :: Int -> (Point2,Float) -> Room -> Room
-putWireEndInvRmShift i pos rm = 
-    rm & rmEndWires %~ IM.insert i (uncurry RoomWire $ invShiftLinkBy (_rmShift rm) pos)
+putWireEnd :: Int -> (Point2,Float) -> Room -> Room
+putWireEnd i pos = rmEndWires %~ IM.insert i (uncurry RoomWire pos)
 
 putWireStart :: Int -> (Point2,Float) -> Room -> Room
-putWireStart i pos rm = rm 
-    & rmStartWires %~ IM.insert i (uncurry RoomWire pos)
-
-
+putWireStart i pos = rmStartWires %~ IM.insert i (uncurry RoomWire pos)