about summary refs log tree commit diff
path: root/src/Xanthous/Generators
diff options
context:
space:
mode:
authorGriffin Smith <root@gws.fyi>2019-12-01T00·55-0500
committerGriffin Smith <root@gws.fyi>2019-12-01T00·55-0500
commit71b628c604556bc2d829f12980db99c9a526ec84 (patch)
tree2bd0b27810139c2fcf19813c0cf3f31100d5008f /src/Xanthous/Generators
parent4431d453f61e88383aba40c8db3c4afb3c828b2e (diff)
Add messages on the ground
Add support for a "GroundMessage" entity type, support for a Read
command to read them, and randomly place an initial, tone-setting
tutorial message on the ground near the character at the beginning of
the game.
Diffstat (limited to 'src/Xanthous/Generators')
-rw-r--r--src/Xanthous/Generators/LevelContents.hs29
1 files changed, 26 insertions, 3 deletions
diff --git a/src/Xanthous/Generators/LevelContents.hs b/src/Xanthous/Generators/LevelContents.hs
index 583bdcbd6729..91a7d38019c8 100644
--- a/src/Xanthous/Generators/LevelContents.hs
+++ b/src/Xanthous/Generators/LevelContents.hs
@@ -3,22 +3,26 @@ module Xanthous.Generators.LevelContents
   ( chooseCharacterPosition
   , randomItems
   , randomCreatures
+  , tutorialMessage
   ) where
 --------------------------------------------------------------------------------
 import           Xanthous.Prelude
 --------------------------------------------------------------------------------
 import           Control.Monad.Random
-import           Data.Array.IArray (amap, bounds, rangeSize)
+import           Data.Array.IArray (amap, bounds, rangeSize, (!))
 --------------------------------------------------------------------------------
 import           Xanthous.Generators.Util
 import           Xanthous.Random
-import           Xanthous.Data (Position, positionFromPair)
+import           Xanthous.Data (Position, _Position, positionFromPair)
 import           Xanthous.Data.EntityMap (EntityMap, _EntityMap)
 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)
+import           Xanthous.Entities.Environment (GroundMessage(..))
+import           Xanthous.Messages (message_)
+import           Xanthous.Util.Graphics (circle)
 --------------------------------------------------------------------------------
 
 chooseCharacterPosition :: MonadRandom m => Cells -> m Position
@@ -30,6 +34,24 @@ randomItems = randomEntities Item.newWithType (0.0004, 0.001)
 randomCreatures :: MonadRandom m => Cells -> m (EntityMap Creature)
 randomCreatures = randomEntities Creature.newWithType (0.0007, 0.003)
 
+tutorialMessage :: MonadRandom m
+  => Cells
+  -> Position -- ^ CharacterPosition
+  -> m (EntityMap GroundMessage)
+tutorialMessage cells characterPosition = do
+  let distance = 2
+  pos <- fmap (fromMaybe (error "No valid positions for tutorial message?"))
+        . choose . ChooseElement
+        $ accessiblePositionsWithin distance cells characterPosition
+  msg <- message_ ["tutorial", "message1"]
+  pure $ _EntityMap # [(pos, GroundMessage msg)]
+  where
+    accessiblePositionsWithin :: Int -> Cells -> Position -> [Position]
+    accessiblePositionsWithin dist valid pos =
+      review _Position
+      <$> filter (\(px, py) -> not $ valid ! (fromIntegral px, fromIntegral py))
+          (circle (pos ^. _Position) dist)
+
 randomEntities
   :: forall entity raw m. (MonadRandom m, RawType raw)
   => (raw -> entity)
@@ -41,7 +63,8 @@ randomEntities newWithType sizeRange cells =
     Nothing -> pure mempty
     Just raws -> do
       let len = rangeSize $ bounds cells
-      (numEntities :: Int) <- floor . (* fromIntegral len) <$> getRandomR sizeRange
+      (numEntities :: Int) <-
+        floor . (* fromIntegral len) <$> getRandomR sizeRange
       entities <- for [0..numEntities] $ const $ do
         pos <- randomPosition cells
         raw <- choose raws