-- | Display atomic update commands received by the client.
module Game.LambdaHack.Client.UI.Watch.WatchUpdAtomicM
  ( watchRespUpdAtomicUI
#ifdef EXPOSE_INTERNAL
    -- * Internal operations
  , updateItemSlot, 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           Data.Tuple
import           GHC.Exts (inline)
import qualified NLP.Miniutter.English as MU

import           Game.LambdaHack.Atomic
import           Game.LambdaHack.Client.MonadClient
import           Game.LambdaHack.Client.State
import           Game.LambdaHack.Client.UI.ActorUI
import           Game.LambdaHack.Client.UI.Animation
import           Game.LambdaHack.Client.UI.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           Game.LambdaHack.Client.UI.ItemSlot
import qualified Game.LambdaHack.Client.UI.Key as K
import           Game.LambdaHack.Client.UI.MonadClientUI
import           Game.LambdaHack.Client.UI.Msg
import           Game.LambdaHack.Client.UI.MsgM
import           Game.LambdaHack.Client.UI.SessionUI
import           Game.LambdaHack.Client.UI.SlideshowM
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 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 :: UpdAtomic -> m ()
watchRespUpdAtomicUI UpdAtomic
cmd = case UpdAtomic
cmd of
  -- Create/destroy actors and items.
  UpdRegisterItems{} -> () -> m ()
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 ()
updateItemSlot Container
c ItemId
iid
    if Bool
verbose then case Container
c of
      CActor ActorId
aid CStore
store -> do
        Actor
b <- (State -> Actor) -> m Actor
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 CStore
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
            Time
localTime <- (State -> Time) -> m Time
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)
            AspectRecord
arItem <- (State -> AspectRecord) -> m AspectRecord
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
            if | Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Blast AspectRecord
arItem -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
               | Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Condition AspectRecord
arItem -> do
                 FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
                 DiscoveryBenefit
discoBenefit <- (StateClient -> DiscoveryBenefit) -> m DiscoveryBenefit
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> DiscoveryBenefit
sdiscoBenefit
                 ItemBag
bag <- (State -> ItemBag) -> m ItemBag
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemBag) -> m ItemBag)
-> (State -> ItemBag) -> m ItemBag
forall a b. (a -> b) -> a -> b
$ Container -> State -> ItemBag
getContainerBag Container
c
                 ItemKind
itemKind <- (State -> ItemKind) -> m ItemKind
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemKind) -> m ItemKind)
-> (State -> ItemKind) -> m ItemKind
forall a b. (a -> b) -> a -> b
$ ItemId -> State -> ItemKind
getIidKind ItemId
iid
                 let more :: Maybe Int
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 :: Part
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 :: Part
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 :: Bool
good = Benefit -> Bool
benInEqp (DiscoveryBenefit
discoBenefit DiscoveryBenefit -> ItemId -> Benefit
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ItemId
iid)
                     msgClass :: MsgClassDistinct
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".
                 MsgClassDistinct -> ActorId -> Part -> Part -> ItemId -> m ()
forall (m :: * -> *).
MonadClientUI m =>
MsgClassDistinct -> ActorId -> Part -> Part -> ItemId -> m ()
itemAidDistinctMU MsgClassDistinct
msgClass ActorId
aid Part
verbShow Part
verbSave ItemId
iid
                 Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Actor -> FactionId
bfid Actor
b FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
good) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
                   -- Others get conditions too often and good ones are not
                   -- dire enough and also too common.
                   MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
MsgTutorialHint Text
"Temporary conditions, especially the bad ones, pass quickly, usually after just a few turns. While active, they are listed in the '@' organ menu and the effects of most of them are seen in the '#' skill menu."
               | Bool
otherwise -> do
                 [Part]
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
                 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
                            (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
"grow" Part -> [Part] -> [Part]
forall a. a -> [a] -> [a]
: [Part]
wown) Container
c
          CStore
_ -> do
            [Part]
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
            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
                       (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
"appear" Part -> [Part] -> [Part]
forall a. a -> [a] -> [a]
: [Part]
wown) Container
c
      CEmbed LevelId
lid Point
_ -> LevelId -> m ()
forall (m :: * -> *). MonadClientUI m => LevelId -> m ()
markDisplayNeeded LevelId
lid
      CFloor LevelId
lid Point
_ -> do
        FactionDict
factionD <- (State -> FactionDict) -> m FactionDict
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> FactionDict
sfactionD
        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
                   (Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ Text
"appear" Text -> Text -> Text
<+> FactionDict -> Container -> Text
ppContainer FactionDict
factionD Container
c) Container
c
        LevelId -> m ()
forall (m :: * -> *). MonadClientUI m => LevelId -> m ()
markDisplayNeeded LevelId
lid
      CTrunk{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    else do
      LevelId
lid <- (State -> LevelId) -> m LevelId
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> LevelId) -> m LevelId)
-> (State -> LevelId) -> m LevelId
forall a b. (a -> b) -> a -> b
$ Container -> State -> LevelId
lidFromC Container
c
      LevelId -> m ()
forall (m :: * -> *). MonadClientUI m => LevelId -> m ()
markDisplayNeeded LevelId
lid
  UpdDestroyItem Bool
verbose ItemId
iid Item
_ ItemQuant
kit Container
c ->
    if Bool
verbose then case Container
c of
      CActor ActorId
aid CStore
_  -> do
        Actor
b <- (State -> Actor) -> m Actor
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 Actor -> Bool
bproj Actor
b then
          MsgClassShowAndSave
-> ItemId -> ItemQuant -> Part -> Container -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> ItemId -> ItemQuant -> Part -> Container -> m ()
itemVerbMUShort MsgClassShowAndSave
MsgItemRuination ItemId
iid ItemQuant
kit Part
"break" Container
c
        else do
          [Part]
ownW <- (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
False Container
c
          let verb :: Part
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
          MsgClassShowAndSave
-> ItemId -> ItemQuant -> Part -> Container -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> ItemId -> ItemQuant -> Part -> Container -> m ()
itemVerbMUShort MsgClassShowAndSave
MsgItemRuination ItemId
iid ItemQuant
kit Part
verb Container
c
      CEmbed LevelId
lid Point
_ -> LevelId -> m ()
forall (m :: * -> *). MonadClientUI m => LevelId -> m ()
markDisplayNeeded LevelId
lid
      CFloor LevelId
lid Point
_ -> do
        FactionDict
factionD <- (State -> FactionDict) -> m FactionDict
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> FactionDict
sfactionD
        MsgClassShowAndSave
-> ItemId -> ItemQuant -> Part -> Container -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> ItemId -> ItemQuant -> Part -> Container -> m ()
itemVerbMUShort MsgClassShowAndSave
MsgItemRuination ItemId
iid ItemQuant
kit
                        (Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ Text
"break" Text -> Text -> Text
<+> FactionDict -> Container -> Text
ppContainer FactionDict
factionD Container
c) Container
c
        LevelId -> m ()
forall (m :: * -> *). MonadClientUI m => LevelId -> m ()
markDisplayNeeded LevelId
lid
      CTrunk{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    else do
      LevelId
lid <- (State -> LevelId) -> m LevelId
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> LevelId) -> m LevelId)
-> (State -> LevelId) -> m LevelId
forall a b. (a -> b) -> a -> b
$ Container -> State -> LevelId
lidFromC Container
c
      LevelId -> m ()
forall (m :: * -> *). MonadClientUI m => LevelId -> m ()
markDisplayNeeded LevelId
lid
  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
    Actor
b <- (State -> Actor) -> m Actor
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
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Actor -> Bool
bproj Actor
b) Bool -> Bool -> Bool
&& Actor -> Int64
bhp Actor
b Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do  -- don't spam
      [Part]
ownW <- (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
False Container
c
      let verb :: Part
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
      MsgClassShowAndSave
-> ItemId -> ItemQuant -> Part -> Container -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> ItemId -> ItemQuant -> Part -> Container -> m ()
itemVerbMUShort MsgClassShowAndSave
MsgItemMovement ItemId
iid ItemQuant
kit Part
verb Container
c
  UpdLoseItem{} -> () -> m ()
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 (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"
    MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
MsgTutorialHint Text
"Woken up actors regain stats and skills, including sight radius and melee armor, over several turns."
  UpdWaitActor ActorId
aid Watchfulness
WWake Watchfulness
_ -> do
    FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
    Actor
b <- (State -> Actor) -> m Actor
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
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Actor -> FactionId
bfid Actor
b FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
      MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
MsgTutorialHint Text
"To avoid waking enemies up, make sure they don't lose HP nor too much Calm through noises, particularly close ones. Beware, however, that they slowly regenerate HP as they sleep and eventually wake up at full HP."
  UpdWaitActor{} -> () -> m ()
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 (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"
    Actor
b <- (State -> Actor) -> m Actor
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
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Actor -> Bool
bproj Actor
b) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
      MsgClassSave -> ActorId -> Part -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> ActorId -> Part -> m ()
aidVerbMU MsgClassSave
MsgNumericReport ActorId
aid (Part -> m ()) -> Part -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Part
MU.Text
                ((if Int64
hpDelta Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
0 then Text
"heal" else Text
"lose") Text -> Text -> Text
<+> Text
tDelta)
    LevelId
arena <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
getArenaUI
    FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
    if | Actor -> Bool
bproj Actor
b Bool -> Bool -> Bool
&& (ItemBag -> Bool
forall k a. EnumMap k a -> Bool
EM.null (Actor -> ItemBag
beqp Actor
b) Bool -> Bool -> Bool
|| Maybe ([Vector], Speed) -> Bool
forall a. Maybe a -> Bool
isNothing (Actor -> Maybe ([Vector], Speed)
btrajectory Actor
b)) ->
           () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()  -- ignore caught proj or one hitting a wall
       | Actor -> Int64
bhp Actor
b Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int64
0 Bool -> Bool -> Bool
&& Int64
hpDelta Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int64
0
         Bool -> Bool -> Bool
&& (Actor -> FactionId
bfid Actor
b FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side Bool -> Bool -> Bool
&& Bool -> Bool
not (Actor -> Bool
bproj Actor
b) Bool -> Bool -> Bool
|| LevelId
arena LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> LevelId
blid Actor
b) -> do
         let (Part
firstFall, Part
hurtExtra) = case (Actor -> FactionId
bfid Actor
b FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side, Actor -> Bool
bproj Actor
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 :: Part
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 :: Bool
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
         Faction
tfact <- (State -> Faction) -> m Faction
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (FactionDict -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
b) (FactionDict -> Faction)
-> (State -> FactionDict) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> FactionDict
sfactionD
         ActorUI
bUI <- (SessionUI -> ActorUI) -> m ActorUI
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
aid
         Part
subjectRaw <- ActorId -> m Part
forall (m :: * -> *). MonadClientUI m => ActorId -> m Part
partActorLeader ActorId
aid
         let subject :: Part
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 :: Text
msgDie = [Part] -> Text
makeSentence [Part -> Part -> Part
MU.SubjectVerbSg Part
subject Part
verbDie]
             targetIsFoe :: Bool
targetIsFoe = FactionId -> Faction -> FactionId -> Bool
isFoe (Actor -> FactionId
bfid Actor
b) Faction
tfact FactionId
side
             targetIsFriend :: Bool
targetIsFriend = FactionId -> Faction -> FactionId -> Bool
isFriend (Actor -> FactionId
bfid Actor
b) Faction
tfact FactionId
side
             msgClass :: MsgClassShowAndSave
msgClass | Actor -> Bool
bproj Actor
b = MsgClassShowAndSave
MsgDeathBoring
                      | Bool
targetIsFoe = MsgClassShowAndSave
MsgDeathVictory
                      | Bool
targetIsFriend = MsgClassShowAndSave
MsgDeathDeafeat
                      | Bool
otherwise = MsgClassShowAndSave
MsgDeathBoring
         if | Actor -> Bool
bproj Actor
b -> MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
msgClass Text
msgDie
            | Actor -> FactionId
bfid Actor
b FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side -> do
              MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgLnAdd MsgClassShowAndSave
msgClass (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
msgDie Text -> Text -> Text
<+> Text
"Alas!"
              ColorMode -> Text -> m ()
forall (m :: * -> *). MonadClientUI m => ColorMode -> Text -> m ()
displayMore ColorMode
ColorBW Text
""
            | Bool
otherwise -> MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgLnAdd MsgClassShowAndSave
msgClass Text
msgDie
         -- We show death anims only if not dead already before this refill.
         let deathAct :: Animation
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)
         Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Actor -> Bool
bproj Actor
b Bool -> Bool -> Bool
|| Bool
alreadyDeadBefore) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ LevelId -> Animation -> m ()
forall (m :: * -> *).
MonadClientUI m =>
LevelId -> Animation -> m ()
animate (Actor -> LevelId
blid Actor
b) Animation
deathAct
       | Bool
otherwise -> do
         Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int64
hpDelta Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Actor -> Int64
bhp Actor
b Bool -> Bool -> Bool
&& Actor -> Int64
bhp Actor
b Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
           MsgClassShowAndSave -> ActorId -> Part -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> ActorId -> Part -> m ()
aidVerbMU MsgClassShowAndSave
MsgActionWarning ActorId
aid Part
"return from the brink of death"
         Maybe ActorId
mleader <- (StateClient -> Maybe ActorId) -> m (Maybe ActorId)
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Maybe ActorId
sleader
         Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ActorId -> Maybe ActorId
forall a. a -> Maybe a
Just ActorId
aid Maybe ActorId -> Maybe ActorId -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe ActorId
mleader) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
           Skills
actorMaxSk <- (State -> Skills) -> m Skills
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Skills) -> m Skills) -> (State -> Skills) -> m Skills
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Skills
getActorMaxSkills ActorId
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.
           Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Actor -> Int64
