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
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
|
--------------------------------------------------------------------------------
module Xanthous.App.Common
( describeEntities
, describeEntitiesAt
, entitiesAtPositionWithType
-- * Re-exports
, MonadState
, MonadRandom
, EntityMap
, module Xanthous.Game.Lenses
, module Xanthous.Monad
) where
--------------------------------------------------------------------------------
import Xanthous.Prelude
--------------------------------------------------------------------------------
import Data.Aeson (object)
import qualified Data.Aeson as A
import Control.Monad.State (MonadState)
import Control.Monad.Random (MonadRandom)
--------------------------------------------------------------------------------
import Xanthous.Data (Position, positioned)
import Xanthous.Data.EntityMap (EntityMap)
import qualified Xanthous.Data.EntityMap as EntityMap
import Xanthous.Game
import Xanthous.Game.Lenses
import Xanthous.Game.State
import Xanthous.Monad
import Xanthous.Entities.Character (Character)
import Xanthous.Util.Inflection (toSentence)
--------------------------------------------------------------------------------
entitiesAtPositionWithType
:: forall a. (Entity a, Typeable a)
=> Position
-> EntityMap SomeEntity
-> [(EntityMap.EntityID, a)]
entitiesAtPositionWithType pos em =
let someEnts = EntityMap.atPositionWithIDs pos em
in flip foldMap someEnts $ \(eid, view positioned -> se) ->
case downcastEntity @a se of
Just e -> [(eid, e)]
Nothing -> []
describeEntitiesAt :: (MonadState GameState m, MonadRandom m) => Position -> m ()
describeEntitiesAt pos =
use ( entities
. EntityMap.atPosition pos
. to (filter (not . entityIs @Character))
) >>= \case
Empty -> pure ()
ents -> describeEntities ents
describeEntities
:: ( Entity entity
, MonadRandom m
, MonadState GameState m
, MonoFoldable (f Text)
, Functor f
, Element (f Text) ~ Text
)
=> f entity
-> m ()
describeEntities ents =
let descriptions = description <$> ents
in say ["entities", "description"]
$ object ["entityDescriptions" A..= toSentence descriptions]
|
