-- | Display atomic SFX commands received by the client.
module Game.LambdaHack.Client.UI.Watch.WatchSfxAtomicM
  ( watchRespSfxAtomicUI
#ifdef EXPOSE_INTERNAL
    -- * Internal operations
  , returnJustLeft, ppSfxMsg, strike
#endif
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import qualified Data.EnumMap.Strict as EM
import           Data.Int (Int64)
import qualified Data.Text as T
import qualified NLP.Miniutter.English as MU

import           Game.LambdaHack.Atomic (SfxAtomic (..), SfxMsg (..))
import           Game.LambdaHack.Client.MonadClient
import           Game.LambdaHack.Client.State
import           Game.LambdaHack.Client.UI.ActorUI
import           Game.LambdaHack.Client.UI.Animation
import           Game.LambdaHack.Client.UI.Content.Screen
import           Game.LambdaHack.Client.UI.ContentClientUI
import           Game.LambdaHack.Client.UI.EffectDescription
import           Game.LambdaHack.Client.UI.Frame
import           Game.LambdaHack.Client.UI.FrameM
import           Game.LambdaHack.Client.UI.HandleHelperM
import qualified Game.LambdaHack.Client.UI.HumanCmd as HumanCmd
import           Game.LambdaHack.Client.UI.ItemDescription
import qualified Game.LambdaHack.Client.UI.Key as K
import           Game.LambdaHack.Client.UI.MonadClientUI
import           Game.LambdaHack.Client.UI.Msg
import           Game.LambdaHack.Client.UI.MsgM
import           Game.LambdaHack.Client.UI.SessionUI
import           Game.LambdaHack.Client.UI.SlideshowM
import           Game.LambdaHack.Client.UI.TutorialHints (TutorialHints (..))
import           Game.LambdaHack.Client.UI.Watch.WatchCommonM
import           Game.LambdaHack.Common.Actor
import           Game.LambdaHack.Common.ActorState
import           Game.LambdaHack.Common.Faction
import           Game.LambdaHack.Common.Item
import qualified Game.LambdaHack.Common.ItemAspect as IA
import           Game.LambdaHack.Common.Kind
import           Game.LambdaHack.Common.Level
import           Game.LambdaHack.Common.Misc
import           Game.LambdaHack.Common.MonadStateRead
import           Game.LambdaHack.Common.Point
import           Game.LambdaHack.Common.ReqFailure
import           Game.LambdaHack.Common.State
import           Game.LambdaHack.Common.Time
import           Game.LambdaHack.Common.Types
import           Game.LambdaHack.Content.CaveKind (cdesc)
import qualified Game.LambdaHack.Content.ItemKind as IK
import qualified Game.LambdaHack.Content.TileKind as TK
import qualified Game.LambdaHack.Core.Dice as Dice
import           Game.LambdaHack.Core.Frequency
import           Game.LambdaHack.Core.Random
import qualified Game.LambdaHack.Definition.Ability as Ability
import qualified Game.LambdaHack.Definition.Color as Color
import           Game.LambdaHack.Definition.Defs

-- | Display special effects (text, animation) sent to the client.
-- Don't modify client state (except a few fields), but only client
-- session (e.g., by displaying messages). This is enforced by types.
watchRespSfxAtomicUI :: MonadClientUI m => SfxAtomic -> m ()
{-# INLINE watchRespSfxAtomicUI #-}
watchRespSfxAtomicUI :: forall (m :: * -> *). MonadClientUI m => SfxAtomic -> m ()
watchRespSfxAtomicUI SfxAtomic
sfx = case SfxAtomic
sfx of
  SfxStrike ActorId
source ActorId
target ItemId
iid ->
    Bool -> ActorId -> ActorId -> ItemId -> m ()
forall (m :: * -> *).
MonadClientUI m =>
Bool -> ActorId -> ActorId -> ItemId -> m ()
strike Bool
False ActorId
source ActorId
target ItemId
iid
  SfxRecoil ActorId
source ActorId
target ItemId
iid -> do
    sourceSeen <- (State -> Bool) -> m Bool
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Bool) -> m Bool) -> (State -> Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ ActorId -> EnumMap ActorId Actor -> Bool
forall k a. Enum k => k -> EnumMap k a -> Bool
EM.member ActorId
source (EnumMap ActorId Actor -> Bool)
-> (State -> EnumMap ActorId Actor) -> State -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap ActorId Actor
sactorD
    if not sourceSeen then do
      tb <- getsState $ getActorBody target
      animate (blid tb) $ blockMiss (bpos tb, bpos tb)
    else do
      CCUI{coscreen=ScreenContent{rwidth}} <- getsSession sccui
      sb <- getsState $ getActorBody source
      tb <- getsState $ getActorBody source
      spart <- partActorLeader source
      tpart <- partActorLeader target
      side <- getsClient sside
      factionD <- getsState sfactionD
      localTime <- getsState $ getLocalTime (blid tb)
      itemFullWeapon <- getsState $ itemToFull iid
      let kitWeapon = ItemQuant
quantSingle
          (weaponName, _) = partItemShort rwidth side factionD
                                          localTime itemFullWeapon kitWeapon
          weaponNameOwn = Int
-> FactionId
-> FactionDict
-> Part
-> Time
-> ItemFull
-> ItemQuant
-> Part
partItemShortWownW Int
rwidth FactionId
side FactionDict
factionD Part
spart
                                             Time
localTime ItemFull
itemFullWeapon ItemQuant
kitWeapon
          verb = if Actor -> Bool
bproj Actor
sb then Part
"deflect" else Part
"fend off"
          objects | ItemId
iid ItemId -> ItemId -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> ItemId
btrunk Actor
sb = [Part
"the", Part
spart]
                  | ItemId
iid ItemId -> EnumMap ItemId ItemQuant -> Bool
forall k a. Enum k => k -> EnumMap k a -> Bool
`EM.member` Actor -> EnumMap ItemId ItemQuant
borgan Actor
sb =  [Part
"the", Part
weaponNameOwn]
                  | Bool
otherwise = [Part
"the", Part
weaponName, Part
"of", Part
spart]
      msgAdd MsgActionMajor $
        makeSentence $ MU.SubjectVerbSg tpart verb : objects
      animate (blid tb) $ blockMiss (bpos tb, bpos sb)
  SfxSteal ActorId
source ActorId
target ItemId
iid ->
    Bool -> ActorId -> ActorId -> ItemId -> m ()
forall (m :: * -> *).
MonadClientUI m =>
Bool -> ActorId -> ActorId -> ItemId -> m ()
strike Bool
True ActorId
source ActorId
target ItemId
iid
  SfxRelease ActorId
source ActorId
target ItemId
_ -> do
    spart <- ActorId -> m Part
forall (m :: * -> *). MonadClientUI m => ActorId -> m Part
partActorLeader ActorId
source
    tpart <- partActorLeader target
    msgAdd MsgActionMajor $
      makeSentence [MU.SubjectVerbSg spart "release", tpart]
  SfxProject ActorId
aid ItemId
iid ->
    MsgClassShowAndSave
-> ActorId -> Part -> ItemId -> Either Int Int -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> ActorId -> Part -> ItemId -> Either Int Int -> m ()
itemAidVerbMU MsgClassShowAndSave
MsgActionMajor ActorId
aid Part
"fling" ItemId
iid (Int -> Either Int Int
forall a b. a -> Either a b
Left Int
1)
  SfxReceive ActorId
aid ItemId
iid ->
    MsgClassShowAndSave
-> ActorId -> Part -> ItemId -> Either Int Int -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> ActorId -> Part -> ItemId -> Either Int Int -> m ()
itemAidVerbMU MsgClassShowAndSave
MsgActionMajor ActorId
aid Part
"receive" ItemId
iid (Int -> Either Int Int
forall a b. a -> Either a b
Left Int
1)
  SfxApply ActorId
aid ItemId
iid -> do
    CCUI{coscreen=ScreenContent{rapplyVerbMap}} <- (SessionUI -> CCUI) -> m CCUI
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
    ItemFull{itemKind} <- getsState $ itemToFull iid
    let actionPart =
          Part -> (Text -> Part) -> Maybe Text -> Part
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Part
"trigger"
                Text -> Part
MU.Text
                (Char -> EnumMap Char Text -> Maybe Text
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup (ItemKind -> Char
IK.isymbol ItemKind
itemKind) EnumMap Char Text
rapplyVerbMap)
    itemAidVerbMU MsgActionMajor aid actionPart iid (Left 1)
  SfxCheck ActorId
aid ItemId
iid ->
    MsgClassShowAndSave
-> ActorId -> Part -> ItemId -> Either Int Int -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> ActorId -> Part -> ItemId -> Either Int Int -> m ()
itemAidVerbMU MsgClassShowAndSave
MsgActionMajor ActorId
aid Part
"recover" ItemId
iid (Int -> Either Int Int
forall a b. a -> Either a b
Left Int
1)
  SfxTrigger ActorId
_ LevelId
_ Point
_ ContentId TileKind
fromTile -> do
    COps{cotile} <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
    let subject = Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ TileKind -> Text
TK.tname (TileKind -> Text) -> TileKind -> Text
forall a b. (a -> b) -> a -> b
$ ContentData TileKind -> ContentId TileKind -> TileKind
forall a. ContentData a -> ContentId a -> a
okind ContentData TileKind
cotile ContentId TileKind
fromTile
        verb = Part
"shake"
        msg = [Part] -> Text
makeSentence [Part
"the", Part -> Part -> Part
MU.SubjectVerbSg Part
subject Part
verb]
    msgAdd MsgNeutralEvent msg
  SfxShun ActorId
aid LevelId
_ Point
_ ContentId TileKind
_ ->
    MsgClassShowAndSave -> ActorId -> Part -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> ActorId -> Part -> m ()
aidVerbMU MsgClassShowAndSave
MsgActionMajor ActorId
aid Part
"shun it"
  SfxEffect FactionId
fidSource ActorId
aid ItemId
iid Effect
effect Int64
hpDelta -> do
    -- In most messages below @iid@ is ignored, because it's too common,
    -- e.g., caused by some combat hits, or rather obvious,
    -- e.g., in case of embedded items, or would be counterintuitive,
    -- e.g., when actor is said to be intimidated by a particle, not explosion.
    CCUI{coscreen=ScreenContent{rwidth}} <- (SessionUI -> CCUI) -> m CCUI
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
    b <- getsState $ getActorBody aid
    bUI <- getsSession $ getActorUI aid
    side <- getsClient sside
    mleader <- getsClient sleader
    itemD <- getsState sitemD
    actorMaxSk <- getsState $ getActorMaxSkills aid
    let fid = Actor -> FactionId
bfid Actor
b
        isOurCharacter = FactionId
fid FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side Bool -> Bool -> Bool
&& Bool -> Bool
not (Actor -> Bool
bproj Actor
b)
        isAlive = Actor -> Int64
bhp Actor
b Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
0
        isOurAlive = Bool
isOurCharacter Bool -> Bool -> Bool
&& Bool
isAlive
        isOurLeader = ActorId -> Maybe ActorId
forall a. a -> Maybe a
Just ActorId
aid Maybe ActorId -> Maybe ActorId -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe ActorId
mleader
        -- The message classes are close enough. It's melee or similar.
        feelLookHPBad Text
bigAdj Text
projAdj = do
          MsgClassShowAndSave -> MsgClassShowAndSave -> Text -> Text -> m ()
feelLook MsgClassShowAndSave
MsgBadMiscEvent MsgClassShowAndSave
MsgGoodMiscEvent Text
bigAdj Text
projAdj
          -- We can't know here if the hit was in melee, ranged or
          -- even triggering a harmful item. However, let's not talk
          -- about armor before the player has the most basic one.
          -- for melee. Most of the time the first hit in the game is,
          -- in fact, from melee, so that's a sensible default.
          --
          -- Note that the @idamage@ is called piercing (or edged) damage,
          -- even though the distinction from impact damage is fleshed
          -- out only in Allure.
          Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
isOurCharacter
                Bool -> Bool -> Bool
&& Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkArmorMelee Skills
actorMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
            TutorialHints -> m ()
forall (m :: * -> *). MonadClientUI m => TutorialHints -> m ()
tutorialHintMsgAdd TutorialHints
DamageOfDifferentKind
        feelLookHPGood = MsgClassShowAndSave -> MsgClassShowAndSave -> Text -> Text -> m ()
feelLook MsgClassShowAndSave
MsgGoodMiscEvent MsgClassShowAndSave
MsgBadMiscEvent
        feelLookCalm Text
bigAdj Text
projAdj = Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isAlive (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
          MsgClassShowAndSave -> MsgClassShowAndSave -> Text -> Text -> m ()
feelLook MsgClassShowAndSave
MsgEffectMinor MsgClassShowAndSave
MsgEffectMinor Text
bigAdj Text
projAdj
        -- Ignore @iid@, because it's usually obvious what item caused that
        -- and because the effects are not particularly disortienting.
        feelLook MsgClassShowAndSave
msgClassOur MsgClassShowAndSave
msgClassTheir Text
bigAdj Text
projAdj =
          let (Text
verb, Text
adjective) =
                if Actor -> Bool
bproj Actor
b
                then (Text
"get", Text
projAdj)
                else ( if Bool
isOurCharacter then Text
"feel" else Text
"look"
                     , if Bool
isAlive then Text
bigAdj else Text
projAdj )
                         -- dead body is an item, not a person
              msgClass :: MsgClassShowAndSave
msgClass = if | Actor -> Bool
bproj Actor
b -> MsgClassShowAndSave
MsgEffectMinor
                            | Bool
isOurCharacter -> MsgClassShowAndSave
msgClassOur
                            | Bool
otherwise -> MsgClassShowAndSave
msgClassTheir
          in MsgClassShowAndSave -> ActorId -> Part -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> ActorId -> Part -> m ()
aidVerbMU MsgClassShowAndSave
msgClass ActorId
aid (Part -> m ()) -> Part -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ Text
verb Text -> Text -> Text
<+> Text
adjective
    case effect of
      IK.Burn{} -> do
        Text -> Text -> m ()
feelLookHPBad Text
"burned" Text
"scorched"
        let ps :: (Point, Point)
ps = (Actor -> Point
bpos Actor
b, Actor -> Point
bpos Actor
b)
        LevelId -> Animation -> m ()
forall (m :: * -> *).
MonadClientUI m =>
LevelId -> Animation -> m ()
animate (Actor -> LevelId
blid Actor
b) (Animation -> m ()) -> Animation -> m ()
forall a b. (a -> b) -> a -> b
$ (Point, Point) -> Color -> Color -> Animation
twirlSplash (Point, Point)
ps Color
Color.BrRed Color
Color.Brown
      IK.Explode{} -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()  -- lots of visual feedback
      IK.RefillHP Int
p | Int
p Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()  -- no spam from regeneration
      IK.RefillHP Int
p | Int
p Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== -Int
1 -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()  -- no spam from poison
      IK.RefillHP{} | Int64
hpDelta Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
0 -> do
        Text -> Text -> m ()
feelLookHPGood Text
"healthier" Text
"mended"
        let ps :: (Point, Point)
ps = (Actor -> Point
bpos Actor
b, Actor -> Point
bpos Actor
b)
        LevelId -> Animation -> m ()
forall (m :: * -> *).
MonadClientUI m =>
LevelId -> Animation -> m ()
animate (Actor -> LevelId
blid Actor
b) (Animation -> m ()) -> Animation -> m ()
forall a b. (a -> b) -> a -> b
$ (Point, Point) -> Color -> Color -> Animation
twirlSplash (Point, Point)
ps Color
Color.BrGreen Color
Color.Green
      IK.RefillHP{} -> do
        Text -> Text -> m ()
feelLookHPBad Text
"wounded" Text
"broken"
        let ps :: (Point, Point)
ps = (Actor -> Point
bpos Actor
b, Actor -> Point
bpos Actor
b)
        LevelId -> Animation -> m ()
forall (m :: * -> *).
MonadClientUI m =>
LevelId -> Animation -> m ()
animate (Actor -> LevelId
blid Actor
b) (Animation -> m ()) -> Animation -> m ()
forall a b. (a -> b) -> a -> b
$ (Point, Point) -> Color -> Color -> Animation
twirlSplash (Point, Point)
ps Color
Color.BrRed Color
Color.Red
      IK.RefillCalm{} | Bool -> Bool
not Bool
isAlive -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      IK.RefillCalm{} | Actor -> Bool
bproj Actor
b -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      IK.RefillCalm Int
p | Int
p Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()  -- no spam from regen items
      IK.RefillCalm Int
p | Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 -> Text -> Text -> m ()
feelLookCalm Text
"calmer" Text
"stabilized"
      IK.RefillCalm Int
_ -> Text -> Text -> m ()
feelLookCalm Text
"agitated" Text
"wobbly"
      Effect
IK.Dominate | Bool -> Bool
not Bool
isAlive -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Effect
IK.Dominate -> do
        -- For subsequent messages use the proper name, never "you".
        let subject :: Part
subject = ActorUI -> Part
partActor ActorUI
bUI
        if FactionId
fid FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
/= FactionId
fidSource then do
          -- Before domination, possibly not seen if actor (yet) not ours.
          if Actor -> Int64
bcalm Actor
b Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
0  -- sometimes only a coincidence, but nm
          then MsgClassShowAndSave -> ActorId -> Part -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> ActorId -> Part -> m ()
aidVerbMU MsgClassShowAndSave
MsgEffectMedium ActorId
aid Part
"yield, under extreme pressure"
          else do
            let verb :: Part
verb = if Bool
isOurAlive
                       then Part
"black out, dominated by foes"
                       else Part
"decide abruptly to switch allegiance"
                -- Faction is being switched, so item that caused domination
                -- and vanished may not be known to the new faction.
                msuffix :: Maybe Part
msuffix = if ItemId
iid ItemId -> ItemId -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> ItemId
btrunk Actor
b Bool -> Bool -> Bool
|| ItemId
iid ItemId -> ItemDict -> Bool
forall k a. Enum k => k -> EnumMap k a -> Bool
`EM.notMember` ItemDict
itemD
                          then Maybe Part
forall a. Maybe a
Nothing
                          else Part -> Maybe Part
forall a. a -> Maybe a
Just (Part -> Maybe Part) -> Part -> Maybe Part
forall a b. (a -> b) -> a -> b
$ if Bool
isOurAlive
                                      then Part
"through"
                                      else Part
"under the influence of"
            MsgClassShowAndSave
-> ActorId -> Part -> ItemId -> Maybe Part -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> ActorId -> Part -> ItemId -> Maybe Part -> m ()
mitemAidVerbMU MsgClassShowAndSave
MsgEffectMedium ActorId
aid Part
verb ItemId
iid Maybe Part
msuffix
          fidNameRaw <- (State -> Text) -> m Text
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Text) -> m Text) -> (State -> Text) -> m Text
forall a b. (a -> b) -> a -> b
$ Faction -> Text
gname (Faction -> Text) -> (State -> Faction) -> State -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FactionDict -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
fid) (FactionDict -> Faction)
-> (State -> FactionDict) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> FactionDict
sfactionD
          -- Avoid "controlled by Controlled foo".
          let fidName = [Text] -> Text
