Move to using RoomLink datatype

src/Dodge/Room/Link.hs

@@ -17,7 +17,7 @@ module Dodge.Room.Link
     , changeLinkTo
     , changeLinkFrom
     , randomiseOutLinks
-    , randomiseLinksBy
+--    , randomiseLinksBy
     , invShiftLinkBy
     , finalLinksUpdate
     ) where
@@ -26,6 +26,7 @@ import Dodge.LevelGen.Data
 import Dodge.RandomHelp
 import Geometry
 import Data.Tile
+import Dodge.RoomLink
 
 import System.Random
 import Control.Monad.State
@@ -38,14 +39,14 @@ randomiseOutLinks r = do
     return $ r {_rmOutLinks = newLinks }
 
 sortOutLinksOn :: Ord b => ((Point2,Float) -> b) -> Room -> Room
-sortOutLinksOn f = rmOutLinks %~ sortOn f
+sortOutLinksOn f = overLnkType OutLink $ sortOn (f . lnkPosDir)
 
 filterSortOutLinksOn :: Ord b => ((Point2,Float) -> Bool) -> ((Point2,Float) -> b) -> Room -> Room
-filterSortOutLinksOn test f = rmOutLinks %~ dosort
+filterSortOutLinksOn test f = overLnkType OutLink dosort
   where
     dosort [] = []
-    dosort xs = let (ys,zs) = partition test xs
-        in sortOn f ys ++ zs
+    dosort xs = let (ys,zs) = partition (test . lnkPosDir) xs
+        in sortOn (f . lnkPosDir) ys ++ zs
 
 {- Shuffle all links of a room randomly. -}
 randomiseAllLinks :: RandomGen g => Room -> State g Room
@@ -55,26 +56,26 @@ randomiseAllLinks r = do
         , _rmInLinks = [head newLinks]
         }
 
-randomiseLinksBy 
-    :: ( [(Point2,Float)] -> State g [(Point2,Float)] )
-    -> Room
-    -> State g Room
-randomiseLinksBy f r = do
-    newLinks <- f $ _rmOutLinks r ++ _rmInLinks r
-    return $ r {_rmOutLinks = init newLinks
-                , _rmInLinks = [last newLinks]
-                }
+--randomiseLinksBy 
+--    :: ( [(Point2,Float)] -> State g [(Point2,Float)] )
+--    -> Room
+--    -> State g Room
+--randomiseLinksBy f r = do
+--    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 $ _rmOutLinks r
+    newLinks <- shuffle $ filter (cond . lnkPosDir) $ _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 $ _rmOutLinks r
+    let (possibleLnks,otherLnks) = partition (cond . lnkPosDir) $ _rmOutLinks r
     newLnks <- shuffle possibleLnks
     return $ r {_rmOutLinks = newLnks ++ otherLnks}
 {- | Swaps the last link in the list with one that satisfies a given
@@ -83,7 +84,7 @@ changeLinkFrom cond r = do
 changeLinkTo :: RandomGen g => ((Point2,Float) -> Bool) -> Room -> State g Room
 changeLinkTo cond r = do
     let alllinks = _rmOutLinks r ++ _rmInLinks r
-    l <- takeOne $ filter cond alllinks
+    l <- takeOne $ filter (cond . lnkPosDir) alllinks
     let newLinks = delete l alllinks
     return $ r { _rmOutLinks = newLinks
         ,_rmInLinks = [l]}
@@ -98,7 +99,7 @@ shiftRoomToLink l r
     $ shiftRoomBy (V2 0 0 -.- p , 0) 
     r
   where 
-    (p,a) = head $ _rmInLinks r
+    (p,a) = lnkPosDir $ head $ _rmInLinks r
 
 doRoomShift :: Room -> Room
 doRoomShift rm = shiftRoomBy (_rmShift rm) rm & rmShift .~ _rmShift rm
@@ -111,7 +112,7 @@ shiftRoomBy shift r = r
     & rmInLinks %~ fmap (shiftLinkBy shift)
     & rmPath  %~ map (shiftPathBy shift)
     & rmBound %~ fmap (map (shiftPointBy shift))
-    & rmShift %~ shiftLinkBy shift
+    & rmShift %~ shiftPosDirBy shift
     & rmFloor %~ map 
         ( (tilePoly %~ map (shiftPointBy shift))
         . (tileZero %~ shiftPointBy shift    )
@@ -138,10 +139,15 @@ shiftRoomShiftToLink' l inlink r
 -- NOTE placements, when placed, will be shifted by the value _rmShift
 shiftRoomShiftBy :: (Point2,Float) -> Room -> Room
 shiftRoomShiftBy shift r = r
-    & rmShift %~ shiftLinkBy shift
+    & rmShift %~ shiftPosDirBy shift
 
-shiftLinkBy :: (Point2,Float) -> (Point2,Float) -> (Point2,Float)
-shiftLinkBy (pos,rot) (p,r) = (shiftPointBy (pos,rot) p, r + rot)
+shiftPosDirBy :: (Point2,Float) -> (Point2,Float) -> (Point2,Float)
+shiftPosDirBy (pos,rot) (p,r) = (shiftPointBy (pos,rot) p, r + rot)
+
+shiftLinkBy :: (Point2,Float) -> RoomLink -> RoomLink
+shiftLinkBy (pos,rot) = overLnkPosDir f
+  where
+    f (p,r) = (shiftPointBy (pos,rot) p, r + rot)
 
 invShiftLinkBy :: (Point2,Float) -> (Point2,Float) -> (Point2,Float)
 invShiftLinkBy (pos,rot) (p,r) = (invShiftPointBy (pos,rot) p, r - rot)
@@ -156,8 +162,8 @@ finalLinksUpdate :: Room -> Room
 finalLinksUpdate rm = case _rmInLinks rm of
     (_:_) -> rm
         & rmInLinks %~ tail
-        & rmPos %~ ( (uncurry (UsedInLink 0) (head inlnks) :) 
-                    . (map (uncurry UnusedLink) (outlnks ++ tail inlnks) ++) )
+        & rmPos %~ ( (uncurry (UsedInLink 0) (lnkPosDir $ head inlnks) :) 
+                    . (map (uncurry UnusedLink . lnkPosDir) (outlnks ++ tail inlnks) ++) )
     _ -> rm
   where
     inlnks = _rmInLinks rm