bhp Actor
b Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int -> Int64
xM (Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkMaxHP Skills
actorMaxSk)
                 Bool -> Bool -> Bool
&& 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
< Int -> Int64
xM (Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkMaxHP
                                                  Skills
actorMaxSk)) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
             MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
MsgSpecialEvent Text
"You recover your health fully. Any further gains will be transient."
         Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Actor -> FactionId
bfid Actor
b FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side Bool -> Bool -> Bool
&& Bool -> Bool
not (Actor -> Bool
bproj Actor
b)) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
           Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int64 -> Int64
forall a. Num a => a -> a
abs Int64
hpDelta Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int64
oneM) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ LevelId -> m ()
forall (m :: * -> *). MonadClientUI m => LevelId -> m ()
markDisplayNeeded (Actor -> LevelId
blid Actor
b)
           Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int64
hpDelta Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int64
0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
             Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int64
hpDelta Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int -> Int64
xM (-Int
3)) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
MsgTutorialHint Text
"You took a lot of damage from one source. If the danger persists, consider retreating towards your teammates or buffing up or an instant escape, if consumables permit."
             UIOptions
sUIOptions <- (SessionUI -> UIOptions) -> m UIOptions
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> UIOptions
sUIOptions
             Bool
currentWarning <-
               (State -> Bool) -> m Bool
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Bool) -> m Bool) -> (State -> Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ UIOptions -> ActorId -> Int64 -> State -> Bool
checkWarningHP UIOptions
sUIOptions ActorId
aid (Actor -> Int64
bhp Actor
b)
             Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
currentWarning (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
               Bool
previousWarning <-
                 (State -> Bool) -> m Bool
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Bool) -> m Bool) -> (State -> Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ UIOptions -> ActorId -> Int64 -> State -> Bool
checkWarningHP UIOptions
sUIOptions ActorId
aid (Actor -> Int64
bhp Actor
b Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
hpDelta)
               Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
previousWarning (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
                 MsgClassShowAndSave -> ActorId -> Part -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> ActorId -> Part -> m ()
aidVerbMU MsgClassShowAndSave
MsgRiskOfDeath ActorId
aid
                           Part
"be down to a dangerous health level"
  UpdRefillCalm ActorId
_ Int64
0 -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdRefillCalm ActorId
aid Int64
calmDelta -> do
    FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
    Actor
b <- (State -> Actor) -> m Actor
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
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Actor -> FactionId
bfid Actor
b FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side Bool -> Bool -> Bool
&& Bool -> Bool
not (Actor -> Bool
bproj Actor
b)) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
      if | Int64
calmDelta Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
0 -> do  -- regeneration or effect
           Maybe ActorId
mleader <- (StateClient -> Maybe ActorId) -> m (Maybe ActorId)
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Maybe ActorId
sleader
           Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ActorId -> Maybe ActorId
forall a. a -> Maybe a
Just ActorId
aid Maybe ActorId -> Maybe ActorId -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe ActorId
mleader) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
             Skills
actorMaxSk <- (State -> Skills) -> m Skills
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Skills) -> m Skills) -> (State -> Skills) -> m Skills
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Skills
getActorMaxSkills ActorId
aid
             let bPrev :: Actor
bPrev = Actor
b {bcalm :: Int64
bcalm = Actor -> Int64
bcalm Actor
b Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
calmDelta}
             Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Actor -> Skills -> Bool
calmEnough Actor
b Skills
actorMaxSk
                   Bool -> Bool -> Bool
&& Bool -> Bool
not (Actor -> Skills -> Bool
calmEnough Actor
bPrev Skills
actorMaxSk)) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
               MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
MsgNeutralEvent Text
"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.
           Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int64 -> Int64
forall a. Num a => a -> a
abs Int64
calmDelta Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
oneM) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ LevelId -> m ()
forall (m :: * -> *). MonadClientUI m => LevelId -> m ()
markDisplayNeeded (Actor -> LevelId
blid Actor
b)
         | Int64
calmDelta Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
minusM1 -> do
           Faction
fact <- (State -> Faction) -> m Faction
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (FactionDict -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
side) (FactionDict -> Faction)
-> (State -> FactionDict) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> FactionDict
sfactionD
           State
s <- m State
forall (m :: * -> *). MonadStateRead m => m State
getState
           let closeFoe :: (Point, ActorId) -> Bool
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 :: Bool
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
           Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
