-- | Display atomic commands received by the client.
module Game.LambdaHack.Client.UI.DisplayAtomicM
  ( displayRespUpdAtomicUI, displayRespSfxAtomicUI
#ifdef EXPOSE_INTERNAL
    -- * Internal operations
  , updateItemSlot, markDisplayNeeded, updateItemSlotSide, lookAtMove
  , actorVerbMU, aidVerbMU, itemVerbMU, itemAidVerbMU, msgDuplicateScrap
  , createActorUI, destroyActorUI, spotItem, moveActor, displaceActorUI
  , moveItemUI, quitFactionUI, discover, ppSfxMsg, setLastSlot, strike
#endif
  ) where

import Prelude ()

import Game.LambdaHack.Common.Prelude

import qualified Data.Char as Char
import qualified Data.EnumMap.Strict as EM
import qualified Data.EnumSet as ES
import           Data.Key (mapWithKeyM_)
import qualified Data.Map.Strict as M
import           Data.Tuple
import           GHC.Exts (inline)
import qualified NLP.Miniutter.English as MU

import           Game.LambdaHack.Atomic
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.FrameM
import           Game.LambdaHack.Client.UI.HandleHelperM
import           Game.LambdaHack.Client.UI.ItemDescription
import           Game.LambdaHack.Client.UI.ItemSlot
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.Overlay
import           Game.LambdaHack.Client.UI.SessionUI
import           Game.LambdaHack.Client.UI.Slideshow
import           Game.LambdaHack.Client.UI.SlideshowM
import           Game.LambdaHack.Client.UI.UIOptions
import           Game.LambdaHack.Common.Actor
import           Game.LambdaHack.Common.ActorState
import qualified Game.LambdaHack.Common.Color as Color
import qualified Game.LambdaHack.Common.Dice as Dice
import           Game.LambdaHack.Common.Faction
import           Game.LambdaHack.Common.Flavour
import           Game.LambdaHack.Common.Item
import qualified Game.LambdaHack.Common.Kind as 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 qualified Game.LambdaHack.Common.Tile as Tile
import           Game.LambdaHack.Common.Time
import qualified Game.LambdaHack.Content.ItemKind as IK
import           Game.LambdaHack.Content.ModeKind
import           Game.LambdaHack.Content.RuleKind
import qualified Game.LambdaHack.Content.TileKind as TK

-- * RespUpdAtomicUI