T.unwords ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text]
forall a. HasCallStack => [a] -> [a]
tail ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.words Text
fidNameRaw
              verb = Part
"be no longer controlled by"
          msgLnAdd MsgEffectMajor $ makeSentence
            [MU.SubjectVerbSg subject verb, MU.Text fidName]
          when isOurAlive $ displayMoreKeep ColorFull ""  -- Ln makes it short
        else do
          -- After domination, possibly not seen, if actor (already) not ours.
          fidSourceNameRaw <- (State -> Text) -> m Text
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Text) -> m Text) -> (State -> Text) -> m Text
forall a b. (a -> b) -> a -> b
$ Faction -> Text
gname (Faction -> Text) -> (State -> Faction) -> State -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FactionDict -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
fidSource) (FactionDict -> Faction)
-> (State -> FactionDict) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> FactionDict
sfactionD
          -- Avoid "Controlled control".
          let fidSourceName = [Text] -> Text
T.unwords ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text]
forall a. HasCallStack => [a] -> [a]
tail ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.words Text
fidSourceNameRaw
              verb = Part
"be now under"
          msgAdd MsgEffectMajor $ makeSentence
            [MU.SubjectVerbSg subject verb, MU.Text fidSourceName, "control"]
      Effect
IK.Impress | Bool -> Bool
not Bool
isAlive -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Effect
IK.Impress -> MsgClassShowAndSave -> ActorId -> Part -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> ActorId -> Part -> m ()
aidVerbMU MsgClassShowAndSave
MsgEffectMinor ActorId
aid Part
"be awestruck"
      Effect
IK.PutToSleep | Bool -> Bool
not Bool
isAlive -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Effect
IK.PutToSleep -> do
        let verb :: Part
verb = Part
"be put to sleep"
            msuffix :: Maybe Part
msuffix = Part -> Maybe Part
forall a. a -> Maybe a
Just (Part -> Maybe Part) -> Part -> Maybe Part
forall a b. (a -> b) -> a -> b
$ if FactionId
fidSource FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> FactionId
bfid Actor
b then Part
"due to" else Part
"by"
        MsgClassShowAndSave
-> ActorId -> Part -> ItemId -> Maybe Part -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> ActorId -> Part -> ItemId -> Maybe Part -> m ()
mitemAidVerbMU MsgClassShowAndSave
MsgEffectMajor ActorId
aid Part
verb ItemId
iid Maybe Part
msuffix
      Effect
IK.Yell | Bool -> Bool
not Bool
isAlive -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Effect
IK.Yell -> MsgClassShowAndSave -> ActorId -> Part -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> ActorId -> Part -> m ()
aidVerbMU MsgClassShowAndSave
MsgMiscellanous ActorId
aid Part
"start"
      IK.Summon GroupName ItemKind
grp Dice
p -> do
        let verbBase :: Part
verbBase = if Actor -> Bool
bproj Actor
b then Part
"lure" else Part
"summon"
            part :: Part
part = Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ GroupName ItemKind -> Text
forall c. GroupName c -> Text
displayGroupName GroupName ItemKind
grp
            object :: Part
object = if Dice
p Dice -> Dice -> Bool
forall a. Eq a => a -> a -> Bool
== Dice
1  -- works, because exact number sent, not dice
                     then Part -> Part
MU.AW Part
part
                     else Part -> Part
MU.Ws Part
part
            verb :: Part
verb = [Part] -> Part
MU.Phrase [Part
verbBase, Part
object]
            msuffix :: Maybe Part
msuffix = Part -> Maybe Part
forall a. a -> Maybe a
Just Part
"with"
        MsgClassShowAndSave
-> ActorId -> Part -> ItemId -> Maybe Part -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> ActorId -> Part -> ItemId -> Maybe Part -> m ()
mitemAidVerbMU MsgClassShowAndSave
MsgEffectMajor ActorId
aid Part
verb ItemId
iid Maybe Part
msuffix
      IK.Ascend{} | Bool -> Bool
not Bool
isAlive -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      IK.Ascend Bool
up -> do
        COps{cocave} <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
        aidVerbMU MsgEffectMajor aid $ MU.Text $
          "find a way" <+> if up then "upstairs" else "downstairs"
        when isOurLeader $ do
          destinations <- getsState $ whereTo (blid b) (bpos b) up
                                      . sdungeon
          case destinations of
            (LevelId
lid, Point
_) : [(LevelId, Point)]
_ -> do  -- only works until different levels possible
              lvl <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel LevelId
lid
              let desc = CaveKind -> Text
cdesc (CaveKind -> Text) -> CaveKind -> Text
forall a b. (a -> b) -> a -> b
$ ContentData CaveKind -> ContentId CaveKind -> CaveKind
forall a. ContentData a -> ContentId a -> a
okind ContentData CaveKind
cocave (ContentId CaveKind -> CaveKind) -> ContentId CaveKind -> CaveKind
forall a b. (a -> b) -> a -> b
$ Level -> ContentId CaveKind
lkind Level
lvl
              unless (T.null desc) $
                msgAdd MsgBackdropInfo $ desc <> "\n"
              tutorialHintMsgAdd NewFloorNewOpportunity
            [] -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()  -- spell fizzles; normally should not be sent
      IK.Escape{} | Bool
isOurCharacter -> do
        ours <- (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)])
