135 lines
5.8 KiB
Haskell
135 lines
5.8 KiB
Haskell
-- | The tree of rooms that make up a level.
|
|
module Dodge.Floor (
|
|
initialRoomTree,
|
|
tutRoomTree,
|
|
) where
|
|
|
|
import Dodge.Data.MTRS
|
|
import Data.Maybe
|
|
import Dodge.Room.Tutorial
|
|
import Data.List (intersperse)
|
|
import Dodge.Cleat
|
|
import Dodge.Creature
|
|
import Dodge.Data.GenWorld
|
|
import Dodge.LockAndKey
|
|
import Dodge.PlacementSpot
|
|
import Dodge.Room
|
|
import Dodge.Tree
|
|
import LensHelp
|
|
import RandomHelp
|
|
|
|
tutRoomTree :: State LayoutVars (MetaTree Room String)
|
|
tutRoomTree = tutAnoTree
|
|
|
|
initialRoomTree :: State LayoutVars MTRS
|
|
initialRoomTree =
|
|
foldMTRS $
|
|
intersperse
|
|
(zoom lyGen corDoor)
|
|
[ intAnno startRoom
|
|
, passthroughLockKeyLists
|
|
[(sensorRoomRunPast ElectricSensor, takeOne
|
|
[-- CRAFT (ENERGYBALLCRAFT TeslaBall) ,
|
|
HELD SPARKGUN])]
|
|
itemRooms
|
|
, intAnno lasSensorTurretTest
|
|
, -- , AnRoom $ tanksRoom [] [] <&> rmPmnts .~ []
|
|
-- , AnRoom $ tanksRoom [] []
|
|
-- , AnRoom $ roomCCrits 0
|
|
-- , AnRoom $ return airlock0
|
|
anRoom slowDoorRoom
|
|
, -- , AnRoom $ roomCCrits 10
|
|
-- , AnTree firstBreather
|
|
-- , AnTree $ telRoomLev 1 >>= rToOnward "telRoomLev" . pure . cleatOnward
|
|
-- ]
|
|
--
|
|
--extraAnoList :: [Annotation]
|
|
--extraAnoList =
|
|
---- , (SpecificRoom . return . tToBTree $ treePost [corridor,corridor,cleatOnward corridor])
|
|
-- [ AnRoom $ roomCCrits 10
|
|
-- , AnRoom $ roomCCrits 10
|
|
-- , AnTree $ tToBTree "spawners" <$> spawnerRoom
|
|
-- , AnRoom pistolerRoom
|
|
-- , AnRoom doubleCorridorBarrels
|
|
passthroughLockKeyLists keyCardRunPastRand itemRooms
|
|
, intAnno $ warningRooms "INVISIBLE CREATURE AHEAD"
|
|
, rToOnward "chaseCrit+armourChaseCrit rectRoom" .
|
|
return . cleatOnward =<<
|
|
(roomRectAutoLinks 400 400 <&> rmPmnts
|
|
.++~ [ psPtPl anyUnusedSpot (PutCrit invisibleChaseCrit)
|
|
, psPtPl anyUnusedSpot (PutCrit armourChaseCrit)
|
|
])
|
|
, intAnno $ fmap (tToBTree "healthTest") . healthTest
|
|
, zoom lyGen
|
|
$ tanksRoom [] [] >>= rToOnward "empty tanksRoom" . pure . cleatOnward
|
|
, passthroughLockKeyLists lockRoomKeyItems itemRooms
|
|
, randomChallenges
|
|
, intAnno lasSensorTurretTest
|
|
, -- ,[AnTree $ fmap pure roomCCrits]
|
|
-- ,[AirlockAno]
|
|
-- ,[Corridor]
|
|
------ ,[AnTree roomCCrits]
|
|
------ ,[Corridor]
|
|
------ ,[AnTree . pure . pure . useAll $ roomGlassOctogon 400
|
|
------ & rmPS %~ ([sPS (V2 0 50) 0 $ PutCrit armourChaseCrit
|
|
------ ,sPS (V2 50 25) 0 $ PutCrit armourChaseCrit
|
|
------ ,sPS (V2 50 0) 0 $ PutCrit armourChaseCrit
|
|
------ ]++)
|
|
------ ]
|
|
------ --,[AnTree . pure . pure . useAll $ roomGlassOctogon 400
|
|
------ -- & rmPS %~ ([swarmPS 0 (x,y) 0 swarmCrit | x <- [-20,-19.5.. 20] , y <- [200,202] ]++)
|
|
------ -- ]
|
|
------ ,[AnTree . pure . pure . useAll $ roomGlassOctogon 400
|
|
------ & rmPS %~ ([sPS (V2 0 50) 0 $ PutCrit pistolCrit ]++)
|
|
------ ]
|
|
------ ,[Corridor]
|
|
---- --,[AnTree $ pure . useAll <$> twinSlowDoorChasers]
|
|
----- ,[AnTree $ pure $ (pure . useAll) (twinSlowDoorRoom 80 200 40)]
|
|
----- ,[DoorAno]
|
|
----- ,[AnTree $ pure . useAll <$> centerVaultExplosiveExit]
|
|
----- ,[AnTree blockedCorridor]
|
|
----- ,[OrAno [[DoorAno]
|
|
----- ,[Corridor]
|
|
----- ,[DoorNumAno 0,AirlockAno]]
|
|
----- ]
|
|
----- ,[FirstWeapon]
|
|
----- ,[CorridorDebug]
|
|
----- ,[AnTree $ fmap (pure . useAll) randomFourCornerRoom]
|
|
-- ,[OrAno
|
|
-- [[AnTree $ branchRectWith $ fmap (fmap ) armouredChasers]
|
|
-- ,[BossAno $ addArmour launcherCrit & crHP +~ 800
|
|
-- & crState . crDropsOnDeath .~ DropSpecific [0] ]
|
|
-- ]
|
|
-- ]
|
|
---- ,[AnTree $ fmap (pure . useAll) armouredCorridor]
|
|
-- ,[Corridor]
|
|
-- ,[TreasureAno [addArmour autoCrit,addArmour autoCrit] [launcher]]
|
|
-- ,[Corridor]
|
|
randomFourCornerRoom [] >>= rToOnward "randomFourCornerRoom" . pure . cleatOnward
|
|
]
|
|
|
|
intAnno :: (Int -> State StdGen MTRS) -> State LayoutVars MTRS
|
|
intAnno f = do
|
|
LayVars g i <- get
|
|
put $ LayVars g (i+1)
|
|
zoom lyGen (f i)
|
|
|
|
anRoom :: State StdGen Room -> State LayoutVars MTRS
|
|
anRoom t = zoom lyGen (tToBTree "anRoom" . return . cleatOnward <$> t)
|
|
|
|
passthroughLockKeyLists ::
|
|
[(Int -> State LayoutVars (MetaTree Room String), State LayoutVars ItemType)]
|
|
-> [(ItemType, State LayoutVars (MetaTree Room String))]
|
|
-> State LayoutVars (MetaTree Room String)
|
|
passthroughLockKeyLists ls ks = do
|
|
i <- nextLayoutInt
|
|
(functionlockroom, randomitemidentity) <- takeOne ls
|
|
lr <- functionlockroom i
|
|
ii <- randomitemidentity
|
|
keyroom <- fromJust $ lookup ii ks
|
|
return $
|
|
MTree
|
|
("PassthroughLockKeyLists-" ++ show ii)
|
|
(NodeMTree $ MTree "RassThroughLockKeyLists" (NodeMTree lr) [MBranch (toLabel i) keyroom])
|
|
[]
|