src/Xanthous/Generators/LevelContents.hs


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50

--------------------------------------------------------------------------------
module Xanthous.Generators.LevelContents
  ( chooseCharacterPosition
  , randomItems
  ) where
--------------------------------------------------------------------------------
import           Xanthous.Prelude
--------------------------------------------------------------------------------
import           Control.Monad.Random
import           Data.Array.IArray (amap, bounds, rangeSize)
--------------------------------------------------------------------------------
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 qualified Xanthous.Entities.Item as Item
--------------------------------------------------------------------------------

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

randomPosition :: MonadRandom m => Cells -> m Position
randomPosition cells = fmap positionFromPair . choose $ impureNonNull candidates
  where
    -- cells ends up with true = wall, we want true = can put an item here
    placeableCells = amap not cells

    -- find the largest contiguous region of cells in the cave.
    candidates
      = maximumBy (compare `on` length)
      $ fromMaybe (error "No regions generated! this should never happen.")
      $ fromNullable
      $ regions placeableCells