-- | Display atomic update commands received by the client.
module Game.LambdaHack.Client.UI.Watch.WatchUpdAtomicM
  ( watchRespUpdAtomicUI
#ifdef EXPOSE_INTERNAL
    -- * Internal operations
  , assignItemRole, Threat, createActorUI, destroyActorUI, spotItemBag
  , recordItemLid, moveActor, displaceActorUI, moveItemUI
  , discover, ppHearMsg, ppHearDistanceAdjective, ppHearDistanceAdverb
#endif
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import           Control.Concurrent (threadDelay)
import qualified Data.Char as Char
import qualified Data.EnumMap.Strict as EM
import qualified Data.EnumSet as ES
import qualified Data.Map.Strict as M
import qualified Data.Text as T
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.Content.Screen
import           Game.LambdaHack.Client.UI.ContentClientUI
import           Game.LambdaHack.Client.UI.DrawM
import           Game.LambdaHack.Client.UI.Frame
import           Game.LambdaHack.Client.UI.FrameM
import           Game.LambdaHack.Client.UI.HandleHelperM
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.UIOptions
import           Game.LambdaHack.Client.UI.Watch.WatchCommonM
import           Game.LambdaHack.Client.UI.Watch.WatchQuitM
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.State
import qualified Game.LambdaHack.Common.Tile as Tile
import           Game.LambdaHack.Common.Time
import           Game.LambdaHack.Common.Types
import           Game.LambdaHack.Content.CaveKind (cdesc)
import           Game.LambdaHack.Content.FactionKind
import qualified Game.LambdaHack.Content.ItemKind as IK
import           Game.LambdaHack.Content.ModeKind
import qualified Game.LambdaHack.Content.ModeKind as MK
import           Game.LambdaHack.Content.RuleKind
import qualified Game.LambdaHack.Content.TileKind as TK
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
import           Game.LambdaHack.Definition.Flavour

-- | 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.
-- Doesn't modify client state (except a few fields), but only client
-- session (e.g., by displaying messages). This is enforced by types.
watchRespUpdAtomicUI :: MonadClientUI m => UpdAtomic -> m ()
{-# INLINE watchRespUpdAtomicUI #-}
watchRespUpdAtomicUI :: forall (m :: * -> *). MonadClientUI m => UpdAtomic -> m ()
watchRespUpdAtomicUI UpdAtomic
cmd = case UpdAtomic
cmd of
  -- Create/destroy actors and items.
  UpdRegisterItems{} -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdCreateActor ActorId
aid Actor
body [(ItemId, Item)]
_ -> Bool -> ActorId -> Actor -> m ()
forall (m :: * -> *).
MonadClientUI m =>
Bool -> ActorId -> Actor -> m ()
createActorUI Bool
True ActorId
aid Actor
body
  UpdDestroyActor ActorId
aid Actor
body [(ItemId, Item)]
_ -> Bool -> ActorId -> Actor -> m ()
forall (m :: * -> *).
MonadClientUI m =>
Bool -> ActorId -> Actor -> m ()
destroyActorUI Bool
True ActorId
aid Actor
body
  UpdCreateItem Bool
verbose ItemId
iid Item
_ kit :: ItemQuant
kit@(Int
kAdd, ItemTimers
_) Container
c -> do
    ItemId -> Container -> m ()
forall (m :: * -> *).
MonadClientUI m =>
ItemId -> Container -> m ()
recordItemLid ItemId
iid Container
c
    Container -> ItemId -> m ()
forall (m :: * -> *).
MonadClientUI m =>
Container -> ItemId -> m ()
assignItemRole Container
c ItemId
iid
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
verbose (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ case Container
c of
      CActor ActorId
aid CStore
store -> do
        b <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
        case store of
          CStore
_ | Actor -> Bool
bproj Actor
b ->
            MsgClassShowAndSave
-> ItemId -> ItemQuant -> Part -> Container -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> ItemId -> ItemQuant -> Part -> Container -> m ()
itemVerbMU MsgClassShowAndSave
MsgItemCreation ItemId
iid ItemQuant
kit Part
"appear" Container
c
          CStore
COrgan -> do
            localTime <- (State -> Time) -> m Time
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Time) -> m Time) -> (State -> Time) -> m Time
forall a b. (a -> b) -> a -> b
$ LevelId -> State -> Time
getLocalTime (Actor -> LevelId
blid Actor
b)
            arItem <- getsState $ aspectRecordFromIid iid
            if | IA.checkFlag Ability.Blast arItem -> return ()
               | IA.checkFlag Ability.Condition arItem -> do
                 side <- getsClient sside
                 discoBenefit <- getsClient sdiscoBenefit
                 bag <- getsState $ getContainerBag c
                 itemKind <- getsState $ getIidKind iid
                 let more = case ItemId -> ItemBag -> Maybe ItemQuant
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup ItemId
iid ItemBag
bag of
                       Just (Int
kTotal, ItemTimers
_) | Int
kTotal Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
kAdd -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
kTotal
                       Maybe ItemQuant
_ -> Maybe Int
forall a. Maybe a
Nothing
                     verbShow = Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$
                       Text
"become"
                       Text -> Text -> Text
<+> case ItemQuant
kit of
                         (Int
1, ItemTimer
_ : ItemTimers
_) -> Text
"somewhat"
                         (Int
1, []) | Maybe Int -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Int
more -> Text
""
                         ItemQuant
_ | Maybe Int -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Int
more -> Text
"many-fold"
                         ItemQuant
_ -> Text
"additionally"
                     verbSave = Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$
                       Text
"become"
                       Text -> Text -> Text
<+> case ItemQuant
kit of
                         (Int
1, ItemTimer
t:ItemTimers
_) ->  -- only exceptionally not singleton list
                                      -- or even more than one copy total
                           let total :: Delta Time
total = Time -> ItemTimer -> Delta Time
deltaOfItemTimer Time
localTime ItemTimer
t
                           in Delta Time -> Text
timeDeltaInSecondsText Delta Time
total
                         (Int
1, []) | Maybe Int -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Int
more -> Text
""
                         (Int
k, ItemTimers
_) ->  -- usually the list empty; ignore anyway
                           (if Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust Maybe Int
more then Text
"additionally" else Text
"")
                           Text -> Text -> Text
<+> Int -> Text
forall a. Show a => a -> Text
tshow Int
k Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"-fold"
                           Text -> Text -> Text
<+> case Maybe Int
more of
                                 Maybe Int
Nothing -> Text
""
                                 Just Int
kTotal ->
                                   Text
"(total:" Text -> Text -> Text
<+> Int -> Text
forall a. Show a => a -> Text
tshow Int
kTotal Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"-fold)"
                     good = Benefit -> Bool
benInEqp (DiscoveryBenefit
discoBenefit DiscoveryBenefit -> ItemId -> Benefit
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ItemId
iid)
                     msgClass = case GroupName ItemKind -> [(GroupName ItemKind, Int)] -> Maybe Int
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup GroupName ItemKind
IK.S_ASLEEP ([(GroupName ItemKind, Int)] -> Maybe Int)
-> [(GroupName ItemKind, Int)] -> Maybe Int
forall a b. (a -> b) -> a -> b
$ ItemKind -> [(GroupName ItemKind, Int)]
IK.ifreq ItemKind
itemKind of
                       Just Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 -> MsgClassDistinct
MsgStatusSleep
                       Maybe Int
_ -> if | Actor -> FactionId
bfid Actor
b FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
/= FactionId
side -> MsgClassDistinct
MsgStatusOthers
                               | Bool
good -> MsgClassDistinct
MsgStatusGoodUs
                               | Bool
otherwise -> MsgClassDistinct
MsgStatusBadUs
                 -- This describes all such items already among organs,
                 -- which is useful, because it shows "charging".
                 itemAidDistinctMU msgClass aid verbShow verbSave iid
                 when (bfid b == side && not good) $
                   -- Others get conditions too often and good ones are not
                   -- dire enough and also too common.
                   tutorialHintMsgAdd TemporaryConditions
               | otherwise -> do
                 wown <- ppContainerWownW partActorLeader True c
                 itemVerbMU MsgItemCreation iid kit
                            (MU.Text $ makePhrase $ "grow" : wown) c
          CStore
_ -> do
            wown <- (ActorId -> m Part) -> Bool -> Container -> m [Part]
forall (m :: * -> *).
MonadClientUI m =>
(ActorId -> m Part) -> Bool -> Container -> m [Part]
ppContainerWownW ActorId -> m Part
forall (m :: * -> *). MonadClientUI m => ActorId -> m Part
partActorLeader Bool
True Container
c
            itemVerbMU MsgItemCreation iid kit
                       (MU.Text $ makePhrase $ "appear" : wown) c
      CEmbed{} -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()  -- not visible so can't delay even if important
      CFloor LevelId
lid Point
_ -> do
        factionD <- (State -> FactionDict) -> m FactionDict
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> FactionDict
sfactionD
        itemVerbMU MsgItemCreation iid kit
                   (MU.Text $ "appear" <+> ppContainer factionD c) c
        markDisplayNeeded lid
      CTrunk{} -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdDestroyItem Bool
verbose ItemId
iid Item
_ ItemQuant
kit Container
c ->
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
verbose (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ case Container
c of
      CActor ActorId
aid CStore
_  -> do
        b <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
        if bproj b then
          itemVerbMUShort MsgItemRuination iid kit "break" c
        else do
          ownW <- ppContainerWownW partActorLeader False c
          let verb = Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ [Part] -> Text
makePhrase ([Part] -> Text) -> [Part] -> Text
forall a b. (a -> b) -> a -> b
$ Part
"vanish from" Part -> [Part] -> [Part]
forall a. a -> [a] -> [a]
: [Part]
ownW
          itemVerbMUShort MsgItemRuination iid kit verb c
      CEmbed{} -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()  -- not visible so can't delay even if important
      CFloor LevelId
lid Point
_ -> do
        factionD <- (State -> FactionDict) -> m FactionDict
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> FactionDict
sfactionD
        itemVerbMUShort MsgItemRuination iid kit
                        (MU.Text $ "break" <+> ppContainer factionD c) c
        markDisplayNeeded lid
      CTrunk{} -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdSpotActor ActorId
aid Actor
body -> Bool -> ActorId -> Actor -> m ()
forall (m :: * -> *).
MonadClientUI m =>
Bool -> ActorId -> Actor -> m ()
createActorUI Bool
False ActorId
aid Actor
body
  UpdLoseActor ActorId
aid Actor
body -> Bool -> ActorId -> Actor -> m ()
forall (m :: * -> *).
MonadClientUI m =>
Bool -> ActorId -> Actor -> m ()
destroyActorUI Bool
False ActorId
aid Actor
body
  UpdSpotItem Bool
verbose ItemId
iid ItemQuant
kit Container
c -> Bool -> Container -> ItemBag -> m ()
forall (m :: * -> *).
MonadClientUI m =>
Bool -> Container -> ItemBag -> m ()
spotItemBag Bool
verbose Container
c (ItemBag -> m ()) -> ItemBag -> m ()
forall a b. (a -> b) -> a -> b
$ ItemId -> ItemQuant -> ItemBag
forall k a. Enum k => k -> a -> EnumMap k a
EM.singleton ItemId
iid ItemQuant
kit
  UpdLoseItem Bool
True ItemId
iid ItemQuant
kit c :: Container
c@(CActor ActorId
aid CStore
_) -> do
    b <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
    when (not (bproj b) && bhp b > 0) $ do  -- don't spam
      ownW <- ppContainerWownW partActorLeader False c
      let verb = Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ [Part] -> Text
makePhrase ([Part] -> Text) -> [Part] -> Text
forall a b. (a -> b) -> a -> b
$ Part
"be removed from" Part -> [Part] -> [Part]
forall a. a -> [a] -> [a]
: [Part]
ownW
      itemVerbMUShort MsgItemMovement iid kit verb c
  UpdLoseItem{} -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdSpotItemBag Bool
verbose Container
c ItemBag
bag -> Bool -> Container -> ItemBag -> m ()
forall (m :: * -> *).
MonadClientUI m =>
Bool -> Container -> ItemBag -> m ()
spotItemBag Bool
verbose Container
c ItemBag
bag
  UpdLoseItemBag{} -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()  -- rarely interesting and can be very long
  -- Move actors and items.
  UpdMoveActor ActorId
aid Point
source Point
target -> ActorId -> Point -> Point -> m ()
forall (m :: * -> *).
MonadClientUI m =>
ActorId -> Point -> Point -> m ()
moveActor ActorId
aid Point
source Point
target
  UpdWaitActor ActorId
aid Watchfulness
WSleep Watchfulness
_ -> do
    MsgClassShowAndSave -> ActorId -> Part -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> ActorId -> Part -> m ()
aidVerbMU MsgClassShowAndSave
MsgStatusWakeup ActorId
aid Part
"wake up"
    TutorialHints -> m ()
forall (m :: * -> *). MonadClientUI m => TutorialHints -> m ()
tutorialHintMsgAdd TutorialHints
WokenUpActors
  UpdWaitActor ActorId
aid Watchfulness
WWake Watchfulness
_ -> 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 (bfid b == side) $
      tutorialHintMsgAdd AvoidWalkingEnemies
  UpdWaitActor{} -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()  -- falling asleep handled uniformly elsewhere
  UpdDisplaceActor ActorId
source ActorId
target -> ActorId -> ActorId -> m ()
forall (m :: * -> *). MonadClientUI m => ActorId -> ActorId -> m ()
displaceActorUI ActorId
source ActorId
target
  UpdMoveItem ItemId
iid Int
k ActorId
aid CStore
c1 CStore
c2 -> ItemId -> Int -> ActorId -> CStore -> CStore -> m ()
forall (m :: * -> *).
MonadClientUI m =>
ItemId -> Int -> ActorId -> CStore -> CStore -> m ()
moveItemUI ItemId
iid Int
k ActorId
aid CStore
c1 CStore
c2
  -- Change actor attributes.
  UpdRefillHP ActorId
_ Int64
0 -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdRefillHP ActorId
aid Int64
hpDelta -> do
    let coarseDelta :: Int64
coarseDelta = Int64 -> Int64
forall a. Num a => a -> a
abs Int64
hpDelta Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`div` Int64
oneM
        tDelta :: Text
tDelta = if Int64
coarseDelta Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
0
                 then if Int64
hpDelta Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
0 then Text
"a little" else Text
"a fraction of an HP"
                 else Int64 -> Text
forall a. Show a => a -> Text
tshow Int64
coarseDelta Text -> Text -> Text
<+> Text
"HP"
    b <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
    unless (bproj b) $
      aidVerbMU MsgNumericReport aid $ MU.Text
                ((if hpDelta > 0 then "heal" else "lose") <+> tDelta)
    arena <- getArenaUI
    side <- getsClient sside
    if | bproj b && (EM.null (beqp b) || isNothing (btrajectory b)) ->
           return ()  -- ignore caught proj or one hitting a wall
       | bhp b <= 0 && hpDelta < 0
         && (bfid b == side && not (bproj b) || arena == blid b) -> do
         let (firstFall, hurtExtra) = case (bfid b == side, bproj b) of
               (Bool
True, Bool
True) -> (Part
"drop down", Part
"tumble down")
               (Bool
True, Bool
False) -> (Part
"fall down", Part
"suffer woeful mutilation")
               (Bool
False, Bool
True) -> (Part
"plummet", Part
"crash")
               (Bool
False, Bool
False) -> (Part
"collapse", Part
"be reduced to a bloody pulp")
             verbDie = if Bool
alreadyDeadBefore then Part
hurtExtra else Part
firstFall
             -- Rarely, this is wrong, because 2 other actors hit the victim
             -- at exactly the same time. No big problem. Doubled "dies"
             -- messages appears instead of "dies; is mutilated".
             alreadyDeadBefore = Actor -> Int64
bhp Actor
b Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
hpDelta Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int64
0
         tfact <- getsState $ (EM.! bfid b) . sfactionD
         bUI <- getsSession $ getActorUI aid
         subjectRaw <- partActorLeader aid
         let subject = if Bool
alreadyDeadBefore Bool -> Bool -> Bool
|| Part
subjectRaw Part -> Part -> Bool
forall a. Eq a => a -> a -> Bool
== Part
"you"
                       then Part
subjectRaw
                       else ActorUI -> Part
partActor ActorUI
bUI  -- avoid "fallen"
             msgDie = [Part] -> Text
makeSentence [Part -> Part -> Part
MU.SubjectVerbSg Part
subject Part
verbDie]
             targetIsFoe = FactionId -> Faction -> FactionId -> Bool
isFoe (Actor -> FactionId
bfid Actor
b) Faction
tfact FactionId
side
             targetIsFriend = FactionId -> Faction -> FactionId -> Bool
isFriend (Actor -> FactionId
bfid Actor
b) Faction
tfact FactionId
side
             msgClass | Actor -> Bool
bproj Actor
b = MsgClassShowAndSave
MsgDeathBoring
                      | Bool
targetIsFoe = MsgClassShowAndSave
MsgDeathVictory
                      | Bool
targetIsFriend = MsgClassShowAndSave
MsgDeathDeafeat
                      | Bool
otherwise = MsgClassShowAndSave
MsgDeathBoring
         if | bproj b -> msgAdd msgClass msgDie
            | bfid b == side -> do
              msgLnAdd msgClass $ msgDie <+> "Alas!"
              displayMore ColorBW ""
            | otherwise -> msgLnAdd msgClass msgDie
         -- We show death anims only if not dead already before this refill.
         let deathAct = if Actor -> FactionId
bfid Actor
b FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side
                        then Point -> Animation
deathBody (Actor -> Point
bpos Actor
b)
                        else Point -> Animation
shortDeathBody (Actor -> Point
bpos Actor
b)
         unless (bproj b || alreadyDeadBefore) $ animate (blid b) deathAct
       | otherwise -> do
         when (hpDelta >= bhp b && bhp b > 0) $
           aidVerbMU MsgActionWarning aid "return from the brink of death"
         mleader <- getsClient sleader
         when (Just aid == mleader) $ do
           actorMaxSk <- getsState $ getActorMaxSkills aid
           -- Regenerating actors never stop gaining HP, so we need to stop
           -- reporting it after they reach full HP for the first time.
           -- Also, no spam for non-leaders.
           when (bhp b >= xM (Ability.getSk Ability.SkMaxHP actorMaxSk)
                 && bhp b - hpDelta < xM (Ability.getSk Ability.SkMaxHP
                                                  actorMaxSk)) $
             msgAdd MsgSpecialEvent "You recover your health fully. Any further gains will be transient."
         when (bfid b == side && not (bproj b)) $ do
           when (abs hpDelta >= oneM) $ markDisplayNeeded (blid b)
           when (hpDelta < 0) $ do
             when (hpDelta <= xM (-3)) $ tutorialHintMsgAdd AlotOfDamageFromOneSource
             sUIOptions <- getsSession sUIOptions
             currentWarning <-
               getsState $ checkWarningHP sUIOptions aid (bhp b)
             when currentWarning $ do
               previousWarning <-
                 getsState $ checkWarningHP sUIOptions aid (bhp b - hpDelta)
               unless previousWarning $
                 aidVerbMU MsgRiskOfDeath aid
                           "be down to a dangerous health level"
  UpdRefillCalm ActorId
_ Int64
0 -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdRefillCalm ActorId
aid Int64
calmDelta -> 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
    when (bfid b == side && not (bproj b)) $ do
      if | calmDelta > 0 -> do  -- regeneration or effect
           mleader <- getsClient sleader
           when (Just aid == mleader) $ do
             actorMaxSk <- getsState $ getActorMaxSkills aid
             let bPrev = Actor
b {bcalm = bcalm b - calmDelta}
             when (calmEnough b actorMaxSk
                   && not (calmEnough bPrev actorMaxSk)) $
               msgAdd MsgSpecialEvent "You are again calm enough to manage your equipment outfit."
           -- If the leader regenerates Calm more often than once per
           -- standard game turn, this will not be reflected, for smoother
           -- and faster display. However, every halt for keypress
           -- shows Calm, so this only matters for macros, where speed is good.
           when (abs calmDelta > oneM) $ markDisplayNeeded (blid b)
         | calmDelta == minusM1 -> do
           fact <- getsState $ (EM.! side) . sfactionD
           s <- getState
           let closeFoe (!Point
p, ActorId
aid2) =  -- mimics isHeardFoe
                 let b2 :: Actor
b2 = ActorId -> State -> Actor
getActorBody ActorId
aid2 State
s
                 in (Point -> Point -> Int) -> Point -> Point -> Int
forall a. a -> a
inline Point -> Point -> Int
chessDist Point
p (Actor -> Point
bpos Actor
b) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
3
                    Bool -> Bool -> Bool
&& Bool -> Bool
not (Actor -> Bool
actorWaitsOrSleeps Actor
b2)  -- uncommon
                    Bool -> Bool -> Bool
&& (FactionId -> Faction -> FactionId -> Bool)
-> FactionId -> Faction -> FactionId -> Bool
forall a. a -> a
inline FactionId -> Faction -> FactionId -> Bool
isFoe FactionId
side Faction
fact (Actor -> FactionId
bfid Actor
b2)  -- costly
               anyCloseFoes = ((Point, ActorId) -> Bool) -> [(Point, ActorId)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Point, ActorId) -> Bool
closeFoe ([(Point, ActorId)] -> Bool) -> [(Point, ActorId)] -> Bool
forall a b. (a -> b) -> a -> b
$ EnumMap Point ActorId -> [(Point, ActorId)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs (EnumMap Point ActorId -> [(Point, ActorId)])
-> EnumMap Point ActorId -> [(Point, ActorId)]
forall a b. (a -> b) -> a -> b
$ Level -> EnumMap Point ActorId
lbig
                                           (Level -> EnumMap Point ActorId) -> Level -> EnumMap Point ActorId
forall a b. (a -> b) -> a -> b
$ State -> Dungeon
sdungeon State
s Dungeon -> LevelId -> Level
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> LevelId
blid Actor
b
           unless anyCloseFoes $ do  -- obvious where the feeling comes from
             duplicated <- aidVerbDuplicateMU MsgHeardNearby aid
                                              "hear something"
             unless duplicated stopPlayBack
         | otherwise ->  -- low deltas from hits; displayed elsewhere
           return ()
      when (calmDelta < 0) $ do
        sUIOptions <- getsSession sUIOptions
        currentWarning <-
          getsState $ checkWarningCalm sUIOptions aid (bcalm b)
        when currentWarning $ do
          previousWarning <-
            getsState $ checkWarningCalm sUIOptions aid (bcalm b - calmDelta)
          unless previousWarning $
            -- This messages is not shown if impression happens after
            -- Calm is low enough. However, this is rare and HUD shows the red.
            aidVerbMU MsgRiskOfDeath aid
                      "have grown agitated and impressed enough to be in danger of defecting"
  UpdTrajectory ActorId
_ Maybe ([Vector], Speed)
_ Maybe ([Vector], Speed)
mt ->  -- if projectile dies just after, force one frame
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe ([Vector], Speed) -> Bool
forall a. Maybe a -> Bool
isNothing Maybe ([Vector], Speed)
mt) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Bool -> m ()
forall (m :: * -> *). MonadClientUI m => Bool -> m ()
pushFrame Bool
False
  -- Change faction attributes.
  UpdQuitFaction FactionId
fid Maybe Status
_ Maybe Status
toSt Maybe (FactionAnalytics, GenerationAnalytics)
manalytics -> FactionId
-> Maybe Status
-> Maybe (FactionAnalytics, GenerationAnalytics)
-> m ()
forall (m :: * -> *).
MonadClientUI m =>
FactionId
-> Maybe Status
-> Maybe (FactionAnalytics, GenerationAnalytics)
-> m ()
quitFactionUI FactionId
fid Maybe Status
toSt Maybe (FactionAnalytics, GenerationAnalytics)
manalytics
  UpdSpotStashFaction Bool
verbose FactionId
fid LevelId
lid Point
pos -> 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
    when verbose $ do
      if fid == side then
        msgLnAdd MsgFactionIntel
                 "You set up the shared inventory stash of your team."
      else do
        fact <- getsState $ (EM.! fid) . sfactionD
        let fidName = Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ Faction -> Text
gname Faction
fact
        msgAdd MsgFactionIntel $
          makeSentence [ "you have found the current"
                       , MU.WownW fidName "hoard location" ]
    unless (fid == side) $
      animate lid $ actorX pos
  UpdLoseStashFaction Bool
verbose FactionId
fid LevelId
lid Point
pos -> do
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
verbose (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ 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
      if fid == side then
        msgAdd MsgFactionIntel
               "You've lost access to your shared inventory stash!"
      else do
        fact <- getsState $ (EM.! fid) . sfactionD
        let fidName = Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ Faction -> Text
gname Faction
fact
        msgAdd MsgFactionIntel $
          makeSentence [fidName, "no longer control their hoard"]
    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 -> Animation
vanish Point
pos
  UpdLeadFaction FactionId
fid (Just ActorId
source) mtgt :: Maybe ActorId
mtgt@(Just ActorId
target) -> 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
    when (mtgt /= mleader) $ do
      fact <- getsState $ (EM.! fid) . sfactionD
      lidV <- viewedLevelUI
      when (gunderAI 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 Actor
sb | Actor -> Int64
bhp Actor
sb Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int64
0 -> Bool -> m () -> m ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Actor -> Bool
bproj Actor
sb) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
          -- Regardless who the leader is, give proper names here, not 'you'.
          sbUI <- (SessionUI -> ActorUI) -> m ActorUI
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession ((SessionUI -> ActorUI) -> m ActorUI)
-> (SessionUI -> ActorUI) -> m ActorUI
forall a b. (a -> b) -> a -> b
$ ActorId -> SessionUI -> ActorUI
getActorUI ActorId
source
          tbUI <- getsSession $ getActorUI target
          let subject = ActorUI -> Part
partActor ActorUI
tbUI
              object  = ActorUI -> Part
partActor ActorUI
sbUI
          msgAdd MsgPointmanSwap $
            makeSentence [ MU.SubjectVerbSg subject "take command"
                         , "from", object ]
        Maybe Actor
_ -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      lookAtMove target
  UpdLeadFaction FactionId
_ Maybe ActorId
Nothing mtgt :: Maybe ActorId
mtgt@(Just ActorId
target) -> 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
    when (mtgt /= mleader) $
      lookAtMove target
  UpdLeadFaction{} -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdDiplFaction FactionId
fid1 FactionId
fid2 Diplomacy
_ Diplomacy
toDipl -> do
    name1 <- (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
fid1) (FactionDict -> Faction)
-> (State -> FactionDict) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> FactionDict
sfactionD
    name2 <- getsState $ gname . (EM.! fid2) . sfactionD
    msgAdd MsgFactionIntel $
      name1 <+> "and" <+> name2 <+> "are now" <+> tshowDiplomacy toDipl <> "."
  UpdDoctrineFaction{} -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdAutoFaction FactionId
fid Bool
b -> 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
    lidV <- viewedLevelUI
    markDisplayNeeded lidV
    when (fid == side) $ do
      unless b $
        -- Clear macros and invoke a special main menu entrance macro
        -- that sets @swasAutomated@, preparing for AI control at exit.
        modifySession $ \SessionUI
sess ->
          SessionUI
sess { smacroFrame =
                   emptyMacroFrame {keyPending = KeyMacro [K.controlEscKM]}
               , smacroStack = [] }
      setFrontAutoYes b  -- now can start/stop auto-accepting prompts
  UpdRecordKill{} -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  -- Alter map.
  UpdAlterTile LevelId
lid Point
p ContentId TileKind
fromTile ContentId TileKind
toTile -> 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
    markDisplayNeeded lid
    let feats = TileKind -> [Feature]
TK.tfeature (TileKind -> [Feature]) -> TileKind -> [Feature]
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
        toAlter Feature
feat =
          case Feature
feat of
            TK.OpenTo GroupName TileKind
tgroup -> GroupName TileKind -> Maybe (GroupName TileKind)
forall a. a -> Maybe a
Just GroupName TileKind
tgroup
            TK.CloseTo GroupName TileKind
tgroup -> GroupName TileKind -> Maybe (GroupName TileKind)
forall a. a -> Maybe a
Just GroupName TileKind
tgroup
            TK.ChangeTo GroupName TileKind
tgroup -> GroupName TileKind -> Maybe (GroupName TileKind)
forall a. a -> Maybe a
Just GroupName TileKind
tgroup
            TK.OpenWith ProjectileTriggers
_ [(Int, GroupName ItemKind)]
_ GroupName TileKind
tgroup -> GroupName TileKind -> Maybe (GroupName TileKind)
forall a. a -> Maybe a
Just GroupName TileKind
tgroup
            TK.CloseWith ProjectileTriggers
_ [(Int, GroupName ItemKind)]
_ GroupName TileKind
tgroup -> GroupName TileKind -> Maybe (GroupName TileKind)
forall a. a -> Maybe a
Just GroupName TileKind
tgroup
            TK.ChangeWith ProjectileTriggers
_ [(Int, GroupName ItemKind)]
_ GroupName TileKind
tgroup -> GroupName TileKind -> Maybe (GroupName TileKind)
forall a. a -> Maybe a
Just GroupName TileKind
tgroup
            Feature
_ -> Maybe (GroupName TileKind)
forall a. Maybe a
Nothing
        groupsToAlterTo = (Feature -> Maybe (GroupName TileKind))
-> [Feature] -> [GroupName TileKind]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Feature -> Maybe (GroupName TileKind)
toAlter [Feature]
feats
        freq = ((GroupName TileKind, Int) -> GroupName TileKind)
-> [(GroupName TileKind, Int)] -> [GroupName TileKind]
forall a b. (a -> b) -> [a] -> [b]
map (GroupName TileKind, Int) -> GroupName TileKind
forall a b. (a, b) -> a
fst ([(GroupName TileKind, Int)] -> [GroupName TileKind])
-> [(GroupName TileKind, Int)] -> [GroupName TileKind]
forall a b. (a -> b) -> a -> b
$ ((GroupName TileKind, Int) -> Bool)
-> [(GroupName TileKind, Int)] -> [(GroupName TileKind, Int)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(GroupName TileKind
_, Int
q) -> Int
q Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0)
               ([(GroupName TileKind, Int)] -> [(GroupName TileKind, Int)])
-> [(GroupName TileKind, Int)] -> [(GroupName TileKind, Int)]
forall a b. (a -> b) -> a -> b
$ TileKind -> [(GroupName TileKind, Int)]
TK.tfreq (TileKind -> [(GroupName TileKind, Int)])
-> TileKind -> [(GroupName TileKind, Int)]
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
toTile
        unexpected = [GroupName TileKind] -> Bool
forall a. [a] -> Bool
null ([GroupName TileKind] -> Bool) -> [GroupName TileKind] -> Bool
forall a b. (a -> b) -> a -> b
$ [GroupName TileKind]
-> [GroupName TileKind] -> [GroupName TileKind]
forall a. Eq a => [a] -> [a] -> [a]
intersect [GroupName TileKind]
freq [GroupName TileKind]
groupsToAlterTo
    mactorAtPos <- getsState $ posToBig p lid
    mleader <- getsClient sleader
    when (unexpected || isJust mactorAtPos && mactorAtPos /= mleader) $ do
      -- Faction 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 = Part
""  -- a hack, because we don't handle adverbs well
          verb = Part
"turn into"
          msg = [Part] -> Text
makeSentence ([Part] -> Text) -> [Part] -> Text
forall a b. (a -> b) -> a -> b
$
            [ Part
"the", 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
            , Part
"at position", Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ Point -> Text
forall a. Show a => a -> Text
tshow Point
p ]
            [Part] -> [Part] -> [Part]
forall a. [a] -> [a] -> [a]
++ [Part
"suddenly" | Bool
unexpected]  -- adverb
            [Part] -> [Part] -> [Part]
forall a. [a] -> [a] -> [a]
++ [ Part -> Part -> Part
MU.SubjectVerbSg Part
subject Part
verb
               , 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
toTile ]
      msgAdd (if unexpected then MsgSpecialEvent else MsgNeutralEvent) msg
  UpdAlterExplorable LevelId
lid Int
_ -> LevelId -> m ()
forall (m :: * -> *). MonadClientUI m => LevelId -> m ()
markDisplayNeeded LevelId
lid
  UpdAlterGold{} -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()  -- not displayed on HUD
  UpdSearchTile ActorId
aid Point
_p ContentId TileKind
toTile -> 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
    subject <- partActorLeader aid
    let fromTile = ContentId TileKind
-> Maybe (ContentId TileKind) -> ContentId TileKind
forall a. a -> Maybe a -> a
fromMaybe (String -> ContentId TileKind
forall a. (?callStack::CallStack) => String -> a
error (String -> ContentId TileKind) -> String -> ContentId TileKind
forall a b. (a -> b) -> a -> b
$ ContentId TileKind -> String
forall a. Show a => a -> String
show ContentId TileKind
toTile) (Maybe (ContentId TileKind) -> ContentId TileKind)
-> Maybe (ContentId TileKind) -> ContentId TileKind
forall a b. (a -> b) -> a -> b
$ ContentData TileKind
-> ContentId TileKind -> Maybe (ContentId TileKind)
Tile.hideAs ContentData TileKind
cotile ContentId TileKind
toTile
        subject2 = 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
        object = 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
toTile
    let msg = [Part] -> Text
makeSentence [ Part -> Part -> Part
MU.SubjectVerbSg Part
subject Part
"reveal"
                           , Part
"that the"
                           , Part -> Part -> Part
MU.SubjectVerbSg Part
subject2 Part
"be"
                           , Part -> Part
MU.AW Part
object ]
    unless (subject2 == object) $ do
      msgAdd MsgTerrainReveal msg
      tutorialHintMsgAdd TerrainNotFullyKnown
  UpdHideTile{} -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdSpotTile{} -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdLoseTile{} -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdSpotEntry{} -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdLoseEntry{} -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdAlterSmell{} -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdSpotSmell{} -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdLoseSmell{} -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  -- Assorted.
  UpdTimeItem{} -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdAgeGame{} -> do
    sdisplayNeeded <- (SessionUI -> Bool) -> m Bool
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Bool
sdisplayNeeded
    sturnDisplayed <- getsSession sturnDisplayed
    time <- getsState stime
    let clipN = Time
time Time -> Time -> Int
`timeFit` Time
timeClip
        clipMod = Int
clipN Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
clipsInTurn
        turnPing = Int
clipMod Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0  -- e.g., to see resting counter
    if | sdisplayNeeded -> pushFrame True
           -- adds delay, because it's not an extra animation-like frame,
           -- but showing some real information accumulated up to this point
       | turnPing && not sturnDisplayed -> pushFrame False
       | otherwise -> return ()
    when turnPing $
      modifySession $ \SessionUI
sess -> SessionUI
sess {sturnDisplayed = False}
  UpdUnAgeGame{} -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdDiscover Container
c ItemId
iid ContentId ItemKind
_ AspectRecord
_ -> Container -> ItemId -> m ()
forall (m :: * -> *).
MonadClientUI m =>
Container -> ItemId -> m ()
discover Container
c ItemId
iid
  UpdCover{} -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()  -- don't spam when doing undo
  UpdDiscoverKind{} -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()  -- don't spam when server tweaks stuff
  UpdCoverKind{} -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()  -- don't spam when doing undo
  UpdDiscoverAspect{} -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()  -- don't spam when server tweaks stuff
  UpdCoverAspect{} -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()  -- don't spam when doing undo
  UpdDiscoverServer{} -> String -> m ()
forall a. (?callStack::CallStack) => String -> a
error String
"server command leaked to client"
  UpdCoverServer{} -> String -> m ()
forall a. (?callStack::CallStack) => String -> a
error String
"server command leaked to client"
  UpdPerception{} -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdRestart FactionId
fid PerLid
_ State
_ Challenge
_ ClientOptions
_ SMGen
srandom -> do
    cops@COps{cocave, comode, corule} <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
    oldSess <- getSession
    snxtChal <- getsClient snxtChal
    noConfirmsGame <- isNoConfirmsGame
    let uiOptions = SessionUI -> UIOptions
sUIOptions SessionUI
oldSess
        f ![a]
acc p
_p !a
i p
_a = a
i a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
acc
        modes = [Int] -> [ContentId ModeKind] -> [(Int, ContentId ModeKind)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([ContentId ModeKind] -> [(Int, ContentId ModeKind)])
-> [ContentId ModeKind] -> [(Int, ContentId ModeKind)]
forall a b. (a -> b) -> a -> b
$ ContentData ModeKind
-> GroupName ModeKind
-> ([ContentId ModeKind]
    -> Int -> ContentId ModeKind -> ModeKind -> [ContentId ModeKind])
-> [ContentId ModeKind]
-> [ContentId ModeKind]
forall a b.
ContentData a
-> GroupName a -> (b -> Int -> ContentId a -> a -> b) -> b -> b
ofoldlGroup' ContentData ModeKind
comode GroupName ModeKind
CAMPAIGN_SCENARIO [ContentId ModeKind]
-> Int -> ContentId ModeKind -> ModeKind -> [ContentId ModeKind]
forall {a} {p} {p}. [a] -> p -> a -> p -> [a]
f []
        g :: (Int, ContentId ModeKind) -> Int
        g (Int
_, ContentId ModeKind
mode) = case ContentId ModeKind
-> EnumMap (ContentId ModeKind) (Map Challenge Int)
-> Maybe (Map Challenge Int)
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup ContentId ModeKind
mode (SessionUI -> EnumMap (ContentId ModeKind) (Map Challenge Int)
svictories SessionUI
oldSess) of
          Maybe (Map Challenge Int)
Nothing -> Int
0
          Just Map Challenge Int
cm -> Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (Challenge -> Map Challenge Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Challenge
snxtChal Map Challenge Int
cm)
        (snxtScenario, _) = minimumBy (comparing g) modes
        nxtGameTutorial = ModeKind -> Bool
MK.mtutorial (ModeKind -> Bool) -> ModeKind -> Bool
forall a b. (a -> b) -> a -> b
$ (ContentId ModeKind, ModeKind) -> ModeKind
forall a b. (a, b) -> b
snd ((ContentId ModeKind, ModeKind) -> ModeKind)
-> (ContentId ModeKind, ModeKind) -> ModeKind
forall a b. (a -> b) -> a -> b
$ COps -> Int -> (ContentId ModeKind, ModeKind)
nxtGameMode COps
cops Int
snxtScenario
    putSession $
      (emptySessionUI uiOptions)
        { schanF = schanF oldSess
        , sccui = sccui oldSess
        , shistory = shistory oldSess
        , svictories = svictories oldSess
        , scampings = scampings oldSess
        , srestarts = srestarts oldSess
        , smarkVision = smarkVision oldSess
        , smarkSmell = smarkSmell oldSess
        , snxtScenario
        , scurTutorial = noConfirmsGame || snxtTutorial oldSess
            -- make sure a newbie interrupting a screensaver has ample help
        , snxtTutorial = nxtGameTutorial
        , soverrideTut = soverrideTut oldSess
        , sstart = sstart oldSess
        , sgstart = sgstart oldSess
        , sallTime = sallTime oldSess
        , snframes = snframes oldSess
        , sallNframes = sallNframes oldSess
        , srandomUI = srandom
        }
    when (sstart oldSess == 0) resetSessionStart
    when (lengthHistory (shistory oldSess) == 0) $ do
      -- Generate initial history. Only for UI clients.
      shistory <- defaultHistory
      modifySession $ \SessionUI
sess -> SessionUI
sess {shistory}
      let title = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ RuleContent -> String
rtitle RuleContent
corule
      msgAdd MsgBookKeeping $ "Welcome to" <+> title <> "!"
    recordHistory  -- to ensure EOL even at creation of history
    lid <- getArenaUI
    lvl <- getLevel lid
    gameMode <- getGameMode
    curChal <- getsClient scurChal
    fact <- getsState $ (EM.! fid) . sfactionD
    let loneMode = case Faction -> [(Int, Int, GroupName ItemKind)]
ginitial Faction
fact of
          [] -> Bool
True
          [(Int
_, Int
1, GroupName ItemKind
_)] -> Bool
True
          [(Int, Int, GroupName ItemKind)]
_ -> Bool
False
    msgAdd MsgBookKeeping "-------------------------------------------------"
    recordHistory
    msgAdd MsgPromptGeneric
           "A grand story starts right here! (Press '?' for mode description and help.)"
    if lengthHistory (shistory oldSess) > 1
      then fadeOutOrIn False
      else pushReportFrame  -- show anything ASAP
    msgAdd MsgActionWarning
           ("New game started in" <+> mname gameMode <+> "mode.")
    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) $ do
      msgLnAdd MsgBackdropFocus "You take in your surroundings."
      msgAdd MsgBackdropInfo desc
    -- We can fool the player only once (per scenario), but let's not do it
    -- in the same way each time. TODO: PCG
    blurb <- rndToActionUI $ oneOf
      [ "You think you saw movement."
      , "Something catches your peripherial vision."
      , "You think you felt a tremor under your feet."
      , "A whiff of chilly air passes around you."
      , "You notice a draft just when it dies down."
      , "The ground nearby is stained along some faint lines."
      , "Scarce black motes slowly settle on the ground."
      , "The ground in the immediate area is empty, as if just swiped."
      ]
    msgLnAdd MsgBadMiscEvent blurb  -- being here is a bad turn of events
    when (cwolf curChal && not loneMode) $
      msgAdd MsgActionWarning "Being a lone wolf, you begin without companions."
    setFrontAutoYes $ gunderAI fact
    -- Forget the furious keypresses when dying in the previous game.
    resetPressedKeys
  UpdRestartServer{} -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdResume FactionId
fid PerLid
_ -> 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
    resetSessionStart
    fact <- getsState $ (EM.! fid) . sfactionD
    setFrontAutoYes $ gunderAI fact
    unless (gunderAI fact) $ do
      lid <- getArenaUI
      lvl <- getLevel lid
      gameMode <- getGameMode
      msgAdd MsgPromptGeneric
             "Welcome back! (Press '?' for mode description and help.)"
      pushReportFrame  -- show anything ASAP
      msgAdd MsgActionAlert $ "Continuing" <+> mname gameMode <+> "mode."
      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) $ do
        msgLnAdd MsgPromptFocus "You remember your surroundings."
        msgAdd MsgPromptGeneric desc
  UpdResumeServer{} -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdKillExit{} -> do
#ifdef USE_JSFILE
      -- Some browsers seem to trash Local Storage when page reloaded or closed
      -- or the browser closed, while they still internally finish the saving
      -- in the background, so wait 2s. If the exit is without a save,
      -- the wait is spurious, but it's not supposed to be common.
      -- TODO: replace the @liftIO@ with a @MonadClientUI@ delay function.
    liftIO $ threadDelay 2000000
#else
    IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadClientRead m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> IO ()
threadDelay Int
200000
#endif
    -- The prompt is necessary to force frontend to show this before exiting.
    m () -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ ColorMode -> Text -> m ()
forall (m :: * -> *). MonadClientUI m => ColorMode -> Text -> m ()
displayMore ColorMode
ColorBW Text
"Done."  -- in case it follows "Saving..."
    side <- (StateClient -> FactionId) -> m FactionId
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
    debugPossiblyPrintUI $ "Client" <+> tshow side <+> "closing frontend."
    frontendShutdown
    debugPossiblyPrintUI $ "Client" <+> tshow side <+> "closed frontend."
  UpdAtomic
UpdWriteSave -> MsgClassSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassSave
MsgInnerWorkSpam Text
"Saving backup."
  UpdHearFid FactionId
_ Maybe Int
distance HearMsg
hearMsg -> 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
    msg <- ppHearMsg distance hearMsg
    let msgClass = case Maybe Int
distance of
          Maybe Int
Nothing -> MsgClassShowAndSave
MsgHeardOutside
          Just Int
0 -> MsgClassShowAndSave
MsgHeardNearby
          Just Int
_ -> MsgClassShowAndSave
MsgHeardFaraway
    msgAdd msgClass msg
    case hearMsg of
      HearUpd UpdDestroyActor{} ->
        TutorialHints -> m ()
forall (m :: * -> *). MonadClientUI m => TutorialHints -> m ()
tutorialHintMsgAdd TutorialHints
OutOfSightEvents
      HearTaunt{} -> do
        globalTime <- (State -> Time) -> m Time
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> Time
stime
        when (globalTime > timeTurn) $  -- avoid too many hints at the start
          tutorialHintMsgAdd HearingRadius
      HearMsg
_ -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdMuteMessages FactionId
_ Bool
smuteMessages ->
    (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \SessionUI
sess -> SessionUI
sess {smuteMessages}

assignItemRole :: MonadClientUI m => Container -> ItemId -> m ()
assignItemRole :: forall (m :: * -> *).
MonadClientUI m =>
Container -> ItemId -> m ()
assignItemRole Container
c ItemId
iid = do
  arItem <- (State -> AspectRecord) -> m AspectRecord
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> AspectRecord) -> m AspectRecord)
-> (State -> AspectRecord) -> m AspectRecord
forall a b. (a -> b) -> a -> b
$ ItemId -> State -> AspectRecord
aspectRecordFromIid ItemId
iid
  let assignSingleRole SLore
lore = do
        ItemRoles itemRoles <- (SessionUI -> ItemRoles) -> m ItemRoles
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> ItemRoles
sroles
        let itemRole = EnumMap SLore (EnumSet ItemId)
itemRoles EnumMap SLore (EnumSet ItemId) -> SLore -> EnumSet ItemId
forall k a. Enum k => EnumMap k a -> k -> a
EM.! SLore
lore
        unless (iid `ES.member` itemRole) $ do
          let newRoles = EnumMap SLore (EnumSet ItemId) -> ItemRoles
ItemRoles (EnumMap SLore (EnumSet ItemId) -> ItemRoles)
-> EnumMap SLore (EnumSet ItemId) -> ItemRoles
forall a b. (a -> b) -> a -> b
$ (EnumSet ItemId -> EnumSet ItemId)
-> SLore
-> EnumMap SLore (EnumSet ItemId)
-> EnumMap SLore (EnumSet ItemId)
forall k a. Enum k => (a -> a) -> k -> EnumMap k a -> EnumMap k a
EM.adjust (ItemId -> EnumSet ItemId -> EnumSet ItemId
forall k. Enum k => k -> EnumSet k -> EnumSet k
ES.insert ItemId
iid) SLore
lore EnumMap SLore (EnumSet ItemId)
itemRoles
          modifySession $ \SessionUI
sess -> SessionUI
sess {sroles = newRoles}
      slore = AspectRecord -> Container -> SLore
IA.loreFromContainer AspectRecord
arItem Container
c
  assignSingleRole slore
  when (slore `elem` [SOrgan, STrunk, SCondition]) $
    assignSingleRole SBody

data Threat =
    ThreatNone
  | ThreatUnarmed
  | ThreatArmed
  | ThreatAnotherUnarmed
  | ThreatAnotherArmed
  deriving Threat -> Threat -> Bool
(Threat -> Threat -> Bool)
-> (Threat -> Threat -> Bool) -> Eq Threat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Threat -> Threat -> Bool
== :: Threat -> Threat -> Bool
$c/= :: Threat -> Threat -> Bool
/= :: Threat -> Threat -> Bool
Eq

createActorUI :: MonadClientUI m => Bool -> ActorId -> Actor -> m ()
createActorUI :: forall (m :: * -> *).
MonadClientUI m =>
Bool -> ActorId -> Actor -> m ()
createActorUI Bool
born ActorId
aid Actor
body = 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
  side <- getsClient sside
  factionD <- getsState sfactionD
  let fact = FactionDict
factionD FactionDict -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
body
  localTime <- getsState $ getLocalTime $ blid body
  itemFull@ItemFull{itemBase, itemKind} <- getsState $ itemToFull (btrunk body)
  actorUI <- getsSession sactorUI
  let arItem = ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFull
  unless (aid `EM.member` actorUI) $ do
    UIOptions{uHeroNames} <- getsSession sUIOptions
    let baseColor = Flavour -> Color
flavourToColor (Flavour -> Color) -> Flavour -> Color
forall a b. (a -> b) -> a -> b
$ Item -> Flavour
jflavour Item
itemBase
        basePronoun | Bool -> Bool
not (Actor -> Bool
bproj Actor
body)
                      Bool -> Bool -> Bool
&& ItemKind -> Char
IK.isymbol ItemKind
itemKind Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'@'
                      Bool -> Bool -> Bool
&& FactionKind -> Bool
fhasGender (Faction -> FactionKind
gkind Faction
fact) = Text
"he"
                    | Bool
otherwise = Text
"it"
        nameFromNumber Text
fn a
k = if a
k a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0
                              then [Part] -> Text
makePhrase [Part -> Part
MU.Ws (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ Text -> Part
MU.Text Text
fn, Part
"Captain"]
                              else Text
fn Text -> Text -> Text
<+> a -> Text
forall a. Show a => a -> Text
tshow a
k
        heroNamePronoun Int
k =
          if Faction -> Color
gcolor Faction
fact Color -> Color -> Bool
forall a. Eq a => a -> a -> Bool
/= Color
Color.BrWhite
          then (Text -> Int -> Text
forall {a}. (Eq a, Num a, Show a) => Text -> a -> Text
nameFromNumber (FactionKind -> Text
fname (FactionKind -> Text) -> FactionKind -> Text
forall a b. (a -> b) -> a -> b
$ Faction -> FactionKind
gkind Faction
fact) Int
k, Text
"he")
          else (Text, Text) -> Maybe (Text, Text) -> (Text, Text)
forall a. a -> Maybe a -> a
fromMaybe (Text -> Int -> Text
forall {a}. (Eq a, Num a, Show a) => Text -> a -> Text
nameFromNumber (FactionKind -> Text
fname (FactionKind -> Text) -> FactionKind -> Text
forall a b. (a -> b) -> a -> b
$ Faction -> FactionKind
gkind Faction
fact) Int
k, Text
"he")
               (Maybe (Text, Text) -> (Text, Text))
-> Maybe (Text, Text) -> (Text, Text)
forall a b. (a -> b) -> a -> b
$ Int -> [(Int, (Text, Text))] -> Maybe (Text, Text)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Int
k [(Int, (Text, Text))]
uHeroNames
        (n, bsymbol) =
          if | bproj body -> (0, if IA.checkFlag Ability.Blast arItem
                                 then IK.isymbol itemKind
                                 else '*')
             | baseColor /= Color.BrWhite -> (0, IK.isymbol itemKind)
             | otherwise -> case bnumber body of
                 Maybe Int
Nothing ->
                   String -> (Int, Char)
forall a. (?callStack::CallStack) => String -> a
error (String -> (Int, Char)) -> String -> (Int, Char)
forall a b. (a -> b) -> a -> b
$ String
"numbered actor without server-assigned number"
                           String -> (ActorId, Actor) -> String
forall v. Show v => String -> v -> String
`showFailure` (ActorId
aid, Actor
body)
                 Just Int
bn -> (Int
bn, if Int
0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
bn Bool -> Bool -> Bool
&& Int
bn Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
10
                                 then Int -> Char
Char.intToDigit Int
bn
                                 else Char
'@')
        (object1, object2) =
          partItemShortest rwidth (bfid body) factionD localTime
                           itemFull quantSingle
        (bname, bpronoun) =
          if | bproj body ->
               let adj = case Actor -> Maybe ([Vector], Speed)
btrajectory Actor
body of
                     Just ([Vector]
tra, Speed
_) | [Vector] -> Int
forall a. [a] -> Int
length [Vector]
tra Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
5 -> Part
"falling"
                     Maybe ([Vector], Speed)
_ -> Part
"flying"
               in (makePhrase [adj, object1, object2], basePronoun)
             | baseColor /= Color.BrWhite ->
               (makePhrase [object1, object2], basePronoun)
             | otherwise -> heroNamePronoun n
        bcolor | Actor -> Bool
bproj Actor
body = if Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Blast AspectRecord
arItem
                              then Color
baseColor
                              else Color
Color.BrWhite
               | Color
baseColor Color -> Color -> Bool
forall a. Eq a => a -> a -> Bool
== Color
Color.BrWhite = Faction -> Color
gcolor Faction
fact
               | Bool
otherwise = Color
baseColor
        bUI = ActorUI{Char
Text
Color
bsymbol :: Char
bname :: Text
bpronoun :: Text
bcolor :: Color
bcolor :: Color
bpronoun :: Text
bname :: Text
bsymbol :: Char
..}
    modifySession $ \SessionUI
sess ->
      SessionUI
sess {sactorUI = EM.insert aid bUI actorUI}
  mapM_ (\(ItemId
iid, CStore
store) -> do
           let c :: Container
c = if Bool -> Bool
not (Actor -> Bool
bproj Actor
body) Bool -> Bool -> Bool
&& ItemId
iid ItemId -> ItemId -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> ItemId
btrunk Actor
body
                   then FactionId -> LevelId -> Point -> Container
CTrunk (Actor -> FactionId
bfid Actor
body) (Actor -> LevelId
blid Actor
body) (Actor -> Point
bpos Actor
body)
                   else ActorId -> CStore -> Container
CActor ActorId
aid CStore
store
           Container -> ItemId -> m ()
forall (m :: * -> *).
MonadClientUI m =>
Container -> ItemId -> m ()
assignItemRole Container
c ItemId
iid
           ItemId -> Container -> m ()
forall (m :: * -> *).
MonadClientUI m =>
ItemId -> Container -> m ()
recordItemLid ItemId
iid Container
c)
        ((btrunk body, CEqp)  -- store will be overwritten, unless projectile
         : filter ((/= btrunk body) . fst) (getCarriedIidCStore body))
  if | bproj body -> do
       when (bfid body /= side)
         stopPlayBack
       pushFrame False  -- make sure first (seen (again)) position displayed
     | bfid body == side -> do
       let upd = ActorId -> EnumSet ActorId -> EnumSet ActorId
forall k. Enum k => k -> EnumSet k -> EnumSet k
ES.insert ActorId
aid
       modifySession $ \SessionUI
sess -> SessionUI
sess {sselected = upd $ sselected sess}
       unless (EM.null actorUI) $ do  -- don't announce the very first party member
         when born $ do
           let verb = Part
"join you"
           aidVerbMU MsgSpottedActor aid verb
           tutorialHintMsgAdd SwitchTeammate
           animate (blid body) $ actorX (bpos body)
     | otherwise -> do
       -- 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
       then markDisplayNeeded (blid body)
       else do
         stopPlayBack
         let verb = if Bool
born then Part
"appear suddenly" else Part
"be spotted"
         threat <-
           if isFoe (bfid body) fact side then do
             -- 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.
             xhair <- getsSession sxhair
             case xhair of
               Just (TVector Vector
_) -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()  -- explicitly set; keep it
               Maybe Target
_ -> (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \SessionUI
sess ->
                      SessionUI
sess { sxhair = Just $ TEnemy aid
                           , sitemSel = Nothing } -- reset flinging totally
             foes <- getsState $ foeRegularList side (blid body)
             itemsSize <- getsState $ guardItemSize body
             if length foes <= 1 then
               if itemsSize == 0 then do
                 msgAdd MsgSpottedThreat "You are not alone!"
                 return ThreatUnarmed
               else do
                 msgAdd MsgSpottedThreat "Armed intrusion ahead!"
                 return ThreatArmed
             else
               if itemsSize == 0 then
                 return ThreatAnotherUnarmed
               else do
                 msgAdd MsgSpottedThreat "Another threat, armed!"
                 return ThreatAnotherArmed
           else return ThreatNone  -- member of neutral faction
         aidVerbMU MsgSpottedActor aid verb
         friendAssocs <- getsState $ friendRegularAssocs side (blid body)
         case threat of
           Threat
ThreatNone -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()  -- too rare to care ATM
           Threat
ThreatUnarmed ->
             TutorialHints -> m ()
forall (m :: * -> *). MonadClientUI m => TutorialHints -> m ()
tutorialHintMsgAdd TutorialHints
MeleeEnemies
           Threat
ThreatArmed ->
             TutorialHints -> m ()
forall (m :: * -> *). MonadClientUI m => TutorialHints -> m ()
tutorialHintMsgAdd TutorialHints
UseTerrainEffect
           Threat
_ | [(ActorId, Actor)] -> Int
forall a. [a] -> Int
length [(ActorId, Actor)]
friendAssocs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1 -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()  -- one member on level
           Threat
ThreatAnotherUnarmed ->
             TutorialHints -> m ()
forall (m :: * -> *). MonadClientUI m => TutorialHints -> m ()
tutorialHintMsgAdd TutorialHints
SwitchPointmanAndAvoidMeleeAlone
           Threat
ThreatAnotherArmed ->
             TutorialHints -> m ()
forall (m :: * -> *). MonadClientUI m => TutorialHints -> m ()
tutorialHintMsgAdd TutorialHints
SwitchPointmanAndSoftenFoes
         animate (blid body) $ actorX (bpos body)

destroyActorUI :: MonadClientUI m => Bool -> ActorId -> Actor -> m ()
destroyActorUI :: forall (m :: * -> *).
MonadClientUI m =>
Bool -> ActorId -> Actor -> m ()
destroyActorUI Bool
destroy ActorId
aid Actor
b = do
  trunk <- (State -> Item) -> m Item
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Item) -> m Item) -> (State -> Item) -> m Item
forall a b. (a -> b) -> a -> b
$ ItemId -> State -> Item
getItemBody (ItemId -> State -> Item) -> ItemId -> State -> Item
forall a b. (a -> b) -> a -> b
$ Actor -> ItemId
btrunk Actor
b
  let baseColor = Flavour -> Color
flavourToColor (Flavour -> Color) -> Flavour -> Color
forall a b. (a -> b) -> a -> b
$ Item -> Flavour
jflavour Item
trunk
  unless (baseColor == Color.BrWhite) $  -- keep setup for heroes, etc.
    modifySession $ \SessionUI
sess -> SessionUI
sess {sactorUI = EM.delete aid $ sactorUI sess}
  let dummyTarget = TGoal -> LevelId -> Point -> Target
TPoint TGoal
TKnown (Actor -> LevelId
blid Actor
b) (Actor -> Point
bpos Actor
b)
      affect Maybe Target
tgt = case Maybe Target
tgt of
        Just (TEnemy ActorId
a) | ActorId
a ActorId -> ActorId -> Bool
forall a. Eq a => a -> a -> Bool
== ActorId
aid -> Target -> Maybe Target
forall a. a -> Maybe a
Just (Target -> Maybe Target) -> Target -> Maybe Target
forall a b. (a -> b) -> a -> b
$
          if Bool
destroy then
            -- If *really* nothing more interesting, the actor will
            -- go to last known location to perhaps find other foes.
            Target
dummyTarget
          else
            -- If enemy only hides (or we stepped behind obstacle) find him.
            TGoal -> LevelId -> Point -> Target
TPoint (ActorId -> TGoal
TEnemyPos ActorId
a) (Actor -> LevelId
blid Actor
b) (Actor -> Point
bpos Actor
b)
        Just (TNonEnemy ActorId
a) | ActorId
a ActorId -> ActorId -> Bool
forall a. Eq a => a -> a -> Bool
== ActorId
aid -> Target -> Maybe Target
forall a. a -> Maybe a
Just Target
dummyTarget
        Maybe Target
_ -> Maybe Target
tgt
  modifySession $ \SessionUI
sess -> SessionUI
sess {sxhair = affect $ sxhair sess}
  unless (bproj b || destroy) $
    modifySession $ \SessionUI
sess -> SessionUI
sess {slastLost = ES.insert aid $ slastLost sess}
  side <- getsClient sside
  fact <- getsState $ (EM.! side) . sfactionD
  let gameOver = Maybe Status -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Status -> Bool) -> Maybe Status -> Bool