-> (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
forall a b. (a -> b) -> a -> b
$ FactionId -> State -> [(ActorId, Actor)]
fidActorNotProjGlobalAssocs FactionId
side
        when (length ours > 1) $ do
          (_, total) <- getsState $ calculateTotal side
          if total == 0
          then msgAdd MsgFactionIntel $
                 "The team joins" <+> makePhrase [partActor bUI]
                 <> ", forms a perimeter and leaves triumphant."
          else msgAdd MsgItemCreation $
                 "The team joins" <+> makePhrase [partActor bUI]
                 <> ", forms a perimeter, repacks its belongings and leaves triumphant."
      IK.Escape{} -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      IK.Paralyze{} | Bool -> Bool
not Bool
isAlive -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      IK.Paralyze{} ->
        MsgClassShowAndSave
-> ActorId -> Part -> ItemId -> Maybe Part -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> ActorId -> Part -> ItemId -> Maybe Part -> m ()
mitemAidVerbMU MsgClassShowAndSave
MsgEffectMedium ActorId
aid Part
"be paralyzed" ItemId
iid (Part -> Maybe Part
forall a. a -> Maybe a
Just Part
"with")
      IK.ParalyzeInWater{} | Bool -> Bool
not Bool
isAlive -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      IK.ParalyzeInWater{} ->
        MsgClassShowAndSave -> ActorId -> Part -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> ActorId -> Part -> m ()
aidVerbMU MsgClassShowAndSave
MsgEffectMinor ActorId
aid Part
"move with difficulty"
      IK.InsertMove{} | Bool -> Bool
not Bool
isAlive -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      IK.InsertMove Dice
d ->
        -- Usually self-inflicted of from embeds, so obvious, so no @iid@.
        if Dice -> Int
Dice.supDice Dice
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
10
        then MsgClassShowAndSave -> ActorId -> Part -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> ActorId -> Part -> m ()
aidVerbMU MsgClassShowAndSave
MsgEffectMedium ActorId
aid Part
"act with extreme speed"
        else do
          let msgClass :: MsgClassShowAndSave
msgClass = if Bool
isOurCharacter
                         then MsgClassShowAndSave
MsgEffectMedium
                         else MsgClassShowAndSave
MsgEffectMinor
          MsgClassShowAndSave -> ActorId -> Part -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> ActorId -> Part -> m ()
aidVerbMU MsgClassShowAndSave
msgClass ActorId
aid Part
"move swiftly"
      IK.Teleport Dice
t | Dice -> Int
Dice.supDice Dice
t Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
9 -> do
        -- Actor may be sent away before noticing the item that did it.
        let msuffix :: Maybe Part
msuffix = if ItemId
iid ItemId -> ItemDict -> Bool
forall k a. Enum k => k -> EnumMap k a -> Bool
`EM.notMember` ItemDict
itemD
                      then Maybe Part
forall a. Maybe a
Nothing
                      else Part -> Maybe Part
forall a. a -> Maybe a
Just Part
"due to"
            msgClass :: MsgClassShowAndSave
msgClass = if Bool
isOurCharacter
                       then MsgClassShowAndSave
MsgEffectMedium
                       else MsgClassShowAndSave
MsgEffectMinor
        MsgClassShowAndSave
-> ActorId -> Part -> ItemId -> Maybe Part -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> ActorId -> Part -> ItemId -> Maybe Part -> m ()
mitemAidVerbMU MsgClassShowAndSave
msgClass ActorId
aid Part
"blink" ItemId
iid Maybe Part
msuffix
      IK.Teleport{} -> do
        -- Actor may be sent away before noticing the item that did it.
        let msuffix :: Maybe Part
msuffix = if ItemId
iid ItemId -> ItemDict -> Bool
forall k a. Enum k => k -> EnumMap k a -> Bool
`EM.notMember` ItemDict
itemD
                      then Maybe Part
forall a. Maybe a
Nothing
                      else Part -> Maybe Part
forall a. a -> Maybe a
Just Part
"by the power of"
        MsgClassShowAndSave
-> ActorId -> Part -> ItemId -> Maybe Part -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> ActorId -> Part -> ItemId -> Maybe Part -> m ()
mitemAidVerbMU MsgClassShowAndSave
MsgEffectMedium ActorId
aid Part
"teleport" ItemId
iid Maybe Part
msuffix
      IK.CreateItem{} -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      IK.DestroyItem{} -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      IK.ConsumeItems{} -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      IK.DropItem Int
_ Int
_ CStore
COrgan GroupName ItemKind
_ -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      IK.DropItem{} ->  -- rare enough
        MsgClassShowAndSave
-> ActorId -> Part -> ItemId -> Maybe Part -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> ActorId -> Part -> ItemId -> Maybe Part -> m ()
mitemAidVerbMU MsgClassShowAndSave
MsgEffectMedium ActorId
aid Part
"be stripped" ItemId
iid (Part -> Maybe Part
forall a. a -> Maybe a
Just Part
"with")
      IK.Recharge{} | Bool -> Bool
not Bool
isAlive -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      IK.Recharge{} -> MsgClassShowAndSave -> ActorId -> Part -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> ActorId -> Part -> m ()
aidVerbMU MsgClassShowAndSave
MsgEffectMedium ActorId
aid Part
"charge up"
      IK.Discharge{} | Bool -> Bool
not Bool
isAlive -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      IK.Discharge{} -> MsgClassShowAndSave -> ActorId -> Part -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> ActorId -> Part -> m ()
aidVerbMU MsgClassShowAndSave
MsgEffectMedium ActorId
aid Part
"lose charges"
      Effect
IK.PolyItem -> do
        subject <- ActorId -> m Part
forall (m :: * -> *). MonadClientUI m => ActorId -> m Part
partActorLeader ActorId
aid
        let ppstore = Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ CStore -> Text
ppCStoreIn CStore
CGround
        msgAdd MsgEffectMedium $ makeSentence
          [ MU.SubjectVerbSg subject "repurpose", "what lies", ppstore
          , "to a common item of the current level" ]
      Effect
IK.RerollItem -> do
        subject <- ActorId -> m Part
forall (m :: * -> *). MonadClientUI m => ActorId -> m Part
partActorLeader ActorId
aid
        let ppstore = Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ CStore -> Text
ppCStoreIn CStore
CGround
        msgAdd MsgEffectMedium $ makeSentence
          [ MU.SubjectVerbSg subject "reshape", "what lies", ppstore
          , "striving for the highest possible standards" ]
      Effect
IK.DupItem -> do
        subject <- ActorId -> m Part
forall (m :: * -> *). MonadClientUI m => ActorId -> m Part
partActorLeader ActorId
aid
        let ppstore = Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ CStore -> Text
ppCStoreIn CStore
CGround
        msgAdd MsgEffectMedium $ makeSentence
          [MU.SubjectVerbSg subject "multiply", "what lies", ppstore]
      Effect
IK.Identify -> do
        subject <- ActorId -> m Part
forall (m :: * -> *). MonadClientUI m => ActorId -> m Part
partActorLeader ActorId
aid
        pronoun <- partPronounLeader aid
        msgAdd MsgEffectMinor $ makeSentence
          [ MU.SubjectVerbSg subject "look at"
          , MU.WownW pronoun $ MU.Text "inventory"
          , "intensely" ]
      IK.Detect DetectKind
d Int
_ -> do
        subject <- ActorId -> m Part
forall (m :: * -> *). MonadClientUI m => ActorId -> m Part
partActorLeader ActorId
aid
        factionD <- getsState sfactionD
        localTime <- getsState $ getLocalTime $ blid b
        let verb = Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ DetectKind -> Text
detectToVerb DetectKind
d
            object = Part -> Part
MU.Ws (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ DetectKind -> Text
detectToObject DetectKind
d
        (periodic, itemFull) <-
          if iid `EM.member` itemD then do
            itemFull <- getsState $ itemToFull iid
            let arItem = ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFull
            return (IA.checkFlag Ability.Periodic arItem, itemFull)
          else do
#ifdef WITH_EXPENSIVE_ASSERTIONS
            -- It's not actually expensive, but it's particularly likely
            -- to fail with wild content, indicating server game rules logic
            -- needs to be fixed/extended:
            -- Observer from another faction may receive the effect information
            -- from the server, because the affected actor is visible,
            -- but the position of the item may be out of FOV. This is fine;
            -- the message is then shorter, because only the effect was seen,
            -- while the cause remains misterious.
            let !_A = if fid /= side  -- not from affected faction; observing
                      then ()
                      else error $ "item never seen by the affected actor"
                                   `showFailure` (aid, b, bUI, verb, iid, sfx)
#endif
            return (False, undefined)
        let iidDesc =
              let (Part
name1, Part
powers) = Int
-> FactionId
-> FactionDict
-> Time
-> ItemFull
-> ItemQuant
-> (Part, Part)
partItemShort Int
rwidth FactionId
side FactionDict
factionD Time
localTime
                                                  ItemFull
itemFull ItemQuant
quantSingle
              in [Part] -> Text
makePhrase [Part
"the", Part
name1, Part
powers]
            -- If item not periodic, most likely intentional, so don't spam.
            means = [Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ Text
"(via" Text -> Text -> Text
<+> Text
iidDesc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")" | Bool
periodic]
        msgAdd MsgEffectMinor $
          makeSentence $ [MU.SubjectVerbSg subject verb] ++ [object] ++ means
        -- Don't make it modal if all info remains after no longer seen.
        unless (fid /= side || d `elem` [IK.DetectHidden, IK.DetectExit]) $
          displayMore ColorFull ""  -- the sentence short
      IK.SendFlying{} | Bool -> Bool
not Bool
isAlive -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      IK.SendFlying{} -> MsgClassShowAndSave -> ActorId -> Part -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> ActorId -> Part -> m ()
aidVerbMU MsgClassShowAndSave
MsgEffectMedium ActorId
aid Part
"be sent flying"
      IK.PushActor{} | Bool -> Bool
not Bool
isAlive -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      IK.PushActor{} -> MsgClassShowAndSave -> ActorId -> Part -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> ActorId -> Part -> m ()
aidVerbMU MsgClassShowAndSave
MsgEffectMedium ActorId
aid Part
"be pushed"
      IK.PullActor{} | Bool -> Bool
not Bool
isAlive -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      IK.PullActor{} -> MsgClassShowAndSave -> ActorId -> Part -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> ActorId -> Part -> m ()
aidVerbMU MsgClassShowAndSave
MsgEffectMedium ActorId
aid Part
"be pulled"
      Effect
IK.ApplyPerfume ->
        MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
MsgEffectMinor
               Text
"The fragrance quells all scents in the vicinity."
      IK.AtMostOneOf{} -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      IK.OneOf{} -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      IK.OnSmash{} -> String -> m ()
forall a. HasCallStack => String -> a
error (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"" String -> SfxAtomic -> String
forall v. Show v => String -> v -> String
`showFailure` SfxAtomic
sfx
      IK.OnCombine{} -> String -> m ()
forall a. HasCallStack => String -> a
error (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"" String -> SfxAtomic -> String
forall v. Show v => String -> v -> String
`showFailure` SfxAtomic
sfx
      IK.OnUser{} -> String -> m ()
forall a. HasCallStack => String -> a
error (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"" String -> SfxAtomic -> String
forall v. Show v => String -> v -> String
`showFailure` SfxAtomic
sfx
      Effect
IK.NopEffect -> String -> m ()
forall a. HasCallStack => String -> a
error (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"" String -> SfxAtomic -> String
forall v. Show v => String -> v -> String
`showFailure` SfxAtomic
sfx
      IK.AndEffect{} -> String -> m ()
forall a. HasCallStack => String -> a
error (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"" String -> SfxAtomic -> String
forall v. Show v => String -> v -> String
`showFailure` SfxAtomic
sfx
      IK.OrEffect{} -> String -> m ()
forall a. HasCallStack => String -> a
error (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"" String -> SfxAtomic -> String
forall v. Show v => String -> v -> String
`showFailure` SfxAtomic
sfx
      IK.SeqEffect{} -> String -> m ()
forall a. HasCallStack => String -> a
error (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"" String -> SfxAtomic -> String
forall v. Show v => String -> v -> String
`showFailure` SfxAtomic
sfx
      IK.When{} -> String -> m ()
forall a. HasCallStack => String -> a
error (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"" String -> SfxAtomic -> String
forall v. Show v => String -> v -> String
`showFailure` SfxAtomic
sfx
      IK.Unless{} -> String -> m ()
forall a. HasCallStack => String -> a
error (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"" String -> SfxAtomic -> String
forall v. Show v => String -> v -> String
`showFailure` SfxAtomic
sfx
      IK.IfThenElse{} -> String -> m ()
forall a. HasCallStack => String -> a
error (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"" String -> SfxAtomic -> String
forall v. Show v => String -> v -> String
`showFailure` SfxAtomic
sfx
      IK.VerbNoLonger{} | Bool -> Bool
not Bool
isAlive -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      IK.VerbNoLonger Text
verb Text
ending -> do
        let msgClass :: MsgClassShowAndSave
msgClass = if FactionId
fid FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side
                       then MsgClassShowAndSave
MsgStatusStopUs
                       else MsgClassShowAndSave
MsgStatusStopThem
        subject <- ActorId -> m Part
forall (m :: * -> *). MonadClientUI m => ActorId -> m Part
partActorLeader ActorId
aid
        msgAdd msgClass $
          makePhrase [MU.Capitalize $ MU.SubjectVerbSg subject $ MU.Text verb]
          <> ending
      IK.VerbMsg Text
verb Text
ending -> do
        subject <- ActorId -> m Part
forall (m :: * -> *). MonadClientUI m => ActorId -> m Part
partActorLeader ActorId
aid
        msgAdd MsgEffectMedium $
          makePhrase [MU.Capitalize $ MU.SubjectVerbSg subject $ MU.Text verb]
          <> ending
      IK.VerbMsgFail Text
verb Text
ending -> do
        subject <- ActorId -> m Part
forall (m :: * -> *). MonadClientUI m => ActorId -> m Part
partActorLeader ActorId
aid
        msgAdd MsgActionWarning $
          makePhrase [MU.Capitalize $ MU.SubjectVerbSg subject $ MU.Text verb]
          <> ending
  SfxItemApplied Bool
verbose ItemId
iid Container
c -> do
    if Bool
verbose
    then MsgClassShowAndSave
-> ItemId -> ItemQuant -> Part -> Container -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> ItemId -> ItemQuant -> Part -> Container -> m ()
itemVerbMU MsgClassShowAndSave
MsgActionMinor ItemId
iid (Int
1, []) Part
"have got activated" Container
c
    else MsgClassSave -> ItemId -> ItemQuant -> Part -> Container -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> ItemId -> ItemQuant -> Part -> Container -> m ()
itemVerbMU MsgClassSave
MsgInnerWorkSpam ItemId
iid (Int
1, []) Part
"have been triggered" Container
c
  SfxMsgFid FactionId
_ SfxMsg
sfxMsg -> do
    mleader <- (StateClient -> Maybe ActorId) -> m (Maybe ActorId)
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Maybe ActorId
sleader
    case mleader of
      Just{} -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()  -- will flush messages when leader moves
      Maybe ActorId
Nothing -> do
        lidV <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
viewedLevelUI
        markDisplayNeeded lidV
        recordHistory
    mmsg <- ppSfxMsg sfxMsg
    case mmsg of
      Just (Left (MsgClassShowAndSave
msgClass, Text
msg)) -> MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
msgClass Text
msg
      Just (Right (MsgClassDistinct
msgClass, (Text
t1, Text
t2))) -> do
        let dotsIfShorter :: Text
dotsIfShorter = if Text
t1 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
t2 then Text
"" else Text
".."
        MsgClassDistinct -> (Text, Text) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
MsgClassDistinct -> (Text, Text) -> m ()
msgAddDistinct MsgClassDistinct
msgClass  (Text
t1 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
dotsIfShorter, Text
t2)
      Maybe
  (Either
     (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text)))
Nothing -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  SfxAtomic
SfxRestart -> Bool -> m ()
forall (m :: * -> *). MonadClientUI m => Bool -> m ()
fadeOutOrIn Bool
True
  SfxCollideTile ActorId
source Point
pos -> do
    COps{cotile} <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
    sb <- getsState $ getActorBody source
    lvl <- getLevel $ blid sb
    spart <- partActorLeader source
    let object = Part -> Part
MU.AW (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ TileKind -> Text
TK.tname (TileKind -> Text) -> TileKind -> Text
forall a b. (a -> b) -> a -> b
$ ContentData TileKind -> ContentId TileKind -> TileKind
forall a. ContentData a -> ContentId a -> a
okind ContentData TileKind
cotile (ContentId TileKind -> TileKind) -> ContentId TileKind -> TileKind
forall a b. (a -> b) -> a -> b
$ Level
lvl Level -> Point -> ContentId TileKind
`at` Point
pos
    -- Neutral message, because minor damage and we don't say, which faction.
    msgAdd MsgNeutralEvent $! makeSentence
      [MU.SubjectVerbSg spart "collide", "painfully with", object]
  SfxTaunt Bool
voluntary ActorId
aid -> do
    side <- (StateClient -> FactionId) -> m FactionId
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
    b <- getsState $ getActorBody aid
    unless (bproj b && bfid b == side) $ do  -- don't spam
      spart <- partActorLeader aid
      (_heardSubject, verb) <- displayTaunt voluntary rndToActionUI aid
      let msgClass = if Bool
voluntary Bool -> Bool -> Bool
&& Actor -> FactionId
bfid Actor
b FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side
                     then MsgClassShowAndSave
MsgActionComplete  -- give feedback after keypress
                     else MsgClassShowAndSave
MsgMiscellanous
      msgAdd msgClass $! makeSentence [MU.SubjectVerbSg spart (MU.Text verb)]

returnJustLeft :: MonadClientUI m
               => (MsgClassShowAndSave, Text)
               -> m (Maybe (Either (MsgClassShowAndSave, Text)
                                   (MsgClassDistinct, (Text, Text))))
returnJustLeft :: forall (m :: * -> *).
MonadClientUI m =>
(MsgClassShowAndSave, Text)
-> m (Maybe
        (Either
           (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text))))
returnJustLeft = Maybe
  (Either
     (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text)))
-> m (Maybe
        (Either
           (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text))))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe
   (Either
      (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text)))
 -> m (Maybe
         (Either
            (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text)))))
-> ((MsgClassShowAndSave, Text)
    -> Maybe
         (Either
            (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text))))
-> (MsgClassShowAndSave, Text)
-> m (Maybe
        (Either
           (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text))))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text))
-> Maybe
     (Either
        (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text)))
forall a. a -> Maybe a
Just (Either
   (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text))
 -> Maybe
      (Either
         (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text))))
