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
thecor <- shuffleLinks corridor
takeOne
[ (toOnward "door", return (useAll door))
, (toOnward "twoDoors"
,treeFromPost [ door, thecor] (useAll door)
)
[ (toOnward "door", return (cleatOnward door))
, (toOnward "twoDoors" ,treePost [ door, thecor, cleatOnward door])
]
{- 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
a <- takeOne as
anoToRoomTree' a
[Corridor] -> pure . useAll <$> shuffleLinks corridor
[Corridor] -> pure . cleatOnward <$> shuffleLinks corridor
(BossAno cr : _) -> do
br <- bossRoom cr
branchRectWith . pure $ treeFromPost [corridor,corridor] br
@@ -79,4 +77,4 @@ anoToRoomTree' anos = case anos of
_ -> do
w <- state $ randomR (100,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 #-}
{- | The tree of rooms that make up a level. -}
module Dodge.Floor
@@ -40,18 +40,16 @@ initialAnoTree = padSucWithDoors $ treeFromPost
[[AnoApplyInt 110 startRoom]
, [PassthroughLockKeyLists 2 keyCardRunPastRand itemRooms]
, [SpecificRoom $ warningRooms 777777]
, [SpecificRoom $ return ( toOnward "chaseCrit+armourChaseCrit rectRoom"
, return . useAll $ roomRectAutoLinks 400 400
& rmPmnts .++~ [spNoID anyUnusedSpot (PutCrit invisibleChaseCrit)
, spNoID anyUnusedSpot (PutCrit armourChaseCrit)
]
)
, [SpecificRoom $ rToOnward "chaseCrit+armourChaseCrit rectRoom"
$ return . cleatOnward $ roomRectAutoLinks 400 400 & rmPmnts .++~
[ spNoID anyUnusedSpot (PutCrit invisibleChaseCrit)
, spNoID anyUnusedSpot (PutCrit armourChaseCrit)
]
]
-- , [AnoApplyInt 100 healthTest]
, [PassthroughLockKeyLists 23
[(sensorRoomRunPast ELECTRICAL, takeOne [STATICMODULE,SPARKGUN] )] itemRooms]
, [SpecificRoom ((return . useAll <$> tanksRoom [] [])
<&> (toOnward "empty tanksRoom",))]
, [SpecificRoom (tanksRoom [] [] >>= rToOnward "empty tanksRoom" . pure . cleatOnward)]
, [PassthroughLockKeyLists 222 lockRoomKeyItems itemRooms]
, [SpecificRoom randomChallenges]
, [AnoApplyInt 1 lasSensorTurretTest]
@@ -95,11 +93,9 @@ initialAnoTree = padSucWithDoors $ treeFromPost
-- ,[Corridor]
-- ,[TreasureAno [addArmour autoCrit,addArmour autoCrit] [launcher]]
-- ,[Corridor]
,[SpecificRoom $ (pure . useAll <$> randomFourCornerRoom [])
<&>(toOnward "randomFourCornerRoom" , )]
,[SpecificRoom $ randomFourCornerRoom [] >>= rToOnward "randomFourCornerRoom" . pure . cleatOnward ]
]
[SpecificRoom $ fmap (pure . useAll) (telRoomLev 1)
<&> (toOnward "telRoomLev" ,)]
[SpecificRoom $ telRoomLev 1 >>= rToOnward "telRoomLev" . pure . cleatOnward]
{- | A test level tree. -}
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 = [(return . useAll <$> bossRoom autoCrit, takeOne [PISTOL]) ]
bossKeyItems = [(return . cleatOnward <$> bossRoom autoCrit, takeOne [PISTOL]) ]
lockRoomMultiItems :: RandomGen g => [ ( State g (LabTree Room) , State g [ItemBaseType] ) ]
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 = do
teleFromRoom <- shuffleLinks $ roomRectAutoLinks 200 200
teleToRoom <- shuffleLinks $ roomRectAutoLinks 200 200
emptylink <- shuffleLinks emptyCorridor
return (toOnward "blinkAcrossChallenge"
,treeFromPost [ teleFromRoom, emptylink] (useAll teleToRoom)
)
teleToRoom <- shuffleLinks $ roomRectAutoLinks 200 200
emptylink <- shuffleLinks emptyCorridor
rToOnward "blinkAcrossChallenge"
$ treePost [ teleFromRoom, emptylink, cleatOnward teleToRoom]
emptyCorridor :: Room
emptyCorridor = corridor & rmPolys .~ []
src/Dodge/Room/Branch.hs
+1 -1
View File
@@ -23,6 +23,6 @@ branchRectWith t = do
b <- t
rt <- shuffleLinks $ roomRectAutoLinks x y
return $ Node rt
[ Node (useAll door) []
[ pure $ cleatOnward door
, treeFromTrunk [door] b
]
src/Dodge/Room/Containing.hs
+3 -5
View File
@@ -21,18 +21,16 @@ roomsContaining crs its = do
[ randomFourCornerRoomCrsIts 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))
, pure $ useAll endroom
)
$ pure $ cleatOnward endroom
roomsContaining' :: RandomGen g => [Creature] -> [Item] -> State g (Tree Room)
roomsContaining' crs its = do
endroom <- join $ takeOne
[ randomFourCornerRoomCrsIts crs its
, tanksRoom crs its
]
return (pure $ useAll endroom
)
return (pure $ cleatOnward endroom)
pedestalRoom :: RandomGen g => Item -> State g Room
pedestalRoom it = do
src/Dodge/Room/GlassLesson.hs
+2 -2
View File
@@ -27,7 +27,7 @@ glassLesson = do
[ pure $ door & rmConnectsTo .~ fromWest North 1
, uppers
, treeFromPost ( (door & rmConnectsTo .~ S.member (OnEdge East))
: corridors) $ useAll door]
: corridors) $ cleatOnward door]
where
fromWest edge i s = S.member (OnEdge edge) s && S.member (FromWest i) s
uppers = Node (door & rmConnectsTo .~ fromWest North 0) [pure topRoom]
@@ -56,4 +56,4 @@ glassLesson = do
glassLessonRunPast :: RandomGen g => State g (LabTree Room)
glassLessonRunPast = (f <$> glassLesson) <&> (toOnward "glassLessonRunPast",)
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
return (toOnward "keyCardRoomRunPast",
treeFromTrunk [door] $ Node cenroom
[ treeFromPost [doorroom] (useAll door)
, treeFromPost [door] (useLabel rmid corridor)
[ treeFromPost [doorroom] (cleatOnward door)
, treeFromPost [door] (cleatLabel rmid corridor)
])
keyCardAnalyserByDoor :: Int -> Int -> Room -> Room
@@ -106,19 +106,19 @@ analyserByDoor proxreq outplid rm = rm
healthTest :: RandomGen g => Int -> State g (Tree Room)
healthTest n = do
cenroom <- shuffleLinks $ healthAnalyserByDoor n $ roomNgon 8 200
let doorroom = triggerDoorRoom n
return $ treeFromPost [door
return $ treePost
[ door
, corridor & rmPmnts .:~ spNoID (PS 20 0) (PutFlIt (medkit 100))
, cenroom, doorroom]
(useAll door)
, cenroom
, triggerDoorRoom n
, cleatOnward door
]
lasSensorTurretTest :: RandomGen g => Int -> State g (LabTree Room)
lasSensorTurretTest n = do
cenroom <- shuffleLinks $ lightSensInsideDoor n cenLasTur
let doorroom = triggerDoorRoom n
return ( toOnward "lasSensorTurretTest"
, treeFromPost [ door, cenroom, doorroom] (useAll door)
)
rToOnward "lasSensorTurretTest" $ treePost
[ door, cenroom, triggerDoorRoom n, cleatOnward door]
lasCenSensEdge :: RandomGen g => Int -> State g (LabTree Room)
lasCenSensEdge n = do
@@ -126,9 +126,9 @@ lasCenSensEdge n = do
let doorroom = triggerDoorRoom n
rToOnward "lasCenSensEdge"
$ treeFromTrunk [ door] $ Node cenroom
[ treeFromPost [ doorroom] (useAll door)
, treeFromPost [ door] (useLabel 0 corridor)
]
[ treePost [ doorroom, cleatOnward door ]
, treePost [ door, cleatLabel 0 corridor]
]
lasTunnel :: RandomGen g => Float -> State g Room
lasTunnel y = do
@@ -171,6 +171,6 @@ lasTunnelRunPast y = do
r1 <- takeOne [door,corridor]
r2 <- takeOne [door,corridor]
rToOnward "lasTunnelRunPast" $ Node r
[ pure $ useAll r1
, return (useLabel 0 $ r2 & rmConnectsTo .~ S.member InLink)
[ pure $ cleatOnward r1
, 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
r <- slowDoorRoom
rToOnward "slowDoorRoomRunPast" $ treeFromTrunk [ door] $ Node r
[ pure $ useAll door
, return (useLabel 0 $ door & rmConnectsTo .~ S.member InLink)
[ pure $ cleatOnward door
, 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
r <- longRoom
rToOnward "longRoomRunPast"
$ treeFromTrunk [ door] $ Node r
[ pure $ useAll door
, treeFromPost [ corridor & rmConnectsTo .~ S.member InLink]
(useLabel 0 door)
$ treeFromTrunk [door] $ Node r
[ pure $ cleatOnward door
, treePost [ corridor & rmConnectsTo .~ S.member InLink, cleatLabel 0 door ]
]
src/Dodge/Room/RezBox.hs
+2 -2
View File
@@ -60,7 +60,7 @@ rezBoxesWp = do
adddoor rm = treeFromPost [ connectsToNorth door ] rm
connectsToNorth = rmConnectsTo .~ S.member (OnEdge North)
maybeBlockedPassage :: RandomGen g => State g (Tree Room)
maybeBlockedPassage = fmap (pure . useAll)
maybeBlockedPassage = fmap (pure . cleatOnward)
$ join $ takeOne [return corridor, blockedCorridorCloseBlocks]
rezBoxesWpCrit :: RandomGen g => State g (Tree Room)
rezBoxesWpCrit = do
@@ -100,7 +100,7 @@ rezBoxes = do
& rmLinks %~ setInLinks bottomEdgeTest
let n = length $ filter bottomEdgeTest $_rmLinks centralRoom
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 = do
src/Dodge/Room/RoadBlock.hs
+1 -1
View File
@@ -59,7 +59,7 @@ longBlockedCorridor maxn = do
,sPS (V2 20 15) 0 putLamp
]
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.
blockedCorridor :: RandomGen g => State g (Tree Room)
src/Dodge/Room/Room.hs
+35 -52
View File
@@ -57,11 +57,11 @@ roomPadCut ps p = defaultRoom
}
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 i = treeFromPost (replicate i door) $ useAll door
manyDoors i = treeFromPost (replicate i door) $ cleatOnward door
glassSwitchBack :: RandomGen g => State g Room
glassSwitchBack = do
@@ -108,21 +108,14 @@ miniRoom3 = do
w <- state $ randomR (300,400)
h <- state $ randomR (300,400)
let cp = V2 0 (h/2+40)
let b = PutBlock StoneBlock 5 [20,20] baseBlockPane $ map toV2 [(-10,-60)
,( 10,-60)
,( 10,-80)
,(-10,-80)
]
let plmnts =
[ sPS cp (fromIntegral i*pi/4) $ windowLineType (V2 0 (-40)) (V2 0 (-80))
| i <- [0..7::Int]
] ++
[ 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
let b = PutBlock StoneBlock 5 [20,20] baseBlockPane $ rectNSEW 10 (-10) (-60) (-80)
-- baseBlockPlane might need a reverse...
let plmnts = concatMap
(\i -> [ sPS cp (fromIntegral i*pi/4) $ windowLineType (V2 0 (-40)) (V2 0 (-80))
, sPS cp (pi/8+fromIntegral i*pi/4) b]
) [0..7::Int]
++ [ sPS cp 0 $ PutCrit miniGunCrit , sPS (V2 (w/2) (h/2)) 0 putLamp ]
pure <$> shuffleLinks (cleatOnward $ set rmPmnts plmnts $ roomRectAutoLinks w h)
rot90Around :: Point2 -> Point2 -> Point2
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)
rm <- addHighGirder >=> shuffleLinks
$ 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 i = do
@@ -207,23 +200,17 @@ weaponUnderCrits i = do
,sPS (V2 20 20) ( pi/2) randC1
]
addwpat p = rmPmnts .:~ PickOnePlacement i (sPS p 0 $ RandPS randFirstWeapon)
let continuationRoom = treeFromTrunk
[ addwpat (V2 20 0) corridorN, addwpat (V2 20 0) corridorN]
(pure $ useAll (set rmPmnts plmnts corridorN))
let continuationRoom = treePost
[ addwpat (V2 20 0) corridorN
, addwpat (V2 20 0) corridorN
, cleatOnward (set rmPmnts plmnts corridorN)
]
rcp <- roomCenterPillar
rmpils <- roomPillars 30 240 240 2 2
deadEndRoom' <- takeOne
[ addwpat (V2 120 20) rmpils
, addwpat (V2 120 20) rcp]
deadEndRoom' <- takeOne [ addwpat (V2 120 20) rmpils , addwpat (V2 120 20) rcp]
junctionRoom <- takeOne [ tEast, tWest]
let thetree = treeFromTrunk
--[ $ corridorN & rmPmnts .:~ mntLightLnkCond (resetPLUse $ rprBool $ \rp _ -> isInLnk rp)
[ corridorN
, corridorN]
$ Node junctionRoom
[continuationRoom
,pure deadEndRoom'
]
let thetree = treeFromTrunk [ corridorN , corridorN]
$ Node junctionRoom [continuationRoom ,pure deadEndRoom' ]
return (toOnward "weaponUnderCrits" , thetree )
-- TODO addSubmessages
@@ -254,7 +241,7 @@ weaponBehindPillar = do
--, $ over rmOutLinks tail $ 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 = do
@@ -268,23 +255,21 @@ weaponBetweenPillars = do
]
ncrits <- state $ randomR (1,3)
critPlacementSpots <- replicateM ncrits $ randDirPS $ rprBool $ \rp r ->
RoomPosOnPath `S.member` _rpType rp
&& _rpPlacementUse rp == 0
&& all ((>100) . dist (_rpPos rp)) (usedRoomLinkPoss r)
theRoom <- roomPillars 30 w h wn hn <&> rmPmnts .++~
sps wpPos (RandPS randFirstWeapon) : map (`sps` randC1) critPlacementSpots
return $ pure $ useAll theRoom
RoomPosOnPath `S.member` _rpType rp
&& _rpPlacementUse rp == 0
&& all ((>100) . dist (_rpPos rp)) (usedRoomLinkPoss r)
fmap pure $ roomPillars 30 w h wn hn
<&> rmPmnts .++~ sps wpPos (RandPS randFirstWeapon) : map (`sps` randC1) critPlacementSpots
<&> cleatOnward
weaponLongCorridor :: RandomGen g => State g (Tree Room)
weaponLongCorridor = do
rt <- takeOne [tEast, tWest]
connectingRoom <- takeOne
[tEast & rmPmnts .~ [spanLightI (V2 (-30) 40) (V2 (-30) 80)]
]
connectingRoom <- takeOne [tEast & rmPmnts .~ [spanLightI (V2 (-30) 40) (V2 (-30) 80)] ]
i1 <- state $ randomR (2,5)
i2 <- state $ randomR (2,5)
let branch1 = treeFromTrunk (replicate i1 corridorN) (pure . useAll $ putCrs connectingRoom)
let branch2 = treeFromTrunk (replicate i2 corridorN) (pure . useSide $ putWp corridor)
let branch1 = treeFromTrunk (replicate i1 corridorN) (pure . cleatOnward $ putCrs connectingRoom)
let branch2 = treeFromTrunk (replicate i2 corridorN) (pure . cleatSide $ putWp corridor)
return $ Node rt [branch1,branch2]
where
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 = do
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
. restrictInLinks (\(V2 x y,_) -> y < 10 && x > 20 && x < 180)
. restrictOutLinks (\(V2 _ y,r) -> y > 200 && r /= 0)
rm3 <- shootersRoom >>= shuffleLinks
. restrictInLinks (\(V2 x y,_) -> y < 10 && x > 20 && x < 180)
. restrictOutLinks (\(_,r) -> r == 0)
return ( toOnward "shootingRange"
,treeFromPost
rToOnward "shootingRange" $ treePost
[ rm1
, roomPadCut (rectNSWE 40 (-40) (-80) 80) (V2 0 20)
& rmPmnts %~ (spanLightI (V2 (-80) 10) (V2 80 10) :)
, rm2
, roomPadCut (rectNSWE 40 (-40) (-80) 80) (V2 0 20)
& rmPmnts %~ (spanLightI (V2 (-80) 10) (V2 80 10) :)
]
(useAll rm3)
)
, cleatOnward rm3
]
spawnerRoom :: RandomGen g => State g (Tree Room)
spawnerRoom = do
x <- state $ randomR (250,300)
y <- state $ randomR (300,400)
roomWithSpawner <- roomC x y <&>
rmPmnts %~ (spNoID (PSRoomRand 0 (uncurry PS)) (PutCrit spawnerCrit) :)
rmPmnts .:~ spNoID (PSRoomRand 0 (uncurry PS)) (PutCrit spawnerCrit)
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
switchdoor = triggerDoorRoom i
n = length $ filter (elem theedge . _rlType) (_rmLinks cenroom)
doorrooms = map (treePost . (switchdoor:)) $ [critroom]
: [ linkcor,corridor,corridor,useAll door]
doorrooms = map (treePost . (switchdoor:))
$ [critroom]
: [linkcor,corridor,corridor,cleatOnward door]
: replicate (n-2) [linkcor]
return $ Node cenroom $
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
rm <- takeOne [roomNgon 8 200, roomRectAutoLinks 200 200]
cenroom <- shuffleLinks $ sensInsideDoor senseType n rm
let doorroom = triggerDoorRoom n
return $ treeFromPost [ door, cenroom & rmLinkEff .~ f, doorroom] (useAll door)
return $ treePost
[ door
, cenroom & rmLinkEff .~ f
, triggerDoorRoom n
, cleatOnward door
]
where
f _ _ 0 rl rm = rm & rmLinks %~ map (g (_rlPos rl) (_rlDir rl))
f _ _ _ _ rm = rm
@@ -55,15 +59,13 @@ sensorRoom senseType n = do
sensorRoomRunPast :: RandomGen g => DamageType -> Int -> State g (LabTree Room)
sensorRoomRunPast dt n = do
t <- sensorRoom dt n
return ( toOnward "sensorRoomRunPast"
, applyToSubforest [0] (++
[treeFromPost
[ door & rmConnectsTo
.~ (\s -> S.member InLink s && not (S.member BlockedLink s))
] (useLabel 0 corridor)
]
) t
)--[return $ useLabel 0 $ door & rmConnectsTo .~ S.member InLink]
rToOnward "sensorRoomRunPast" $ t & applyToSubforest [0]
(++
[treePost
[ door & rmConnectsTo .~ (\s -> S.member InLink s && not (S.member BlockedLink s))
, cleatLabel 0 corridor ]
]
)
sensAboveDoor :: DamageType -> Float -> PlacementSpot -> Placement
sensAboveDoor sensetype wth ps = extTrigLitPos
src/Dodge/Room/Start.hs
+2 -2
View File
@@ -46,7 +46,7 @@ powerFakeout = do
++ randcors
++ [ corridor & rmPmnts .:~ plRRpt 0 (PutFlIt shrinkGun)
, keyholeCorridor, corridor])
`treeFromPost` useAll door
`treeFromPost` cleatOnward door
startRoom :: RandomGen g => Int -> State g (LabTree Room)
startRoom i = join (takeOne
@@ -80,7 +80,7 @@ runPastStart i = do
rezBoxStart :: RandomGen g => State g (Tree Room)
rezBoxStart = do
ls <- rezColor
return $ treeFromPost [ rezBox ls] (useAll door)
return $ treePost [ rezBox ls, cleatOnward door ]
rezBoxesThenWeaponRoom :: RandomGen g => Int -> State g (Tree Room,String)
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
rm <- takeOne [roomNgon 8 200, roomRectAutoLinks 200 200]
cenroom <- shuffleLinks $ addWarningTerminal n rm
let doorroom = triggerDoorRoom n
return ( toOnward "warningRooms"
, treeFromPost [ door, cenroom, doorroom] (useAll door)
)
rToOnward "warningRooms" $ treePost [ door, cenroom, triggerDoorRoom n, cleatOnward door]
addWarningTerminal :: Int -> Room -> Room
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)
| otherwise = Nothing
useAll :: Room -> Room
useAll = rmClusterStatus . csLinks .~ S.singleton OnwardCluster
cleatOnward :: Room -> Room
cleatOnward = rmClusterStatus . csLinks .~ S.singleton OnwardCluster
useSide :: Room -> Room
useSide = rmClusterStatus . csLinks .~ S.singleton SideCluster
cleatSide :: Room -> Room
cleatSide = rmClusterStatus . csLinks .~ S.singleton SideCluster
useLabel :: Int -> Room -> Room
useLabel i = rmClusterStatus . csLinks .~ S.singleton (LabelCluster i)
cleatLabel :: Int -> Room -> Room
cleatLabel i = rmClusterStatus . csLinks .~ S.singleton (LabelCluster i)