-- | Visualize atomic updates sent to the client. This is done
-- in the global state after the command is executed and after
-- the client state is modified by the command.
displayRespUpdAtomicUI :: MonadClientUI m => Bool -> UpdAtomic -> m ()
{-# INLINE displayRespUpdAtomicUI #-}
displayRespUpdAtomicUI verbose cmd = case cmd of
  -- Create/destroy actors and items.
  UpdCreateActor aid body _ -> createActorUI True aid body
  UpdDestroyActor aid body _ -> destroyActorUI True aid body
  UpdCreateItem iid _ kit c -> do
    case c of
      CActor aid store -> do
        slastSlot <- updateItemSlotSide store aid iid
        case store of
          COrgan -> do
            bag <- getsState $ getContainerBag c
            let more = case EM.lookup iid bag of
                  Nothing -> False
                  Just kit2 -> fst kit2 /= fst kit
                verb = MU.Text $
                  "become" <+> case fst kit of
                                 1 -> if more then "more" else ""
                                 k -> if more then "additionally" else ""
                                      <+> tshow k <> "-fold"
            -- This describes all such items already among organs,
            -- which is useful, because it shows "charging".
            itemAidVerbMU aid verb iid (Left Nothing) COrgan
          _ -> do
            ownerFun <- partActorLeaderFun
            let wown = ppContainerWownW ownerFun True c
            itemVerbMU iid kit (MU.Text $ makePhrase $ "appear" : wown) c
            mleader <- getsClient sleader
            when (Just aid == mleader) $
              modifySession $ \sess -> sess {slastSlot}
      CEmbed lid _ -> markDisplayNeeded lid
      CFloor lid _ -> do
        -- If you want an item to be assigned to @slastSlot@, create it
        -- in @CActor aid CGround@, not in @CFloor@.
        void $ updateItemSlot CGround Nothing iid
        itemVerbMU iid kit (MU.Text $ "appear" <+> ppContainer c) c
        markDisplayNeeded lid
      CTrunk{} -> error $ "" `showFailure` c
    stopPlayBack
  UpdDestroyItem iid _ kit c -> do
    itemVerbMU iid kit "disappear" c
    lid <- getsState $ lidFromC c
    markDisplayNeeded lid
  UpdSpotActor aid body _ -> createActorUI False aid body
  UpdLoseActor aid body _ -> destroyActorUI False aid body
  UpdSpotItem verbose2 iid _ kit c -> spotItem verbose2 iid kit c
  {-
  UpdLoseItem False _ _ _ _ -> return ()
  -- The message is rather cryptic, so let's disable it until it's decided
  -- if anemy inventories should be displayed, etc.
  UpdLoseItem True iid _ kit c@(CActor aid store) | store /= CSha -> do
    -- Actor putting an item into shared stash, most probably.
    side <- getsClient sside
    b <- getsState $ getActorBody aid
    subject <- partActorLeader aid b
    let ownW = ppCStoreWownW store subject
        verb = MU.Text $ makePhrase $ "be removed from" : ownW
    when (bfid b == side) $ itemVerbMU iid kit verb c
  -}
  UpdLoseItem{} -> return ()
  UpdSpotItemBag c bag _ ->
    mapWithKeyM_ (\iid kit -> spotItem True iid kit c) bag
  UpdLoseItemBag{} -> return ()
  -- Move actors and items.
  UpdMoveActor aid source target -> moveActor aid source target
  UpdWaitActor aid _ -> when verbose $ aidVerbMU aid "wait"
  UpdDisplaceActor source target -> displaceActorUI source target
  UpdMoveItem iid k aid c1 c2 -> moveItemUI iid k aid c1 c2
  -- Change actor attributes.
  UpdRefillHP _ 0 -> return ()
  UpdRefillHP aid n -> do
    when verbose $
      aidVerbMU aid $ MU.Text $ (if n > 0 then "heal" else "lose")
                                <+> tshow (abs n `divUp` oneM) <> "HP"
    b <- getsState $ getActorBody aid
    bUI <- getsSession $ getActorUI aid
    arena <- getArenaUI
    side <- getsClient sside
    if | bproj b && (length (beqp b) == 0 || isNothing (btrajectory b)) ->
           return ()  -- ignore caught proj or one hitting a wall
       | bhp b <= 0 && n < 0
         && (bfid b == side && not (bproj b) || arena == blid b) -> do
         let (firstFall, hurtExtra) = case (bfid b == side, bproj b) of
               (True, True) -> ("drop down", "tumble down")
               (True, False) -> ("fall down", "fall to pieces")
               (False, True) -> ("plummet", "crash")
               (False, False) -> ("collapse", "be reduced to a bloody pulp")
             verbDie = if alreadyDeadBefore then hurtExtra else firstFall
             alreadyDeadBefore = bhp b - n <= 0
         subject <- partActorLeader aid bUI
         let msgDie = makeSentence [MU.SubjectVerbSg subject verbDie]
         msgAdd msgDie
         -- We show death anims only if not dead already before this refill.
         let deathAct | alreadyDeadBefore =
                        twirlSplash (bpos b, bpos b) Color.Red Color.Red
                      | bfid b == side = deathBody (bpos b)
                      | otherwise = shortDeathBody (bpos b)
         unless (bproj b) $ animate (blid b) deathAct
       | otherwise -> do
         when (n >= bhp b && bhp b > 0) $
           actorVerbMU aid bUI "return from the brink of death"
         mleader <- getsClient sleader
         when (Just aid == mleader) $ do
           ar <- getsState $ getActorAspect aid
           -- Regenerating actors never stop gaining HP, so we need to stop
           -- reporting it after they reach full HP for the first time.
           when (bhp b >= xM (aMaxHP ar) && bhp b - n < xM (aMaxHP ar)) $ do
             actorVerbMU aid bUI "recover your health fully"
             stopPlayBack
  UpdRefillCalm aid calmDelta ->
    when (calmDelta == minusM) $ do  -- lower deltas come from hits; obvious
      side <- getsClient sside
      fact <- getsState $ (EM.! side) . sfactionD
      body <- getsState $ getActorBody aid
      when (bfid body == side) $ do
        let closeFoe b =  -- mimics isHeardFoe
                     blid b == blid body
                     && chessDist (bpos b) (bpos body) <= 3  -- a bit costly
                     && not (waitedLastTurn b)  -- uncommon
                     && inline isAtWar fact (bfid b)  -- costly
        anyCloseFoes <- getsState $ any closeFoe . EM.elems . sactorD
        unless anyCloseFoes $ do  -- obvious where the feeling comes from
          aidVerbMU aid "hear something"
          duplicated <- msgDuplicateScrap
          unless duplicated stopPlayBack
  UpdTrajectory{} -> return ()  -- if projectile dies here, no display
  -- Change faction attributes.
  UpdQuitFaction fid _ toSt -> quitFactionUI fid toSt
  UpdLeadFaction fid (Just source) (Just target) -> do
    fact <- getsState $ (EM.! fid) . sfactionD
    lidV <- viewedLevelUI
    when (isAIFact fact) $ markDisplayNeeded lidV
    -- This faction can't run with multiple actors, so this is not
    -- a leader change while running, but rather server changing
    -- their leader, which the player should be alerted to.
    when (noRunWithMulti fact) stopPlayBack
    actorD <- getsState sactorD
    case EM.lookup source actorD of
      Just sb | bhp sb <= 0 -> assert (not $ bproj sb) $ do
        -- Regardless who the leader is, give proper names here, not 'you'.
        sbUI <- getsSession $ getActorUI source
        tbUI <- getsSession $ getActorUI target
        let subject = partActor tbUI
            object  = partActor sbUI
        msgAdd $ makeSentence [ MU.SubjectVerbSg subject "take command"
                              , "from", object ]
      _ -> return ()
    lookAtMove target
  UpdLeadFaction _ Nothing (Just target) -> lookAtMove target
  UpdLeadFaction{} -> return ()
  UpdDiplFaction fid1 fid2 _ toDipl -> do
    name1 <- getsState $ gname . (EM.! fid1) . sfactionD
    name2 <- getsState $ gname . (EM.! fid2) . sfactionD
    let showDipl Unknown = "unknown to each other"
        showDipl Neutral = "in neutral diplomatic relations"
        showDipl Alliance = "allied"
        showDipl War = "at war"
    msgAdd $ name1 <+> "and" <+> name2 <+> "are now" <+> showDipl toDipl <> "."
  UpdTacticFaction{} -> return ()
  UpdAutoFaction fid b -> do
    side <- getsClient sside
    lidV <- viewedLevelUI
    markDisplayNeeded lidV
    when (fid == side) $ setFrontAutoYes b
  UpdRecordKill{} -> return ()
  -- Alter map.
  UpdAlterTile lid p fromTile toTile -> do
    markDisplayNeeded lid
    Kind.COps{cotile=Kind.Ops{okind}} <- getsState scops
    let feats = TK.tfeature $ okind fromTile
        toAlter feat =
          case feat of
            TK.OpenTo tgroup -> Just tgroup
            TK.CloseTo tgroup -> Just tgroup
            TK.ChangeTo tgroup -> Just tgroup
            _ -> Nothing
        groupsToAlterTo = mapMaybe toAlter feats
        freq = map fst $ filter (\(_, q) -> q > 0) $ TK.tfreq $ okind toTile
    when (null $ intersect freq groupsToAlterTo) $ do
      -- Player notices @fromTile can't be altered into @toTIle@,
      -- which is uncanny, so we produce a message.
      -- This happens when the player missed an earlier search of the tile
      -- performed by another faction.
      let subject = ""  -- a hack, we we don't handle adverbs well
          verb = "turn into"
          msg = makeSentence [ "the", MU.Text $ TK.tname $ okind fromTile
                             , "at position", MU.Text $ tshow p
                             , "suddenly"  -- adverb
                             , MU.SubjectVerbSg subject verb
                             , MU.AW $ MU.Text $ TK.tname $ okind toTile ]
      msgAdd msg
  UpdAlterExplorable{} -> return ()
  UpdSearchTile aid _p toTile -> do
    Kind.COps{cotile = cotile@Kind.Ops{okind}} <- getsState scops
    subject <- partAidLeader aid
    let fromTile = fromJust $ Tile.hideAs cotile toTile
        subject2 = MU.Text $ TK.tname $ okind fromTile
        object = MU.Text $ TK.tname $ okind toTile
    let msg = makeSentence [ MU.SubjectVerbSg subject "reveal"
                           , "that the"
                           , MU.SubjectVerbSg subject2 "be"
                           , MU.AW object ]
    unless (subject2 == object) $ msgAdd msg
  UpdHideTile{} -> return ()
  UpdSpotTile{} -> return ()
  UpdLoseTile{} -> return ()
  UpdAlterSmell{} -> return ()
  UpdSpotSmell{} -> return ()
  UpdLoseSmell{} -> return ()
  -- Assorted.
  UpdTimeItem{} -> return ()
  UpdAgeGame{} -> do
    sdisplayNeeded <- getsSession sdisplayNeeded
    when sdisplayNeeded pushFrame
  UpdUnAgeGame{} -> return ()
  UpdDiscover c iid _ _ -> discover c iid
  UpdCover{} -> return ()  -- don't spam when doing undo
  UpdDiscoverKind{} -> return ()  -- don't spam when server tweaks stuff
  UpdCoverKind{} -> return ()  -- don't spam when doing undo
  UpdDiscoverSeed{} -> return ()  -- don't spam when server tweaks stuff
  UpdCoverSeed{} -> return ()  -- don't spam when doing undo
  UpdDiscoverServer{} -> error "server command leaked to client"
  UpdCoverServer{} -> error "server command leaked to client"
  UpdPerception{} -> return ()
  UpdRestart fid _ _ _ _ -> do
    sstart <- getsSession sstart
    when (sstart == 0) resetSessionStart
    history <- getsSession shistory
    when (lengthHistory history == 0) $ do
      Kind.COps{corule} <- getsState scops
      let title = rtitle $ Kind.stdRuleset corule
      msgAdd $ "Welcome to" <+> title <> "!"
      -- Generate initial history. Only for UI clients.
      sUIOptions <- getsSession sUIOptions
      shistory <- defaultHistory $ uHistoryMax sUIOptions
      modifySession $ \sess -> sess {shistory}
    lid <- getArenaUI
    lvl <- getLevel lid
    mode <- getGameMode
    curChal <- getsClient scurChal
    fact <- getsState $ (EM.! fid) . sfactionD
    let loneMode = case ginitial fact of
          [] -> True
          [(_, 1, _)] -> True
          _ -> False
    msgAdd $ "New game started in" <+> mname mode <+> "mode."
             <+> mdesc mode <+> ldesc lvl
             <+> if cwolf curChal && not loneMode
                 then "Being a lone wolf, you start without companions."
                 else ""
    when (lengthHistory history > 1) $ fadeOutOrIn False
    setFrontAutoYes $ isAIFact fact
    when (isAIFact fact) $ do
      -- Prod the frontend to flush frames and start showing them continuously.
      slides <- reportToSlideshow []
      void $ getConfirms ColorFull [K.spaceKM, K.escKM] slides
  UpdRestartServer{} -> return ()
  UpdResume fid _ -> do
    resetSessionStart
    fact <- getsState $ (EM.! fid) . sfactionD
    setFrontAutoYes $ isAIFact fact
    unless (isAIFact fact) $ do
      lid <- getArenaUI
      lvl <- getLevel lid
      mode <- getGameMode
      promptAdd $ "Continuing" <+> mname mode <> "."
                  <+> mdesc mode <+> ldesc lvl
                  <+> "Are you up for the challenge?"
      slides <- reportToSlideshow [K.spaceKM, K.escKM]
      km <- getConfirms ColorFull [K.spaceKM, K.escKM] slides
      if km == K.escKM then addPressedEsc else promptAdd "Prove yourself!"
  UpdResumeServer{} -> return ()
  UpdKillExit{} -> frontendShutdown
  UpdWriteSave -> when verbose $ promptAdd "Saving backup."

updateItemSlot :: MonadClientUI m
               => CStore -> Maybe ActorId -> ItemId -> m SlotChar
updateItemSlot store maid iid = do
  slots@(ItemSlots itemSlots organSlots) <- getsSession sslots
  let onlyOrgans = store == COrgan
      lSlots = if onlyOrgans then organSlots else itemSlots
      incrementPrefix m l iid2 = EM.insert l iid2 $
        case EM.lookup l m of
          Nothing -> m
          Just iidOld ->
            let lNew = SlotChar (slotPrefix l + 1) (slotChar l)
            in incrementPrefix m lNew iidOld
  case lookup iid $ map swap $ EM.assocs lSlots of
    Nothing -> do
      side <- getsClient sside
      item <- getsState $ getItemBody iid
      lastSlot <- getsSession slastSlot
      mb <- maybe (return Nothing) (fmap Just . getsState . getActorBody) maid
      l <- getsState $ assignSlot store item side mb slots lastSlot
      let newSlots | onlyOrgans = ItemSlots
                                    itemSlots
                                    (incrementPrefix organSlots l iid)
                   | otherwise = ItemSlots
                                   (incrementPrefix itemSlots l iid)
                                   organSlots
      modifySession $ \sess -> sess {sslots = newSlots}
      return l
    Just l -> return l  -- slot already assigned; a letter or a number

markDisplayNeeded :: MonadClientUI m => LevelId -> m ()
markDisplayNeeded lid = do
  lidV <- viewedLevelUI
  when (lidV == lid) $ modifySession $ \sess -> sess {sdisplayNeeded = True}

updateItemSlotSide :: MonadClientUI m
                   => CStore -> ActorId -> ItemId -> m SlotChar
updateItemSlotSide store aid iid = do
  side <- getsClient sside
  b <- getsState $ getActorBody aid
  if bfid b == side
  then updateItemSlot store (Just aid) iid
  else updateItemSlot store Nothing iid

lookAtMove :: MonadClientUI m => ActorId -> m ()
lookAtMove aid = do
  body <- getsState $ getActorBody aid
  side <- getsClient sside
  aimMode <- getsSession saimMode
  when (not (bproj body)
        && bfid body == side
        && isNothing aimMode) $ do  -- aiming does a more extensive look
    lookMsg <- lookAt False "" True (bpos body) aid ""
    msgAdd lookMsg
  fact <- getsState $ (EM.! bfid body) . sfactionD
  adjacentAssocs <- getsState $ actorAdjacentAssocs body
  if not (bproj body) && side == bfid body then do
    let foe (_, b2) = isAtWar fact (bfid b2)
        adjFoes = filter foe adjacentAssocs
    unless (null adjFoes) stopPlayBack
  else when (isAtWar fact side) $ do
    let our (_, b2) = not (bproj b2) && bfid b2 == side
        adjOur = filter our adjacentAssocs
    unless (null adjOur) stopPlayBack

actorVerbMU :: MonadClientUI m => ActorId -> ActorUI -> MU.Part -> m ()
actorVerbMU aid bUI verb = do
  subject <- partActorLeader aid bUI
  msgAdd $ makeSentence [MU.SubjectVerbSg subject verb]

aidVerbMU :: MonadClientUI m => ActorId -> MU.Part -> m ()
aidVerbMU aid verb = do
  bUI <- getsSession $ getActorUI aid
  actorVerbMU aid bUI verb

itemVerbMU :: MonadClientUI m
           => ItemId -> ItemQuant -> MU.Part -> Container -> m ()
itemVerbMU iid kit@(k, _) verb c = assert (k > 0) $ do
  lid <- getsState $ lidFromC c
  localTime <- getsState $ getLocalTime lid
  itemToF <- getsState itemToFull
  side <- getsClient sside
  factionD <- getsState sfactionD
  let subject = partItemWs side factionD
                                k (storeFromC c) localTime (itemToF iid kit)
      msg | k > 1 = makeSentence [MU.SubjectVerb MU.PlEtc MU.Yes subject verb]
          | otherwise = makeSentence [MU.SubjectVerbSg subject verb]
  msgAdd msg

-- We assume the item is inside the specified container.
-- So, this function can't be used for, e.g., @UpdDestroyItem@.
itemAidVerbMU :: MonadClientUI m
              => ActorId -> MU.Part
              -> ItemId -> Either (Maybe Int) Int -> CStore
              -> m ()
itemAidVerbMU aid verb iid ek cstore = do
  body <- getsState $ getActorBody aid
  bag <- getsState $ getBodyStoreBag body cstore
  side <- getsClient sside
  factionD <- getsState sfactionD
  -- The item may no longer be in @c@, but it was
  case iid `EM.lookup` bag of
    Nothing -> error $ "" `showFailure` (aid, verb, iid, cstore)
    Just kit@(k, _) -> do
      itemToF <- getsState itemToFull
      let lid = blid body
      localTime <- getsState $ getLocalTime lid
      subject <- partAidLeader aid
      let itemFull = itemToF iid kit
          object = case ek of
            Left (Just n) ->
              assert (n <= k `blame` (aid, verb, iid, cstore))
              $ partItemWs side factionD n cstore localTime itemFull
            Left Nothing ->
              let (_, _, name, stats) =
                    partItem side factionD cstore localTime itemFull
              in MU.Phrase [name, stats]
            Right n ->
              assert (n <= k `blame` (aid, verb, iid, cstore))
              $ let (_, _, name1, stats) =
                      partItemShort side factionD cstore localTime itemFull
                    name = if n == 1 then name1 else MU.CarWs n name1
                in MU.Phrase ["the", name, stats]
          msg = makeSentence [MU.SubjectVerbSg subject verb, object]
      msgAdd msg

msgDuplicateScrap :: MonadClientUI m => m Bool
msgDuplicateScrap = do
  report <- getsSession sreport
  history <- getsSession shistory
  let (lastMsg, repRest) = lastMsgOfReport report
      repLast = lastReportOfHistory history
  case incrementInReport (== lastMsg) repRest of
    Just repIncr -> do
      modifySession $ \sess -> sess {_sreport = repIncr}
      return True
    Nothing -> case incrementInReport (== lastMsg) repLast of
      Just repIncr -> do
        let historyIncr = replaceLastReportOfHistory repIncr history
        modifySession $ \sess -> sess { _sreport = repRest
                                      , shistory = historyIncr }
        return True
      Nothing -> return False

createActorUI :: MonadClientUI m => Bool -> ActorId -> Actor -> m ()
createActorUI born aid body = do
  side <- getsClient sside
  fact <- getsState $ (EM.! bfid body) . sfactionD
  globalTime <- getsState stime
  localTime <- getsState $ getLocalTime $ blid body
  mbUI <- getsSession $ EM.lookup aid . sactorUI
  bUI <- case mbUI of
    Just bUI -> return bUI
    Nothing -> do
      trunk <- getsState $ getItemBody $ btrunk body
      UIOptions{uHeroNames} <- getsSession sUIOptions
      let isBlast = actorTrunkIsBlast trunk
          baseColor = flavourToColor $ jflavour trunk
          basePronoun | not (bproj body) && fhasGender (gplayer fact) = "he"
                      | otherwise = "it"
          nameFromNumber fn k = if k == 0
                                then makePhrase [MU.Ws $ MU.Text fn, "Captain"]
                                else fn <+> tshow k
          heroNamePronoun k =
            if gcolor fact /= Color.BrWhite
            then (nameFromNumber (fname $ gplayer fact) k, "he")
            else fromMaybe (nameFromNumber (fname $ gplayer fact) k, "he")
                 $ lookup k uHeroNames
      (n, bsymbol) <-
        if | bproj body -> return (0, if isBlast then jsymbol trunk else '*')
           | baseColor /= Color.BrWhite -> return (0, jsymbol trunk)
           | otherwise -> do
             sactorUI <- getsSession sactorUI
             let hasNameK k bUI = bname bUI == fst (heroNamePronoun k)
                                  && bcolor bUI == gcolor fact
                 findHeroK k = isJust $ find (hasNameK k) (EM.elems sactorUI)
                 mhs = map findHeroK [0..]
                 n = fromJust $ elemIndex False mhs
             return (n, if 0 < n && n < 10 then Char.intToDigit n else '@')
      factionD <- getsState sfactionD
      let (bname, bpronoun) =
            if | bproj body ->
                 let adj | length (btrajectory body) < 5 = "falling"
                         | otherwise = "flying"
                     -- Not much detail about a fast flying item.
                     (_, _, object1, object2) =
                       partItem (bfid body) factionD CInv localTime
                                (itemNoDisco (trunk, 1))
                 in ( makePhrase [MU.AW $ MU.Text adj, object1, object2]
                    , basePronoun )
               | baseColor /= Color.BrWhite -> (jname trunk, basePronoun)
               | otherwise -> heroNamePronoun n
          bcolor | bproj body = if isBlast then baseColor else Color.BrWhite
                 | baseColor == Color.BrWhite = gcolor fact
                 | otherwise = baseColor
          bUI = ActorUI{..}
      modifySession $ \sess ->
        sess {sactorUI = EM.insert aid bUI $ sactorUI sess}
      return bUI
  let verb = MU.Text $
        if born
        then if globalTime == timeZero
             then "be here"
             else "appear" <+> if bfid body == side then "" else "suddenly"
        else "be spotted"
  mapM_ (\(iid, store) -> void $ updateItemSlotSide store aid iid)
        (getCarriedIidCStore body)
  when (bfid body /= side) $ do
    when (not (bproj body) && isAtWar fact side) $
      -- Aim even if nobody can shoot at the enemy. Let's home in on him
      -- and then we can aim or melee. We set permit to False, because it's
      -- technically very hard to check aimability here, because we are
      -- in-between turns and, e.g., leader's move has not yet been taken
      -- into account.
      modifySession $ \sess -> sess {sxhair = TEnemy aid False}
    stopPlayBack
  -- Don't spam if the actor was already visible (but, e.g., on a tile that is
  -- invisible this turn (in that case move is broken down to lose+spot)
  -- or on a distant tile, via teleport while the observer teleported, too).
  lastLost <- getsSession slastLost
  if ES.member aid lastLost || bproj body then
    markDisplayNeeded (blid body)
  else do
    actorVerbMU aid bUI verb
    animate (blid body) $ actorX (bpos body)