-> ((MsgClassShowAndSave, Text)
    -> Either
         (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text)))
-> (MsgClassShowAndSave, Text)
-> Maybe
     (Either
        (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MsgClassShowAndSave, Text)
-> Either
     (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text))
forall a b. a -> Either a b
Left

ppSfxMsg :: MonadClientUI m
         => SfxMsg -> m (Maybe (Either (MsgClassShowAndSave, Text)
                                       (MsgClassDistinct, (Text, Text))))
ppSfxMsg :: forall (m :: * -> *).
MonadClientUI m =>
SfxMsg
-> m (Maybe
        (Either
           (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text))))
ppSfxMsg SfxMsg
sfxMsg = case SfxMsg
sfxMsg of
  SfxUnexpected ReqFailure
reqFailure -> (MsgClassShowAndSave, Text)
-> m (Maybe
        (Either
           (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text))))
forall (m :: * -> *).
MonadClientUI m =>
(MsgClassShowAndSave, Text)
-> m (Maybe
        (Either
           (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text))))
returnJustLeft
    ( MsgClassShowAndSave
MsgActionWarning
    , Text
"Unexpected problem:" Text -> Text -> Text
<+> ReqFailure -> Text
showReqFailure ReqFailure
reqFailure Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." )
  SfxExpected Text
itemName ReqFailure
reqFailure -> (MsgClassShowAndSave, Text)
-> m (Maybe
        (Either
           (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text))))
forall (m :: * -> *).
MonadClientUI m =>
(MsgClassShowAndSave, Text)
-> m (Maybe
        (Either
           (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text))))
returnJustLeft
    ( MsgClassShowAndSave
MsgActionWarning
    , Text
"The" Text -> Text -> Text
<+> Text
itemName Text -> Text -> Text
<+> Text
"is not triggered:"
      Text -> Text -> Text
<+> ReqFailure -> Text
showReqFailure ReqFailure
reqFailure Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." )
  SfxExpectedEmbed ItemId
iid LevelId
lid ReqFailure
reqFailure -> do
    iidSeen <- (State -> Bool) -> m Bool
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Bool) -> m Bool) -> (State -> Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ ItemId -> ItemDict -> Bool
forall k a. Enum k => k -> EnumMap k a -> Bool
EM.member ItemId
iid (ItemDict -> Bool) -> (State -> ItemDict) -> State -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> ItemDict
sitemD
    if iidSeen then do
      itemFull <- getsState $ itemToFull iid
      side <- getsClient sside
      factionD <- getsState sfactionD
      localTime <- getsState $ getLocalTime lid
      let (object1, object2) =
            partItemShortest maxBound side factionD localTime
                             itemFull quantSingle
          name = [Part] -> Text
makePhrase [Part
object1, Part
object2]
      returnJustLeft
        ( MsgActionWarning
        , "The" <+> "embedded" <+> name <+> "is not activated:"
          <+> showReqFailure reqFailure <> "." )
    else return Nothing
  SfxFizzles ItemId
iid Container
c -> do
    msg <- Bool -> ItemId -> ItemQuant -> Part -> Container -> m Text
forall (m :: * -> *).
MonadClientUI m =>
Bool -> ItemId -> ItemQuant -> Part -> Container -> m Text
itemVerbMUGeneral Bool
True ItemId
iid (Int
1, []) Part
"do not work" Container
c
    return $ Just $ Right (MsgStatusWarning, ("It didn't work.", msg))
  SfxNothingHappens ItemId
iid Container
c -> do
    msg <- Bool -> ItemId -> ItemQuant -> Part -> Container -> m Text
forall (m :: * -> *).
MonadClientUI m =>
Bool -> ItemId -> ItemQuant -> Part -> Container -> m Text
itemVerbMUGeneral Bool
True ItemId
iid (Int
1, []) Part
"do nothing, predictably" Container
c
    return $ Just $ Right (MsgStatusBenign, ("Nothing happens.", msg))
  SfxNoItemsForTile [[(Int, GroupName ItemKind)]]
toolsToAlterWith -> do
    revCmd <- m (HumanCmd -> KM)
forall (m :: * -> *). MonadClientUI m => m (HumanCmd -> KM)
revCmdMap
    let km = HumanCmd -> KM
revCmd HumanCmd
HumanCmd.AlterDir
        tItems = [[(Int, GroupName ItemKind)]] -> Text
describeToolsAlternative [[(Int, GroupName ItemKind)]]
toolsToAlterWith
    returnJustLeft ( MsgActionWarning
                   , "To transform the terrain, prepare the following items on the ground or in equipment:"
                     <+> tItems
                     <+> "and use the '"
                     <> T.pack (K.showKM km)
                     <> "' terrain modification command."
                   )
  SfxVoidDetection DetectKind
d -> (MsgClassShowAndSave, Text)
-> m (Maybe
        (Either
           (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text))))
forall (m :: * -> *).
MonadClientUI m =>
(MsgClassShowAndSave, Text)
-> m (Maybe
        (Either
           (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text))))
returnJustLeft
    ( MsgClassShowAndSave
MsgMiscellanous
    , [Part] -> Text
makeSentence [Part
"no new", Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ DetectKind -> Text
detectToObject DetectKind
d, Part
"detected"] )
  SfxUnimpressed ActorId
aid -> do
    msbUI <- (SessionUI -> Maybe ActorUI) -> m (Maybe ActorUI)
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession ((SessionUI -> Maybe ActorUI) -> m (Maybe ActorUI))
-> (SessionUI -> Maybe ActorUI) -> m (Maybe ActorUI)
forall a b. (a -> b) -> a -> b
$ ActorId -> EnumMap ActorId ActorUI -> Maybe ActorUI
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup ActorId
aid (EnumMap ActorId ActorUI -> Maybe ActorUI)
-> (SessionUI -> EnumMap ActorId ActorUI)
-> SessionUI
-> Maybe ActorUI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessionUI -> EnumMap ActorId ActorUI
sactorUI
    case msbUI of
      Maybe ActorUI
Nothing -> Maybe
  (Either
     (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text)))
-> m (Maybe
        (Either
           (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text))))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe
  (Either
     (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text)))
forall a. Maybe a
Nothing
      Just ActorUI
sbUI -> do
        let subject :: Part
subject = ActorUI -> Part
partActor ActorUI
sbUI
            verb :: Part
verb = Part
"be unimpressed"
        (MsgClassShowAndSave, Text)
-> m (Maybe
        (Either
           (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text))))
forall (m :: * -> *).
MonadClientUI m =>
(MsgClassShowAndSave, Text)
-> m (Maybe
        (Either
           (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text))))
returnJustLeft ( MsgClassShowAndSave
MsgActionWarning
                       , [Part] -> Text
makeSentence [Part -> Part -> Part
MU.SubjectVerbSg Part
subject Part
verb] )
  SfxSummonLackCalm ActorId
aid -> do
    msbUI <- (SessionUI -> Maybe ActorUI) -> m (Maybe ActorUI)
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession ((SessionUI -> Maybe ActorUI) -> m (Maybe ActorUI))
-> (SessionUI -> Maybe ActorUI) -> m (Maybe ActorUI)
forall a b. (a -> b) -> a -> b
$ ActorId -> EnumMap ActorId ActorUI -> Maybe ActorUI
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup ActorId
aid (EnumMap ActorId ActorUI -> Maybe ActorUI)
-> (SessionUI -> EnumMap ActorId ActorUI)
-> SessionUI
-> Maybe ActorUI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessionUI -> EnumMap ActorId ActorUI
sactorUI
    case msbUI of
      Maybe ActorUI
Nothing -> Maybe
  (Either
     (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text)))
-> m (Maybe
        (Either
           (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text))))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe
  (Either
     (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text)))
forall a. Maybe a
Nothing
      Just ActorUI
sbUI -> do
        let subject :: Part
subject = ActorUI -> Part
partActor ActorUI
sbUI
            verb :: Part
verb = Part
"lack Calm to summon"
        (MsgClassShowAndSave, Text)
-> m (Maybe
        (Either
           (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text))))
forall (m :: * -> *).
MonadClientUI m =>
(MsgClassShowAndSave, Text)
-> m (Maybe
        (Either
           (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text))))
returnJustLeft ( MsgClassShowAndSave
MsgActionWarning
                       , [Part] -> Text
makeSentence [Part -> Part -> Part
MU.SubjectVerbSg Part
subject Part
verb] )
  SfxSummonTooManyOwn ActorId
aid -> do
    msbUI <- (SessionUI -> Maybe ActorUI) -> m (Maybe ActorUI)
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession ((SessionUI -> Maybe ActorUI) -> m (Maybe ActorUI))
-> (SessionUI -> Maybe ActorUI) -> m (Maybe ActorUI)
forall a b. (a -> b) -> a -> b
$ ActorId -> EnumMap ActorId ActorUI -> Maybe ActorUI
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup ActorId
aid (EnumMap ActorId ActorUI -> Maybe ActorUI)
-> (SessionUI -> EnumMap ActorId ActorUI)
-> SessionUI
-> Maybe ActorUI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessionUI -> EnumMap ActorId ActorUI
sactorUI
    case msbUI of
      Maybe ActorUI
