-- | Common code for displaying atomic update and SFX commands.
module Game.LambdaHack.Client.UI.Watch.WatchCommonM
  ( fadeOutOrIn, markDisplayNeeded, lookAtMove, stopAtMove
  , aidVerbMU, aidVerbDuplicateMU, itemVerbMUGeneral, itemVerbMU
  , itemVerbMUShort, itemAidVerbMU, mitemAidVerbMU, itemAidDistinctMU
  , manyItemsAidVerbMU
#ifdef EXPOSE_INTERNAL
    -- * Internal operations
#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.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.SessionUI
import           Game.LambdaHack.Common.Actor
import           Game.LambdaHack.Common.ActorState
import           Game.LambdaHack.Common.Faction
import           Game.LambdaHack.Common.Item
import qualified Game.LambdaHack.Common.ItemAspect as IA
import           Game.LambdaHack.Common.Misc
import           Game.LambdaHack.Common.MonadStateRead
import           Game.LambdaHack.Common.State
import           Game.LambdaHack.Common.Types
import qualified Game.LambdaHack.Definition.Ability as Ability

fadeOutOrIn :: MonadClientUI m => Bool -> m ()
fadeOutOrIn :: forall (m :: * -> *). MonadClientUI m => Bool -> m ()
fadeOutOrIn Bool
out = do
  arena <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
getArenaUI
  CCUI{coscreen} <- getsSession sccui
  animMap <- rndToActionUI $ fadeout coscreen out 2
  animFrs <- renderAnimFrames arena animMap (Just False)
  displayFrames arena (tail animFrs)  -- no basic frame between fadeout and in

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

lookAtMove :: MonadClientUI m => ActorId -> m ()
lookAtMove :: forall (m :: * -> *). MonadClientUI m => ActorId -> m ()
lookAtMove ActorId
aid = do
  mleader <- (StateClient -> Maybe ActorId) -> m (Maybe ActorId)
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Maybe ActorId
sleader
  body <- getsState $ getActorBody aid
  side <- getsClient sside
  aimMode <- getsSession saimMode
  when (not (bproj body)
        && bfid body == side
        && isNothing aimMode) $ do  -- aiming does a more extensive look
    stashBlurb <- lookAtStash (bpos body) (blid body)
    (itemsBlurb, _) <-
      lookAtItems True (bpos body) (blid body) (Just aid) Nothing
    let 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
stashBlurb Text -> Text -> Text
<+> Text
itemsBlurb
    unless (T.null blurb) $
      msgAdd msgClass blurb

stopAtMove :: MonadClientUI m => ActorId -> m ()
stopAtMove :: forall (m :: * -> *). MonadClientUI m => ActorId -> m ()
stopAtMove ActorId
aid = do
  body <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
  side <- getsClient sside
  fact <- getsState $ (EM.! bfid body) . sfactionD
  adjBigAssocs <- getsState $ adjacentBigAssocs body
  adjProjAssocs <- getsState $ adjacentProjAssocs body
  if not (bproj body) && bfid body == side then do
    let foe (ActorId
_, Actor
b2) = FactionId -> Faction -> FactionId -> Bool
isFoe (Actor -> FactionId
bfid Actor
body) Faction
fact (Actor -> FactionId
bfid Actor
b2)
        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
    unless (null adjFoes) stopPlayBack
  else when (isFoe (bfid body) fact side) $ do
    let our (ActorId
_, Actor
b2) = Actor -> FactionId
bfid Actor
b2 FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side
        adjOur = ((ActorId, Actor) -> Bool)
-> [(ActorId, Actor)] -> [(ActorId, Actor)]
forall a. (a -> Bool) -> [a] -> [a]
filter (ActorId, Actor) -> Bool
our [(ActorId, Actor)]
adjBigAssocs
    unless (null adjOur) stopPlayBack

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

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

itemVerbMUGeneral :: MonadClientUI m
                  => Bool -> ItemId -> ItemQuant -> MU.Part -> Container
                  -> m Text
itemVerbMUGeneral :: forall (m :: * -> *).
MonadClientUI m =>
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. HasCallStack => 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=ScreenContent{rwidth}} <- (SessionUI -> CCUI) -> m CCUI
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
  lid <- getsState $ lidFromC c
  localTime <- getsState $ getLocalTime lid
  itemFull <- getsState $ itemToFull iid
  side <- getsClient sside
  factionD <- getsState sfactionD
  let arItem = ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFull
      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 = 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 | 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]
  return $! msg

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

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