destroyActorUI :: MonadClientUI m => Bool -> ActorId -> Actor -> m ()
destroyActorUI destroy aid b = do
  trunk <- getsState $ getItemBody $ btrunk b
  let baseColor = flavourToColor $ jflavour trunk
  unless (baseColor == Color.BrWhite) $  -- keep setup for heroes, etc.
    modifySession $ \sess -> sess {sactorUI = EM.delete aid $ sactorUI sess}
  let affect tgt = case tgt of
        TEnemy a permit | a == aid ->
          if destroy then
            -- If *really* nothing more interesting, the actor will
            -- go to last known location to perhaps find other foes.
            TPoint TAny (blid b) (bpos b)
          else
            -- If enemy only hides (or we stepped behind obstacle) find him.
            TPoint (TEnemyPos a permit) (blid b) (bpos b)
        _ -> tgt
  modifySession $ \sess -> sess {sxhair = affect $ sxhair sess}
  when (isNothing $ btrajectory b) $
    modifySession $ \sess -> sess {slastLost = ES.insert aid $ slastLost sess}
  side <- getsClient sside
  fact <- getsState $ (EM.! side) . sfactionD
  let gameOver = isJust $ gquit fact  -- we are the UI faction, so we determine
  unless gameOver $ do
    when (bfid b == side && not (bproj b)) $ do
      stopPlayBack
      let upd = ES.delete aid
      modifySession $ \sess -> sess {sselected = upd $ sselected sess}
      when destroy $ do
        displayMore ColorBW "Alas!"
        mleader <- getsClient sleader
        when (isJust mleader)
          -- This is especially handy when the dead actor was a leader
          -- on a different level than the new one:
          clearAimMode
    -- If pushed, animate spotting again, to draw attention to pushing.
    markDisplayNeeded (blid b)