forall a b. (a -> b) -> a -> b
$ Faction -> Maybe Status
gquit Faction
fact  -- we are the UI faction, so we determine
  unless gameOver $ do
    when (bfid b == side && not (bproj b)) $ do
      stopPlayBack
      let upd = ActorId -> EnumSet ActorId -> EnumSet ActorId
forall k. Enum k => k -> EnumSet k -> EnumSet k
ES.delete ActorId
aid
      modifySession $ \SessionUI
sess -> SessionUI
sess {sselected = upd $ sselected sess}
      when destroy $ do
        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)

spotItemBag :: forall m. MonadClientUI m
            => Bool -> Container -> ItemBag -> m ()
spotItemBag :: forall (m :: * -> *).
MonadClientUI m =>
Bool -> Container -> ItemBag -> m ()
spotItemBag Bool
verbose Container
c ItemBag
bag = do
  -- This is due to a move, or similar, which will be displayed,
  -- so no extra @markDisplayNeeded@ needed here and in similar places.
  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
  side <- getsClient sside
  getKind <- getsState $ flip getIidKindId
  lid <- getsState $ lidFromC c
  localTime <- getsState $ getLocalTime lid
  factionD <- getsState sfactionD
  -- Queried just once, so many copies of a new item can be reported. OK.
  ItemRoles itemRoles <- getsSession sroles
  sxhairOld <- getsSession sxhair
  let resetXhair = case Container
