Continue link cleanup

This commit is contained in:
2022-03-05 01:29:24 +00:00
parent 0c580e63a4
commit f82bd3f788
5 changed files with 22 additions and 24 deletions
+1 -1
View File
@@ -34,7 +34,7 @@ import System.Random
initialAnoTree :: RandomGen g => Tree [Annotation g]
initialAnoTree = padSucWithCorridors $ treeFromTrunk
[[AnoApplyInt 0 startRoom]
, [SpecificRoom $ fmap (return . UseAll) doubleCorridorBarrels]
, [SpecificRoom shootingRange]
, [PassthroughLockKeyLists 2 lockRoomKeyItems itemRooms]
, [AnoApplyInt 1 lasSensorTurretTest]
-- ,[ChainAnos
-9
View File
@@ -15,7 +15,6 @@ module Dodge.Room.Link
, shuffleLinks
, filterLinks
, changeLinkTo
, changeLinkFrom
, randomiseOutLinks
, chooseOneInLink
, restrictRMInLinksPD
@@ -93,14 +92,6 @@ 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}
{- | Swaps the first link in the list with one that satisfies a given property.
- Does not change the last link in the list -}
-- TODO replace all instances of this with something more sensible
changeLinkFrom :: RandomGen g => ((Point2,Float) -> Bool) -> Room -> State g Room
changeLinkFrom cond r = do
let (possibleLnks,otherLnks) = partition (cond . lnkPosDir) $ _rmLinks r
newLnks <- shuffle possibleLnks
return $ r {_rmLinks = 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. -}
+2 -2
View File
@@ -102,11 +102,11 @@ rezBoxes = do
centralRoom <- shuffleLinks $ setInLinksPD bottomEdgeTest
((roomRectAutoLinks w h) {_rmPmnts = []})
let n = length $ filter bottomEdgeTest $ map lnkPosDir $_rmLinks centralRoom
centralRoom' <- changeLinkFrom bottomEdgeTest centralRoom
-- let centralRoom' = restrictOutLinks bottomEdgeTest centralRoom
return $ treeFromTrunk [PassDown $ rezBox thecol
, PassDown door
]
(Node (PassDown centralRoom') (replicate (n-1) dbox ++ [Node (UseAll door) []]))
(Node (PassDown centralRoom) (replicate (n-1) dbox ++ [Node (UseAll door) []]))
rezColor :: RandomGen g => State g LightSource
+9 -7
View File
@@ -38,7 +38,7 @@ 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))
]
changeLinkFrom fromCond $ roomRectAutoLinks w h
randomiseAllLinks $ restrictOutLinks fromCond $ roomRectAutoLinks w h
& rmPmnts %~ (wl : )
& rmRandPSs .~ [farside]
where
@@ -484,12 +484,14 @@ pistolerRoom = pillarGrid
shootingRange :: RandomGen g => State g (SubCompTree Room)
shootingRange = do
rm1 <- shootersRoom1 >>= changeLinkTo (\(V2 _ y,_) -> y < 40)
>>= changeLinkFrom (\(V2 _ y,r) -> y > 200 && r /= 0)
rm2 <- shootersRoom >>= changeLinkTo (\(V2 x y,_) -> y < 10 && x > 20 && x < 180)
>>= changeLinkFrom (\(V2 _ y,r) -> y > 200 && r /= 0)
rm3 <- shootersRoom >>= changeLinkTo (\(V2 x y,_) -> y < 10 && x > 20 && x < 180)
>>= changeLinkFrom (\(_,r) -> r == 0)
rm1 <- shootersRoom1 >>= randomiseAllLinks . restrictInLinks (\(V2 _ y,_) -> y < 40)
. restrictOutLinks (\(V2 _ y,r) -> y > 200 && r /= 0)
rm2 <- shootersRoom >>= randomiseAllLinks
. restrictInLinks (\(V2 x y,_) -> y < 10 && x > 20 && x < 180)
. restrictOutLinks (\(V2 _ y,r) -> y > 200 && r /= 0)
rm3 <- shootersRoom >>= randomiseAllLinks
. restrictInLinks (\(V2 x y,_) -> y < 10 && x > 20 && x < 180)
. restrictOutLinks (\(_,r) -> r == 0)
return $ treeFromPost
[PassDown rm1
,PassDown $ roomPadCut (rectNSWE 40 (-40) (-80) 80) (V2 0 20)
+10 -5
View File
@@ -67,14 +67,19 @@ room2 = lasCenSensEdge
startRoom :: RandomGen g => Int -> State g (SubCompTree Room)
startRoom i = join $ uncurry takeOneWeighted $ unzip
-- [ (,) (0.5::Float) $ chainUses <$> sequence [minigunFakeout,weaponRoom]
[ (,) one rezBoxesWp
, (,) 1 rezBoxesThenWeaponRoom
, (,) 1 rezBoxThenWeaponRoom
, (,) one rezBoxesWpCrit
, (,) 1 $ runPastStart i
[-- (,) one rezBoxesWp
(,) one rezBoxesThenWeaponRoom
-- , (,) 1 rezBoxThenWeaponRoom
-- , (,) one rezBoxesWpCrit
-- , (,) 1 $ runPastStart i
]
where
one = (1::Float)
randomChallenges :: RandomGen g => State g (SubCompTree Room)
randomChallenges = join $ takeOne
[fmap (return . UseAll) doubleCorridorBarrels
,shootingRange
]
runPastStart :: RandomGen g => Int -> State g (SubCompTree Room)
runPastStart i = do