spotItem :: MonadClientUI m
         => Bool -> ItemId -> ItemQuant -> Container -> m ()
spotItem verbose iid kit c = do
  -- This is due to a move, or similar, which will be displayed,
  -- so no extra @markDisplayNeeded@ needed here and in similar places.
  ItemSlots itemSlots _ <- getsSession sslots
  case lookup iid $ map swap $ EM.assocs itemSlots of
    Nothing ->  -- never seen or would have a slot
      case c of
        CActor aid store ->
          -- Most probably an actor putting item in or out of shared stash.
          void $ updateItemSlotSide store aid iid
        CEmbed{} -> return ()
        CFloor lid p -> do
          void $ updateItemSlot CGround Nothing iid
          sxhairOld <- getsSession sxhair
          case sxhairOld of
            TEnemy{} -> return ()  -- probably too important to overwrite
            TPoint TEnemyPos{} _ _ -> return ()
            _ -> do
              -- Don't steal xhair if it's only an item on another level.
              -- For enemies, OTOH, capture xhair to alarm player.
              lidV <- viewedLevelUI
              when (lid == lidV) $ do
                bag <- getsState $ getFloorBag lid p
                modifySession $ \sess ->
                  sess {sxhair = TPoint (TItem bag) lidV p}
          itemVerbMU iid kit "be spotted" c
          stopPlayBack
        CTrunk{} -> return ()
    _ -> return ()  -- this item or another with the same @iid@
                    -- seen already (has a slot assigned), so old news
  when verbose $ case c of
    CActor aid store | store `elem` [CEqp, CInv, CGround, CSha] -> do
      -- Actor fetching an item from or to shared stash, most probably.
      bUI <- getsSession $ getActorUI aid
      subject <- partActorLeader aid bUI
      let ownW = ppCStoreWownW False store subject
          verb = MU.Text $ makePhrase $ "be added to" : ownW
      itemVerbMU iid kit verb c
    _ -> return ()

