Transition to new room datatypes, first separate out/inlinks

src/Dodge/Room/Link.hs

@@ -33,56 +33,60 @@ import Data.List
 {- Shuffle the initial links of a room randomly. -}
 randomiseOutLinks :: RandomGen g => Room -> State g Room
 randomiseOutLinks r = do
-    newLinks <- shuffle $ init $ _rmLinks r
-    return $ r {_rmLinks = newLinks ++ [last $ _rmLinks r]}
+    newLinks <- shuffle $ _rmOutLinks r
+    return $ r {_rmOutLinks = newLinks }
 
 sortOutLinksOn :: Ord b => ((Point2,Float) -> b) -> Room -> Room
-sortOutLinksOn f = rmLinks %~ dosort
-  where
-    dosort [] = []
-    dosort xs = sortOn f (init xs) ++ [last xs]
+sortOutLinksOn f = rmOutLinks %~ sortOn f
 
 filterSortOutLinksOn :: Ord b => ((Point2,Float) -> Bool) -> ((Point2,Float) -> b) -> Room -> Room
-filterSortOutLinksOn test f = rmLinks %~ dosort
+filterSortOutLinksOn test f = rmOutLinks %~ dosort
   where
     dosort [] = []
-    dosort xs = let (ys,zs) = partition test (init xs)
-        in sortOn f ys ++ zs ++ [last xs]
+    dosort xs = let (ys,zs) = partition test xs
+        in sortOn f ys ++ zs
 
 {- Shuffle all links of a room randomly. -}
 randomiseAllLinks :: RandomGen g => Room -> State g Room
 randomiseAllLinks r = do
-    newLinks <- shuffle $ _rmLinks r
-    return $ r {_rmLinks = newLinks}
+    newLinks <- shuffle $ _rmOutLinks r ++ _rmInLinks r
+    return $ r {_rmOutLinks = tail newLinks
+        , _rmInLinks = [head newLinks]
+        }
 
 randomiseLinksBy 
     :: ( [(Point2,Float)] -> State g [(Point2,Float)] )
     -> Room
     -> State g Room
 randomiseLinksBy f r = do
-    newLinks <- f $ _rmLinks r
-    return $ r {_rmLinks = newLinks}
+    newLinks <- f $ _rmOutLinks r ++ _rmInLinks r
+    return $ r {_rmOutLinks = init newLinks
+                , _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 $ init $ _rmLinks r
-    return $ r {_rmLinks = newLinks ++ [last $ _rmLinks r]}
+    newLinks <- shuffle $ filter cond $ _rmOutLinks r
+    return $ r {_rmOutLinks = newLinks}
 {- | Swaps the first link in the list with one that satisfies a given property.
  - Does not change the last link in the list -}
 changeLinkFrom :: RandomGen g => ((Point2,Float) -> Bool) -> Room -> State g Room
 changeLinkFrom cond r = do
-    let (possibleLnks,otherLnks) = partition cond . init $ _rmLinks r
+    let (possibleLnks,otherLnks) = partition cond $ _rmOutLinks r
     newLnks <- shuffle possibleLnks
-    return $ r {_rmLinks = newLnks ++ otherLnks ++ [last $ _rmLinks r]}
+    return $ r {_rmOutLinks = 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. -}
 changeLinkTo :: RandomGen g => ((Point2,Float) -> Bool) -> Room -> State g Room
 changeLinkTo cond r = do
-    l <- takeOne $ filter cond $ _rmLinks r
-    let newLinks = delete l (_rmLinks r) ++ [l]
-    return $ r {_rmLinks = newLinks}
-{- | Move a room so that the last link in '_rmLinks' lines up to 
+    let alllinks = _rmOutLinks r ++ _rmInLinks r
+    l <- takeOne $ filter cond alllinks
+    let newLinks = delete l alllinks
+    return $ r { _rmOutLinks = newLinks
+        ,_rmInLinks = [l]}
+{- | 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.
 -}
@@ -93,7 +97,7 @@ shiftRoomToLink l r
     $ shiftRoomBy (V2 0 0 -.- p , 0) 
     r
   where 
-    (p,a) = last $ _rmLinks r
+    (p,a) = head $ _rmInLinks r
 doRoomShift :: Room -> Room
 doRoomShift rm = shiftRoomBy (_rmShift rm) rm & rmShift .~ _rmShift rm
 
@@ -101,7 +105,8 @@ doRoomShift rm = shiftRoomBy (_rmShift rm) rm & rmShift .~ _rmShift rm
 shiftRoomBy :: (Point2,Float) -> Room -> Room
 shiftRoomBy shift r = r
     & rmPolys %~ fmap (map (shiftPointBy shift))
-    & rmLinks %~ fmap (shiftLinkBy shift)
+    & rmOutLinks %~ fmap (shiftLinkBy shift)
+    & rmInLinks %~ fmap (shiftLinkBy shift)
     & rmPath  %~ map (shiftPathBy shift)
     & rmBound %~ fmap (map (shiftPointBy shift))
     & rmShift %~ shiftLinkBy shift
@@ -118,7 +123,7 @@ shiftRoomShiftToLink l r
     $ shiftRoomShiftBy (V2 0 0 -.- p , 0) 
     r
   where 
-    (p,a) = last $ _rmLinks r
+    (p,a) = head $ _rmInLinks r
 -- NOTE placements, when placed, will be shifted by the value _rmShift
 shiftRoomShiftBy :: (Point2,Float) -> Room -> Room
 shiftRoomShiftBy shift r = r
@@ -137,10 +142,12 @@ shiftPathBy
 shiftPathBy s (p1,p2) = (shiftPointBy s p1, shiftPointBy s p2)
 
 finalLinksUpdate :: Room -> Room
-finalLinksUpdate rm = case _rmLinks rm of
+finalLinksUpdate rm = case _rmInLinks rm of
     (_:_) -> rm
-        & rmLinks %~ init
-        & rmPos %~ ( (uncurry UsedInLink (last thelnks) :) . (map (uncurry UnusedLink) (init thelnks) ++) )
+        & rmInLinks %~ tail
+        & rmPos %~ ( (uncurry UsedInLink (head inlnks) :) 
+                    . (map (uncurry UnusedLink) (outlnks ++ tail inlnks) ++) )
     _ -> rm
   where
-    thelnks = _rmLinks rm
+    inlnks = _rmInLinks rm
+    outlnks = _rmOutLinks rm