132 lines
5.6 KiB
Haskell
132 lines
5.6 KiB
Haskell
-- | The tree of rooms that make up a level.
|
|
module Dodge.Floor (
|
|
initialRoomTree,
|
|
tutRoomTree,
|
|
) where
|
|
|
|
import Dodge.Room.Tutorial
|
|
import Dodge.Annotation.Data
|
|
import Data.List (intersperse)
|
|
import Dodge.Annotation
|
|
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
|
|
|
|
-- | A test level tree.
|
|
initialRoomTree :: State LayoutVars (MetaTree Room String)
|
|
initialRoomTree = annoToRoomTree initialAnoTree
|
|
--initialRoomTree = annoToRoomTree startWorldTreeTest
|
|
|
|
tutRoomTree :: State LayoutVars (MetaTree Room String)
|
|
tutRoomTree = annoToRoomTree tutAnoTree
|
|
|
|
--startWorldTreeTest :: Annotation
|
|
--startWorldTreeTest =
|
|
-- OnwardList $
|
|
-- [ IntAnno $ AnTree . startRoom
|
|
-- ]
|
|
|
|
initialAnoTree :: Annotation
|
|
initialAnoTree =
|
|
OnwardList $
|
|
intersperse
|
|
(AnTree $ zoom lyGen corDoor)
|
|
[ AnTree $ intAnno startRoom
|
|
, --IntAnno $
|
|
PassthroughLockKeyLists
|
|
[(sensorRoomRunPast ElectricSensor, takeOne
|
|
[-- CRAFT (ENERGYBALLCRAFT TeslaBall) ,
|
|
HELD SPARKGUN])]
|
|
itemRooms
|
|
, AnTree $ 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
|
|
, AnTree . intAnno $ warningRooms "INVISIBLE CREATURE AHEAD"
|
|
, AnTree $
|
|
rToOnward "chaseCrit+armourChaseCrit rectRoom" =<<
|
|
return . cleatOnward <$>
|
|
(roomRectAutoLinks 400 400 <&> rmPmnts
|
|
.++~ [ psPtPl anyUnusedSpot (PutCrit invisibleChaseCrit)
|
|
, psPtPl anyUnusedSpot (PutCrit armourChaseCrit)
|
|
])
|
|
, AnTree . intAnno $ fmap (tToBTree "healthTest") . healthTest
|
|
, AnTree . zoom lyGen $
|
|
(tanksRoom [] [] >>= rToOnward "empty tanksRoom" . pure . cleatOnward)
|
|
, PassthroughLockKeyLists lockRoomKeyItems itemRooms
|
|
, AnTree randomChallenges
|
|
, AnTree $ 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]
|
|
AnTree $ 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 -> Annotation
|
|
anRoom t = AnTree $ zoom lyGen (tToBTree "anRoom" . return . cleatOnward <$> t)
|