moveActor :: MonadClientUI m => ActorId -> Point -> Point -> m ()
moveActor aid source target = do
  -- If source and target tile distant, assume it's a teleportation
  -- and display an animation. Note: jumps and pushes go through all
  -- intervening tiles, so won't be considered. Note: if source or target
  -- not seen, the (half of the) animation would be boring, just a delay,
  -- not really showing a transition, so we skip it (via 'breakUpdAtomic').
  -- The message about teleportation is sometimes shown anyway, just as the X.
  body <- getsState $ getActorBody aid
  if adjacent source target
  then markDisplayNeeded (blid body)
  else do
    let ps = (source, target)
    animate (blid body) $ teleport ps
  lookAtMove aid

displaceActorUI :: MonadClientUI m => ActorId -> ActorId -> m ()
displaceActorUI source target = do
  sb <- getsState $ getActorBody source
  sbUI <- getsSession $ getActorUI source
  tb <- getsState $ getActorBody target
  tbUI <- getsSession $ getActorUI target
  spart <- partActorLeader source sbUI
  tpart <- partActorLeader target tbUI
  let msg = makeSentence [MU.SubjectVerbSg spart "displace", tpart]
  msgAdd msg
  when (bfid sb /= bfid tb) $ do
    lookAtMove source
    lookAtMove target
  let ps = (bpos tb, bpos sb)
  animate (blid sb) $ swapPlaces ps

moveItemUI :: MonadClientUI m
           => ItemId -> Int -> ActorId -> CStore -> CStore
           -> m ()
moveItemUI iid k aid cstore1 cstore2 = do
  let verb = verbCStore cstore2
  b <- getsState $ getActorBody aid
  fact <- getsState $ (EM.! bfid b) . sfactionD
  let underAI = isAIFact fact
  mleader <- getsClient sleader
  ItemSlots itemSlots _ <- getsSession sslots
  case lookup iid $ map swap $ EM.assocs itemSlots of
    Just slastSlot -> do
      when (Just aid == mleader) $ modifySession $ \sess -> sess {slastSlot}
      if cstore1 == CGround && Just aid == mleader && not underAI then
        itemAidVerbMU aid (MU.Text verb) iid (Right k) cstore2
      else when (not (bproj b) && bhp b > 0) $  -- don't announce death drops
        itemAidVerbMU aid (MU.Text verb) iid (Left $ Just k) cstore2
    Nothing -> error $
      "" `showFailure` (iid, k, aid, cstore1, cstore2, itemSlots)

quitFactionUI :: MonadClientUI m => FactionId -> Maybe Status -> m ()
quitFactionUI fid toSt = do
  Kind.COps{coitem=Kind.Ops{okind, ouniqGroup}} <- getsState scops
  fact <- getsState $ (EM.! fid) . sfactionD
  let fidName = MU.Text $ gname fact
      person = if fhasGender $ gplayer fact then MU.PlEtc else MU.Sg3rd
      horror = isHorrorFact fact
  side <- getsClient sside
  when (side == fid && maybe False ((/= Camping) . stOutcome) toSt) $ do
    let won = case toSt of
          Just Status{stOutcome=Conquer} -> True
          Just Status{stOutcome=Escape} -> True
          _ -> False
    when won $ do
      gameModeId <- getsState sgameModeId
      scurChal <- getsClient scurChal
      let sing = M.singleton scurChal 1
          f = M.unionWith (+)
          g = EM.insertWith f gameModeId sing
      modifyClient $ \cli -> cli {svictories = g $ svictories cli}
    tellGameClipPS
    resetGameStart
  let msgIfSide _ | fid /= side = Nothing
      msgIfSide s = Just s
      (startingPart, partingPart) = case toSt of
        _ | horror ->
          -- Ignore summoned actors' factions.
          (Nothing, Nothing)
        Just Status{stOutcome=Killed} ->
          ( Just "be eliminated"
          , msgIfSide "Let's hope another party can save the day!" )
        Just Status{stOutcome=Defeated} ->
          ( Just "be decisively defeated"
          , msgIfSide "Let's hope your new overlords let you live." )
        Just Status{stOutcome=Camping} ->
          ( Just "order save and exit"
          , Just $ if fid == side
                   then "See you soon, stronger and braver!"
                   else "See you soon, stalwart warrior!" )
        Just Status{stOutcome=Conquer} ->
          ( Just "vanquish all foes"
          , msgIfSide "Can it be done in a better style, though?" )
        Just Status{stOutcome=Escape} ->
          ( Just "achieve victory"
          , msgIfSide "Can it be done better, though?" )
        Just Status{stOutcome=Restart, stNewGame=Just gn} ->
          ( Just $ MU.Text $ "order mission restart in" <+> tshow gn <+> "mode"
          , Just $ if fid == side
                   then "This time for real."
                   else "Somebody couldn't stand the heat." )
        Just Status{stOutcome=Restart, stNewGame=Nothing} ->
          error $ "" `showFailure` (fid, toSt)
        Nothing -> (Nothing, Nothing)  -- server wipes out Camping for savefile
  case startingPart of
    Nothing -> return ()
    Just sp -> msgAdd $ makeSentence [MU.SubjectVerb person MU.Yes fidName sp]
  case (toSt, partingPart) of
    (Just status, Just pp) -> do
      isNoConfirms <- isNoConfirmsGame
      go <- if isNoConfirms then return False else displaySpaceEsc ColorFull ""
      when (side == fid) recordHistory
        -- we are going to exit or restart, so record and clear, but only once
      when go $ do
        lidV <- viewedLevelUI
        Level{lxsize, lysize} <- getLevel lidV
        let store = CGround  -- only matters for UI details; all items shown
            currencyName = MU.Text $ IK.iname $ okind $ ouniqGroup "currency"
        arena <- getArenaUI
        (bag, itemSlides, total) <- do
          (bag, tot) <- getsState $ calculateTotal side
          if EM.null bag then return (EM.empty, emptySlideshow, 0)
          else do
            let spoilsMsg = makeSentence [ "Your spoils are worth"
                                         , MU.CarWs tot currencyName ]
            promptAdd spoilsMsg
            io <- itemOverlay store arena bag
            sli <- overlayToSlideshow (lysize + 1) [K.spaceKM, K.escKM] io
            return (bag, sli, tot)
        localTime <- getsState $ getLocalTime arena
        itemToF <- getsState itemToFull
        ItemSlots lSlots _ <- getsSession sslots
        let keyOfEKM (Left km) = km
            keyOfEKM (Right SlotChar{slotChar}) = [K.mkChar slotChar]
            allOKX = concatMap snd $ slideshow itemSlides
            keys = [K.spaceKM, K.escKM] ++ concatMap (keyOfEKM . fst) allOKX
            examItem slot =
              case EM.lookup slot lSlots of
                Nothing -> error $ "" `showFailure` slot
                Just iid -> case EM.lookup iid bag of
                  Nothing -> error $ "" `showFailure` iid
                  Just kit@(k, _) -> do
                    factionD <- getsState sfactionD
                    let itemFull = itemToF iid kit
                        attrLine = itemDesc side factionD 0
                                            store localTime itemFull
                        ov = splitAttrLine lxsize attrLine
                        worth = itemPrice (itemBase itemFull, 1)
                        lootMsg = makeSentence $
                          ["This particular loot is worth"]
                          ++ (if k > 1 then [ MU.Cardinal k, "times"] else [])
                          ++ [MU.CarWs worth currencyName]
                    promptAdd lootMsg
                    slides <- overlayToSlideshow (lysize + 1)
                                                 [K.spaceKM, K.escKM]
                                                 (ov, [])
                    km <- getConfirms ColorFull [K.spaceKM, K.escKM] slides
                    return $! km == K.spaceKM
            viewItems pointer =
              if itemSlides == emptySlideshow then return True
              else do
                (ekm, pointer2) <- displayChoiceScreen ColorFull False pointer
                                                       itemSlides keys
                case ekm of
                  Left km | km == K.spaceKM -> return True
                  Left km | km == K.escKM -> return False
                  Left _ -> error $ "" `showFailure` ekm
                  Right slot -> do
                    go2 <- examItem slot
                    if go2 then viewItems pointer2 else return True
        go3 <- viewItems 2
        when go3 $ do
          -- Show score for any UI client after any kind of game exit,
          -- even though it is saved only for human UI clients at game over.
          scoreSlides <- scoreToSlideshow total status
          void $ getConfirms ColorFull [K.spaceKM, K.escKM] scoreSlides
          -- The last prompt stays onscreen during shutdown, etc.
          promptAdd pp
          partingSlide <- reportToSlideshow [K.spaceKM, K.escKM]
          void $ getConfirms ColorFull [K.spaceKM, K.escKM] partingSlide
      unless (fmap stOutcome toSt == Just Camping) $
        fadeOutOrIn True
    _ -> return ()