Nothing -> Maybe
  (Either
     (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text)))
-> m (Maybe
        (Either
           (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text))))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe
  (Either
     (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text)))
forall a. Maybe a
Nothing
      Just ActorUI
sbUI -> do
        let subject :: Part
subject = ActorUI -> Part
partActor ActorUI
sbUI
            verb :: Part
verb = Part
"can't keep track of their numerous friends, let alone summon any more"
        (MsgClassShowAndSave, Text)
-> m (Maybe
        (Either
           (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text))))
forall (m :: * -> *).
MonadClientUI m =>
(MsgClassShowAndSave, Text)
-> m (Maybe
        (Either
           (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text))))
returnJustLeft (MsgClassShowAndSave
MsgActionWarning, [Part] -> Text
makeSentence [Part
subject, Part
verb])
  SfxSummonTooManyAll ActorId
aid -> do
    msbUI <- (SessionUI -> Maybe ActorUI) -> m (Maybe ActorUI)
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession ((SessionUI -> Maybe ActorUI) -> m (Maybe ActorUI))
-> (SessionUI -> Maybe ActorUI) -> m (Maybe ActorUI)
forall a b. (a -> b) -> a -> b
$ ActorId -> EnumMap ActorId ActorUI -> Maybe ActorUI
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup ActorId
aid (EnumMap ActorId ActorUI -> Maybe ActorUI)
-> (SessionUI -> EnumMap ActorId ActorUI)
-> SessionUI
-> Maybe ActorUI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessionUI -> EnumMap ActorId ActorUI
sactorUI
    case msbUI of
      Maybe ActorUI
Nothing -> Maybe
  (Either
     (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text)))
-> m (Maybe
        (Either
           (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text))))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe
  (Either
     (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text)))
forall a. Maybe a
Nothing
      Just ActorUI
sbUI -> do
        let subject :: Part
subject = ActorUI -> Part
partActor ActorUI
sbUI
            verb :: Part
verb = Part
"can't keep track of everybody around, let alone summon anyone else"
        (MsgClassShowAndSave, Text)
-> m (Maybe
        (Either
           (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text))))
forall (m :: * -> *).
MonadClientUI m =>
(MsgClassShowAndSave, Text)
-> m (Maybe
        (Either
           (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text))))
returnJustLeft (MsgClassShowAndSave
MsgActionWarning, [Part] -> Text
makeSentence [Part
subject, Part
verb])
  SfxSummonFailure ActorId
aid -> do
    msbUI <- (SessionUI -> Maybe ActorUI) -> m (Maybe ActorUI)
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession ((SessionUI -> Maybe ActorUI) -> m (Maybe ActorUI))
-> (SessionUI -> Maybe ActorUI) -> m (Maybe ActorUI)
forall a b. (a -> b) -> a -> b
$ ActorId -> EnumMap ActorId ActorUI -> Maybe ActorUI
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup ActorId
aid (EnumMap ActorId ActorUI -> Maybe ActorUI)
-> (SessionUI -> EnumMap ActorId ActorUI)
-> SessionUI
-> Maybe ActorUI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessionUI -> EnumMap ActorId ActorUI
sactorUI
    case msbUI of
      Maybe ActorUI
Nothing -> Maybe
  (Either
     (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text)))
-> m (Maybe
        (Either
           (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text))))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe
  (Either
     (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text)))
forall a. Maybe a
Nothing
      Just ActorUI
sbUI -> do
        let subject :: Part
subject = ActorUI -> Part
partActor ActorUI
sbUI
            verb :: Part
verb = Part
"fail to summon anything"
        (MsgClassShowAndSave, Text)
-> m (Maybe
        (Either
           (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text))))
forall (m :: * -> *).
MonadClientUI m =>
(MsgClassShowAndSave, Text)
-> m (Maybe
        (Either
           (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text))))
returnJustLeft ( MsgClassShowAndSave
MsgActionWarning
                       , [Part] -> Text
makeSentence [Part -> Part -> Part
MU.SubjectVerbSg Part
subject Part
verb] )
  SfxMsg
SfxLevelNoMore -> (MsgClassShowAndSave, Text)
-> m (Maybe
        (Either
           (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text))))
forall (m :: * -> *).
MonadClientUI m =>
(MsgClassShowAndSave, Text)
-> m (Maybe
        (Either
           (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text))))
returnJustLeft
    (MsgClassShowAndSave
MsgActionWarning, Text
"No more levels in this direction.")
  SfxMsg
SfxLevelPushed -> (MsgClassShowAndSave, Text)
-> m (Maybe
        (Either
           (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text))))
forall (m :: * -> *).
MonadClientUI m =>
(MsgClassShowAndSave, Text)
-> m (Maybe
        (Either
           (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text))))
returnJustLeft
    (MsgClassShowAndSave
MsgActionWarning, Text
"You notice somebody pushed to another level.")
  SfxBracedImmune ActorId
aid -> do
    msbUI <- (SessionUI -> Maybe ActorUI) -> m (Maybe ActorUI)
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession ((SessionUI -> Maybe ActorUI) -> m (Maybe ActorUI))
-> (SessionUI -> Maybe ActorUI) -> m (Maybe ActorUI)
forall a b. (a -> b) -> a -> b
$ ActorId -> EnumMap ActorId ActorUI -> Maybe ActorUI
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup ActorId
aid (EnumMap ActorId ActorUI -> Maybe ActorUI)
-> (SessionUI -> EnumMap ActorId ActorUI)
-> SessionUI
-> Maybe ActorUI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessionUI -> EnumMap ActorId ActorUI
sactorUI
    case msbUI of
      Maybe ActorUI
Nothing -> Maybe
  (Either
     (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text)))
-> m (Maybe
        (Either
           (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text))))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe
  (Either
     (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text)))
forall a. Maybe a
Nothing
      Just ActorUI
sbUI -> do
        let subject :: Part
subject = ActorUI -> Part
partActor ActorUI
sbUI
            verb :: Part
verb = Part
"be braced and so immune to translocation"
        (MsgClassShowAndSave, Text)
-> m (Maybe
        (Either
           (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text))))
forall (m :: * -> *).
MonadClientUI m =>
(MsgClassShowAndSave, Text)
-> m (Maybe
        (Either
           (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text))))
returnJustLeft ( MsgClassShowAndSave
MsgMiscellanous
                       , [Part] -> Text
makeSentence [Part -> Part -> Part
MU.SubjectVerbSg Part
subject Part
verb] )
                         -- too common
  SfxMsg
SfxEscapeImpossible -> (MsgClassShowAndSave, Text)
-> m (Maybe
        (Either
           (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text))))
forall (m :: * -> *).
MonadClientUI m =>
(MsgClassShowAndSave, Text)
-> m (Maybe
        (Either
           (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text))))
returnJustLeft
    ( MsgClassShowAndSave
MsgActionWarning
    , Text
"Escaping outside is unthinkable for members of this faction." )
  SfxMsg
SfxStasisProtects -> (MsgClassShowAndSave, Text)
-> m (Maybe
        (Either
           (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text))))
forall (m :: * -> *).
MonadClientUI m =>
(MsgClassShowAndSave, Text)
-> m (Maybe
        (Either
           (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text))))
returnJustLeft
    ( MsgClassShowAndSave
MsgMiscellanous  -- too common
    , Text
"Paralysis and speed surge require recovery time." )
  SfxMsg
SfxWaterParalysisResisted -> Maybe
  (Either
     (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text)))
-> m (Maybe
        (Either
           (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text))))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe
  (Either
     (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text)))
forall a. Maybe a
Nothing  -- don't spam
  SfxMsg
SfxTransImpossible -> (MsgClassShowAndSave, Text)
-> m (Maybe
        (Either
           (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text))))
forall (m :: * -> *).
MonadClientUI m =>
(MsgClassShowAndSave, Text)
-> m (Maybe
        (Either
           (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text))))
returnJustLeft
    (MsgClassShowAndSave
MsgActionWarning, Text
"Translocation not possible.")
  SfxMsg
SfxIdentifyNothing -> (MsgClassShowAndSave, Text)
-> m (Maybe
        (Either
           (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text))))
forall (m :: * -> *).
MonadClientUI m =>
(MsgClassShowAndSave, Text)
-> m (Maybe
        (Either
           (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text))))
returnJustLeft
    (MsgClassShowAndSave
MsgActionWarning, Text
"Nothing to identify.")
  SfxMsg
SfxPurposeNothing -> (MsgClassShowAndSave, Text)
-> m (Maybe
        (Either
           (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text))))
forall (m :: * -> *).
MonadClientUI m =>
(MsgClassShowAndSave, Text)
-> m (Maybe
        (Either
           (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text))))
returnJustLeft
    ( MsgClassShowAndSave
MsgActionWarning
    , Text
"The purpose of repurpose cannot be availed without an item"
      Text -> Text -> Text
<+> CStore -> Text
ppCStoreIn CStore
CGround Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." )
  SfxPurposeTooFew Int
maxCount Int
itemK -> (MsgClassShowAndSave, Text)
-> m (Maybe
        (Either
           (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text))))
forall (m :: * -> *).
MonadClientUI m =>
(MsgClassShowAndSave, Text)
-> m (Maybe
        (Either
           (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text))))
returnJustLeft
    ( MsgClassShowAndSave
MsgActionWarning
    , Text
"The purpose of repurpose is served by" Text -> Text -> Text
<+> Int -> Text
forall a. Show a => a -> Text
tshow Int
maxCount
      Text -> Text -> Text
<+> Text
"pieces of this item, not by" Text -> Text -> Text
<+> Int -> Text
forall a. Show a => a -> Text
tshow Int
itemK Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." )
  SfxMsg
SfxPurposeUnique -> (MsgClassShowAndSave, Text)
-> m (Maybe
        (Either
           (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text))))
forall (m :: * -> *).
MonadClientUI m =>
(MsgClassShowAndSave, Text)
-> m (Maybe
        (Either
           (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text))))
returnJustLeft
    (MsgClassShowAndSave
MsgActionWarning, Text
"Unique items can't be repurposed.")
  SfxMsg
SfxPurposeNotCommon -> (MsgClassShowAndSave, Text)
-> m (Maybe
        (Either
           (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text))))
forall (m :: * -> *).
MonadClientUI m =>
(MsgClassShowAndSave, Text)
-> m (Maybe
        (Either
           (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text))))
returnJustLeft
    (MsgClassShowAndSave
MsgActionWarning, Text
"Only ordinary common items can be repurposed.")
  SfxMsg
SfxRerollNothing -> (MsgClassShowAndSave, Text)
-> m (Maybe
        (Either
           (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text))))
forall (m :: * -> *).
MonadClientUI m =>
(MsgClassShowAndSave, Text)
-> m (Maybe
        (Either
           (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text))))
returnJustLeft
    ( MsgClassShowAndSave
MsgActionWarning
    , Text
"The shape of reshape cannot be assumed without an item"
      Text -> Text -> Text
<+> CStore -> Text
ppCStoreIn CStore
CGround Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." )
  SfxMsg
SfxRerollNotRandom -> (MsgClassShowAndSave, Text)
-> m (Maybe
        (Either
           (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text))))
forall (m :: * -> *).
MonadClientUI m =>
(MsgClassShowAndSave, Text)
-> m (Maybe
        (Either
           (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text))))
returnJustLeft
    (MsgClassShowAndSave
MsgActionWarning, Text
"Only items of variable shape can be reshaped.")
  SfxMsg
SfxDupNothing -> (MsgClassShowAndSave, Text)
-> m (Maybe
        (Either
           (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text))))
forall (m :: * -> *).
MonadClientUI m =>
(MsgClassShowAndSave, Text)
-> m (Maybe
        (Either
           (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text))))
returnJustLeft
    ( MsgClassShowAndSave
MsgActionWarning
    , Text
"Mutliplicity won't rise above zero without an item"
      Text -> Text -> Text
<+> CStore -> Text
ppCStoreIn CStore
CGround Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." )
  SfxMsg
SfxDupUnique -> (MsgClassShowAndSave, Text)
-> m (Maybe
        (Either
           (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text))))
forall (m :: * -> *).
MonadClientUI m =>
(MsgClassShowAndSave, Text)
-> m (Maybe
        (Either
           (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text))))
returnJustLeft
    (MsgClassShowAndSave
MsgActionWarning, Text
"Unique items can't be multiplied.")
  SfxMsg
SfxDupValuable -> (MsgClassShowAndSave, Text)
-> m (Maybe
        (Either
           (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text))))
forall (m :: * -> *).
MonadClientUI m =>
(MsgClassShowAndSave, Text)
-> m (Maybe
        (Either
           (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text))))
returnJustLeft
    (MsgClassShowAndSave
MsgActionWarning, Text
"Valuable items can't be multiplied.")
  SfxMsg