c of
        CFloor LevelId
_ Point
p -> case Maybe Target
sxhairOld of
          Just TEnemy{} -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()  -- probably too important to overwrite
          Just (TPoint TEnemyPos{} LevelId
_ Point
_) -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          Just (TPoint TStash{} LevelId
_ Point
_) -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          Just (TVector Vector
_) -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()  -- explicitly set; keep it
          Maybe Target
_ -> do
            -- Don't steal xhair if it's only an item on another level.
            -- For enemies, OTOH, capture xhair to alarm player.
            lidV <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
viewedLevelUI
            when (lid == lidV) $ do
              bagFloor <- getsState $ getFloorBag lid p
              modifySession $ \SessionUI
sess ->
                SessionUI
sess { sxhair = Just $ TPoint (TItem bagFloor) lidV p
                     , sitemSel = Nothing }  -- reset flinging totally
        Container
_ -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      locatedWhere = FactionDict -> Container -> Text
ppContainer FactionDict
factionD Container
c
      beLocated = Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$
        Text
"be located" Text -> Text -> Text
<+> if Text
locatedWhere Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== FactionDict -> Container -> Text
ppContainer FactionDict
forall k a. EnumMap k a
EM.empty Container
c
                         then Text
""  -- boring
                         else Text
locatedWhere
      subjectMaybe :: (ItemId, ItemQuant) -> m (Maybe (Int, MU.Part, MU.Part))
      subjectMaybe (ItemId
iid, kit :: ItemQuant
kit@(Int
k, ItemTimers
_)) = do
        ItemId -> Container -> m ()