anyCloseFoes (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do  -- obvious where the feeling comes from
             Bool
duplicated <- MsgClassShowAndSave -> ActorId -> Part -> m Bool
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> ActorId -> Part -> m Bool
aidVerbDuplicateMU MsgClassShowAndSave
MsgHeardNearby ActorId
aid
                                              Part
"hear something"
             Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
duplicated m ()
forall (m :: * -> *). MonadClientUI m => m ()
stopPlayBack
         | Bool
otherwise ->  -- low deltas from hits; displayed elsewhere
           () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int64
calmDelta Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int64
0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
        UIOptions
sUIOptions <- (SessionUI -> UIOptions) -> m UIOptions
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> UIOptions
sUIOptions
        Bool
currentWarning <-
          (State -> Bool) -> m Bool
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Bool) -> m Bool) -> (State -> Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ UIOptions -> ActorId -> Int64 -> State -> Bool
checkWarningCalm UIOptions
sUIOptions ActorId
aid (Actor -> Int64
bcalm Actor
b)
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
currentWarning (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
          Bool
previousWarning <-
            (State -> Bool) -> m Bool
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Bool) -> m Bool) -> (State -> Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ UIOptions -> ActorId -> Int64 -> State -> Bool
checkWarningCalm UIOptions
sUIOptions ActorId
aid (Actor -> Int64
bcalm Actor
b Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
calmDelta)
          Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
previousWarning (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
            -- This messages is not shown if impression happens after
            -- Calm is low enough. However, this is rare and HUD shows the red.
            MsgClassShowAndSave -> ActorId -> Part -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> ActorId -> Part -> m ()
aidVerbMU MsgClassShowAndSave
MsgRiskOfDeath ActorId
aid
                      Part
"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
    FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
    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
      if FactionId
fid FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side then
        MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgLnAdd MsgClassShowAndSave
MsgFactionIntel
                 Text
"You set up the shared inventory stash of your team."
      else do
        Faction
fact <- (State -> Faction) -> m Faction
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (FactionDict -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
fid) (FactionDict -> Faction)
-> (State -> FactionDict) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> FactionDict
sfactionD
        let fidName :: Part
fidName = Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ Faction -> Text
gname Faction
fact
        MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
MsgFactionIntel (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
          [Part] -> Text
makeSentence [ Part
"you have found the current"
                       , Part -> Part -> Part
MU.WownW Part
fidName Part
"hoard location" ]
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FactionId
fid FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
      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
actorX Point
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
      FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
      if FactionId
fid FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side then
        MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
MsgFactionIntel
               Text
"You've lost access to your shared inventory stash!"
      else do
        Faction
fact <- (State -> Faction) -> m Faction
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (FactionDict -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
fid) (FactionDict -> Faction)
-> (State -> FactionDict) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> FactionDict
sfactionD
        let fidName :: Part
fidName = Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ Faction -> Text
gname Faction
fact
        MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
MsgFactionIntel (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
          [Part] -> Text
makeSentence [Part
fidName, Part
"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
    Maybe ActorId
mleader <- (StateClient -> Maybe ActorId) -> m (Maybe ActorId)
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Maybe ActorId
sleader
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe ActorId
mtgt Maybe ActorId -> Maybe ActorId -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe ActorId
mleader) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
      Faction
fact <- (State -> Faction) -> m Faction
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (FactionDict -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
fid) (FactionDict -> Faction)
-> (State -> FactionDict) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> FactionDict
sfactionD
      LevelId
lidV <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
viewedLevelUI
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Faction -> Bool
isAIFact Faction
fact) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ LevelId -> m ()
forall (m :: * -> *). MonadClientUI m => LevelId -> m ()
markDisplayNeeded LevelId
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.
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Faction -> Bool
noRunWithMulti Faction
fact) m ()
forall (m :: * -> *). MonadClientUI m => m ()
stopPlayBack
      ActorDict
actorD <- (State -> ActorDict) -> m ActorDict
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> ActorDict
sactorD
      case ActorId -> ActorDict -> Maybe Actor
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup ActorId
source ActorDict
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'.
          ActorUI
sbUI <- (SessionUI -> ActorUI) -> m ActorUI
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
          ActorUI
tbUI <- (SessionUI -> ActorUI) -> m ActorUI
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
target
          let subject :: Part
subject = ActorUI -> Part
partActor ActorUI
tbUI
              object :: Part
object  = ActorUI -> Part
partActor ActorUI
sbUI
          MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
MsgPointmanSwap (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
            [Part] -> Text
makeSentence [ Part -> Part -> Part
MU.SubjectVerbSg Part
subject Part
"take command"
                         , Part
"from", Part
object ]
        Maybe Actor
_ -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      ActorId -> m ()
forall (m :: * -> *). MonadClientUI m => ActorId -> m ()
lookAtMove ActorId
target
  UpdLeadFaction FactionId
_ Maybe ActorId
Nothing mtgt :: Maybe ActorId
mtgt@(Just ActorId
target) -> do
    Maybe ActorId
mleader <- (StateClient -> Maybe ActorId) -> m (Maybe ActorId)
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Maybe ActorId
sleader
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe ActorId
mtgt Maybe ActorId -> Maybe ActorId -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe ActorId
mleader) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
      ActorId -> m ()
forall (m :: * -> *). MonadClientUI m => ActorId -> m ()
lookAtMove ActorId
target
  UpdLeadFaction{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdDiplFaction FactionId
fid1 FactionId
fid2 Diplomacy
_ Diplomacy
toDipl -> do
    Text
name1 <- (State -> Text) -> m Text
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
    Text
name2 <- (State -> Text) -> m Text
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
fid2) (FactionDict -> Faction)
-> (State -> FactionDict) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> FactionDict
sfactionD
    let showDipl :: Diplomacy -> p
showDipl Diplomacy
Unknown = p
"unknown to each other"
        showDipl Diplomacy
Neutral = p
"in neutral diplomatic relations"
        showDipl Diplomacy
Alliance = p
"allied"
        showDipl Diplomacy
War = p
"at war"
    MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
MsgFactionIntel (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
      Text
name1 Text -> Text -> Text
<+> Text
"and" Text -> Text -> Text
<+> Text
name2 Text -> Text -> Text
<+> Text
"are now" Text -> Text -> Text
<+> Diplomacy -> Text
forall p. IsString p => Diplomacy -> p
showDipl Diplomacy
toDipl Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
  UpdDoctrineFaction{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdAutoFaction FactionId
fid Bool
b -> do
    FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
    LevelId
lidV <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
viewedLevelUI
    LevelId -> m ()
forall (m :: * -> *). MonadClientUI m => LevelId -> m ()
markDisplayNeeded LevelId
lidV
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (FactionId
fid FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
b (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
        -- Clear macros and invoke a special main menu entrance macro
        -- that sets @swasAutomated@, preparing for AI control at exit.
        (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 { smacroFrame :: KeyMacroFrame
smacroFrame =
                   KeyMacroFrame
emptyMacroFrame {keyPending :: KeyMacro
keyPending = [KM] -> KeyMacro
KeyMacro [KM
K.controlEscKM]}
               , smacroStack :: [KeyMacroFrame]
smacroStack = [] }
      Bool -> m ()
forall (m :: * -> *). MonadClientUI m => Bool -> m ()
setFrontAutoYes Bool
b  -- now can start/stop auto-accepting prompts
  UpdRecordKill{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  -- Alter map.
  UpdAlterTile LevelId
lid Point
p ContentId TileKind
fromTile ContentId TileKind
toTile -> do
    COps{ContentData TileKind
cotile :: COps -> ContentData TileKind
cotile :: ContentData TileKind
cotile} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
    LevelId -> m ()
forall (m :: * -> *). MonadClientUI m => LevelId -> m ()
markDisplayNeeded LevelId
lid
    let feats :: [Feature]
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 -> Maybe (GroupName TileKind)
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 :: [GroupName TileKind]
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]
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 :: Bool
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
    Maybe ActorId
mactorAtPos <- (State -> Maybe ActorId) -> m (Maybe ActorId)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Maybe ActorId) -> m (Maybe ActorId))
-> (State -> Maybe ActorId) -> m (Maybe ActorId)
forall a b. (a -> b) -> a -> b
$ Point -> LevelId -> State -> Maybe ActorId
posToBig Point
p LevelId
lid
    Maybe ActorId
mleader <- (StateClient -> Maybe ActorId) -> m (Maybe ActorId)
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Maybe ActorId
sleader
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
unexpected Bool -> Bool -> Bool
|| Maybe ActorId -> Bool
forall a. Maybe a -> Bool
isJust Maybe ActorId
mactorAtPos Bool -> Bool -> Bool
&& Maybe ActorId
mactorAtPos Maybe ActorId -> Maybe ActorId -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe ActorId
mleader) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
      -- Player notices @fromTile can't be altered into @toTIle@,
      -- which is uncanny, so we produce a message.
      -- This happens when the player missed an earlier search of the tile
      -- performed by another faction.
      let subject :: Part
subject = Part
""  -- a hack, because we don't handle adverbs well
          verb :: Part
verb = Part
"turn into"
          msg :: Text
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 ]
      MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd (if Bool
unexpected then MsgClassShowAndSave
MsgSpecialEvent else MsgClassShowAndSave
MsgNeutralEvent) Text
msg
  UpdAlterExplorable LevelId
lid Int
_ -> LevelId -> m ()
forall (m :: * -> *). MonadClientUI m => LevelId -> m ()
markDisplayNeeded LevelId
lid
  UpdAlterGold{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()  -- not displayed on HUD
  UpdSearchTile ActorId
aid Point
_p ContentId TileKind
toTile -> do
    COps{ContentData TileKind
cotile :: ContentData TileKind
cotile :: COps -> ContentData TileKind
cotile} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
    Part
subject <- ActorId -> m Part
forall (m :: * -> *). MonadClientUI m => ActorId -> m Part
partActorLeader ActorId
aid
    let fromTile :: ContentId TileKind
fromTile = ContentId TileKind
-> Maybe (ContentId TileKind) -> ContentId TileKind
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> ContentId TileKind
forall a. (?callStack::CallStack) => [Char] -> a
error ([Char] -> ContentId TileKind) -> [Char] -> ContentId TileKind
forall a b. (a -> b) -> a -> b
$ ContentId TileKind -> [Char]
forall a. Show a => a -> [Char]
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 :: Part
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 :: Part
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 :: Text
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 ]
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Part
subject2 Part -> Part -> Bool
forall a. Eq a => a -> a -> Bool
== Part
object) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
      MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
MsgTerrainReveal Text
msg
      MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
MsgTutorialHint Text
"Solid terrain drawn in pink is not fully known until searched. This is usually done by bumping into it, which also triggers effects and transformations the terrain is capable of. Once revealed, the terrain can be inspected in aiming mode started with the '*' key or with mouse."
  UpdHideTile{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdSpotTile{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdLoseTile{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdSpotEntry{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdLoseEntry{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdAlterSmell{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdSpotSmell{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdLoseSmell{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  -- Assorted.
  UpdTimeItem{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdAgeGame{} -> do
    Bool
sdisplayNeeded <- (SessionUI -> Bool) -> m Bool
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Bool
sdisplayNeeded
    Bool
sturnDisplayed <- (SessionUI -> Bool) -> m Bool
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Bool
sturnDisplayed
    Time
time <- (State -> Time) -> m Time
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> Time
stime
    let clipN :: Int
clipN = Time
time Time -> Time -> Int
`timeFit` Time
timeClip
        clipMod :: Int
clipMod = Int
clipN Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
clipsInTurn
        turnPing :: Bool
turnPing = Int
clipMod Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0  -- e.g., to see resting counter
    if | Bool
sdisplayNeeded -> Bool -> m ()
forall (m :: * -> *). MonadClientUI m => Bool -> m ()
pushFrame Bool
True
           -- adds delay, because it's not an extra animation-like frame,
           -- but showing some real information accumulated up to this point
       | Bool
turnPing Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
sturnDisplayed -> Bool -> m ()
forall (m :: * -> *). MonadClientUI m => Bool -> m ()
pushFrame Bool
False
       | Bool
otherwise -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
turnPing (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
      (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 {sturnDisplayed :: Bool
sturnDisplayed = Bool
False}
  UpdUnAgeGame{} -> () -> m ()
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 (m :: * -> *) a. Monad m => a -> m a
return ()  -- don't spam when doing undo
  UpdDiscoverKind{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()  -- don't spam when server tweaks stuff
  UpdCoverKind{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()  -- don't spam when doing undo
  UpdDiscoverAspect{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()  -- don't spam when server tweaks stuff
  UpdCoverAspect{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()  -- don't spam when doing undo
  UpdDiscoverServer{} -> [Char] -> m ()
forall a. (?callStack::CallStack) => [Char] -> a
error [Char]
"server command leaked to client"
  UpdCoverServer{} -> [Char] -> m ()
forall a. (?callStack::CallStack) => [Char] -> a
error [Char]
"server command leaked to client"
  UpdPerception{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdRestart FactionId
fid PerLid
_ State
_ Challenge
_ ClientOptions
_ SMGen
srandom -> do
    cops :: COps
cops@COps{ContentData CaveKind
cocave :: COps -> ContentData CaveKind
cocave :: ContentData CaveKind
cocave, ContentData ModeKind
comode :: COps -> ContentData ModeKind
comode :: ContentData ModeKind
comode, RuleContent
corule :: COps -> RuleContent
corule :: RuleContent
corule} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
    SessionUI
oldSess <- m SessionUI
forall (m :: * -> *). MonadClientUI m => m SessionUI
getSession
    EnumMap (ContentId ModeKind) (Map Challenge Int)
svictories <- (StateClient -> EnumMap (ContentId ModeKind) (Map Challenge Int))
-> m (EnumMap (ContentId ModeKind) (Map Challenge Int))
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> EnumMap (ContentId ModeKind) (Map Challenge Int)
svictories
    Challenge
snxtChal <- (StateClient -> Challenge) -> m Challenge
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Challenge
snxtChal
    let uiOptions :: UIOptions
uiOptions = SessionUI -> UIOptions
sUIOptions SessionUI
oldSess
        f :: [a] -> p -> a -> p -> [a]
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)]
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) -> 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 EnumMap (ContentId ModeKind) (Map Challenge Int)
svictories 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)
        (Int
snxtScenario, ContentId ModeKind
_) = ((Int, ContentId ModeKind)
 -> (Int, ContentId ModeKind) -> Ordering)
-> [(Int, ContentId ModeKind)] -> (Int, ContentId ModeKind)
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
minimumBy (((Int, ContentId ModeKind) -> Int)
-> (Int, ContentId ModeKind)
-> (Int, ContentId ModeKind)
-> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Int, ContentId ModeKind) -> Int
g) [(Int, ContentId ModeKind)]
modes
        nxtGameTutorial :: Bool
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
    SessionUI -> m ()
forall (m :: * -> *). MonadClientUI m => SessionUI -> m ()
putSession (SessionUI -> m ()) -> SessionUI -> m ()
forall a b. (a -> b) -> a -> b
$
      (UIOptions -> SessionUI
emptySessionUI UIOptions
uiOptions)
        { schanF :: ChanFrontend
schanF = SessionUI -> ChanFrontend
schanF SessionUI
oldSess
        , sccui :: CCUI
sccui = SessionUI -> CCUI
sccui SessionUI
oldSess
        , shistory :: History
shistory = SessionUI -> History
shistory SessionUI
oldSess
        , smarkVision :: Int
smarkVision = SessionUI -> Int
smarkVision SessionUI
oldSess
        , smarkSmell :: Bool
smarkSmell = SessionUI -> Bool
smarkSmell SessionUI
oldSess
        , Int
snxtScenario :: Int
snxtScenario :: Int
snxtScenario
        , scurTutorial :: Bool
scurTutorial = SessionUI -> Bool
snxtTutorial SessionUI
oldSess  -- quite random for screensavers
        , snxtTutorial :: Bool
snxtTutorial = Bool
nxtGameTutorial
        , soverrideTut :: Maybe Bool
soverrideTut = SessionUI -> Maybe Bool
soverrideTut SessionUI
oldSess
        , sstart :: POSIXTime
sstart = SessionUI -> POSIXTime
sstart SessionUI
oldSess
        , sgstart :: POSIXTime
sgstart = SessionUI -> POSIXTime
sgstart SessionUI
oldSess
        , sallTime :: Time
sallTime = SessionUI -> Time
sallTime SessionUI
oldSess
        , snframes :: Int
snframes = SessionUI -> Int
snframes SessionUI
oldSess
        , sallNframes :: Int
sallNframes = SessionUI -> Int
sallNframes SessionUI
oldSess
        , srandomUI :: SMGen
srandomUI = SMGen
srandom
        }
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (SessionUI -> POSIXTime
sstart SessionUI
oldSess POSIXTime -> POSIXTime -> Bool
forall a. Eq a => a -> a -> Bool
== POSIXTime
0) m ()
forall (m :: * -> *). MonadClientUI m => m ()
resetSessionStart
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (History -> Int
lengthHistory (SessionUI -> History
shistory SessionUI
oldSess) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
      let title :: Text
title = [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ RuleContent -> [Char]
rtitle RuleContent
corule
      MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
MsgBookKeeping (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Welcome to" Text -> Text -> Text
<+> Text
title Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"!"
      -- Generate initial history. Only for UI clients.
      History
shistory <- m History
forall (m :: * -> *). MonadClientUI m => m History
defaultHistory
      (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 {History
shistory :: History
shistory :: History
shistory}
    m ()
forall (m :: * -> *). MonadClientUI m => m ()
recordHistory  -- to ensure EOL even at creation of history
    LevelId
lid <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
getArenaUI
    Level
lvl <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel LevelId
lid
    ModeKind
gameMode <- m ModeKind
forall (m :: * -> *). MonadStateRead m => m ModeKind
getGameMode
    Challenge
curChal <- (StateClient -> Challenge) -> m Challenge
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Challenge
scurChal
    Faction
fact <- (State -> Faction) -> m Faction
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (FactionDict -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
fid) (FactionDict -> Faction)
-> (State -> FactionDict) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> FactionDict
sfactionD
    let loneMode :: Bool
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
    MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
MsgBookKeeping Text
"-------------------------------------------------"
    m ()
forall (m :: * -> *). MonadClientUI m => m ()
recordHistory
    MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
MsgActionWarning
           (Text
"New game started in" Text -> Text -> Text
<+> ModeKind -> Text
mname ModeKind
gameMode Text -> Text -> Text
<+> Text
"mode.")
    MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
MsgPlotExposition (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ ModeKind -> Text
mdesc ModeKind
gameMode
    let desc :: Text
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
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> Bool
T.null Text
desc) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
      MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgLnAdd MsgClassShowAndSave
MsgBackdropFocus Text
"You take in your surroundings."
      MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
MsgBackdropInfo Text
desc
    -- We can fool the player only once (per scenario), but let's not do it
    -- in the same way each time. TODO: PCG
    Text
blurb <- Rnd Text -> m Text
forall (m :: * -> *) a. MonadClientUI m => Rnd a -> m a
rndToActionUI (Rnd Text -> m Text) -> Rnd Text -> m Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Rnd Text
forall a. [a] -> Rnd a
oneOf
      [ Text
"You think you saw movement."
      , Text
"Something catches your peripherial vision."
      , Text
"You think you felt a tremor under your feet."
      , Text
"A whiff of chilly air passes around you."
      , Text
"You notice a draft just when it dies down."
      , Text
"The ground nearby is stained along some faint lines."
      , Text
"Scarce black motes slowly settle on the ground."
      , Text
"The ground in the immediate area is empty, as if just swiped."
      ]
    MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgLnAdd MsgClassShowAndSave
MsgBadMiscEvent Text
blurb  -- being here is a bad turn of events
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Challenge -> Bool
cwolf Challenge
curChal Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
loneMode) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
      MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
MsgActionWarning Text
"Being a lone wolf, you begin without companions."
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (History -> Int
lengthHistory (SessionUI -> History
shistory SessionUI
oldSess) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
      Bool -> m ()
forall (m :: * -> *). MonadClientUI m => Bool -> m ()
fadeOutOrIn Bool
False
    Bool -> m ()
forall (m :: * -> *). MonadClientUI m => Bool -> m ()
setFrontAutoYes (Bool -> m ()) -> Bool -> m ()
forall a b. (a -> b) -> a -> b
$ Faction -> Bool
isAIFact Faction
fact
    -- Forget the furious keypresses when dying in the previous game.
    m ()
forall (m :: * -> *). MonadClientUI m => m ()
resetPressedKeys
    -- Help newbies when actors obscured by text and no obvious key to press:
    ColorMode -> Text -> m ()
forall (m :: * -> *). MonadClientUI m => ColorMode -> Text -> m ()
displayMore ColorMode
ColorFull Text
"\nAre you up for the challenge?"
    MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgPromptGeneric
           Text
"A grand story starts right here! (Press '?' for context and help.)"
  UpdRestartServer{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdResume FactionId
fid PerLid
_ -> do
    COps{ContentData CaveKind
cocave :: ContentData CaveKind
cocave :: COps -> ContentData CaveKind
cocave} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
    m ()
forall (m :: * -> *). MonadClientUI m => m ()
resetSessionStart
    Faction
fact <- (State -> Faction) -> m Faction
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (FactionDict -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
fid) (FactionDict -> Faction)
-> (State -> FactionDict) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> FactionDict
sfactionD
    Bool -> m ()
forall (m :: * -> *). MonadClientUI m => Bool -> m ()
setFrontAutoYes (Bool -> m ()) -> Bool -> m ()
forall a b. (a -> b) -> a -> b
$ Faction -> Bool
isAIFact Faction
fact
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Faction -> Bool
isAIFact Faction
fact) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
      LevelId
lid <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
getArenaUI
      Level
lvl <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel LevelId
lid
      ModeKind
gameMode <- m ModeKind
forall (m :: * -> *). MonadStateRead m => m ModeKind
getGameMode
      MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgActionAlert (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Continuing" Text -> Text -> Text
<+> ModeKind -> Text
mname ModeKind
gameMode Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
      MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgPromptGeneric (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ ModeKind -> Text
mdesc ModeKind
gameMode
      let desc :: Text
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
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> Bool
T.null Text
desc) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
        MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgLnAdd MsgClassShow
MsgPromptFocus Text
"You remember your surroundings."
        MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgPromptGeneric Text
desc
      ColorMode -> Text -> m ()
forall (m :: * -> *). MonadClientUI m => ColorMode -> Text -> m ()
displayMore ColorMode
ColorFull Text
"\nAre you up for the challenge?"
      MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgPromptGeneric
             Text
"Prove yourself! (Press '?' for context and help.)"
  UpdResumeServer{} -> () -> m ()
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 (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..."
    FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
    Text -> m ()
forall (m :: * -> *). MonadClientUI m => Text -> m ()
debugPossiblyPrintUI (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Client" Text -> Text -> Text
<+> FactionId -> Text
forall a. Show a => a -> Text
tshow FactionId
side Text -> Text -> Text
<+> Text
"closing frontend."
    m ()
forall (m :: * -> *). MonadClientUI m => m ()
frontendShutdown
    Text -> m ()
forall (m :: * -> *). MonadClientUI m => Text -> m ()
debugPossiblyPrintUI (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Client" Text -> Text -> Text
<+> FactionId -> Text
forall a. Show a => a -> Text
tshow FactionId
side Text -> Text -> Text
<+> Text
"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
    Maybe ActorId
mleader <- (StateClient -> Maybe ActorId) -> m (Maybe ActorId)
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Maybe ActorId
sleader
    case Maybe ActorId
mleader of
      Just{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()  -- will flush messages when leader moves
      Maybe ActorId
Nothing -> do
        LevelId
lidV <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
viewedLevelUI
        LevelId -> m ()
forall (m :: * -> *). MonadClientUI m => LevelId -> m ()
markDisplayNeeded LevelId
lidV
        m ()
forall (m :: * -> *). MonadClientUI m => m ()
recordHistory
    Text
msg <- Maybe Int -> HearMsg -> m Text
forall (m :: * -> *).
MonadClientUI m =>
Maybe Int -> HearMsg -> m Text
ppHearMsg Maybe Int
distance HearMsg
hearMsg
    let msgClass :: MsgClassShowAndSave
msgClass = case Maybe Int
distance of
          Maybe Int
Nothing -> MsgClassShowAndSave
MsgHeardOutside
          Just Int
0 -> MsgClassShowAndSave
MsgHeardNearby
          Just Int
_ -> MsgClassShowAndSave
MsgHeardFaraway
    MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
msgClass Text
msg
    case HearMsg
hearMsg of
      HearUpd UpdDestroyActor{} ->
        MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
MsgTutorialHint Text
"Events out of your sight radius (as listed in the '#' skill menu) can sometimes be heard, depending on your hearing radius skill. Some, such as death shrieks, can always be heard regardless of skill and distance, including when they come from a different floor."
      HearTaunt{} -> do
        Time
globalTime <- (State -> Time) -> m Time
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> Time
stime
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Time
globalTime Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
> Time
timeTurn) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$  -- avoid too many hints at the start
          MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
MsgTutorialHint Text
"Enemies you can't see are sometimes heard yelling and emitting other noises. Whether you can hear them, depends on their distance and your hearing radius, as listed in the '#' skill menu."
      HearMsg
_ -> () -> m ()
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 {Bool
smuteMessages :: Bool
smuteMessages :: Bool
smuteMessages}

updateItemSlot :: MonadClientUI m => Container -> ItemId -> m ()
updateItemSlot :: Container -> ItemId -> m ()
updateItemSlot Container
c ItemId
iid = do
  AspectRecord
arItem <- (State -> AspectRecord) -> m AspectRecord
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
  ItemSlots EnumMap SLore SingleItemSlots
itemSlots <- (SessionUI -> ItemSlots) -> m ItemSlots
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> ItemSlots
sslots
  let slore :: SLore
slore = AspectRecord -> Container -> SLore
IA.loreFromContainer AspectRecord
arItem Container
c
      lSlots :: SingleItemSlots
lSlots = EnumMap SLore SingleItemSlots
itemSlots EnumMap SLore SingleItemSlots -> SLore -> SingleItemSlots
forall k a. Enum k => EnumMap k a -> k -> a
EM.! SLore
slore
  case ItemId -> [(ItemId, SlotChar)] -> Maybe SlotChar
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ItemId
iid ([(ItemId, SlotChar)] -> Maybe SlotChar)
-> [(ItemId, SlotChar)] -> Maybe SlotChar
forall a b. (a -> b) -> a -> b
$ ((SlotChar, ItemId) -> (ItemId, SlotChar))
-> [(SlotChar, ItemId)] -> [(ItemId, SlotChar)]
forall a b. (a -> b) -> [a] -> [b]
map (SlotChar, ItemId) -> (ItemId, SlotChar)
forall a b. (a, b) -> (b, a)
swap ([(SlotChar, ItemId)] -> [(ItemId, SlotChar)])
-> [(SlotChar, ItemId)] -> [(ItemId, SlotChar)]
forall a b. (a -> b) -> a -> b
$ SingleItemSlots -> [(SlotChar, ItemId)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs SingleItemSlots
lSlots of
    Maybe SlotChar
Nothing -> do
      let l :: SlotChar
l = SingleItemSlots -> SlotChar
assignSlot SingleItemSlots
lSlots
          f :: SingleItemSlots -> SingleItemSlots
f = SlotChar -> ItemId -> SingleItemSlots -> SingleItemSlots
forall k a. Enum k => k -> a -> EnumMap k a -> EnumMap k a
EM.insert SlotChar
l ItemId
iid
          newSlots :: ItemSlots
newSlots = EnumMap SLore SingleItemSlots -> ItemSlots
ItemSlots (EnumMap SLore SingleItemSlots -> ItemSlots)
-> EnumMap SLore SingleItemSlots -> ItemSlots
forall a b. (a -> b) -> a -> b
$ (SingleItemSlots -> SingleItemSlots)
-> SLore
-> EnumMap SLore SingleItemSlots
-> EnumMap SLore SingleItemSlots
forall k a. Enum k => (a -> a) -> k -> EnumMap k a -> EnumMap k a
EM.adjust SingleItemSlots -> SingleItemSlots
f SLore
slore EnumMap SLore SingleItemSlots
itemSlots
      (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 {sslots :: ItemSlots
sslots = ItemSlots
newSlots}
    Just SlotChar
_l -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()  -- slot already assigned

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
/= :: Threat -> Threat -> Bool
$c/= :: Threat -> Threat -> Bool
== :: Threat -> Threat -> Bool
$c== :: Threat -> Threat -> Bool
Eq

createActorUI :: MonadClientUI m => Bool -> ActorId -> Actor -> m ()
createActorUI :: Bool -> ActorId -> Actor -> m ()
createActorUI Bool
born ActorId
aid Actor
body = do
  CCUI{coscreen :: CCUI -> ScreenContent
coscreen=ScreenContent{Int
rwidth :: ScreenContent -> Int
rwidth :: Int
rwidth}} <- (SessionUI -> CCUI) -> m CCUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
  FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
  FactionDict
factionD <- (State -> FactionDict) -> m FactionDict
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> FactionDict
sfactionD
  let fact :: Faction
fact = FactionDict
factionD FactionDict -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
body
  Time
localTime <- (State -> Time) -> m Time
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 (LevelId -> State -> Time) -> LevelId -> State -> Time
forall a b. (a -> b) -> a -> b
$ Actor -> LevelId
blid Actor
body
  itemFull :: ItemFull
itemFull@ItemFull{Item
itemBase :: ItemFull -> Item
itemBase :: Item
itemBase, ItemKind
itemKind :: ItemFull -> ItemKind
itemKind :: ItemKind
itemKind} <- (State -> ItemFull) -> m ItemFull
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 (Actor -> ItemId
btrunk Actor
body)
  ActorDictUI
actorUI <- (SessionUI -> ActorDictUI) -> m ActorDictUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> ActorDictUI
sactorUI
  let arItem :: AspectRecord
arItem = ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFull
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ActorId
aid ActorId -> ActorDictUI -> Bool
forall k a. Enum k => k -> EnumMap k a -> Bool
`EM.member` ActorDictUI
actorUI) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    UIOptions{[(Int, (Text, Text))]
uHeroNames :: UIOptions -> [(Int, (Text, Text))]
uHeroNames :: [(Int, (Text, Text))]
uHeroNames} <- (SessionUI -> UIOptions) -> m UIOptions
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> UIOptions
sUIOptions
    let baseColor :: Color
baseColor = Flavour -> Color
flavourToColor (Flavour -> Color) -> Flavour -> Color
forall a b. (a -> b) -> a -> b
$ Item -> Flavour
jflavour Item
itemBase
        basePronoun :: Text
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
&& Player -> Bool
fhasGender (Faction -> Player
gplayer Faction
fact) = Text
"he"
                    | Bool
otherwise = Text
"it"
        nameFromNumber :: Text -> a -> Text
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 -> (Text, Text)
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 (Player -> Text
fname (Player -> Text) -> Player -> Text
forall a b. (a -> b) -> a -> b
$ Faction -> Player
gplayer 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 (Player -> Text
fname (Player -> Text) -> Player -> Text
forall a b. (a -> b) -> a -> b
$ Faction -> Player
gplayer 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
        (Int
n, Char
bsymbol) =
          if | Actor -> Bool
bproj Actor
body -> (Int
0, if Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Blast AspectRecord
arItem
                                 then ItemKind -> Char
IK.isymbol ItemKind
itemKind
                                 else Char
'*')
             | Color
baseColor Color -> Color -> Bool
forall a. Eq a => a -> a -> Bool
/= Color
Color.BrWhite -> (Int
0, ItemKind -> Char
IK.isymbol ItemKind
itemKind)
             | Bool
otherwise -> case Actor -> Maybe Int
bnumber Actor
body of
                 Maybe Int
Nothing ->
                   [Char] -> (Int, Char)
forall a. (?callStack::CallStack) => [Char] -> a
error ([Char] -> (Int, Char)) -> [Char] -> (Int, Char)
forall a b. (a -> b) -> a -> b
$ [Char]
"numbered actor without server-assigned number"
                           [Char] -> (ActorId, Actor) -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`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
'@')
        (Part
object1, Part
object2) =
          Int
-> FactionId
-> FactionDict
-> Time
-> ItemFull
-> ItemQuant
-> (Part, Part)
partItemShortest Int
rwidth (Actor -> FactionId
bfid Actor
body) FactionDict
factionD Time
localTime
                           ItemFull
itemFull ItemQuant
quantSingle
        (Text
bname, Text
bpronoun) =
          if | Actor -> Bool
bproj Actor
body ->
               let adj :: Part
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 ([Part] -> Text
makePhrase [Part
adj, Part
object1, Part
object2], Text
basePronoun)
             | Color
baseColor Color -> Color -> Bool
forall a. Eq a => a -> a -> Bool
/= Color
Color.BrWhite ->
               ([Part] -> Text
makePhrase [Part
object1, Part
object2], Text
basePronoun)
             | Bool
otherwise -> Int -> (Text, Text)
heroNamePronoun Int
n
        bcolor :: Color
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
bUI = ActorUI :: Char -> Text -> Text -> Color -> ActorUI
ActorUI{Char
Text
Color
bcolor :: Color
bpronoun :: Text
bname :: Text
bsymbol :: Char
bcolor :: Color
bpronoun :: Text
bname :: Text
bsymbol :: Char
..}
    (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 {sactorUI :: ActorDictUI
sactorUI = ActorId -> ActorUI -> ActorDictUI -> ActorDictUI
forall k a. Enum k => k -> a -> EnumMap k a -> EnumMap k a
EM.insert ActorId
aid ActorUI
bUI ActorDictUI
actorUI}
  ((ItemId, CStore) -> m ()) -> [(ItemId, CStore)] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
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 ()
updateItemSlot Container
c ItemId
iid
           ItemId -> Container -> m ()
forall (m :: * -> *).
MonadClientUI m =>
ItemId -> Container -> m ()
recordItemLid ItemId
iid Container
c)
        ((Actor -> ItemId
btrunk Actor
body, CStore
CEqp)  -- store will be overwritten, unless projectile
         (ItemId, CStore) -> [(ItemId, CStore)] -> [(ItemId, CStore)]
forall a. a -> [a] -> [a]
: ((ItemId, CStore) -> Bool)
-> [(ItemId, CStore)] -> [(ItemId, CStore)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((ItemId -> ItemId -> Bool
forall a. Eq a => a -> a -> Bool
/= Actor -> ItemId
btrunk Actor
body) (ItemId -> Bool)
-> ((ItemId, CStore) -> ItemId) -> (ItemId, CStore) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ItemId, CStore) -> ItemId
forall a b. (a, b) -> a
fst) (Actor -> [(ItemId, CStore)]
getCarriedIidCStore Actor
body))
  if | Actor -> Bool
bproj Actor
body -> do
       Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Actor -> FactionId
bfid Actor
body FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
/= FactionId
side)
         m ()
forall (m :: * -> *). MonadClientUI m => m ()
stopPlayBack
       Bool -> m ()
forall (m :: * -> *). MonadClientUI m => Bool -> m ()
pushFrame Bool
False  -- make sure first (seen (again)) position displayed
     | Actor -> FactionId
bfid Actor
body FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side -> do
       let upd :: EnumSet ActorId -> EnumSet ActorId
upd = ActorId -> EnumSet ActorId -> EnumSet ActorId
forall k. Enum k => k -> EnumSet k -> EnumSet k
ES.insert ActorId
aid
       (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 {sselected :: EnumSet ActorId
sselected = EnumSet ActorId -> EnumSet ActorId
upd (EnumSet ActorId -> EnumSet ActorId)
-> EnumSet ActorId -> EnumSet ActorId
forall a b. (a -> b) -> a -> b
$ SessionUI -> EnumSet ActorId
sselected SessionUI
sess}
       Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ActorDictUI -> Bool
forall k a. EnumMap k a -> Bool
EM.null ActorDictUI
actorUI) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do  -- don't announce the very first party member
         Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
born (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
           let verb :: Part
verb = Part
"join you"
           MsgClassShowAndSave -> ActorId -> Part -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> ActorId -> Part -> m ()
aidVerbMU MsgClassShowAndSave
MsgSpottedActor ActorId
aid Part
verb
           MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
MsgTutorialHint Text
"You survive this mission, or die trying, as a team. After a few moves, feel free to switch the controlled teammate (marked on the map with the yellow box) using the Tab key to another party member (marked with a green box)."  -- assuming newbies don't remap their keys
           LevelId -> Animation -> m ()
forall (m :: * -> *).
MonadClientUI m =>
LevelId -> Animation -> m ()
animate (Actor -> LevelId
blid Actor
body) (Animation -> m ()) -> Animation -> m ()
forall a b. (a -> b) -> a -> b
$ Point -> Animation
actorX (Actor -> Point
bpos Actor
body)
     | Bool
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).
       EnumSet ActorId
lastLost <- (SessionUI -> EnumSet ActorId) -> m (EnumSet ActorId)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> EnumSet ActorId
slastLost
       if ActorId -> EnumSet ActorId -> Bool
forall k. Enum k => k -> EnumSet k -> Bool
ES.member ActorId
aid EnumSet ActorId
lastLost
       then LevelId -> m ()
forall (m :: * -> *). MonadClientUI m => LevelId -> m ()
markDisplayNeeded (Actor -> LevelId
blid Actor
body)
       else do
         m ()
forall (m :: * -> *). MonadClientUI m => m ()
stopPlayBack
         let verb :: Part
verb = if Bool
born then Part
"appear suddenly" else Part
"be spotted"
         Threat
threat <-
           if FactionId -> Faction -> FactionId -> Bool
isFoe (Actor -> FactionId
bfid Actor
body) Faction
fact FactionId
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.
             Maybe Target
xhair <- (SessionUI -> Maybe Target) -> m (Maybe Target)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe Target
sxhair
             case Maybe Target
xhair of
               Just (TVector Vector
_) -> () -> m ()
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 :: Maybe Target
sxhair = Target -> Maybe Target
forall a. a -> Maybe a
Just (Target -> Maybe Target) -> Target -> Maybe Target
forall a b. (a -> b) -> a -> b
$ ActorId -> Target
TEnemy ActorId
aid
                           , sitemSel :: Maybe (ItemId, CStore, Bool)
sitemSel = Maybe (ItemId, CStore, Bool)
forall a. Maybe a
Nothing } -- reset flinging totally
             [Actor]
foes <- (State -> [Actor]) -> m [Actor]
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
$ FactionId -> LevelId -> State -> [Actor]
foeRegularList FactionId
side (Actor -> LevelId
blid Actor
body)
             Int
itemsSize <- (State -> Int) -> m Int
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Int) -> m Int) -> (State -> Int) -> m Int
forall a b. (a -> b) -> a -> b
$ Actor -> State -> Int
guardItemSize Actor
body
             if [Actor] -> Int
forall a. [a] -> Int
length [Actor]
foes Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1 then
               if Int
itemsSize Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then do
                 MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgSpottedThreat Text
"You are not alone!"
                 Threat -> m Threat
forall (m :: * -> *) a. Monad m => a -> m a
return Threat
ThreatUnarmed
               else do
                 MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgSpottedThreat Text
"Armed intrusion ahead!"
                 Threat -> m Threat
forall (m :: * -> *) a. Monad m => a -> m a
return Threat
ThreatArmed
             else
               if Int
itemsSize Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then
                 Threat -> m Threat
forall (m :: * -> *) a. Monad m => a -> m a
return Threat
ThreatAnotherUnarmed
               else do
                 MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgSpottedThreat Text
"Another threat, armed!"
                 Threat -> m Threat
forall (m :: * -> *) a. Monad m => a -> m a
return Threat
ThreatAnotherArmed
           else Threat -> m Threat
forall (m :: * -> *) a. Monad m => a -> m a
return Threat
ThreatNone  -- member of neutral faction
         MsgClassShowAndSave -> ActorId -> Part -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> ActorId -> Part -> m ()
aidVerbMU MsgClassShowAndSave
MsgSpottedActor ActorId
aid Part
verb
         [(ActorId, Actor)]
friendAssocs <- (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)])
-> (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
forall a b. (a -> b) -> a -> b
$ FactionId -> LevelId -> State -> [(ActorId, Actor)]
friendRegularAssocs FactionId
side (Actor -> LevelId
blid Actor
body)
         case Threat
threat of
           Threat
ThreatNone -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()  -- too rare to care ATM
           Threat
ThreatUnarmed ->
             MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
MsgTutorialHint Text
"Enemies are normally dealt with using melee (by bumping when adjacent) or ranged combat (by 'f'linging items at them)."
           Threat
ThreatArmed ->
             MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
MsgTutorialHint Text
"Enemies can be dealt with not only via combat, but also with clever use of terrain effects, stealth (not emitting nor reflecting light) or hasty retreat (particularly when foes are asleep or drowsy)."
           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 (m :: * -> *) a. Monad m => a -> m a
return ()  -- one member on level
           Threat
ThreatAnotherUnarmed ->
             MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
MsgTutorialHint Text
"When dealing with groups of enemies, remember than you fight as a team. Switch the pointman (marked on the map with the yellow box) using the Tab key until you move each teammate to a tactically advantageous position. Avoid meleeing alone."
           Threat
ThreatAnotherArmed ->
             MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
MsgTutorialHint Text
"When dealing with groups of armed enemies, remember than you fight as a team. Switch the pointman (marked on the map with the yellow box) using the Tab key until you move each teammate to a tactically advantageous position. Retreat, if necessary to form a front line. Soften the foes with missiles, especially of exploding kind."
         LevelId -> Animation -> m ()
forall (m :: * -> *).
MonadClientUI m =>
LevelId -> Animation -> m ()
animate (Actor -> LevelId
blid Actor
body) (Animation -> m ()) -> Animation -> m ()
forall a b. (a -> b) -> a -> b
$ Point -> Animation
actorX (Actor -> Point
bpos Actor
body)

destroyActorUI :: MonadClientUI m => Bool -> ActorId -> Actor -> m ()
destroyActorUI :: Bool -> ActorId -> Actor -> m ()
destroyActorUI Bool
destroy ActorId
aid Actor
b = do
  Item
trunk <- (State -> Item) -> m Item
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 :: Color
baseColor = Flavour -> Color
flavourToColor (Flavour -> Color) -> Flavour -> Color
forall a b. (a -> b) -> a -> b
$ Item -> Flavour
jflavour Item
trunk
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Color
baseColor Color -> Color -> Bool
forall a. Eq a => a -> a -> Bool
== Color
Color.BrWhite) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$  -- keep setup for heroes, etc.
    (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 {sactorUI :: ActorDictUI
sactorUI = ActorId -> ActorDictUI -> ActorDictUI
forall k a. Enum k => k -> EnumMap k a -> EnumMap k a
EM.delete ActorId
aid (ActorDictUI -> ActorDictUI) -> ActorDictUI -> ActorDictUI
forall a b. (a -> b) -> a -> b
$ SessionUI -> ActorDictUI
sactorUI SessionUI
sess}
  let dummyTarget :: Target
dummyTarget = TGoal -> LevelId -> Point -> Target
TPoint TGoal
TKnown (Actor -> LevelId
blid Actor
b) (Actor -> Point
bpos Actor
b)
      affect :: Maybe Target -> Maybe Target
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
  (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 :: Maybe Target
sxhair = Maybe Target -> Maybe Target
affect (Maybe Target -> Maybe Target) -> Maybe Target -> Maybe Target
forall a b. (a -> b) -> a -> b
$ SessionUI -> Maybe Target
sxhair SessionUI
sess}
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Actor -> Bool
bproj Actor
b Bool -> Bool -> Bool
|| Bool
destroy) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
    (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 {slastLost :: EnumSet ActorId
slastLost = ActorId -> EnumSet ActorId -> EnumSet ActorId
forall k. Enum k => k -> EnumSet k -> EnumSet k
ES.insert ActorId
aid (EnumSet ActorId -> EnumSet ActorId)
-> EnumSet ActorId -> EnumSet ActorId
forall a b. (a -> b) -> a -> b
$ SessionUI -> EnumSet ActorId
slastLost SessionUI
sess}
  FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
  Faction
fact <- (State -> Faction) -> m Faction
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (FactionDict -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
side) (FactionDict -> Faction)
-> (State -> FactionDict) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> FactionDict
sfactionD
  let gameOver :: Bool
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
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
gameOver (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Actor -> FactionId
bfid Actor
b FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side Bool -> Bool -> Bool
&& Bool -> Bool
not (Actor -> Bool
bproj Actor
b)) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
      m ()
forall (m :: * -> *). MonadClientUI m => m ()
stopPlayBack
      let upd :: EnumSet ActorId -> EnumSet ActorId
upd = ActorId -> EnumSet ActorId -> EnumSet ActorId
forall k. Enum k => k -> EnumSet k -> EnumSet k
ES.delete ActorId
aid
      (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 {sselected :: EnumSet ActorId
sselected = EnumSet ActorId -> EnumSet ActorId
upd (EnumSet ActorId -> EnumSet ActorId)
-> EnumSet ActorId -> EnumSet ActorId
forall a b. (a -> b) -> a -> b
$ SessionUI -> EnumSet ActorId
sselected SessionUI
sess}
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
destroy (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
        Maybe ActorId
mleader <- (StateClient -> Maybe ActorId) -> m (Maybe ActorId)
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Maybe ActorId
sleader
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe ActorId -> Bool
forall a. Maybe a -> Bool
isJust Maybe ActorId
mleader)
          -- This is especially handy when the dead actor was a leader
          -- on a different level than the new one:
          m ()
forall (m :: * -> *). MonadClientUI m => m ()
clearAimMode
    -- If pushed, animate spotting again, to draw attention to pushing.
    LevelId -> m ()
forall (m :: * -> *). MonadClientUI m => LevelId -> m ()
markDisplayNeeded (Actor -> LevelId
blid Actor
b)

spotItemBag :: forall m. MonadClientUI m
            => Bool -> Container -> ItemBag -> m ()
spotItemBag :: 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 :: CCUI -> ScreenContent
coscreen=ScreenContent{Int
rwidth :: Int
rwidth :: ScreenContent -> Int
rwidth}} <- (SessionUI -> CCUI) -> m CCUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
  FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
  ItemId -> ContentId ItemKind
getKind <- (State -> ItemId -> ContentId ItemKind)
-> m (ItemId -> ContentId ItemKind)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemId -> ContentId ItemKind)
 -> m (ItemId -> ContentId ItemKind))
-> (State -> ItemId -> ContentId ItemKind)
-> m (ItemId -> ContentId ItemKind)
forall a b. (a -> b) -> a -> b
$ (ItemId -> State -> ContentId ItemKind)
-> State -> ItemId -> ContentId ItemKind
forall a b c. (a -> b -> c) -> b -> a -> c
flip ItemId -> State -> ContentId ItemKind
getIidKindId
  LevelId
lid <- (State -> LevelId) -> m LevelId
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> LevelId) -> m LevelId)
-> (State -> LevelId) -> m LevelId
forall a b. (a -> b) -> a -> b
$ Container -> State -> LevelId
lidFromC Container
c
  Time
localTime <- (State -> Time) -> m Time
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 LevelId
lid
  FactionDict
factionD <- (State -> FactionDict) -> m FactionDict
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> FactionDict
sfactionD
  -- Queried just once, so many copies of a new item can be reported. OK.
  ItemSlots EnumMap SLore SingleItemSlots
itemSlots <- (SessionUI -> ItemSlots) -> m ItemSlots
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> ItemSlots
sslots
  Maybe Target
sxhairOld <- (SessionUI -> Maybe Target) -> m (Maybe Target)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe Target
sxhair
  let resetXhair :: m ()
resetXhair = case Container
c of
        CFloor LevelId
_ Point
p -> case Maybe Target
sxhairOld of
          Just TEnemy{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()  -- probably too important to overwrite
          Just (TPoint TEnemyPos{} LevelId
_ Point
_) -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          Just (TPoint TStash{} LevelId
_ Point
_) -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          Just (TVector Vector
_) -> () -> m ()
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.
            LevelId
lidV <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
viewedLevelUI
            Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (LevelId
lid LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== LevelId
lidV) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
              ItemBag
bagFloor <- (State -> ItemBag) -> m ItemBag
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemBag) -> m ItemBag)
-> (State -> ItemBag) -> m ItemBag
forall a b. (a -> b) -> a -> b
$ LevelId -> Point -> State -> ItemBag
getFloorBag LevelId
lid Point
p
              (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 :: Maybe Target
sxhair = Target -> Maybe Target
forall a. a -> Maybe a
Just (Target -> Maybe Target) -> Target -> Maybe Target
forall a b. (a -> b) -> a -> b
$ TGoal -> LevelId -> Point -> Target
TPoint (ItemBag -> TGoal
TItem ItemBag
bagFloor) LevelId
lidV Point
p
                     , sitemSel :: Maybe (ItemId, CStore, Bool)
sitemSel = Maybe (ItemId, CStore, Bool)
forall a. Maybe a
Nothing }  -- reset flinging totally
        Container
_ -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      locatedWhere :: Text
locatedWhere = FactionDict -> Container -> Text
ppContainer FactionDict
factionD Container
c
      beLocated :: Part
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, ItemQuant) -> m (Maybe (Int, Part, 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
itemFull <- (State -> ItemFull) -> m ItemFull
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 :: AspectRecord
arItem = ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFull
            slore :: SLore
slore = AspectRecord -> Container -> SLore
IA.loreFromContainer AspectRecord
arItem Container
c
        case ItemId -> [(ItemId, SlotChar)] -> Maybe SlotChar
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ItemId
iid ([(ItemId, SlotChar)] -> Maybe SlotChar)
-> [(ItemId, SlotChar)] -> Maybe SlotChar
forall a b. (a -> b) -> a -> b
$ ((SlotChar, ItemId) -> (ItemId, SlotChar))
-> [(SlotChar, ItemId)] -> [(ItemId, SlotChar)]
forall a b. (a -> b) -> [a] -> [b]
map (SlotChar, ItemId) -> (ItemId, SlotChar)
forall a b. (a, b) -> (b, a)
swap ([(SlotChar, ItemId)] -> [(ItemId, SlotChar)])
-> [(SlotChar, ItemId)] -> [(ItemId, SlotChar)]
forall a b. (a -> b) -> a -> b
$ SingleItemSlots -> [(SlotChar, ItemId)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs (SingleItemSlots -> [(SlotChar, ItemId)])
-> SingleItemSlots -> [(SlotChar, ItemId)]
forall a b. (a -> b) -> a -> b
$ EnumMap SLore SingleItemSlots
itemSlots EnumMap SLore SingleItemSlots -> SLore -> SingleItemSlots
forall k a. Enum k => EnumMap k a -> k -> a
EM.! SLore
slore of
          Maybe SlotChar
Nothing -> do  -- never seen or would have a slot
            Container -> ItemId -> m ()
forall (m :: * -> *).
MonadClientUI m =>
Container -> ItemId -> m ()
updateItemSlot Container
c ItemId
iid
            case Container
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 (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 (m :: * -> *) a. Monad m => a -> m a
return Maybe (Int, Part, Part)
forall a. Maybe a
Nothing
          Maybe SlotChar
_ -> Maybe (Int, Part, Part) -> m (Maybe (Int, Part, Part))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Int, Part, Part)
forall a. Maybe a
Nothing  -- this item or another with the same @iid@
                               -- seen already (has a slot assigned); old news
      -- @SortOn@ less efficient here, because function cheap.
      sortItems :: [(ItemId, ItemQuant)] -> [(ItemId, ItemQuant)]
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)]
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
  [Maybe (Int, Part, Part)]
subjectMaybes <- ((ItemId, ItemQuant) -> m (Maybe (Int, Part, Part)))
-> [(ItemId, ItemQuant)] -> m [Maybe (Int, Part, Part)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ItemId, ItemQuant) -> m (Maybe (Int, Part, Part))
subjectMaybe [(ItemId, ItemQuant)]
sortedAssocs
  let subjects :: [(Int, Part, Part)]
subjects = [Maybe (Int, Part, Part)] -> [(Int, Part, Part)]
forall a. [Maybe a] -> [a]
catMaybes [Maybe (Int, Part, Part)]
subjectMaybes
      sendMsg :: Bool -> m ()
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 [(Int, Part, Part)]
subjects of
    [] -> () -> m ()
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
  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
      let verb :: Part
verb = Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ CStore -> Text
verbCStore CStore
store
      Actor
b <- (State -> Actor) -> m Actor
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
      Faction
fact <- (State -> Faction) -> m Faction
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (FactionDict -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
b) (FactionDict -> Faction)
-> (State -> FactionDict) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> FactionDict
sfactionD
      let underAI :: Bool
underAI = Faction -> Bool
isAIFact Faction
fact
      Maybe ActorId
mleader <- (StateClient -> Maybe ActorId) -> m (Maybe ActorId)
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Maybe ActorId
sleader
      if ActorId -> Maybe ActorId
forall a. a -> Maybe a
Just ActorId
aid Maybe ActorId -> Maybe ActorId -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe ActorId
mleader Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
underAI then
        MsgClassShowAndSave
-> ActorId
-> Part
-> [(ItemId, ItemQuant)]
-> (Int -> Either (Maybe Int) Int)
-> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a
-> ActorId
-> Part
-> [(ItemId, ItemQuant)]
-> (Int -> Either (Maybe Int) Int)
-> m ()
manyItemsAidVerbMU MsgClassShowAndSave
MsgItemMovement ActorId
aid Part
verb [(ItemId, ItemQuant)]
sortedAssocs Int -> Either (Maybe Int) Int
forall a b. b -> Either a b
Right
      else Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Actor -> Bool
bproj Actor
b) Bool -> Bool -> Bool
&& Actor -> Int64
bhp Actor
b Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$  -- don't announce death drops
        MsgClassShowAndSave
-> ActorId
-> Part
-> [(ItemId, ItemQuant)]
-> (Int -> Either (Maybe Int) Int)
-> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a
-> ActorId
-> Part
-> [(ItemId, ItemQuant)]
-> (Int -> Either (Maybe Int) Int)
-> m ()
manyItemsAidVerbMU MsgClassShowAndSave
MsgItemMovement ActorId
aid Part
verb [(ItemId, ItemQuant)]
sortedAssocs (Maybe Int -> Either (Maybe Int) Int
forall a b. a -> Either a b
Left (Maybe Int -> Either (Maybe Int) Int)
-> (Int -> Maybe Int) -> Int -> Either (Maybe Int) Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Maybe Int
forall a. a -> Maybe a
Just)
    Container
_ -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

recordItemLid :: MonadClientUI m => ItemId -> Container -> m ()
recordItemLid :: ItemId -> Container -> m ()
recordItemLid ItemId
iid Container
c = do
  Maybe LevelId
mjlid <- (SessionUI -> Maybe LevelId) -> m (Maybe LevelId)
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
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe LevelId -> Bool
forall a. Maybe a -> Bool
isNothing Maybe LevelId
mjlid) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    LevelId
lid <- (State -> LevelId) -> m LevelId
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> LevelId) -> m LevelId)
-> (State -> LevelId) -> m LevelId
forall a b. (a -> b) -> a -> b
$ Container -> State -> LevelId
lidFromC Container
c
    (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 {sitemUI :: EnumMap ItemId LevelId
sitemUI = ItemId
-> LevelId -> EnumMap ItemId LevelId -> EnumMap ItemId LevelId
forall k a. Enum k => k -> a -> EnumMap k a -> EnumMap k a
EM.insert ItemId
iid LevelId
lid (EnumMap ItemId LevelId -> EnumMap ItemId LevelId)
-> EnumMap ItemId LevelId -> EnumMap ItemId LevelId
forall a b. (a -> b) -> a -> b
$ SessionUI -> EnumMap ItemId LevelId
sitemUI SessionUI
sess}

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

displaceActorUI :: MonadClientUI m => ActorId -> ActorId -> m ()
displaceActorUI :: ActorId -> ActorId -> m ()
displaceActorUI ActorId
source ActorId
target = do
  Maybe ActorId
mleader <- (StateClient -> Maybe ActorId) -> m (Maybe ActorId)
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Maybe ActorId
sleader
  Actor
sb <- (State -> Actor) -> m Actor
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
source
  Actor
tb <- (State -> Actor) -> m Actor
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
target
  Part
spart <- ActorId -> m Part
forall (m :: * -> *). MonadClientUI m => ActorId -> m Part
partActorLeader ActorId
source
  Part
tpart <- ActorId -> m Part
forall (m :: * -> *). MonadClientUI m => ActorId -> m Part
partActorLeader ActorId
target
  let msgClass :: MsgClassShowAndSave
msgClass = if Maybe ActorId
mleader Maybe ActorId -> [Maybe ActorId] -> 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 :: Text
msg = [Part] -> Text
makeSentence [Part -> Part -> Part
MU.SubjectVerbSg Part
spart Part
"displace", Part
tpart]
  MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
msgClass Text
msg
  ActorId -> m ()
forall (m :: * -> *). MonadClientUI m => ActorId -> m ()
lookAtMove ActorId
source
  ActorId -> m ()
forall (m :: * -> *). MonadClientUI m => ActorId -> m ()
stopAtMove ActorId
source
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Actor -> FactionId
bfid Actor
sb FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
/= Actor -> FactionId
bfid Actor
tb) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    ActorId -> m ()
forall (m :: * -> *). MonadClientUI m => ActorId -> m ()
lookAtMove ActorId
target  -- in case only this one is ours
    ActorId -> m ()
forall (m :: * -> *). MonadClientUI m => ActorId -> m ()
stopAtMove ActorId
target
  FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
  -- Ours involved, but definitely not requested by player via UI.
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (FactionId
side FactionId -> [FactionId] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Actor -> FactionId
bfid Actor
sb, Actor -> FactionId
bfid Actor
tb] Bool -> Bool -> Bool
&& Maybe ActorId
mleader Maybe ActorId -> Maybe ActorId -> Bool
forall a. Eq a => a -> a -> Bool
/= ActorId -> Maybe ActorId
forall a. a -> Maybe a
Just ActorId
source) m ()
forall (m :: * -> *). MonadClientUI m => m ()
stopPlayBack
  let ps :: (Point, Point)
ps = (Actor -> Point
bpos Actor
tb, Actor -> Point
bpos Actor
sb)
  LevelId -> Animation -> m ()
forall (m :: * -> *).
MonadClientUI m =>
LevelId -> Animation -> m ()
animate (Actor -> LevelId
blid Actor
sb) (Animation -> m ()) -> Animation -> m ()
forall a b. (a -> b) -> a -> b
$ (Point, Point) -> Animation
swapPlaces (Point, Point)
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 :: 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
  Actor
b <- (State -> Actor) -> m Actor
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
  Faction
fact <- (State -> Faction) -> m Faction
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (FactionDict -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
b) (FactionDict -> Faction)
-> (State -> FactionDict) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> FactionDict
sfactionD
  let underAI :: Bool
underAI = Faction -> Bool
isAIFact Faction
fact
  Maybe ActorId
mleader <- (StateClient -> Maybe ActorId) -> m (Maybe ActorId)
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Maybe ActorId
sleader
  ItemSlots EnumMap SLore SingleItemSlots
itemSlots <- (SessionUI -> ItemSlots) -> m ItemSlots
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> ItemSlots
sslots
  case ItemId -> [(ItemId, SlotChar)] -> Maybe SlotChar
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ItemId
iid ([(ItemId, SlotChar)] -> Maybe SlotChar)
-> [(ItemId, SlotChar)] -> Maybe SlotChar
forall a b. (a -> b) -> a -> b
$ ((SlotChar, ItemId) -> (ItemId, SlotChar))
-> [(SlotChar, ItemId)] -> [(ItemId, SlotChar)]
forall a b. (a -> b) -> [a] -> [b]
map (SlotChar, ItemId) -> (ItemId, SlotChar)
forall a b. (a, b) -> (b, a)
swap ([(SlotChar, ItemId)] -> [(ItemId, SlotChar)])
-> [(SlotChar, ItemId)] -> [(ItemId, SlotChar)]
forall a b. (a -> b) -> a -> b
$ SingleItemSlots -> [(SlotChar, ItemId)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs (SingleItemSlots -> [(SlotChar, ItemId)])
-> SingleItemSlots -> [(SlotChar, ItemId)]
forall a b. (a -> b) -> a -> b
$ EnumMap SLore SingleItemSlots
itemSlots EnumMap SLore SingleItemSlots -> SLore -> SingleItemSlots
forall k a. Enum k => EnumMap k a -> k -> a
EM.! SLore
SItem of
    Just SlotChar
_l ->
      -- So far organs can't be put into stash, so no need to call
      -- @updateItemSlot@ to add or reassign lore category.
      if CStore
cstore1 CStore -> CStore -> Bool
forall a. Eq a => a -> a -> Bool
== CStore
CGround Bool -> Bool -> Bool
&& ActorId -> Maybe ActorId
forall a. a -> Maybe a
Just ActorId
aid Maybe ActorId -> Maybe ActorId -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe ActorId
mleader Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
underAI then
        MsgClassShowAndSave
-> ActorId -> Part -> ItemId -> Either Int Int -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> ActorId -> Part -> ItemId -> Either Int Int -> m ()
itemAidVerbMU MsgClassShowAndSave
MsgActionMajor ActorId
aid Part
verb ItemId
iid (Int -> Either Int Int
forall a b. b -> Either a b
Right Int
k)
      else Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Actor -> Bool
bproj Actor
b) Bool -> Bool -> Bool
&& Actor -> Int64
bhp Actor
b Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$  -- don't announce death drops
        MsgClassShowAndSave
-> ActorId -> Part -> ItemId -> Either Int Int -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> ActorId -> Part -> ItemId -> Either Int Int -> m ()
itemAidVerbMU MsgClassShowAndSave
MsgActionMajor ActorId
aid Part
verb ItemId
iid (Int -> Either Int Int
forall a b. a -> Either a b
Left Int
k)
    Maybe SlotChar
Nothing -> [Char] -> m ()
forall a. (?callStack::CallStack) => [Char] -> a
error ([Char] -> m ()) -> [Char] -> m ()
forall a b. (a -> b) -> a -> b
$
      [Char]
"" [Char] -> (ItemId, Int, ActorId, CStore, CStore) -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` (ItemId
iid, Int
k, ActorId
aid, CStore
cstore1, CStore
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 :: Container -> ItemId -> m ()
discover Container
c ItemId
iid = do
  COps{ContentData ItemKind
coitem :: COps -> ContentData ItemKind
coitem :: ContentData ItemKind
coitem} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  CCUI{coscreen :: CCUI -> ScreenContent
coscreen=ScreenContent{Int
rwidth :: Int
rwidth :: ScreenContent -> Int
rwidth}} <- (SessionUI -> CCUI) -> m CCUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
  LevelId
lid <- (State -> LevelId) -> m LevelId
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> LevelId) -> m LevelId)
-> (State -> LevelId) -> m LevelId
forall a b. (a -> b) -> a -> b
$ Container -> State -> LevelId
lidFromC Container
c
  Time
globalTime <- (State -> Time) -> m Time
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> Time
stime
  Time
localTime <- (State -> Time) -> m Time
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 LevelId
lid
  ItemFull
itemFull <- (State -> ItemFull) -> m ItemFull
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
  ItemBag
bag <- (State -> ItemBag) -> m ItemBag
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemBag) -> m ItemBag)
-> (State -> ItemBag) -> m ItemBag
forall a b. (a -> b) -> a -> b
$ Container -> State -> ItemBag
getContainerBag Container
c
  FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
  FactionDict
factionD <- (State -> FactionDict) -> m FactionDict
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> FactionDict
sfactionD
  (Bool
noMsg, [Part]
nameWhere) <- case Container
c of
    CActor ActorId
aidOwner CStore
storeOwner -> do
      Actor
bOwner <- (State -> Actor) -> m Actor
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
      [Part]
name <- if Actor -> Bool
bproj Actor
bOwner
              then [Part] -> m [Part]
forall (m :: * -> *) a. Monad m => a -> m a
return []
              else (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
      let arItem :: AspectRecord
arItem = ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFull
          inMetaGame :: Bool
inMetaGame = Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.MetaGame AspectRecord
arItem
          isOurOrgan :: Bool
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
      (Bool, [Part]) -> m (Bool, [Part])
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
isOurOrgan, [Part]
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 (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 (m :: * -> *) a. Monad m => a -> m a
return (Bool
False, [])
  let kit :: ItemQuant
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 :: Text
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 :: Text
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
      (Part
object1, Part
object2) =
        Int
-> FactionId
-> FactionDict
-> Time
-> ItemFull
-> ItemQuant
-> (Part, Part)
partItemShortest Int
rwidth FactionId
side FactionDict
factionD Time
localTime ItemFull
itemFull ItemQuant
kit
      name1 :: Text
name1 = [Part] -> Text
makePhrase [Part
object1, Part
object2]
      -- Make sure the two names in the message differ.
      (Bool
ikObvious, ContentId ItemKind
itemKind) = case Item -> ItemIdentity
jkind (Item -> ItemIdentity) -> Item -> ItemIdentity
forall a b. (a -> b) -> a -> b
$ ItemFull -> Item
itemBase ItemFull
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 :: Text
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 :: Text
name = if Bool
ikObvious Bool -> Bool -> Bool
&& [Text] -> Text
T.unwords ([Text] -> [Text]
forall a. [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
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 :: Text
msg = [Part] -> Text
makeSentence
        [ Part
"the"
        , Part -> Part -> Part
MU.SubjectVerbSg Part
unknownName Part
"turn out to be"
        , Text -> Part
MU.Text Text
knownName ]
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool
noMsg Bool -> Bool -> Bool
|| Time
globalTime Time -> Time -> Bool
forall a. Eq a => a -> a -> Bool
== Time
timeZero) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$  -- no spam about initial equipment
    MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
MsgItemDiscovery Text
msg

ppHearMsg :: MonadClientUI m => Maybe Int -> HearMsg -> m Text
ppHearMsg :: Maybe Int -> HearMsg -> m Text
ppHearMsg Maybe Int
distance HearMsg
hearMsg = case HearMsg
hearMsg of
  HearUpd UpdAtomic
cmd -> do
    COps{TileSpeedup
coTileSpeedup :: COps -> TileSpeedup
coTileSpeedup :: TileSpeedup
coTileSpeedup} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
    let sound :: Part
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
_ -> [Char] -> Part
forall a. (?callStack::CallStack) => [Char] -> a
error ([Char] -> Part) -> [Char] -> Part
forall a b. (a -> b) -> a -> b
$ [Char]
"" [Char] -> UpdAtomic -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` UpdAtomic
cmd
        adjective :: Part
adjective = Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Text
ppHearDistanceAdjective Maybe Int
distance
        msg :: Text
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]]
    Text -> m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$! Text
msg
  HearStrike ContentId ItemKind
ik -> do
    COps{ContentData ItemKind
coitem :: ContentData ItemKind
coitem :: COps -> ContentData ItemKind
coitem} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
    let verb :: Text
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 :: Part
adverb = Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Text
ppHearDistanceAdverb Maybe Int
distance
        msg :: Text
msg = [Part] -> Text
makeSentence [ Part
"you", Part
adverb, Part
"hear something"
                           , Text -> Part
MU.Text Text
verb, Part
"someone" ]
    Text -> m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$! Text
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 (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 (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 (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"