Cleanup

src/Dodge/Annotation.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE TupleSections #-}
+--{-# LANGUAGE TupleSections #-}
 {- | Annotating tree structures with desired properties for rooms.  -}
 module Dodge.Annotation 
     ( module Dodge.Annotation.Data

src/Dodge/Room/Link.hs

@@ -8,11 +8,7 @@ module Dodge.Room.Link
     , moveRoomBy
     , shiftLinkBy
     , doRoomShift
-    , sortOutLinksOn
-    , filterSortOutLinksOn
-    , randomiseAllLinks
     , shuffleLinks
-    , filterLinks
     , chooseOneInLink
     , restrictRMInLinksPD
     ) where
@@ -27,7 +23,6 @@ import Data.Tile
 import Dodge.RoomLink
 
 import Control.Lens
-import Data.List
 import qualified Data.Set as S
 
 chooseOneInLink :: RandomGen g => Room -> State g Room
@@ -43,32 +38,11 @@ restrictToFstInLink = rmLinks %~ f
         | otherwise = rl : f xs
     f [] = []
 
-sortOutLinksOn :: Ord b => ((Point2,Float) -> b) -> Room -> Room
-sortOutLinksOn f = overLnkType OutLink $ sortOn (f . lnkPosDir)
-
-filterSortOutLinksOn :: Ord b => ((Point2,Float) -> Bool) -> ((Point2,Float) -> b) -> Room -> Room
-filterSortOutLinksOn test f = overLnkType OutLink dosort
-  where
-    dosort [] = []
-    dosort xs = let (ys,zs) = partition (test . lnkPosDir) xs
-        in sortOn (f . lnkPosDir) ys ++ zs
-
-{- 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 $ _rmLinks r
-    return $ r {_rmLinks = newLinks }
 {- Shuffle the order of all links of a room randomly. 
  - Note this does not change their types. -}
 shuffleLinks :: RandomGen g => Room -> State g Room
 shuffleLinks = rmLinks %%~ shuffle
 
-filterLinks :: RandomGen g => ((Point2,Float) -> Bool) -> Room -> State g Room
-filterLinks cond r = do
-    newLinks <- shuffle $ filter (cond . lnkPosDir) $ _rmLinks r
-    return $ r {_rmLinks = newLinks}
-
 doRoomShift :: Room -> Room
 doRoomShift rm = shiftRoomBy (_rmShift rm) rm & rmShift .~ _rmShift rm
 

src/Dodge/Room/Procedural.hs

@@ -206,13 +206,6 @@ quarterRoomSquare w = do
         --, _rmBound = [map toV2 [(w,w),(0,2*w),(-w,w)]]
         , _rmBound = [ map toV2 [(0,0),(w,w),(0,2*w),(-w,w)] ]
         }
-{- | Randomise the ordering of placements in a room.
-Useful for randomising the position of generic placements such as 'PutNothing'. -}
-shufflePlacements :: RandomGen g => Room -> State g Room
-shufflePlacements = rmPmnts shuffle
---shufflePlacements r = do
---    newPSs <- shuffle $ _rmPmnts r
---    return $ r & rmPmnts .~ newPSs
 {- | A randomly generate room based on four randomly generated corners. 
 Tight corridors, random placements. -}
 randomFourCornerRoom :: RandomGen g => [Item] -> State g Room
@@ -226,15 +219,12 @@ Tight corridors. -}
 randomFourCornerRoomCrsIts :: RandomGen g => [Creature] -> [Item] -> State g Room
 randomFourCornerRoomCrsIts crits its = do
     corners <- replicateM 4 . join $ takeOne [quarterRoomTri 100, quarterRoomSquare 100]
-    itms <- shuffle its
+    let putitms  = map (\it -> sps0 (PutFlIt it) & plSpot .~ anyUnusedSpot) its
-    let putitms = map (\it -> sps0 (PutFlIt it) & plSpot .~ anyUnusedSpot) itms
         putcrits = map (\cr -> sps0 (PutCrit cr) & plSpot .~ unusedSpotAwayFromLink 50) crits