forall (m :: * -> *).
MonadClientUI m =>
ItemId -> Container -> m ()
recordItemLid ItemId
iid Container
c
        itemFull <- (State -> ItemFull) -> m ItemFull
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemFull) -> m ItemFull)
-> (State -> ItemFull) -> m ItemFull
forall a b. (a -> b) -> a -> b
$ ItemId -> State -> ItemFull
itemToFull ItemId
iid
        let arItem = ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFull
            slore = AspectRecord -> Container -> SLore
IA.loreFromContainer AspectRecord
arItem Container
c
        if iid `ES.member` (itemRoles EM.! slore)
        then return Nothing  -- this item or another with the same @iid@
                             -- seen already (has a role assigned); old news
        else do  -- never seen or would have a role
          assignItemRole c iid
          case c of
            CFloor{} -> do
              let subjectShort :: Part
subjectShort = Int
-> FactionId
-> FactionDict
-> Int
-> Time
-> ItemFull
-> ItemQuant
-> Part
partItemWsShortest Int
rwidth FactionId
side FactionDict
factionD Int
k
                                                    Time
localTime ItemFull
itemFull ItemQuant
kit
                  subjectLong :: Part
subjectLong = Int
-> FactionId
-> FactionDict
-> Int
-> Time
-> ItemFull
-> ItemQuant
-> Part
partItemWsLong Int
rwidth FactionId
side FactionDict
factionD Int
k
                                               Time
