diff options
Diffstat (limited to 'src/Xanthous/Generators/LevelContents.hs')
-rw-r--r-- | src/Xanthous/Generators/LevelContents.hs | 43 |
1 files changed, 28 insertions, 15 deletions
diff --git a/src/Xanthous/Generators/LevelContents.hs b/src/Xanthous/Generators/LevelContents.hs index 87b2a28974f4..583bdcbd6729 100644 --- a/src/Xanthous/Generators/LevelContents.hs +++ b/src/Xanthous/Generators/LevelContents.hs @@ -2,6 +2,7 @@ module Xanthous.Generators.LevelContents ( chooseCharacterPosition , randomItems + , randomCreatures ) where -------------------------------------------------------------------------------- import Xanthous.Prelude @@ -13,28 +14,40 @@ import Xanthous.Generators.Util import Xanthous.Random import Xanthous.Data (Position, positionFromPair) import Xanthous.Data.EntityMap (EntityMap, _EntityMap) -import Xanthous.Entities.Item (Item(..)) -import Xanthous.Entities.Raws -import Xanthous.Entities.RawTypes +import Xanthous.Entities.Raws (rawsWithType, RawType) import qualified Xanthous.Entities.Item as Item +import Xanthous.Entities.Item (Item) +import qualified Xanthous.Entities.Creature as Creature +import Xanthous.Entities.Creature (Creature) -------------------------------------------------------------------------------- chooseCharacterPosition :: MonadRandom m => Cells -> m Position chooseCharacterPosition = randomPosition randomItems :: MonadRandom m => Cells -> m (EntityMap Item) -randomItems cells = do - let len = rangeSize $ bounds cells - (numItems :: Int) <- floor . (* fromIntegral len) - <$> getRandomR @_ @Float (0.0004, 0.001) - items <- for [0..numItems] $ const $ do - pos <- randomPosition cells - itemType <- fmap (fromMaybe (error "no item raws!")) - . choose . ChooseElement - $ rawsWithType @ItemType - let item = Item.newWithType itemType - pure (pos, item) - pure $ _EntityMap # items +randomItems = randomEntities Item.newWithType (0.0004, 0.001) + +randomCreatures :: MonadRandom m => Cells -> m (EntityMap Creature) +randomCreatures = randomEntities Creature.newWithType (0.0007, 0.003) + +randomEntities + :: forall entity raw m. (MonadRandom m, RawType raw) + => (raw -> entity) + -> (Float, Float) + -> Cells + -> m (EntityMap entity) +randomEntities newWithType sizeRange cells = + case fromNullable $ rawsWithType @raw of + Nothing -> pure mempty + Just raws -> do + let len = rangeSize $ bounds cells + (numEntities :: Int) <- floor . (* fromIntegral len) <$> getRandomR sizeRange + entities <- for [0..numEntities] $ const $ do + pos <- randomPosition cells + raw <- choose raws + let entity = newWithType raw + pure (pos, entity) + pure $ _EntityMap # entities randomPosition :: MonadRandom m => Cells -> m Position randomPosition cells = fmap positionFromPair . choose $ impureNonNull candidates |