113 lines
3.3 KiB
Haskell
113 lines
3.3 KiB
Haskell
{-# LANGUAGE TupleSections #-}
|
|
|
|
module Dodge.Room.Start (
|
|
startRoom,
|
|
randomChallenges,
|
|
) where
|
|
|
|
import Dodge.Item.Held.Cane
|
|
import Dodge.Item.Held.Launcher
|
|
import Dodge.Cleat
|
|
import Dodge.Data.GenWorld
|
|
import Dodge.Item.Craftable
|
|
import Dodge.Item.Weapon
|
|
import Dodge.LevelGen.PlacementHelper
|
|
import Dodge.Room.Containing
|
|
import Dodge.Room.Corridor
|
|
import Dodge.Room.Door
|
|
import Dodge.Room.Link
|
|
import Dodge.Room.RezBox
|
|
import Dodge.Room.Room
|
|
import Dodge.Room.RunPast
|
|
import Dodge.Tree
|
|
--import Dodge.LevelGen.PlacementHelper
|
|
--import Geometry.Data
|
|
--import Padding
|
|
--import Shape
|
|
import LensHelp
|
|
import RandomHelp
|
|
|
|
--import Data.Maybe
|
|
--import Data.Tree
|
|
--import qualified IntMapHelp 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]
|
|
]
|