localTime ItemFull
itemFull ItemQuant
kit
              Maybe (Int, Part, Part) -> m (Maybe (Int, Part, Part))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Int, Part, Part) -> m (Maybe (Int, Part, Part)))
-> Maybe (Int, Part, Part) -> m (Maybe (Int, Part, Part))
forall a b. (a -> b) -> a -> b
$ (Int, Part, Part) -> Maybe (Int, Part, Part)
forall a. a -> Maybe a
Just (Int
k, Part
subjectShort, Part
subjectLong)
            Container
_ -> Maybe (Int, Part, Part) -> m (Maybe (Int, Part, Part))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Int, Part, Part)
forall a. Maybe a
Nothing
      -- @SortOn@ less efficient here, because function cheap.
      sortItems = ((ItemId, ItemQuant) -> ContentId ItemKind)
-> [(ItemId, ItemQuant)] -> [(ItemId, ItemQuant)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (ItemId -> ContentId ItemKind
getKind (ItemId -> ContentId ItemKind)
-> ((ItemId, ItemQuant) -> ItemId)
-> (ItemId, ItemQuant)
-> ContentId ItemKind
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ItemId, ItemQuant) -> ItemId
forall a b. (a, b) -> a
fst)
      sortedAssocs = [(ItemId, ItemQuant)] -> [(ItemId, ItemQuant)]
