102 lines
3.1 KiB
Haskell
102 lines
3.1 KiB
Haskell
{-# LANGUAGE TupleSections #-}
|
|
module Dodge.Room.Start
|
|
( startRoom
|
|
, randomChallenges
|
|
) where
|
|
import Dodge.Cleat
|
|
import Dodge.Data
|
|
import Dodge.LevelGen.Data
|
|
--import Dodge.PlacementSpot
|
|
import Dodge.Room.RunPast
|
|
import Dodge.Room.Containing
|
|
--import Dodge.Room.LongDoor
|
|
--import Dodge.RoomLink
|
|
--import Dodge.Data
|
|
--import Dodge.Default
|
|
--import Dodge.RoomLink
|
|
import Dodge.Tree
|
|
import RandomHelp
|
|
import Dodge.Room.Door
|
|
import Dodge.Room.RezBox
|
|
import Dodge.Room.Corridor
|
|
import Dodge.Room.Room
|
|
import Dodge.Room.Link
|
|
import Dodge.Item.Weapon
|
|
import Dodge.Item.Craftable
|
|
--import Dodge.LevelGen.Data
|
|
--import Geometry.Data
|
|
--import Padding
|
|
--import Shape
|
|
import LensHelp
|
|
|
|
--import Data.Maybe
|
|
--import Data.Tree
|
|
--import qualified Data.IntMap.Strict as IM
|
|
|
|
powerFakeout' :: RandomGen g => State g (MetaTree Room String)
|
|
powerFakeout' = tToBTree "powerFakeout'" <$> powerFakeout
|
|
|
|
powerFakeout :: RandomGen g => State g (Tree Room)
|
|
powerFakeout = do
|
|
ncor <- state $ randomR (0,2)
|
|
it <- takeOne
|
|
[miniGunX 6
|
|
,launcherX 7
|
|
]
|
|
roomwithmini <- pedestalRoom it
|
|
randcors <- replicateM ncor $ shuffleLinks corridor
|
|
return $ treePost $
|
|
[ corridor,door
|
|
, roomwithmini
|
|
, door
|
|
]
|
|
++ randcors
|
|
++ [ corridor & rmPmnts .:~ plRRpt 0 (PutFlIt shrinkGun)
|
|
, keyholeCorridor, corridor
|
|
,cleatOnward door]
|
|
|
|
-- the i is used either for a PickOnePlacement or a room id, this is not great
|
|
startRoom :: Int -> State StdGen (MetaTree Room String)
|
|
startRoom i = join $ takeOne
|
|
[ attachOnward "startThenWeaponRoom" <$> preCritStart <*> weaponRoom i
|
|
, rezBoxesWpCrit >>= rToOnward "rezBoxesWpCrit"
|
|
, runPastStart i >>= rToOnward ("runPastStart " ++ show i)
|
|
, attachOnward "startThenCraft" <$> preCritStart <*> (startCrafts >>= roomsContaining [])
|
|
]
|
|
randomChallenges :: RandomGen g => State g (MetaTree Room String)
|
|
randomChallenges = shootingRange
|
|
-- join (takeOne
|
|
-- [fmap (return . useAll) doubleCorridorBarrels <&> (,TreeSubLabelling "doubleCorridorBarrels" Nothing)
|
|
-- ,shootingRange
|
|
-- ,fmap (return . useAll) twinSlowDoorChasers <&> (,TreeSubLabelling "twinSlowDoorChasers" Nothing)
|
|
-- ]) -- <&> over (_2 . topLabel) ("randomChallenges:"++)
|
|
|
|
runPastStart :: RandomGen g => Int -> State g (Tree Room)
|
|
runPastStart i = do
|
|
s <- rezBoxStart
|
|
rp <- lockedStart i
|
|
return . shiftChildren $ attachTree toOnward rp $ fmap ([],) s
|
|
|
|
|
|
rezBoxStart :: RandomGen g => State g (Tree Room)
|
|
rezBoxStart = do
|
|
ls <- rezColor
|
|
return $ treePost [ rezBox ls, cleatOnward door ]
|
|
|
|
preCritStart :: RandomGen g => State g (MetaTree Room String)
|
|
preCritStart = join $ takeOneWeighted
|
|
[100,100,1::Float]
|
|
[rezBoxes
|
|
,rezBox'
|
|
,attachOnward "rezBoxPowerFakeout" <$> rezBox' <*> powerFakeout'
|
|
]
|
|
|
|
startCrafts :: RandomGen g => State g [Item]
|
|
startCrafts = takeOne $ map (map makeTypeCraft)
|
|
[ [PIPE,PIPE,HARDWARE]
|
|
, [TUBE,PIPE,HARDWARE]
|
|
, [PIPE,HARDWARE,HARDWARE]
|
|
, [TUBE,TUBE,HARDWARE]
|
|
, [TUBE,HARDWARE,HARDWARE]
|
|
]
|