From db8c30dac8d4d3d8aece42b8017d105f2fcd00ce Mon Sep 17 00:00:00 2001 From: justin Date: Sat, 11 Jun 2022 13:26:50 +0100 Subject: [PATCH] Cleanup --- src/Dodge/Annotation.hs | 2 +- src/Dodge/Room/Link.hs | 26 -------------------------- src/Dodge/Room/Procedural.hs | 16 +++------------- src/Dodge/Room/Room.hs | 25 +++++++++++++------------ src/Dodge/Terminal.hs | 2 +- 5 files changed, 18 insertions(+), 53 deletions(-) diff --git a/src/Dodge/Annotation.hs b/src/Dodge/Annotation.hs index c6a07a731..cbb550cda 100644 --- a/src/Dodge/Annotation.hs +++ b/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 diff --git a/src/Dodge/Room/Link.hs b/src/Dodge/Room/Link.hs index eb0b433a4..3d465bc98 100644 --- a/src/Dodge/Room/Link.hs +++ b/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 diff --git a/src/Dodge/Room/Procedural.hs b/src/Dodge/Room/Procedural.hs index 21598fc44..f1e6650ce 100644 --- a/src/Dodge/Room/Procedural.hs +++ b/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) itms + let putitms = map (\it -> sps0 (PutFlIt it) & plSpot .~ anyUnusedSpot) its putcrits = map (\cr -> sps0 (PutCrit cr) & plSpot .~ unusedSpotAwayFromLink 50) crits - randomiseAllLinks . (rmPmnts .++~ (putitms ++ putcrits)) =<< - ( shufflePlacements - . over rmPmnts ( sps0 putLamp :) + shuffleLinks + . (rmPmnts .++~ (sps0 putLamp : putitms ++ putcrits)) . 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 diff --git a/src/Dodge/Room/Room.hs b/src/Dodge/Room/Room.hs index 2d02bb0a6..de6170e27 100644 --- a/src/Dodge/Room/Room.hs +++ b/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 - & rmPmnts %~ (wl : ) + shuffleLinks $ roomRectAutoLinks w h + & 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 - <&> rmPmnts %~ ([spNoID (PSRoomRand 0 (uncurry PS)) (PutCrit miniGunCrit) - , spNoID (PSRoomRand 1 (uncurry PS)) randC1 - ] ++) +glassSwitchBackCrits = glassSwitchBack <&> rmPmnts .++~ + [ spNoID (PSRoomRand 0 (uncurry PS)) (PutCrit miniGunCrit) + , spNoID (PSRoomRand 1 (uncurry PS)) randC1 + ] miniTree2 :: RandomGen g => State g (Tree Room) -miniTree2 = (glassSwitchBackCrits - >>= randomiseAllLinks . restrictInLinks (\p -> (sndV2 . fst) p < 70)) - <&> flip branchWith (replicate 3 $ treeFromPost [door,corridor] critInDeadEnd) +miniTree2 = do + rm <- glassSwitchBackCrits >>= shuffleLinks . restrictInLinks (\p -> (sndV2 . fst) p < 70) + 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" diff --git a/src/Dodge/Terminal.hs b/src/Dodge/Terminal.hs index 6a2e0003e..e8bfa806c 100644 --- a/src/Dodge/Terminal.hs +++ b/src/Dodge/Terminal.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TupleSections #-} +--{-# LANGUAGE TupleSections #-} module Dodge.Terminal where import Dodge.Data import Dodge.Default