sortItems ([(ItemId, ItemQuant)] -> [(ItemId, ItemQuant)])
-> [(ItemId, ItemQuant)] -> [(ItemId, ItemQuant)]
forall a b. (a -> b) -> a -> b
$ ItemBag -> [(ItemId, ItemQuant)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs ItemBag
bag
  subjectMaybes <- mapM subjectMaybe sortedAssocs
  let subjects = [Maybe (Int, Part, Part)] -> [(Int, Part, Part)]
forall a. [Maybe a] -> [a]
catMaybes [Maybe (Int, Part, Part)]
subjectMaybes
      sendMsg Bool
plural = do
        let subjectShort :: Part
subjectShort = [Part] -> Part
MU.WWandW ([Part] -> Part) -> [Part] -> Part
forall a b. (a -> b) -> a -> b
$ ((Int, Part, Part) -> Part) -> [(Int, Part, Part)] -> [Part]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
_, Part
part, Part
_) -> Part
part) [(Int, Part, Part)]
subjects
            subjectLong :: Part
subjectLong = [Part] -> Part
MU.WWandW ([Part] -> Part) -> [Part] -> Part
forall a b. (a -> b) -> a -> b
$ ((Int, Part, Part) -> Part) -> [(Int, Part, Part)] -> [Part]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
_, Part
_, Part
part) -> Part
part) [(Int, Part, Part)]
subjects
            msg :: Part -> Text