SfxColdFish -> (MsgClassShowAndSave, Text)
-> m (Maybe
        (Either
           (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text))))
forall (m :: * -> *).
MonadClientUI m =>
(MsgClassShowAndSave, Text)
-> m (Maybe
        (Either
           (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text))))
returnJustLeft
    ( MsgClassShowAndSave
MsgMiscellanous  -- repeatable
    , Text
"Healing attempt from another faction is thwarted by your cold fish attitude." )
  SfxMsg
SfxReadyGoods -> (MsgClassShowAndSave, Text)
-> m (Maybe
        (Either
           (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text))))
forall (m :: * -> *).
MonadClientUI m =>
(MsgClassShowAndSave, Text)
-> m (Maybe
        (Either
           (MsgClassShowAndSave, Text) (MsgClassDistinct, (Text, Text))))
returnJustLeft
    ( MsgClassShowAndSave
MsgMiscellanous  -- repeatable
    , Text
"Crafting is alien to you, accustomed to buying ready goods all your life." )
  SfxTimerExtended ActorId
aid ItemId
iid CStore
cstore Delta Time
delta -> do
    CCUI{coscreen=ScreenContent{rwidth}} <- (SessionUI -> CCUI) -> m CCUI
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
    aidSeen <- getsState $ EM.member aid . sactorD
    iidSeen <- getsState $ EM.member iid . sitemD
    if aidSeen && iidSeen then do
      b <- getsState $ getActorBody aid
      bUI <- getsSession $ getActorUI aid
      factionD <- getsState sfactionD
      localTime <- getsState $ getLocalTime (blid b)
      itemFull <- getsState $ itemToFull iid
      side <- getsClient sside
      bag <- getsState $ getBodyStoreBag b cstore
      let (name, powers) =
            partItem rwidth (bfid b) factionD localTime itemFull quantSingle
          total = case EnumMap ItemId ItemQuant
bag EnumMap ItemId ItemQuant -> ItemId -> ItemQuant
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ItemId
iid of
            (Int
_, []) -> String -> Delta Time
forall a. HasCallStack => String -> a
error (String -> Delta Time) -> String -> Delta Time
forall a b. (a -> b) -> a -> b
$ String
"" String
-> (EnumMap ItemId ItemQuant, ItemId, ActorId, CStore, Delta Time)
-> String
forall v. Show v => String -> v -> String
`showFailure` (EnumMap ItemId ItemQuant
bag, ItemId
iid, ActorId
aid, CStore
cstore, Delta Time
delta)
            (Int
_, ItemTimer
t:[ItemTimer]
_) -> Time -> ItemTimer -> Delta Time
deltaOfItemTimer Time
localTime ItemTimer
t
              -- only exceptionally not singleton list
      storeOwn <- ppContainerWownW partPronounLeader True (CActor aid cstore)
      -- Ideally we'd use a pronoun here, but the action (e.g., hit)
      -- that caused this extension can be invisible to some onlookers.
      -- So their narrative context needs to be taken into account.
      -- The upside is that the messages do not bind pronouns
      -- and so commute and so repetitions can be squashed.
      let cond = [ Part
"condition"
                 | Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Condition (AspectRecord -> Bool) -> AspectRecord -> Bool
forall a b. (a -> b) -> a -> b
$ ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFull ]
          usShow =
            [Part
"the", Part
name, Part
powers] [Part] -> [Part] -> [Part]
forall a. [a] -> [a] -> [a]
++ [Part]
cond
            [Part] -> [Part] -> [Part]
forall a. [a] -> [a] -> [a]
++ [Part]
storeOwn [Part] -> [Part] -> [Part]
forall a. [a] -> [a] -> [a]
++ [Part
"will now last longer"]
          usSave =
            [Part
"the", Part
name, Part
powers] [Part] -> [Part] -> [Part]
forall a. [a] -> [a] -> [a]
++ [Part]
cond
            [Part] -> [Part] -> [Part]
forall a. [a] -> [a] -> [a]
++ [Part]
storeOwn [Part] -> [Part] -> [Part]
forall a. [a] -> [a] -> [a]
++ [Part
"will now last"]
            [Part] -> [Part] -> [Part]
forall a. [a] -> [a] -> [a]
++ [Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ Delta Time -> Text
timeDeltaInSecondsText Delta Time
delta Text -> Text -> Text
<+> Text
"longer"]
            [Part] -> [Part] -> [Part]
forall a. [a] -> [a] -> [a]
++ [Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ Text
"(total:" Text -> Text -> Text
<+> Delta Time -> Text
timeDeltaInSecondsText Delta Time
total Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"]
          -- Note that when enemy actor causes the extension to himself,
          -- the player is not notified at all. So the shorter blurb
          -- displayed on the screen is middle ground and full is in history.
          themShow =
            [Int
-> FactionId
-> FactionDict
-> Part
-> Time
-> ItemFull
-> ItemQuant
-> Part
partItemShortWownW Int
rwidth FactionId
side FactionDict
factionD (ActorUI -> Part
partActor ActorUI
bUI) Time
localTime
                                ItemFull
itemFull ItemQuant
quantSingle]
            [Part] -> [Part] -> [Part]
forall a. [a] -> [a] -> [a]
++ [Part]
cond [Part] -> [Part] -> [Part]
forall a. [a] -> [a] -> [a]
++ [Part
"is extended"]
          themSave =
            [Int
-> FactionId
-> FactionDict
-> Part
-> Time
-> ItemFull
-> ItemQuant
-> Part
partItemShortWownW Int
rwidth FactionId
side FactionDict
factionD (ActorUI -> Part
partActor ActorUI
bUI) Time
localTime
                                ItemFull
itemFull ItemQuant
quantSingle]
            [Part] -> [Part] -> [Part]
forall a. [a] -> [a] -> [a]
++ [Part]
cond [Part] -> [Part] -> [Part]
forall a. [a] -> [a] -> [a]
++ [Part
"is extended by"]
            [Part] -> [Part] -> [Part]
forall a. [a] -> [a] -> [a]
++ [Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ Delta Time -> Text
timeDeltaInSecondsText Delta Time
delta]
            [Part] -> [Part] -> [Part]
forall a. [a] -> [a] -> [a]
++ [Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ Text
"(total:" Text -> Text -> Text
<+> Delta Time -> Text
timeDeltaInSecondsText Delta Time
total Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"]
          (msgClass, parts1, parts2) =
            if bfid b == side
            then (MsgStatusLongerUs, usShow, usSave)
            else (MsgStatusLongThem, themShow, themSave)
      return $ Just $ Right
        (msgClass, (makeSentence parts1, makeSentence parts2))
    else return Nothing
  SfxCollideActor ActorId
source ActorId
target -> do
    sourceSeen <- (State -> Bool) -> m Bool
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Bool) -> m Bool) -> (State -> Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ ActorId -> EnumMap ActorId Actor -> Bool
forall k a. Enum k => k -> EnumMap k a -> Bool
EM.member ActorId
source (EnumMap ActorId Actor -> Bool)
-> (State -> EnumMap ActorId Actor) -> State -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap ActorId Actor
sactorD
    targetSeen <- getsState $ EM.member target . sactorD
    if sourceSeen && targetSeen then do
      spart <- partActorLeader source
      tpart <- partActorLeader target
      -- Neutral message, because minor damage and we don't say, which faction.
      -- And the collision may even be intentional.
      returnJustLeft
        ( MsgSpecialEvent
        , makeSentence
            [MU.SubjectVerbSg spart "collide", "awkwardly with", tpart] )
    else return Nothing
  SfxItemYield ItemId
iid Int
k LevelId
lid -> do
    iidSeen <- (State -> Bool) -> m Bool
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Bool) -> m Bool) -> (State -> Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ ItemId -> ItemDict -> Bool
forall k a. Enum k => k -> EnumMap k a -> Bool
EM.member ItemId
iid (ItemDict -> Bool) -> (State -> ItemDict) -> State -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> ItemDict
sitemD
    if iidSeen then do
      let fakeKit = ItemQuant
quantSingle
          fakeC = LevelId -> Point -> Container
CFloor LevelId
lid Point
originPoint
          verb = Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ Text
"yield" Text -> Text -> Text
<+> [Part] -> Text
makePhrase [Int -> Part -> Part
MU.CardinalAWs Int
k Part
"item"]
      msg <- itemVerbMUGeneral False iid fakeKit verb fakeC
      returnJustLeft (MsgSpecialEvent, msg)  -- differentiate wrt item creation
    else return Nothing

strike :: MonadClientUI m => Bool -> ActorId -> ActorId -> ItemId -> m ()
strike :: forall (m :: * -> *).
MonadClientUI m =>
Bool -> ActorId -> ActorId -> ItemId -> m ()
strike Bool
catch ActorId
source ActorId
target ItemId
iid = Bool -> m () -> m ()
forall a. HasCallStack => Bool -> a -> a
assert (ActorId
source ActorId -> ActorId -> Bool
forall a. Eq a => a -> a -> Bool
/= ActorId
target) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
  sourceSeen <- (State -> Bool) -> m Bool
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Bool) -> m Bool) -> (State -> Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ ActorId -> EnumMap ActorId Actor -> Bool
forall k a. Enum k => k -> EnumMap k a -> Bool
EM.member ActorId
source (EnumMap ActorId Actor -> Bool)
-> (State -> EnumMap ActorId Actor) -> State -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap ActorId Actor
sactorD
  if not sourceSeen then do
    tb <- getsState $ getActorBody target
    animate (blid tb) $ blockMiss (bpos tb, bpos tb)
  else do
    CCUI{coscreen=ScreenContent{rwidth}} <- getsSession sccui
    tb <- getsState $ getActorBody target
    hurtMult <- getsState $ armorHurtBonus source target
    sb <- getsState $ getActorBody source
    sMaxSk <- getsState $ getActorMaxSkills source
    spart <- partActorLeader source
    tpart <- partActorLeader target
    spronoun <- partPronounLeader source
    tpronoun <- partPronounLeader target
    tbUI <- getsSession $ getActorUI target
    localTime <- getsState $ getLocalTime (blid tb)
    itemFullWeapon <- getsState $ itemToFull iid
    let kitWeapon = ItemQuant
quantSingle
    side <- getsClient sside
    factionD <- getsState sfactionD
    tfact <- getsState $ (EM.! bfid tb) . sfactionD
    eqpOrgKit <- getsState $ kitAssocs target [CEqp, COrgan]
    orgKit <- getsState $ kitAssocs target [COrgan]
    let isCond (a
_, (ItemFull
itemFullArmor, b
_)) =
          Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Condition (AspectRecord -> Bool) -> AspectRecord -> Bool
forall a b. (a -> b) -> a -> b
$ ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFullArmor
        -- We exclude genetic flaws, backstory items, etc., because they
        -- can't be easily taken off, so no point spamming the player.
        isOrdinaryCond ikit :: (a, (ItemFull, b))
ikit@(a
_, (ItemFull
itemFullArmor, b
_)) =
          Bool -> Bool
not (Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.MetaGame (ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFullArmor))
          Bool -> Bool -> Bool
&& (a, (ItemFull, b)) -> Bool
forall {a} {b}. (a, (ItemFull, b)) -> Bool
isCond (a, (ItemFull, b))
ikit
        relevantSkArmor =
          if Actor -> Bool
bproj Actor
sb then Skill
Ability.SkArmorRanged else Skill
Ability.SkArmorMelee
        rateArmor (ItemId
iidArmor, (ItemFull
itemFullArmor, (Int
k, [ItemTimer]
_))) =
          ( Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
* Skill -> AspectRecord -> Int
IA.getSkill Skill
relevantSkArmor (ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFullArmor)
          , ( ItemId
iidArmor
            , ItemFull
itemFullArmor ) )
        abs15 (a
v, b
_) = a -> a
forall a. Num a => a -> a
abs a
v a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
15
        condArmor = ((Int, (ItemId, ItemFull)) -> Bool)
-> [(Int, (ItemId, ItemFull))] -> [(Int, (ItemId, ItemFull))]
forall a. (a -> Bool) -> [a] -> [a]
filter (Int, (ItemId, ItemFull)) -> Bool
forall {a} {b}. (Ord a, Num a) => (a, b) -> Bool
abs15 ([(Int, (ItemId, ItemFull))] -> [(Int, (ItemId, ItemFull))])
-> [(Int, (ItemId, ItemFull))] -> [(Int, (ItemId, ItemFull))]
forall a b. (a -> b) -> a -> b
$ ((ItemId, ItemFullKit) -> (Int, (ItemId, ItemFull)))
-> [(ItemId, ItemFullKit)] -> [(Int, (ItemId, ItemFull))]
forall a b. (a -> b) -> [a] -> [b]
map (ItemId, ItemFullKit) -> (Int, (ItemId, ItemFull))
rateArmor ([(ItemId, ItemFullKit)] -> [(Int, (ItemId, ItemFull))])
-> [(ItemId, ItemFullKit)] -> [(Int, (ItemId, ItemFull))]
forall a b. (a -> b) -> a -> b
$ ((ItemId, ItemFullKit) -> Bool)
-> [(ItemId, ItemFullKit)] -> [(ItemId, ItemFullKit)]
forall a. (a -> Bool) -> [a] -> [a]
filter (ItemId, ItemFullKit) -> Bool
forall {a} {b}. (a, (ItemFull, b)) -> Bool
isOrdinaryCond [(ItemId, ItemFullKit)]
orgKit
        fstGt0 (a
v, b
_) = a
v a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
0
        wornArmor =
          ((Int, (ItemId, ItemFull)) -> Bool)
-> [(Int, (ItemId, ItemFull))] -> [(Int, (ItemId, ItemFull))]
forall a. (a -> Bool) -> [a] -> [a]
filter (Int, (ItemId, ItemFull)) -> Bool
forall {a} {b}. (Ord a, Num a) => (a, b) -> Bool
fstGt0 ([(Int, (ItemId, ItemFull))] -> [(Int, (ItemId, ItemFull))])
-> [(Int, (ItemId, ItemFull))] -> [(Int, (ItemId, ItemFull))]
forall a b. (a -> b) -> a -> b
$ ((ItemId, ItemFullKit) -> (Int, (ItemId, ItemFull)))
-> [(ItemId, ItemFullKit)] -> [(Int, (ItemId, ItemFull))]
forall a b. (a -> b) -> [a] -> [b]
map (ItemId, ItemFullKit) -> (Int, (ItemId, ItemFull))
rateArmor ([(ItemId, ItemFullKit)] -> [(Int, (ItemId, ItemFull))])
-> [(ItemId, ItemFullKit)] -> [(Int, (ItemId, ItemFull))]
forall a b. (a -> b) -> a -> b
$ ((ItemId, ItemFullKit) -> Bool)
-> [(ItemId, ItemFullKit)] -> [(ItemId, ItemFullKit)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((ItemId, ItemFullKit) -> Bool) -> (ItemId, ItemFullKit) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ItemId, ItemFullKit) -> Bool
forall {a} {b}. (a, (ItemFull, b)) -> Bool
isCond) [(ItemId, ItemFullKit)]
eqpOrgKit
    mblockArmor <- case wornArmor of
      [] -> Maybe (ItemId, ItemFull) -> m (Maybe (ItemId, ItemFull))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (ItemId, ItemFull)
