Use attack messages when attacking

When attacking, use either:
- the message defined on the entity raw of the wielded item, if any
- the generic attack message, if an item without an attack message is wielded
- the fists attack message, if no item is wielded
This commit is contained in:
Griffin Smith 2019-12-23 10:59:45 -05:00
parent 8ecefddbd4
commit bf7d139c1a
2 changed files with 16 additions and 10 deletions

View file

@ -49,7 +49,7 @@ import Xanthous.Entities.Environment
(Door, open, locked, GroundMessage(..))
import Xanthous.Entities.RawTypes
( edible, eatMessage, hitpointsHealed
, wieldable
, wieldable, attackMessage
)
import Xanthous.Generators
import qualified Xanthous.Generators.CaveAutomata as CaveAutomata
@ -439,10 +439,17 @@ attackAt pos =
say ["combat", "killed"] msgParams
entities . at creatureID .= Nothing
else do
-- TODO attack messages
say ["combat", "hit", "generic"] msgParams
msg <- uses character getAttackMessage
message msg msgParams
entities . ix creatureID . positioned .= SomeEntity creature'
stepGame -- TODO
getAttackMessage chr =
case chr ^? inventory . wielded . wieldedItems . wieldableItem of
Just wi ->
fromMaybe (Messages.lookup ["combat", "hit", "generic"])
$ wi ^. attackMessage
Nothing ->
Messages.lookup ["combat", "hit", "fists"]
entityMenu_
:: (Comonad w, Entity entity)
@ -462,7 +469,6 @@ entityMenuChar entity
then ec
else 'a'
-- entityMenu :: Entity entity => [entity] -> Map Char (MenuOption entity)
-- entityMenu = map (map runIdentity) . entityMenu_ . fmap Identity

View file

@ -10,6 +10,7 @@ module Xanthous.Monad
, say_
, message
, message_
, writeMessage
) where
--------------------------------------------------------------------------------
import Xanthous.Prelude
@ -37,19 +38,18 @@ continue = lift . Brick.continue =<< get
say :: (MonadRandom m, ToJSON params, MonadState GameState m)
=> [Text] -> params -> m ()
say msgPath params = do
msg <- Messages.message msgPath params
messageHistory %= pushMessage msg
say msgPath = writeMessage <=< Messages.message msgPath
say_ :: (MonadRandom m, MonadState GameState m) => [Text] -> m ()
say_ msgPath = say msgPath $ object []
message :: (MonadRandom m, ToJSON params, MonadState GameState m)
=> Message -> params -> m ()
message msg params = do
m <- Messages.render msg params
messageHistory %= pushMessage m
message msg = writeMessage <=< Messages.render msg
message_ :: (MonadRandom m, MonadState GameState m)
=> Message -> m ()
message_ msg = message msg $ object []
writeMessage :: MonadState GameState m => Text -> m ()
writeMessage m = messageHistory %= pushMessage m