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
, 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
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
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
pushFrame :: MonadClientUI m => Bool -> m ()
pushFrame :: Bool -> m ()
pushFrame Bool
delay = do
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
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)
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
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
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
Bool -> m () -> m ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Maybe Part -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Part
msuffix
Bool -> Bool -> Bool
|| Actor -> FactionId
bfid Actor
b FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
/= FactionId
side
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
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
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