itemAidVerbMU :: (MonadClientUI m, MsgShared a)
              => a -> ActorId -> MU.Part -> ItemId -> Either Int Int
              -> m ()
itemAidVerbMU :: forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> ActorId -> Part -> ItemId -> Either Int Int -> m ()
itemAidVerbMU a
msgClass ActorId
aid Part
verb ItemId
iid Either Int Int
ek = do
  CCUI{coscreen=ScreenContent{rwidth}} <- (SessionUI -> CCUI) -> m CCUI
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
  body <- getsState $ getActorBody aid
  side <- getsClient sside
  factionD <- getsState sfactionD
  let lid = Actor -> LevelId
blid Actor
body
      fakeKit = ItemQuant
quantSingle
  localTime <- getsState $ getLocalTime lid
  subject <- partActorLeader aid
  -- The item may no longer be in @c@, but it was.
  itemFull <- getsState $ itemToFull iid
  let 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 = [Part] -> Text
makeSentence [Part -> Part -> Part
MU.SubjectVerbSg Part
subject Part
verb, Part
object]
  msgAdd msgClass msg

mitemAidVerbMU :: (MonadClientUI m, MsgShared a)
               => a -> ActorId -> MU.Part -> ItemId -> Maybe MU.Part
               -> m ()
mitemAidVerbMU :: forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> ActorId -> Part -> ItemId -> Maybe Part -> m ()
mitemAidVerbMU a
msgClass ActorId
aid Part
verb ItemId
iid Maybe Part
msuffix = do
  itemD <- (State -> ItemDict) -> m ItemDict
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> ItemDict
sitemD
  case 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
      side <- getsClient sside
      b <- getsState $ getActorBody aid
      bUI <- getsSession $ getActorUI 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.
      assert (isNothing msuffix  -- item description not requested
              || bfid b /= side  -- not from affected faction; only observing
              `blame` "item never seen by the affected actor"
              `swith` (aid, b, bUI, verb, iid, msuffix)) $
#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 :: forall (m :: * -> *).
MonadClientUI m =>
MsgClassDistinct -> ActorId -> Part -> Part -> ItemId -> m ()
itemAidDistinctMU MsgClassDistinct
msgClass ActorId
aid Part
verbShow Part
verbSave ItemId
iid = do
  CCUI{coscreen=ScreenContent{rwidth}} <- (SessionUI -> CCUI) -> m CCUI
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
  body <- getsState $ getActorBody aid
  side <- getsClient sside
  factionD <- getsState sfactionD
  let lid = Actor -> LevelId
blid Actor
body
      fakeKit = ItemQuant
quantSingle
  localTime <- getsState $ getLocalTime lid
  subject <- partActorLeader aid
  -- The item may no longer be in @c@, but it was.
  itemFull <- getsState $ itemToFull iid
  let 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 = [Part] -> Text
makeSentence [Part -> Part -> Part
MU.SubjectVerbSg Part
subject Part
verbShow, Part
object]
      t2 = [Part] -> Text
makeSentence [Part -> Part -> Part
MU.SubjectVerbSg Part
subject Part
verbSave, Part
object]
      dotsIfShorter = if Text
t1 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
t2 then Text
"" else Text
".."
  msgAddDistinct msgClass (t1 <> dotsIfShorter, t2)

manyItemsAidVerbMU :: (MonadClientUI m, MsgShared a)
                   => a -> ActorId -> MU.Part
                   -> [(ItemId, ItemQuant)] -> (Int -> Either (Maybe Int) Int)
                   -> m ()
manyItemsAidVerbMU :: forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
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=ScreenContent{rwidth}} <- (SessionUI -> CCUI) -> m CCUI
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
  body <- getsState $ getActorBody aid
  side <- getsClient sside
  factionD <- getsState sfactionD
  let lid = Actor -> LevelId
blid Actor
body
      fakeKit = ItemQuant
quantSingle
  localTime <- getsState $ getLocalTime lid
  subject <- partActorLeader aid
  -- The item may no longer be in @c@, but it was.
  itemToF <- getsState $ flip itemToFull
  let 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 = [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]
  msgAdd msgClass msg