Cleanup

src/Dodge/Room/Link.hs

@@ -19,7 +19,7 @@ module Dodge.Room.Link
     , randomiseOutLinks
 --    , randomiseLinksBy
     , invShiftLinkBy
-    , finalLinksUpdate
+    --, finalLinksUpdate
     ) where
 import Dodge.Placement.PlaceSpot
 import Dodge.LevelGen.Data
@@ -32,11 +32,13 @@ import System.Random
 import Control.Monad.State
 import Control.Lens
 import Data.List
+import qualified Data.Set as S
 {- Shuffle the initial links of a room randomly. -}
 randomiseOutLinks :: RandomGen g => Room -> State g Room
 randomiseOutLinks r = do
-    newLinks <- shuffle $ _rmOutLinks r
-    return $ r {_rmOutLinks = newLinks }
+    let (outs,xs) = partition (S.member OutLink . _rlType) $ _rmLinks r
+    newLinks <- shuffle outs
+    return $ r {_rmLinks = newLinks ++ xs }
 
 sortOutLinksOn :: Ord b => ((Point2,Float) -> b) -> Room -> Room
 sortOutLinksOn f = overLnkType OutLink $ sortOn (f . lnkPosDir)
@@ -48,13 +50,12 @@ filterSortOutLinksOn test f = overLnkType OutLink dosort
     dosort xs = let (ys,zs) = partition (test . lnkPosDir) xs
         in sortOn (f . lnkPosDir) ys ++ zs
 
-{- Shuffle all links of a room randomly. -}
+{- Shuffle the order of all links of a room randomly. 
+ - Note this does not change their types. -}
 randomiseAllLinks :: RandomGen g => Room -> State g Room
 randomiseAllLinks r = do
-    newLinks <- shuffle $ _rmOutLinks r ++ _rmInLinks r
-    return $ r {_rmOutLinks = tail newLinks
-        , _rmInLinks = [head newLinks]
-        }
+    newLinks <- shuffle $ _rmLinks r
+    return $ r {_rmLinks = newLinks }
 
 --randomiseLinksBy 
 --    :: ( [(Point2,Float)] -> State g [(Point2,Float)] )
@@ -66,28 +67,29 @@ randomiseAllLinks r = do
 --                , _rmInLinks = [last newLinks]
 --                }
 
--- TODO rename to filterOutLinks
 filterLinks :: RandomGen g => ((Point2,Float) -> Bool) -> Room -> State g Room
 filterLinks cond r = do
-    newLinks <- shuffle $ filter (cond . lnkPosDir) $ _rmOutLinks r
-    return $ r {_rmOutLinks = newLinks}
+    newLinks <- shuffle $ filter (cond . lnkPosDir) $ _rmLinks r
+    return $ r {_rmLinks = newLinks}
 {- | Swaps the first link in the list with one that satisfies a given property.
  - Does not change the last link in the list -}
+-- TODO replace all instances of this with something more sensible
 changeLinkFrom :: RandomGen g => ((Point2,Float) -> Bool) -> Room -> State g Room
 changeLinkFrom cond r = do
-    let (possibleLnks,otherLnks) = partition (cond . lnkPosDir) $ _rmOutLinks r
+    let (possibleLnks,otherLnks) = partition (cond . lnkPosDir) $ _rmLinks r
     newLnks <- shuffle possibleLnks
-    return $ r {_rmOutLinks = newLnks ++ otherLnks}
+    return $ r {_rmLinks = newLnks ++ otherLnks}
 {- | Swaps the last link in the list with one that satisfies a given
  - property (it might swap with itself). Unsafe. 
  - Be careful about calling this after changeLinkFrom. -}
+-- TODO replace with something more sensible
 changeLinkTo :: RandomGen g => ((Point2,Float) -> Bool) -> Room -> State g Room
 changeLinkTo cond r = do
-    let alllinks = _rmOutLinks r ++ _rmInLinks r
+    let alllinks = _rmLinks r
     l <- takeOne $ filter (cond . lnkPosDir) alllinks
+    let l' = l & rlType .~ S.singleton InLink
     let newLinks = delete l alllinks
-    return $ r { _rmOutLinks = newLinks
-        ,_rmInLinks = [l]}
+    return $ r & rmLinks .~ (l':newLinks)
 {- | Move a room so that the first link in '_rmInLinks' lines up to 
 an external point and direction.
 This is intended to work when the external point is an outgoing link from another room.
@@ -108,8 +110,7 @@ doRoomShift rm = shiftRoomBy (_rmShift rm) rm & rmShift .~ _rmShift rm
 shiftRoomBy :: (Point2,Float) -> Room -> Room
 shiftRoomBy shift r = r
     & rmPolys %~ fmap (map (shiftPointBy shift))
-    & rmOutLinks %~ fmap (shiftLinkBy shift)
-    & rmInLinks %~ fmap (shiftLinkBy shift)
+    & rmLinks %~ fmap (shiftLinkBy shift)
     & rmPath  %~ map (shiftPathBy shift)
     & rmBound %~ fmap (map (shiftPointBy shift))
     & rmShift %~ shiftPosDirBy shift
@@ -158,13 +159,13 @@ shiftPathBy
     -> (Point2,Point2) 
 shiftPathBy s (p1,p2) = (shiftPointBy s p1, shiftPointBy s p2)
 
-finalLinksUpdate :: Room -> Room
-finalLinksUpdate rm = case _rmInLinks rm of
-    (_:_) -> rm
-        & rmInLinks %~ tail
-        & rmPos %~ ( (uncurry (UsedInLink 0) (lnkPosDir $ head inlnks) :) 
-                    . (map (uncurry UnusedLink . lnkPosDir) (outlnks ++ tail inlnks) ++) )
-    _ -> rm
-  where
-    inlnks = _rmInLinks rm
-    outlnks = _rmOutLinks rm
+--finalLinksUpdate :: Room -> Room
+--finalLinksUpdate rm = case _rmInLinks rm of
+--    (_:_) -> rm
+--        & rmInLinks %~ tail
+--        & rmPos %~ ( (uncurry (UsedInLink 0) (lnkPosDir $ head inlnks) :) 
+--                    . (map (uncurry UnusedLink . lnkPosDir) (outlnks ++ tail inlnks) ++) )
+--    _ -> rm
+--  where
+--    inlnks = _rmInLinks rm
+--    outlnks = _rmOutLinks rm