justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Cleanup

Browse Source
This commit is contained in:
justin
2022-06-11 14:37:05 +01:00
parent 9c9ec9c553
commit de71c61409
18 changed files with 107 additions and 134 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Annotation.hs
+4 -6
View File
@@ -36,10 +36,8 @@ padSucWithDoors (Node x xs) = Node x (map (padWithAno [SpecificRoom thetree]) xs
thetree = do thetree = do
thecor <- shuffleLinks corridor thecor <- shuffleLinks corridor
takeOne takeOne
[ (toOnward "door", return (useAll door)) [ (toOnward "door", return (cleatOnward door))
, (toOnward "twoDoors" , (toOnward "twoDoors" ,treePost [ door, thecor, cleatOnward door])
,treeFromPost [ door, thecor] (useAll door)
)
] ]
{- Add one to three corridors between each parent-child link of a tree of annotations. -} {- Add one to three corridors between each parent-child link of a tree of annotations. -}
@@ -71,7 +69,7 @@ anoToRoomTree' anos = case anos of
[OrAno as] -> do [OrAno as] -> do
a <- takeOne as a <- takeOne as
anoToRoomTree' a anoToRoomTree' a
[Corridor] -> pure . useAll <$> shuffleLinks corridor [Corridor] -> pure . cleatOnward <$> shuffleLinks corridor
(BossAno cr : _) -> do (BossAno cr : _) -> do
br <- bossRoom cr br <- bossRoom cr
branchRectWith . pure $ treeFromPost [corridor,corridor] br branchRectWith . pure $ treeFromPost [corridor,corridor] br
@@ -79,4 +77,4 @@ anoToRoomTree' anos = case anos of
_ -> do _ -> do
w <- state $ randomR (100,400) w <- state $ randomR (100,400)
h <- state $ randomR (200,400) h <- state $ randomR (200,400)
fmap (pure . useAll) . shuffleLinks $ roomRectAutoLinks w h fmap (pure . cleatOnward) . shuffleLinks $ roomRectAutoLinks w h
src/Dodge/Floor.hs
+9 -13
View File
@@ -1,4 +1,4 @@
{-# LANGUAGE TupleSections #-} --{-# LANGUAGE TupleSections #-}
--{-# OPTIONS_GHC -Wno-unused-imports #-} --{-# OPTIONS_GHC -Wno-unused-imports #-}
{- | The tree of rooms that make up a level. -} {- | The tree of rooms that make up a level. -}
module Dodge.Floor module Dodge.Floor
@@ -40,18 +40,16 @@ initialAnoTree = padSucWithDoors $ treeFromPost
[[AnoApplyInt 110 startRoom] [[AnoApplyInt 110 startRoom]
, [PassthroughLockKeyLists 2 keyCardRunPastRand itemRooms] , [PassthroughLockKeyLists 2 keyCardRunPastRand itemRooms]
, [SpecificRoom $ warningRooms 777777] , [SpecificRoom $ warningRooms 777777]
, [SpecificRoom $ return ( toOnward "chaseCrit+armourChaseCrit rectRoom" , [SpecificRoom $ rToOnward "chaseCrit+armourChaseCrit rectRoom"
, return . useAll $ roomRectAutoLinks 400 400 $ return . cleatOnward $ roomRectAutoLinks 400 400 & rmPmnts .++~
& rmPmnts .++~ [spNoID anyUnusedSpot (PutCrit invisibleChaseCrit) [ spNoID anyUnusedSpot (PutCrit invisibleChaseCrit)
, spNoID anyUnusedSpot (PutCrit armourChaseCrit) , spNoID anyUnusedSpot (PutCrit armourChaseCrit)
] ]
)
] ]
-- , [AnoApplyInt 100 healthTest] -- , [AnoApplyInt 100 healthTest]
, [PassthroughLockKeyLists 23 , [PassthroughLockKeyLists 23
[(sensorRoomRunPast ELECTRICAL, takeOne [STATICMODULE,SPARKGUN] )] itemRooms] [(sensorRoomRunPast ELECTRICAL, takeOne [STATICMODULE,SPARKGUN] )] itemRooms]
, [SpecificRoom ((return . useAll <$> tanksRoom [] []) , [SpecificRoom (tanksRoom [] [] >>= rToOnward "empty tanksRoom" . pure . cleatOnward)]
<&> (toOnward "empty tanksRoom",))]
, [PassthroughLockKeyLists 222 lockRoomKeyItems itemRooms] , [PassthroughLockKeyLists 222 lockRoomKeyItems itemRooms]
, [SpecificRoom randomChallenges] , [SpecificRoom randomChallenges]
, [AnoApplyInt 1 lasSensorTurretTest] , [AnoApplyInt 1 lasSensorTurretTest]
@@ -95,11 +93,9 @@ initialAnoTree = padSucWithDoors $ treeFromPost
-- ,[Corridor] -- ,[Corridor]
-- ,[TreasureAno [addArmour autoCrit,addArmour autoCrit] [launcher]] -- ,[TreasureAno [addArmour autoCrit,addArmour autoCrit] [launcher]]
-- ,[Corridor] -- ,[Corridor]
,[SpecificRoom $ (pure . useAll <$> randomFourCornerRoom []) ,[SpecificRoom $ randomFourCornerRoom [] >>= rToOnward "randomFourCornerRoom" . pure . cleatOnward ]
<&>(toOnward "randomFourCornerRoom" , )]
] ]
[SpecificRoom $ fmap (pure . useAll) (telRoomLev 1) [SpecificRoom $ telRoomLev 1 >>= rToOnward "telRoomLev" . pure . cleatOnward]
<&> (toOnward "telRoomLev" ,)]
{- | A test level tree. -} {- | A test level tree. -}
initialRoomTree :: State StdGen (Tree (Room -> Maybe ([String],Room), Tree Room)) initialRoomTree :: State StdGen (Tree (Room -> Maybe ([String],Room), Tree Room))
src/Dodge/LockAndKey.hs
+1 -1
View File
@@ -15,7 +15,7 @@ import Dodge.Item
bossKeyItems :: RandomGen g => [ (State g (Tree Room), State g ItemBaseType) ] bossKeyItems :: RandomGen g => [ (State g (Tree Room), State g ItemBaseType) ]
bossKeyItems = [(return . useAll <$> bossRoom autoCrit, takeOne [PISTOL]) ] bossKeyItems = [(return . cleatOnward <$> bossRoom autoCrit, takeOne [PISTOL]) ]
lockRoomMultiItems :: RandomGen g => [ ( State g (LabTree Room) , State g [ItemBaseType] ) ] lockRoomMultiItems :: RandomGen g => [ ( State g (LabTree Room) , State g [ItemBaseType] ) ]
lockRoomMultiItems = lockRoomMultiItems =
src/Dodge/Room/BlinkAcross.hs
+4 -5
View File
@@ -37,11 +37,10 @@ import System.Random
blinkAcrossChallenge :: RandomGen g => State g (LabTree Room) blinkAcrossChallenge :: RandomGen g => State g (LabTree Room)
blinkAcrossChallenge = do blinkAcrossChallenge = do
teleFromRoom <- shuffleLinks $ roomRectAutoLinks 200 200 teleFromRoom <- shuffleLinks $ roomRectAutoLinks 200 200
teleToRoom <- shuffleLinks $ roomRectAutoLinks 200 200 teleToRoom <- shuffleLinks $ roomRectAutoLinks 200 200
emptylink <- shuffleLinks emptyCorridor emptylink <- shuffleLinks emptyCorridor
return (toOnward "blinkAcrossChallenge" rToOnward "blinkAcrossChallenge"
,treeFromPost [ teleFromRoom, emptylink] (useAll teleToRoom) $ treePost [ teleFromRoom, emptylink, cleatOnward teleToRoom]
)
emptyCorridor :: Room emptyCorridor :: Room
emptyCorridor = corridor & rmPolys .~ [] emptyCorridor = corridor & rmPolys .~ []
src/Dodge/Room/Branch.hs
+1 -1
View File
@@ -23,6 +23,6 @@ branchRectWith t = do
b <- t b <- t
rt <- shuffleLinks $ roomRectAutoLinks x y rt <- shuffleLinks $ roomRectAutoLinks x y
return $ Node rt return $ Node rt
[ Node (useAll door) [] [ pure $ cleatOnward door
, treeFromTrunk [door] b , treeFromTrunk [door] b
] ]
src/Dodge/Room/Containing.hs
+3 -5
View File
@@ -21,18 +21,16 @@ roomsContaining crs its = do
[ randomFourCornerRoomCrsIts crs its [ randomFourCornerRoomCrsIts crs its
, tanksRoom crs its , tanksRoom crs its
] ]
return (toOnward ("roomsContaining-creatures:" ++ intercalate "," (map _crName crs) rToOnward ("roomsContaining-creatures:" ++ intercalate "," (map _crName crs)
++ "-items:" ++ intercalate "," (map (show . _iyBase . _itType) its)) ++ "-items:" ++ intercalate "," (map (show . _iyBase . _itType) its))
, pure $ useAll endroom $ pure $ cleatOnward endroom
)
roomsContaining' :: RandomGen g => [Creature] -> [Item] -> State g (Tree Room) roomsContaining' :: RandomGen g => [Creature] -> [Item] -> State g (Tree Room)
roomsContaining' crs its = do roomsContaining' crs its = do
endroom <- join $ takeOne endroom <- join $ takeOne
[ randomFourCornerRoomCrsIts crs its [ randomFourCornerRoomCrsIts crs its
, tanksRoom crs its , tanksRoom crs its
] ]
return (pure $ useAll endroom return (pure $ cleatOnward endroom)
)
pedestalRoom :: RandomGen g => Item -> State g Room pedestalRoom :: RandomGen g => Item -> State g Room
pedestalRoom it = do pedestalRoom it = do
src/Dodge/Room/GlassLesson.hs
+2 -2
View File
@@ -27,7 +27,7 @@ glassLesson = do
[ pure $ door & rmConnectsTo .~ fromWest North 1 [ pure $ door & rmConnectsTo .~ fromWest North 1
, uppers , uppers
, treeFromPost ( (door & rmConnectsTo .~ S.member (OnEdge East)) , treeFromPost ( (door & rmConnectsTo .~ S.member (OnEdge East))
: corridors) $ useAll door] : corridors) $ cleatOnward door]
where where
fromWest edge i s = S.member (OnEdge edge) s && S.member (FromWest i) s fromWest edge i s = S.member (OnEdge edge) s && S.member (FromWest i) s
uppers = Node (door & rmConnectsTo .~ fromWest North 0) [pure topRoom] uppers = Node (door & rmConnectsTo .~ fromWest North 0) [pure topRoom]
@@ -56,4 +56,4 @@ glassLesson = do
glassLessonRunPast :: RandomGen g => State g (LabTree Room) glassLessonRunPast :: RandomGen g => State g (LabTree Room)
glassLessonRunPast = (f <$> glassLesson) <&> (toOnward "glassLessonRunPast",) glassLessonRunPast = (f <$> glassLesson) <&> (toOnward "glassLessonRunPast",)
where where
f (Node r rs) = Node r $ return (useLabel 0 $ door & rmConnectsTo .~ S.member (OnEdge West)) : rs f (Node r rs) = Node r $ return (cleatLabel 0 $ door & rmConnectsTo .~ S.member (OnEdge West)) : rs
src/Dodge/Room/LasTurret.hs
+15 -15
View File
@@ -77,8 +77,8 @@ keyCardRoomRunPast keyid rmid = do
let doorroom = triggerDoorRoom rmid let doorroom = triggerDoorRoom rmid
return (toOnward "keyCardRoomRunPast", return (toOnward "keyCardRoomRunPast",
treeFromTrunk [door] $ Node cenroom treeFromTrunk [door] $ Node cenroom
[ treeFromPost [doorroom] (useAll door) [ treeFromPost [doorroom] (cleatOnward door)
, treeFromPost [door] (useLabel rmid corridor) , treeFromPost [door] (cleatLabel rmid corridor)
]) ])
keyCardAnalyserByDoor :: Int -> Int -> Room -> Room keyCardAnalyserByDoor :: Int -> Int -> Room -> Room
@@ -106,19 +106,19 @@ analyserByDoor proxreq outplid rm = rm
healthTest :: RandomGen g => Int -> State g (Tree Room) healthTest :: RandomGen g => Int -> State g (Tree Room)
healthTest n = do healthTest n = do
cenroom <- shuffleLinks $ healthAnalyserByDoor n $ roomNgon 8 200 cenroom <- shuffleLinks $ healthAnalyserByDoor n $ roomNgon 8 200
let doorroom = triggerDoorRoom n return $ treePost
return $ treeFromPost [door [ door
, corridor & rmPmnts .:~ spNoID (PS 20 0) (PutFlIt (medkit 100)) , corridor & rmPmnts .:~ spNoID (PS 20 0) (PutFlIt (medkit 100))
, cenroom, doorroom] , cenroom
(useAll door) , triggerDoorRoom n
, cleatOnward door
]
lasSensorTurretTest :: RandomGen g => Int -> State g (LabTree Room) lasSensorTurretTest :: RandomGen g => Int -> State g (LabTree Room)
lasSensorTurretTest n = do lasSensorTurretTest n = do
cenroom <- shuffleLinks $ lightSensInsideDoor n cenLasTur cenroom <- shuffleLinks $ lightSensInsideDoor n cenLasTur
let doorroom = triggerDoorRoom n rToOnward "lasSensorTurretTest" $ treePost
return ( toOnward "lasSensorTurretTest" [ door, cenroom, triggerDoorRoom n, cleatOnward door]
, treeFromPost [ door, cenroom, doorroom] (useAll door)
)
lasCenSensEdge :: RandomGen g => Int -> State g (LabTree Room) lasCenSensEdge :: RandomGen g => Int -> State g (LabTree Room)
lasCenSensEdge n = do lasCenSensEdge n = do
@@ -126,9 +126,9 @@ lasCenSensEdge n = do
let doorroom = triggerDoorRoom n let doorroom = triggerDoorRoom n
rToOnward "lasCenSensEdge" rToOnward "lasCenSensEdge"
$ treeFromTrunk [ door] $ Node cenroom $ treeFromTrunk [ door] $ Node cenroom
[ treeFromPost [ doorroom] (useAll door) [ treePost [ doorroom, cleatOnward door ]
, treeFromPost [ door] (useLabel 0 corridor) , treePost [ door, cleatLabel 0 corridor]
] ]
lasTunnel :: RandomGen g => Float -> State g Room lasTunnel :: RandomGen g => Float -> State g Room
lasTunnel y = do lasTunnel y = do
@@ -171,6 +171,6 @@ lasTunnelRunPast y = do
r1 <- takeOne [door,corridor] r1 <- takeOne [door,corridor]
r2 <- takeOne [door,corridor] r2 <- takeOne [door,corridor]
rToOnward "lasTunnelRunPast" $ Node r rToOnward "lasTunnelRunPast" $ Node r
[ pure $ useAll r1 [ pure $ cleatOnward r1
, return (useLabel 0 $ r2 & rmConnectsTo .~ S.member InLink) , return (cleatLabel 0 $ r2 & rmConnectsTo .~ S.member InLink)
] ]
src/Dodge/Room/LongDoor.hs
+2 -2
View File
@@ -144,6 +144,6 @@ slowDoorRoomRunPast :: RandomGen g => State g (LabTree Room)
slowDoorRoomRunPast = do slowDoorRoomRunPast = do
r <- slowDoorRoom r <- slowDoorRoom
rToOnward "slowDoorRoomRunPast" $ treeFromTrunk [ door] $ Node r rToOnward "slowDoorRoomRunPast" $ treeFromTrunk [ door] $ Node r
[ pure $ useAll door [ pure $ cleatOnward door
, return (useLabel 0 $ door & rmConnectsTo .~ S.member InLink) , return (cleatLabel 0 $ door & rmConnectsTo .~ S.member InLink)
] ]
src/Dodge/Room/LongRoom.hs
+3 -4
View File
@@ -51,8 +51,7 @@ longRoomRunPast :: RandomGen g => State g (LabTree Room)
longRoomRunPast = do longRoomRunPast = do
r <- longRoom r <- longRoom
rToOnward "longRoomRunPast" rToOnward "longRoomRunPast"
$ treeFromTrunk [ door] $ Node r $ treeFromTrunk [door] $ Node r
[ pure $ useAll door [ pure $ cleatOnward door
, treeFromPost [ corridor & rmConnectsTo .~ S.member InLink] , treePost [ corridor & rmConnectsTo .~ S.member InLink, cleatLabel 0 door ]
(useLabel 0 door)
] ]
src/Dodge/Room/RezBox.hs
+2 -2
View File
@@ -60,7 +60,7 @@ rezBoxesWp = do
adddoor rm = treeFromPost [ connectsToNorth door ] rm adddoor rm = treeFromPost [ connectsToNorth door ] rm
connectsToNorth = rmConnectsTo .~ S.member (OnEdge North) connectsToNorth = rmConnectsTo .~ S.member (OnEdge North)
maybeBlockedPassage :: RandomGen g => State g (Tree Room) maybeBlockedPassage :: RandomGen g => State g (Tree Room)
maybeBlockedPassage = fmap (pure . useAll) maybeBlockedPassage = fmap (pure . cleatOnward)
$ join $ takeOne [return corridor, blockedCorridorCloseBlocks] $ join $ takeOne [return corridor, blockedCorridorCloseBlocks]
rezBoxesWpCrit :: RandomGen g => State g (Tree Room) rezBoxesWpCrit :: RandomGen g => State g (Tree Room)
rezBoxesWpCrit = do rezBoxesWpCrit = do
@@ -100,7 +100,7 @@ rezBoxes = do
& rmLinks %~ setInLinks bottomEdgeTest & rmLinks %~ setInLinks bottomEdgeTest
let n = length $ filter bottomEdgeTest $_rmLinks centralRoom let n = length $ filter bottomEdgeTest $_rmLinks centralRoom
return $ treeFromTrunk [rezBox thecol, door] return $ treeFromTrunk [rezBox thecol, door]
$ Node centralRoom (replicate (n-1) dbox ++ [Node (useAll door) []]) $ Node centralRoom (replicate (n-1) dbox ++ [Node (cleatOnward door) []])
rezColor :: RandomGen g => State g LightSource rezColor :: RandomGen g => State g LightSource
rezColor = do rezColor = do
src/Dodge/Room/RoadBlock.hs
+1 -1
View File
@@ -59,7 +59,7 @@ longBlockedCorridor maxn = do
,sPS (V2 20 15) 0 putLamp ,sPS (V2 20 15) 0 putLamp
] ]
sequence $ treeFromPost (replicate n $ shuffleLinks corridor) sequence $ treeFromPost (replicate n $ shuffleLinks corridor)
$ return $ useAll $ set rmPmnts plmnts corridor $ return $ cleatOnward $ set rmPmnts plmnts corridor
-- | A single corridor with a destructible block blocking it. -- | A single corridor with a destructible block blocking it.
blockedCorridor :: RandomGen g => State g (Tree Room) blockedCorridor :: RandomGen g => State g (Tree Room)
src/Dodge/Room/Room.hs
+34 -51
View File
@@ -57,11 +57,11 @@ roomPadCut ps p = defaultRoom
} }
branchWith :: Room -> [Tree Room] -> Tree Room branchWith :: Room -> [Tree Room] -> Tree Room
branchWith r ts = Node r $ return (useAll door) : ts branchWith r ts = Node r $ return (cleatOnward door) : ts
manyDoors :: Int -> Tree Room manyDoors :: Int -> Tree Room
manyDoors i = treeFromPost (replicate i door) $ useAll door manyDoors i = treeFromPost (replicate i door) $ cleatOnward door
glassSwitchBack :: RandomGen g => State g Room glassSwitchBack :: RandomGen g => State g Room
glassSwitchBack = do glassSwitchBack = do
@@ -108,21 +108,14 @@ miniRoom3 = do
w <- state $ randomR (300,400) w <- state $ randomR (300,400)
h <- state $ randomR (300,400) h <- state $ randomR (300,400)
let cp = V2 0 (h/2+40) let cp = V2 0 (h/2+40)
let b = PutBlock StoneBlock 5 [20,20] baseBlockPane $ map toV2 [(-10,-60) let b = PutBlock StoneBlock 5 [20,20] baseBlockPane $ rectNSEW 10 (-10) (-60) (-80)
,( 10,-60) -- baseBlockPlane might need a reverse...
,( 10,-80) let plmnts = concatMap
,(-10,-80) (\i -> [ sPS cp (fromIntegral i*pi/4) $ windowLineType (V2 0 (-40)) (V2 0 (-80))
] , sPS cp (pi/8+fromIntegral i*pi/4) b]
let plmnts = ) [0..7::Int]
[ sPS cp (fromIntegral i*pi/4) $ windowLineType (V2 0 (-40)) (V2 0 (-80)) ++ [ sPS cp 0 $ PutCrit miniGunCrit , sPS (V2 (w/2) (h/2)) 0 putLamp ]
| i <- [0..7::Int] pure <$> shuffleLinks (cleatOnward $ set rmPmnts plmnts $ roomRectAutoLinks w h)
] ++
[ sPS cp (pi/8+fromIntegral i*pi/4) b
| i <- [0..7::Int]
] ++
[ sPS cp 0 $ PutCrit miniGunCrit
, sPS (V2 (w/2) (h/2)) 0 putLamp ]
fmap (pure . useAll) $ shuffleLinks $ set rmPmnts plmnts $ roomRectAutoLinks w h
rot90Around :: Point2 -> Point2 -> Point2 rot90Around :: Point2 -> Point2 -> Point2
rot90Around cen p = cen +.+ vNormal (p -.- cen) rot90Around cen p = cen +.+ vNormal (p -.- cen)
@@ -197,7 +190,7 @@ weaponEmptyRoom = do
f (V2 x y,a) = (a == pi && x > 25 && x < w - 25) || (a /= 0 && y > w - 30) f (V2 x y,a) = (a == pi && x > 25 && x < w - 25) || (a /= 0 && y > w - 30)
rm <- addHighGirder >=> shuffleLinks rm <- addHighGirder >=> shuffleLinks
$ restrictRMInLinksPD f (roomRect w h 2 2 & rmPmnts .~ plmnts) $ restrictRMInLinksPD f (roomRect w h 2 2 & rmPmnts .~ plmnts)
return $ treeFromTrunk [ corridor] (pure $ useAll rm ) return $ treeFromTrunk [ corridor] (pure $ cleatOnward rm )
weaponUnderCrits :: RandomGen g => Int -> State g (LabTree Room) weaponUnderCrits :: RandomGen g => Int -> State g (LabTree Room)
weaponUnderCrits i = do weaponUnderCrits i = do
@@ -207,23 +200,17 @@ weaponUnderCrits i = do
,sPS (V2 20 20) ( pi/2) randC1 ,sPS (V2 20 20) ( pi/2) randC1
] ]
addwpat p = rmPmnts .:~ PickOnePlacement i (sPS p 0 $ RandPS randFirstWeapon) addwpat p = rmPmnts .:~ PickOnePlacement i (sPS p 0 $ RandPS randFirstWeapon)
let continuationRoom = treeFromTrunk let continuationRoom = treePost
[ addwpat (V2 20 0) corridorN, addwpat (V2 20 0) corridorN] [ addwpat (V2 20 0) corridorN
(pure $ useAll (set rmPmnts plmnts corridorN)) , addwpat (V2 20 0) corridorN
, cleatOnward (set rmPmnts plmnts corridorN)
]
rcp <- roomCenterPillar rcp <- roomCenterPillar
rmpils <- roomPillars 30 240 240 2 2 rmpils <- roomPillars 30 240 240 2 2
deadEndRoom' <- takeOne deadEndRoom' <- takeOne [ addwpat (V2 120 20) rmpils , addwpat (V2 120 20) rcp]
[ addwpat (V2 120 20) rmpils
, addwpat (V2 120 20) rcp]
junctionRoom <- takeOne [ tEast, tWest] junctionRoom <- takeOne [ tEast, tWest]
let thetree = treeFromTrunk let thetree = treeFromTrunk [ corridorN , corridorN]
--[ $ corridorN & rmPmnts .:~ mntLightLnkCond (resetPLUse $ rprBool $ \rp _ -> isInLnk rp) $ Node junctionRoom [continuationRoom ,pure deadEndRoom' ]
[ corridorN
, corridorN]
$ Node junctionRoom
[continuationRoom
,pure deadEndRoom'
]
return (toOnward "weaponUnderCrits" , thetree ) return (toOnward "weaponUnderCrits" , thetree )
-- TODO addSubmessages -- TODO addSubmessages
@@ -254,7 +241,7 @@ weaponBehindPillar = do
--, $ over rmOutLinks tail $ over rmPmnts (++ plmnts1) rcp --, $ over rmOutLinks tail $ over rmPmnts (++ plmnts1) rcp
, over rmPmnts (++ plmnts1) rcp , over rmPmnts (++ plmnts1) rcp
] ]
(pure . useAll $ set rmPmnts [sPS (V2 20 60) (negate $ pi/2) randC1] corridorN) (pure . cleatOnward $ set rmPmnts [sPS (V2 20 60) (negate $ pi/2) randC1] corridorN)
weaponBetweenPillars :: RandomGen g => State g (Tree Room) weaponBetweenPillars :: RandomGen g => State g (Tree Room)
weaponBetweenPillars = do weaponBetweenPillars = do
@@ -268,23 +255,21 @@ weaponBetweenPillars = do
] ]
ncrits <- state $ randomR (1,3) ncrits <- state $ randomR (1,3)
critPlacementSpots <- replicateM ncrits $ randDirPS $ rprBool $ \rp r -> critPlacementSpots <- replicateM ncrits $ randDirPS $ rprBool $ \rp r ->
RoomPosOnPath `S.member` _rpType rp RoomPosOnPath `S.member` _rpType rp
&& _rpPlacementUse rp == 0 && _rpPlacementUse rp == 0
&& all ((>100) . dist (_rpPos rp)) (usedRoomLinkPoss r) && all ((>100) . dist (_rpPos rp)) (usedRoomLinkPoss r)
theRoom <- roomPillars 30 w h wn hn <&> rmPmnts .++~ fmap pure $ roomPillars 30 w h wn hn
sps wpPos (RandPS randFirstWeapon) : map (`sps` randC1) critPlacementSpots <&> rmPmnts .++~ sps wpPos (RandPS randFirstWeapon) : map (`sps` randC1) critPlacementSpots
return $ pure $ useAll theRoom <&> cleatOnward
weaponLongCorridor :: RandomGen g => State g (Tree Room) weaponLongCorridor :: RandomGen g => State g (Tree Room)
weaponLongCorridor = do weaponLongCorridor = do
rt <- takeOne [tEast, tWest] rt <- takeOne [tEast, tWest]
connectingRoom <- takeOne connectingRoom <- takeOne [tEast & rmPmnts .~ [spanLightI (V2 (-30) 40) (V2 (-30) 80)] ]
[tEast & rmPmnts .~ [spanLightI (V2 (-30) 40) (V2 (-30) 80)]
]
i1 <- state $ randomR (2,5) i1 <- state $ randomR (2,5)
i2 <- state $ randomR (2,5) i2 <- state $ randomR (2,5)
let branch1 = treeFromTrunk (replicate i1 corridorN) (pure . useAll $ putCrs connectingRoom) let branch1 = treeFromTrunk (replicate i1 corridorN) (pure . cleatOnward $ putCrs connectingRoom)
let branch2 = treeFromTrunk (replicate i2 corridorN) (pure . useSide $ putWp corridor) let branch2 = treeFromTrunk (replicate i2 corridorN) (pure . cleatSide $ putWp corridor)
return $ Node rt [branch1,branch2] return $ Node rt [branch1,branch2]
where where
putCrs = over rmPmnts (++ [sPS (V2 10 40) (-pi/2) randC1 ,sPS (V2 (-10) 40) (-pi/2) randC1 ]) putCrs = over rmPmnts (++ [sPS (V2 10 40) (-pi/2) randC1 ,sPS (V2 (-10) 40) (-pi/2) randC1 ])
@@ -414,30 +399,28 @@ pistolerRoom = pillarGrid
shootingRange :: RandomGen g => State g (LabTree Room) shootingRange :: RandomGen g => State g (LabTree Room)
shootingRange = do shootingRange = do
rm1 <- shootersRoom1 >>= shuffleLinks . restrictInLinks (\(V2 _ y,_) -> y < 40) rm1 <- shootersRoom1 >>= shuffleLinks . restrictInLinks (\(V2 _ y,_) -> y < 40)
. restrictOutLinks (\(V2 _ y,r) -> y > 200 && r /= 0) . restrictOutLinks (\(V2 _ y,r) -> y > 200 && r /= 0)
rm2 <- shootersRoom >>= shuffleLinks rm2 <- shootersRoom >>= shuffleLinks
. restrictInLinks (\(V2 x y,_) -> y < 10 && x > 20 && x < 180) . restrictInLinks (\(V2 x y,_) -> y < 10 && x > 20 && x < 180)
. restrictOutLinks (\(V2 _ y,r) -> y > 200 && r /= 0) . restrictOutLinks (\(V2 _ y,r) -> y > 200 && r /= 0)
rm3 <- shootersRoom >>= shuffleLinks rm3 <- shootersRoom >>= shuffleLinks
. restrictInLinks (\(V2 x y,_) -> y < 10 && x > 20 && x < 180) . restrictInLinks (\(V2 x y,_) -> y < 10 && x > 20 && x < 180)
. restrictOutLinks (\(_,r) -> r == 0) . restrictOutLinks (\(_,r) -> r == 0)
return ( toOnward "shootingRange" rToOnward "shootingRange" $ treePost
,treeFromPost
[ rm1 [ rm1
, roomPadCut (rectNSWE 40 (-40) (-80) 80) (V2 0 20) , roomPadCut (rectNSWE 40 (-40) (-80) 80) (V2 0 20)
& rmPmnts %~ (spanLightI (V2 (-80) 10) (V2 80 10) :) & rmPmnts %~ (spanLightI (V2 (-80) 10) (V2 80 10) :)
, rm2 , rm2
, roomPadCut (rectNSWE 40 (-40) (-80) 80) (V2 0 20) , roomPadCut (rectNSWE 40 (-40) (-80) 80) (V2 0 20)
& rmPmnts %~ (spanLightI (V2 (-80) 10) (V2 80 10) :) & rmPmnts %~ (spanLightI (V2 (-80) 10) (V2 80 10) :)
, cleatOnward rm3
] ]
(useAll rm3)
)
spawnerRoom :: RandomGen g => State g (Tree Room) spawnerRoom :: RandomGen g => State g (Tree Room)
spawnerRoom = do spawnerRoom = do
x <- state $ randomR (250,300) x <- state $ randomR (250,300)
y <- state $ randomR (300,400) y <- state $ randomR (300,400)
roomWithSpawner <- roomC x y <&> roomWithSpawner <- roomC x y <&>
rmPmnts %~ (spNoID (PSRoomRand 0 (uncurry PS)) (PutCrit spawnerCrit) :) rmPmnts .:~ spNoID (PSRoomRand 0 (uncurry PS)) (PutCrit spawnerCrit)
aRoom <- airlock aRoom <- airlock
return $ treeFromTrunk [ aRoom, corridor] $ pure $ useAll roomWithSpawner return $ treeFromTrunk [ aRoom, corridor] $ pure $ cleatOnward roomWithSpawner
src/Dodge/Room/RunPast.hs
+3 -2
View File
@@ -54,8 +54,9 @@ runPastRoom i = do
critroom = linkcor & rmPmnts .:~ plRRpt 0 randC1 critroom = linkcor & rmPmnts .:~ plRRpt 0 randC1
switchdoor = triggerDoorRoom i switchdoor = triggerDoorRoom i
n = length $ filter (elem theedge . _rlType) (_rmLinks cenroom) n = length $ filter (elem theedge . _rlType) (_rmLinks cenroom)
doorrooms = map (treePost . (switchdoor:)) $ [critroom] doorrooms = map (treePost . (switchdoor:))
: [ linkcor,corridor,corridor,useAll door] $ [critroom]
: [linkcor,corridor,corridor,cleatOnward door]
: replicate (n-2) [linkcor] : replicate (n-2) [linkcor]
return $ Node cenroom $ return $ Node cenroom $
map (over root $ rmConnectsTo .~ S.member theedge) doorrooms map (over root $ rmConnectsTo .~ S.member theedge) doorrooms
src/Dodge/Room/SensorDoor.hs
+13 -11
View File
@@ -40,8 +40,12 @@ sensorRoom :: RandomGen g => DamageType -> Int -> State g (Tree Room)
sensorRoom senseType n = do sensorRoom senseType n = do
rm <- takeOne [roomNgon 8 200, roomRectAutoLinks 200 200] rm <- takeOne [roomNgon 8 200, roomRectAutoLinks 200 200]
cenroom <- shuffleLinks $ sensInsideDoor senseType n rm cenroom <- shuffleLinks $ sensInsideDoor senseType n rm
let doorroom = triggerDoorRoom n return $ treePost
return $ treeFromPost [ door, cenroom & rmLinkEff .~ f, doorroom] (useAll door) [ door
, cenroom & rmLinkEff .~ f
, triggerDoorRoom n
, cleatOnward door
]
where where
f _ _ 0 rl rm = rm & rmLinks %~ map (g (_rlPos rl) (_rlDir rl)) f _ _ 0 rl rm = rm & rmLinks %~ map (g (_rlPos rl) (_rlDir rl))
f _ _ _ _ rm = rm f _ _ _ _ rm = rm
@@ -55,15 +59,13 @@ sensorRoom senseType n = do
sensorRoomRunPast :: RandomGen g => DamageType -> Int -> State g (LabTree Room) sensorRoomRunPast :: RandomGen g => DamageType -> Int -> State g (LabTree Room)
sensorRoomRunPast dt n = do sensorRoomRunPast dt n = do
t <- sensorRoom dt n t <- sensorRoom dt n
return ( toOnward "sensorRoomRunPast" rToOnward "sensorRoomRunPast" $ t & applyToSubforest [0]
, applyToSubforest [0] (++ (++
[treeFromPost [treePost
[ door & rmConnectsTo [ door & rmConnectsTo .~ (\s -> S.member InLink s && not (S.member BlockedLink s))
.~ (\s -> S.member InLink s && not (S.member BlockedLink s)) , cleatLabel 0 corridor ]
] (useLabel 0 corridor) ]
] )
) t
)--[return $ useLabel 0 $ door & rmConnectsTo .~ S.member InLink]
sensAboveDoor :: DamageType -> Float -> PlacementSpot -> Placement sensAboveDoor :: DamageType -> Float -> PlacementSpot -> Placement
sensAboveDoor sensetype wth ps = extTrigLitPos sensAboveDoor sensetype wth ps = extTrigLitPos
src/Dodge/Room/Start.hs
+2 -2
View File
@@ -46,7 +46,7 @@ powerFakeout = do
++ randcors ++ randcors
++ [ corridor & rmPmnts .:~ plRRpt 0 (PutFlIt shrinkGun) ++ [ corridor & rmPmnts .:~ plRRpt 0 (PutFlIt shrinkGun)
, keyholeCorridor, corridor]) , keyholeCorridor, corridor])
`treeFromPost` useAll door `treeFromPost` cleatOnward door
startRoom :: RandomGen g => Int -> State g (LabTree Room) startRoom :: RandomGen g => Int -> State g (LabTree Room)
startRoom i = join (takeOne startRoom i = join (takeOne
@@ -80,7 +80,7 @@ runPastStart i = do
rezBoxStart :: RandomGen g => State g (Tree Room) rezBoxStart :: RandomGen g => State g (Tree Room)
rezBoxStart = do rezBoxStart = do
ls <- rezColor ls <- rezColor
return $ treeFromPost [ rezBox ls] (useAll door) return $ treePost [ rezBox ls, cleatOnward door ]
rezBoxesThenWeaponRoom :: RandomGen g => Int -> State g (Tree Room,String) rezBoxesThenWeaponRoom :: RandomGen g => Int -> State g (Tree Room,String)
rezBoxesThenWeaponRoom i = do rezBoxesThenWeaponRoom i = do
src/Dodge/Room/Warning.hs
+1 -4
View File
@@ -41,10 +41,7 @@ warningRooms :: RandomGen g => Int -> State g (LabTree Room)
warningRooms n = do warningRooms n = do
rm <- takeOne [roomNgon 8 200, roomRectAutoLinks 200 200] rm <- takeOne [roomNgon 8 200, roomRectAutoLinks 200 200]
cenroom <- shuffleLinks $ addWarningTerminal n rm cenroom <- shuffleLinks $ addWarningTerminal n rm
let doorroom = triggerDoorRoom n rToOnward "warningRooms" $ treePost [ door, cenroom, triggerDoorRoom n, cleatOnward door]
return ( toOnward "warningRooms"
, treeFromPost [ door, cenroom, doorroom] (useAll door)
)
addWarningTerminal :: Int -> Room -> Room addWarningTerminal :: Int -> Room -> Room
addWarningTerminal outplid = (rmName .++~ "warningTerm-") addWarningTerminal outplid = (rmName .++~ "warningTerm-")
src/Dodge/UseAll.hs
+6 -6
View File
@@ -23,11 +23,11 @@ toClusterLabel i s rm
| LabelCluster i `elem` rm ^?! rmClusterStatus . csLinks = Just ([s],rm) | LabelCluster i `elem` rm ^?! rmClusterStatus . csLinks = Just ([s],rm)
| otherwise = Nothing | otherwise = Nothing
useAll :: Room -> Room cleatOnward :: Room -> Room
useAll = rmClusterStatus . csLinks .~ S.singleton OnwardCluster cleatOnward = rmClusterStatus . csLinks .~ S.singleton OnwardCluster
useSide :: Room -> Room cleatSide :: Room -> Room
useSide = rmClusterStatus . csLinks .~ S.singleton SideCluster cleatSide = rmClusterStatus . csLinks .~ S.singleton SideCluster
useLabel :: Int -> Room -> Room cleatLabel :: Int -> Room -> Room
useLabel i = rmClusterStatus . csLinks .~ S.singleton (LabelCluster i) cleatLabel i = rmClusterStatus . csLinks .~ S.singleton (LabelCluster i)