module Game.LambdaHack.Client.UI.MsgM
( msgAddDuplicate, msgAddDistinct, msgAdd, msgLnAdd
, promptMainKeys, recordHistory
) 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.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
msgAddDuplicate :: (MonadClientUI m, MsgShared a) => a -> Text -> m Bool
msgAddDuplicate :: a -> Text -> m Bool
msgAddDuplicate a
msgClass Text
t = do
UIOptions
sUIOptions <- (SessionUI -> UIOptions) -> m UIOptions
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> UIOptions
sUIOptions
Time
time <- (State -> Time) -> m Time
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> Time
stime
History
history <- (SessionUI -> History) -> m History
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> History
shistory
Bool
curTutorial <- (SessionUI -> Bool) -> m Bool
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Bool
scurTutorial
Maybe Bool
overrideTut <- (SessionUI -> Maybe Bool) -> m (Maybe Bool)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe Bool
soverrideTut
Set Msg
usedHints <- (SessionUI -> Set Msg) -> m (Set Msg)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Set Msg
susedHints
LevelId
lid <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
getArenaUI
Bool
condInMelee <- LevelId -> m Bool
forall (m :: * -> *). MonadClientRead m => LevelId -> m Bool
condInMeleeM LevelId
lid
Bool
smuteMessages <- (SessionUI -> Bool) -> m Bool
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Bool
smuteMessages
let displayHints :: Bool
displayHints = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
curTutorial Maybe Bool
overrideTut
msg :: Msg
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
(Set Msg
nusedHints, History
nhistory, Bool
duplicate) =
Set Msg
-> Bool
-> Bool
-> History
-> Msg
-> Time
-> (Set Msg, History, Bool)
addToReport Set Msg
usedHints Bool
displayHints Bool
condInMelee History
history Msg
msg Time
time
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
smuteMessages (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
(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 :: History
shistory = History
nhistory, susedHints :: Set Msg
susedHints = Set Msg
nusedHints}
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
sniffMessages (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). MonadClientUI m => Text -> m ()
clientPrintUI Text
t
Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
duplicate
msgAddDistinct :: MonadClientUI m => MsgClassDistinct -> (Text, Text) -> m ()
msgAddDistinct :: MsgClassDistinct -> (Text, Text) -> m ()
msgAddDistinct MsgClassDistinct
msgClass (Text
t1, Text
t2) = do
UIOptions
sUIOptions <- (SessionUI -> UIOptions) -> m UIOptions
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> UIOptions
sUIOptions
Time
time <- (State -> Time) -> m Time
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> Time
stime
History
history <- (SessionUI -> History) -> m History
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> History
shistory
Bool
curTutorial <- (SessionUI -> Bool) -> m Bool
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Bool
scurTutorial
Maybe Bool
overrideTut <- (SessionUI -> Maybe Bool) -> m (Maybe Bool)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe Bool
soverrideTut
Set Msg
usedHints <- (SessionUI -> Set Msg) -> m (Set Msg)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Set Msg
susedHints
LevelId
lid <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
getArenaUI
Bool
condInMelee <- LevelId -> m Bool
forall (m :: * -> *). MonadClientRead m => LevelId -> m Bool
condInMeleeM LevelId
lid
Bool
smuteMessages <- (SessionUI -> Bool) -> m Bool
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Bool
smuteMessages
let displayHints :: Bool
displayHints = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
curTutorial Maybe Bool
overrideTut
msg :: Msg
msg = [(String, Color)] -> MsgClassDistinct -> Text -> Text -> Msg
toMsgDistinct (UIOptions -> [(String, Color)]
uMessageColors UIOptions
sUIOptions) MsgClassDistinct
msgClass Text
t1 Text
t2
(Set Msg
nusedHints, History
nhistory, Bool
_) =
Set Msg
-> Bool
-> Bool
-> History
-> Msg
-> Time
-> (Set Msg, History, Bool)
addToReport Set Msg
usedHints Bool
displayHints Bool
condInMelee History
history Msg
msg Time
time
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
smuteMessages (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
(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 :: History
shistory = History
nhistory, susedHints :: Set Msg
susedHints = Set Msg
nusedHints}
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
sniffMessages (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). MonadClientUI m => Text -> m ()
clientPrintUI Text
t1
msgAdd :: (MonadClientUI m, MsgShared a) => a -> Text -> m ()
msgAdd :: 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
msgLnAdd :: (MonadClientUI m, MsgShared a) => a -> Text -> m ()
msgLnAdd :: a -> Text -> m ()
msgLnAdd a
msgClass Text
t = do
Bool
smuteMessages <- (SessionUI -> Bool) -> m Bool
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Bool
smuteMessages
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
smuteMessages (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 {shistory :: History
shistory = History -> History
addEolToNewReport (History -> History) -> History -> History
forall a b. (a -> b) -> a -> b
$ SessionUI -> History
shistory SessionUI
sess}
a -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd a
msgClass Text
t
promptMainKeys :: MonadClientUI m => m ()
promptMainKeys :: m ()
promptMainKeys = do
FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
[(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
HumanCmd -> KM
revCmd <- m (HumanCmd -> KM)
forall (m :: * -> *). MonadClientUI m => m (HumanCmd -> KM)
revCmdMap
let kmHelp :: KM
kmHelp = HumanCmd -> KM
revCmd HumanCmd
HumanCmd.Hint
kmViewStash :: KM
kmViewStash = HumanCmd -> KM
revCmd (ItemDialogMode -> HumanCmd
HumanCmd.ChooseItemMenu (CStore -> ItemDialogMode
MStore CStore
CStash))
kmItemStash :: KM
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 :: KM
kmXhairPointerFloor = HumanCmd -> KM
revCmd HumanCmd
HumanCmd.XhairPointerFloor
Maybe AimMode
saimMode <- (SessionUI -> Maybe AimMode) -> m (Maybe AimMode)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe AimMode
saimMode
UIOptions{Bool
uVi :: UIOptions -> Bool
uVi :: Bool
uVi, Bool
uLeftHand :: UIOptions -> Bool
uLeftHand :: Bool
uLeftHand} <- (SessionUI -> UIOptions) -> m UIOptions
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> UIOptions
sUIOptions
Maybe Target
xhair <- (SessionUI -> Maybe Target) -> m (Maybe Target)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe Target
sxhair
Text
miniHintAiming <- m Text
forall (m :: * -> *). MonadClientUI m => m Text
getMiniHintAiming
let moveKeys :: Text
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 :: Bool
manyTeammates = [(ActorId, Actor)] -> Int
forall a. [a] -> Int
length [(ActorId, Actor)]
ours Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1
keepTab :: Text
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 :: Text
describePos = if Bool
describeIsNormal
then Text
"Describe map position with MMB or RMB."
else Text
""
viewEquip :: Text
viewEquip = if Bool
stashKeysAreNormal
then Text
"View shared 'I'nventory stash and stash items into the 'i'nventory."
else Text
""
moreHelp :: 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 :: Bool
describeIsNormal = KM
kmXhairPointerFloor KM -> KM -> Bool
forall a. Eq a => a -> a -> Bool
== KM
K.middleButtonReleaseKM
stashKeysAreNormal :: Bool
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 :: Text
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
m () -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgPromptGeneric Text
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"
recordHistory :: MonadClientUI m => m ()
recordHistory :: 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 :: History
shistory = History -> History
archiveReport (History -> History) -> History -> History
forall a b. (a -> b) -> a -> b
$ SessionUI -> History
shistory SessionUI
sess}