discover :: MonadClientUI m => Container -> ItemId -> m ()
discover c iid = do
  let cstore = storeFromC c
  lid <- getsState $ lidFromC c
  globalTime <- getsState stime
  localTime <- getsState $ getLocalTime lid
  itemToF <- getsState itemToFull
  bag <- getsState $ getContainerBag c
  side <- getsClient sside
  factionD <- getsState sfactionD
  (isOurOrgan, nameWhere) <- case c of
    CActor aidOwner storeOwner -> do
      bOwner <- getsState $ getActorBody aidOwner
      bOwnerUI <- getsSession $ getActorUI aidOwner
      let name = if bproj bOwner || bfid bOwner == side
                 then []
                 else ppCStoreWownW True storeOwner (partActor bOwnerUI)
      return (bfid bOwner == side && storeOwner == COrgan, name)
    _ -> return (False, [])
  let kit = EM.findWithDefault (1, []) iid bag
      itemFull = itemToF iid kit
      knownName = partItemMediumAW side factionD cstore localTime itemFull
      -- Wipe out the whole knowledge of the item to make sure the two names
      -- in the message differ even if, e.g., the item is described as
      -- "of many effects".
      itemSecret = itemNoDisco (itemBase itemFull, itemK itemFull)
      (_, _, secretName, secretAEText) =
        partItem side factionD cstore localTime itemSecret
      namePhrase = MU.Phrase $ [secretName, secretAEText] ++ nameWhere
      msg = makeSentence
        ["the", MU.SubjectVerbSg namePhrase "turn out to be", knownName]
  -- Compare descriptions of all aspects and effects to determine
  -- if the discovery was meaningful to the player.
  unless (globalTime == timeZero  -- don't spam about initial equipment
          || isOurOrgan) $  -- assume own faction organs known intuitively
    msgAdd msg

-- * RespSfxAtomicUI

