-- | Common code for displaying atomic update and SFX commands.
module Game.LambdaHack.Client.UI.Watch.WatchCommonM
  ( pushFrame, pushReportFrame, fadeOutOrIn, markDisplayNeeded
  , lookAtMove, stopAtMove
  , aidVerbMU, aidVerbDuplicateMU, itemVerbMUGeneral, itemVerbMU
  , itemVerbMUShort, itemAidVerbMU, mitemAidVerbMU, itemAidDistinctMU
  , manyItemsAidVerbMU
#ifdef EXPOSE_INTERNAL
    -- * Internal operations
  , basicFrameWithoutReport
#endif
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import qualified Data.EnumMap.Strict as EM
import qualified Data.Text as T
import qualified NLP.Miniutter.English as MU

import           Game.LambdaHack.Client.MonadClient
import           Game.LambdaHack.Client.State
import           Game.LambdaHack.Client.UI.Animation
import           Game.LambdaHack.Client.UI.Content.Screen
import           Game.LambdaHack.Client.UI.ContentClientUI
import           Game.LambdaHack.Client.UI.Frame
import           Game.LambdaHack.Client.UI.FrameM
import           Game.LambdaHack.Client.UI.HandleHelperM
import           Game.LambdaHack.Client.UI.ItemDescription
import           Game.LambdaHack.Client.UI.MonadClientUI
import           Game.LambdaHack.Client.UI.Msg
import           Game.LambdaHack.Client.UI.MsgM
import           Game.LambdaHack.Client.UI.Overlay
import           Game.LambdaHack.Client.UI.PointUI
import           Game.LambdaHack.Client.UI.SessionUI
import           Game.LambdaHack.Client.UI.Slideshow
import           Game.LambdaHack.Client.UI.SlideshowM
import           Game.LambdaHack.Common.Actor
import           Game.LambdaHack.Common.ActorState
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.Misc
import           Game.LambdaHack.Common.MonadStateRead
import           Game.LambdaHack.Common.State
import           Game.LambdaHack.Common.Types
import qualified Game.LambdaHack.Definition.Ability as Ability

-- This is not our turn, so we can't obstruct screen with messages
-- and message reformatting causes distraction, so there's no point
-- trying to squeeze the report into the single available line,
-- except when it's not our turn permanently, because AI runs UI.
--
-- The only real drawback of this is that when resting for longer time
-- I can't see the boring messages accumulate until a non-boring interrupts me.
basicFrameWithoutReport :: MonadClientUI m
                        => LevelId -> Maybe Bool -> m PreFrame3
basicFrameWithoutReport :: LevelId -> Maybe Bool -> m PreFrame3
basicFrameWithoutReport LevelId
arena Maybe Bool
forceReport = do
  FontSetup{DisplayFont
propFont :: FontSetup -> DisplayFont
propFont :: DisplayFont
propFont} <- m FontSetup
forall (m :: * -> *). MonadClientUI m => m FontSetup
getFontSetup
  Bool
sbenchMessages <- (StateClient -> Bool) -> m Bool
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient ((StateClient -> Bool) -> m Bool)
-> (StateClient -> Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ ClientOptions -> Bool
sbenchMessages (ClientOptions -> Bool)
-> (StateClient -> ClientOptions) -> StateClient -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateClient -> ClientOptions
soptions
  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
$ (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
side) (EnumMap FactionId Faction -> Faction)
-> (State -> EnumMap FactionId Faction) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap FactionId Faction
sfactionD
  let underAI :: Bool
underAI = Faction -> Bool
isAIFact Faction
fact
  EnumMap DisplayFont Overlay
truncRep <-
    if | Bool
sbenchMessages -> do
         Slideshow
slides <- Bool -> [KM] -> m Slideshow
forall (m :: * -> *).
MonadClientUI m =>
Bool -> [KM] -> m Slideshow
reportToSlideshowKeepHalt Bool
False []
         case Slideshow -> [OKX]
slideshow Slideshow
slides of
           [] -> EnumMap DisplayFont Overlay -> m (EnumMap DisplayFont Overlay)
forall (m :: * -> *) a. Monad m => a -> m a
return EnumMap DisplayFont Overlay
forall k a. EnumMap k a
EM.empty
           (EnumMap DisplayFont Overlay
ov, [KYX]
_) : [OKX]
_ -> do
             -- See @stepQueryUI@. This strips either "--end-" or "--more-".
             let ovProp :: Overlay
ovProp = EnumMap DisplayFont Overlay
ov EnumMap DisplayFont Overlay -> DisplayFont -> Overlay
forall k a. Enum k => EnumMap k a -> k -> a
EM.! DisplayFont
propFont
             EnumMap DisplayFont Overlay -> m (EnumMap DisplayFont Overlay)
forall (m :: * -> *) a. Monad m => a -> m a
return (EnumMap DisplayFont Overlay -> m (EnumMap DisplayFont Overlay))
-> EnumMap DisplayFont Overlay -> m (EnumMap DisplayFont Overlay)
forall a b. (a -> b) -> a -> b
$!
               DisplayFont -> Overlay -> EnumMap DisplayFont Overlay
forall k a. Enum k => k -> a -> EnumMap k a
EM.singleton DisplayFont
propFont
               (Overlay -> EnumMap DisplayFont Overlay)
-> Overlay -> EnumMap DisplayFont Overlay
forall a b. (a -> b) -> a -> b
$ if EnumMap DisplayFont Overlay -> Int
forall k a. EnumMap k a -> Int
EM.size EnumMap DisplayFont Overlay
ov Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 then Overlay
ovProp else Overlay -> Overlay
forall a. [a] -> [a]
init Overlay
ovProp
       | Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
underAI Maybe Bool
forceReport -> do
         Report
report <- Bool -> m Report
forall (m :: * -> *). MonadClientUI m => Bool -> m Report
getReportUI Bool
False
         let par1 :: AttrLine
par1 = AttrString -> AttrLine
firstParagraph (AttrString -> AttrLine) -> AttrString -> AttrLine
forall a b. (a -> b) -> a -> b
$ (AttrString -> AttrString -> AttrString)
-> AttrString -> [AttrString] -> AttrString
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr AttrString -> AttrString -> AttrString
(<+:>) [] ([AttrString] -> AttrString) -> [AttrString] -> AttrString
forall a b. (a -> b) -> a -> b
$ Bool -> Report -> [AttrString]
renderReport Bool
True Report
report
         EnumMap DisplayFont Overlay -> m (EnumMap DisplayFont Overlay)
forall (m :: * -> *) a. Monad m => a -> m a
return (EnumMap DisplayFont Overlay -> m (EnumMap DisplayFont Overlay))
-> EnumMap DisplayFont Overlay -> m (EnumMap DisplayFont Overlay)
forall a b. (a -> b) -> a -> b
$! [(DisplayFont, Overlay)] -> EnumMap DisplayFont Overlay
forall k a. Enum k => [(k, a)] -> EnumMap k a
EM.fromList [(DisplayFont
propFont, [(Int -> Int -> PointUI
PointUI Int
0 Int
0, AttrLine
par1)])]
       | Bool
otherwise -> EnumMap DisplayFont Overlay -> m (EnumMap DisplayFont Overlay)
forall (m :: * -> *) a. Monad m => a -> m a
return EnumMap DisplayFont Overlay
forall k a. EnumMap k a
EM.empty
  ColorMode
-> Bool -> EnumMap DisplayFont Overlay -> LevelId -> m PreFrame3
forall (m :: * -> *).
MonadClientUI m =>
ColorMode
-> Bool -> EnumMap DisplayFont Overlay -> LevelId -> m PreFrame3
drawOverlay ColorMode
ColorFull Bool
False EnumMap DisplayFont Overlay
truncRep LevelId
arena

-- | Push the frame depicting the current level to the frame queue.
-- Only one line of the report is shown, as in animations,
-- because it may not be our turn, so we can't clear the message
-- to see what is underneath.
pushFrame :: MonadClientUI m => Bool -> m ()
pushFrame :: Bool -> m ()
pushFrame Bool
delay = do
  -- The delay before reaction to keypress was too long in case of many
  -- projectiles flying and ending flight, so frames need to be skipped.
  Bool
keyPressed <- m Bool
forall (m :: * -> *). MonadClientUI m => m Bool
anyKeyPressed
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
keyPressed (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    LevelId
lidV <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
viewedLevelUI
    PreFrame3
frame <- LevelId -> Maybe Bool -> m PreFrame3
forall (m :: * -> *).
MonadClientUI m =>
LevelId -> Maybe Bool -> m PreFrame3
basicFrameWithoutReport LevelId
lidV Maybe Bool
forall a. Maybe a
Nothing
    -- Pad with delay before and after to let player see, e.g., door being
    -- opened a few ticks after it came into vision, the same turn.
    LevelId -> PreFrames3 -> m ()
forall (m :: * -> *).
MonadClientUI m =>
LevelId -> PreFrames3 -> m ()
displayFrames LevelId
lidV (PreFrames3 -> m ()) -> PreFrames3 -> m ()
forall a b. (a -> b) -> a -> b
$
      if Bool
delay then [Maybe PreFrame3
forall a. Maybe a
Nothing, PreFrame3 -> Maybe PreFrame3
forall a. a -> Maybe a
Just PreFrame3
frame, Maybe PreFrame3
forall a. Maybe a
Nothing] else [PreFrame3 -> Maybe PreFrame3
forall a. a -> Maybe a
Just PreFrame3
frame]

pushReportFrame :: MonadClientUI m => m ()
pushReportFrame :: m ()
pushReportFrame = do
  LevelId
lidV <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
viewedLevelUI
  PreFrame3
frame <- LevelId -> Maybe Bool -> m PreFrame3
forall (m :: * -> *).
MonadClientUI m =>
LevelId -> Maybe Bool -> m PreFrame3
basicFrameWithoutReport LevelId
lidV (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True)
  LevelId -> PreFrames3 -> m ()
forall (m :: * -> *).
MonadClientUI m =>
LevelId -> PreFrames3 -> m ()
displayFrames LevelId
lidV [PreFrame3 -> Maybe PreFrame3
forall a. a -> Maybe a
Just PreFrame3
frame]

fadeOutOrIn :: MonadClientUI m => Bool -> m ()
fadeOutOrIn :: Bool -> m ()
fadeOutOrIn Bool
out = do
  LevelId
arena <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
getArenaUI
  CCUI{ScreenContent
coscreen :: CCUI -> ScreenContent
coscreen :: ScreenContent
coscreen} <- (SessionUI -> CCUI) -> m CCUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
  Animation
animMap <- Rnd Animation -> m Animation
forall (m :: * -> *) a. MonadClientUI m => Rnd a -> m a
rndToActionUI (Rnd Animation -> m Animation) -> Rnd Animation -> m Animation
forall a b. (a -> b) -> a -> b
$ ScreenContent -> Bool -> Int -> Rnd Animation
fadeout ScreenContent
coscreen Bool
out Int
2
  PreFrames3
animFrs <- LevelId -> Animation -> Maybe Bool -> m PreFrames3
forall (m :: * -> *).
MonadClientUI m =>
LevelId -> Animation -> Maybe Bool -> m PreFrames3
renderAnimFrames LevelId
arena Animation
animMap (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False)
  LevelId -> PreFrames3 -> m ()
forall (m :: * -> *).
MonadClientUI m =>
LevelId -> PreFrames3 -> m ()
displayFrames LevelId
arena (PreFrames3 -> PreFrames3
forall a. [a] -> [a]
tail PreFrames3
animFrs)  -- no basic frame between fadeout and in

markDisplayNeeded :: MonadClientUI m => LevelId -> m ()
markDisplayNeeded :: LevelId -> m ()
markDisplayNeeded 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
$ \SessionUI
sess -> SessionUI
sess {sdisplayNeeded :: Bool
sdisplayNeeded = Bool
True}

lookAtMove :: MonadClientUI m => ActorId -> m ()
lookAtMove :: ActorId -> m ()
lookAtMove 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 <- Point -> LevelId -> m Text
forall (m :: * -> *). MonadClientUI m => Point -> LevelId -> m Text
lookAtStash (Actor -> Point
bpos Actor
body) (Actor -> LevelId
blid Actor
body)
    (Text
itemsBlurb, Maybe Person
_) <-
      Bool
-> Point
-> LevelId
-> Maybe ActorId
-> Maybe (Part, Bool)
-> m (Text, Maybe Person)
forall (m :: * -> *).
MonadClientUI m =>
Bool
-> Point
-> LevelId
-> Maybe ActorId
-> Maybe (Part, Bool)
-> m (Text, Maybe Person)
lookAtItems Bool
True (Actor -> Point
bpos Actor
body) (Actor -> LevelId
blid Actor
body) (ActorId -> Maybe ActorId
forall a. a -> Maybe a
Just 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.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
msgClass Text
blurb

stopAtMove :: MonadClientUI m => ActorId -> m ()
stopAtMove :: ActorId -> m ()
stopAtMove ActorId
aid = do
  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
  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
$ (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
body) (EnumMap FactionId Faction -> Faction)
-> (State -> EnumMap FactionId Faction) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap FactionId Faction
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 (ActorId
_, 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 :: * -> *). 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 (ActorId
_, 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 :: * -> *). MonadClientUI m => m ()
stopPlayBack

aidVerbMU :: (MonadClientUI m, MsgShared a) => a -> ActorId -> MU.Part -> m ()
aidVerbMU :: a -> ActorId -> Part -> m ()
aidVerbMU a
msgClass ActorId
aid Part
verb = do
  Part
subject <- ActorId -> m Part
forall (m :: * -> *). MonadClientUI m => ActorId -> m Part
partActorLeader ActorId
aid
  a -> Text -> m ()
forall (m :: * -> *) a.
(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 :: (MonadClientUI m, MsgShared a)
                   => a -> ActorId -> MU.Part -> m Bool
aidVerbDuplicateMU :: a -> ActorId -> Part -> m Bool
aidVerbDuplicateMU a
msgClass ActorId
aid 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.
(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 Bool
verbose ItemId
iid kit :: ItemQuant
kit@(Int
k, ItemTimers
_) Part
verb 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
> Int
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
  EnumMap FactionId Faction
factionD <- (State -> EnumMap FactionId Faction)
-> m (EnumMap FactionId Faction)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> EnumMap FactionId Faction
sfactionD
  let arItem :: AspectRecord
arItem = ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFull
      partItemWsChosen :: Int
-> FactionId
-> EnumMap FactionId Faction
-> Int
-> Time
-> ItemFull
-> ItemQuant
-> Part
partItemWsChosen | Bool
verbose = Int
-> FactionId
-> EnumMap FactionId Faction
-> Int
-> Time
-> ItemFull
-> ItemQuant
-> Part
partItemWs
                       | Bool
otherwise = Int
-> FactionId
-> EnumMap FactionId Faction
-> Int
-> Time
-> ItemFull
-> ItemQuant
-> Part
partItemWsShort
      subject :: Part
subject = Int
-> FactionId
-> EnumMap FactionId Faction
-> Int
-> Time
-> ItemFull
-> ItemQuant
-> Part
partItemWsChosen Int
rwidth FactionId
side EnumMap FactionId Faction
factionD Int
k Time
localTime ItemFull
itemFull ItemQuant
kit
      msg :: Text
msg | Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
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 :: (MonadClientUI m, MsgShared a)
           => a -> ItemId -> ItemQuant -> MU.Part -> Container -> m ()
itemVerbMU :: a -> ItemId -> ItemQuant -> Part -> Container -> m ()
itemVerbMU a
msgClass ItemId
iid ItemQuant
kit Part
verb 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.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd a
msgClass Text
msg

itemVerbMUShort :: (MonadClientUI m, MsgShared a)
                => a -> ItemId -> ItemQuant -> MU.Part -> Container
                -> m ()
itemVerbMUShort :: a -> ItemId -> ItemQuant -> Part -> Container -> m ()
itemVerbMUShort a
msgClass ItemId
iid ItemQuant
kit Part
verb 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.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd a
msgClass Text
msg

itemAidVerbMU :: (MonadClientUI m, MsgShared a)
              => a -> ActorId -> MU.Part -> ItemId -> Either Int Int
              -> m ()
itemAidVerbMU :: a -> ActorId -> Part -> ItemId -> Either Int Int -> m ()
itemAidVerbMU a
msgClass ActorId
aid Part
verb ItemId
iid 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
  EnumMap FactionId Faction
factionD <- (State -> EnumMap FactionId Faction)
-> m (EnumMap FactionId Faction)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> EnumMap FactionId Faction
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 Int
n ->
          Int
-> FactionId
-> EnumMap FactionId Faction
-> Int
-> Time
-> ItemFull
-> ItemQuant
-> Part
partItemWs Int
rwidth FactionId
side EnumMap FactionId Faction
factionD Int
n Time
localTime ItemFull
itemFull ItemQuant
fakeKit
        Right Int
n ->
          let (Part
name1, Part
powers) =
                Int
-> FactionId
-> EnumMap FactionId Faction
-> Time
-> ItemFull
-> ItemQuant
-> (Part, Part)
partItemShort Int
rwidth FactionId
side EnumMap FactionId Faction
factionD Time
localTime ItemFull
itemFull ItemQuant
fakeKit
          in [Part] -> Part
MU.Phrase [Part
"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.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd a
msgClass Text
msg

mitemAidVerbMU :: (MonadClientUI m, MsgShared a)
               => a -> ActorId -> MU.Part -> ItemId -> Maybe MU.Part
               -> m ()
mitemAidVerbMU :: a -> ActorId -> Part -> ItemId -> Maybe Part -> m ()
mitemAidVerbMU a
msgClass ActorId
aid Part
verb ItemId
iid 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 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.
(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 Int
1)
    Maybe Part
_ -> 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
-> (String, (ActorId, Actor, ActorUI, Part, ItemId, Maybe Part))
-> Bool
forall a. Show a => Bool -> a -> Bool
`blame` String
"item never seen by the affected actor"
              String
-> (ActorId, Actor, ActorUI, Part, ItemId, Maybe Part)
-> (String, (ActorId, Actor, ActorUI, Part, ItemId, Maybe Part))
forall v. String -> v -> (String, 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.
(MonadClientUI m, MsgShared a) =>
a -> ActorId -> Part -> m ()
aidVerbMU a
msgClass ActorId
aid Part
verb

itemAidDistinctMU :: MonadClientUI m
                  => MsgClassDistinct -> ActorId -> MU.Part -> MU.Part -> ItemId
                  -> m ()
itemAidDistinctMU :: MsgClassDistinct -> ActorId -> Part -> Part -> ItemId -> m ()
itemAidDistinctMU MsgClassDistinct
msgClass ActorId
aid Part
verbShow Part
verbSave 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
  EnumMap FactionId Faction
factionD <- (State -> EnumMap FactionId Faction)
-> m (EnumMap FactionId Faction)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> EnumMap FactionId Faction
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 (Part
name, Part
powers) =
                     Int
-> FactionId
-> EnumMap FactionId Faction
-> Time
-> ItemFull
-> ItemQuant
-> (Part, Part)
partItem Int
rwidth FactionId
side EnumMap FactionId Faction
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 Text
"" else Text
".."
  MsgClassDistinct -> (Text, Text) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
MsgClassDistinct -> (Text, Text) -> m ()
msgAddDistinct MsgClassDistinct
msgClass (Text
t1 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
dotsIfShorter, Text
t2)

manyItemsAidVerbMU :: (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 a
msgClass ActorId
aid Part
verb [(ItemId, ItemQuant)]
sortedAssocs 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
  EnumMap FactionId Faction
factionD <- (State -> EnumMap FactionId Faction)
-> m (EnumMap FactionId Faction)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> EnumMap FactionId Faction
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 (ItemId
iid, (Int
k, ItemTimers
_)) =
        let itemFull :: ItemFull
itemFull = ItemId -> ItemFull
itemToF ItemId
iid
        in case Int -> Either (Maybe Int) Int
ekf Int
k of
          Left (Just Int
n) ->
            Int
-> FactionId
-> EnumMap FactionId Faction
-> Int
-> Time
-> ItemFull
-> ItemQuant
-> Part
partItemWs Int
rwidth FactionId
side EnumMap FactionId Faction
factionD Int
n Time
localTime ItemFull
itemFull ItemQuant
fakeKit
          Left Maybe Int
Nothing ->
            let (Part
name, Part
powers) =
                  Int
-> FactionId
-> EnumMap FactionId Faction
-> Time
-> ItemFull
-> ItemQuant
-> (Part, Part)
partItem Int
rwidth FactionId
side EnumMap FactionId Faction
factionD Time
localTime ItemFull
itemFull ItemQuant
fakeKit
            in [Part] -> Part
MU.Phrase [Part
name, Part
powers]
          Right Int
n ->
            let (Part
name1, Part
powers) =
                  Int
-> FactionId
-> EnumMap FactionId Faction
-> Time
-> ItemFull
-> ItemQuant
-> (Part, Part)
partItemShort Int
rwidth FactionId
side EnumMap FactionId Faction
factionD Time
localTime ItemFull
itemFull ItemQuant
fakeKit
            in [Part] -> Part
MU.Phrase [Part
"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.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd a
msgClass Text
msg