module Game.LambdaHack.Client.UI.MsgClient
( msgAdd, msgReset, recordHistory
, SlideOrCmd, failWith, failSlides, failSer
, lookAt, itemOverlay
) where
import Control.Arrow (first)
import Control.Exception.Assert.Sugar
import Control.Monad
import qualified Data.EnumMap.Strict as EM
import qualified Data.IntMap.Strict as IM
import Data.Maybe
import Data.Monoid
import Data.Text (Text)
import qualified Data.Text as T
import qualified Game.LambdaHack.Common.Kind as Kind
import qualified NLP.Miniutter.English as MU
import Game.LambdaHack.Client.CommonClient
import Game.LambdaHack.Client.ItemSlot
import Game.LambdaHack.Client.MonadClient hiding (liftIO)
import Game.LambdaHack.Client.State
import Game.LambdaHack.Client.UI.Config
import Game.LambdaHack.Client.UI.MonadClientUI
import Game.LambdaHack.Client.UI.WidgetClient
import Game.LambdaHack.Common.Actor
import Game.LambdaHack.Common.ActorState
import Game.LambdaHack.Common.Item
import Game.LambdaHack.Common.ItemDescription
import Game.LambdaHack.Common.Level
import Game.LambdaHack.Common.Misc
import Game.LambdaHack.Common.MonadStateRead
import Game.LambdaHack.Common.Msg
import Game.LambdaHack.Common.Point
import Game.LambdaHack.Common.Request
import Game.LambdaHack.Common.State
import qualified Game.LambdaHack.Common.Tile as Tile
import Game.LambdaHack.Content.TileKind
msgAdd :: MonadClientUI m => Msg -> m ()
msgAdd msg = modifyClient $ \d -> d {sreport = addMsg (sreport d) msg}
msgReset :: MonadClientUI m => Msg -> m ()
msgReset msg = modifyClient $ \d -> d {sreport = singletonReport msg}
recordHistory :: MonadClientUI m => m ()
recordHistory = do
StateClient{sreport, shistory} <- getClient
unless (nullReport sreport) $ do
Config{configHistoryMax} <- askConfig
msgReset ""
let nhistory = takeHistory configHistoryMax $! addReport sreport shistory
modifyClient $ \cli -> cli {shistory = nhistory}
type SlideOrCmd a = Either Slideshow a
failWith :: MonadClientUI m => Msg -> m (SlideOrCmd a)
failWith msg = do
stopPlayBack
assert (not $ T.null msg) $ fmap Left $ promptToSlideshow msg
failSlides :: MonadClientUI m => Slideshow -> m (SlideOrCmd a)
failSlides slides = do
stopPlayBack
return $ Left slides
failSer :: MonadClientUI m => ReqFailure -> m (SlideOrCmd a)
failSer = failWith . showReqFailure
lookAt :: MonadClientUI m
=> Bool
-> Text
-> Bool
-> Point
-> ActorId
-> Text
-> m Text
lookAt detailed tilePrefix canSee pos aid msg = do
cops@Kind.COps{cotile=cotile@Kind.Ops{okind}} <- getsState scops
itemToF <- itemToFullClient
lidV <- viewedLevel
lvl <- getLevel lidV
b <- getsState $ getActorBody aid
subject <- partAidLeader aid
let is = lvl `atI` pos
verb = MU.Text $ if pos == bpos b
then "stand on"
else if canSee then "notice" else "remember"
let nWs (iid, k) = partItemWs k CGround (itemToF iid k)
isd = case detailed of
_ | EM.size is == 0 -> ""
_ | EM.size is <= 2 ->
makeSentence [ MU.SubjectVerbSg subject verb
, MU.WWandW $ map nWs $ EM.assocs is]
True -> "\n"
_ -> "Items here."
tile = lvl `at` pos
obscured | knownLsecret lvl
&& tile /= hideTile cops lvl pos = "partially obscured"
| otherwise = ""
tileText = obscured <+> tname (okind tile)
tilePart | T.null tilePrefix = MU.Text tileText
| otherwise = MU.AW $ MU.Text tileText
tileDesc = [MU.Text tilePrefix, tilePart]
if not (null (Tile.causeEffects cotile tile)) then
return $! makeSentence ("activable:" : tileDesc)
<+> msg <+> isd
else if detailed then
return $! makeSentence tileDesc
<+> msg <+> isd
else return $! msg <+> isd
itemOverlay :: MonadClient m => CStore -> ItemBag -> m Overlay
itemOverlay cstore bag = do
itemToF <- itemToFullClient
(letterSlots, numberSlots) <- getsClient sslots
let pr (l, iid) =
case EM.lookup iid bag of
Nothing -> Nothing
Just k ->
let itemFull = itemToF iid k
in Just $ makePhrase [ slotLabel l, "-"
, partItemWs k cstore itemFull ]
<> " "
return $! toOverlay $ mapMaybe pr
$ map (first Left) (EM.assocs letterSlots)
++ (map (first Right) (IM.assocs numberSlots))