-    randomiseAllLinks . (rmPmnts .++~ (putitms ++ putcrits)) =<< 
+    shuffleLinks 
-        ( shufflePlacements
+        . (rmPmnts .++~ (sps0 putLamp : putitms ++ putcrits)) 
-        . over rmPmnts ( sps0 putLamp :)
         . foldr1 combineRooms
         $ zipWith (\r a -> moveRoomBy (V2 0 0,a) r) corners [0,pi/2,pi,3*pi/2]
-        )
 {- | Creates room with a central vault with doors around it.  -}
 centerVaultRoom
     :: Float    -- ^ Width

src/Dodge/Room/Room.hs

@@ -37,8 +37,9 @@ roomC w h = do
             [ sPS (V2 0 0) 0 $ PutWall (rectNSWE (h-60) 0 (w/2-10) (w/2+10)) defaultCrystalWall
             , windowLine (V2 (w/2) 0) (V2 (w/2) (h-60))
             ]
-    randomiseAllLinks $ restrictOutLinks fromCond $ roomRectAutoLinks w h
+    shuffleLinks $ roomRectAutoLinks w h
-        & rmPmnts %~ (wl : )
+        & restrictOutLinks fromCond 
+        & rmPmnts .:~ wl
         & rmRandPSs .~ [farside]
   where
     fromCond (V2 x _,_) = x < w / 2 - 10
@@ -92,15 +93,15 @@ glassSwitchBack = do
         & rmName .~ "glassSwitchBack"
 
 glassSwitchBackCrits :: RandomGen g => State g Room
-glassSwitchBackCrits = glassSwitchBack 
+glassSwitchBackCrits = glassSwitchBack <&> rmPmnts .++~ 
-    <&> rmPmnts %~ ([spNoID (PSRoomRand 0 (uncurry PS)) (PutCrit miniGunCrit)
+    [ spNoID (PSRoomRand 0 (uncurry PS)) (PutCrit miniGunCrit)
-                , spNoID (PSRoomRand 1 (uncurry PS)) randC1
+    , spNoID (PSRoomRand 1 (uncurry PS)) randC1
-                ] ++)
+    ]
 
 miniTree2 :: RandomGen g => State g (Tree Room)
-miniTree2 =  (glassSwitchBackCrits 
+miniTree2 = do
-    >>= randomiseAllLinks . restrictInLinks (\p -> (sndV2 . fst) p < 70))
+    rm <- glassSwitchBackCrits >>= shuffleLinks . restrictInLinks (\p -> (sndV2 . fst) p < 70)
-    <&> flip branchWith (replicate 3 $ treeFromPost [door,corridor] critInDeadEnd)
+    return $ branchWith rm (replicate 3 $ treePost [door,corridor,critInDeadEnd])
 
 miniRoom3 :: RandomGen g => State g (Tree Room)
 miniRoom3 = do
@@ -412,12 +413,12 @@ pistolerRoom = pillarGrid
 
 shootingRange :: RandomGen g => State g (LabTree Room)
 shootingRange = do
-    rm1 <- shootersRoom1 >>= randomiseAllLinks . restrictInLinks (\(V2 _ y,_) -> y < 40)
+    rm1 <- shootersRoom1 >>= shuffleLinks . restrictInLinks (\(V2 _ y,_) -> y < 40)
                         . restrictOutLinks  (\(V2 _ y,r) -> y > 200 && r /= 0)
-    rm2 <- shootersRoom >>= randomiseAllLinks 
+    rm2 <- shootersRoom >>= shuffleLinks 
             . restrictInLinks  (\(V2 x y,_) -> y < 10 && x > 20 && x < 180)
             . restrictOutLinks (\(V2 _ y,r) -> y > 200 && r /= 0)
-    rm3 <- shootersRoom >>= randomiseAllLinks
+    rm3 <- shootersRoom >>= shuffleLinks
             . restrictInLinks  (\(V2 x y,_) -> y < 10 && x > 20 && x < 180)
             . restrictOutLinks (\(_,r) -> r == 0)
     return ( toOnward "shootingRange" 

src/Dodge/Terminal.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE TupleSections #-}
+--{-# LANGUAGE TupleSections #-}
 module Dodge.Terminal where
 import Dodge.Data
 import Dodge.Default