forall a. Maybe a
Nothing
      [(Int, (ItemId, ItemFull))]
_ -> (ItemId, ItemFull) -> Maybe (ItemId, ItemFull)
forall a. a -> Maybe a
Just
           ((ItemId, ItemFull) -> Maybe (ItemId, ItemFull))
-> m (ItemId, ItemFull) -> m (Maybe (ItemId, ItemFull))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Rnd (ItemId, ItemFull) -> m (ItemId, ItemFull)
forall (m :: * -> *) a. MonadClientUI m => Rnd a -> m a
rndToActionUI (Frequency (ItemId, ItemFull) -> Rnd (ItemId, ItemFull)
forall a. Show a => Frequency a -> Rnd a
frequency (Frequency (ItemId, ItemFull) -> Rnd (ItemId, ItemFull))
-> Frequency (ItemId, ItemFull) -> Rnd (ItemId, ItemFull)
forall a b. (a -> b) -> a -> b
$ Text -> [(Int, (ItemId, ItemFull))] -> Frequency (ItemId, ItemFull)
forall a. Text -> [(Int, a)] -> Frequency a
toFreq Text
"msg armor" [(Int, (ItemId, ItemFull))]
wornArmor)
    actorMaxSkills <- getsState sactorMaxSkills
    let (blockWithWhat, blockWithWeapon) = case mblockArmor of
          Just (ItemId
iidArmor, ItemFull
itemFullArmor) | ItemId
iidArmor ItemId -> ItemId -> Bool
forall a. Eq a => a -> a -> Bool
/= Actor -> ItemId
btrunk Actor
tb ->
            let (Part
object1, Part
object2) =
                  Int
-> FactionId
-> FactionDict
-> Time
-> ItemFull
-> ItemQuant
-> (Part, Part)
partItemShortest Int
rwidth (Actor -> FactionId
bfid Actor
tb) FactionDict
factionD Time
localTime
                                   ItemFull
itemFullArmor ItemQuant
quantSingle
                name :: Part
name = [Part] -> Part
MU.Phrase [Part
object1, Part
object2]
            in ( [Part
"with", Part -> Part -> Part
MU.WownW Part
tpronoun Part
name]
               , Dice -> Int
Dice.supDice (ItemKind -> Dice
IK.idamage (ItemKind -> Dice) -> ItemKind -> Dice
forall a b. (a -> b) -> a -> b
$ ItemFull -> ItemKind
itemKind ItemFull
itemFullArmor) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 )
          Maybe (ItemId, ItemFull)
_ -> ([], Bool
False)
        verb = Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ ItemKind -> Text
IK.iverbHit (ItemKind -> Text) -> ItemKind -> Text
forall a b. (a -> b) -> a -> b
$ ItemFull -> ItemKind
itemKind ItemFull
itemFullWeapon
        partItemChoice =
          if ItemId
iid ItemId -> EnumMap ItemId ItemQuant -> Bool
forall k a. Enum k => k -> EnumMap k a -> Bool
`EM.member` Actor -> EnumMap ItemId ItemQuant
borgan Actor
sb
          then Int
-> FactionId
-> FactionDict
-> Part
-> Time
-> ItemFull
-> ItemQuant
-> Part
partItemShortWownW Int
rwidth FactionId
side FactionDict
factionD Part
spronoun Time
localTime
          else Int
-> FactionId
-> FactionDict
-> Time
-> ItemFull
-> ItemQuant
-> Part
partItemShortAW Int
rwidth FactionId
side FactionDict
factionD Time
localTime
        weaponNameWith = if ItemId
iid ItemId -> ItemId -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> ItemId
btrunk Actor
sb
                         then []
                         else [Part
"with", ItemFull -> ItemQuant -> Part
partItemChoice ItemFull
itemFullWeapon ItemQuant
kitWeapon]
        sleepy = if Actor -> Watchfulness
bwatch Actor
tb Watchfulness -> [Watchfulness] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Watchfulness
WSleep, Watchfulness
WWake]
                    Bool -> Bool -> Bool
&& Part
tpart Part -> Part -> Bool
forall a. Eq a => a -> a -> Bool
/= Part
"you"
                    Bool -> Bool -> Bool
&& Actor -> Int64
bhp Actor
tb Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
0
                 then Part
"the sleepy"
                 else Part
""
        unBurn (IK.Burn Dice
d) = Dice -> Maybe Dice
forall a. a -> Maybe a
Just Dice
d
        unBurn Effect
_ = Maybe Dice
forall a. Maybe a
Nothing
        unRefillHP (IK.RefillHP Int
n) | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = Int -> Maybe Int
forall a. a -> Maybe a
Just (-Int
n)
        unRefillHP Effect
_ = Maybe Int
forall a. Maybe a
Nothing
        kineticDmg =
          let dmg :: Int
dmg = Dice -> Int
Dice.supDice (Dice -> Int) -> Dice -> Int
forall a b. (a -> b) -> a -> b
$ ItemKind -> Dice
IK.idamage (ItemKind -> Dice) -> ItemKind -> Dice
forall a b. (a -> b) -> a -> b
$ ItemFull -> ItemKind
itemKind ItemFull
itemFullWeapon
              rawDeltaHP :: Int64
rawDeltaHP = forall target source. From source target => source -> target
into @Int64 Int
sHurt Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int -> Int64
xM Int
dmg Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`divUp` Int64
100
          in case Actor -> Maybe ([Vector], Speed)
btrajectory Actor
sb of
            Just ([Vector]
_, Speed
speed) | Actor -> Bool
bproj Actor
sb ->
              - Int64 -> Speed -> Int64
modifyDamageBySpeed Int64
rawDeltaHP Speed
speed
            Maybe ([Vector], Speed)
_ -> - Int64
rawDeltaHP
        burnDmg = - ([Int] -> Int
forall a. Num a => [a] -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (Dice -> Int) -> [Dice] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Dice -> Int
Dice.supDice
                     ([Dice] -> [Int]) -> [Dice] -> [Int]
forall a b. (a -> b) -> a -> b
$ (Effect -> Maybe Dice) -> [Effect] -> [Dice]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Effect -> Maybe Dice
unBurn ([Effect] -> [Dice]) -> [Effect] -> [Dice]
forall a b. (a -> b) -> a -> b
$ ItemKind -> [Effect]
IK.ieffects (ItemKind -> [Effect]) -> ItemKind -> [Effect]
forall a b. (a -> b) -> a -> b
$ ItemFull -> ItemKind
itemKind ItemFull
itemFullWeapon)
        fillDmg =
          - ([Int] -> Int
forall a. Num a => [a] -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (Effect -> Maybe Int) -> [Effect] -> [Int]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Effect -> Maybe Int
unRefillHP ([Effect] -> [Int]) -> [Effect] -> [Int]
forall a b. (a -> b) -> a -> b
$ ItemKind -> [Effect]
IK.ieffects (ItemKind -> [Effect]) -> ItemKind -> [Effect]
forall a b. (a -> b) -> a -> b
$ ItemFull -> ItemKind
itemKind ItemFull
itemFullWeapon)
        -- For variety, attack adverb is based on attacker's and weapon's
        -- damage potential as compared to victim's current HP.
        -- We are not taking into account victim's armor yet.
        sHurt = Bool -> Skills -> Skills -> Int
armorHurtCalculation (Actor -> Bool
bproj Actor
sb) Skills
sMaxSk Skills
Ability.zeroSkills
        nonPiercingDmg = Int
burnDmg Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
fillDmg
        sDamage = Int64 -> Int64 -> Int64
forall a. Ord a => a -> a -> a
min Int64
0 (Int64 -> Int64) -> Int64 -> Int64
forall a b. (a -> b) -> a -> b
$ Int64
kineticDmg Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int -> Int64
xM Int
nonPiercingDmg
        deadliness = Int64
1000 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* (- Int64
sDamage) Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`div` Int64 -> Int64 -> Int64
forall a. Ord a => a -> a -> a
max Int64
1 (Actor -> Int64
bhp Actor
tb)
        strongly
          | Int64
deadliness Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int64
10000 = Part
"artfully"
          | Int64
deadliness Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int64
5000 = Part
"madly"
          | Int64
deadliness Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int64
2000 = Part
"mercilessly"
          | Int64
deadliness Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int64
1000 = Part
"murderously"  -- one blow can wipe out all HP
          | Int64
deadliness Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int64
700 = Part
"devastatingly"
          | Int64
deadliness Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int64
500 = Part
"vehemently"
          | Int64
deadliness Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int64
400 = Part
"forcefully"
          | Int64
deadliness Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int64
350 = Part
"sturdily"
          | Int64
deadliness Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int64
300 = Part
"accurately"
          | Int64
deadliness Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int64
20 = Part
""  -- common, terse case, between 2% and 30%
          | Int64
deadliness Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int64
10 = Part
"cautiously"
          | Int64
deadliness Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int64
5 = Part
"guardedly"
          | Int64
deadliness Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int64
3 = Part
"hesitantly"
          | Int64
deadliness Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int64
2 = Part
"clumsily"
          | Int64
deadliness Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int64
1 = Part
"haltingly"
          | Bool
otherwise = Part
"feebly"
        -- Here we take into account armor, so we look at @hurtMult@,
        -- so we finally convey the full info about effectiveness of the strike.
        blockHowWell  -- under some conditions, the message not shown at all
          | Int
hurtMult Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
90 = Part
"incompetently"
          | Int
hurtMult Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
80 = Part
"too late"
          | Int
hurtMult Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
70 = Part
"too slowly"
          | Int
hurtMult Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
20 Bool -> Bool -> Bool
|| Int
nonPiercingDmg Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 =
                            if | Int64
deadliness Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int64
2000 -> Part
"marginally"
                               | Int64
deadliness Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int64
1000 -> Part
"partially"
                               | Int64
deadliness Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int64
100 -> Part
"partly"  -- common
                               | Int64
deadliness Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int64
50 -> Part
"to an extent"
                               | Int64
deadliness Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int64
20 -> Part
"to a large extent"
                               | Int64
deadliness Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int64
5 -> Part
"for the major part"
                               | Bool
otherwise -> Part
"for the most part"
          | Int
hurtMult Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 = if | Actor -> Bool
actorWaits Actor
tb -> Part
"doggedly"
                              | Int64
deadliness Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int64
50 -> Part
"easily"  -- common
                              | Int64
deadliness Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int64
20 -> Part
"effortlessly"
                              | Int64
deadliness Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int64
5 -> Part
"nonchalantly"
                              | Bool
otherwise -> Part
"bemusedly"
          | Bool
otherwise = Part
"almost completely"
              -- a fraction gets through, but if fast missile, can be deadly
        avertVerb = if Actor -> Bool
actorWaits Actor
tb then Part
"avert it" else Part
"ward it off"
        blockPhrase =
          let (Part
subjectBlock, Part
verbBlock) =
                if | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Actor -> Bool
