{-# LANGUAGE TupleSections #-}
-- | Display atomic commands received by the client.
module Game.LambdaHack.Client.UI.DisplayAtomicM
  ( displayRespUpdAtomicUI, displayRespSfxAtomicUI
#ifdef EXPOSE_INTERNAL
    -- * Internal operations
  , ppHearMsg, ppHearDistanceAdjective, ppHearDistanceAdverb
  , updateItemSlot, markDisplayNeeded, lookAtMove
  , aidVerbMU, aidVerbDuplicateMU, itemVerbMUGeneral, itemVerbMU
  , itemVerbMUShort, itemAidVerbMU, mitemAidVerbMU, itemAidDistinctMU
  , manyItemsAidVerbMU
  , createActorUI, destroyActorUI, spotItemBag, moveActor, displaceActorUI
  , moveItemUI, quitFactionUI
  , displayGameOverLoot, displayGameOverAnalytics
  , discover, ppSfxMsg, strike
#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.EffectDescription
import           Game.LambdaHack.Client.UI.Frame
import           Game.LambdaHack.Client.UI.FrameM
import           Game.LambdaHack.Client.UI.HandleHelperM
import qualified Game.LambdaHack.Client.UI.HumanCmd as HumanCmd
import           Game.LambdaHack.Client.UI.ItemDescription
import           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.Common.Actor
import           Game.LambdaHack.Common.ActorState
import           Game.LambdaHack.Common.Analytics
import           Game.LambdaHack.Common.ClientOptions
import           Game.LambdaHack.Common.Faction
import           Game.LambdaHack.Common.Item
import qualified Game.LambdaHack.Common.ItemAspect as IA
import           Game.LambdaHack.Common.Kind
import           Game.LambdaHack.Common.Level
import           Game.LambdaHack.Common.Misc
import           Game.LambdaHack.Common.MonadStateRead
import           Game.LambdaHack.Common.Point
import           Game.LambdaHack.Common.ReqFailure
import           Game.LambdaHack.Common.State
import 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 qualified Game.LambdaHack.Core.Dice as Dice
import           Game.LambdaHack.Core.Frequency
import           Game.LambdaHack.Core.Random
import qualified Game.LambdaHack.Definition.Ability as Ability
import qualified Game.LambdaHack.Definition.Color as Color
import           Game.LambdaHack.Definition.Defs
import           Game.LambdaHack.Definition.Flavour

-- * RespUpdAtomicUI

-- | Visualize atomic updates sent to the client. This is done
-- in the global state after the command is executed and after
-- the client state is modified by the command.
-- Doesn't modify client state (except a few fields), but only client
-- session (e.g., by displaying messages). This is enforced by types.
displayRespUpdAtomicUI :: (MonadClient m, MonadClientUI m) => UpdAtomic -> m ()
{-# INLINE displayRespUpdAtomicUI #-}
displayRespUpdAtomicUI :: UpdAtomic -> m ()
displayRespUpdAtomicUI cmd :: UpdAtomic
cmd = case UpdAtomic
cmd of
  -- Create/destroy actors and items.
  UpdRegisterItems{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdCreateActor aid :: ActorId
aid body :: Actor
body _ -> Bool -> ActorId -> Actor -> m ()
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
Bool -> ActorId -> Actor -> m ()
createActorUI Bool
True ActorId
aid Actor
body
  UpdDestroyActor aid :: ActorId
aid body :: Actor
body _ -> Bool -> ActorId -> Actor -> m ()
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
Bool -> ActorId -> Actor -> m ()
destroyActorUI Bool
True ActorId
aid Actor
body
  UpdCreateItem verbose :: Bool
verbose iid :: ItemId
iid _ kit :: ItemQuant
kit@(kAdd :: Int
kAdd, _) c :: 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 aid :: ActorId
aid store :: 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
          _ | Actor -> Bool
bproj Actor
b ->
            MsgClassShowAndSave
-> ItemId -> ItemQuant -> Part -> Container -> m ()
forall (m :: * -> *) a.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> ItemId -> ItemQuant -> Part -> Container -> m ()
itemVerbMU MsgClassShowAndSave
MsgItemCreation ItemId
iid ItemQuant
kit "appear" Container
c
          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 (kTotal :: Int
kTotal, _) | 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 Int
forall a. Maybe a
Nothing
                     verbShow :: Part
verbShow = Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$
                       "become"
                       Text -> Text -> Text
<+> case ItemQuant
kit of
                         (1, _ : _) -> "somewhat"
                         (1, []) | Maybe Int -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Int
more -> ""
                         _ | Maybe Int -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Int
more -> "many-fold"
                         _ -> "additionally"
                     verbSave :: Part
verbSave = Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$
                       "become"
                       Text -> Text -> Text
<+> case ItemQuant
kit of
                         (1, t :: ItemTimer
t:_) ->  -- 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
                         (1, []) | Maybe Int -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Int
more -> ""
                         (k :: Int
k, _) ->  -- usually the list empty; ignore anyway
                           (if Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust Maybe Int
more then "additionally" else "")
                           Text -> Text -> Text
<+> Int -> Text
forall a. Show a => a -> Text
tshow Int
k Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "-fold"
                           Text -> Text -> Text
<+> case Maybe Int
more of
                                 Nothing -> ""
                                 Just kTotal :: Int
kTotal ->
                                   "(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
<> "-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 n :: Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 -> MsgClassDistinct
MsgStatusSleep
                       _ -> 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 :: * -> *).
(MonadClient 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.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
MsgTutorialHint "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.
(MonadClient m, 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
$ "grow" Part -> [Part] -> [Part]
forall a. a -> [a] -> [a]
: [Part]
wown) Container
c
          _ -> 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.
(MonadClient m, 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
$ "appear" Part -> [Part] -> [Part]
forall a. a -> [a] -> [a]
: [Part]
wown) Container
c
      CEmbed lid :: LevelId
lid _ -> LevelId -> m ()
forall (m :: * -> *). MonadClientUI m => LevelId -> m ()
markDisplayNeeded LevelId
lid
      CFloor lid :: LevelId
lid _ -> 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.
(MonadClient m, 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
$ "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 verbose :: Bool
verbose iid :: ItemId
iid _ kit :: ItemQuant
kit c :: Container
c ->
    if Bool
verbose then case Container
c of
      CActor aid :: ActorId
aid _  -> 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.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> ItemId -> ItemQuant -> Part -> Container -> m ()
itemVerbMUShort MsgClassShowAndSave
MsgItemRuination ItemId
iid ItemQuant
kit "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
$ "vanish from" Part -> [Part] -> [Part]
forall a. a -> [a] -> [a]
: [Part]
ownW
          MsgClassShowAndSave
-> ItemId -> ItemQuant -> Part -> Container -> m ()
forall (m :: * -> *) a.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> ItemId -> ItemQuant -> Part -> Container -> m ()
itemVerbMUShort MsgClassShowAndSave
MsgItemRuination ItemId
iid ItemQuant
kit Part
verb Container
c
      CEmbed lid :: LevelId
lid _ -> LevelId -> m ()
forall (m :: * -> *). MonadClientUI m => LevelId -> m ()
markDisplayNeeded LevelId
lid
      CFloor lid :: LevelId
lid _ -> 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.
(MonadClient m, 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
$ "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 aid :: ActorId
aid body :: Actor
body -> Bool -> ActorId -> Actor -> m ()
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
Bool -> ActorId -> Actor -> m ()
createActorUI Bool
False ActorId
aid Actor
body
  UpdLoseActor aid :: ActorId
aid body :: Actor
body -> Bool -> ActorId -> Actor -> m ()
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
Bool -> ActorId -> Actor -> m ()
destroyActorUI Bool
False ActorId
aid Actor
body
  UpdSpotItem verbose :: Bool
verbose iid :: ItemId
iid kit :: ItemQuant
kit c :: Container
c -> Bool -> Container -> ItemBag -> m ()
forall (m :: * -> *).
(MonadClient 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 True iid :: ItemId
iid kit :: ItemQuant
kit c :: Container
c@(CActor aid :: ActorId
aid _) -> 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
> 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
$ "be removed from" Part -> [Part] -> [Part]
forall a. a -> [a] -> [a]
: [Part]
ownW
      MsgClassShowAndSave
-> ItemId -> ItemQuant -> Part -> Container -> m ()
forall (m :: * -> *) a.
(MonadClient m, 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 verbose :: Bool
verbose c :: Container
c bag :: ItemBag
bag -> Bool -> Container -> ItemBag -> m ()
forall (m :: * -> *).
(MonadClient 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 aid :: ActorId
aid source :: Point
source target :: Point
target -> ActorId -> Point -> Point -> m ()
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
ActorId -> Point -> Point -> m ()
moveActor ActorId
aid Point
source Point
target
  UpdWaitActor aid :: ActorId
aid WSleep _ -> do
    MsgClassShowAndSave -> ActorId -> Part -> m ()
forall (m :: * -> *) a.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> ActorId -> Part -> m ()
aidVerbMU MsgClassShowAndSave
MsgStatusWakeup ActorId
aid "wake up"
    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.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
MsgTutorialHint "Woken up actors regain stats and skills, including sight radius and melee armor, over several turns. To avoid waking them 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 source :: ActorId
source target :: ActorId
target -> ActorId -> ActorId -> m ()
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
ActorId -> ActorId -> m ()
displaceActorUI ActorId
source ActorId
target
  UpdMoveItem iid :: ItemId
iid k :: Int
k aid :: ActorId
aid c1 :: CStore
c1 c2 :: CStore
c2 -> ItemId -> Int -> ActorId -> CStore -> CStore -> m ()
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
ItemId -> Int -> ActorId -> CStore -> CStore -> m ()
moveItemUI ItemId
iid Int
k ActorId
aid CStore
c1 CStore
c2
  -- Change actor attributes.
  UpdRefillHP _ 0 -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdRefillHP aid :: ActorId
aid hpDelta :: 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
== 0
                 then if Int64
hpDelta Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> 0 then "a little" else "a fraction of an HP"
                 else Int64 -> Text
forall a. Show a => a -> Text
tshow Int64
coarseDelta 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.
(MonadClient m, 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
> 0 then "heal" else "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
<= 0 Bool -> Bool -> Bool
&& Int64
hpDelta Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< 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 (firstFall :: Part
firstFall, hurtExtra :: 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
               (True, True) -> ("drop down", "tumble down")
               (True, False) -> ("fall down", "suffer woeful mutilation")
               (False, True) -> ("plummet", "crash")
               (False, False) -> ("collapse", "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
<= 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
== "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.
(MonadClient m, 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.
(MonadClient m, 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
<+> "Alas!"
              ColorMode -> Text -> m ()
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
ColorMode -> Text -> m ()
displayMore ColorMode
ColorBW ""
            | Bool
otherwise -> MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClient m, 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
> 0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
           MsgClassShowAndSave -> ActorId -> Part -> m ()
forall (m :: * -> *) a.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> ActorId -> Part -> m ()
aidVerbMU MsgClassShowAndSave
MsgActionWarning ActorId
aid "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.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
MsgSpecialEvent "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
< 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 (-3)) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
MsgTutorialHint "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.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> ActorId -> Part -> m ()
aidVerbMU MsgClassShowAndSave
MsgRiskOfDeath ActorId
aid
                           "be down to a dangerous health level"
  UpdRefillCalm _ 0 -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdRefillCalm aid :: ActorId
aid calmDelta :: 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
> 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.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
MsgNeutralEvent "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, aid2 :: 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
<= 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.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> ActorId -> Part -> m Bool
aidVerbDuplicateMU MsgClassShowAndSave
MsgHeardNearby ActorId
aid
                                              "hear something"
             Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
duplicated m ()
forall (m :: * -> *). (MonadClient 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
< 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.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> ActorId -> Part -> m ()
aidVerbMU MsgClassShowAndSave
MsgRiskOfDeath ActorId
aid
                      "have grown agitated and impressed enough to be in danger of defecting"
  UpdTrajectory _ _ mt :: 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 fid :: FactionId
fid _ toSt :: Maybe Status
toSt manalytics :: Maybe (FactionAnalytics, GenerationAnalytics)
manalytics -> FactionId
-> Maybe Status
-> Maybe (FactionAnalytics, GenerationAnalytics)
-> m ()
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
FactionId
-> Maybe Status
-> Maybe (FactionAnalytics, GenerationAnalytics)
-> m ()
quitFactionUI FactionId
fid Maybe Status
toSt Maybe (FactionAnalytics, GenerationAnalytics)
manalytics
  UpdSpotStashFaction verbose :: Bool
verbose fid :: FactionId
fid lid :: LevelId
lid pos :: 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.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgLnAdd MsgClassShowAndSave
MsgFactionIntel
                 "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.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
MsgFactionIntel (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
          [Part] -> Text
makeSentence [ "you have found the current"
                       , Part -> Part -> Part
MU.WownW Part
fidName "hoard location" ]
    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 verbose :: Bool
verbose fid :: FactionId
fid lid :: LevelId
lid pos :: 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.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
MsgFactionIntel
               "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.
(MonadClient m, 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, "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 fid :: FactionId
fid (Just source :: ActorId
source) mtgt :: Maybe ActorId
mtgt@(Just target :: 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 :: * -> *). (MonadClient 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 sb :: Actor
sb | Actor -> Int64
bhp Actor
sb Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= 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.
(MonadClient m, 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 "take command"
                         , "from", Part
object ]
        _ -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      ActorId -> m ()
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
ActorId -> m ()
lookAtMove ActorId
target
  UpdLeadFaction _ Nothing mtgt :: Maybe ActorId
mtgt@(Just target :: 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 :: * -> *).
(MonadClient m, MonadClientUI m) =>
ActorId -> m ()
lookAtMove ActorId
target
  UpdLeadFaction{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdDiplFaction fid1 :: FactionId
fid1 fid2 :: FactionId
fid2 _ toDipl :: 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 Unknown = "unknown to each other"
        showDipl Neutral = "in neutral diplomatic relations"
        showDipl Alliance = "allied"
        showDipl War = "at war"
    MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClient m, 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
<+> "and" Text -> Text -> Text
<+> Text
name2 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
<> "."
  UpdDoctrineFaction{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdAutoFaction fid :: FactionId
fid b :: 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 ()
forall (m :: * -> *). MonadClientUI m => m ()
addPressedControlEsc  -- sets @swasAutomated@, enters main menu
      Bool -> m ()
forall (m :: * -> *). MonadClientUI m => Bool -> m ()
setFrontAutoYes Bool
b  -- now can stop auto-accepting prompts
  UpdRecordKill{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  -- Alter map.
  UpdAlterTile lid :: LevelId
lid p :: Point
p fromTile :: ContentId TileKind
fromTile toTile :: 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 feat :: Feature
feat =
          case Feature
feat of
            TK.OpenTo tgroup :: GroupName TileKind
tgroup -> GroupName TileKind -> Maybe (GroupName TileKind)
forall a. a -> Maybe a
Just GroupName TileKind
tgroup
            TK.CloseTo tgroup :: GroupName TileKind
tgroup -> GroupName TileKind -> Maybe (GroupName TileKind)
forall a. a -> Maybe a
Just GroupName TileKind
tgroup
            TK.ChangeTo tgroup :: GroupName TileKind
tgroup -> GroupName TileKind -> Maybe (GroupName TileKind)
forall a. a -> Maybe a
Just GroupName TileKind
tgroup
            TK.OpenWith _ _ tgroup :: GroupName TileKind
tgroup -> GroupName TileKind -> Maybe (GroupName TileKind)
forall a. a -> Maybe a
Just GroupName TileKind
tgroup
            TK.CloseWith _ _ tgroup :: GroupName TileKind
tgroup -> GroupName TileKind -> Maybe (GroupName TileKind)
forall a. a -> Maybe a
Just GroupName TileKind
tgroup
            TK.ChangeWith _ _ tgroup :: GroupName TileKind
tgroup -> GroupName TileKind -> Maybe (GroupName TileKind)
forall a. a -> Maybe a
Just GroupName TileKind
tgroup
            _ -> 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 (\(_, q :: Int
q) -> Int
q Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 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 = ""  -- a hack, because we don't handle adverbs well
          verb :: Part
verb = "turn into"
          msg :: Text
msg = [Part] -> Text
makeSentence ([Part] -> Text) -> [Part] -> Text
forall a b. (a -> b) -> a -> b
$
            [ "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
            , "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]
++ ["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.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd (if Bool
unexpected then MsgClassShowAndSave
MsgSpecialEvent else MsgClassShowAndSave
MsgNeutralEvent) Text
msg
  UpdAlterExplorable lid :: LevelId
lid _ -> 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 aid :: ActorId
aid _p :: Point
_p toTile :: 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 "reveal"
                           , "that the"
                           , Part -> Part -> Part
MU.SubjectVerbSg Part
subject2 "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.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
MsgTerrainReveal Text
msg
      MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
MsgTutorialHint "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
== 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
$ \sess :: SessionUI
sess -> SessionUI
sess {sturnDisplayed :: Bool
sturnDisplayed = Bool
False}
  UpdUnAgeGame{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdDiscover c :: Container
c iid :: ItemId
iid _ _ -> Container -> ItemId -> m ()
forall (m :: * -> *).
(MonadClient 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 "server command leaked to client"
  UpdCoverServer{} -> [Char] -> m ()
forall a. (?callStack::CallStack) => [Char] -> a
error "server command leaked to client"
  UpdPerception{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdRestart fid :: FactionId
fid _ _ _ _ srandom :: 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@UIOptions{Bool
uHistory1PerLine :: UIOptions -> Bool
uHistory1PerLine :: Bool
uHistory1PerLine} = SessionUI -> UIOptions
sUIOptions SessionUI
oldSess
        f :: [a] -> p -> a -> p -> [a]
f ![a]
acc _p :: p
_p !a
i _a :: 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 [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 (_, mode :: 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
          Nothing -> 0
          Just cm :: Map Challenge Int
cm -> Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe 0 (Challenge -> Map Challenge Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Challenge
snxtChal Map Challenge Int
cm)
        (snxtScenario :: Int
snxtScenario, _) = ((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
        , 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
== 0) m ()
forall (m :: * -> *). MonadClientUI m => m ()
resetSessionStart
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> History -> Int
lengthHistory Bool
uHistory1PerLine (SessionUI -> History
shistory SessionUI
oldSess) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 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.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
MsgBookKeeping (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ "Welcome to" Text -> Text -> Text
<+> Text
title Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "!"
      -- Generate initial history. Only for UI clients.
      History
shistory <- m History
forall (m :: * -> *). (MonadClient 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
$ \sess :: 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
          [(_, 1, _)] -> Bool
True
          _ -> Bool
False
    MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
MsgBookKeeping "-------------------------------------------------"
    m ()
forall (m :: * -> *). MonadClientUI m => m ()
recordHistory
    MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
MsgActionWarning
           ("New game started in" Text -> Text -> Text
<+> ModeKind -> Text
mname ModeKind
gameMode Text -> Text -> Text
<+> "mode.")
    MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClient m, 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.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgLnAdd MsgClassShowAndSave
MsgBackdropFocus "You take in your surroundings."
      MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClient m, 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
      [ "You think you saw movement."
      , "Something catches your peripherial vision."
      , "You think you felt a tremor under your feet."
      , "A whiff of chilly air passes around you."
      , "You notice a draft just when it dies down."
      , "The ground nearby is stained along some faint lines."
      , "Scarce black motes slowly settle on the ground."
      , "The ground in the immediate area is empty, as if just swiped."
      ]
    MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClient m, 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.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
MsgActionWarning "Being a lone wolf, you begin without companions."
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> History -> Int
lengthHistory Bool
uHistory1PerLine (SessionUI -> History
shistory SessionUI
oldSess) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 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 :: * -> *).
(MonadClient m, MonadClientUI m) =>
ColorMode -> Text -> m ()
displayMore ColorMode
ColorFull "\nAre you up for the challenge?"
    MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgPromptGeneric
           "A grand story starts right here! (Press '?' for context and help.)"
  UpdRestartServer{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdResume fid :: FactionId
fid _ -> 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.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgActionAlert (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ "Continuing" Text -> Text -> Text
<+> ModeKind -> Text
mname ModeKind
gameMode Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "."
      MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClient m, 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.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgLnAdd MsgClassShow
MsgPromptFocus "You remember your surroundings."
        MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgPromptGeneric Text
desc
      ColorMode -> Text -> m ()
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
ColorMode -> Text -> m ()
displayMore ColorMode
ColorFull "\nAre you up for the challenge?"
      MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgPromptGeneric
             "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 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 :: * -> *).
(MonadClient m, MonadClientUI m) =>
ColorMode -> Text -> m ()
displayMore ColorMode
ColorBW "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
$ "Client" Text -> Text -> Text
<+> FactionId -> Text
forall a. Show a => a -> Text
tshow FactionId
side 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
$ "Client" Text -> Text -> Text
<+> FactionId -> Text
forall a. Show a => a -> Text
tshow FactionId
side Text -> Text -> Text
<+> "closed frontend."
  UpdWriteSave -> MsgClassSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassSave
MsgInnerWorkSpam "Saving backup."
  UpdHearFid _ distance :: Maybe Int
distance hearMsg :: 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 display stuff when leader moves
      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
          Nothing -> MsgClassShowAndSave
MsgHeardOutside
          Just 0 -> MsgClassShowAndSave
MsgHeardNearby
          Just _ -> MsgClassShowAndSave
MsgHeardFaraway
    MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
msgClass Text
msg
    case HearMsg
hearMsg of
      HearUpd UpdDestroyActor{} ->
        MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
MsgTutorialHint "Events out of your sight radius (as listed in the '#' skill menu) can sometimes be heard, depending on your hearing radius. Some, such as death shrieks, can always be heard regardless of skill and distance, including when they come from a different floor."
      HearTaunt{} ->
        MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
MsgTutorialHint "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."
      _ -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

updateItemSlot :: MonadClientUI m => Container -> ItemId -> m ()
updateItemSlot :: Container -> ItemId -> m ()
updateItemSlot c :: Container
c iid :: 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 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
    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
$ \sess :: SessionUI
sess -> SessionUI
sess {sslots :: ItemSlots
sslots = ItemSlots
newSlots}
    Just _l :: SlotChar
_l -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()  -- slot already assigned

markDisplayNeeded :: MonadClientUI m => LevelId -> m ()
markDisplayNeeded :: LevelId -> m ()
markDisplayNeeded lid :: LevelId
lid = do
  LevelId
lidV <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
viewedLevelUI
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (LevelId
lidV LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== LevelId
lid) (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
$ \sess :: SessionUI
sess -> SessionUI
sess {sdisplayNeeded :: Bool
sdisplayNeeded = Bool
True}

lookAtMove :: (MonadClient m, MonadClientUI m) => ActorId -> m ()
lookAtMove :: ActorId -> m ()
lookAtMove aid :: ActorId
aid = 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
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
  FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
  Maybe AimMode
aimMode <- (SessionUI -> Maybe AimMode) -> m (Maybe AimMode)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe AimMode
saimMode
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Actor -> Bool
bproj Actor
body)
        Bool -> Bool -> Bool
&& Actor -> FactionId
bfid Actor
body FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side
        Bool -> Bool -> Bool
&& Maybe AimMode -> Bool
forall a. Maybe a -> Bool
isNothing Maybe AimMode
aimMode) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do  -- aiming does a more extensive look
    Text
stashBlurb <- LevelId -> Point -> m Text
forall (m :: * -> *). MonadClientUI m => LevelId -> Point -> m Text
lookAtStash (Actor -> LevelId
blid Actor
body) (Actor -> Point
bpos Actor
body)
    (itemsBlurb :: Text
itemsBlurb, _) <- Bool
-> Point -> ActorId -> Maybe (Part, Bool) -> m (Text, Maybe Person)
forall (m :: * -> *).
MonadClientUI m =>
Bool
-> Point -> ActorId -> Maybe (Part, Bool) -> m (Text, Maybe Person)
lookAtItems Bool
True (Actor -> Point
bpos Actor
body) ActorId
aid Maybe (Part, Bool)
forall a. Maybe a
Nothing
    let msgClass :: MsgClassShowAndSave
msgClass = 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
                   then MsgClassShowAndSave
MsgAtFeetMajor
                   else MsgClassShowAndSave
MsgAtFeetMinor
        blurb :: Text
blurb = Text
stashBlurb Text -> Text -> Text
<+> Text
itemsBlurb
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> Bool
T.null Text
blurb) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
      MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
msgClass Text
blurb
  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
body) (FactionDict -> Faction)
-> (State -> FactionDict) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> FactionDict
sfactionD
  [(ActorId, Actor)]
adjBigAssocs <- (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
$ Actor -> State -> [(ActorId, Actor)]
adjacentBigAssocs Actor
body
  [(ActorId, Actor)]
adjProjAssocs <- (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
$ Actor -> State -> [(ActorId, Actor)]
adjacentProjAssocs Actor
body
  if Bool -> Bool
not (Actor -> Bool
bproj Actor
body) Bool -> Bool -> Bool
&& Actor -> FactionId
bfid Actor
body FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side then do
    let foe :: (ActorId, Actor) -> Bool
foe (_, b2 :: Actor
b2) = FactionId -> Faction -> FactionId -> Bool
isFoe (Actor -> FactionId
bfid Actor
body) Faction
fact (Actor -> FactionId
bfid Actor
b2)
        adjFoes :: [(ActorId, Actor)]
adjFoes = ((ActorId, Actor) -> Bool)
-> [(ActorId, Actor)] -> [(ActorId, Actor)]
forall a. (a -> Bool) -> [a] -> [a]
filter (ActorId, Actor) -> Bool
foe ([(ActorId, Actor)] -> [(ActorId, Actor)])
-> [(ActorId, Actor)] -> [(ActorId, Actor)]
forall a b. (a -> b) -> a -> b
$ [(ActorId, Actor)]
adjBigAssocs [(ActorId, Actor)] -> [(ActorId, Actor)] -> [(ActorId, Actor)]
forall a. [a] -> [a] -> [a]
++ [(ActorId, Actor)]
adjProjAssocs
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([(ActorId, Actor)] -> Bool
forall a. [a] -> Bool
null [(ActorId, Actor)]
adjFoes) m ()
forall (m :: * -> *). (MonadClient m, MonadClientUI m) => m ()
stopPlayBack
  else Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (FactionId -> Faction -> FactionId -> Bool
isFoe (Actor -> FactionId
bfid Actor
body) Faction
fact FactionId
side) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    let our :: (ActorId, Actor) -> Bool
our (_, b2 :: Actor
b2) = Actor -> FactionId
bfid Actor
b2 FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side
        adjOur :: [(ActorId, Actor)]
adjOur = ((ActorId, Actor) -> Bool)
-> [(ActorId, Actor)] -> [(ActorId, Actor)]
forall a. (a -> Bool) -> [a] -> [a]
filter (ActorId, Actor) -> Bool
our [(ActorId, Actor)]
adjBigAssocs
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([(ActorId, Actor)] -> Bool
forall a. [a] -> Bool
null [(ActorId, Actor)]
adjOur) m ()
forall (m :: * -> *). (MonadClient m, MonadClientUI m) => m ()
stopPlayBack

aidVerbMU :: (MonadClient m, MonadClientUI m, MsgShared a)
          => a -> ActorId -> MU.Part -> m ()
aidVerbMU :: a -> ActorId -> Part -> m ()
aidVerbMU msgClass :: a
msgClass aid :: ActorId
aid verb :: Part
verb = do
  Part
subject <- ActorId -> m Part
forall (m :: * -> *). MonadClientUI m => ActorId -> m Part
partActorLeader ActorId
aid
  a -> Text -> m ()
forall (m :: * -> *) a.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd a
msgClass (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ [Part] -> Text
makeSentence [Part -> Part -> Part
MU.SubjectVerbSg Part
subject Part
verb]

aidVerbDuplicateMU :: (MonadClient m, MonadClientUI m, MsgShared a)
                   => a -> ActorId -> MU.Part -> m Bool
aidVerbDuplicateMU :: a -> ActorId -> Part -> m Bool
aidVerbDuplicateMU msgClass :: a
msgClass aid :: ActorId
aid verb :: Part
verb = do
  Part
subject <- ActorId -> m Part
forall (m :: * -> *). MonadClientUI m => ActorId -> m Part
partActorLeader ActorId
aid
  a -> Text -> m Bool
forall (m :: * -> *) a.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m Bool
msgAddDuplicate a
msgClass ([Part] -> Text
makeSentence [Part -> Part -> Part
MU.SubjectVerbSg Part
subject Part
verb])

itemVerbMUGeneral :: MonadClientUI m
                  => Bool -> ItemId -> ItemQuant -> MU.Part -> Container
                  -> m Text
itemVerbMUGeneral :: Bool -> ItemId -> ItemQuant -> Part -> Container -> m Text
itemVerbMUGeneral verbose :: Bool
verbose iid :: ItemId
iid kit :: ItemQuant
kit@(k :: Int
k, _) verb :: Part
verb c :: Container
c = Bool -> m Text -> m Text
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0) (m Text -> m Text) -> m Text -> m Text
forall a b. (a -> b) -> a -> b
$ 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
  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
  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
  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 arItem :: AspectRecord
arItem = ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFull
      partItemWsChosen :: Int
-> FactionId
-> FactionDict
-> Int
-> Time
-> ItemFull
-> ItemQuant
-> Part
partItemWsChosen | Bool
verbose = Int
-> FactionId
-> FactionDict
-> Int
-> Time
-> ItemFull
-> ItemQuant
-> Part
partItemWs
                       | Bool
otherwise = Int
-> FactionId
-> FactionDict
-> Int
-> Time
-> ItemFull
-> ItemQuant
-> Part
partItemWsShort
      subject :: Part
subject = Int
-> FactionId
-> FactionDict
-> Int
-> Time
-> ItemFull
-> ItemQuant
-> Part
partItemWsChosen Int
rwidth FactionId
side FactionDict
factionD Int
k Time
localTime ItemFull
itemFull ItemQuant
kit
      msg :: Text
msg | Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1 Bool -> Bool -> Bool
&& Bool -> Bool
not (Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Condition AspectRecord
arItem) =
              [Part] -> Text
makeSentence [Person -> Polarity -> Part -> Part -> Part
MU.SubjectVerb Person
MU.PlEtc Polarity
MU.Yes Part
subject Part
verb]
          | Bool
otherwise = [Part] -> Text
makeSentence [Part -> Part -> Part
MU.SubjectVerbSg Part
subject Part
verb]
  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

itemVerbMU :: (MonadClient m, MonadClientUI m, MsgShared a)
           => a -> ItemId -> ItemQuant -> MU.Part -> Container -> m ()
itemVerbMU :: a -> ItemId -> ItemQuant -> Part -> Container -> m ()
itemVerbMU msgClass :: a
msgClass iid :: ItemId
iid kit :: ItemQuant
kit verb :: Part
verb c :: Container
c = do
  Text
msg <- Bool -> ItemId -> ItemQuant -> Part -> Container -> m Text
forall (m :: * -> *).
MonadClientUI m =>
Bool -> ItemId -> ItemQuant -> Part -> Container -> m Text
itemVerbMUGeneral Bool
True ItemId
iid ItemQuant
kit Part
verb Container
c
  a -> Text -> m ()
forall (m :: * -> *) a.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd a
msgClass Text
msg

itemVerbMUShort :: (MonadClient m, MonadClientUI m, MsgShared a)
                => a -> ItemId -> ItemQuant -> MU.Part -> Container
                -> m ()
itemVerbMUShort :: a -> ItemId -> ItemQuant -> Part -> Container -> m ()
itemVerbMUShort msgClass :: a
msgClass iid :: ItemId
iid kit :: ItemQuant
kit verb :: Part
verb c :: Container
c = do
  Text
msg <- Bool -> ItemId -> ItemQuant -> Part -> Container -> m Text
forall (m :: * -> *).
MonadClientUI m =>
Bool -> ItemId -> ItemQuant -> Part -> Container -> m Text
itemVerbMUGeneral Bool
False ItemId
iid ItemQuant
kit Part
verb Container
c
  a -> Text -> m ()
forall (m :: * -> *) a.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd a
msgClass Text
msg

itemAidVerbMU :: (MonadClient m, MonadClientUI m, MsgShared a)
              => a -> ActorId -> MU.Part -> ItemId -> Either Int Int
              -> m ()
itemAidVerbMU :: a -> ActorId -> Part -> ItemId -> Either Int Int -> m ()
itemAidVerbMU msgClass :: a
msgClass aid :: ActorId
aid verb :: Part
verb iid :: ItemId
iid ek :: Either Int Int
ek = do
  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
  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
  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 lid :: LevelId
lid = Actor -> LevelId
blid Actor
body
      fakeKit :: ItemQuant
fakeKit = ItemQuant
quantSingle
  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
  Part
subject <- ActorId -> m Part
forall (m :: * -> *). MonadClientUI m => ActorId -> m Part
partActorLeader ActorId
aid
  -- The item may no longer be in @c@, but it was.
  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 object :: Part
object = case Either Int Int
ek of
        Left n :: Int
n ->
          Int
-> FactionId
-> FactionDict
-> Int
-> Time
-> ItemFull
-> ItemQuant
-> Part
partItemWs Int
rwidth FactionId
side FactionDict
factionD Int
n Time
localTime ItemFull
itemFull ItemQuant
fakeKit
        Right n :: Int
n ->
          let (name1 :: Part
name1, powers :: Part
powers) =
                Int
-> FactionId
-> FactionDict
-> Time
-> ItemFull
-> ItemQuant
-> (Part, Part)
partItemShort Int
rwidth FactionId
side FactionDict
factionD Time
localTime ItemFull
itemFull ItemQuant
fakeKit
          in [Part] -> Part
MU.Phrase ["the", Int -> Part -> Part
MU.Car1Ws Int
n Part
name1, Part
powers]
      msg :: Text
msg = [Part] -> Text
makeSentence [Part -> Part -> Part
MU.SubjectVerbSg Part
subject Part
verb, Part
object]
  a -> Text -> m ()
forall (m :: * -> *) a.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd a
msgClass Text
msg

mitemAidVerbMU :: (MonadClient m, MonadClientUI m, MsgShared a)
               => a -> ActorId -> MU.Part -> ItemId -> Maybe MU.Part
               -> m ()
mitemAidVerbMU :: a -> ActorId -> Part -> ItemId -> Maybe Part -> m ()
mitemAidVerbMU msgClass :: a
msgClass aid :: ActorId
aid verb :: Part
verb iid :: ItemId
iid msuffix :: Maybe Part
msuffix = do
  ItemDict
itemD <- (State -> ItemDict) -> m ItemDict
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> ItemDict
sitemD
  case Maybe Part
msuffix of
    Just suffix :: Part
suffix | ItemId
iid ItemId -> ItemDict -> Bool
forall k a. Enum k => k -> EnumMap k a -> Bool
`EM.member` ItemDict
itemD ->
      a -> ActorId -> Part -> ItemId -> Either Int Int -> m ()
forall (m :: * -> *) a.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> ActorId -> Part -> ItemId -> Either Int Int -> m ()
itemAidVerbMU a
msgClass ActorId
aid ([Part] -> Part
MU.Phrase [Part
verb, Part
suffix]) ItemId
iid (Int -> Either Int Int
forall a b. b -> Either a b
Right 1)
    _ -> do
#ifdef WITH_EXPENSIVE_ASSERTIONS
      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
      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
      -- It's not actually expensive, but it's particularly likely
      -- to fail with wild content, indicating server game rules logic
      -- needs to be fixed/extended.
      -- Observer from another faction may receive the effect information
      -- from the server, because the affected actor is visible,
      -- but the position of the item may be out of FOV. This is fine;
      -- the message is then shorter, because only the effect was seen,
      -- while the cause remains misterious.
      Bool -> m () -> m ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Maybe Part -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Part
msuffix  -- item description not requested
              Bool -> Bool -> Bool
|| Actor -> FactionId
bfid Actor
b FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
/= FactionId
side  -- not from affected faction; only observing
              Bool
-> ([Char], (ActorId, Actor, ActorUI, Part, ItemId, Maybe Part))
-> Bool
forall a. Show a => Bool -> a -> Bool
`blame` "item never seen by the affected actor"
              [Char]
-> (ActorId, Actor, ActorUI, Part, ItemId, Maybe Part)
-> ([Char], (ActorId, Actor, ActorUI, Part, ItemId, Maybe Part))
forall v. [Char] -> v -> ([Char], v)
`swith` (ActorId
aid, Actor
b, ActorUI
bUI, Part
verb, ItemId
iid, Maybe Part
msuffix)) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
#endif
        a -> ActorId -> Part -> m ()
forall (m :: * -> *) a.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> ActorId -> Part -> m ()
aidVerbMU a
msgClass ActorId
aid Part
verb

itemAidDistinctMU :: (MonadClient m, MonadClientUI m)
                  => MsgClassDistinct -> ActorId -> MU.Part -> MU.Part -> ItemId
                  -> m ()
itemAidDistinctMU :: MsgClassDistinct -> ActorId -> Part -> Part -> ItemId -> m ()
itemAidDistinctMU msgClass :: MsgClassDistinct
msgClass aid :: ActorId
aid verbShow :: Part
verbShow verbSave :: Part
verbSave iid :: ItemId
iid = do
  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
  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
  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 lid :: LevelId
lid = Actor -> LevelId
blid Actor
body
      fakeKit :: ItemQuant
fakeKit = ItemQuant
quantSingle
  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
  Part
subject <- ActorId -> m Part
forall (m :: * -> *). MonadClientUI m => ActorId -> m Part
partActorLeader ActorId
aid
  -- The item may no longer be in @c@, but it was.
  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 object :: Part
object = let (name :: Part
name, powers :: Part
powers) =
                     Int
-> FactionId
-> FactionDict
-> Time
-> ItemFull
-> ItemQuant
-> (Part, Part)
partItem Int
rwidth FactionId
side FactionDict
factionD Time
localTime ItemFull
itemFull ItemQuant
fakeKit
               in [Part] -> Part
MU.Phrase [Part
name, Part
powers]
      t1 :: Text
t1 = [Part] -> Text
makeSentence [Part -> Part -> Part
MU.SubjectVerbSg Part
subject Part
verbShow, Part
object]
      t2 :: Text
t2 = [Part] -> Text
makeSentence [Part -> Part -> Part
MU.SubjectVerbSg Part
subject Part
verbSave, Part
object]
      dotsIfShorter :: Text
dotsIfShorter = if Text
t1 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
t2 then "" else ".."
  MsgClassDistinct -> (Text, Text) -> m ()
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
MsgClassDistinct -> (Text, Text) -> m ()
msgAddDistinct MsgClassDistinct
msgClass (Text
t1 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
dotsIfShorter, Text
t2)

manyItemsAidVerbMU :: (MonadClient m, MonadClientUI m, MsgShared a)
                   => a -> ActorId -> MU.Part
                   -> [(ItemId, ItemQuant)] -> (Int -> Either (Maybe Int) Int)
                   -> m ()
manyItemsAidVerbMU :: a
-> ActorId
-> Part
-> [(ItemId, ItemQuant)]
-> (Int -> Either (Maybe Int) Int)
-> m ()
manyItemsAidVerbMU msgClass :: a
msgClass aid :: ActorId
aid verb :: Part
verb sortedAssocs :: [(ItemId, ItemQuant)]
sortedAssocs ekf :: Int -> Either (Maybe Int) Int
ekf = do
  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
  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
  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 lid :: LevelId
lid = Actor -> LevelId
blid Actor
body
      fakeKit :: ItemQuant
fakeKit = ItemQuant
quantSingle
  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
  Part
subject <- ActorId -> m Part
forall (m :: * -> *). MonadClientUI m => ActorId -> m Part
partActorLeader ActorId
aid
  -- The item may no longer be in @c@, but it was.
  ItemId -> ItemFull
itemToF <- (State -> ItemId -> ItemFull) -> m (ItemId -> ItemFull)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemId -> ItemFull) -> m (ItemId -> ItemFull))
-> (State -> ItemId -> ItemFull) -> m (ItemId -> ItemFull)
forall a b. (a -> b) -> a -> b
$ (ItemId -> State -> ItemFull) -> State -> ItemId -> ItemFull
forall a b c. (a -> b -> c) -> b -> a -> c
flip ItemId -> State -> ItemFull
itemToFull
  let object :: (ItemId, ItemQuant) -> Part
object (iid :: ItemId
iid, (k :: Int
k, _)) =
        let itemFull :: ItemFull
itemFull = ItemId -> ItemFull
itemToF ItemId
iid
        in case Int -> Either (Maybe Int) Int
ekf Int
k of
          Left (Just n :: Int
n) ->
            Int
-> FactionId
-> FactionDict
-> Int
-> Time
-> ItemFull
-> ItemQuant
-> Part
partItemWs Int
rwidth FactionId
side FactionDict
factionD Int
n Time
localTime ItemFull
itemFull ItemQuant
fakeKit
          Left Nothing ->
            let (name :: Part
name, powers :: Part
powers) =
                  Int
-> FactionId
-> FactionDict
-> Time
-> ItemFull
-> ItemQuant
-> (Part, Part)
partItem Int
rwidth FactionId
side FactionDict
factionD Time
localTime ItemFull
itemFull ItemQuant
fakeKit
            in [Part] -> Part
MU.Phrase [Part
name, Part
powers]
          Right n :: Int
n ->
            let (name1 :: Part
name1, powers :: Part
powers) =
                  Int
-> FactionId
-> FactionDict
-> Time
-> ItemFull
-> ItemQuant
-> (Part, Part)
partItemShort Int
rwidth FactionId
side FactionDict
factionD Time
localTime ItemFull
itemFull ItemQuant
fakeKit
            in [Part] -> Part
MU.Phrase ["the", Int -> Part -> Part
MU.Car1Ws Int
n Part
name1, Part
powers]
      msg :: Text
msg = [Part] -> Text
makeSentence [ Part -> Part -> Part
MU.SubjectVerbSg Part
subject Part
verb
                         , [Part] -> Part
MU.WWandW ([Part] -> Part) -> [Part] -> Part
forall a b. (a -> b) -> a -> b
$ ((ItemId, ItemQuant) -> Part) -> [(ItemId, ItemQuant)] -> [Part]
forall a b. (a -> b) -> [a] -> [b]
map (ItemId, ItemQuant) -> Part
object [(ItemId, ItemQuant)]
sortedAssocs]
  a -> Text -> m ()
forall (m :: * -> *) a.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd a
msgClass Text
msg

createActorUI :: (MonadClient m, MonadClientUI m)
              => Bool -> ActorId -> Actor -> m ()
createActorUI :: Bool -> ActorId -> Actor -> m ()
createActorUI born :: Bool
born aid :: ActorId
aid body :: Actor
body = do
  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
  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 Bool -> Bool -> Bool
&& Bool -> Bool
not (Actor -> Bool
bproj Actor
body)) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ 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
$ \sess :: 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}
  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
== '@'
                      Bool -> Bool -> Bool
&& Player -> Bool
fhasGender (Faction -> Player
gplayer Faction
fact) = "he"
                    | Bool
otherwise = "it"
        nameFromNumber :: Text -> a -> Text
nameFromNumber fn :: Text
fn k :: a
k = if a
k a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== 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, "Captain"]
                              else Text
fn Text -> Text -> Text
<+> a -> Text
forall a. Show a => a -> Text
tshow a
k
        heroNamePronoun :: Int -> (Text, Text)
heroNamePronoun k :: 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, "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, "he")
               (Maybe (Text, Text) -> (Text, Text))
-> Maybe (Text, Text) -> (Text, Text)
forall a b. (a -> b) -> a -> b
$ Int -> [(Int, (Text, Text))] -> Maybe (Text, Text)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Int
k [(Int, (Text, Text))]
uHeroNames
        (n :: Int
n, bsymbol :: Char
bsymbol) =
          if | Actor -> Bool
bproj Actor
body -> (0, if Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Blast AspectRecord
arItem
                                 then ItemKind -> Char
IK.isymbol ItemKind
itemKind
                                 else '*')
             | Color
baseColor Color -> Color -> Bool
forall a. Eq a => a -> a -> Bool
/= Color
Color.BrWhite -> (0, ItemKind -> Char
IK.isymbol ItemKind
itemKind)
             | Bool
otherwise -> case Actor -> Maybe Int
bnumber Actor
body of
                 Nothing ->
                   [Char] -> (Int, Char)
forall a. (?callStack::CallStack) => [Char] -> a
error ([Char] -> (Int, Char)) -> [Char] -> (Int, Char)
forall a b. (a -> b) -> a -> b
$ "numbered actor without server-assigned number"
                           [Char] -> (ActorId, Actor) -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` (ActorId
aid, Actor
body)
                 Just bn :: Int
bn -> (Int
bn, if 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
< 10
                                 then Int -> Char
Char.intToDigit Int
bn
                                 else '@')
        (object1 :: Part
object1, object2 :: 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
        (bname :: Text
bname, bpronoun :: Text
bpronoun) =
          if | Actor -> Bool
bproj Actor
body ->
               let adj :: Part
adj = case Actor -> Maybe ([Vector], Speed)
btrajectory Actor
body of
                     Just (tra :: [Vector]
tra, _) | [Vector] -> Int
forall a. [a] -> Int
length [Vector]
tra Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 5 -> "falling"
                     _ -> "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 = $WActorUI :: Char -> Text -> Text -> Color -> ActorUI
ActorUI{..}
    (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: 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}
  let (verb :: Part
verb, joinYou :: Bool
joinYou) =
        if Bool
born
        then if Actor -> FactionId
bfid Actor
body FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side
             then ("join you", Bool
True)
             else ("appear suddenly", Bool
False)
        else ("be spotted", Bool
False)
  ((ItemId, CStore) -> m ()) -> [(ItemId, CStore)] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
mapM_ (\(iid :: ItemId
iid, store :: 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))
  -- 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
  Bool
firstEnemy <-
    if Actor -> FactionId
bfid Actor
body FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
/= FactionId
side then do
      Bool
firstE <-
        if Bool -> Bool
not (Actor -> Bool
bproj Actor
body) Bool -> Bool -> Bool
&& 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 _) -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()  -- explicitly set; keep it
            _ -> (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: 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 ActorId -> EnumSet ActorId -> Bool
forall k. Enum k => k -> EnumSet k -> Bool
ES.member ActorId
aid EnumSet ActorId
lastLost
          then Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
          else if [Actor] -> Int
forall a. [a] -> Int
length [Actor]
foes Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1
               then do
                 Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
itemsSize Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
                   MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgSpottedThreat "Another armed threat!"
                 Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
               else do
                 if Int
itemsSize Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0
                 then MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgSpottedThreat "Armed intrusion ahead!"
                 else MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgSpottedThreat "You are not alone!"
                 Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
        else Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
      m ()
forall (m :: * -> *). (MonadClient m, MonadClientUI m) => m ()
stopPlayBack
      Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
firstE
    else Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
  if | ActorDictUI -> Bool
forall k a. EnumMap k a -> Bool
EM.null ActorDictUI
actorUI Bool -> Bool -> Bool
&& Actor -> FactionId
bfid Actor
body FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side ->
       () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()  -- don't speak about yourself in 3rd person
     | Bool
born Bool -> Bool -> Bool
&& Actor -> Bool
bproj Actor
body ->
         Bool -> m ()
forall (m :: * -> *). MonadClientUI m => Bool -> m ()
pushFrame Bool
False  -- make sure first position displayed
     | ActorId -> EnumSet ActorId -> Bool
forall k. Enum k => k -> EnumSet k -> Bool
ES.member ActorId
aid EnumSet ActorId
lastLost Bool -> Bool -> Bool
|| Actor -> Bool
bproj Actor
body -> LevelId -> m ()
forall (m :: * -> *). MonadClientUI m => LevelId -> m ()
markDisplayNeeded (Actor -> LevelId
blid Actor
body)
     | Bool
otherwise -> do
       MsgClassShowAndSave -> ActorId -> Part -> m ()
forall (m :: * -> *) a.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> ActorId -> Part -> m ()
aidVerbMU MsgClassShowAndSave
MsgSpottedActor ActorId
aid Part
verb
       if | Bool
joinYou -> MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
MsgTutorialHint "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
          | Bool
firstEnemy -> MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
MsgTutorialHint "Enemies can be dealt with using melee (by bumping), ranged combat, terrain effects, stealth (not being seen) or hasty retreat (particularly if they are asleep)."
          | Bool
otherwise -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
       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 :: (MonadClient m, MonadClientUI m)
               => Bool -> ActorId -> Actor -> m ()
destroyActorUI :: Bool -> ActorId -> Actor -> m ()
destroyActorUI destroy :: Bool
destroy aid :: ActorId
aid b :: 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
$ \sess :: 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 tgt :: Maybe Target
tgt = case Maybe Target
tgt of
        Just (TEnemy a :: 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 a :: 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
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
$ \sess :: 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) (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
$ \sess :: 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 :: * -> *). (MonadClient 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
$ \sess :: 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. (MonadClient m, MonadClientUI m)
            => Bool -> Container -> ItemBag -> m ()
spotItemBag :: Bool -> Container -> ItemBag -> m ()
spotItemBag verbose :: Bool
verbose c :: Container
c bag :: 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 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 _ p :: 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{} _ _) -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          Just (TPoint TStash{} _ _) -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          Just (TVector _) -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()  -- explicitly set; keep it
          _ -> 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
$ \sess :: 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
        _ -> () -> 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
$
        "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 ""  -- boring
                         else Text
locatedWhere
      subjectMaybe :: (ItemId, ItemQuant) -> m (Maybe (Int, MU.Part, MU.Part))
      subjectMaybe :: (ItemId, ItemQuant) -> m (Maybe (Int, Part, Part))
subjectMaybe (iid :: ItemId
iid, kit :: ItemQuant
kit@(k :: Int
k, _)) = 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
          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)
              _ -> 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 (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 iis :: [(ItemId, ItemQuant)]
iis = ((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) [(ItemId, ItemQuant)]
iis
      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 plural :: 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 (\(_, 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 (\(_, _, part :: Part
part) -> Part
part) [(Int, Part, Part)]
subjects
            msg :: Part -> Text
msg subject :: 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 "" else ".."
        m ()
resetXhair
        MsgClassDistinct -> (Text, Text) -> m ()
forall (m :: * -> *).
(MonadClient 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 ()
    [(1, _, _)] -> Bool -> m ()
sendMsg Bool
False
    _ -> 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 aid :: ActorId
aid store :: 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.
(MonadClient m, 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
> 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.
(MonadClient m, 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)
    _ -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

recordItemLid :: MonadClientUI m => ItemId -> Container -> m ()
recordItemLid :: ItemId -> Container -> m ()
recordItemLid iid :: ItemId
iid c :: 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
$ \sess :: 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 :: (MonadClient m, MonadClientUI m)
          => ActorId -> Point -> Point -> m ()
moveActor :: ActorId -> Point -> Point -> m ()
moveActor aid :: ActorId
aid source :: Point
source target :: 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 :: * -> *).
(MonadClient m, MonadClientUI m) =>
ActorId -> m ()
lookAtMove ActorId
aid

displaceActorUI :: (MonadClient m, MonadClientUI m)
                => ActorId -> ActorId -> m ()
displaceActorUI :: ActorId -> ActorId -> m ()
displaceActorUI source :: ActorId
source target :: 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
      msg :: Text
msg = [Part] -> Text
makeSentence [Part -> Part -> Part
MU.SubjectVerbSg Part
spart "displace", Part
tpart]
  MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
msgClass Text
msg
  ActorId -> m ()
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
ActorId -> m ()
lookAtMove 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
$
    ActorId -> m ()
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
ActorId -> m ()
lookAtMove ActorId
target  -- in case only this one is ours
  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 :: * -> *). (MonadClient 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 :: (MonadClient m, MonadClientUI m)
           => ItemId -> Int -> ActorId -> CStore -> CStore
           -> m ()
moveItemUI :: ItemId -> Int -> ActorId -> CStore -> CStore -> m ()
moveItemUI iid :: ItemId
iid k :: Int
k aid :: ActorId
aid cstore1 :: CStore
cstore1 cstore2 :: 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 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 _l :: 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.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> ActorId -> Part -> ItemId -> Either Int Int -> m ()
itemAidVerbMU MsgClassShowAndSave
MsgItemMovement 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
> 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.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> ActorId -> Part -> ItemId -> Either Int Int -> m ()
itemAidVerbMU MsgClassShowAndSave
MsgItemMovement ActorId
aid Part
verb ItemId
iid (Int -> Either Int Int
forall a b. a -> Either a b
Left Int
k)
    Nothing -> [Char] -> m ()
forall a. (?callStack::CallStack) => [Char] -> a
error ([Char] -> m ()) -> [Char] -> m ()
forall a b. (a -> b) -> a -> b
$
      "" [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)

quitFactionUI :: (MonadClient m, MonadClientUI m)
              => FactionId -> Maybe Status
              -> Maybe (FactionAnalytics, GenerationAnalytics)
              -> m ()
quitFactionUI :: FactionId
-> Maybe Status
-> Maybe (FactionAnalytics, GenerationAnalytics)
-> m ()
quitFactionUI fid :: FactionId
fid toSt :: Maybe Status
toSt manalytics :: Maybe (FactionAnalytics, GenerationAnalytics)
manalytics = do
  ClientOptions{Bool
sexposeItems :: ClientOptions -> Bool
sexposeItems :: Bool
sexposeItems} <- (StateClient -> ClientOptions) -> m ClientOptions
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> ClientOptions
soptions
  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
      person :: Person
person = if Player -> Bool
fhasGender (Player -> Bool) -> Player -> Bool
forall a b. (a -> b) -> a -> b
$ Faction -> Player
gplayer Faction
fact then Person
MU.PlEtc else Person
MU.Sg3rd
      horror :: Bool
horror = Faction -> Bool
isHorrorFact Faction
fact
      camping :: Bool
camping = Bool -> (Status -> Bool) -> Maybe Status -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True ((Outcome -> Outcome -> Bool
forall a. Eq a => a -> a -> Bool
== Outcome
Camping) (Outcome -> Bool) -> (Status -> Outcome) -> Status -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Status -> Outcome
stOutcome) Maybe Status
toSt
  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 (FactionId
fid FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
camping) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    m ()
forall (m :: * -> *). MonadClientUI m => m ()
tellGameClipPS
    m ()
forall (m :: * -> *). MonadClientUI m => m ()
resetGameStart
  ModeKind
gameMode <- m ModeKind
forall (m :: * -> *). MonadStateRead m => m ModeKind
getGameMode
  Int
allNframes <- (SessionUI -> Int) -> m Int
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Int
sallNframes
  let startingPart :: Maybe Part
startingPart = case Maybe Status
toSt of
        _ | Bool
horror -> Maybe Part
forall a. Maybe a
Nothing  -- Ignore summoned actors' factions.
        Just Status{stOutcome :: Status -> Outcome
stOutcome=stOutcome :: Outcome
stOutcome@Outcome
Restart, stNewGame :: Status -> Maybe (GroupName ModeKind)
stNewGame=Just gn :: GroupName ModeKind
gn} ->
          Part -> Maybe Part
forall a. a -> Maybe a
Just (Part -> Maybe Part) -> Part -> Maybe Part
forall a b. (a -> b) -> a -> b
$ Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ Outcome -> Text
nameOutcomeVerb Outcome
stOutcome
                           Text -> Text -> Text
<+> "to restart in" Text -> Text -> Text
<+> GroupName ModeKind -> Text
forall a. GroupName a -> Text
fromGroupName GroupName ModeKind
gn Text -> Text -> Text
<+> "mode"
                             -- when multiplayer: "order mission restart in"
        Just Status{stOutcome :: Status -> Outcome
stOutcome=Outcome
Restart, stNewGame :: Status -> Maybe (GroupName ModeKind)
stNewGame=Maybe (GroupName ModeKind)
Nothing} ->
          [Char] -> Maybe Part
forall a. (?callStack::CallStack) => [Char] -> a
error ([Char] -> Maybe Part) -> [Char] -> Maybe Part
forall a b. (a -> b) -> a -> b
$ "" [Char] -> (FactionId, Maybe Status) -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` (FactionId
fid, Maybe Status
toSt)
        Just Status{Outcome
stOutcome :: Outcome
stOutcome :: Status -> Outcome
stOutcome} -> Part -> Maybe Part
forall a. a -> Maybe a
Just (Part -> Maybe Part) -> Part -> Maybe Part
forall a b. (a -> b) -> a -> b
$ Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ Outcome -> Text
nameOutcomeVerb Outcome
stOutcome
          -- when multiplayer, for @Camping@: "order save and exit"
        Nothing -> Maybe Part
forall a. Maybe a
Nothing
      middlePart :: Maybe Text
middlePart = case Maybe Status
toSt of
        _ | FactionId
fid FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
/= FactionId
side -> Maybe Text
forall a. Maybe a
Nothing
        Just Status{Outcome
stOutcome :: Outcome
stOutcome :: Status -> Outcome
stOutcome} -> Outcome -> [(Outcome, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Outcome
stOutcome ([(Outcome, Text)] -> Maybe Text)
-> [(Outcome, Text)] -> Maybe Text
forall a b. (a -> b) -> a -> b
$ ModeKind -> [(Outcome, Text)]
mendMsg ModeKind
gameMode
        Nothing -> Maybe Text
forall a. Maybe a
Nothing
      partingPart :: Maybe Text
partingPart = if FactionId
fid FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
/= FactionId
side Bool -> Bool -> Bool
|| Int
allNframes Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== -1
                    then Maybe Text
forall a. Maybe a
Nothing
                    else Outcome -> Text
endMessageOutcome (Outcome -> Text) -> (Status -> Outcome) -> Status -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Status -> Outcome
stOutcome (Status -> Text) -> Maybe Status -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Status
toSt
  case Maybe Part
startingPart of
    Nothing -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just sp :: Part
sp ->
      let blurb :: Text
blurb = [Part] -> Text
makeSentence [Person -> Polarity -> Part -> Part -> Part
MU.SubjectVerb Person
person Polarity
MU.Yes Part
fidName Part
sp]
      in MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgLnAdd MsgClassShowAndSave
MsgFinalOutcome Text
blurb
  case (Maybe Status
toSt, Maybe Text
partingPart) of
    (Just status :: Status
status, Just pp :: Text
pp) -> do
      Bool
noConfirmsGame <- m Bool
forall (m :: * -> *). MonadStateRead m => m Bool
isNoConfirmsGame
      Bool
go <- if Bool
noConfirmsGame
            then Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
            else ColorMode -> Text -> m Bool
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
ColorMode -> Text -> m Bool
displaySpaceEsc ColorMode
ColorFull ""  -- short, just @startingPart@
      m ()
forall (m :: * -> *). MonadClientUI m => m ()
recordHistory
        -- we are going to exit or restart, so record and clear, but only once
      (itemBag :: ItemBag
itemBag, total :: Int
total) <- (State -> (ItemBag, Int)) -> m (ItemBag, Int)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> (ItemBag, Int)) -> m (ItemBag, Int))
-> (State -> (ItemBag, Int)) -> m (ItemBag, Int)
forall a b. (a -> b) -> a -> b
$ FactionId -> State -> (ItemBag, Int)
calculateTotal FactionId
side
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
go (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
        case Maybe Text
middlePart of
          Nothing -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          Just sp1 :: Text
sp1 -> do
            FactionDict
factionD <- (State -> FactionDict) -> m FactionDict
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> FactionDict
sfactionD
            ItemId -> ItemFull
itemToF <- (State -> ItemId -> ItemFull) -> m (ItemId -> ItemFull)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemId -> ItemFull) -> m (ItemId -> ItemFull))
-> (State -> ItemId -> ItemFull) -> m (ItemId -> ItemFull)
forall a b. (a -> b) -> a -> b
$ (ItemId -> State -> ItemFull) -> State -> ItemId -> ItemFull
forall a b c. (a -> b -> c) -> b -> a -> c
flip ItemId -> State -> ItemFull
itemToFull
            let getTrunkFull :: (ActorId, Actor) -> (ActorId, ItemFull)
getTrunkFull (aid :: ActorId
aid, b :: Actor
b) = (ActorId
aid, ItemId -> ItemFull
itemToF (ItemId -> ItemFull) -> ItemId -> ItemFull
forall a b. (a -> b) -> a -> b
$ Actor -> ItemId
btrunk Actor
b)
            [(ActorId, ItemFull)]
ourTrunks <- (State -> [(ActorId, ItemFull)]) -> m [(ActorId, ItemFull)]
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(ActorId, ItemFull)]) -> m [(ActorId, ItemFull)])
-> (State -> [(ActorId, ItemFull)]) -> m [(ActorId, ItemFull)]
forall a b. (a -> b) -> a -> b
$ ((ActorId, Actor) -> (ActorId, ItemFull))
-> [(ActorId, Actor)] -> [(ActorId, ItemFull)]
forall a b. (a -> b) -> [a] -> [b]
map (ActorId, Actor) -> (ActorId, ItemFull)
getTrunkFull
                                     ([(ActorId, Actor)] -> [(ActorId, ItemFull)])
-> (State -> [(ActorId, Actor)]) -> State -> [(ActorId, ItemFull)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FactionId -> State -> [(ActorId, Actor)]
fidActorNotProjGlobalAssocs FactionId
side
            let smartFaction :: Faction -> Bool
smartFaction fact2 :: Faction
fact2 = Player -> LeaderMode
fleaderMode (Faction -> Player
gplayer Faction
fact2) LeaderMode -> LeaderMode -> Bool
forall a. Eq a => a -> a -> Bool
/= LeaderMode
LeaderNull
                canBeSmart :: [(a, Faction)] -> Bool
canBeSmart = ((a, Faction) -> Bool) -> [(a, Faction)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Faction -> Bool
smartFaction (Faction -> Bool)
-> ((a, Faction) -> Faction) -> (a, Faction) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, Faction) -> Faction
forall a b. (a, b) -> b
snd)
                canBeOurFaction :: [(FactionId, Faction)] -> Bool
canBeOurFaction = ((FactionId, Faction) -> Bool) -> [(FactionId, Faction)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\(fid2 :: FactionId
fid2, _) -> FactionId
fid2 FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side)
                smartEnemy :: ItemFull -> Bool
smartEnemy trunkFull :: ItemFull
trunkFull =
                  let possible :: [(FactionId, Faction)]
possible =
                        ItemKind -> FactionDict -> [(FactionId, Faction)]
possibleActorFactions (ItemFull -> ItemKind
itemKind ItemFull
trunkFull) FactionDict
factionD
                  in Bool -> Bool
not ([(FactionId, Faction)] -> Bool
canBeOurFaction [(FactionId, Faction)]
possible) Bool -> Bool -> Bool
&& [(FactionId, Faction)] -> Bool
forall a. [(a, Faction)] -> Bool
canBeSmart [(FactionId, Faction)]
possible
                smartEnemiesOurs :: [(ActorId, ItemFull)]
smartEnemiesOurs = ((ActorId, ItemFull) -> Bool)
-> [(ActorId, ItemFull)] -> [(ActorId, ItemFull)]
forall a. (a -> Bool) -> [a] -> [a]
filter (ItemFull -> Bool
smartEnemy (ItemFull -> Bool)
-> ((ActorId, ItemFull) -> ItemFull) -> (ActorId, ItemFull) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ActorId, ItemFull) -> ItemFull
forall a b. (a, b) -> b
snd) [(ActorId, ItemFull)]
ourTrunks
                uniqueActor :: ItemFull -> Bool
uniqueActor trunkFull :: ItemFull
trunkFull = Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Unique
                                        (AspectRecord -> Bool) -> AspectRecord -> Bool
forall a b. (a -> b) -> a -> b
$ ItemFull -> AspectRecord
aspectRecordFull ItemFull
trunkFull
                uniqueEnemiesOurs :: [(ActorId, ItemFull)]
uniqueEnemiesOurs = ((ActorId, ItemFull) -> Bool)
-> [(ActorId, ItemFull)] -> [(ActorId, ItemFull)]
forall a. (a -> Bool) -> [a] -> [a]
filter (ItemFull -> Bool
uniqueActor (ItemFull -> Bool)
-> ((ActorId, ItemFull) -> ItemFull) -> (ActorId, ItemFull) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ActorId, ItemFull) -> ItemFull
forall a b. (a, b) -> b
snd) [(ActorId, ItemFull)]
smartEnemiesOurs
                smartUniqueEnemyCaptured :: Bool
smartUniqueEnemyCaptured = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [(ActorId, ItemFull)] -> Bool
forall a. [a] -> Bool
null [(ActorId, ItemFull)]
uniqueEnemiesOurs
                smartEnemyCaptured :: Bool
smartEnemyCaptured = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [(ActorId, ItemFull)] -> Bool
forall a. [a] -> Bool
null [(ActorId, ItemFull)]
smartEnemiesOurs
            Text
smartEnemySentence <- case [(ActorId, ItemFull)]
uniqueEnemiesOurs [(ActorId, ItemFull)]
-> [(ActorId, ItemFull)] -> [(ActorId, ItemFull)]
forall a. [a] -> [a] -> [a]
++ [(ActorId, ItemFull)]
smartEnemiesOurs of
              [] -> Text -> m Text
forall (m :: * -> *) a. Monad m => a -> m a
return ""
              (enemyAid :: ActorId
enemyAid, _) : _ -> do
                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
enemyAid
                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 -> Part
MU.Capitalize (ActorUI -> Part
partActor ActorUI
bUI)] Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "?"
            let won :: Bool
won = Bool -> (Status -> Bool) -> Maybe Status -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False ((Outcome -> [Outcome] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Outcome]
victoryOutcomes) (Outcome -> Bool) -> (Status -> Outcome) -> Status -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Status -> Outcome
stOutcome) Maybe Status
toSt
                lost :: Bool
lost = Bool -> (Status -> Bool) -> Maybe Status -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False ((Outcome -> [Outcome] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Outcome]
deafeatOutcomes) (Outcome -> Bool) -> (Status -> Outcome) -> Status -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Status -> Outcome
stOutcome) Maybe Status
toSt
                msgClass :: MsgClassShowAndSave
msgClass | Bool
won = MsgClassShowAndSave
MsgGoodMiscEvent
                         | Bool
lost = MsgClassShowAndSave
MsgBadMiscEvent
                         | Bool
otherwise = MsgClassShowAndSave
MsgNeutralEvent
                (sp2 :: Text
sp2, escPrompt :: Text
escPrompt) =
                  if | Bool
lost -> ("", "Accept the unacceptable?")
                     | Bool
smartUniqueEnemyCaptured ->
                       ( "\nOh, wait, who is this, towering behind your escaping crew?" Text -> Text -> Text
<+> Text
smartEnemySentence Text -> Text -> Text
<+> "This changes everything. For everybody. Everywhere. Forever. Did you plan for this? Are you sure it was your idea?"
                       , "What happens now?" )
                     | Bool
smartEnemyCaptured ->
                       ( "\nOh, wait, who is this, hunched among your escaping crew?" Text -> Text -> Text
<+> Text
smartEnemySentence Text -> Text -> Text
<+> "Suddenly, this makes your crazy story credible. Suddenly, the door of knowledge opens again."
                       , "How will you play that move?" )
                     | Bool
otherwise -> ("", "Let's see what we've got here.")
            MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
msgClass Text
sp1
            MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
MsgFactionIntel Text
sp2
            m Bool -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m Bool -> m ()) -> m Bool -> m ()
forall a b. (a -> b) -> a -> b
$ ColorMode -> Text -> m Bool
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
ColorMode -> Text -> m Bool
displaySpaceEsc ColorMode
ColorFull Text
escPrompt
        case Maybe (FactionAnalytics, GenerationAnalytics)
manalytics of
          Nothing -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          Just (factionAn :: FactionAnalytics
factionAn, generationAn :: GenerationAnalytics
generationAn) ->
            [m KM] -> [m KM] -> m ()
forall (m :: * -> *). MonadClientUI m => [m KM] -> [m KM] -> m ()
cycleLore []
              [ (ItemBag, Int) -> GenerationAnalytics -> m KM
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
(ItemBag, Int) -> GenerationAnalytics -> m KM
displayGameOverLoot (ItemBag
itemBag, Int
total) GenerationAnalytics
generationAn
              , SLore -> Bool -> GenerationAnalytics -> m KM
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
SLore -> Bool -> GenerationAnalytics -> m KM
displayGameOverLore SLore
SOrgan Bool
True GenerationAnalytics
generationAn
              , FactionAnalytics -> GenerationAnalytics -> m KM
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
FactionAnalytics -> GenerationAnalytics -> m KM
displayGameOverAnalytics FactionAnalytics
factionAn GenerationAnalytics
generationAn
              , SLore -> Bool -> GenerationAnalytics -> m KM
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
SLore -> Bool -> GenerationAnalytics -> m KM
displayGameOverLore SLore
SCondition Bool
sexposeItems GenerationAnalytics
generationAn
              , SLore -> Bool -> GenerationAnalytics -> m KM
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
SLore -> Bool -> GenerationAnalytics -> m KM
displayGameOverLore SLore
SBlast Bool
True GenerationAnalytics
generationAn
              , SLore -> Bool -> GenerationAnalytics -> m KM
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
SLore -> Bool -> GenerationAnalytics -> m KM
displayGameOverLore SLore
SEmbed Bool
True GenerationAnalytics
generationAn ]
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
noConfirmsGame (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
        -- Show score for any UI client after any kind of game exit,
        -- even though it's saved only for human UI clients at game over
        -- (that is not a noConfirms or benchmark game).
        Slideshow
scoreSlides <- Int -> Status -> m Slideshow
forall (m :: * -> *).
MonadClientUI m =>
Int -> Status -> m Slideshow
scoreToSlideshow Int
total Status
status
        m KM -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m KM -> m ()) -> m KM -> m ()
forall a b. (a -> b) -> a -> b
$ ColorMode -> [KM] -> Slideshow -> m KM
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
ColorMode -> [KM] -> Slideshow -> m KM
getConfirms ColorMode
ColorFull [KM
K.spaceKM, KM
K.escKM] Slideshow
scoreSlides
      -- The last prompt stays onscreen during shutdown, etc.
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
noConfirmsGame Bool -> Bool -> Bool
|| Bool
camping) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
        MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgPromptGeneric Text
pp
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
camping (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgPromptGeneric "Saving..."
        Bool -> m ()
forall (m :: * -> *). MonadClientUI m => Bool -> m ()
pushFrame Bool
False  -- don't leave frozen prompts on the browser screen
    _ -> Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Part -> Bool
forall a. Maybe a -> Bool
isJust Maybe Part
startingPart Bool -> Bool -> Bool
&& (Status -> Outcome
stOutcome (Status -> Outcome) -> Maybe Status -> Maybe Outcome
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Status
toSt) Maybe Outcome -> Maybe Outcome -> Bool
forall a. Eq a => a -> a -> Bool
== Outcome -> Maybe Outcome
forall a. a -> Maybe a
Just Outcome
Killed) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
      -- Needed not to overlook the competitor dying in raid scenario.
      ColorMode -> Text -> m ()
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
ColorMode -> Text -> m ()
displayMore ColorMode
ColorFull ""

displayGameOverLoot :: (MonadClient m, MonadClientUI m)
                    => (ItemBag, Int) -> GenerationAnalytics -> m K.KM
displayGameOverLoot :: (ItemBag, Int) -> GenerationAnalytics -> m KM
displayGameOverLoot (heldBag :: ItemBag
heldBag, total :: Int
total) generationAn :: GenerationAnalytics
generationAn = do
  ClientOptions{Bool
sexposeItems :: Bool
sexposeItems :: ClientOptions -> Bool
sexposeItems} <- (StateClient -> ClientOptions) -> m ClientOptions
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> ClientOptions
soptions
  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
  ItemSlots itemSlots :: EnumMap SLore SingleItemSlots
itemSlots <- (SessionUI -> ItemSlots) -> m ItemSlots
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> ItemSlots
sslots
  -- We assume "gold grain", not "grain" with label "of gold":
  let currencyName :: Text
currencyName = 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) -> ContentId ItemKind -> ItemKind
forall a b. (a -> b) -> a -> b
$ ContentData ItemKind -> GroupName ItemKind -> ContentId ItemKind
forall a. Show a => ContentData a -> GroupName a -> ContentId a
ouniqGroup ContentData ItemKind
coitem GroupName ItemKind
IK.S_CURRENCY
      lSlotsRaw :: SingleItemSlots
lSlotsRaw = (ItemId -> Bool) -> SingleItemSlots -> SingleItemSlots
forall a k. (a -> Bool) -> EnumMap k a -> EnumMap k a
EM.filter (ItemId -> ItemBag -> Bool
forall k a. Enum k => k -> EnumMap k a -> Bool
`EM.member` ItemBag
heldBag) (SingleItemSlots -> SingleItemSlots)
-> SingleItemSlots -> SingleItemSlots
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
      generationItem :: EnumMap ItemId Int
generationItem = GenerationAnalytics
generationAn GenerationAnalytics -> SLore -> EnumMap ItemId Int
forall k a. Enum k => EnumMap k a -> k -> a
EM.! SLore
SItem
      (itemBag :: ItemBag
itemBag, lSlots :: SingleItemSlots
lSlots) =
        if Bool
sexposeItems
        then let generationBag :: ItemBag
generationBag = (Int -> ItemQuant) -> EnumMap ItemId Int -> ItemBag
forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
EM.map (\k :: Int
k -> (-Int
k, [])) EnumMap ItemId Int
generationItem
                 bag :: ItemBag
bag = ItemBag
heldBag ItemBag -> ItemBag -> ItemBag
forall k a. EnumMap k a -> EnumMap k a -> EnumMap k a
`EM.union` ItemBag
generationBag
                 slots :: SingleItemSlots
slots = [(SlotChar, ItemId)] -> SingleItemSlots
forall k a. Enum k => [(k, a)] -> EnumMap k a
EM.fromDistinctAscList ([(SlotChar, ItemId)] -> SingleItemSlots)
-> [(SlotChar, ItemId)] -> SingleItemSlots
forall a b. (a -> b) -> a -> b
$ [SlotChar] -> [ItemId] -> [(SlotChar, ItemId)]
forall a b. [a] -> [b] -> [(a, b)]
zip [SlotChar]
allSlots ([ItemId] -> [(SlotChar, ItemId)])
-> [ItemId] -> [(SlotChar, ItemId)]
forall a b. (a -> b) -> a -> b
$ ItemBag -> [ItemId]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys ItemBag
bag
             in (ItemBag
bag, SingleItemSlots
slots)
        else (ItemBag
heldBag, SingleItemSlots
lSlotsRaw)
      promptFun :: ItemId -> ItemFull -> Int -> Text
promptFun iid :: ItemId
iid itemFull2 :: ItemFull
itemFull2 k :: Int
k =
        let worth :: Int
worth = Int -> ItemKind -> Int
itemPrice 1 (ItemKind -> Int) -> ItemKind -> Int
forall a b. (a -> b) -> a -> b
$ ItemFull -> ItemKind
itemKind ItemFull
itemFull2
            lootMsg :: Text
lootMsg = if Int
worth Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 then "" else
              let pile :: Part
pile = if Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 then "exemplar" else "hoard"
              in [Part] -> Text
makeSentence ([Part] -> Text) -> [Part] -> Text
forall a b. (a -> b) -> a -> b
$
                   ["this treasure", Part
pile, "is worth"]
                   [Part] -> [Part] -> [Part]
forall a. [a] -> [a] -> [a]
++ (if Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1 then [ Int -> Part
MU.Cardinal Int
k, "times"] else [])
                   [Part] -> [Part] -> [Part]
forall a. [a] -> [a] -> [a]
++ [Int -> Part -> Part
MU.CarWs Int
worth (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ Text -> Part
MU.Text Text
currencyName]
            holdsMsg :: Text
holdsMsg =
              let n :: Int
n = EnumMap ItemId Int
generationItem EnumMap ItemId Int -> ItemId -> Int
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ItemId
iid
              in if | Int -> Int -> Int
forall a. Ord a => a -> a -> a
max 0 Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 ->
                      "You keep the only specimen extant:"
                    | Int -> Int -> Int
forall a. Ord a => a -> a -> a
max 0 Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 ->
                      "You don't have the only hypothesized specimen:"
                    | Int -> Int -> Int
forall a. Ord a => a -> a -> a
max 0 Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 ->
                      "No such specimen was recorded:"
                    | Bool
otherwise ->
                        [Part] -> Text
makePhrase [ "You hold"
                                   , if Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n
                                     then "all pieces"
                                     else Int -> Part -> Part
MU.CardinalAWs (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max 0 Int
k) "piece"
                                   , "out of"
                                   , Int -> Part
MU.Car Int
n
                                   , "scattered:" ]
        in Text
lootMsg Text -> Text -> Text
<+> Text
holdsMsg
  Int
dungeonTotal <- (State -> Int) -> m Int
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> Int
sgold
  let promptGold :: Text
promptGold = Text -> Int -> Int -> Text
spoilsBlurb Text
currencyName Int
total Int
dungeonTotal
      -- Total number of items is meaningless in the presence of so much junk.
      prompt :: Text
prompt =
        Text
promptGold
        Text -> Text -> Text
<+> (if Bool
sexposeItems
             then "Non-positive count means none held but this many generated."
             else "")
      examItem :: Int -> SingleItemSlots -> m Bool
examItem = ItemBag
-> Int
-> (ItemId -> ItemFull -> Int -> Text)
-> Int
-> SingleItemSlots
-> m Bool
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
ItemBag
-> Int
-> (ItemId -> ItemFull -> Int -> Text)
-> Int
-> SingleItemSlots
-> m Bool
displayItemLore ItemBag
itemBag 0 ItemId -> ItemFull -> Int -> Text
promptFun
  [Char]
-> SingleItemSlots
-> ItemBag
-> Text
-> (Int -> SingleItemSlots -> m Bool)
-> Bool
-> m KM
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
[Char]
-> SingleItemSlots
-> ItemBag
-> Text
-> (Int -> SingleItemSlots -> m Bool)
-> Bool
-> m KM
viewLoreItems "GameOverLoot" SingleItemSlots
lSlots ItemBag
itemBag Text
prompt Int -> SingleItemSlots -> m Bool
examItem Bool
True

displayGameOverAnalytics :: (MonadClient m, MonadClientUI m)
                         => FactionAnalytics -> GenerationAnalytics
                         -> m K.KM
displayGameOverAnalytics :: FactionAnalytics -> GenerationAnalytics -> m KM
displayGameOverAnalytics factionAn :: FactionAnalytics
factionAn generationAn :: GenerationAnalytics
generationAn = do
  ClientOptions{Bool
sexposeActors :: ClientOptions -> Bool
sexposeActors :: Bool
sexposeActors} <- (StateClient -> ClientOptions) -> m ClientOptions
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> ClientOptions
soptions
  FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
  ItemSlots itemSlots :: EnumMap SLore SingleItemSlots
itemSlots <- (SessionUI -> ItemSlots) -> m ItemSlots
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> ItemSlots
sslots
  let ourAn :: EnumMap KillHow KillMap
ourAn = Analytics -> EnumMap KillHow KillMap
akillCounts
              (Analytics -> EnumMap KillHow KillMap)
-> Analytics -> EnumMap KillHow KillMap
forall a b. (a -> b) -> a -> b
$ Analytics -> FactionId -> FactionAnalytics -> Analytics
forall k a. Enum k => a -> k -> EnumMap k a -> a
EM.findWithDefault Analytics
emptyAnalytics FactionId
side FactionAnalytics
factionAn
      foesAn :: EnumMap ItemId Int
foesAn = (Int -> Int -> Int) -> [EnumMap ItemId Int] -> EnumMap ItemId Int
forall a k. (a -> a -> a) -> [EnumMap k a] -> EnumMap k a
EM.unionsWith Int -> Int -> Int
forall a. Num a => a -> a -> a
(+)
               ([EnumMap ItemId Int] -> EnumMap ItemId Int)
-> [EnumMap ItemId Int] -> EnumMap ItemId Int
forall a b. (a -> b) -> a -> b
$ (KillMap -> [EnumMap ItemId Int])
-> [KillMap] -> [EnumMap ItemId Int]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap KillMap -> [EnumMap ItemId Int]
forall k a. EnumMap k a -> [a]
EM.elems ([KillMap] -> [EnumMap ItemId Int])
-> [KillMap] -> [EnumMap ItemId Int]
forall a b. (a -> b) -> a -> b
$ [Maybe KillMap] -> [KillMap]
forall a. [Maybe a] -> [a]
catMaybes
               ([Maybe KillMap] -> [KillMap]) -> [Maybe KillMap] -> [KillMap]
forall a b. (a -> b) -> a -> b
$ (KillHow -> Maybe KillMap) -> [KillHow] -> [Maybe KillMap]
forall a b. (a -> b) -> [a] -> [b]
map (KillHow -> EnumMap KillHow KillMap -> Maybe KillMap
forall k a. Enum k => k -> EnumMap k a -> Maybe a
`EM.lookup` EnumMap KillHow KillMap
ourAn) [KillHow
KillKineticMelee .. KillHow
KillOtherPush]
      trunkBagRaw :: ItemBag
trunkBagRaw = (Int -> ItemQuant) -> EnumMap ItemId Int -> ItemBag
forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
EM.map (, []) EnumMap ItemId Int
foesAn
      lSlotsRaw :: SingleItemSlots
lSlotsRaw = (ItemId -> Bool) -> SingleItemSlots -> SingleItemSlots
forall a k. (a -> Bool) -> EnumMap k a -> EnumMap k a
EM.filter (ItemId -> ItemBag -> Bool
forall k a. Enum k => k -> EnumMap k a -> Bool
`EM.member` ItemBag
trunkBagRaw) (SingleItemSlots -> SingleItemSlots)
-> SingleItemSlots -> SingleItemSlots
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
STrunk
      killedBag :: ItemBag
killedBag = [(ItemId, ItemQuant)] -> ItemBag
forall k a. Enum k => [(k, a)] -> EnumMap k a
EM.fromList ([(ItemId, ItemQuant)] -> ItemBag)
-> [(ItemId, ItemQuant)] -> ItemBag
forall a b. (a -> b) -> a -> b
$ (ItemId -> (ItemId, ItemQuant))
-> [ItemId] -> [(ItemId, ItemQuant)]
forall a b. (a -> b) -> [a] -> [b]
map (\iid :: ItemId
iid -> (ItemId
iid, ItemBag
trunkBagRaw ItemBag -> ItemId -> ItemQuant
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ItemId
iid))
                                    (SingleItemSlots -> [ItemId]
forall k a. EnumMap k a -> [a]
EM.elems SingleItemSlots
lSlotsRaw)
      generationTrunk :: EnumMap ItemId Int
generationTrunk = GenerationAnalytics
generationAn GenerationAnalytics -> SLore -> EnumMap ItemId Int
forall k a. Enum k => EnumMap k a -> k -> a
EM.! SLore
STrunk
      (trunkBag :: ItemBag
trunkBag, lSlots :: SingleItemSlots
lSlots) =
        if Bool
sexposeActors
        then let generationBag :: ItemBag
generationBag = (Int -> ItemQuant) -> EnumMap ItemId Int -> ItemBag
forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
EM.map (\k :: Int
k -> (-Int
k, [])) EnumMap ItemId Int
generationTrunk
                 bag :: ItemBag
bag = ItemBag
killedBag ItemBag -> ItemBag -> ItemBag
forall k a. EnumMap k a -> EnumMap k a -> EnumMap k a
`EM.union` ItemBag
generationBag
                 slots :: SingleItemSlots
slots = [(SlotChar, ItemId)] -> SingleItemSlots
forall k a. Enum k => [(k, a)] -> EnumMap k a
EM.fromDistinctAscList ([(SlotChar, ItemId)] -> SingleItemSlots)
-> [(SlotChar, ItemId)] -> SingleItemSlots
forall a b. (a -> b) -> a -> b
$ [SlotChar] -> [ItemId] -> [(SlotChar, ItemId)]
forall a b. [a] -> [b] -> [(a, b)]
zip [SlotChar]
allSlots ([ItemId] -> [(SlotChar, ItemId)])
-> [ItemId] -> [(SlotChar, ItemId)]
forall a b. (a -> b) -> a -> b
$ ItemBag -> [ItemId]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys ItemBag
bag
             in (ItemBag
bag, SingleItemSlots
slots)
        else (ItemBag
killedBag, SingleItemSlots
lSlotsRaw)
      total :: Int
total = [Int] -> Int
forall a. Num a => [a] -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
filter (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0) ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ (ItemQuant -> Int) -> [ItemQuant] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ItemQuant -> Int
forall a b. (a, b) -> a
fst ([ItemQuant] -> [Int]) -> [ItemQuant] -> [Int]
forall a b. (a -> b) -> a -> b
$ ItemBag -> [ItemQuant]
forall k a. EnumMap k a -> [a]
EM.elems ItemBag
trunkBag
      -- Not just "killed 1 out of 4", because it's sometimes "2 out of 1",
      -- if an enemy was revived.
      promptFun :: ItemId -> ItemFull-> Int -> Text
      promptFun :: ItemId -> ItemFull -> Int -> Text
promptFun iid :: ItemId
iid _ k :: Int
k =
        let n :: Int
n = EnumMap ItemId Int
generationTrunk EnumMap ItemId Int -> ItemId -> Int
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ItemId
iid
        in [Part] -> Text
makePhrase [ "You recall the adversary, which you killed on"
                      , Int -> Part -> Part
MU.CarWs (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max 0 Int
k) "occasion", "while reports mention"
                      , Int -> Part -> Part
MU.CarWs Int
n "individual", "in total:" ]
      prompt :: Text
prompt =
        [Part] -> Text
makeSentence ["your team vanquished", Int -> Part -> Part
MU.CarWs Int
total "adversary"]
          -- total reported would include our own, so not given
        Text -> Text -> Text
<+> (if Bool
sexposeActors
             then "Non-positive count means none killed but this many reported."
             else "")
      examItem :: Int -> SingleItemSlots -> m Bool
examItem = ItemBag
-> Int
-> (ItemId -> ItemFull -> Int -> Text)
-> Int
-> SingleItemSlots
-> m Bool
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
ItemBag
-> Int
-> (ItemId -> ItemFull -> Int -> Text)
-> Int
-> SingleItemSlots
-> m Bool
displayItemLore ItemBag
trunkBag 0 ItemId -> ItemFull -> Int -> Text
promptFun
  [Char]
-> SingleItemSlots
-> ItemBag
-> Text
-> (Int -> SingleItemSlots -> m Bool)
-> Bool
-> m KM
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
[Char]
-> SingleItemSlots
-> ItemBag
-> Text
-> (Int -> SingleItemSlots -> m Bool)
-> Bool
-> m KM
viewLoreItems "GameOverAnalytics" SingleItemSlots
lSlots ItemBag
trunkBag Text
prompt Int -> SingleItemSlots -> m Bool
examItem Bool
False

displayGameOverLore :: (MonadClient m, MonadClientUI m)
                    => SLore -> Bool -> GenerationAnalytics -> m K.KM
displayGameOverLore :: SLore -> Bool -> GenerationAnalytics -> m KM
displayGameOverLore slore :: SLore
slore exposeCount :: Bool
exposeCount generationAn :: GenerationAnalytics
generationAn = do
  let generationLore :: EnumMap ItemId Int
generationLore = GenerationAnalytics
generationAn GenerationAnalytics -> SLore -> EnumMap ItemId Int
forall k a. Enum k => EnumMap k a -> k -> a
EM.! SLore
slore
      generationBag :: ItemBag
generationBag = (Int -> ItemQuant) -> EnumMap ItemId Int -> ItemBag
forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
EM.map (\k :: Int
k -> (if Bool
exposeCount then Int
k else 1, []))
                             EnumMap ItemId Int
generationLore
      total :: Int
total = [Int] -> Int
forall a. Num a => [a] -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (ItemQuant -> Int) -> [ItemQuant] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ItemQuant -> Int
forall a b. (a, b) -> a
fst ([ItemQuant] -> [Int]) -> [ItemQuant] -> [Int]
forall a b. (a -> b) -> a -> b
$ ItemBag -> [ItemQuant]
forall k a. EnumMap k a -> [a]
EM.elems ItemBag
generationBag
      slots :: SingleItemSlots
slots = [(SlotChar, ItemId)] -> SingleItemSlots
forall k a. Enum k => [(k, a)] -> EnumMap k a
EM.fromDistinctAscList ([(SlotChar, ItemId)] -> SingleItemSlots)
-> [(SlotChar, ItemId)] -> SingleItemSlots
forall a b. (a -> b) -> a -> b
$ [SlotChar] -> [ItemId] -> [(SlotChar, ItemId)]
forall a b. [a] -> [b] -> [(a, b)]
zip [SlotChar]
allSlots ([ItemId] -> [(SlotChar, ItemId)])
-> [ItemId] -> [(SlotChar, ItemId)]
forall a b. (a -> b) -> a -> b
$ ItemBag -> [ItemId]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys ItemBag
generationBag
      promptFun :: ItemId -> ItemFull-> Int -> Text
      promptFun :: ItemId -> ItemFull -> Int -> Text
promptFun _ _ k :: Int
k =
        [Part] -> Text
makeSentence
          [ "this", Text -> Part
MU.Text (SLore -> Text
ppSLore SLore
slore), "manifested during your quest"
          , Int -> Part -> Part
MU.CarWs Int
k "time" ]
      verb :: Part
verb = if SLore
slore SLore -> [SLore] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [SLore
SCondition, SLore
SBlast]
             then "experienced"
             else "saw"
      prompt :: Text
prompt | Int
total Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 =
               [Part] -> Text
makeSentence [ "you didn't experience any"
                            , Part -> Part
MU.Ws (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ Text -> Part
MU.Text (SLore -> Text
headingSLore SLore
slore)
                            , "this time" ]
             | Bool
otherwise =
               [Part] -> Text
makeSentence [ "you", Part
verb, "the following variety of"
                            , Int -> Part -> Part
MU.CarWs Int
total (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ Text -> Part
MU.Text (SLore -> Text
headingSLore SLore
slore) ]
      examItem :: Int -> SingleItemSlots -> m Bool
examItem = ItemBag
-> Int
-> (ItemId -> ItemFull -> Int -> Text)
-> Int
-> SingleItemSlots
-> m Bool
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
ItemBag
-> Int
-> (ItemId -> ItemFull -> Int -> Text)
-> Int
-> SingleItemSlots
-> m Bool
displayItemLore ItemBag
generationBag 0 ItemId -> ItemFull -> Int -> Text
promptFun
      displayRanged :: Bool
displayRanged = SLore
slore SLore -> [SLore] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [SLore
SOrgan, SLore
STrunk]
  [Char]
-> SingleItemSlots
-> ItemBag
-> Text
-> (Int -> SingleItemSlots -> m Bool)
-> Bool
-> m KM
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
[Char]
-> SingleItemSlots
-> ItemBag
-> Text
-> (Int -> SingleItemSlots -> m Bool)
-> Bool
-> m KM
viewLoreItems ("GameOverLore" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ SLore -> [Char]
forall a. Show a => a -> [Char]
show SLore
slore)
                SingleItemSlots
slots ItemBag
generationBag Text
prompt Int -> SingleItemSlots -> m Bool
examItem Bool
displayRanged

-- 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 :: (MonadClient m, MonadClientUI m) => Container -> ItemId -> m ()
discover :: Container -> ItemId -> m ()
discover c :: Container
c iid :: ItemId
iid = 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
  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
  (noMsg :: Bool
noMsg, nameWhere :: [Part]
nameWhere) <- case Container
c of
    CActor aidOwner :: ActorId
aidOwner storeOwner :: 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 _ _ p :: 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
    _ -> (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
      (object1 :: Part
object1, object2 :: 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.
      (ikObvious :: Bool
ikObvious, itemKind :: 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 ik :: ContentId ItemKind
ik -> (Bool
True, ContentId ItemKind
ik)
        IdentityCovered _ix :: ItemKindIx
_ix ik :: 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
        [ "the"
        , Part -> Part -> Part
MU.SubjectVerbSg Part
unknownName "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.
(MonadClient m, 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 distance :: Maybe Int
distance hearMsg :: HearMsg
hearMsg = case HearMsg
hearMsg of
  HearUpd cmd :: 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{} -> "shriek"
          UpdCreateItem{} -> "clatter"
          UpdTrajectory{} -> "thud"  -- A non-blast projectle hits a tile.
          UpdAlterTile _ _ fromTile :: ContentId TileKind
fromTile toTile :: 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 -> "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 -> "splash"
               | Bool
otherwise -> "rumble"
          UpdAlterExplorable _ k :: Int
k ->
            if Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 then "grinding noise" else "fizzing noise"
          _ -> [Char] -> Part
forall a. (?callStack::CallStack) => [Char] -> a
error ([Char] -> Part) -> [Char] -> Part
forall a b. (a -> b) -> a -> b
$ "" [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 ["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 ik :: 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 [ "you", Part
adverb, "hear something"
                           , Text -> Part
MU.Text Text
verb, "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 isProj :: Bool
isProj grp :: GroupName ItemKind
grp p :: Dice
p -> do
    let verb :: Part
verb = if Bool
isProj then "something lure" else "somebody summon"
        part :: Part
part = Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ GroupName ItemKind -> Text
forall a. GroupName a -> Text
fromGroupName GroupName ItemKind
grp
        object :: Part
object = if Dice
p Dice -> Dice -> Bool
forall a. Eq a => a -> a -> Bool
== 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 ["you", Part
adverb, "hear", Part
verb, Part
object]
  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 ["you", Part
adverb, "hear someone crash into something"]
  HearTaunt t :: 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 ["You", Part
adverb, "overhear", Text -> Part
MU.Text Text
t]

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

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

-- * RespSfxAtomicUI

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

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

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

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