diff --git a/src/Dodge/Floor.hs b/src/Dodge/Floor.hs index 92cac428d..cc06e8be9 100644 --- a/src/Dodge/Floor.hs +++ b/src/Dodge/Floor.hs @@ -37,7 +37,7 @@ import RandomHelp initialAnoTree :: Tree [Annotation] initialAnoTree = padSucWithDoors $ treeFromPost - [[AnoApplyInt 0 startRoom] + [[AnoApplyInt 110 startRoom] , [PassthroughLockKeyLists 2 keyCardRunPastRand itemRooms] , [SpecificRoom $ warningRooms 7] , [SpecificRoom $ return ( toOnward "chaseCrit+armourChaseCrit rectRoom" diff --git a/src/Dodge/LockAndKey.hs b/src/Dodge/LockAndKey.hs index 96d9941da..d5992581a 100644 --- a/src/Dodge/LockAndKey.hs +++ b/src/Dodge/LockAndKey.hs @@ -15,9 +15,7 @@ import Dodge.Item bossKeyItems :: RandomGen g => [ (State g (Tree Room), State g ItemBaseType) ] -bossKeyItems = - [(return . useAll <$> bossRoom autoCrit, takeOne [PISTOL]) - ] +bossKeyItems = [(return . useAll <$> bossRoom autoCrit, takeOne [PISTOL]) ] lockRoomMultiItems :: RandomGen g => [ ( State g (LabTree Room) , State g [ItemBaseType] ) ] lockRoomMultiItems = @@ -40,9 +38,7 @@ lockRoomKeyItems = ,(keyCardRoomRunPast 0, return (KEYCARD 0)) ] keyCardRunPastRand :: RandomGen g => [ (Int -> State g (LabTree Room) , State g ItemBaseType ) ] -keyCardRunPastRand = - [(keyCardRoomRunPast 0, return (KEYCARD 0)) - ] +keyCardRunPastRand = [(keyCardRoomRunPast 0, return (KEYCARD 0)) ] itemRooms :: RandomGen g => [(ItemBaseType, State g (LabTree Room))] itemRooms = diff --git a/src/Dodge/Placement/Instance/Button.hs b/src/Dodge/Placement/Instance/Button.hs index 04faf9db0..7c721b575 100644 --- a/src/Dodge/Placement/Instance/Button.hs +++ b/src/Dodge/Placement/Instance/Button.hs @@ -75,9 +75,7 @@ extTrigLitPos ps f = psPtCont ps (PutTrigger (const False)) } thels = lsColPosRad (V3 0.5 0 0) (V3 0 0 78) 75 -putLitButOnPosExtTrig :: Color - -> PlacementSpot - -> Placement +putLitButOnPosExtTrig :: Color -> PlacementSpot -> Placement putLitButOnPosExtTrig col thePS = putLitButOnPosExtTrig' col thePS (const . const . const Nothing) putLitButOnPosExtTrig' :: Color diff --git a/src/Dodge/Room/Link.hs b/src/Dodge/Room/Link.hs index d2a793841..eb0b433a4 100644 --- a/src/Dodge/Room/Link.hs +++ b/src/Dodge/Room/Link.hs @@ -62,9 +62,7 @@ randomiseAllLinks r = do {- 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 r = do - newLinks <- shuffle $ _rmLinks r - return $ r {_rmLinks = newLinks } +shuffleLinks = rmLinks %%~ shuffle filterLinks :: RandomGen g => ((Point2,Float) -> Bool) -> Room -> State g Room filterLinks cond r = do diff --git a/src/Dodge/Room/RunPast.hs b/src/Dodge/Room/RunPast.hs index ba4eb872b..2219b01c8 100644 --- a/src/Dodge/Room/RunPast.hs +++ b/src/Dodge/Room/RunPast.hs @@ -2,7 +2,7 @@ module Dodge.Room.RunPast where import Dodge.UseAll import Dodge.LevelGen.Data import Dodge.LightSource -import Dodge.RoomLink +--import Dodge.RoomLink import Dodge.Data --import Dodge.Default --import Dodge.Layout.Tree.Either @@ -44,26 +44,24 @@ critRoom = corridorWallN & rmRandPSs .~ [psRandRanges (15,25) (30,45) (pi,2*pi)] runPastRoom :: RandomGen g => Int -> State g (Tree Room) runPastRoom i = do - h <- state $ randomR (200,400::Float) - theedgetest <- takeOne [horEdgeTest (<1), horEdgeTest (>39)] - thels <- roomCritLS - theweapon <- randBlockBreakWeapon - cenroom <- shuffleLinks $ restrictRMInLinksPD (\(V2 _ y,_) -> y < 1) - $ roomRectAutoLinks 40 h & rmPmnts .~ [plRRpt 0 (PutFlIt theweapon)] - theedge <- takeOne [West,East] - --let cenroom = filterSortOutLinksOn theedgetest ((\(V2 a b) -> (a,b)) . fst) + h <- state $ randomR (200,400::Float) + thels <- roomCritLS + theweapon <- randBlockBreakWeapon + --cenroom <- shuffleLinks $ restrictRMInLinksPD (\(V2 _ y,_) -> y < 1) + cenroom <- shuffleLinks + $ roomRectAutoLinks 40 h & rmPmnts .~ [plRRpt 0 (PutFlIt theweapon)] + theedge <- takeOne $ map OnEdge [West,East] let linkcor = critRoom & rmPmnts .~ [ spanLS thels (V2 0 65) (V2 40 65) ] critroom = linkcor & rmPmnts .:~ plRRpt 0 randC1 aswitchroom = corridorWallN {_rmOutPmnt = [OutPlacement (putLitButOnPosExtTrig red useUnusedLnk) i] ,_rmPmnts = [] } - switchdoor = triggerDoorRoom i - n = length $ filter theedgetest $ map lnkPosDir $ _rmLinks cenroom + switchdoor = triggerDoorRoom i + n = length $ filter (elem theedge . _rlType) $ _rmLinks cenroom controom = treeFromPost [ switchdoor, linkcor,corridor,corridor] (useAll door) - critrooms :: [Tree Room] - critrooms = treeFromPost [ switchdoor] critroom + doorrooms = treeFromPost [ switchdoor] critroom : replicate (n-2) (treeFromPost [ switchdoor] linkcor) - return $ Node cenroom $ - map (over root $ rmConnectsTo .~ S.member (OnEdge theedge)) (controom : critrooms) + return $ Node cenroom $ + map (over root $ rmConnectsTo .~ S.member theedge) (controom : doorrooms) ++ [return aswitchroom] diff --git a/src/Dodge/Room/Start.hs b/src/Dodge/Room/Start.hs index 5c99bc6d8..fe8a64c2a 100644 --- a/src/Dodge/Room/Start.hs +++ b/src/Dodge/Room/Start.hs @@ -1,4 +1,4 @@ ---{-# LANGUAGE TupleSections #-} +{-# LANGUAGE TupleSections #-} module Dodge.Room.Start where import Dodge.UseAll import Dodge.Data @@ -53,12 +53,12 @@ startRoom i = join (takeOne [-- (,) (0.5::Float) ((chainUses <$> sequence [powerFakeout,fmap fst $weaponRoom i]) -- <&> (,TreeSubLabelling "chainUses <$> sequence [powerFakeout,weaponRoom i]" Nothing)) -- wat - rezBoxesWp >>= rToOnward "rezBoxesWp" - , rezBoxThenWeaponRoom i - , rezBoxesWpCrit >>= rToOnward "rezBoxesWpCrit" - , runPastStart i >>= rToOnward ("runPastStart " ++ show i) - , startCrafts >>= roomsContaining' [] >>= rezBoxThenRooms - >>= rToOnward "startCrafts >>= roomsContaining [] >>= rezBoxThenRooms" +-- rezBoxesWp >>= rToOnward "rezBoxesWp" +-- , rezBoxThenWeaponRoom i +-- , rezBoxesWpCrit >>= rToOnward "rezBoxesWpCrit" + runPastStart i >>= rToOnward ("runPastStart " ++ show i) +-- , startCrafts >>= roomsContaining' [] >>= rezBoxThenRooms +-- >>= rToOnward "startCrafts >>= roomsContaining [] >>= rezBoxThenRooms" ]) randomChallenges :: RandomGen g => State g (LabTree Room) randomChallenges = shootingRange @@ -72,7 +72,10 @@ runPastStart :: RandomGen g => Int -> State g (Tree Room) runPastStart i = do s <- rezBoxStart rp <- runPastRoom i - return $ s `passUntiluseAll` [rp] + --return $ s `passUntiluseAll` [rp] + return . shiftChildren $ attachTree toOnward' rp $ fmap ([],) s +-- return . shiftChildren $ attachTree toOnward' (pure $ useAll corridor) $ fmap ([],) s + rezBoxStart :: RandomGen g => State g (Tree Room) rezBoxStart = do diff --git a/src/Dodge/Tree/Compose.hs b/src/Dodge/Tree/Compose.hs index c93b80dc3..aab6de87f 100644 --- a/src/Dodge/Tree/Compose.hs +++ b/src/Dodge/Tree/Compose.hs @@ -12,6 +12,8 @@ module Dodge.Tree.Compose , overwriteLabel , composeTree , composeTree' + , shiftChildren + , attachTree , composeTreeRand -- , compTree ) where @@ -124,6 +126,11 @@ newf t = safeUpdateSingleNode (isJust . upf . snd) ( (root . _2 %~ g) . (root . upf = t ^?! root . _1 g x = fromMaybe x (upf x) +attachTree :: (a -> Maybe a) -> Tree a -> Tree ([Tree a],a) -> Tree ([Tree a],a) +attachTree upf t = safeUpdateSingleNode (isJust . upf . snd) ( (root . _2 %~ g) . (root . _1 .:~ t ) ) + where + g x = fromMaybe x (upf x) + shiftChildren :: Tree ([Tree a],a) -> Tree a shiftChildren (Node (ts,x) ts') = Node x (ts ++ map shiftChildren ts') diff --git a/src/Dodge/UseAll.hs b/src/Dodge/UseAll.hs index f6a9e0a53..85a880d24 100644 --- a/src/Dodge/UseAll.hs +++ b/src/Dodge/UseAll.hs @@ -8,9 +8,13 @@ import qualified Data.Set as S toOnward :: String -> Room -> Maybe ([String],Room) toOnward s rm - | OnwardCluster `elem` rm ^?! rmClusterStatus . csLinks = Just ([s],rm) + | OnwardCluster `elem` rm ^?! rmClusterStatus . csLinks + = Just ([s],rm & rmClusterStatus . csLinks . at OnwardCluster .~ Nothing) | otherwise = Nothing +toOnward' :: Room -> Maybe Room +toOnward' = fmap snd . toOnward "" + rToOnward :: Monad m => String -> Tree Room -> m (Room -> Maybe ([String],Room), Tree Room) rToOnward s = return . (toOnward s ,)