msg Part
subject =
              if Bool
plural
              then [Part] -> Text
makeSentence [Person -> Polarity -> Part -> Part -> Part
MU.SubjectVerb Person
MU.PlEtc Polarity
MU.Yes
                                                Part
subject Part
beLocated]
              else [Part] -> Text
makeSentence [Part -> Part -> Part
MU.SubjectVerbSg Part
subject Part
beLocated]
            msgShort :: Text
msgShort = Part -> Text
msg Part
subjectShort
            msgLong :: Text
msgLong = Part -> Text
msg Part
subjectLong
            dotsIfShorter :: Text
dotsIfShorter = if Text
msgShort Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
msgLong then Text
"" else Text
".."
        m ()
resetXhair
        MsgClassDistinct -> (Text, Text) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
MsgClassDistinct -> (Text, Text) -> m ()
msgAddDistinct MsgClassDistinct
MsgSpottedItem (Text
msgShort Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
dotsIfShorter, Text
msgLong)
  case subjects of
    [] -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    [(Int
1, Part
_, Part
_)] -> Bool -> m ()
sendMsg Bool
False
    [(Int, Part, Part)]
_ -> Bool -> m ()
sendMsg Bool
True
  when verbose $ case c of
    CActor ActorId
aid CStore
store -> do
      let verb :: Part
verb = Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ CStore -> Text
verbCStore CStore
store
      b <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
      fact <- getsState $ (EM.! bfid b) . sfactionD
      mleader <- getsClient sleader
      if Just aid == mleader && not (gunderAI fact) then
        manyItemsAidVerbMU MsgItemMovement aid verb sortedAssocs Right
      else when (not (bproj b) && bhp b > 0) $  -- don't announce death drops
        manyItemsAidVerbMU MsgItemMovement aid verb sortedAssocs (Left . Just)
    Container
_ -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

recordItemLid :: MonadClientUI m => ItemId -> Container -> m ()
recordItemLid :: forall (m :: * -> *).
MonadClientUI m =>
ItemId -> Container -> m ()
recordItemLid ItemId
iid Container
c = do
  mjlid <- (SessionUI -> Maybe LevelId) -> m (Maybe LevelId)
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession ((SessionUI -> Maybe LevelId) -> m (Maybe LevelId))
-> (SessionUI -> Maybe LevelId) -> m (Maybe LevelId)
forall a b. (a -> b) -> a -> b
$ ItemId -> EnumMap ItemId LevelId -> Maybe LevelId
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup ItemId
iid (EnumMap ItemId LevelId -> Maybe LevelId)
-> (SessionUI -> EnumMap ItemId LevelId)
-> SessionUI
-> Maybe LevelId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessionUI -> EnumMap ItemId LevelId
sitemUI
  when (isNothing mjlid) $ do
    lid <- getsState $ lidFromC c
    modifySession $ \SessionUI
sess ->
      SessionUI
sess {sitemUI = EM.insert iid lid $ sitemUI sess}

moveActor :: MonadClientUI m => ActorId -> Point -> Point -> m ()
moveActor :: forall (m :: * -> *).
MonadClientUI m =>
ActorId -> Point -> Point -> m ()
moveActor ActorId
aid Point
source Point
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 <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
  if adjacent source target
  then markDisplayNeeded (blid body)
  else do
    let ps = (Point
source, Point
target)
    animate (blid body) $ teleport ps
  lookAtMove aid
  stopAtMove aid

displaceActorUI :: MonadClientUI m => ActorId -> ActorId -> m ()
displaceActorUI :: forall (m :: * -> *). MonadClientUI m => ActorId -> ActorId -> m ()
displaceActorUI ActorId
source ActorId
target = 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
  sb <- getsState $ getActorBody source
  tb <- getsState $ getActorBody target
  spart <- partActorLeader source
  tpart <- partActorLeader target
  let msgClass = if Maybe ActorId
mleader Maybe ActorId -> [Maybe ActorId] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (ActorId -> Maybe ActorId) -> [ActorId] -> [Maybe ActorId]
forall a b. (a -> b) -> [a] -> [b]
map ActorId -> Maybe ActorId
forall a. a -> Maybe a
Just [ActorId
source, ActorId
target]
                 then MsgClassShowAndSave
MsgActionMajor  -- to interrupt run after a displace;
                 else MsgClassShowAndSave
MsgActionMinor  -- configurable, animation is feedback
      msg = [Part] -> Text
makeSentence [Part -> Part -> Part
MU.SubjectVerbSg Part
spart Part
"displace", Part
tpart]
  msgAdd msgClass msg
  lookAtMove source
  stopAtMove source
  when (bfid sb /= bfid tb) $ do
    lookAtMove target  -- in case only this one is ours
    stopAtMove target
  side <- getsClient sside
  -- Ours involved, but definitely not requested by player via UI.
  when (side `elem` [bfid sb, bfid tb] && mleader /= Just source) stopPlayBack
  let ps = (Actor -> Point
bpos Actor
tb, Actor -> Point
bpos Actor
sb)
  animate (blid sb) $ swapPlaces ps