bproj Actor
sb ->
                     (Part
tpronoun, if Bool
blockWithWeapon
                                then Part
"parry"
                                else Part
"block")
                   | Part
tpronoun Part -> Part -> Bool
forall a. Eq a => a -> a -> Bool
== Part
"it"
                     Bool -> Bool -> Bool
|| Bool
projectileHitsWeakly Bool -> Bool -> Bool
&& Part
tpronoun Part -> Part -> Bool
forall a. Eq a => a -> a -> Bool
/= Part
"you" ->
                     -- Avoid ambiguity.
                     (ActorUI -> Part
partActor ActorUI
tbUI, Part
avertVerb)
                   | Bool
otherwise -> (Part
tpronoun, Part
avertVerb)
          in Part -> Part -> Part
MU.SubjectVerbSg Part
subjectBlock Part
verbBlock
        surprisinglyGoodDefense = Int64
deadliness Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int64
20 Bool -> Bool -> Bool
&& Int
hurtMult Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
70
        surprisinglyBadDefense = Int64
deadliness Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int64
20 Bool -> Bool -> Bool
&& Int
hurtMult Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
70
        yetButAnd
          | Bool
surprisinglyGoodDefense = Text
", but"
          | Bool
surprisinglyBadDefense = Text
", yet"
          | Bool
otherwise = Text
" and"  -- no surprises
        projectileHitsWeakly = Actor -> Bool
bproj Actor
sb Bool -> Bool -> Bool
&& Int64
deadliness Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int64
20
        msgArmor = if Bool -> Bool
not Bool
projectileHitsWeakly
                        -- ensures if attack msg terse, armor message
                        -- mentions object, so we know who is hit
                      Bool -> Bool -> Bool
&& Int
hurtMult Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
90
                        -- at most minor armor relatively to skill of the hit
                      Bool -> Bool -> Bool
&& ([(Int, (ItemId, ItemFull))] -> Bool
forall a. [a] -> Bool
null [(Int, (ItemId, ItemFull))]
condArmor Bool -> Bool -> Bool
|| Int64
deadliness Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int64
100)
                      Bool -> Bool -> Bool
|| [Part] -> Bool
forall a. [a] -> Bool
null [Part]
blockWithWhat
                      Bool -> Bool -> Bool
|| Int64
kineticDmg Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= -Int64
1000  -- -1/1000 HP
                   then Text
""
                   else Text
yetButAnd
                        Text -> Text -> Text
<+> [Part] -> Text
makePhrase ([Part
blockPhrase, Part
blockHowWell]
                                        [Part] -> [Part] -> [Part]
forall a. [a] -> [a] -> [a]
++ [Part]
blockWithWhat)
        ps = (Actor -> Point
bpos Actor
tb, Actor -> Point
bpos Actor
sb)
        basicAnim
          | Int
hurtMult Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
70 = (Point, Point) -> Color -> Color -> Animation
twirlSplash (Point, Point)
ps Color
Color.BrRed Color
Color.Red
          | Int
hurtMult Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 = if Int
nonPiercingDmg Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0  -- no extra anim
                           then (Point, Point) -> Color -> Color -> Animation
blockHit (Point, Point)
ps Color
Color.BrRed Color
Color.Red
                           else (Point, Point) -> Animation
blockMiss (Point, Point)
ps
          | Bool
otherwise = (Point, Point) -> Animation
blockMiss (Point, Point)
ps
        targetIsFoe = Actor -> FactionId
bfid Actor
sb FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side  -- no big news if others hit our foes
                      Bool -> Bool -> Bool
&& FactionId -> Faction -> FactionId -> Bool
isFoe (Actor -> FactionId
bfid Actor
tb) Faction
tfact FactionId
side
        targetIsFriend = FactionId -> Faction -> FactionId -> Bool
isFriend (Actor -> FactionId
bfid Actor
tb) Faction
tfact FactionId
side
                           -- warning if anybody hits our friends
        msgClassMelee =
          if Bool
targetIsFriend then MsgClassShowAndSave
MsgMeleeNormalUs else MsgClassShowAndSave
MsgMeleeOthers
        msgClassRanged =
          if Bool
targetIsFriend then MsgClassShowAndSave
MsgRangedNormalUs else MsgClassShowAndSave
MsgRangedOthers
        animateAlive LevelId
lid Animation
anim =
          if Actor -> Int64
bhp Actor
tb Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
0
          then LevelId -> Animation -> m ()
forall (m :: * -> *).
MonadClientUI m =>
LevelId -> Animation -> m ()
animate LevelId
lid Animation
anim
          else LevelId -> Animation -> m ()
forall (m :: * -> *).
MonadClientUI m =>
LevelId -> Animation -> m ()
animate LevelId
lid (Animation -> m ()) -> Animation -> m ()
forall a b. (a -> b) -> a -> b
$ (Point, Point) -> Color -> Color -> Animation
twirlSplashShort (Point, Point)
ps Color
Color.BrRed Color
Color.Red
        tutorialHintBenignFoe =
          Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Actor -> FactionId
bfid Actor
sb FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side
                Bool -> Bool -> Bool
&& Bool -> Bool
not (ActorMaxSkills -> ActorId -> Actor -> Bool
actorCanMeleeToHarm ActorMaxSkills
actorMaxSkills ActorId
target Actor
tb)) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
            TutorialHints -> m ()
forall (m :: * -> *). MonadClientUI m => TutorialHints -> m ()
tutorialHintMsgAdd TutorialHints
CannotHarmYouInMelee
    -- The messages about parrying and immediately afterwards dying
    -- sound goofy, but there is no easy way to prevent that.
    -- And it's consistent.
    -- If/when death blow instead sets HP to 1 and only the next below 1,
    -- we can check here for HP==1; also perhaps actors with HP 1 should
    -- not be able to block.
    if | catch -> do  -- charge not needed when catching
         let msg = [Part] -> Text
makeSentence
                     [Part -> Part -> Part
MU.SubjectVerbSg Part
spart Part
"catch", Part
tpart, Part
"skillfully"]
         msgAdd MsgSpecialEvent msg
         when (bfid sb == side) $
           tutorialHintMsgAdd CaughtProjectile
         animate (blid tb) $ blockHit ps Color.BrGreen Color.Green
       | not (hasCharge localTime kitWeapon) -> do
         -- Can easily happen with a thrown discharged item.
         -- Much less plausible with a wielded weapon.
         -- Theoretically possible if the weapon not identified
         -- (then timeout is a mean estimate), but they usually should be,
         -- even in foes' possession.
         let msg = if Actor -> Bool
bproj Actor
sb
                   then [Part] -> Text
makePhrase
                          [Part -> Part
MU.Capitalize (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ Part -> Part -> Part
MU.SubjectVerbSg Part
spart Part
"connect"]
                        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", but it may be completely discharged."
                   else [Part] -> Text
makePhrase
                          ([ Part -> Part
MU.Capitalize (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ Part -> Part -> Part
MU.SubjectVerbSg Part
spart Part
"try"
                           , Part
"to"
                           , Part
verb
                           , Part
tpart ]
                           [Part] -> [Part] -> [Part]
forall a. [a] -> [a] -> [a]
++ [Part]
weaponNameWith)
                        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> if [Part] -> Bool
forall a. [a] -> Bool
null [Part]
weaponNameWith
                           then Text
", but there are no charges left."
                           else Text
", but it may be not readied yet."
         msgAdd MsgSpecialEvent msg  -- and no animation
       | bproj sb && bproj tb -> do  -- server sends unless both are blasts
         -- Short message.
         msgAdd MsgSpecialEvent $
           makeSentence [MU.SubjectVerbSg spart "intercept", tpart]
         -- Basic non-bloody animation regardless of stats.
         animateAlive (blid tb) $ blockHit ps Color.BrBlue Color.Blue
       | kineticDmg >= -1000  -- -1/1000 HP
         -- We ignore nested effects, because they are, in general, avoidable.
         && nonPiercingDmg >= 0 -> do
         let adverb | ItemFull -> Bool
itemSuspect ItemFull
itemFullWeapon Bool -> Bool -> Bool
&& Actor -> FactionId
bfid Actor
sb FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side =
                        Part
"tentatively"  -- we didn't identify the weapon before
                    | Actor -> Bool
bproj Actor
sb = Part
"lightly"
                    | Bool
otherwise = Part
"delicately"
             msg = [Part] -> Text
makeSentence ([Part] -> Text) -> [Part] -> Text
forall a b. (a -> b) -> a -> b
$
               [Part -> Part -> Part
MU.SubjectVerbSg Part
spart Part
verb, Part
tpart, Part
adverb]
               [Part] -> [Part] -> [Part]
forall a. [a] -> [a] -> [a]
++ if Actor -> Bool
bproj Actor
sb then [] else [Part]
weaponNameWith
         msgAdd msgClassMelee msg  -- too common for color
         when (bfid sb == side || bfid tb == side) $
           tutorialHintMsgAdd HitsWithNoDirectDamage
         animate (blid tb) $ subtleHit ps
       | bproj sb -> do  -- more terse than melee, because sometimes very spammy
         let msgRangedPowerful | Bool
targetIsFoe = MsgClassShowAndSave
MsgRangedMightyWe
                               | Bool
targetIsFriend = MsgClassShowAndSave
MsgRangedMightyUs
                               | Bool
otherwise = MsgClassShowAndSave
msgClassRanged
             (attackParts, msgRanged)
               | projectileHitsWeakly =
                 ( [MU.SubjectVerbSg spart "connect"]  -- weak, so terse
                 , msgClassRanged )
               | deadliness >= 300 =
                 ( [MU.SubjectVerbSg spart verb, tpart, "powerfully"]
                 , if targetIsFriend || deadliness >= 700
                   then msgRangedPowerful
                   else msgClassRanged )
               | otherwise =
                 ( [MU.SubjectVerbSg spart verb, tpart]  -- strong, for a proj
                 , msgClassRanged )
         msgAdd msgRanged $ makePhrase [MU.Capitalize $ MU.Phrase attackParts]
                            <> msgArmor <> "."
         tutorialHintBenignFoe
         animateAlive (blid tb) basicAnim
       | bproj tb -> do  -- much less emotion and the victim not active.
         let attackParts =
               [Part -> Part -> Part
MU.SubjectVerbSg Part
spart Part
verb, Part
tpart] [Part] -> [Part] -> [Part]
forall a. [a] -> [a] -> [a]
++ [Part]
weaponNameWith
         msgAdd MsgMeleeOthers $ makeSentence attackParts
         animateAlive (blid tb) basicAnim
       | otherwise -> do  -- ordinary melee
         let msgMeleeInteresting | Bool
targetIsFoe = MsgClassShowAndSave
MsgMeleeComplexWe
                                 | Bool
targetIsFriend = MsgClassShowAndSave
MsgMeleeComplexUs
                                 | Bool
otherwise = MsgClassShowAndSave
msgClassMelee
             msgMeleePowerful | Bool
targetIsFoe = MsgClassShowAndSave
MsgMeleeMightyWe
                              | Bool
targetIsFriend = MsgClassShowAndSave
MsgMeleeMightyUs
                              | Bool
otherwise = MsgClassShowAndSave
msgClassMelee
             attackParts =
               [Part -> Part -> Part
MU.SubjectVerbSg Part
spart Part
verb, Part
sleepy, Part
tpart, Part
strongly]
               [Part] -> [Part] -> [Part]
forall a. [a] -> [a] -> [a]
++ [Part]
weaponNameWith
             (tmpInfluenceBlurb, msgClassInfluence) =
               if null condArmor || T.null msgArmor
               then ("", msgClassMelee)
               else
                 let (armor, (_, itemFullArmor)) =
                       maximumBy (comparing $ abs . fst) condArmor
                     (object1, object2) =
                       partItemShortest rwidth (bfid tb) factionD localTime
                                        itemFullArmor quantSingle
                     name = [Part] -> Text
makePhrase [Part
object1, Part
object2]
                     msgText =
                       if Int
hurtMult Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
70
                       then (if Int
armor Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= -Int
15
                             then Text
", due to being"
                             else Bool -> Text -> Text
forall a. HasCallStack => Bool -> a -> a
assert (Int
armor Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
15) Text
", regardless of being")
                            Text -> Text -> Text
<+> Text
name
                       else (if Int
armor Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
15
                             then Text
", thanks to being"
                             else Bool -> Text -> Text
forall a. HasCallStack => Bool -> a -> a
assert (Int
armor Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= -Int
15) Text
", despite being")
                            Text -> Text -> Text
<+> Text
name
                 in (msgText, msgMeleeInteresting)
             msgClass = if Bool
targetIsFriend Bool -> Bool -> Bool
&& Int64
deadliness Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int64
300
                           Bool -> Bool -> Bool
|| Int64
deadliness Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int64
2000
                        then MsgClassShowAndSave
msgMeleePowerful
                        else MsgClassShowAndSave
msgClassInfluence
         msgAdd msgClass $ makePhrase [MU.Capitalize $ MU.Phrase attackParts]
                           <> msgArmor <> tmpInfluenceBlurb <> "."
         tutorialHintBenignFoe
         animateAlive (blid tb) basicAnim