-- | Display special effects (text, animation) sent to the client.
displayRespSfxAtomicUI :: MonadClientUI m => Bool -> SfxAtomic -> m ()
{-# INLINE displayRespSfxAtomicUI #-}
displayRespSfxAtomicUI verbose sfx = case sfx of
  SfxStrike source target iid store ->
    strike False source target iid store
  SfxRecoil source target _ _ -> do
    spart <- partAidLeader source
    tpart <- partAidLeader target
    msgAdd $ makeSentence [MU.SubjectVerbSg spart "shrink away from", tpart]
  SfxSteal source target iid store ->
    strike True source target iid store
  SfxRelease source target _ _ -> do
    spart <- partAidLeader source
    tpart <- partAidLeader target
    msgAdd $ makeSentence [MU.SubjectVerbSg spart "release", tpart]
  SfxProject aid iid cstore -> do
    setLastSlot aid iid cstore
    itemAidVerbMU aid "fling" iid (Left $ Just 1) cstore
  SfxReceive aid iid cstore ->
    itemAidVerbMU aid "receive" iid (Left $ Just 1) cstore
  SfxApply aid iid cstore -> do
    setLastSlot aid iid cstore
    itemAidVerbMU aid "apply" iid (Left $ Just 1) cstore
  SfxCheck aid iid cstore ->
    itemAidVerbMU aid "deapply" iid (Left $ Just 1) cstore
  SfxTrigger aid _p ->
    -- So far triggering is visible, e.g., doors close, so no need for messages.
    when verbose $ aidVerbMU aid "trigger"
  SfxShun aid _p ->
    when verbose $ aidVerbMU aid "shun"
  SfxEffect fidSource aid effect hpDelta -> do
    b <- getsState $ getActorBody aid
    bUI <- getsSession $ getActorUI aid
    side <- getsClient sside
    let fid = bfid b
        isOurCharacter = fid == side && not (bproj b)
        isOurAlive = isOurCharacter && bhp b > 0
    case effect of
        IK.ELabel{} -> return ()
        IK.EqpSlot{} -> return ()
        IK.Burn{} -> do
          if isOurAlive
          then actorVerbMU aid bUI "feel burned"
          else actorVerbMU aid bUI "look burned"
          let ps = (bpos b, bpos b)
          animate (blid b) $ twirlSplash ps Color.BrRed Color.Brown
        IK.Explode{} -> return ()  -- lots of visual feedback
        IK.RefillHP p | p == 1 -> return ()  -- no spam from regeneration
        IK.RefillHP p | p == -1 -> return ()  -- no spam from poison
        IK.RefillHP{} | hpDelta > 0 -> do
          if isOurAlive then
            actorVerbMU aid bUI "feel healthier"
          else
            actorVerbMU aid bUI "look healthier"
          let ps = (bpos b, bpos b)
          animate (blid b) $ twirlSplash ps Color.BrGreen Color.Green
        IK.RefillHP{} -> do
          if isOurAlive then
            actorVerbMU aid bUI "feel wounded"
          else
            actorVerbMU aid bUI "look wounded"
          let ps = (bpos b, bpos b)
          animate (blid b) $ twirlSplash ps Color.BrRed Color.Red
        IK.RefillCalm p | p == 1 -> return ()  -- no spam from regen items
        IK.RefillCalm p | p > 0 ->
          if isOurAlive then
            actorVerbMU aid bUI "feel calmer"
          else
            actorVerbMU aid bUI "look calmer"
        IK.RefillCalm _ ->
          if isOurAlive then
            actorVerbMU aid bUI "feel agitated"
          else
            actorVerbMU aid bUI "look agitated"
        IK.Dominate -> do
          -- For subsequent messages use the proper name, never "you".
          let subject = partActor bUI
          if fid /= fidSource then do
            -- Before domination, possibly not seen if actor (yet) not ours.
            if | bcalm b == 0 ->  -- sometimes only a coincidence, but nm
                 aidVerbMU aid $ MU.Text "yield, under extreme pressure"
               | isOurAlive ->
                 aidVerbMU aid $ MU.Text "black out, dominated by foes"
               | otherwise ->
                 aidVerbMU aid $ MU.Text "decide abrubtly to switch allegiance"
            fidName <- getsState $ gname . (EM.! fid) . sfactionD
            let verb = "be no longer controlled by"
            msgAdd $ makeSentence
              [MU.SubjectVerbSg subject verb, MU.Text fidName]
            when isOurAlive $ displayMoreKeep ColorFull ""
          else do
            -- After domination, possibly not seen, if actor (already) not ours.
            fidSourceName <- getsState $ gname . (EM.! fidSource) . sfactionD
            let verb = "be now under"
            msgAdd $ makeSentence
              [MU.SubjectVerbSg subject verb, MU.Text fidSourceName, "control"]
          stopPlayBack
        IK.Impress -> actorVerbMU aid bUI "be awestruck"
        IK.Summon grp p -> do
          let verb = if bproj b then "lure" else "summon"
              object = (if p == 1  -- avoid "2 + 4 dl 3"
                        then MU.AW
                        else MU.Ws) $ MU.Text $ tshow grp
          actorVerbMU aid bUI $ MU.Phrase [verb, object]
        IK.Ascend True -> do
          actorVerbMU aid bUI "find a way upstairs"
          (lid, _) <- getsState $ whereTo (blid b) (bpos b) (Just True)
                                  . sdungeon
          lvl <- getLevel lid
          msgAdd $ ldesc lvl
        IK.Ascend False -> do
          actorVerbMU aid bUI "find a way downstairs"
          (lid, _) <- getsState $ whereTo (blid b) (bpos b) (Just False)
                                  . sdungeon
          lvl <- getLevel lid
          msgAdd $ ldesc lvl
        IK.Escape{} -> return ()
        IK.Paralyze{} -> actorVerbMU aid bUI "be paralyzed"
        IK.InsertMove{} -> actorVerbMU aid bUI "act with extreme speed"
        IK.Teleport t | Dice.maxDice t <= 9 -> actorVerbMU aid bUI "blink"
        IK.Teleport{} -> actorVerbMU aid bUI "teleport"
        IK.CreateItem{} -> return ()
        IK.DropItem _ _ COrgan _ -> return ()
        IK.DropItem{} -> actorVerbMU aid bUI "be stripped"
        IK.PolyItem -> do
          localTime <- getsState $ getLocalTime $ blid b
          allAssocs <- getsState $ fullAssocs aid [CGround]
          case allAssocs of
            [] -> return ()  -- invisible items?
            (_, ItemFull{..}) : _ -> do
              subject <- partActorLeader aid bUI
              factionD <- getsState sfactionD
              let itemSecret = itemNoDisco (itemBase, itemK)
                  (_, _, secretName, secretAEText) =
                    partItem side factionD CGround localTime itemSecret
                  verb = "repurpose"
                  store = MU.Text $ ppCStoreIn CGround
              msgAdd $ makeSentence
                [ MU.SubjectVerbSg subject verb
                , "the", secretName, secretAEText, store ]
        IK.Identify -> do
          allAssocs <- getsState $ fullAssocs aid [CGround]
          case allAssocs of
            [] -> return ()  -- invisible items?
            (_, ItemFull{..}) : _ -> do
              subject <- partActorLeader aid bUI
              let verb = "inspect"
                  store = MU.Text $ ppCStoreIn CGround
              msgAdd $ makeSentence
                [ MU.SubjectVerbSg subject verb
                , "an item", store ]
        IK.Detect{} -> do
          subject <- partActorLeader aid bUI
          let verb = "perceive nearby area"
          displayMore ColorFull $ makeSentence [MU.SubjectVerbSg subject verb]
        IK.DetectActor{} -> do
          subject <- partActorLeader aid bUI
          let verb = "detect nearby actors"
          displayMore ColorFull $ makeSentence [MU.SubjectVerbSg subject verb]
        IK.DetectItem{} -> do
          subject <- partActorLeader aid bUI
          let verb = "detect nearby items"
          displayMore ColorFull $ makeSentence [MU.SubjectVerbSg subject verb]
        IK.DetectExit{} -> do
          subject <- partActorLeader aid bUI
          let verb = "detect nearby exits"
          displayMore ColorFull $ makeSentence [MU.SubjectVerbSg subject verb]
        IK.DetectHidden{} -> do
          subject <- partActorLeader aid bUI
          let verb = "detect nearby secrets"
          displayMore ColorFull $ makeSentence [MU.SubjectVerbSg subject verb]
        IK.SendFlying{} -> actorVerbMU aid bUI "be sent flying"
        IK.PushActor{} -> actorVerbMU aid bUI "be pushed"
        IK.PullActor{} -> actorVerbMU aid bUI "be pulled"
        IK.DropBestWeapon -> actorVerbMU aid bUI "be disarmed"
        IK.ActivateInv{} -> return ()
        IK.ApplyPerfume ->
          msgAdd "The fragrance quells all scents in the vicinity."
        IK.OneOf{} -> return ()
        IK.OnSmash{} -> error $ "" `showFailure` sfx
        IK.Recharging{} -> error $ "" `showFailure` sfx
        IK.Temporary t -> actorVerbMU aid bUI $ MU.Text t
        IK.Unique -> error $ "" `showFailure` sfx
        IK.Periodic -> error $ "" `showFailure` sfx
        IK.Composite{} -> error $ "" `showFailure` sfx
  SfxMsgFid _ sfxMsg -> do
    mleader <- getsClient sleader
    case mleader of
      Just{} -> return ()  -- will display stuff when leader moves
      Nothing -> do
        lidV <- viewedLevelUI
        markDisplayNeeded lidV
        recordHistory
    msg <- ppSfxMsg sfxMsg
    msgAdd msg
  SfxSortSlots -> do
    side <- getsClient sside
    sortSlots side Nothing

ppSfxMsg :: MonadClientUI m => SfxMsg -> m Text
ppSfxMsg sfxMsg = case sfxMsg of
  SfxUnexpected reqFailure -> return $!
    "Unexpected problem:" <+> showReqFailure reqFailure <> "."
  SfxLoudUpd local cmd -> do
    Kind.COps{coTileSpeedup} <- getsState scops
    let sound = case cmd of
          UpdDestroyActor{} -> "shriek"
          UpdCreateItem{} -> "clatter"
          UpdTrajectory{} ->
            -- Projectile hits an non-walkable tile on leader's level.
            "thud"
          UpdAlterTile _ _ fromTile _ ->
            if Tile.isDoor coTileSpeedup fromTile
            then "creaking sound"
            else "rumble"
          UpdAlterExplorable _ k -> if k > 0 then "grinding noise"
                                             else "fizzing noise"
          _ -> error $ "" `showFailure` cmd
        distant = if local then [] else ["distant"]
        msg = makeSentence [ "you hear"
                           , MU.AW $ MU.Phrase $ distant ++ [sound] ]
    return $! msg
  SfxLoudStrike local ik distance -> do
    Kind.COps{coitem=Kind.Ops{okind}} <- getsState scops
    let verb = IK.iverbHit $ okind ik
        adverb = if | distance < 5 -> "loudly"
                    | distance < 10 -> "distinctly"
                    | distance < 40 -> ""  -- most common
                    | distance < 45 -> "faintly"
                    | otherwise -> "barely"  -- 50 is the hearing limit
        distant = if local then [] else ["far away"]
        msg = makeSentence $
          [ "you", adverb, "hear something", verb, "someone"] ++ distant
    return $! msg
  SfxLoudSummon isProj grp p -> do
    let verb = if isProj then "something lure" else "somebody summon"
        object = if p == 1
                 then MU.Text $ tshow grp
                 else MU.Ws $ MU.Text $ tshow grp
    return $! makeSentence ["you hear", verb, object]
  SfxFizzles -> return "It flashes and fizzles."
  SfxNothingHappens -> return "Nothing happens."
  SfxVoidDetection -> return "Nothing new detected."
  SfxSummonLackCalm aid -> do
    msbUI <- getsSession $ EM.lookup aid . sactorUI
    case msbUI of
      Nothing -> return ""
      Just sbUI -> do
        let subject = partActor sbUI
            verb = "lack Calm to summon"
        return $! makeSentence [MU.SubjectVerbSg subject verb]
  SfxLevelNoMore -> return "No more levels in this direction."
  SfxLevelPushed -> return "You notice somebody pushed to another level."
  SfxBracedImmune aid -> do
    msbUI <- getsSession $ EM.lookup aid . sactorUI
    case msbUI of
      Nothing -> return ""
      Just sbUI -> do
        let subject = partActor sbUI
            verb = "be braced and so immune to translocation"
        return $! makeSentence [MU.SubjectVerbSg subject verb]
  SfxEscapeImpossible -> return "This faction doesn't want to escape outside."
  SfxTransImpossible -> return "Translocation not possible."
  SfxIdentifyNothing -> return "Nothing to identify."
  SfxPurposeNothing store -> return $!
    "The purpose of repurpose cannot be availed without an item"
    <+> ppCStoreIn store <> "."
  SfxPurposeTooFew maxCount itemK -> return $!
    "The purpose of repurpose is served by" <+> tshow maxCount
    <+> "pieces of this item, not by" <+> tshow itemK <> "."
  SfxPurposeUnique -> return "Unique items can't be repurposed."
  SfxColdFish -> return "Healing attempt from another faction is thwarted by your cold fish attitude."
  SfxTimerExtended aid iid cstore -> do
    b <- getsState $ getActorBody aid
    bUI <- getsSession $ getActorUI aid
    aidPhrase <- partActorLeader aid bUI
    factionD <- getsState sfactionD
    localTime <- getsState $ getLocalTime (blid b)
    itemToF <- getsState itemToFull
    let itemFull = itemToF iid (1, [])
        (_, _, name, stats) =
          partItem (bfid b) factionD cstore localTime itemFull
        storeOwn = ppCStoreWownW True cstore aidPhrase
        cond = ["condition" | jsymbol (itemBase itemFull) == '+']
    return $! makeSentence $
      ["the", name, stats] ++ cond ++ storeOwn ++ ["will now last longer"]

setLastSlot :: MonadClientUI m => ActorId -> ItemId -> CStore -> m ()
setLastSlot aid iid cstore = do
  mleader <- getsClient sleader
  when (Just aid == mleader) $ do
    ItemSlots itemSlots _ <- getsSession sslots
    case lookup iid $ map swap $ EM.assocs itemSlots of
      Just slastSlot -> modifySession $ \sess -> sess {slastSlot}
      Nothing -> error $ "" `showFailure` (iid, cstore, aid)

strike :: MonadClientUI m
       => Bool -> ActorId -> ActorId -> ItemId -> CStore -> m ()
strike catch source target iid cstore = assert (source /= target) $ do
  tb <- getsState $ getActorBody target
  tbUI <- getsSession $ getActorUI target
  sourceSeen <- getsState $ memActor source (blid tb)
  (ps, hurtMult) <-
   if sourceSeen then do
    hurtMult <- getsState $ armorHurtBonus source target
    itemToF <- getsState itemToFull
    sb <- getsState $ getActorBody source
    sbUI <- getsSession $ getActorUI source
    spart <- partActorLeader source sbUI
    tpart <- partActorLeader target tbUI
    spronoun <- partPronounLeader source sbUI
    localTime <- getsState $ getLocalTime (blid tb)
    bag <- getsState $ getBodyStoreBag sb cstore
    side <- getsClient sside
    factionD <- getsState sfactionD
    let kit = EM.findWithDefault (1, []) iid bag
        itemFull = itemToF iid kit
        verb = case itemDisco itemFull of
          _ | catch -> "catch"
          Nothing -> "hit"  -- not identified
          Just ItemDisco{itemKind} -> IK.iverbHit itemKind
        isOrgan = iid `EM.member` borgan sb
        partItemChoice =
          if isOrgan
          then partItemShortWownW side factionD spronoun COrgan localTime
          else partItemShortAW side factionD cstore localTime
        msg | bhp tb <= 0  -- incapacitated, so doesn't actively block
              || hurtMult > 90  -- at most minor armor
              || jdamage (itemBase itemFull) == 0 = makeSentence $
              [MU.SubjectVerbSg spart verb, tpart]
              ++ if bproj sb
                 then []
                 else ["with", partItemChoice itemFull]
            | otherwise =
          -- This sounds funny when the victim falls down immediately,
          -- 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.
          let sActs = if bproj sb
                      then [ MU.SubjectVerbSg spart "connect" ]
                      else [ MU.SubjectVerbSg spart verb, tpart
                           , "with", partItemChoice itemFull ]
              actionPhrase =
                MU.SubjectVerbSg tpart
                $ if bproj sb
                  then if braced tb
                       then "deflect it"
                       else "fend it off"  -- ward it off
                  else if braced tb
                       then "block"  -- parry
                       else "dodge"  -- evade
              butEvenThough = if catch then ", even though" else ", but"
          in makeSentence
               [ MU.Phrase sActs <> butEvenThough
               , actionPhrase
               , if | hurtMult >= 50 ->  -- braced or big bonuses
                      "partly"
                    | hurtMult > 1 ->  -- braced and/or huge bonuses
                      if braced tb then "doggedly" else "nonchalantly"
                    | otherwise ->         -- 1% got through, which can
                      "almost completely"  -- still be deadly, if fast missile
               ]
    msgAdd msg
    return ((bpos tb, bpos sb), hurtMult)
   else return ((bpos tb, bpos tb), 100)
  let anim | hurtMult > 90 = twirlSplash ps Color.BrRed Color.Red
           | hurtMult > 1 = blockHit ps Color.BrRed Color.Red
           | otherwise = blockMiss ps
  animate (blid tb) anim