-- @UpdMoveItem@ is relatively rare (except within the player's faction),
-- but it ensures that even if only one of the stores is visible
-- (e.g., stash floor is not or actor posision is not), some messages
-- will be printed (via verbose @UpdLoseItem@).
moveItemUI :: MonadClientUI m
           => ItemId -> Int -> ActorId -> CStore -> CStore
           -> m ()
moveItemUI :: forall (m :: * -> *).
MonadClientUI m =>
ItemId -> Int -> ActorId -> CStore -> CStore -> m ()
moveItemUI ItemId
iid Int
k ActorId
aid CStore
cstore1 CStore
cstore2 = do
  let verb :: Part
verb = Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ CStore -> Text
verbCStore CStore
cstore2
  b <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
  fact <- getsState $ (EM.! bfid b) . sfactionD
  mleader <- getsClient sleader
  ItemRoles itemRoles <- getsSession sroles
  if iid `ES.member` (itemRoles EM.! SItem) then
    -- So far organs can't be put into stash, so no need to call
    -- @assignItemRole@ to add or reassign lore category.
    if cstore1 == CGround && Just aid == mleader && not (gunderAI fact) then
      itemAidVerbMU MsgActionMajor aid verb iid (Right k)
    else when (not (bproj b) && bhp b > 0) $  -- don't announce death drops
      itemAidVerbMU MsgActionMajor aid verb iid (Left k)
  else error $ "" `showFailure` (iid, k, aid, cstore1, cstore2)

-- The item may be used up already and so not present in the container,
-- e.g., if the item destroyed itself. This is OK. Message is still needed.
discover :: MonadClientUI m => Container -> ItemId -> m ()
discover :: forall (m :: * -> *).
MonadClientUI m =>
Container -> ItemId -> m ()
discover Container
c ItemId
iid = do
  COps{coitem} <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  CCUI{coscreen=ScreenContent{rwidth}} <- getsSession sccui
  lid <- getsState $ lidFromC c
  globalTime <- getsState stime
  localTime <- getsState $ getLocalTime lid
  itemFull <- getsState $ itemToFull iid
  bag <- getsState $ getContainerBag c
  side <- getsClient sside
  factionD <- getsState sfactionD
  (noMsg, nameWhere) <- case c of
    CActor ActorId
aidOwner CStore
storeOwner -> do
      bOwner <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aidOwner
      name <- if bproj bOwner
              then return []
              else ppContainerWownW partActorLeader True c
      let arItem = ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFull
          inMetaGame = Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.MetaGame AspectRecord
arItem
          isOurOrgan = Actor -> FactionId
bfid Actor
bOwner FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side
                       Bool -> Bool -> Bool
&& CStore
storeOwner CStore -> CStore -> Bool
forall a. Eq a => a -> a -> Bool
== CStore
COrgan
                       Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
inMetaGame
            -- assume own faction organs known intuitively,
            -- except backstories and other meta game items
      return (isOurOrgan, name)
    CTrunk FactionId
_ LevelId
_ Point
p | Point
p Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Point
originPoint -> (Bool, [Part]) -> m (Bool, [Part])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
True, [])
      -- the special reveal at game over, using fake @CTrunk@; don't spam
    Container
_ -> (Bool, [Part]) -> m (Bool, [Part])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
False, [])
  let kit = ItemQuant -> ItemId -> ItemBag -> ItemQuant
forall k a. Enum k => a -> k -> EnumMap k a -> a
EM.findWithDefault ItemQuant
quantSingle ItemId
iid ItemBag
bag
              -- may be used up by that time
      knownName = [Part] -> Text
makePhrase
        [Int
-> FactionId
-> FactionDict
-> Time
-> ItemFull
-> ItemQuant
-> Part
partItemMediumAW Int
rwidth FactionId
side FactionDict
factionD Time
localTime ItemFull
itemFull ItemQuant
kit]
      flav = Flavour -> Text
flavourToName (Flavour -> Text) -> Flavour -> Text
forall a b. (a -> b) -> a -> b
$ Item -> Flavour
jflavour (Item -> Flavour) -> Item -> Flavour
forall a b. (a -> b) -> a -> b
$ ItemFull -> Item
itemBase ItemFull
itemFull
      (object1, object2) =
        partItemShortest rwidth side factionD localTime itemFull kit
      name1 = [Part] -> Text
makePhrase [Part
object1, Part
object2]
      -- Make sure the two names in the message differ.
      (ikObvious, itemKind) = case jkind $ itemBase itemFull of
        IdentityObvious ContentId ItemKind
ik -> (Bool
True, ContentId ItemKind
ik)
        IdentityCovered ItemKindIx
_ix ContentId ItemKind
ik -> (Bool
False, ContentId ItemKind
ik)
          -- fake kind (template); OK, we talk about appearances
      name2 = ItemKind -> Text
IK.iname (ItemKind -> Text) -> ItemKind -> Text
forall a b. (a -> b) -> a -> b
$ ContentData ItemKind -> ContentId ItemKind -> ItemKind
forall a. ContentData a -> ContentId a -> a
okind ContentData ItemKind
coitem ContentId ItemKind
itemKind
      name = if Bool
ikObvious Bool -> Bool -> Bool
&& [Text] -> Text
T.unwords ([Text] -> [Text]
forall a. (?callStack::CallStack) => [a] -> [a]
tail (Text -> [Text]
T.words Text
knownName)) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
name1
             then Text
name1  -- avoid "a pair turns out to be"
             else Text
name2  -- avoid "chip of scientific explanation"
      unknownName = [Part] -> Part
MU.Phrase ([Part] -> Part) -> [Part] -> Part
forall a b. (a -> b) -> a -> b
$ [Text -> Part
MU.Text Text
flav, Text -> Part
MU.Text Text
name] [Part] -> [Part] -> [Part]
forall a. [a] -> [a] -> [a]
++ [Part]
nameWhere
      msg = [Part] -> Text
makeSentence
        [ Part
"the"
        , Part -> Part -> Part
MU.SubjectVerbSg Part
unknownName Part
"turn out to be"
        , Text -> Part
MU.Text Text
knownName ]
  unless (noMsg || globalTime == timeZero) $  -- no spam about initial equipment
    msgAdd MsgItemDiscovery msg

ppHearMsg :: MonadClientUI m => Maybe Int -> HearMsg -> m Text
ppHearMsg :: forall (m :: * -> *).
MonadClientUI m =>
Maybe Int -> HearMsg -> m Text
ppHearMsg Maybe Int
distance HearMsg
hearMsg = case HearMsg
hearMsg of
  HearUpd UpdAtomic
cmd -> do
    COps{coTileSpeedup} <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
    let sound = case UpdAtomic
cmd of
          UpdDestroyActor{} -> Part
"shriek"
          UpdCreateItem{} -> Part
"clatter"
          UpdTrajectory{} -> Part
"thud"  -- A non-blast projectle hits a tile.
          UpdAlterTile LevelId
_ Point
_ ContentId TileKind
fromTile ContentId TileKind
toTile ->
            if | TileSpeedup -> ContentId TileKind -> Bool
Tile.isOpenable TileSpeedup
coTileSpeedup ContentId TileKind
fromTile
                 Bool -> Bool -> Bool
&& TileSpeedup -> ContentId TileKind -> Bool
Tile.isClosable TileSpeedup
coTileSpeedup ContentId TileKind
toTile
                 Bool -> Bool -> Bool
|| TileSpeedup -> ContentId TileKind -> Bool
Tile.isClosable TileSpeedup
coTileSpeedup ContentId TileKind
fromTile
                    Bool -> Bool -> Bool
&& TileSpeedup -> ContentId TileKind -> Bool
Tile.isOpenable TileSpeedup
coTileSpeedup ContentId TileKind
toTile -> Part
"creaking sound"
               | TileSpeedup -> ContentId TileKind -> Bool
Tile.isWalkable TileSpeedup
coTileSpeedup ContentId TileKind
fromTile
                 Bool -> Bool -> Bool
&& TileSpeedup -> ContentId TileKind -> Bool
Tile.isWalkable TileSpeedup
coTileSpeedup ContentId TileKind
toTile -> Part
"splash"
               | Bool
otherwise -> Part
"rumble"
          UpdAlterExplorable LevelId
_ Int
k ->
            if Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then Part
"grinding noise" else Part
"fizzing noise"
          UpdAtomic
_ -> String -> Part
forall a. (?callStack::CallStack) => String -> a
error (String -> Part) -> String -> Part
forall a b. (a -> b) -> a -> b
$ String
"" String -> UpdAtomic -> String
forall v. Show v => String -> v -> String
`showFailure` UpdAtomic
cmd
        adjective = Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Text
ppHearDistanceAdjective Maybe Int
distance
        msg = [Part] -> Text
makeSentence [Part
"you hear", Part -> Part
MU.AW (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ [Part] -> Part
MU.Phrase [Part
adjective, Part
sound]]
    return $! msg
  HearStrike ContentId ItemKind
ik -> do
    COps{coitem} <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
    let verb = ItemKind -> Text
IK.iverbHit (ItemKind -> Text) -> ItemKind -> Text
forall a b. (a -> b) -> a -> b
$ ContentData ItemKind -> ContentId ItemKind -> ItemKind
forall a. ContentData a -> ContentId a -> a
okind ContentData ItemKind
coitem ContentId ItemKind
ik
        adverb = Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Text
ppHearDistanceAdverb Maybe Int
distance
        msg = [Part] -> Text
makeSentence [ Part
"you", Part
adverb, Part
"hear something"
                           , Text -> Part
MU.Text Text
verb, Part
"someone" ]
    return $! msg
  HearSummon Bool
isProj GroupName ItemKind
grp Dice
p -> do
    let verb :: Part
verb = if Bool
isProj then Part
"something lure" else Part
"somebody 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
        adverb :: Part
adverb = Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Text
ppHearDistanceAdverb Maybe Int
distance
    Text -> m Text
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$! [Part] -> Text
makeSentence [Part
"you", Part
adverb, Part
"hear", Part
verb, Part
object]
  HearMsg
HearCollideTile -> do
    let adverb :: Part
adverb = Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Text
ppHearDistanceAdverb Maybe Int
distance
    Text -> m Text
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$! [Part] -> Text
makeSentence [Part
"you", Part
adverb, Part
"hear someone crash into something"]
  HearTaunt Text
t -> do
    let adverb :: Part
adverb = Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Text
ppHearDistanceAdverb Maybe Int
distance
    Text -> m Text
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$! [Part] -> Text
makePhrase [Part
"You", Part
adverb, Part
"overhear", Text -> Part
MU.Text Text
t]

ppHearDistanceAdjective :: Maybe Int -> Text
ppHearDistanceAdjective :: Maybe Int -> Text
ppHearDistanceAdjective Maybe Int
Nothing = Text
"indistinct"
ppHearDistanceAdjective (Just Int
0) = Text
"very close"
ppHearDistanceAdjective (Just Int
1) = Text
"close"
ppHearDistanceAdjective (Just Int
2) = Text
""
ppHearDistanceAdjective (Just Int
3) = Text
"remote"
ppHearDistanceAdjective (Just Int
4) = Text
"distant"
ppHearDistanceAdjective (Just Int
_) = Text
"far-off"

ppHearDistanceAdverb :: Maybe Int -> Text
ppHearDistanceAdverb :: Maybe Int -> Text
ppHearDistanceAdverb Maybe Int
Nothing = Text
"indistinctly"
ppHearDistanceAdverb (Just Int
0) = Text
"very clearly"
ppHearDistanceAdverb (Just Int
1) = Text
"clearly"
ppHearDistanceAdverb (Just Int
2) = Text
""
ppHearDistanceAdverb (Just Int
3) = Text
"remotely"
ppHearDistanceAdverb (Just Int
4) = Text
"distantly"
ppHearDistanceAdverb (Just Int
_) = Text
"barely"