-- | Monadic operations on game messages.
module Game.LambdaHack.Client.UI.MsgM
  ( msgAddDuplicate, msgAddDistinct, msgAdd, msgLnAdd
  , promptMainKeys, recordHistory, tutorialHintMsgAdd
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import           Game.LambdaHack.Client.MonadClient
import           Game.LambdaHack.Client.State
import qualified Game.LambdaHack.Client.UI.HumanCmd as HumanCmd
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.SessionUI
import           Game.LambdaHack.Client.UI.TutorialHints
  (TutorialHints, renderTutorialHints)
import           Game.LambdaHack.Client.UI.UIOptions
import           Game.LambdaHack.Common.ActorState
import           Game.LambdaHack.Common.MonadStateRead
import           Game.LambdaHack.Common.State
import           Game.LambdaHack.Definition.Defs

sniffMessages :: Bool
sniffMessages :: Bool
sniffMessages = Bool
False

-- | Add a shared message to the current report. Say if it was a duplicate.
msgAddDuplicate :: (MonadClientUI m, MsgShared a) => a -> Text -> m Bool
msgAddDuplicate :: forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m Bool
msgAddDuplicate a
msgClass Text
t = do
  sUIOptions <- (SessionUI -> UIOptions) -> m UIOptions
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> UIOptions
sUIOptions
  time <- getsState stime
  history <- getsSession shistory
  curTutorial <- getsSession scurTutorial
  overrideTut <- getsSession soverrideTut
  usedHints <- getsSession susedHints
  lid <- getArenaUI
  condInMelee <- condInMeleeM lid
  smuteMessages <- getsSession smuteMessages
  let displayHints = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
curTutorial Maybe Bool
overrideTut
      msg = [(String, Color)] -> a -> Text -> Msg
forall a. MsgShared a => [(String, Color)] -> a -> Text -> Msg
toMsgShared (UIOptions -> [(String, Color)]
uMessageColors UIOptions
sUIOptions) a
msgClass Text
t
      (nusedHints, nhistory, duplicate) =
        addToReport usedHints displayHints condInMelee history msg time
  unless smuteMessages $ do
    modifySession $ \SessionUI
sess -> SessionUI
sess {shistory = nhistory, susedHints = nusedHints}
    when sniffMessages $ clientPrintUI t
  return duplicate

-- | Add a message comprising of two different texts, one to show, the other
-- to save to messages log, to the current report.
msgAddDistinct :: MonadClientUI m => MsgClassDistinct -> (Text, Text) -> m ()
msgAddDistinct :: forall (m :: * -> *).
MonadClientUI m =>
MsgClassDistinct -> (Text, Text) -> m ()
msgAddDistinct MsgClassDistinct
msgClass (Text
t1, Text
t2) = do
  sUIOptions <- (SessionUI -> UIOptions) -> m UIOptions
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> UIOptions
sUIOptions
  time <- getsState stime
  history <- getsSession shistory
  curTutorial <- getsSession scurTutorial
  overrideTut <- getsSession soverrideTut
  usedHints <- getsSession susedHints
  lid <- getArenaUI
  condInMelee <- condInMeleeM lid
  smuteMessages <- getsSession smuteMessages
  let displayHints = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
curTutorial Maybe Bool
overrideTut
      msg = [(String, Color)] -> MsgClassDistinct -> Text -> Text -> Msg
toMsgDistinct (UIOptions -> [(String, Color)]
uMessageColors UIOptions
sUIOptions) MsgClassDistinct
msgClass Text
t1 Text
t2
      (nusedHints, nhistory, _) =
        addToReport usedHints displayHints condInMelee history msg time
  unless smuteMessages $ do
    modifySession $ \SessionUI
sess -> SessionUI
sess {shistory = nhistory, susedHints = nusedHints}
    when sniffMessages $ clientPrintUI t1

-- | Add a message to the current report.
msgAdd :: (MonadClientUI m, MsgShared a) => a -> Text -> m ()
msgAdd :: forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd a
msgClass Text
t = 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
$ a -> Text -> m Bool
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m Bool
msgAddDuplicate a
msgClass Text
t

-- | Add a tutorial hint message to the current report.
tutorialHintMsgAdd :: MonadClientUI m => TutorialHints -> m ()
tutorialHintMsgAdd :: forall (m :: * -> *). MonadClientUI m => TutorialHints -> m ()
tutorialHintMsgAdd = MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
MsgTutorialHint (Text -> m ()) -> (TutorialHints -> Text) -> TutorialHints -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TutorialHints -> Text
renderTutorialHints

-- | Add a message to the current report. End previously collected report,
-- if any, with newline.
msgLnAdd :: (MonadClientUI m, MsgShared a) => a -> Text -> m ()
msgLnAdd :: forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgLnAdd a
msgClass Text
t = do
  smuteMessages <- (SessionUI -> Bool) -> m Bool
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Bool
smuteMessages
  unless smuteMessages $
    modifySession $ \SessionUI
sess -> SessionUI
sess {shistory = addEolToNewReport $ shistory sess}
  msgAdd msgClass t

-- | Add a prompt with basic keys description.
promptMainKeys :: MonadClientUI m => m ()
promptMainKeys :: forall (m :: * -> *). MonadClientUI m => m ()
promptMainKeys = do
  side <- (StateClient -> FactionId) -> m FactionId
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
  ours <- getsState $ fidActorNotProjGlobalAssocs side
  revCmd <- revCmdMap
  let kmHelp = HumanCmd -> KM
revCmd HumanCmd
HumanCmd.Hint
      kmViewStash = HumanCmd -> KM
revCmd (ItemDialogMode -> HumanCmd
HumanCmd.ChooseItemMenu (CStore -> ItemDialogMode
MStore CStore
CStash))
      kmItemStash = HumanCmd -> KM
revCmd ([CStore] -> CStore -> Maybe Text -> Bool -> HumanCmd
HumanCmd.MoveItem [CStore
CGround, CStore
CEqp] CStore
CStash
                                              Maybe Text
forall a. Maybe a
Nothing Bool
False)
      kmXhairPointerFloor = HumanCmd -> KM
revCmd HumanCmd
HumanCmd.XhairPointerFloor
  saimMode <- getsSession saimMode
  UIOptions{uVi, uLeftHand} <- getsSession sUIOptions
  xhair <- getsSession sxhair
  miniHintAiming <- getMiniHintAiming
  -- The silly "axwdqezc" name of keys is chosen to match "hjklyubn",
  -- which the usual way of writing them.
  let moveKeys | Bool
uVi Bool -> Bool -> Bool
&& Bool
uLeftHand = Text
"keypad or axwdqezc or hjklyubn"
               | Bool
uLeftHand = Text
"keypad or axwdqezc"
               | Bool
uVi = Text
"keypad or hjklyubn"
               | Bool
otherwise = Text
"keypad"
      manyTeammates = [(ActorId, Actor)] -> Int
forall a. [a] -> Int
length [(ActorId, Actor)]
ours Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1
      -- @Tab@ here is not a button, which we would write consistently
      -- as @TAB@, just as in our internal in-game key naming, but a key name
      -- as written on the keyboard, hence most useful to a newbie.
      keepTab = if Bool
manyTeammates
                then Text
"Switch to another teammate with Tab, while all others auto-melee foes, if adjacent, but normally don't chase them."
                else Text
""
      describePos = if Bool
describeIsNormal
                    then Text
"Describe map position with MMB or RMB."
                    else Text
""
      viewEquip = if Bool
stashKeysAreNormal
                  then Text
"View shared 'I'nventory stash and stash items into the 'i'nventory."
                  else Text
""
      moreHelp = Text
"Press '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> KM -> Text
forall a. Show a => a -> Text
tshow KM
kmHelp Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' for more help."
      describeIsNormal = KM
kmXhairPointerFloor KM -> KM -> Bool
forall a. Eq a => a -> a -> Bool
== KM
K.middleButtonReleaseKM
      stashKeysAreNormal = KM
kmViewStash KM -> KM -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> KM
K.mkChar Char
'I'
                           Bool -> Bool -> Bool
&& KM
kmItemStash KM -> KM -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> KM
K.mkChar Char
'i'
      keys | Maybe AimMode -> Bool
forall a. Maybe a -> Bool
isNothing Maybe AimMode
saimMode =
        Text
"Explore with" Text -> Text -> Text
<+> Text
moveKeys Text -> Text -> Text
<+> Text
"or mouse."
        Text -> Text -> Text
<+> Text
describePos
        Text -> Text -> Text
<+> Text
viewEquip
        Text -> Text -> Text
<+> Text
keepTab
        Text -> Text -> Text
<+> Text
moreHelp
           | Bool
otherwise =
        Text
miniHintAiming
        Text -> Text -> Text
<+> Maybe Target -> Text
tgtKindVerb Maybe Target
xhair
        Text -> Text -> Text
<+> Text
"with" Text -> Text -> Text
<+> Text
moveKeys Text -> Text -> Text
<+> Text
"keys or mouse."
        Text -> Text -> Text
<+> Text
keepTab
        Text -> Text -> Text
<+> Text
moreHelp
  void $ msgAdd MsgPromptGeneric keys

tgtKindVerb :: Maybe Target -> Text
tgtKindVerb :: Maybe Target -> Text
tgtKindVerb Maybe Target
mtgt = case Maybe Target
mtgt of
  Just TEnemy{} -> Text
"Aim at enemy"
  Just TNonEnemy{} -> Text
"Aim at non-enemy"
  Just TPoint{} -> Text
"Aim at position"
  Just TVector{} -> Text
"Indicate a move vector"
  Maybe Target
Nothing -> Text
"Start aiming"

-- | Store new report in the history and archive old report.
recordHistory :: MonadClientUI m => m ()
recordHistory :: forall (m :: * -> *). MonadClientUI m => m ()
recordHistory =
  (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 {shistory = archiveReport $ shistory sess}