-- | Helper functions for both inventory management and human commands.
module Game.LambdaHack.Client.UI.HandleHelperM
  ( FailError, showFailError, MError, mergeMError, FailOrCmd, failWith
  , failSer, failMsg, weaveJust
  , pointmanCycle, pointmanCycleLevel, partyAfterLeader
  , pickLeader, doLook, pickLeaderWithPointer
  , itemOverlay, skillsOverlay, placesFromState, placesOverlay
  , factionsFromState, factionsOverlay
  , describeMode, modesOverlay
  , pickNumber, guardItemSize, lookAtItems, lookAtStash, lookAtPosition
  , displayOneMenuItem, okxItemLoreInline, okxItemLoreMsg, itemDescOverlays
  , cycleLore, spoilsBlurb, ppContainerWownW, nxtGameMode
#ifdef EXPOSE_INTERNAL
    -- * Internal operations
  , itemOverlayFromState, lookAtTile, lookAtActors, guardItemVerbs
#endif
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import           Control.Applicative
import qualified Data.Char as Char
import qualified Data.EnumMap.Strict as EM
import qualified Data.EnumSet as ES
import qualified Data.Map.Strict as M
import qualified Data.Text as T
import qualified NLP.Miniutter.English as MU

import           Game.LambdaHack.Client.CommonM
import           Game.LambdaHack.Client.MonadClient
import           Game.LambdaHack.Client.State
import           Game.LambdaHack.Client.UI.ActorUI
import           Game.LambdaHack.Client.UI.Content.Screen
import           Game.LambdaHack.Client.UI.ContentClientUI
import           Game.LambdaHack.Client.UI.EffectDescription
import           Game.LambdaHack.Client.UI.Frame
import           Game.LambdaHack.Client.UI.ItemDescription
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.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 qualified Game.LambdaHack.Common.HighScore as HighScore
import           Game.LambdaHack.Common.Item
import qualified Game.LambdaHack.Common.ItemAspect as IA
import           Game.LambdaHack.Common.Kind
import           Game.LambdaHack.Common.Level
import           Game.LambdaHack.Common.Misc
import           Game.LambdaHack.Common.MonadStateRead
import           Game.LambdaHack.Common.Perception
import           Game.LambdaHack.Common.Point
import           Game.LambdaHack.Common.ReqFailure
import           Game.LambdaHack.Common.State
import           Game.LambdaHack.Common.Time
import           Game.LambdaHack.Common.Types
import qualified Game.LambdaHack.Content.FactionKind as FK
import qualified Game.LambdaHack.Content.ItemKind as IK
import qualified Game.LambdaHack.Content.ModeKind as MK
import qualified Game.LambdaHack.Content.PlaceKind as PK
import qualified Game.LambdaHack.Content.TileKind as TK
import qualified Game.LambdaHack.Definition.Ability as Ability
import qualified Game.LambdaHack.Definition.Color as Color
import           Game.LambdaHack.Definition.Defs

-- | Message describing the cause of failure of human command.
newtype FailError = FailError {FailError -> Text
failError :: Text}
  deriving (Int -> FailError -> ShowS
[FailError] -> ShowS
FailError -> String
(Int -> FailError -> ShowS)
-> (FailError -> String)
-> ([FailError] -> ShowS)
-> Show FailError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FailError] -> ShowS
$cshowList :: [FailError] -> ShowS
show :: FailError -> String
$cshow :: FailError -> String
showsPrec :: Int -> FailError -> ShowS
$cshowsPrec :: Int -> FailError -> ShowS
Show, FailError -> FailError -> Bool
(FailError -> FailError -> Bool)
-> (FailError -> FailError -> Bool) -> Eq FailError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FailError -> FailError -> Bool
$c/= :: FailError -> FailError -> Bool
== :: FailError -> FailError -> Bool
$c== :: FailError -> FailError -> Bool
Eq)

showFailError :: FailError -> Text
showFailError :: FailError -> Text
showFailError (FailError Text
err) = Text
"*" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
err Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"*"

type MError = Maybe FailError

mergeMError :: MError -> MError -> MError
mergeMError :: MError -> MError -> MError
mergeMError MError
Nothing MError
Nothing = MError
forall a. Maybe a
Nothing
mergeMError merr1 :: MError
merr1@Just{} MError
Nothing = MError
merr1
mergeMError MError
Nothing merr2 :: MError
merr2@Just{} = MError
merr2
mergeMError (Just FailError
err1) (Just FailError
err2) =
  FailError -> MError
forall a. a -> Maybe a
Just (FailError -> MError) -> FailError -> MError
forall a b. (a -> b) -> a -> b
$ Text -> FailError
FailError (Text -> FailError) -> Text -> FailError
forall a b. (a -> b) -> a -> b
$ FailError -> Text
failError FailError
err1 Text -> Text -> Text
<+> Text
"and" Text -> Text -> Text
<+> FailError -> Text
failError FailError
err2

type FailOrCmd a = Either FailError a

failWith :: MonadClientUI m => Text -> m (FailOrCmd a)
failWith :: Text -> m (FailOrCmd a)
failWith Text
err = Bool -> m (FailOrCmd a) -> m (FailOrCmd a)
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Bool
T.null Text
err) (m (FailOrCmd a) -> m (FailOrCmd a))
-> m (FailOrCmd a) -> m (FailOrCmd a)
forall a b. (a -> b) -> a -> b
$ FailOrCmd a -> m (FailOrCmd a)
forall (m :: * -> *) a. Monad m => a -> m a
return (FailOrCmd a -> m (FailOrCmd a)) -> FailOrCmd a -> m (FailOrCmd a)
forall a b. (a -> b) -> a -> b
$ FailError -> FailOrCmd a
forall a b. a -> Either a b
Left (FailError -> FailOrCmd a) -> FailError -> FailOrCmd a
forall a b. (a -> b) -> a -> b
$ Text -> FailError
FailError Text
err

failSer :: MonadClientUI m => ReqFailure -> m (FailOrCmd a)
failSer :: ReqFailure -> m (FailOrCmd a)
failSer = Text -> m (FailOrCmd a)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith (Text -> m (FailOrCmd a))
-> (ReqFailure -> Text) -> ReqFailure -> m (FailOrCmd a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReqFailure -> Text
showReqFailure

failMsg :: MonadClientUI m => Text -> m MError
failMsg :: Text -> m MError
failMsg Text
err = Bool -> m MError -> m MError
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Bool
T.null Text
err) (m MError -> m MError) -> m MError -> m MError
forall a b. (a -> b) -> a -> b
$ MError -> m MError
forall (m :: * -> *) a. Monad m => a -> m a
return (MError -> m MError) -> MError -> m MError
forall a b. (a -> b) -> a -> b
$ FailError -> MError
forall a. a -> Maybe a
Just (FailError -> MError) -> FailError -> MError
forall a b. (a -> b) -> a -> b
$ Text -> FailError
FailError Text
err

weaveJust :: FailOrCmd a -> Either MError a
weaveJust :: FailOrCmd a -> Either MError a
weaveJust (Left FailError
ferr) = MError -> Either MError a
forall a b. a -> Either a b
Left (MError -> Either MError a) -> MError -> Either MError a
forall a b. (a -> b) -> a -> b
$ FailError -> MError
forall a. a -> Maybe a
Just FailError
ferr
weaveJust (Right a
a) = a -> Either MError a
forall a b. b -> Either a b
Right a
a

-- | Switches current pointman to the next on the level, if any, wrapping.
pointmanCycleLevel :: MonadClientUI m
                   => ActorId -> Bool -> Direction -> m MError
pointmanCycleLevel :: ActorId -> Bool -> Direction -> m MError
pointmanCycleLevel ActorId
leader Bool
verbose Direction
direction = do
  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
  LevelId
lidV <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
viewedLevelUI
  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
leader
  [(ActorId, Actor, ActorUI)]
hs <- ActorId -> m [(ActorId, Actor, ActorUI)]
forall (m :: * -> *).
MonadClientUI m =>
ActorId -> m [(ActorId, Actor, ActorUI)]
partyAfterLeader ActorId
leader
  let banned :: Bool
banned = Faction -> Bool
bannedPointmanSwitchBetweenLevels Faction
fact
      hsSort :: [(ActorId, Actor, ActorUI)]
hsSort = case Direction
direction of
        Direction
Forward -> [(ActorId, Actor, ActorUI)]
hs
        Direction
Backward -> [(ActorId, Actor, ActorUI)] -> [(ActorId, Actor, ActorUI)]
forall a. [a] -> [a]
reverse [(ActorId, Actor, ActorUI)]
hs
  case ((ActorId, Actor, ActorUI) -> Bool)
-> [(ActorId, Actor, ActorUI)] -> [(ActorId, Actor, ActorUI)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(ActorId
_, Actor
b, ActorUI
_) -> Actor -> LevelId
blid Actor
b LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== LevelId
lidV) [(ActorId, Actor, ActorUI)]
hsSort of
    [(ActorId, Actor, ActorUI)]
_ | Bool
banned Bool -> Bool -> Bool
&& LevelId
lidV LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
/= Actor -> LevelId
blid Actor
body ->
      Text -> m MError
forall (m :: * -> *). MonadClientUI m => Text -> m MError
failMsg (Text -> m MError) -> Text -> m MError
forall a b. (a -> b) -> a -> b
$ ReqFailure -> Text
showReqFailure ReqFailure
NoChangeDunLeader
    [] -> Text -> m MError
forall (m :: * -> *). MonadClientUI m => Text -> m MError
failMsg Text
"cannot pick any other pointman on this level"
    (ActorId
np, Actor
b, ActorUI
_) : [(ActorId, Actor, ActorUI)]
_ -> do
      Bool
success <- Bool -> ActorId -> m Bool
forall (m :: * -> *). MonadClientUI m => Bool -> ActorId -> m Bool
pickLeader Bool
verbose ActorId
np
      let !_A :: ()
_A = Bool -> () -> ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Bool
success Bool -> (String, (ActorId, ActorId, Actor)) -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` String
"same leader"
                                String
-> (ActorId, ActorId, Actor) -> (String, (ActorId, ActorId, Actor))
forall v. String -> v -> (String, v)
`swith` (ActorId
leader, ActorId
np, Actor
b)) ()
      MError -> m MError
forall (m :: * -> *) a. Monad m => a -> m a
return MError
forall a. Maybe a
Nothing

-- | Switches current pointman to the previous in the whole dungeon, wrapping.
pointmanCycle :: MonadClientUI m
              => ActorId -> Bool -> Direction -> m MError
pointmanCycle :: ActorId -> Bool -> Direction -> m MError
pointmanCycle ActorId
leader Bool
verbose Direction
direction = do
  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
  [(ActorId, Actor, ActorUI)]
hs <- ActorId -> m [(ActorId, Actor, ActorUI)]
forall (m :: * -> *).
MonadClientUI m =>
ActorId -> m [(ActorId, Actor, ActorUI)]
partyAfterLeader ActorId
leader
  let banned :: Bool
banned = Faction -> Bool
bannedPointmanSwitchBetweenLevels Faction
fact
      hsSort :: [(ActorId, Actor, ActorUI)]
hsSort = case Direction
direction of
        Direction
Forward -> [(ActorId, Actor, ActorUI)]
hs
        Direction
Backward -> [(ActorId, Actor, ActorUI)] -> [(ActorId, Actor, ActorUI)]
forall a. [a] -> [a]
reverse [(ActorId, Actor, ActorUI)]
hs
  case [(ActorId, Actor, ActorUI)]
hsSort of
    [(ActorId, Actor, ActorUI)]
_ | Bool
banned -> Text -> m MError
forall (m :: * -> *). MonadClientUI m => Text -> m MError
failMsg (Text -> m MError) -> Text -> m MError
forall a b. (a -> b) -> a -> b
$ ReqFailure -> Text
showReqFailure ReqFailure
NoChangeDunLeader
    [] -> Text -> m MError
forall (m :: * -> *). MonadClientUI m => Text -> m MError
failMsg Text
"no other member in the party"
    (ActorId
np, Actor
b, ActorUI
_) : [(ActorId, Actor, ActorUI)]
_ -> do
      Bool
success <- Bool -> ActorId -> m Bool
forall (m :: * -> *). MonadClientUI m => Bool -> ActorId -> m Bool
pickLeader Bool
verbose ActorId
np
      let !_A :: ()
_A = Bool -> () -> ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Bool
success Bool -> (String, (ActorId, ActorId, Actor)) -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` String
"same leader"
                                String
-> (ActorId, ActorId, Actor) -> (String, (ActorId, ActorId, Actor))
forall v. String -> v -> (String, v)
`swith` (ActorId
leader, ActorId
np, Actor
b)) ()
      MError -> m MError
forall (m :: * -> *) a. Monad m => a -> m a
return MError
forall a. Maybe a
Nothing

partyAfterLeader :: MonadClientUI m => ActorId -> m [(ActorId, Actor, ActorUI)]
partyAfterLeader :: ActorId -> m [(ActorId, Actor, ActorUI)]
partyAfterLeader ActorId
leader = do
  FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
  ActorDictUI
sactorUI <- (SessionUI -> ActorDictUI) -> m ActorDictUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> ActorDictUI
sactorUI
  [(ActorId, Actor)]
allOurs <- (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 -- not only on level
  let allOursUI :: [(ActorId, Actor, ActorUI)]
allOursUI = ((ActorId, Actor) -> (ActorId, Actor, ActorUI))
-> [(ActorId, Actor)] -> [(ActorId, Actor, ActorUI)]
forall a b. (a -> b) -> [a] -> [b]
map (\(ActorId
aid, Actor
b) -> (ActorId
aid, Actor
b, ActorDictUI
sactorUI ActorDictUI -> ActorId -> ActorUI
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ActorId
aid)) [(ActorId, Actor)]
allOurs
      hs :: [(ActorId, Actor, ActorUI)]
hs = ((ActorId, Actor, ActorUI)
 -> (Bool, Bool, Bool, Char, Color, ActorId))
-> [(ActorId, Actor, ActorUI)] -> [(ActorId, Actor, ActorUI)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (ActorId, Actor, ActorUI)
-> (Bool, Bool, Bool, Char, Color, ActorId)
keySelected [(ActorId, Actor, ActorUI)]
allOursUI
      i :: Int
i = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe (-Int
1) (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ ((ActorId, Actor, ActorUI) -> Bool)
-> [(ActorId, Actor, ActorUI)] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex (\(ActorId
aid, Actor
_, ActorUI
_) -> ActorId
aid ActorId -> ActorId -> Bool
forall a. Eq a => a -> a -> Bool
== ActorId
leader) [(ActorId, Actor, ActorUI)]
hs
      ([(ActorId, Actor, ActorUI)]
lt, [(ActorId, Actor, ActorUI)]
gt) = (Int -> [(ActorId, Actor, ActorUI)] -> [(ActorId, Actor, ActorUI)]
forall a. Int -> [a] -> [a]
take Int
i [(ActorId, Actor, ActorUI)]
hs, Int -> [(ActorId, Actor, ActorUI)] -> [(ActorId, Actor, ActorUI)]
forall a. Int -> [a] -> [a]
drop (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [(ActorId, Actor, ActorUI)]
hs)
  [(ActorId, Actor, ActorUI)] -> m [(ActorId, Actor, ActorUI)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(ActorId, Actor, ActorUI)] -> m [(ActorId, Actor, ActorUI)])
-> [(ActorId, Actor, ActorUI)] -> m [(ActorId, Actor, ActorUI)]
forall a b. (a -> b) -> a -> b
$! [(ActorId, Actor, ActorUI)]
gt [(ActorId, Actor, ActorUI)]
-> [(ActorId, Actor, ActorUI)] -> [(ActorId, Actor, ActorUI)]
forall a. [a] -> [a] -> [a]
++ [(ActorId, Actor, ActorUI)]
lt

-- | Select a faction leader. False, if nothing to do.
pickLeader :: MonadClientUI m => Bool -> ActorId -> m Bool
pickLeader :: Bool -> ActorId -> m Bool
pickLeader Bool
verbose 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
  if Maybe ActorId
mleader Maybe ActorId -> Maybe ActorId -> Bool
forall a. Eq a => a -> a -> Bool
== ActorId -> Maybe ActorId
forall a. a -> Maybe a
Just ActorId
aid
    then Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False -- already picked
    else 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
      ActorUI
bodyUI <- (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
      let !_A :: ()
_A = Bool -> () -> ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Bool -> Bool
not (Actor -> Bool
bproj Actor
body)
                        Bool -> (String, (ActorId, Actor)) -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` String
"projectile chosen as the pointman"
                        String -> (ActorId, Actor) -> (String, (ActorId, Actor))
forall v. String -> v -> (String, v)
`swith` (ActorId
aid, Actor
body)) ()
      -- Even if it's already the leader, give his proper name, not 'you'.
      let subject :: Part
subject = ActorUI -> Part
partActor ActorUI
bodyUI
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
verbose (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
MsgPointmanSwap (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ [Part] -> Text
makeSentence [Part
subject, Part
"picked as a pointman"]
      -- Update client state.
      ActorId -> m ()
forall (m :: * -> *). MonadClientUI m => ActorId -> m ()
updateClientLeader ActorId
aid
      -- Move the xhair, if active, to the new level.
      (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 {saimMode :: Maybe AimMode
saimMode =
        (\AimMode
aimMode -> AimMode
aimMode {aimLevelId :: LevelId
aimLevelId = Actor -> LevelId
blid Actor
body}) (AimMode -> AimMode) -> Maybe AimMode -> Maybe AimMode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SessionUI -> Maybe AimMode
saimMode SessionUI
sess}
      -- Inform about items, etc.
      Maybe AimMode
saimMode <- (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
verbose (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
        if Maybe AimMode -> Bool
forall a. Maybe a -> Bool
isJust Maybe AimMode
saimMode
        then m ()
forall (m :: * -> *). MonadClientUI m => m ()
doLook
        else do
          (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
          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)
          MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
MsgAtFeetMinor (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
stashBlurb Text -> Text -> Text
<+> Text
itemsBlurb
      Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True

-- | Perform look around in the current position of the xhair.
-- Does nothing outside aiming mode.
doLook :: MonadClientUI m => m ()
doLook :: m ()
doLook = do
  Maybe AimMode
saimMode <- (SessionUI -> Maybe AimMode) -> m (Maybe AimMode)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe AimMode
saimMode
  case Maybe AimMode
saimMode of
    Just AimMode
aimMode -> do
      let lidV :: LevelId
lidV = AimMode -> LevelId
aimLevelId AimMode
aimMode
      Maybe Point
mxhairPos <- m (Maybe Point)
forall (m :: * -> *). MonadClientUI m => m (Maybe Point)
mxhairToPos
      Point
xhairPos <- m Point
forall (m :: * -> *). MonadClientUI m => m Point
xhairToPos
      [(MsgClassShow, Text)]
blurb <- Point -> LevelId -> m [(MsgClassShow, Text)]
forall (m :: * -> *).
MonadClientUI m =>
Point -> LevelId -> m [(MsgClassShow, Text)]
lookAtPosition Point
xhairPos LevelId
lidV
      Maybe (ItemId, CStore, Bool)
itemSel <- (SessionUI -> Maybe (ItemId, CStore, Bool))
-> m (Maybe (ItemId, CStore, Bool))
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe (ItemId, CStore, Bool)
sitemSel
      Maybe ActorId
mleader <- (StateClient -> Maybe ActorId) -> m (Maybe ActorId)
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Maybe ActorId
sleader
      [(MsgClassShow, Text)]
outOfRangeBlurb <- case (Maybe (ItemId, CStore, Bool)
itemSel, Maybe Point
mxhairPos, Maybe ActorId
mleader) of
        (Just (ItemId
iid, CStore
_, Bool
_), Just Point
pos, Just ActorId
leader) -> do
          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
leader
          if LevelId
lidV LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
/= Actor -> LevelId
blid Actor
b  -- no range warnings on remote levels
             Bool -> Bool -> Bool
|| AimMode -> DetailLevel
detailLevel AimMode
aimMode DetailLevel -> DetailLevel -> Bool
forall a. Ord a => a -> a -> Bool
< DetailLevel
DetailAll  -- no spam
          then [(MsgClassShow, Text)] -> m [(MsgClassShow, Text)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
          else do
            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 arItem :: AspectRecord
arItem = ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFull
            [(MsgClassShow, Text)] -> m [(MsgClassShow, Text)]
forall (m :: * -> *) a. Monad m => a -> m a
return [ (MsgClassShow
MsgPromptGeneric, Text
"This position is out of range when flinging the selected item.")
                   | Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ AspectRecord -> ItemKind -> Int
IA.totalRange AspectRecord
arItem (ItemFull -> ItemKind
itemKind ItemFull
itemFull)
                     Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Point -> Point -> Int
chessDist (Actor -> Point
bpos Actor
b) Point
pos ]
        (Maybe (ItemId, CStore, Bool), Maybe Point, Maybe ActorId)
_ -> [(MsgClassShow, Text)] -> m [(MsgClassShow, Text)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
      ((MsgClassShow, Text) -> m ()) -> [(MsgClassShow, Text)] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
mapM_ ((MsgClassShow -> Text -> m ()) -> (MsgClassShow, Text) -> m ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd) ([(MsgClassShow, Text)] -> m ()) -> [(MsgClassShow, Text)] -> m ()
forall a b. (a -> b) -> a -> b
$ [(MsgClassShow, Text)]
blurb [(MsgClassShow, Text)]
-> [(MsgClassShow, Text)] -> [(MsgClassShow, Text)]
forall a. [a] -> [a] -> [a]
++ [(MsgClassShow, Text)]
outOfRangeBlurb
    Maybe AimMode
_ -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

pickLeaderWithPointer :: MonadClientUI m => ActorId -> m MError
pickLeaderWithPointer :: ActorId -> m MError
pickLeaderWithPointer ActorId
leader = do
  CCUI{coscreen :: CCUI -> ScreenContent
coscreen=ScreenContent{Int
rheight :: ScreenContent -> Int
rheight :: Int
rheight}} <- (SessionUI -> CCUI) -> m CCUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
  LevelId
lidV <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
viewedLevelUI
  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
  LevelId
arena <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
getArenaUI
  ActorDictUI
sactorUI <- (SessionUI -> ActorDictUI) -> m ActorDictUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> ActorDictUI
sactorUI
  [(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
$ ((ActorId, Actor) -> Bool)
-> [(ActorId, Actor)] -> [(ActorId, Actor)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((ActorId, Actor) -> Bool) -> (ActorId, Actor) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Actor -> Bool
bproj (Actor -> Bool)
-> ((ActorId, Actor) -> Actor) -> (ActorId, Actor) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ActorId, Actor) -> Actor
forall a b. (a, b) -> b
snd)
                      ([(ActorId, Actor)] -> [(ActorId, Actor)])
-> (State -> [(ActorId, Actor)]) -> State -> [(ActorId, Actor)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FactionId -> Bool) -> LevelId -> State -> [(ActorId, Actor)]
actorAssocs (FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side) LevelId
lidV
  let oursUI :: [(ActorId, Actor, ActorUI)]
oursUI = ((ActorId, Actor) -> (ActorId, Actor, ActorUI))
-> [(ActorId, Actor)] -> [(ActorId, Actor, ActorUI)]
forall a b. (a -> b) -> [a] -> [b]
map (\(ActorId
aid, Actor
b) -> (ActorId
aid, Actor
b, ActorDictUI
sactorUI ActorDictUI -> ActorId -> ActorUI
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ActorId
aid)) [(ActorId, Actor)]
ours
      viewed :: [(ActorId, Actor, ActorUI)]
viewed = ((ActorId, Actor, ActorUI)
 -> (Bool, Bool, Bool, Char, Color, ActorId))
-> [(ActorId, Actor, ActorUI)] -> [(ActorId, Actor, ActorUI)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (ActorId, Actor, ActorUI)
-> (Bool, Bool, Bool, Char, Color, ActorId)
keySelected [(ActorId, Actor, ActorUI)]
oursUI
      banned :: Bool
banned = Faction -> Bool
bannedPointmanSwitchBetweenLevels Faction
fact
      pick :: (ActorId, Actor) -> m MError
pick (ActorId
aid, Actor
b) = if Actor -> LevelId
blid Actor
b LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
/= LevelId
arena Bool -> Bool -> Bool
&& Bool
banned
                      then Text -> m MError
forall (m :: * -> *). MonadClientUI m => Text -> m MError
failMsg (Text -> m MError) -> Text -> m MError
forall a b. (a -> b) -> a -> b
$ ReqFailure -> Text
showReqFailure ReqFailure
NoChangeDunLeader
                      else do
                        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
$ Bool -> ActorId -> m Bool
forall (m :: * -> *). MonadClientUI m => Bool -> ActorId -> m Bool
pickLeader Bool
True ActorId
aid
                        MError -> m MError
forall (m :: * -> *) a. Monad m => a -> m a
return MError
forall a. Maybe a
Nothing
  PointUI
pUI <- (SessionUI -> PointUI) -> m PointUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> PointUI
spointer
  let p :: Point
p@(Point Int
px Int
py) = PointSquare -> Point
squareToMap (PointSquare -> Point) -> PointSquare -> Point
forall a b. (a -> b) -> a -> b
$ PointUI -> PointSquare
uiToSquare PointUI
pUI
  -- Pick even if no space in status line for the actor's symbol.
  if | Int
py Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
rheight Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2 Bool -> Bool -> Bool
&& Int
px Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> ActorId -> Bool -> Direction -> m MError
forall (m :: * -> *).
MonadClientUI m =>
ActorId -> Bool -> Direction -> m MError
pointmanCycle ActorId
leader Bool
True Direction
Forward
     | Int
py Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
rheight Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2 ->
         case Int -> [(ActorId, Actor, ActorUI)] -> [(ActorId, Actor, ActorUI)]
forall a. Int -> [a] -> [a]
drop (Int
px Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [(ActorId, Actor, ActorUI)]
viewed of
           [] -> MError -> m MError
forall (m :: * -> *) a. Monad m => a -> m a
return MError
forall a. Maybe a
Nothing
             -- relaxed, due to subtleties of display of selected actors
           (ActorId
aid, Actor
b, ActorUI
_) : [(ActorId, Actor, ActorUI)]
_ -> (ActorId, Actor) -> m MError
pick (ActorId
aid, Actor
b)
     | Bool
otherwise ->
         case ((ActorId, Actor, ActorUI) -> Bool)
-> [(ActorId, Actor, ActorUI)] -> Maybe (ActorId, Actor, ActorUI)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(ActorId
_, Actor
b, ActorUI
_) -> Actor -> Point
bpos Actor
b Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Point
p) [(ActorId, Actor, ActorUI)]
oursUI of
           Maybe (ActorId, Actor, ActorUI)
Nothing -> Text -> m MError
forall (m :: * -> *). MonadClientUI m => Text -> m MError
failMsg Text
"not pointing at an actor"
           Just (ActorId
aid, Actor
b, ActorUI
_) -> (ActorId, Actor) -> m MError
pick (ActorId
aid, Actor
b)

itemOverlayFromState :: LevelId -> [(ItemId, ItemQuant)] -> Bool
                     -> CCUI -> FactionId -> DiscoveryBenefit -> FontSetup
                     -> State
                     -> OKX
itemOverlayFromState :: LevelId
-> [(ItemId, ItemQuant)]
-> Bool
-> CCUI
-> FactionId
-> DiscoveryBenefit
-> FontSetup
-> State
-> OKX
itemOverlayFromState LevelId
arena [(ItemId, ItemQuant)]
iids Bool
displayRanged CCUI
sccui FactionId
side DiscoveryBenefit
discoBenefit
                     FontSetup{DisplayFont
propFont :: FontSetup -> DisplayFont
monoFont :: FontSetup -> DisplayFont
squareFont :: FontSetup -> DisplayFont
propFont :: DisplayFont
monoFont :: DisplayFont
squareFont :: DisplayFont
..} State
s =
  let CCUI{coscreen :: CCUI -> ScreenContent
coscreen=ScreenContent{Int
rwidth :: ScreenContent -> Int
rwidth :: Int
rwidth}} = CCUI
sccui
      localTime :: Time
localTime = LevelId -> State -> Time
getLocalTime LevelId
arena State
s
      itemToF :: ItemId -> ItemFull
itemToF = (ItemId -> State -> ItemFull) -> State -> ItemId -> ItemFull
forall a b c. (a -> b -> c) -> b -> a -> c
flip ItemId -> State -> ItemFull
itemToFull State
s
      factionD :: EnumMap FactionId Faction
factionD = State -> EnumMap FactionId Faction
sfactionD State
s
      attrCursor :: Attr
attrCursor = Attr
Color.defAttr {bg :: Highlight
Color.bg = Highlight
Color.HighlightNoneCursor}
      markEqp :: Bool -> a -> a -> Char
markEqp Bool
periodic a
k a
ncha =
        if | Bool
periodic -> Char
'"'  -- if equipped, no charges
           | a
ncha a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 -> Char
'-'  -- no charges left
           | a
k a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
ncha -> Char
'~'  -- not all charges left
           | Bool
otherwise -> Char
'+'
      pr :: MenuSlot -> (ItemId, ItemQuant)
         -> (AttrString, AttrString, KeyOrSlot)
      pr :: MenuSlot
-> (ItemId, ItemQuant) -> (AttrString, AttrString, KeyOrSlot)
pr MenuSlot
c (ItemId
iid, kit :: ItemQuant
kit@(Int
k, ItemTimers
_)) =
        let itemFull :: ItemFull
itemFull = ItemId -> ItemFull
itemToF ItemId
iid
            arItem :: AspectRecord
arItem = ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFull
            colorSymbol :: AttrCharW32
colorSymbol =
              if Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Condition AspectRecord
arItem
              then DiscoveryBenefit -> ItemId -> ItemFull -> AttrCharW32
viewItemBenefitColored DiscoveryBenefit
discoBenefit ItemId
iid ItemFull
itemFull
              else ItemFull -> AttrCharW32
viewItem ItemFull
itemFull
            phrase :: Text
phrase = [Part] -> Text
makePhrase
              [Int
-> FactionId
-> EnumMap FactionId Faction
-> Bool
-> DetailLevel
-> Int
-> Int
-> Time
-> ItemFull
-> ItemQuant
-> Part
partItemWsRanged Int
rwidth FactionId
side EnumMap FactionId Faction
factionD Bool
displayRanged
                                DetailLevel
DetailMedium Int
4 Int
k Time
localTime ItemFull
itemFull ItemQuant
kit]
            ncha :: Int
ncha = Time -> ItemQuant -> Int
ncharges Time
localTime ItemQuant
kit
            periodic :: Bool
periodic = Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Periodic AspectRecord
arItem
            !cLab :: AttrChar
cLab = AttrChar :: Attr -> Char -> AttrChar
Color.AttrChar { acAttr :: Attr
acAttr = Attr
attrCursor
                                   , acChar :: Char
acChar = Bool -> Int -> Int -> Char
forall a. (Num a, Ord a) => Bool -> a -> a -> Char
markEqp Bool
periodic Int
k Int
ncha }
            asLab :: AttrString
asLab = [AttrChar -> AttrCharW32
Color.attrCharToW32 AttrChar
cLab]
                    AttrString -> AttrString -> AttrString
forall a. [a] -> [a] -> [a]
++ [AttrCharW32
Color.spaceAttrW32 | DisplayFont -> Bool
isSquareFont DisplayFont
propFont]
                    AttrString -> AttrString -> AttrString
forall a. [a] -> [a] -> [a]
++ [AttrCharW32
colorSymbol]
            !tDesc :: Text
tDesc = Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
phrase
        in (AttrString
asLab, Text -> AttrString
textToAS Text
tDesc, MenuSlot -> KeyOrSlot
forall a b. b -> Either a b
Right MenuSlot
c)
      l :: [(AttrString, AttrString, KeyOrSlot)]
l = (MenuSlot
 -> (ItemId, ItemQuant) -> (AttrString, AttrString, KeyOrSlot))
-> [MenuSlot]
-> [(ItemId, ItemQuant)]
-> [(AttrString, AttrString, KeyOrSlot)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith MenuSlot
-> (ItemId, ItemQuant) -> (AttrString, AttrString, KeyOrSlot)
pr [MenuSlot]
natSlots [(ItemId, ItemQuant)]
iids
  in DisplayFont
-> DisplayFont -> [(AttrString, AttrString, KeyOrSlot)] -> OKX
labDescOKX DisplayFont
squareFont DisplayFont
propFont [(AttrString, AttrString, KeyOrSlot)]
l

-- | Extract whole-dungeon statistics for each place kind,
-- counting the number of occurrences of each type of
-- `Game.LambdaHack.Content.PlaceKind.PlaceEntry`
-- for the given place kind and gathering the set of levels
-- on which any entry for that place kind can be found.
placesFromState :: ContentData PK.PlaceKind -> Bool -> State
                -> EM.EnumMap (ContentId PK.PlaceKind)
                              (ES.EnumSet LevelId, Int, Int, Int)
placesFromState :: ContentData PlaceKind
-> Bool
-> State
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
placesFromState ContentData PlaceKind
coplace Bool
sexposePlaces State
s =
  let addEntries :: (EnumSet k, b, c, d)
-> (EnumSet k, b, c, d) -> (EnumSet k, b, c, d)
addEntries (!EnumSet k
es1, !b
nEntries1, !c
nArounds1, !d
nExists1)
                 (!EnumSet k
es2, !b
nEntries2, !c
nArounds2, !d
nExists2) =
        let !es :: EnumSet k
es = EnumSet k -> EnumSet k -> EnumSet k
forall k. EnumSet k -> EnumSet k -> EnumSet k
ES.union EnumSet k
es1 EnumSet k
es2
            !nEntries :: b
nEntries = b
nEntries1 b -> b -> b
forall a. Num a => a -> a -> a
+ b
nEntries2
            !nArounds :: c
nArounds = c
nArounds1 c -> c -> c
forall a. Num a => a -> a -> a
+ c
nArounds2
            !nExists :: d
nExists = d
nExists1 d -> d -> d
forall a. Num a => a -> a -> a
+ d
nExists2
        in (EnumSet k
es, b
nEntries, c
nArounds, d
nExists)
      placesFromLevel :: (LevelId, Level)
                      -> EM.EnumMap (ContentId PK.PlaceKind)
                                    (ES.EnumSet LevelId, Int, Int, Int)
      placesFromLevel :: (LevelId, Level)
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
placesFromLevel (!LevelId
lid, Level{EntryMap
lentry :: Level -> EntryMap
lentry :: EntryMap
lentry}) =
        let f :: PlaceEntry
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
f (PK.PEntry ContentId PlaceKind
pk) EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
em =
              ((EnumSet LevelId, Int, Int, Int)
 -> (EnumSet LevelId, Int, Int, Int)
 -> (EnumSet LevelId, Int, Int, Int))
-> ContentId PlaceKind
-> (EnumSet LevelId, Int, Int, Int)
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
forall k a.
Enum k =>
(a -> a -> a) -> k -> a -> EnumMap k a -> EnumMap k a
EM.insertWith (EnumSet LevelId, Int, Int, Int)
-> (EnumSet LevelId, Int, Int, Int)
-> (EnumSet LevelId, Int, Int, Int)
forall d c b k.
(Num d, Num c, Num b) =>
(EnumSet k, b, c, d)
-> (EnumSet k, b, c, d) -> (EnumSet k, b, c, d)
addEntries ContentId PlaceKind
pk (LevelId -> EnumSet LevelId
forall k. Enum k => k -> EnumSet k
ES.singleton LevelId
lid, Int
1, Int
0, Int
0) EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
em
            f (PK.PAround ContentId PlaceKind
pk) EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
em =
              ((EnumSet LevelId, Int, Int, Int)
 -> (EnumSet LevelId, Int, Int, Int)
 -> (EnumSet LevelId, Int, Int, Int))
-> ContentId PlaceKind
-> (EnumSet LevelId, Int, Int, Int)
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
forall k a.
Enum k =>
(a -> a -> a) -> k -> a -> EnumMap k a -> EnumMap k a
EM.insertWith (EnumSet LevelId, Int, Int, Int)
-> (EnumSet LevelId, Int, Int, Int)
-> (EnumSet LevelId, Int, Int, Int)
forall d c b k.
(Num d, Num c, Num b) =>
(EnumSet k, b, c, d)
-> (EnumSet k, b, c, d) -> (EnumSet k, b, c, d)
addEntries ContentId PlaceKind
pk (LevelId -> EnumSet LevelId
forall k. Enum k => k -> EnumSet k
ES.singleton LevelId
lid, Int
0, Int
1, Int
0) EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
em
            f (PK.PExists ContentId PlaceKind
pk) EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
em =
              ((EnumSet LevelId, Int, Int, Int)
 -> (EnumSet LevelId, Int, Int, Int)
 -> (EnumSet LevelId, Int, Int, Int))
-> ContentId PlaceKind
-> (EnumSet LevelId, Int, Int, Int)
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
forall k a.
Enum k =>
(a -> a -> a) -> k -> a -> EnumMap k a -> EnumMap k a
EM.insertWith (EnumSet LevelId, Int, Int, Int)
-> (EnumSet LevelId, Int, Int, Int)
-> (EnumSet LevelId, Int, Int, Int)
forall d c b k.
(Num d, Num c, Num b) =>
(EnumSet k, b, c, d)
-> (EnumSet k, b, c, d) -> (EnumSet k, b, c, d)
addEntries ContentId PlaceKind
pk (LevelId -> EnumSet LevelId
forall k. Enum k => k -> EnumSet k
ES.singleton LevelId
lid, Int
0, Int
0, Int
1) EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
em
        in (PlaceEntry
 -> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
 -> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int))
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
-> EntryMap
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
forall a b k. (a -> b -> b) -> b -> EnumMap k a -> b
EM.foldr' PlaceEntry
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
f EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
forall k a. EnumMap k a
EM.empty EntryMap
lentry
             -- go through place entrances and depending on the place
             -- add an entry for it, whether Entry/Around/Exists,
             -- the effect being we're counting #s of each type
      insertZeros :: EnumMap k (EnumSet k, b, c, d)
-> k -> p -> EnumMap k (EnumSet k, b, c, d)
insertZeros !EnumMap k (EnumSet k, b, c, d)
em !k
pk p
_ = k
-> (EnumSet k, b, c, d)
-> EnumMap k (EnumSet k, b, c, d)
-> EnumMap k (EnumSet k, b, c, d)
forall k a. Enum k => k -> a -> EnumMap k a -> EnumMap k a
EM.insert k
pk (EnumSet k
forall k. EnumSet k
ES.empty, b
0, c
0, d
0) EnumMap k (EnumSet k, b, c, d)
em
      -- The initial places are overwritten except for those
      -- that have no entries in the dungeon at all,
      -- and in `sexposePlaces` debug mode these will be shown even though
      -- the stats will be zeros (which is a valuable warning!).
      initialPlaces :: EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
initialPlaces | Bool -> Bool
not Bool
sexposePlaces = EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
forall k a. EnumMap k a
EM.empty
                    | Bool
otherwise = ContentData PlaceKind
-> (EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
    -> ContentId PlaceKind
    -> PlaceKind
    -> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int))
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
forall a b. ContentData a -> (b -> ContentId a -> a -> b) -> b -> b
ofoldlWithKey' ContentData PlaceKind
coplace EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
-> ContentId PlaceKind
-> PlaceKind
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
forall k b c d k p.
(Enum k, Num b, Num c, Num d) =>
EnumMap k (EnumSet k, b, c, d)
-> k -> p -> EnumMap k (EnumSet k, b, c, d)
insertZeros EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
forall k a. EnumMap k a
EM.empty
  in ((EnumSet LevelId, Int, Int, Int)
 -> (EnumSet LevelId, Int, Int, Int)
 -> (EnumSet LevelId, Int, Int, Int))
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
forall a k.
(a -> a -> a) -> EnumMap k a -> EnumMap k a -> EnumMap k a
EM.unionWith (EnumSet LevelId, Int, Int, Int)
-> (EnumSet LevelId, Int, Int, Int)
-> (EnumSet LevelId, Int, Int, Int)
forall d c b k.
(Num d, Num c, Num b) =>
(EnumSet k, b, c, d)
-> (EnumSet k, b, c, d) -> (EnumSet k, b, c, d)
addEntries
       EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
initialPlaces
       (((EnumSet LevelId, Int, Int, Int)
 -> (EnumSet LevelId, Int, Int, Int)
 -> (EnumSet LevelId, Int, Int, Int))
-> [EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)]
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
forall a k. (a -> a -> a) -> [EnumMap k a] -> EnumMap k a
EM.unionsWith (EnumSet LevelId, Int, Int, Int)
-> (EnumSet LevelId, Int, Int, Int)
-> (EnumSet LevelId, Int, Int, Int)
forall d c b k.
(Num d, Num c, Num b) =>
(EnumSet k, b, c, d)
-> (EnumSet k, b, c, d) -> (EnumSet k, b, c, d)
addEntries ([EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)]
 -> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int))
-> [EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)]
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
forall a b. (a -> b) -> a -> b
$ ((LevelId, Level)
 -> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int))
-> [(LevelId, Level)]
-> [EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (LevelId, Level)
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
placesFromLevel ([(LevelId, Level)]
 -> [EnumMap
       (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)])
-> [(LevelId, Level)]
-> [EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)]
forall a b. (a -> b) -> a -> b
$ EnumMap LevelId Level -> [(LevelId, Level)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs (EnumMap LevelId Level -> [(LevelId, Level)])
-> EnumMap LevelId Level -> [(LevelId, Level)]
forall a b. (a -> b) -> a -> b
$ State -> EnumMap LevelId Level
sdungeon State
s)
        -- gather per-place-kind statistics for each level,
        -- then aggregate them over all levels, remembering that the place
        -- appeared on the given level (but not how man times)

-- TODO: if faction not known, it's info should not be updated
-- by the server. But let's wait until server sends general state diffs
-- and then block diffs that don't apply, because faction is missing.
factionsFromState :: ItemRoles -> State -> [(FactionId, Faction)]
factionsFromState :: ItemRoles -> State -> [(FactionId, Faction)]
factionsFromState (ItemRoles EnumMap SLore (EnumSet ItemId)
itemRoles) State
s =
  let seenTrunks :: [ItemId]
seenTrunks = EnumSet ItemId -> [ItemId]
forall k. Enum k => EnumSet k -> [k]
ES.toList (EnumSet ItemId -> [ItemId]) -> EnumSet ItemId -> [ItemId]
forall a b. (a -> b) -> a -> b
$ EnumMap SLore (EnumSet ItemId)
itemRoles EnumMap SLore (EnumSet ItemId) -> SLore -> EnumSet ItemId
forall k a. Enum k => EnumMap k a -> k -> a
EM.! SLore
STrunk
      trunkBelongs :: FactionId -> ItemId -> Bool
trunkBelongs FactionId
fid ItemId
iid = Item -> Maybe FactionId
jfid (ItemId -> State -> Item
getItemBody ItemId
iid State
s) Maybe FactionId -> Maybe FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId -> Maybe FactionId
forall a. a -> Maybe a
Just FactionId
fid
      factionSeen :: (FactionId, Faction) -> Bool
factionSeen (FactionId
fid, Faction
fact) = Bool -> Bool
not (EnumMap (ContentId ItemKind) Int -> Bool
forall k a. EnumMap k a -> Bool
EM.null (Faction -> EnumMap (ContentId ItemKind) Int
gvictims Faction
fact))  -- shortcut
                                Bool -> Bool -> Bool
|| (ItemId -> Bool) -> [ItemId] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (FactionId -> ItemId -> Bool
trunkBelongs FactionId
fid) [ItemId]
seenTrunks
  in ((FactionId, Faction) -> Bool)
-> [(FactionId, Faction)] -> [(FactionId, Faction)]
forall a. (a -> Bool) -> [a] -> [a]
filter (FactionId, Faction) -> Bool
factionSeen ([(FactionId, Faction)] -> [(FactionId, Faction)])
-> [(FactionId, Faction)] -> [(FactionId, Faction)]
forall a b. (a -> b) -> a -> b
$ EnumMap FactionId Faction -> [(FactionId, Faction)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs (EnumMap FactionId Faction -> [(FactionId, Faction)])
-> EnumMap FactionId Faction -> [(FactionId, Faction)]
forall a b. (a -> b) -> a -> b
$ State -> EnumMap FactionId Faction
sfactionD State
s

itemOverlay :: MonadClientUI m
            => [(ItemId, ItemQuant)] -> ItemDialogMode -> m OKX
itemOverlay :: [(ItemId, ItemQuant)] -> ItemDialogMode -> m OKX
itemOverlay [(ItemId, ItemQuant)]
iids ItemDialogMode
dmode = do
  CCUI
sccui <- (SessionUI -> CCUI) -> m CCUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
  FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
  LevelId
arena <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
getArenaUI
  DiscoveryBenefit
discoBenefit <- (StateClient -> DiscoveryBenefit) -> m DiscoveryBenefit
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> DiscoveryBenefit
sdiscoBenefit
  FontSetup
fontSetup <- m FontSetup
forall (m :: * -> *). MonadClientUI m => m FontSetup
getFontSetup
  let displayRanged :: Bool
displayRanged =
        ItemDialogMode
dmode ItemDialogMode -> [ItemDialogMode] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ CStore -> ItemDialogMode
MStore CStore
CGround, CStore -> ItemDialogMode
MStore CStore
CEqp, CStore -> ItemDialogMode
MStore CStore
CStash
                     , ItemDialogMode
MOwned, SLore -> ItemDialogMode
MLore SLore
SItem, SLore -> ItemDialogMode
MLore SLore
SBlast ]
  OKX
okx <- (State -> OKX) -> m OKX
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> OKX) -> m OKX) -> (State -> OKX) -> m OKX
forall a b. (a -> b) -> a -> b
$ LevelId
-> [(ItemId, ItemQuant)]
-> Bool
-> CCUI
-> FactionId
-> DiscoveryBenefit
-> FontSetup
-> State
-> OKX
itemOverlayFromState LevelId
arena [(ItemId, ItemQuant)]
iids Bool
displayRanged
                                          CCUI
sccui FactionId
side DiscoveryBenefit
discoBenefit FontSetup
fontSetup
  OKX -> m OKX
forall (m :: * -> *) a. Monad m => a -> m a
return (OKX -> m OKX) -> OKX -> m OKX
forall a b. (a -> b) -> a -> b
$! OKX
okx

skillsOverlay :: MonadClientUI m => ActorId -> m OKX
skillsOverlay :: ActorId -> m OKX
skillsOverlay ActorId
aid = do
  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
  Skills
actorMaxSk <- (State -> Skills) -> m Skills
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Skills) -> m Skills) -> (State -> Skills) -> m Skills
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Skills
getActorMaxSkills ActorId
aid
  FontSetup{DisplayFont
propFont :: DisplayFont
monoFont :: DisplayFont
squareFont :: DisplayFont
propFont :: FontSetup -> DisplayFont
monoFont :: FontSetup -> DisplayFont
squareFont :: FontSetup -> DisplayFont
..} <- m FontSetup
forall (m :: * -> *). MonadClientUI m => m FontSetup
getFontSetup
  let prSlot :: MenuSlot -> Ability.Skill
             -> ((AttrLine, (Int, AttrLine), (Int, AttrLine)), KYX)
      prSlot :: MenuSlot
-> Skill -> ((AttrLine, (Int, AttrLine), (Int, AttrLine)), KYX)
prSlot MenuSlot
c Skill
skill =
        let skName :: Text
skName = Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Skill -> Text
skillName Skill
skill
            attrCursor :: Attr
attrCursor = Attr
Color.defAttr {bg :: Highlight
Color.bg = Highlight
Color.HighlightNoneCursor}
            labAc :: AttrChar
labAc = AttrChar :: Attr -> Char -> AttrChar
Color.AttrChar { acAttr :: Attr
acAttr = Attr
attrCursor
                                   , acChar :: Char
acChar = Char
'+' }
            lab :: AttrLine
lab = AttrString -> AttrLine
attrStringToAL [AttrChar -> AttrCharW32
Color.attrCharToW32 AttrChar
labAc]
            labLen :: Int
labLen = DisplayFont -> AttrString -> Int
forall a. DisplayFont -> [a] -> Int
textSize DisplayFont
squareFont (AttrString -> Int) -> AttrString -> Int
forall a b. (a -> b) -> a -> b
$ AttrLine -> AttrString
attrLine AttrLine
lab
            indentation :: Int
indentation = if DisplayFont -> Bool
isSquareFont DisplayFont
propFont then Int
52 else Int
26
            valueText :: Text
valueText = Skill -> Actor -> Int -> Text
skillToDecorator Skill
skill Actor
b
                        (Int -> Text) -> Int -> Text
forall a b. (a -> b) -> a -> b
$ Skill -> Skills -> Int
Ability.getSk Skill
skill Skills
actorMaxSk
            triple :: (AttrLine, (Int, AttrLine), (Int, AttrLine))
triple = ( AttrLine
lab
                     , (Int
labLen, Text -> AttrLine
textToAL Text
skName)
                     , (Int
indentation, Text -> AttrLine
textToAL Text
valueText) )
            lenButton :: Int
lenButton = Int
26 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Text -> Int
T.length Text
valueText
        in ((AttrLine, (Int, AttrLine), (Int, AttrLine))
triple, (MenuSlot -> KeyOrSlot
forall a b. b -> Either a b
Right MenuSlot
c, ( Int -> Int -> PointUI
PointUI Int
0 (MenuSlot -> Int
forall a. Enum a => a -> Int
fromEnum MenuSlot
c)
                              , DisplayFont -> Int -> ButtonWidth
ButtonWidth DisplayFont
propFont Int
lenButton )))
      ([(AttrLine, (Int, AttrLine), (Int, AttrLine))]
ts, [KYX]
kxs) = [((AttrLine, (Int, AttrLine), (Int, AttrLine)), KYX)]
-> ([(AttrLine, (Int, AttrLine), (Int, AttrLine))], [KYX])
forall a b. [(a, b)] -> ([a], [b])
unzip ([((AttrLine, (Int, AttrLine), (Int, AttrLine)), KYX)]
 -> ([(AttrLine, (Int, AttrLine), (Int, AttrLine))], [KYX]))
-> [((AttrLine, (Int, AttrLine), (Int, AttrLine)), KYX)]
-> ([(AttrLine, (Int, AttrLine), (Int, AttrLine))], [KYX])
forall a b. (a -> b) -> a -> b
$ (MenuSlot
 -> Skill -> ((AttrLine, (Int, AttrLine), (Int, AttrLine)), KYX))
-> [MenuSlot]
-> [Skill]
-> [((AttrLine, (Int, AttrLine), (Int, AttrLine)), KYX)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith MenuSlot
-> Skill -> ((AttrLine, (Int, AttrLine), (Int, AttrLine)), KYX)
prSlot [MenuSlot]
natSlots [Skill]
skillsInDisplayOrder
      ([AttrLine]
skLab, [(Int, AttrLine)]
skDescr, [(Int, AttrLine)]
skValue) = [(AttrLine, (Int, AttrLine), (Int, AttrLine))]
-> ([AttrLine], [(Int, AttrLine)], [(Int, AttrLine)])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 [(AttrLine, (Int, AttrLine), (Int, AttrLine))]
ts
      skillLab :: EnumMap DisplayFont Overlay
skillLab = DisplayFont -> Overlay -> EnumMap DisplayFont Overlay
forall k a. Enum k => k -> a -> EnumMap k a
EM.singleton DisplayFont
squareFont (Overlay -> EnumMap DisplayFont Overlay)
-> Overlay -> EnumMap DisplayFont Overlay
forall a b. (a -> b) -> a -> b
$ [AttrLine] -> Overlay
offsetOverlay [AttrLine]
skLab
      skillDescr :: EnumMap DisplayFont Overlay
skillDescr = 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
$ [(Int, AttrLine)] -> Overlay
offsetOverlayX [(Int, AttrLine)]
skDescr
      skillValue :: EnumMap DisplayFont Overlay
skillValue = DisplayFont -> Overlay -> EnumMap DisplayFont Overlay
forall k a. Enum k => k -> a -> EnumMap k a
EM.singleton DisplayFont
monoFont (Overlay -> EnumMap DisplayFont Overlay)
-> Overlay -> EnumMap DisplayFont Overlay
forall a b. (a -> b) -> a -> b
$ [(Int, AttrLine)] -> Overlay
offsetOverlayX [(Int, AttrLine)]
skValue
  OKX -> m OKX
forall (m :: * -> *) a. Monad m => a -> m a
return ((Overlay -> Overlay -> Overlay)
-> [EnumMap DisplayFont Overlay] -> EnumMap DisplayFont Overlay
forall a k. (a -> a -> a) -> [EnumMap k a] -> EnumMap k a
EM.unionsWith Overlay -> Overlay -> Overlay
forall a. [a] -> [a] -> [a]
(++) [EnumMap DisplayFont Overlay
skillLab, EnumMap DisplayFont Overlay
skillDescr, EnumMap DisplayFont Overlay
skillValue], [KYX]
kxs)

placesOverlay :: MonadClientUI m => m OKX
placesOverlay :: m OKX
placesOverlay = do
  COps{ContentData PlaceKind
coplace :: COps -> ContentData PlaceKind
coplace :: ContentData PlaceKind
coplace} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  ClientOptions
soptions <- (StateClient -> ClientOptions) -> m ClientOptions
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> ClientOptions
soptions
  FontSetup{DisplayFont
propFont :: DisplayFont
monoFont :: DisplayFont
squareFont :: DisplayFont
propFont :: FontSetup -> DisplayFont
monoFont :: FontSetup -> DisplayFont
squareFont :: FontSetup -> DisplayFont
..} <- m FontSetup
forall (m :: * -> *). MonadClientUI m => m FontSetup
getFontSetup
  EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
places <- (State
 -> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int))
-> m (EnumMap
        (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int))
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State
  -> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int))
 -> m (EnumMap
         (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)))
-> (State
    -> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int))
-> m (EnumMap
        (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int))
forall a b. (a -> b) -> a -> b
$ ContentData PlaceKind
-> Bool
-> State
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
placesFromState ContentData PlaceKind
coplace (ClientOptions -> Bool
sexposePlaces ClientOptions
soptions)
  let prSlot :: MenuSlot
             -> (ContentId PK.PlaceKind, (ES.EnumSet LevelId, Int, Int, Int))
             -> (AttrString, AttrString, KeyOrSlot)
      prSlot :: MenuSlot
-> (ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))
-> (AttrString, AttrString, KeyOrSlot)
prSlot MenuSlot
c (ContentId PlaceKind
pk, (EnumSet LevelId
es, Int
_, Int
_, Int
_)) =
        let name :: Text
name = PlaceKind -> Text
PK.pname (PlaceKind -> Text) -> PlaceKind -> Text
forall a b. (a -> b) -> a -> b
$ ContentData PlaceKind -> ContentId PlaceKind -> PlaceKind
forall a. ContentData a -> ContentId a -> a
okind ContentData PlaceKind
coplace ContentId PlaceKind
pk
            labChar :: Char
labChar = if EnumSet LevelId -> Bool
forall k. EnumSet k -> Bool
ES.null EnumSet LevelId
es then Char
'-' else Char
'+'
            attrCursor :: Attr
attrCursor = Attr
Color.defAttr {bg :: Highlight
Color.bg = Highlight
Color.HighlightNoneCursor}
            labAc :: AttrChar
labAc = AttrChar :: Attr -> Char -> AttrChar
Color.AttrChar { acAttr :: Attr
acAttr = Attr
attrCursor
                                   , acChar :: Char
acChar = Char
labChar }
            -- Bang required to free @places@ as you go.
            !asLab :: AttrString
asLab = [AttrChar -> AttrCharW32
Color.attrCharToW32 AttrChar
labAc]
            !tDesc :: Text
tDesc = Text
" "
                     Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name
                     Text -> Text -> Text
<+> if EnumSet LevelId -> Bool
forall k. EnumSet k -> Bool
ES.null EnumSet LevelId
es
                         then Text
""
                         else Text
"("
                              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Part] -> Text
makePhrase [Int -> Part -> Part
MU.CarWs (EnumSet LevelId -> Int
forall k. EnumSet k -> Int
ES.size EnumSet LevelId
es) Part
"level"]
                              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
        in (AttrString
asLab, Text -> AttrString
textToAS Text
tDesc, MenuSlot -> KeyOrSlot
forall a b. b -> Either a b
Right MenuSlot
c)
      l :: [(AttrString, AttrString, KeyOrSlot)]
l = (MenuSlot
 -> (ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))
 -> (AttrString, AttrString, KeyOrSlot))
-> [MenuSlot]
-> [(ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))]
-> [(AttrString, AttrString, KeyOrSlot)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith MenuSlot
-> (ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))
-> (AttrString, AttrString, KeyOrSlot)
prSlot [MenuSlot]
natSlots ([(ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))]
 -> [(AttrString, AttrString, KeyOrSlot)])
-> [(ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))]
-> [(AttrString, AttrString, KeyOrSlot)]
forall a b. (a -> b) -> a -> b
$ EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
-> [(ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
places
  OKX -> m OKX
forall (m :: * -> *) a. Monad m => a -> m a
return (OKX -> m OKX) -> OKX -> m OKX
forall a b. (a -> b) -> a -> b
$! DisplayFont
-> DisplayFont -> [(AttrString, AttrString, KeyOrSlot)] -> OKX
labDescOKX DisplayFont
squareFont DisplayFont
propFont [(AttrString, AttrString, KeyOrSlot)]
l

factionsOverlay :: MonadClientUI m => m OKX
factionsOverlay :: m OKX
factionsOverlay = do
  FontSetup{DisplayFont
propFont :: DisplayFont
monoFont :: DisplayFont
squareFont :: DisplayFont
propFont :: FontSetup -> DisplayFont
monoFont :: FontSetup -> DisplayFont
squareFont :: FontSetup -> DisplayFont
..} <- m FontSetup
forall (m :: * -> *). MonadClientUI m => m FontSetup
getFontSetup
  ItemRoles
sroles <- (SessionUI -> ItemRoles) -> m ItemRoles
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> ItemRoles
sroles
  [(FactionId, Faction)]
factions <- (State -> [(FactionId, Faction)]) -> m [(FactionId, Faction)]
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(FactionId, Faction)]) -> m [(FactionId, Faction)])
-> (State -> [(FactionId, Faction)]) -> m [(FactionId, Faction)]
forall a b. (a -> b) -> a -> b
$ ItemRoles -> State -> [(FactionId, Faction)]
factionsFromState ItemRoles
sroles
  let prSlot :: MenuSlot
             -> (FactionId, Faction)
             -> (AttrString, AttrString, KeyOrSlot)
      prSlot :: MenuSlot
-> (FactionId, Faction) -> (AttrString, AttrString, KeyOrSlot)
prSlot MenuSlot
c (FactionId
_, Faction
fact) =
        let name :: Text
name = FactionKind -> Text
FK.fname (FactionKind -> Text) -> FactionKind -> Text
forall a b. (a -> b) -> a -> b
$ Faction -> FactionKind
gkind Faction
fact  -- we ignore "Controlled", etc.
            gameOver :: Bool
gameOver = Maybe Status -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Status -> Bool) -> Maybe Status -> Bool
forall a b. (a -> b) -> a -> b
$ Faction -> Maybe Status
gquit Faction
fact
            labChar :: Char
labChar = if Bool
gameOver then Char
'-' else Char
'+'
            attrCursor :: Attr
attrCursor = Attr
Color.defAttr {bg :: Highlight
Color.bg = Highlight
Color.HighlightNoneCursor}
            labAc :: AttrChar
labAc = AttrChar :: Attr -> Char -> AttrChar
Color.AttrChar { acAttr :: Attr
acAttr = Attr
attrCursor
                                   , acChar :: Char
acChar = Char
labChar }
            !asLab :: AttrString
asLab = [AttrChar -> AttrCharW32
Color.attrCharToW32 AttrChar
labAc]
            !tDesc :: Text
tDesc = Text
" "
                     Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name
                     Text -> Text -> Text
<+> case Faction -> Maybe Status
gquit Faction
fact of
                           Just Status{Outcome
stOutcome :: Status -> Outcome
stOutcome :: Outcome
stOutcome} | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Faction -> Bool
isHorrorFact Faction
fact ->
                             Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Outcome -> Text
FK.nameOutcomePast Outcome
stOutcome Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
                           Maybe Status
_ -> Text
""
        in (AttrString
asLab, Text -> AttrString
textToAS Text
tDesc, MenuSlot -> KeyOrSlot
forall a b. b -> Either a b
Right MenuSlot
c)
      l :: [(AttrString, AttrString, KeyOrSlot)]
l = (MenuSlot
 -> (FactionId, Faction) -> (AttrString, AttrString, KeyOrSlot))
-> [MenuSlot]
-> [(FactionId, Faction)]
-> [(AttrString, AttrString, KeyOrSlot)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith MenuSlot
-> (FactionId, Faction) -> (AttrString, AttrString, KeyOrSlot)
prSlot [MenuSlot]
natSlots [(FactionId, Faction)]
factions
  OKX -> m OKX
forall (m :: * -> *) a. Monad m => a -> m a
return (OKX -> m OKX) -> OKX -> m OKX
forall a b. (a -> b) -> a -> b
$! DisplayFont
-> DisplayFont -> [(AttrString, AttrString, KeyOrSlot)] -> OKX
labDescOKX DisplayFont
squareFont DisplayFont
propFont [(AttrString, AttrString, KeyOrSlot)]
l

modesOverlay :: MonadClientUI m => m OKX
modesOverlay :: m OKX
modesOverlay = do
  COps{ContentData ModeKind
comode :: COps -> ContentData ModeKind
comode :: ContentData ModeKind
comode} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  FontSetup{DisplayFont
propFont :: DisplayFont
monoFont :: DisplayFont
squareFont :: DisplayFont
propFont :: FontSetup -> DisplayFont
monoFont :: FontSetup -> DisplayFont
squareFont :: FontSetup -> DisplayFont
..} <- m FontSetup
forall (m :: * -> *). MonadClientUI m => m FontSetup
getFontSetup
  EnumMap (ContentId ModeKind) (Map Challenge Int)
svictories <- (SessionUI -> EnumMap (ContentId ModeKind) (Map Challenge Int))
-> m (EnumMap (ContentId ModeKind) (Map Challenge Int))
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> EnumMap (ContentId ModeKind) (Map Challenge Int)
svictories
  Challenge
nxtChal <- (StateClient -> Challenge) -> m Challenge
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Challenge
snxtChal  -- mark victories only for current difficulty
  let f :: [(a, b)] -> p -> a -> b -> [(a, b)]
f ![(a, b)]
acc p
_p !a
i !b
a = (a
i, b
a) (a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
: [(a, b)]
acc
      campaignModes :: [(ContentId ModeKind, ModeKind)]
campaignModes = ContentData ModeKind
-> GroupName ModeKind
-> ([(ContentId ModeKind, ModeKind)]
    -> Int
    -> ContentId ModeKind
    -> ModeKind
    -> [(ContentId ModeKind, ModeKind)])
-> [(ContentId ModeKind, ModeKind)]
-> [(ContentId ModeKind, ModeKind)]
forall a b.
ContentData a
-> GroupName a -> (b -> Int -> ContentId a -> a -> b) -> b -> b
ofoldlGroup' ContentData ModeKind
comode GroupName ModeKind
MK.CAMPAIGN_SCENARIO [(ContentId ModeKind, ModeKind)]
-> Int
-> ContentId ModeKind
-> ModeKind
-> [(ContentId ModeKind, ModeKind)]
forall a b p. [(a, b)] -> p -> a -> b -> [(a, b)]
f []
      prSlot :: MenuSlot
             -> (ContentId MK.ModeKind, MK.ModeKind)
             -> (AttrString, AttrString, KeyOrSlot)
      prSlot :: MenuSlot
-> (ContentId ModeKind, ModeKind)
-> (AttrString, AttrString, KeyOrSlot)
prSlot MenuSlot
c (ContentId ModeKind
gameModeId, ModeKind
gameMode) =
        let modeName :: Text
modeName = ModeKind -> Text
MK.mname ModeKind
gameMode
            victories :: Int
victories = case ContentId ModeKind
-> EnumMap (ContentId ModeKind) (Map Challenge Int)
-> Maybe (Map Challenge Int)
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup ContentId ModeKind
gameModeId EnumMap (ContentId ModeKind) (Map Challenge Int)
svictories of
              Maybe (Map Challenge Int)
Nothing -> Int
0
              Just Map Challenge Int
cm -> Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (Challenge -> Map Challenge Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Challenge
nxtChal Map Challenge Int
cm)
            labChar :: Char
labChar = if Int
victories Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then Char
'-' else Char
'+'
            attrCursor :: Attr
attrCursor = Attr
Color.defAttr {bg :: Highlight
Color.bg = Highlight
Color.HighlightNoneCursor}
            labAc :: AttrChar
labAc = AttrChar :: Attr -> Char -> AttrChar
Color.AttrChar { acAttr :: Attr
acAttr = Attr
attrCursor
                                   , acChar :: Char
acChar = Char
labChar }
            !asLab :: AttrString
asLab = [AttrChar -> AttrCharW32
Color.attrCharToW32 AttrChar
labAc]
            !tDesc :: Text
tDesc = Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
modeName
        in (AttrString
asLab, Text -> AttrString
textToAS Text
tDesc, MenuSlot -> KeyOrSlot
forall a b. b -> Either a b
Right MenuSlot
c)
      l :: [(AttrString, AttrString, KeyOrSlot)]
l = (MenuSlot
 -> (ContentId ModeKind, ModeKind)
 -> (AttrString, AttrString, KeyOrSlot))
-> [MenuSlot]
-> [(ContentId ModeKind, ModeKind)]
-> [(AttrString, AttrString, KeyOrSlot)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith MenuSlot
-> (ContentId ModeKind, ModeKind)
-> (AttrString, AttrString, KeyOrSlot)
prSlot [MenuSlot]
natSlots [(ContentId ModeKind, ModeKind)]
campaignModes
  OKX -> m OKX
forall (m :: * -> *) a. Monad m => a -> m a
return (OKX -> m OKX) -> OKX -> m OKX
forall a b. (a -> b) -> a -> b
$! DisplayFont
-> DisplayFont -> [(AttrString, AttrString, KeyOrSlot)] -> OKX
labDescOKX DisplayFont
squareFont DisplayFont
propFont [(AttrString, AttrString, KeyOrSlot)]
l

describeMode :: MonadClientUI m
             => Bool -> ContentId MK.ModeKind
             -> m (EM.EnumMap DisplayFont Overlay)
describeMode :: Bool -> ContentId ModeKind -> m (EnumMap DisplayFont Overlay)
describeMode Bool
addTitle ContentId ModeKind
gameModeId = do
  COps{ContentData ModeKind
comode :: ContentData ModeKind
comode :: COps -> ContentData ModeKind
comode} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  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
  FontSetup{DisplayFont
propFont :: DisplayFont
monoFont :: DisplayFont
squareFont :: DisplayFont
propFont :: FontSetup -> DisplayFont
monoFont :: FontSetup -> DisplayFont
squareFont :: FontSetup -> DisplayFont
..} <- m FontSetup
forall (m :: * -> *). MonadClientUI m => m FontSetup
getFontSetup
  ScoreDict
scoreDict <- (State -> ScoreDict) -> m ScoreDict
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> ScoreDict
shigh
  EnumSet (ContentId ModeKind)
scampings <- (SessionUI -> EnumSet (ContentId ModeKind))
-> m (EnumSet (ContentId ModeKind))
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> EnumSet (ContentId ModeKind)
scampings
  EnumSet (ContentId ModeKind)
srestarts <- (SessionUI -> EnumSet (ContentId ModeKind))
-> m (EnumSet (ContentId ModeKind))
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> EnumSet (ContentId ModeKind)
srestarts
  FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
  Int
total <- (State -> Int) -> m Int
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Int) -> m Int) -> (State -> Int) -> m Int
forall a b. (a -> b) -> a -> b
$ (ItemBag, Int) -> Int
forall a b. (a, b) -> b
snd ((ItemBag, Int) -> Int)
-> (State -> (ItemBag, Int)) -> State -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FactionId -> State -> (ItemBag, Int)
calculateTotal FactionId
side
  Int
dungeonTotal <- (State -> Int) -> m Int
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> Int
sgold
  let screensaverBlurb :: Text
screensaverBlurb = Text
"This is one of the screensaver scenarios, not available from the main menu, with all factions controlled by AI. Feel free to take over or relinquish control at any moment, but to register a legitimate high score, choose a standard scenario instead.\n"
  let gameMode :: ModeKind
gameMode = ContentData ModeKind -> ContentId ModeKind -> ModeKind
forall a. ContentData a -> ContentId a -> a
okind ContentData ModeKind
comode ContentId ModeKind
gameModeId
      duplicateEOL :: Char -> Text
duplicateEOL Char
'\n' = Text
"\n\n"
      duplicateEOL Char
c = Char -> Text
T.singleton Char
c
      sections :: [(AttrString, Text)]
sections =
        [ ( Color -> Text -> AttrString
textFgToAS Color
Color.BrGreen Text
"The story so far:"
          , (Char -> Text) -> Text -> Text
T.concatMap Char -> Text
duplicateEOL (ModeKind -> Text
MK.mdesc ModeKind
gameMode) )
        , ( Color -> Text -> AttrString
textFgToAS Color
Color.cMeta Text
"Rules of the game:"
          , ModeKind -> Text
MK.mrules ModeKind
gameMode )
        , ( Color -> Text -> AttrString
textFgToAS Color
Color.BrCyan Text
"Running commentary:"
          , (Char -> Text) -> Text -> Text
T.concatMap Char -> Text
duplicateEOL
              (if ModeKind -> Bool
MK.mattract ModeKind
gameMode
               then Text
screensaverBlurb Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ModeKind -> Text
MK.mreason ModeKind
gameMode
               else ModeKind -> Text
MK.mreason ModeKind
gameMode) )
        , ( Color -> Text -> AttrString
textFgToAS Color
Color.cGreed Text
"Hints, not needed unless stuck:"
          , (Char -> Text) -> Text -> Text
T.concatMap Char -> Text
duplicateEOL (ModeKind -> Text
MK.mhint ModeKind
gameMode) )
        ]
      renderSection :: (AttrString, Text) -> Maybe [(DisplayFont, AttrString)]
      renderSection :: (AttrString, Text) -> Maybe [(DisplayFont, AttrString)]
renderSection (AttrString
header, Text
desc) =
        if Text -> Bool
T.null Text
desc
        then Maybe [(DisplayFont, AttrString)]
forall a. Maybe a
Nothing
        else [(DisplayFont, AttrString)] -> Maybe [(DisplayFont, AttrString)]
forall a. a -> Maybe a
Just [(DisplayFont
monoFont, AttrString
header), (DisplayFont
propFont, Text -> AttrString
textToAS Text
desc)]
      survivingHow :: Text
survivingHow = if | Int
total Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> Text
"(barely)"
                        | Int
total Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
dungeonTotal Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2 -> Text
"(so far)"
                        | Bool
otherwise -> Text
""
      title :: Text
title = if Bool
addTitle
              then Text
"\nYou are"
                   Text -> Text -> Text
<+> Text
survivingHow
                   Text -> Text -> Text
<+> Text
"surviving the '"
                   Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ModeKind -> Text
MK.mname ModeKind
gameMode
                   Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' adventure.\n"
              else Text
""
      blurb :: [(DisplayFont, [AttrLine])]
blurb = ((DisplayFont, AttrString) -> (DisplayFont, [AttrLine]))
-> [(DisplayFont, AttrString)] -> [(DisplayFont, [AttrLine])]
forall a b. (a -> b) -> [a] -> [b]
map ((AttrString -> [AttrLine])
-> (DisplayFont, AttrString) -> (DisplayFont, [AttrLine])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((AttrString -> [AttrLine])
 -> (DisplayFont, AttrString) -> (DisplayFont, [AttrLine]))
-> (AttrString -> [AttrLine])
-> (DisplayFont, AttrString)
-> (DisplayFont, [AttrLine])
forall a b. (a -> b) -> a -> b
$ Int -> Int -> AttrString -> [AttrLine]
splitAttrString (Int
rwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) (Int
rwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2)) ([(DisplayFont, AttrString)] -> [(DisplayFont, [AttrLine])])
-> [(DisplayFont, AttrString)] -> [(DisplayFont, [AttrLine])]
forall a b. (a -> b) -> a -> b
$
        (DisplayFont
propFont, Text -> AttrString
textToAS (Text
title Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"))
        (DisplayFont, AttrString)
-> [(DisplayFont, AttrString)] -> [(DisplayFont, AttrString)]
forall a. a -> [a] -> [a]
: [(DisplayFont, AttrString)]
-> [[(DisplayFont, AttrString)]] -> [(DisplayFont, AttrString)]
forall a. [a] -> [[a]] -> [a]
intercalate [(DisplayFont
monoFont, Text -> AttrString
textToAS Text
"\n")]
                       (((AttrString, Text) -> Maybe [(DisplayFont, AttrString)])
-> [(AttrString, Text)] -> [[(DisplayFont, AttrString)]]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (AttrString, Text) -> Maybe [(DisplayFont, AttrString)]
renderSection [(AttrString, Text)]
sections)
      -- Colour is used to delimit the section when displayed in one
      -- column, when using square fonts only.
      blurbEnd :: [(DisplayFont, [AttrLine])]
blurbEnd = ((DisplayFont, AttrString) -> (DisplayFont, [AttrLine]))
-> [(DisplayFont, AttrString)] -> [(DisplayFont, [AttrLine])]
forall a b. (a -> b) -> [a] -> [b]
map ((AttrString -> [AttrLine])
-> (DisplayFont, AttrString) -> (DisplayFont, [AttrLine])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((AttrString -> [AttrLine])
 -> (DisplayFont, AttrString) -> (DisplayFont, [AttrLine]))
-> (AttrString -> [AttrLine])
-> (DisplayFont, AttrString)
-> (DisplayFont, [AttrLine])
forall a b. (a -> b) -> a -> b
$ Int -> Int -> AttrString -> [AttrLine]
splitAttrString (Int
rwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) (Int
rwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2)) ([(DisplayFont, AttrString)] -> [(DisplayFont, [AttrLine])])
-> [(DisplayFont, AttrString)] -> [(DisplayFont, [AttrLine])]
forall a b. (a -> b) -> a -> b
$
        ( DisplayFont
propFont
        , Color -> Text -> AttrString
textFgToAS Color
Color.Brown
                     Text
"\nThis adventure's endings experienced so far:\n\n" )
          (DisplayFont, AttrString)
-> [(DisplayFont, AttrString)] -> [(DisplayFont, AttrString)]
forall a. a -> [a] -> [a]
: if [(DisplayFont, AttrString)] -> Bool
forall a. [a] -> Bool
null [(DisplayFont, AttrString)]
sectionsEndAS
            then [(DisplayFont
monoFont, Text -> AttrString
textToAS Text
"*none*")]
            else [(DisplayFont, AttrString)]
sectionsEndAS
      sectionsEndAS :: [(DisplayFont, AttrString)]
sectionsEndAS = [(DisplayFont, AttrString)]
-> [[(DisplayFont, AttrString)]] -> [(DisplayFont, AttrString)]
forall a. [a] -> [[a]] -> [a]
intercalate [(DisplayFont
monoFont, Text -> AttrString
textToAS Text
"\n")]
                                  (((AttrString, Text) -> Maybe [(DisplayFont, AttrString)])
-> [(AttrString, Text)] -> [[(DisplayFont, AttrString)]]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (AttrString, Text) -> Maybe [(DisplayFont, AttrString)]
renderSection [(AttrString, Text)]
sectionsEnd)
      sectionsEnd :: [(AttrString, Text)]
sectionsEnd = (Outcome -> (AttrString, Text))
-> [Outcome] -> [(AttrString, Text)]
forall a b. (a -> b) -> [a] -> [b]
map Outcome -> (AttrString, Text)
outcomeSection [Outcome
forall a. Bounded a => a
minBound..Outcome
forall a. Bounded a => a
maxBound]
      outcomeSection :: FK.Outcome -> (AttrString, Text)
      outcomeSection :: Outcome -> (AttrString, Text)
outcomeSection Outcome
outcome =
        ( Outcome -> AttrString
renderOutcome Outcome
outcome
        , if Bool -> Bool
not (Outcome -> Bool
outcomeSeen Outcome
outcome)
          then Text
""  -- a possible spoiler and lack of sense of progression
          else (Char -> Text) -> Text -> Text
T.concatMap Char -> Text
duplicateEOL
               (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Outcome -> [(Outcome, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Outcome
outcome
               ([(Outcome, Text)] -> Maybe Text)
-> [(Outcome, Text)] -> Maybe Text
forall a b. (a -> b) -> a -> b
$ ModeKind -> [(Outcome, Text)]
MK.mendMsg ModeKind
gameMode [(Outcome, Text)] -> [(Outcome, Text)] -> [(Outcome, Text)]
forall a. [a] -> [a] -> [a]
++ [(Outcome, Text)]
endMsgDefault  -- left-biased
        )
      -- These are not added to @mendMsg@, because they only fit here.
      endMsgDefault :: [(Outcome, Text)]
endMsgDefault =
        [ (Outcome
FK.Restart, Text
"No shame there is in noble defeat and there is honour in perseverance. Sometimes there are ways and places to turn rout into victory.")
        , (Outcome
FK.Camping, Text
"Don't fear to take breaks. While you move, others move, even on distant floors, but while you stay still, the world stays still.")
        ]
      scoreRecords :: [ScoreRecord]
scoreRecords = [ScoreRecord]
-> (ScoreTable -> [ScoreRecord])
-> Maybe ScoreTable
-> [ScoreRecord]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ScoreTable -> [ScoreRecord]
HighScore.unTable (Maybe ScoreTable -> [ScoreRecord])
-> Maybe ScoreTable -> [ScoreRecord]
forall a b. (a -> b) -> a -> b
$ ContentId ModeKind -> ScoreDict -> Maybe ScoreTable
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup ContentId ModeKind
gameModeId ScoreDict
scoreDict
      -- This doesn't use @svictories@, but high scores, because high scores
      -- are more persistent and granular (per-outcome). OTOH, @svictories@
      -- are per-challenge, which is important in other cases.
      -- @Camping@ and @Restart@ are fine to be less persistent.
      outcomeSeen :: FK.Outcome -> Bool
      outcomeSeen :: Outcome -> Bool
outcomeSeen Outcome
outcome = case Outcome
outcome of
        Outcome
FK.Camping -> ContentId ModeKind
gameModeId ContentId ModeKind -> EnumSet (ContentId ModeKind) -> Bool
forall k. Enum k => k -> EnumSet k -> Bool
`ES.member` EnumSet (ContentId ModeKind)
scampings
        Outcome
FK.Restart -> ContentId ModeKind
gameModeId ContentId ModeKind -> EnumSet (ContentId ModeKind) -> Bool
forall k. Enum k => k -> EnumSet k -> Bool
`ES.member` EnumSet (ContentId ModeKind)
srestarts
        Outcome
_ -> Outcome
outcome Outcome -> [Outcome] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (ScoreRecord -> Outcome) -> [ScoreRecord] -> [Outcome]
forall a b. (a -> b) -> [a] -> [b]
map (Status -> Outcome
stOutcome (Status -> Outcome)
-> (ScoreRecord -> Status) -> ScoreRecord -> Outcome
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScoreRecord -> Status
HighScore.getStatus) [ScoreRecord]
scoreRecords
      -- Camping not taken into account.
      lastOutcome :: FK.Outcome
      lastOutcome :: Outcome
lastOutcome = if [ScoreRecord] -> Bool
forall a. [a] -> Bool
null [ScoreRecord]
scoreRecords
                    then Outcome
FK.Restart  -- only if nothing else
                    else Status -> Outcome
stOutcome (Status -> Outcome)
-> (ScoreRecord -> Status) -> ScoreRecord -> Outcome
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScoreRecord -> Status
HighScore.getStatus
                         (ScoreRecord -> Outcome) -> ScoreRecord -> Outcome
forall a b. (a -> b) -> a -> b
$ (ScoreRecord -> ScoreRecord -> Ordering)
-> [ScoreRecord] -> ScoreRecord
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy ((ScoreRecord -> POSIXTime)
-> ScoreRecord -> ScoreRecord -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing ScoreRecord -> POSIXTime
HighScore.getDate) [ScoreRecord]
scoreRecords
      renderOutcome :: FK.Outcome -> AttrString
      renderOutcome :: Outcome -> AttrString
renderOutcome Outcome
outcome =
        let color :: Color
color | Outcome
outcome Outcome -> [Outcome] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Outcome]
FK.deafeatOutcomes = Color
Color.cVeryBadEvent
                  | Outcome
outcome Outcome -> [Outcome] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Outcome]
FK.victoryOutcomes = Color
Color.cVeryGoodEvent
                  | Bool
otherwise = Color
Color.cNeutralEvent
            lastRemark :: Text
lastRemark
              | Outcome
outcome Outcome -> Outcome -> Bool
forall a. Eq a => a -> a -> Bool
/= Outcome
lastOutcome = Text
""
              | Outcome
outcome Outcome -> [Outcome] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Outcome]
FK.deafeatOutcomes = Text
"(last suffered ending)"
              | Outcome
outcome Outcome -> [Outcome] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Outcome]
FK.victoryOutcomes = Text
"(last achieved ending)"
              | Bool
otherwise = Text
"(last seen ending)"
        in Text -> AttrString
textToAS Text
"Game over message when"
           AttrString -> AttrString -> AttrString
<+:> (Color -> Text -> AttrString
textFgToAS Color
color (Text -> Text
T.toTitle (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Outcome -> Text
FK.nameOutcomePast Outcome
outcome)
                 AttrString -> AttrString -> AttrString
<+:> Text -> AttrString
textToAS Text
lastRemark)
           AttrString -> AttrString -> AttrString
forall a. Semigroup a => a -> a -> a
<> Text -> AttrString
textToAS Text
":"
  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
$! if DisplayFont -> Bool
isSquareFont DisplayFont
propFont
            then DisplayFont -> Overlay -> EnumMap DisplayFont Overlay
forall k a. Enum k => k -> a -> EnumMap k a
EM.singleton DisplayFont
squareFont  -- single column, single font
                 (Overlay -> EnumMap DisplayFont Overlay)
-> Overlay -> EnumMap DisplayFont Overlay
forall a b. (a -> b) -> a -> b
$ Int -> Overlay -> Overlay
xtranslateOverlay Int
2 (Overlay -> Overlay) -> Overlay -> Overlay
forall a b. (a -> b) -> a -> b
$ [AttrLine] -> Overlay
offsetOverlay
                 ([AttrLine] -> Overlay) -> [AttrLine] -> Overlay
forall a b. (a -> b) -> a -> b
$ ((DisplayFont, [AttrLine]) -> [AttrLine])
-> [(DisplayFont, [AttrLine])] -> [AttrLine]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (DisplayFont, [AttrLine]) -> [AttrLine]
forall a b. (a, b) -> b
snd ([(DisplayFont, [AttrLine])] -> [AttrLine])
-> [(DisplayFont, [AttrLine])] -> [AttrLine]
forall a b. (a -> b) -> a -> b
$ [(DisplayFont, [AttrLine])]
blurb [(DisplayFont, [AttrLine])]
-> [(DisplayFont, [AttrLine])] -> [(DisplayFont, [AttrLine])]
forall a. [a] -> [a] -> [a]
++ [(DisplayFont, [AttrLine])]
blurbEnd
            else (Overlay -> Overlay -> Overlay)
-> EnumMap DisplayFont Overlay
-> EnumMap DisplayFont Overlay
-> EnumMap DisplayFont Overlay
forall a k.
(a -> a -> a) -> EnumMap k a -> EnumMap k a -> EnumMap k a
EM.unionWith Overlay -> Overlay -> Overlay
forall a. [a] -> [a] -> [a]
(++)
                 ((Overlay -> Overlay)
-> EnumMap DisplayFont Overlay -> EnumMap DisplayFont Overlay
forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
EM.map (Int -> Overlay -> Overlay
xtranslateOverlay Int
1)
                  (EnumMap DisplayFont Overlay -> EnumMap DisplayFont Overlay)
-> EnumMap DisplayFont Overlay -> EnumMap DisplayFont Overlay
forall a b. (a -> b) -> a -> b
$ [(DisplayFont, [AttrLine])] -> EnumMap DisplayFont Overlay
attrLinesToFontMap [(DisplayFont, [AttrLine])]
blurb)
                 ((Overlay -> Overlay)
-> EnumMap DisplayFont Overlay -> EnumMap DisplayFont Overlay
forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
EM.map (Int -> Overlay -> Overlay
xtranslateOverlay (Int -> Overlay -> Overlay) -> Int -> Overlay -> Overlay
forall a b. (a -> b) -> a -> b
$ Int
rwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                  (EnumMap DisplayFont Overlay -> EnumMap DisplayFont Overlay)
-> EnumMap DisplayFont Overlay -> EnumMap DisplayFont Overlay
forall a b. (a -> b) -> a -> b
$ [(DisplayFont, [AttrLine])] -> EnumMap DisplayFont Overlay
attrLinesToFontMap [(DisplayFont, [AttrLine])]
blurbEnd)

pickNumber :: MonadClientUI m => Bool -> Int -> m (Either MError Int)
pickNumber :: Bool -> Int -> m (Either MError Int)
pickNumber Bool
askNumber Int
kAll = Bool -> m (Either MError Int) -> m (Either MError Int)
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
kAll Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1) (m (Either MError Int) -> m (Either MError Int))
-> m (Either MError Int) -> m (Either MError Int)
forall a b. (a -> b) -> a -> b
$ do
  let shownKeys :: [KM]
shownKeys = [ KM
K.returnKM, KM
K.spaceKM, Char -> KM
K.mkChar Char
'+', Char -> KM
K.mkChar Char
'-'
                  , KM
K.backspaceKM, KM
K.escKM ]
      frontKeyKeys :: [KM]
frontKeyKeys = [KM]
shownKeys [KM] -> [KM] -> [KM]
forall a. [a] -> [a] -> [a]
++ (Char -> KM) -> String -> [KM]
forall a b. (a -> b) -> [a] -> [b]
map Char -> KM
K.mkChar [Char
'0'..Char
'9']
      gatherNumber :: Int -> m (Either MError Int)
gatherNumber Int
kCur = Bool -> m (Either MError Int) -> m (Either MError Int)
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
kCur Bool -> Bool -> Bool
&& Int
kCur Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
kAll) (m (Either MError Int) -> m (Either MError Int))
-> m (Either MError Int) -> m (Either MError Int)
forall a b. (a -> b) -> a -> b
$ do
        let kprompt :: Text
kprompt = Text
"Choose number:" Text -> Text -> Text
<+> Int -> Text
forall a. Show a => a -> Text
tshow Int
kCur
        MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgPromptGeneric Text
kprompt
        Slideshow
sli <- [KM] -> m Slideshow
forall (m :: * -> *). MonadClientUI m => [KM] -> m Slideshow
reportToSlideshow [KM]
shownKeys
        KeyOrSlot
ekkm <- String -> ColorMode -> Bool -> Slideshow -> [KM] -> m KeyOrSlot
forall (m :: * -> *).
MonadClientUI m =>
String -> ColorMode -> Bool -> Slideshow -> [KM] -> m KeyOrSlot
displayChoiceScreen String
"" ColorMode
ColorFull Bool
False Slideshow
sli [KM]
frontKeyKeys
        case KeyOrSlot
ekkm of
          Left KM
kkm ->
            case KM -> Key
K.key KM
kkm of
              K.Char Char
'+' ->
                Int -> m (Either MError Int)
gatherNumber (Int -> m (Either MError Int)) -> Int -> m (Either MError Int)
forall a b. (a -> b) -> a -> b
$ if Int
kCur Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
kAll then Int
1 else Int
kCur Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
              K.Char Char
'-' ->
                Int -> m (Either MError Int)
gatherNumber (Int -> m (Either MError Int)) -> Int -> m (Either MError Int)
forall a b. (a -> b) -> a -> b
$ if Int
kCur Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 then Int
kAll else Int
kCur Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
              K.Char Char
l | Int
kCur Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
Char.digitToInt Char
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
kAll ->
                Int -> m (Either MError Int)
gatherNumber (Int -> m (Either MError Int)) -> Int -> m (Either MError Int)
forall a b. (a -> b) -> a -> b
$ if Char -> Int
Char.digitToInt Char
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
                               then Int
kAll
                               else Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
kAll (Char -> Int
Char.digitToInt Char
l)
              K.Char Char
l -> Int -> m (Either MError Int)
gatherNumber (Int -> m (Either MError Int)) -> Int -> m (Either MError Int)
forall a b. (a -> b) -> a -> b
$ Int
kCur Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
Char.digitToInt Char
l
              Key
K.BackSpace -> Int -> m (Either MError Int)
gatherNumber (Int -> m (Either MError Int)) -> Int -> m (Either MError Int)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Int
kCur Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
10)
              Key
K.Return -> Either MError Int -> m (Either MError Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either MError Int -> m (Either MError Int))
-> Either MError Int -> m (Either MError Int)
forall a b. (a -> b) -> a -> b
$ Int -> Either MError Int
forall a b. b -> Either a b
Right Int
kCur
              Key
K.Esc -> FailOrCmd Int -> Either MError Int
forall a. FailOrCmd a -> Either MError a
weaveJust (FailOrCmd Int -> Either MError Int)
-> m (FailOrCmd Int) -> m (Either MError Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> m (FailOrCmd Int)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith Text
"never mind"
              Key
K.Space -> Either MError Int -> m (Either MError Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either MError Int -> m (Either MError Int))
-> Either MError Int -> m (Either MError Int)
forall a b. (a -> b) -> a -> b
$ MError -> Either MError Int
forall a b. a -> Either a b
Left MError
forall a. Maybe a
Nothing
              Key
_ -> String -> m (Either MError Int)
forall a. (?callStack::CallStack) => String -> a
error (String -> m (Either MError Int))
-> String -> m (Either MError Int)
forall a b. (a -> b) -> a -> b
$ String
"unexpected key" String -> KM -> String
forall v. Show v => String -> v -> String
`showFailure` KM
kkm
          Right MenuSlot
slot -> String -> m (Either MError Int)
forall a. (?callStack::CallStack) => String -> a
error (String -> m (Either MError Int))
-> String -> m (Either MError Int)
forall a b. (a -> b) -> a -> b
$ String
"unexpected menu slot" String -> MenuSlot -> String
forall v. Show v => String -> v -> String
`showFailure` MenuSlot
slot
  if Int
kAll Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
askNumber
  then Either MError Int -> m (Either MError Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either MError Int -> m (Either MError Int))
-> Either MError Int -> m (Either MError Int)
forall a b. (a -> b) -> a -> b
$ Int -> Either MError Int
forall a b. b -> Either a b
Right Int
kAll
  else do
    Either MError Int
res <- Int -> m (Either MError Int)
gatherNumber Int
kAll
    case Either MError Int
res of
      Right Int
k | Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 -> String -> m (Either MError Int)
forall a. (?callStack::CallStack) => String -> a
error (String -> m (Either MError Int))
-> String -> m (Either MError Int)
forall a b. (a -> b) -> a -> b
$ String
"" String -> (Either MError Int, Int) -> String
forall v. Show v => String -> v -> String
`showFailure` (Either MError Int
res, Int
kAll)
      Either MError Int
_ -> Either MError Int -> m (Either MError Int)
forall (m :: * -> *) a. Monad m => a -> m a
return Either MError Int
res

-- | Produces a textual description of the tile at a position.
lookAtTile :: MonadClientUI m
           => Bool             -- ^ can be seen right now?
           -> Point            -- ^ position to describe
           -> LevelId          -- ^ level the position is at
           -> Maybe ActorId    -- ^ the actor that looks
           -> Maybe MU.Person  -- ^ grammatical person of the item(s), if any
           -> m (Text, Text, [(Int, MU.Part)])
lookAtTile :: Bool
-> Point
-> LevelId
-> Maybe ActorId
-> Maybe Person
-> m (Text, Text, [(Int, Part)])
lookAtTile Bool
canSee Point
p LevelId
lidV Maybe ActorId
maid Maybe Person
mperson = 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
  cops :: COps
cops@COps{ContentData TileKind
cotile :: COps -> ContentData TileKind
cotile :: ContentData TileKind
cotile, ContentData PlaceKind
coplace :: ContentData PlaceKind
coplace :: COps -> ContentData PlaceKind
coplace} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  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
  Maybe Actor
mb <- (State -> Maybe Actor) -> m (Maybe Actor)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Maybe Actor) -> m (Maybe Actor))
-> (State -> Maybe Actor) -> m (Maybe Actor)
forall a b. (a -> b) -> a -> b
$ \State
s -> (ActorId -> State -> Actor) -> State -> ActorId -> Actor
forall a b c. (a -> b -> c) -> b -> a -> c
flip ActorId -> State -> Actor
getActorBody State
s (ActorId -> Actor) -> Maybe ActorId -> Maybe Actor
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ActorId
maid
  Level
lvl <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel LevelId
lidV
  Maybe AimMode
saimMode <- (SessionUI -> Maybe AimMode) -> m (Maybe AimMode)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe AimMode
saimMode
  ItemBag
embeds <- (State -> ItemBag) -> m ItemBag
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemBag) -> m ItemBag)
-> (State -> ItemBag) -> m ItemBag
forall a b. (a -> b) -> a -> b
$ LevelId -> Point -> State -> ItemBag
getEmbedBag LevelId
lidV Point
p
  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
  Int
seps <- (StateClient -> Int) -> m Int
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Int
seps
  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
lidV
  ItemId -> ItemKind
getKind <- (State -> ItemId -> ItemKind) -> m (ItemId -> ItemKind)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemId -> ItemKind) -> m (ItemId -> ItemKind))
-> (State -> ItemId -> ItemKind) -> m (ItemId -> ItemKind)
forall a b. (a -> b) -> a -> b
$ (ItemId -> State -> ItemKind) -> State -> ItemId -> ItemKind
forall a b c. (a -> b -> c) -> b -> a -> c
flip ItemId -> State -> ItemKind
getIidKind
  let inhabitants :: [ActorId]
inhabitants = Point -> Level -> [ActorId]
posToAidsLvl Point
p Level
lvl
      detail :: DetailLevel
detail = DetailLevel
-> (AimMode -> DetailLevel) -> Maybe AimMode -> DetailLevel
forall b a. b -> (a -> b) -> Maybe a -> b
maybe DetailLevel
DetailAll AimMode -> DetailLevel
detailLevel Maybe AimMode
saimMode
      aims :: Bool
aims = Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Int -> Bool) -> Maybe Int -> Bool
forall a b. (a -> b) -> a -> b
$ (\Actor
b -> Bool -> Actor -> Point -> Int -> COps -> Level -> Maybe Int
makeLine Bool
False Actor
b Point
p Int
seps COps
cops Level
lvl) (Actor -> Maybe Int) -> Maybe Actor -> Maybe Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Actor
mb
      tkid :: ContentId TileKind
tkid = Level
lvl Level -> Point -> ContentId TileKind
`at` Point
p
      tile :: TileKind
tile = ContentData TileKind -> ContentId TileKind -> TileKind
forall a. ContentData a -> ContentId a -> a
okind ContentData TileKind
cotile ContentId TileKind
tkid
      vis :: Part
vis | TileKind -> Text
TK.tname TileKind
tile Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"unknown space" = Part
"that is"
          | Bool -> Bool
not ([ActorId] -> Bool
forall a. [a] -> Bool
null [ActorId]
inhabitants)
            Bool -> Bool -> Bool
&& (Actor -> Point
bpos (Actor -> Point) -> Maybe Actor -> Maybe Point
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Actor
mb) Maybe Point -> Maybe Point -> Bool
forall a. Eq a => a -> a -> Bool
/= Point -> Maybe Point
forall a. a -> Maybe a
Just Point
p = Part
"the terrain here is"
          | Bool -> Bool
not Bool
canSee = Part
"you remember"
          | Bool -> Bool
not Bool
aims = Part
"you are aware of"  -- walkable path a proxy for in LOS
          | Bool
otherwise = Part
"you see"
      vperson :: Part
vperson = case Maybe Person
mperson of
        Maybe Person
Nothing -> Part
vis
        Just Person
MU.Sg1st -> String -> Part
forall a. (?callStack::CallStack) => String -> a
error String
"an item speaks in first person"
        Just Person
MU.Sg3rd -> Part
"It is laying on"
        Just Person
MU.PlEtc -> Part
"They lay on"
      tilePart :: Part
tilePart = Part -> Part
MU.AW (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ TileKind -> Text
TK.tname TileKind
tile
      entrySentence :: ContentId PlaceKind -> Part -> Text
entrySentence ContentId PlaceKind
pk Part
blurb =
        [Part] -> Text
makeSentence [Part
blurb, Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ PlaceKind -> Text
PK.pname (PlaceKind -> Text) -> PlaceKind -> Text
forall a b. (a -> b) -> a -> b
$ ContentData PlaceKind -> ContentId PlaceKind -> PlaceKind
forall a. ContentData a -> ContentId a -> a
okind ContentData PlaceKind
coplace ContentId PlaceKind
pk]
      placeBlurb :: Text
placeBlurb = case Point -> EntryMap -> Maybe PlaceEntry
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup Point
p (EntryMap -> Maybe PlaceEntry) -> EntryMap -> Maybe PlaceEntry
forall a b. (a -> b) -> a -> b
$ Level -> EntryMap
lentry Level
lvl of
        Maybe PlaceEntry
Nothing -> Text
""
        Just (PK.PEntry ContentId PlaceKind
pk) -> ContentId PlaceKind -> Part -> Text
entrySentence ContentId PlaceKind
pk Part
"it is an entrance to"
        Just (PK.PAround ContentId PlaceKind
pk) -> ContentId PlaceKind -> Part -> Text
entrySentence ContentId PlaceKind
pk Part
"it surrounds"
        Just (PK.PExists ContentId PlaceKind
_) -> Text
""
      embedLook :: (ItemId, ItemQuant) -> (Int, Part)
embedLook (ItemId
iid, kit :: ItemQuant
kit@(Int
k, ItemTimers
_)) =
        let itemFull :: ItemFull
itemFull = ItemId -> ItemFull
itemToF ItemId
iid
            nWs :: Part
nWs = DetailLevel
-> Int
-> FactionId
-> EnumMap FactionId Faction
-> Int
-> Time
-> ItemFull
-> ItemQuant
-> Part
partItemWsDetail DetailLevel
detail
                                   Int
rwidth FactionId
side EnumMap FactionId Faction
factionD Int
k Time
localTime ItemFull
itemFull ItemQuant
kit
        in (Int
k, Part
nWs)
      embedKindList :: [(ItemKind, (ItemId, ItemQuant))]
embedKindList =
        ((ItemId, ItemQuant) -> (ItemKind, (ItemId, ItemQuant)))
-> [(ItemId, ItemQuant)] -> [(ItemKind, (ItemId, ItemQuant))]
forall a b. (a -> b) -> [a] -> [b]
map (\(ItemId
iid, ItemQuant
kit) -> (ItemId -> ItemKind
getKind ItemId
iid, (ItemId
iid, ItemQuant
kit))) (ItemBag -> [(ItemId, ItemQuant)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs ItemBag
embeds)
      embedList :: [(Int, Part)]
embedList = ((ItemId, ItemQuant) -> (Int, Part))
-> [(ItemId, ItemQuant)] -> [(Int, Part)]
forall a b. (a -> b) -> [a] -> [b]
map (ItemId, ItemQuant) -> (Int, Part)
embedLook ([(ItemId, ItemQuant)] -> [(Int, Part)])
-> [(ItemId, ItemQuant)] -> [(Int, Part)]
forall a b. (a -> b) -> a -> b
$ COps
-> ContentId TileKind
-> [(ItemKind, (ItemId, ItemQuant))]
-> [(ItemId, ItemQuant)]
sortEmbeds COps
cops ContentId TileKind
tkid [(ItemKind, (ItemId, ItemQuant))]
embedKindList
  (Text, Text, [(Int, Part)]) -> m (Text, Text, [(Int, Part)])
forall (m :: * -> *) a. Monad m => a -> m a
return ([Part] -> Text
makeSentence [Part
vperson, Part
tilePart], Text
placeBlurb, [(Int, Part)]
embedList)

-- | Produces a textual description of actors at a position.
lookAtActors :: MonadClientUI m
             => Point      -- ^ position to describe
             -> LevelId    -- ^ level the position is at
             -> m (Text, Maybe (MU.Part, Bool), Text)
lookAtActors :: Point -> LevelId -> m (Text, Maybe (Part, Bool), Text)
lookAtActors Point
p LevelId
lidV = 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
  FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
  [(ActorId, Actor)]
inhabitants <- (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
$ Point -> LevelId -> State -> [(ActorId, Actor)]
posToAidAssocs Point
p LevelId
lidV
  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
  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
lidV
  Maybe AimMode
saimMode <- (SessionUI -> Maybe AimMode) -> m (Maybe AimMode)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe AimMode
saimMode
  let detail :: DetailLevel
detail = DetailLevel
-> (AimMode -> DetailLevel) -> Maybe AimMode -> DetailLevel
forall b a. b -> (a -> b) -> Maybe a -> b
maybe DetailLevel
DetailAll AimMode -> DetailLevel
detailLevel Maybe AimMode
saimMode
  case [(ActorId, Actor)]
inhabitants of
    [] -> (Text, Maybe (Part, Bool), Text)
-> m (Text, Maybe (Part, Bool), Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
"", Maybe (Part, Bool)
forall a. Maybe a
Nothing, Text
"")
    (ActorId
aid, Actor
body) : [(ActorId, Actor)]
rest -> do
      Part
actorPronoun <- ActorId -> m Part
forall (m :: * -> *). MonadClientUI m => ActorId -> m Part
partPronounLeader 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 -> State -> ItemFull) -> ItemId -> State -> ItemFull
forall a b. (a -> b) -> a -> b
$ Actor -> ItemId
btrunk Actor
body
      [Part]
guardVerbs <- (State -> [Part]) -> m [Part]
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [Part]) -> m [Part]) -> (State -> [Part]) -> m [Part]
forall a b. (a -> b) -> a -> b
$ Actor -> State -> [Part]
guardItemVerbs Actor
body
      [Part]
subjects <- ((ActorId, Actor) -> m Part) -> [(ActorId, Actor)] -> m [Part]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ActorId -> m Part
forall (m :: * -> *). MonadClientUI m => ActorId -> m Part
partActorLeader (ActorId -> m Part)
-> ((ActorId, Actor) -> ActorId) -> (ActorId, Actor) -> m Part
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ActorId, Actor) -> ActorId
forall a b. (a, b) -> a
fst) [(ActorId, Actor)]
inhabitants
      let bfact :: Faction
bfact = EnumMap FactionId Faction
factionD EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
body
          -- No "a" prefix even if singular and inanimate, to distinguish
          -- from items lying on the floor (and to simplify code).
          (Part
subject, Person
person) = [Part] -> (Part, Person)
squashedWWandW [Part]
subjects
          resideVerb :: Part
resideVerb = case Actor -> Watchfulness
bwatch Actor
body of
            Watchfulness
WWatch -> Part
"be here"
            WWait Int
0 -> Part
"idle here"
            WWait Int
_ -> Part
"brace for impact"
            Watchfulness
WSleep -> Part
"sleep here"
            Watchfulness
WWake -> Part
"be waking up"
          flyVerb :: Part
flyVerb | Actor -> Bool
bproj Actor
body = Part
"zip through here"
                  | Maybe ([Vector], Speed) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe ([Vector], Speed) -> Bool)
-> Maybe ([Vector], Speed) -> Bool
forall a b. (a -> b) -> a -> b
$ Actor -> Maybe ([Vector], Speed)
btrajectory Actor
body = Part
"move through here"
                  | Bool
otherwise = Part
resideVerb
          verbs :: [Part]
verbs = Part
flyVerb Part -> [Part] -> [Part]
forall a. a -> [a] -> [a]
: [Part]
guardVerbs
          projDesc :: Text
projDesc | Bool -> Bool
not (Actor -> Bool
bproj Actor
body) Bool -> Bool -> Bool
|| DetailLevel
detail DetailLevel -> DetailLevel -> Bool
forall a. Ord a => a -> a -> Bool
< DetailLevel
DetailAll = Text
""
                   | Bool
otherwise =
            let kit :: ItemQuant
kit = Actor -> ItemBag
beqp Actor
body ItemBag -> ItemId -> ItemQuant
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> ItemId
btrunk Actor
body
                ps :: [Part]
ps = [Int
-> FactionId
-> EnumMap FactionId Faction
-> Time
-> ItemFull
-> ItemQuant
-> Part
partItemMediumAW Int
rwidth FactionId
side EnumMap FactionId Faction
factionD Time
localTime
                                       ItemFull
itemFull ItemQuant
kit]
                tailWords :: [Part] -> [Text]
tailWords = [Text] -> [Text]
forall a. [a] -> [a]
tail ([Text] -> [Text]) -> ([Part] -> [Text]) -> [Part] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.words (Text -> [Text]) -> ([Part] -> Text) -> [Part] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Part] -> Text
makePhrase
            in if [Part] -> [Text]
tailWords [Part]
ps [Text] -> [Text] -> Bool
forall a. Eq a => a -> a -> Bool
== [Part] -> [Text]
tailWords [Part]
subjects
               then Text
""
               else [Part] -> Text
makeSentence ([Part] -> Text) -> [Part] -> Text
forall a b. (a -> b) -> a -> b
$ Part
"this is" Part -> [Part] -> [Part]
forall a. a -> [a] -> [a]
: [Part]
ps
          factDesc :: Text
factDesc = case Item -> Maybe FactionId
jfid (Item -> Maybe FactionId) -> Item -> Maybe FactionId
forall a b. (a -> b) -> a -> b
$ ItemFull -> Item
itemBase ItemFull
itemFull of
            Just FactionId
tfid | FactionId
tfid FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
/= Actor -> FactionId
bfid Actor
body ->
              let dominatedBy :: Text
dominatedBy = if Actor -> FactionId
bfid Actor
body FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side then Text
"us" else Faction -> Text
gname Faction
bfact
                  tfact :: Faction
tfact = EnumMap FactionId Faction
factionD EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
tfid
              in Text
"Originally of" Text -> Text -> Text
<+> Faction -> Text
gname Faction
tfact
                 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", now fighting for" Text -> Text -> Text
<+> Text
dominatedBy Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
            Maybe FactionId
_ | DetailLevel
detail DetailLevel -> DetailLevel -> Bool
forall a. Ord a => a -> a -> Bool
< DetailLevel
DetailAll -> Text
""  -- only domination worth spamming
            Maybe FactionId
_ | Actor -> FactionId
bfid Actor
body FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side -> Text
""  -- just one of us
            Maybe FactionId
_ | Actor -> Bool
bproj Actor
body -> Text
"Launched by" Text -> Text -> Text
<+> Faction -> Text
gname Faction
bfact Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
            Maybe FactionId
_ -> Text
"One of" Text -> Text -> Text
<+> Faction -> Text
gname Faction
bfact Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
          idesc :: Text
idesc = if DetailLevel
detail DetailLevel -> DetailLevel -> Bool
forall a. Ord a => a -> a -> Bool
< DetailLevel
DetailAll
                  then Text
""
                  else ItemKind -> Text
IK.idesc (ItemKind -> Text) -> ItemKind -> Text
forall a b. (a -> b) -> a -> b
$ ItemFull -> ItemKind
itemKind ItemFull
itemFull
          -- If many different actors, only list names.
          sameTrunks :: Bool
sameTrunks = ((ActorId, Actor) -> Bool) -> [(ActorId, Actor)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\(ActorId
_, Actor
b) -> Actor -> ItemId
btrunk Actor
b ItemId -> ItemId -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> ItemId
btrunk Actor
body) [(ActorId, Actor)]
rest
          desc :: Text
desc = Text -> Text
wrapInParens (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
projDesc Text -> Text -> Text
<+> Text
factDesc Text -> Text -> Text
<+> Text
idesc
          onlyIs :: Bool
onlyIs = Actor -> Watchfulness
bwatch Actor
body Watchfulness -> Watchfulness -> Bool
forall a. Eq a => a -> a -> Bool
== Watchfulness
WWatch Bool -> Bool -> Bool
&& [Part] -> Bool
forall a. [a] -> Bool
null [Part]
guardVerbs
          allBlurb :: Text
allBlurb = [Part] -> Text
makeSentence [Part -> Person -> Polarity -> Part -> [Part] -> Part
MU.SubjectVVxV Part
"and" Person
person Polarity
MU.Yes
                                                  Part
subject [Part]
verbs]
          headBlurb :: Text
headBlurb = [Part] -> Text
makeSentence [Part -> Person -> Polarity -> Part -> [Part] -> Part
MU.SubjectVVxV Part
"and" Person
MU.Sg3rd Polarity
MU.Yes
                                                   ([Part] -> Part
forall a. [a] -> a
head [Part]
subjects) [Part]
verbs]
          andProjectiles :: Text
andProjectiles = case [Part]
subjects of
            Part
_ : projs :: [Part]
projs@(Part
_ : [Part]
_) ->
              let (Part
subjectProjs, Person
personProjs) =
                    [Part] -> (Part, Person)
squashedWWandW [Part]
projs
              in [Part] -> Text
makeSentence
                   [Person -> Polarity -> Part -> Part -> Part
MU.SubjectVerb Person
personProjs Polarity
MU.Yes
                                   Part
subjectProjs Part
"can be seen"]
            [Part]
_ -> Text
""
          actorAlive :: Bool
actorAlive = Actor -> Int64
bhp Actor
body Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int64
0
          mactorPronounAlive :: Maybe (Part, Bool)
mactorPronounAlive =
            if Actor -> Bool
bproj Actor
body then Maybe (Part, Bool)
forall a. Maybe a
Nothing else (Part, Bool) -> Maybe (Part, Bool)
forall a. a -> Maybe a
Just (Part
actorPronoun, Bool
actorAlive)
      (Text, Maybe (Part, Bool), Text)
-> m (Text, Maybe (Part, Bool), Text)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Text, Maybe (Part, Bool), Text)
 -> m (Text, Maybe (Part, Bool), Text))
-> (Text, Maybe (Part, Bool), Text)
-> m (Text, Maybe (Part, Bool), Text)
forall a b. (a -> b) -> a -> b
$!
        if | Bool -> Bool
not Bool
actorAlive Bool -> Bool -> Bool
&& Bool -> Bool
not (Actor -> Bool
bproj Actor
body) ->
             ( [Part] -> Text
makeSentence
                 (Part -> Part -> Part
MU.SubjectVerbSg ([Part] -> Part
forall a. [a] -> a
head [Part]
subjects) Part
"lie here"
                  Part -> [Part] -> [Part]
forall a. a -> [a] -> [a]
: if [Part] -> Bool
forall a. [a] -> Bool
null [Part]
guardVerbs
                    then []
                    else [ Part -> Person -> Polarity -> Part -> [Part] -> Part
MU.SubjectVVxV Part
"and" Person
MU.Sg3rd Polarity
MU.No
                                          Part
"and" [Part]
guardVerbs
                         , Part
"any more" ])
             , Maybe (Part, Bool)
mactorPronounAlive
             , Text -> Text
wrapInParens Text
desc Text -> Text -> Text
<+> Text
andProjectiles )
           | Bool
sameTrunks ->  -- only non-proj or several similar projectiles
             ( Text
allBlurb
             , Maybe (Part, Bool)
mactorPronounAlive
             , Text
desc )
           | Bool -> Bool
not (Actor -> Bool
bproj Actor
body) Bool -> Bool -> Bool
&& Bool
onlyIs ->
             ( Text
headBlurb
             , Maybe (Part, Bool)
mactorPronounAlive
             , Text
desc Text -> Text -> Text
<+> Text
andProjectiles )
           | Bool -> Bool
not (Actor -> Bool
bproj Actor
body) ->
             ( [Part] -> Text
makeSentence [Part
subject, Part
"can be seen"] Text -> Text -> Text
<+> Text
headBlurb
             , Maybe (Part, Bool)
mactorPronounAlive
             , Text
desc )
           | Bool
otherwise -> Bool
-> (Text, Maybe (Part, Bool), Text)
-> (Text, Maybe (Part, Bool), Text)
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Actor -> Bool
bproj Actor
body Bool -> Bool -> Bool
&& Bool -> Bool
not ([(ActorId, Actor)] -> Bool
forall a. [a] -> Bool
null [(ActorId, Actor)]
rest))
             ( [Part] -> Text
makeSentence [Part
subject, Part
"can be seen"]
             , Maybe (Part, Bool)
forall a. Maybe a
Nothing
             , Text
"" )

guardItemVerbs :: Actor -> State -> [MU.Part]
guardItemVerbs :: Actor -> State -> [Part]
guardItemVerbs Actor
body State
s =
  -- We only hint while, in reality, currently the client knows
  -- all the items in eqp of the foe. But we may remove the knowledge
  -- in the future and, anyway, it would require a dedicated
  -- UI mode beyond a couple of items per actor.
  let itemsSize :: Int
itemsSize = Actor -> State -> Int
guardItemSize Actor
body State
s
      belongingsVerbs :: [Part]
belongingsVerbs | Int
itemsSize Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = [Part
"fondle a trinket"]
                      | Int
itemsSize Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 = [Part
"haul a hoard"]
                      | Bool
otherwise = []
  in if Actor -> Bool
bproj Actor
body then [] else [Part]
belongingsVerbs

guardItemSize :: Actor -> State -> Int
guardItemSize :: Actor -> State -> Int
guardItemSize Actor
body State
s =
  let toReport :: ItemId -> Bool
toReport ItemId
iid =
        let itemKind :: ItemKind
itemKind = ItemId -> State -> ItemKind
getIidKind ItemId
iid State
s
        in Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (GroupName ItemKind -> [(GroupName ItemKind, Int)] -> Maybe Int
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup GroupName ItemKind
IK.UNREPORTED_INVENTORY (ItemKind -> [(GroupName ItemKind, Int)]
IK.ifreq ItemKind
itemKind)) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
  in [ItemId] -> Int
forall a. [a] -> Int
length ([ItemId] -> Int) -> [ItemId] -> Int
forall a b. (a -> b) -> a -> b
$ (ItemId -> Bool) -> [ItemId] -> [ItemId]
forall a. (a -> Bool) -> [a] -> [a]
filter ItemId -> Bool
toReport ([ItemId] -> [ItemId]) -> [ItemId] -> [ItemId]
forall a b. (a -> b) -> a -> b
$ ItemBag -> [ItemId]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys (Actor -> ItemBag
beqp Actor
body)

-- | Produces a textual description of items at a position.
lookAtItems :: MonadClientUI m
            => Bool     -- ^ can be seen right now?
            -> Point    -- ^ position to describe
            -> LevelId  -- ^ level the position is at
            -> Maybe ActorId
                        -- ^ the actor that looks
            -> Maybe (MU.Part, Bool)
                        -- ^ pronoun for the big actor at the position, if any,
                        --   and whether the big actor is alive
            -> m (Text, Maybe MU.Person)
lookAtItems :: Bool
-> Point
-> LevelId
-> Maybe ActorId
-> Maybe (Part, Bool)
-> m (Text, Maybe Person)
lookAtItems Bool
canSee Point
p LevelId
lidV Maybe ActorId
maid Maybe (Part, Bool)
mactorPronounAlive = 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
  FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
  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
  Maybe Actor
mb <- (State -> Maybe Actor) -> m (Maybe Actor)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Maybe Actor) -> m (Maybe Actor))
-> (State -> Maybe Actor) -> m (Maybe Actor)
forall a b. (a -> b) -> a -> b
$ \State
s -> (ActorId -> State -> Actor) -> State -> ActorId -> Actor
forall a b c. (a -> b -> c) -> b -> a -> c
flip ActorId -> State -> Actor
getActorBody State
s (ActorId -> Actor) -> Maybe ActorId -> Maybe Actor
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ActorId
maid
  -- Not using @viewedLevelUI@, because @aid@ may be temporarily not a leader.
  Maybe AimMode
saimMode <- (SessionUI -> Maybe AimMode) -> m (Maybe AimMode)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe AimMode
saimMode
  let standingOn :: Bool
standingOn = Point -> Maybe Point
forall a. a -> Maybe a
Just Point
p Maybe Point -> Maybe Point -> Bool
forall a. Eq a => a -> a -> Bool
== (Actor -> Point
bpos (Actor -> Point) -> Maybe Actor -> Maybe Point
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Actor
mb) Bool -> Bool -> Bool
&& LevelId -> Maybe LevelId
forall a. a -> Maybe a
Just LevelId
lidV Maybe LevelId -> Maybe LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== (Actor -> LevelId
blid (Actor -> LevelId) -> Maybe Actor -> Maybe LevelId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Actor
mb)
      -- In exploration mode the detail level depends on whether the actor
      -- that looks stand over the items, because then he can check details
      -- with inventory commands (or look in aiming mode).
      detailExploration :: DetailLevel
detailExploration = if Bool
standingOn Bool -> Bool -> Bool
&& FactionId -> Maybe FactionId
forall a. a -> Maybe a
Just FactionId
side Maybe FactionId -> Maybe FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== (Actor -> FactionId
bfid (Actor -> FactionId) -> Maybe Actor -> Maybe FactionId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Actor
mb)
                          then DetailLevel
DetailMedium
                          else DetailLevel
DetailAll
      detail :: DetailLevel
detail = DetailLevel
-> (AimMode -> DetailLevel) -> Maybe AimMode -> DetailLevel
forall b a. b -> (a -> b) -> Maybe a -> b
maybe DetailLevel
detailExploration AimMode -> DetailLevel
detailLevel Maybe AimMode
saimMode
  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
lidV
  ItemBag
is <- (State -> ItemBag) -> m ItemBag
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemBag) -> m ItemBag)
-> (State -> ItemBag) -> m ItemBag
forall a b. (a -> b) -> a -> b
$ LevelId -> Point -> State -> ItemBag
getFloorBag LevelId
lidV Point
p
  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
  Time
globalTime <- (State -> Time) -> m Time
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> Time
stime
  ItemId -> ContentId ItemKind
getKind <- (State -> ItemId -> ContentId ItemKind)
-> m (ItemId -> ContentId ItemKind)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemId -> ContentId ItemKind)
 -> m (ItemId -> ContentId ItemKind))
-> (State -> ItemId -> ContentId ItemKind)
-> m (ItemId -> ContentId ItemKind)
forall a b. (a -> b) -> a -> b
$ (ItemId -> State -> ContentId ItemKind)
-> State -> ItemId -> ContentId ItemKind
forall a b c. (a -> b -> c) -> b -> a -> c
flip ItemId -> State -> ContentId ItemKind
getIidKindId
  Maybe (Part, Bool)
mLeader <- case Maybe ActorId
maid of
    Just ActorId
aid | Bool
standingOn -> do
      Part
leaderPronoun <- ActorId -> m Part
forall (m :: * -> *). MonadClientUI m => ActorId -> m Part
partPronounLeader ActorId
aid
      Maybe (Part, Bool) -> m (Maybe (Part, Bool))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Part, Bool) -> m (Maybe (Part, Bool)))
-> Maybe (Part, Bool) -> m (Maybe (Part, Bool))
forall a b. (a -> b) -> a -> b
$ (Part, Bool) -> Maybe (Part, Bool)
forall a. a -> Maybe a
Just (Part
leaderPronoun, (Actor -> Int64
bhp (Actor -> Int64) -> Maybe Actor -> Maybe Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Actor
mb) Maybe Int64 -> Maybe Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int64 -> Maybe Int64
forall a. a -> Maybe a
Just Int64
0)
    Maybe ActorId
_ -> Maybe (Part, Bool) -> m (Maybe (Part, Bool))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Part, Bool)
forall a. Maybe a
Nothing
  let mactorPronounAliveLeader :: Maybe (Part, Bool)
mactorPronounAliveLeader = Maybe (Part, Bool)
mactorPronounAlive Maybe (Part, Bool) -> Maybe (Part, Bool) -> Maybe (Part, Bool)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (Part, Bool)
mLeader
  (Part
subject, Text
verb) <- case Maybe (Part, Bool)
mactorPronounAliveLeader of
    Just (Part
actorPronoun, Bool
actorAlive) ->
      (Part, Text) -> m (Part, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Part
actorPronoun, if Bool
actorAlive then Text
"stand over" else Text
"fall over")
    Maybe (Part, Bool)
Nothing -> case Maybe ActorId
maid of
      Just ActorId
aid -> do
        Part
subjectAid <- ActorId -> m Part
forall (m :: * -> *). MonadClientUI m => ActorId -> m Part
partActorLeader ActorId
aid
        (Part, Text) -> m (Part, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Part
subjectAid, if Bool
canSee then Text
"notice" else Text
"remember")
      Maybe ActorId
Nothing ->
        (Part, Text) -> m (Part, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Part
"one", if Bool
canSee then Text
"can see" else Text
"may remember")
  let nWs :: (ItemId, ItemQuant) -> Part
nWs (ItemId
iid, kit :: ItemQuant
kit@(Int
k, ItemTimers
_)) =
        DetailLevel
-> Int
-> FactionId
-> EnumMap FactionId Faction
-> Int
-> Time
-> ItemFull
-> ItemQuant
-> Part
partItemWsDetail DetailLevel
detail
                         Int
rwidth FactionId
side EnumMap FactionId Faction
factionD Int
k Time
localTime (ItemId -> ItemFull
itemToF ItemId
iid) ItemQuant
kit
      (Part
object, Person
person) = case ItemBag -> [(ItemId, ItemQuant)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs ItemBag
is of
        [(ItemId
_, (Int
k, ItemTimers
_))] | DetailLevel
detail DetailLevel -> DetailLevel -> Bool
forall a. Eq a => a -> a -> Bool
== DetailLevel
DetailLow ->
          (if Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then Part
"an item" else Part
"an item stack", Person
MU.Sg3rd)
        [(ItemId, ItemQuant)]
_ | DetailLevel
detail DetailLevel -> DetailLevel -> Bool
forall a. Eq a => a -> a -> Bool
== DetailLevel
DetailLow -> (Part
"some items", Person
MU.PlEtc)
        (ItemId, ItemQuant)
ii : (ItemId, ItemQuant)
_ : (ItemId, ItemQuant)
_ : [(ItemId, ItemQuant)]
_ | DetailLevel
detail DetailLevel -> DetailLevel -> Bool
forall a. Ord a => a -> a -> Bool
<= DetailLevel
DetailMedium ->
          ([Part] -> Part
MU.Phrase [(ItemId, ItemQuant) -> Part
nWs (ItemId, ItemQuant)
ii, Part
"and other items"], Person
MU.PlEtc)
        [ii :: (ItemId, ItemQuant)
ii@(ItemId
_, (Int
1, ItemTimers
_))] -> ((ItemId, ItemQuant) -> Part
nWs (ItemId, ItemQuant)
ii, Person
MU.Sg3rd)
        [(ItemId, ItemQuant)]
iis -> ([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
nWs ([(ItemId, ItemQuant)] -> [Part])
-> [(ItemId, ItemQuant)] -> [Part]
forall a b. (a -> b) -> a -> b
$ ((ItemId, ItemQuant) -> ContentId ItemKind)
-> [(ItemId, ItemQuant)] -> [(ItemId, ItemQuant)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (ItemId -> ContentId ItemKind
getKind (ItemId -> ContentId ItemKind)
-> ((ItemId, ItemQuant) -> ItemId)
-> (ItemId, ItemQuant)
-> ContentId ItemKind
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ItemId, ItemQuant) -> ItemId
forall a b. (a, b) -> a
fst) [(ItemId, ItemQuant)]
iis, Person
MU.PlEtc)
  -- Here @squashedWWandW@ is not needed, because identical items at the same
  -- position are already merged in the floor item bag and multiple identical
  -- messages concerning different positions are merged with <x7>
  -- to distinguish from a stack of items at a single position.
  (Text, Maybe Person) -> m (Text, Maybe Person)
forall (m :: * -> *) a. Monad m => a -> m a
return ( if ItemBag -> Bool
forall k a. EnumMap k a -> Bool
EM.null ItemBag
is Bool -> Bool -> Bool
|| Time
globalTime Time -> Time -> Bool
forall a. Eq a => a -> a -> Bool
== Time
timeZero
           then Text
""
           else [Part] -> Text
makeSentence [Part -> Part -> Part
MU.SubjectVerbSg Part
subject (Text -> Part
MU.Text Text
verb), Part
object]
         , if Maybe (Part, Bool) -> Bool
forall a. Maybe a -> Bool
isNothing Maybe (Part, Bool)
mactorPronounAlive then Person -> Maybe Person
forall a. a -> Maybe a
Just Person
person else Maybe Person
forall a. Maybe a
Nothing )

lookAtStash :: MonadClientUI m => Point -> LevelId -> m Text
lookAtStash :: Point -> LevelId -> m Text
lookAtStash Point
p LevelId
lidV = do
  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 locateStash :: (FactionId, Faction) -> Maybe Text
locateStash (FactionId
fid, Faction
fact) = case Faction -> Maybe (LevelId, Point)
gstash Faction
fact of
        Just (LevelId
lid, Point
pos) | LevelId
lid LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== LevelId
lidV  Bool -> Bool -> Bool
&& Point
pos Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Point
p ->
          Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ if FactionId
fid FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side
                 then Text
"Here is the shared inventory stash of your team."
                 else Faction -> Text
gname Faction
fact
                      Text -> Text -> Text
<+> Text
"set up their shared inventory stash here."
        Maybe (LevelId, Point)
_ -> Maybe Text
forall a. Maybe a
Nothing
  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 -> [Text] -> Text
T.intercalate Text
" " ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ ((FactionId, Faction) -> Maybe Text)
-> [(FactionId, Faction)] -> [Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (FactionId, Faction) -> Maybe Text
locateStash ([(FactionId, Faction)] -> [Text])
-> [(FactionId, Faction)] -> [Text]
forall a b. (a -> b) -> a -> b
$ EnumMap FactionId Faction -> [(FactionId, Faction)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs EnumMap FactionId Faction
factionD

-- | Produces a textual description of everything at the requested
-- level's position.
lookAtPosition :: MonadClientUI m
               => Point -> LevelId -> m [(MsgClassShow, Text)]
lookAtPosition :: Point -> LevelId -> m [(MsgClassShow, Text)]
lookAtPosition Point
p LevelId
lidV = do
  COps{ContentData TileKind
cotile :: ContentData TileKind
cotile :: COps -> ContentData TileKind
cotile} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
  Perception
per <- LevelId -> m Perception
forall (m :: * -> *). MonadClientRead m => LevelId -> m Perception
getPerFid LevelId
lidV
  let canSee :: Bool
canSee = Point -> EnumSet Point -> Bool
forall k. Enum k => k -> EnumSet k -> Bool
ES.member Point
p (Perception -> EnumSet Point
totalVisible Perception
per)
  (Text
actorsBlurb, Maybe (Part, Bool)
mactorPronounAlive, Text
actorsDesc) <- Point -> LevelId -> m (Text, Maybe (Part, Bool), Text)
forall (m :: * -> *).
MonadClientUI m =>
Point -> LevelId -> m (Text, Maybe (Part, Bool), Text)
lookAtActors Point
p LevelId
lidV
  Maybe ActorId
mleader <- (StateClient -> Maybe ActorId) -> m (Maybe ActorId)
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Maybe ActorId
sleader
  (Text
itemsBlurb, Maybe Person
mperson) <-
    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
canSee Point
p LevelId
lidV Maybe ActorId
mleader Maybe (Part, Bool)
mactorPronounAlive
  let tperson :: Maybe Person
tperson = if Text -> Bool
T.null Text
itemsBlurb then Maybe Person
forall a. Maybe a
Nothing else Maybe Person
mperson
  (Text
tileBlurb, Text
placeBlurb, [(Int, Part)]
embedsList) <-
    Bool
-> Point
-> LevelId
-> Maybe ActorId
-> Maybe Person
-> m (Text, Text, [(Int, Part)])
forall (m :: * -> *).
MonadClientUI m =>
Bool
-> Point
-> LevelId
-> Maybe ActorId
-> Maybe Person
-> m (Text, Text, [(Int, Part)])
lookAtTile Bool
canSee Point
p LevelId
lidV Maybe ActorId
mleader Maybe Person
tperson
  [(ActorId, Actor)]
inhabitants <- (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
$ Point -> LevelId -> State -> [(ActorId, Actor)]
posToAidAssocs Point
p LevelId
lidV
  let actorMsgClass :: MsgClassShow
actorMsgClass =
        if (Actor -> FactionId
bfid (Actor -> FactionId)
-> ((ActorId, Actor) -> Actor) -> (ActorId, Actor) -> FactionId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ActorId, Actor) -> Actor
forall a b. (a, b) -> b
snd ((ActorId, Actor) -> FactionId)
-> [(ActorId, Actor)] -> [FactionId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(ActorId, Actor)]
inhabitants) [FactionId] -> [FactionId] -> Bool
forall a. Eq a => a -> a -> Bool
== [FactionId
side]
        then MsgClassShow
MsgPromptGeneric  -- our single proj or non-proj; tame
        else MsgClassShow
MsgPromptActors
  Text
stashBlurb <- Point -> LevelId -> m Text
forall (m :: * -> *). MonadClientUI m => Point -> LevelId -> m Text
lookAtStash Point
p LevelId
lidV
  lvl :: Level
lvl@Level{SmellMap
lsmell :: Level -> SmellMap
lsmell :: SmellMap
lsmell, Time
ltime :: Level -> Time
ltime :: Time
ltime} <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel LevelId
lidV
  Maybe AimMode
saimMode <- (SessionUI -> Maybe AimMode) -> m (Maybe AimMode)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe AimMode
saimMode
  let detail :: DetailLevel
detail = DetailLevel
-> (AimMode -> DetailLevel) -> Maybe AimMode -> DetailLevel
forall b a. b -> (a -> b) -> Maybe a -> b
maybe DetailLevel
DetailAll AimMode -> DetailLevel
detailLevel Maybe AimMode
saimMode
      smellBlurb :: Text
smellBlurb = case Point -> SmellMap -> Maybe Time
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup Point
p SmellMap
lsmell of
        Just Time
sml | Time
sml Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
> Time
ltime ->
          let Delta Time
t = Delta Time
smellTimeout Delta Time -> Delta Time -> Delta Time
`timeDeltaSubtract`
                          (Time
sml Time -> Time -> Delta Time
`timeDeltaToFrom` Time
ltime)
              seconds :: Int
seconds = Time
t Time -> Time -> Int
`timeFitUp` Time
timeSecond
          in Text
"A smelly body passed here around" Text -> Text -> Text
<+> Int -> Text
forall a. Show a => a -> Text
tshow Int
seconds Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"s ago."
        Maybe Time
_ -> Text
""
  ItemBag
embeds <- (State -> ItemBag) -> m ItemBag
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemBag) -> m ItemBag)
-> (State -> ItemBag) -> m ItemBag
forall a b. (a -> b) -> a -> b
$ LevelId -> Point -> State -> ItemBag
getEmbedBag LevelId
lidV Point
p
  ItemId -> ItemKind
getKind <- (State -> ItemId -> ItemKind) -> m (ItemId -> ItemKind)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemId -> ItemKind) -> m (ItemId -> ItemKind))
-> (State -> ItemId -> ItemKind) -> m (ItemId -> ItemKind)
forall a b. (a -> b) -> a -> b
$ (ItemId -> State -> ItemKind) -> State -> ItemId -> ItemKind
forall a b c. (a -> b -> c) -> b -> a -> c
flip ItemId -> State -> ItemKind
getIidKind
  let ppEmbedName :: (Int, MU.Part) -> Text
      ppEmbedName :: (Int, Part) -> Text
ppEmbedName (Int
k, Part
part) =
        let verb :: Part
verb = if Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then Part
"is" else Part
"are"
        in [Part] -> Text
makeSentence [Part
"There", Part
verb, Part
part]
      embedKindList :: [(ItemKind, (ItemId, ItemQuant))]
embedKindList = ((ItemId, ItemQuant) -> (ItemKind, (ItemId, ItemQuant)))
-> [(ItemId, ItemQuant)] -> [(ItemKind, (ItemId, ItemQuant))]
forall a b. (a -> b) -> [a] -> [b]
map (\(ItemId
iid, ItemQuant
kit) -> (ItemId -> ItemKind
getKind ItemId
iid, (ItemId
iid, ItemQuant
kit)))
                          (ItemBag -> [(ItemId, ItemQuant)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs ItemBag
embeds)
      feats :: [Feature]
feats = TileKind -> [Feature]
TK.tfeature (TileKind -> [Feature]) -> TileKind -> [Feature]
forall a b. (a -> b) -> a -> b
$ ContentData TileKind -> ContentId TileKind -> TileKind
forall a. ContentData a -> ContentId a -> a
okind ContentData TileKind
cotile (ContentId TileKind -> TileKind) -> ContentId TileKind -> TileKind
forall a b. (a -> b) -> a -> b
$ Level
lvl Level -> Point -> ContentId TileKind
`at` Point
p
      tileActions :: [TileAction]
tileActions = (Feature -> Maybe TileAction) -> [Feature] -> [TileAction]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Bool
-> Bool
-> [(ItemKind, (ItemId, ItemQuant))]
-> Feature
-> Maybe TileAction
parseTileAction Bool
False Bool
False [(ItemKind, (ItemId, ItemQuant))]
embedKindList)
                             [Feature]
feats
      isEmbedAction :: TileAction -> Bool
isEmbedAction EmbedAction{} = Bool
True
      isEmbedAction TileAction
_ = Bool
False
      embedVerb :: [Part]
embedVerb = [ Part
"activated"
                  | (TileAction -> Bool) -> [TileAction] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any TileAction -> Bool
isEmbedAction [TileAction]
tileActions
                    Bool -> Bool -> Bool
&& ((ItemKind, (ItemId, ItemQuant)) -> Bool)
-> [(ItemKind, (ItemId, ItemQuant))] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\(ItemKind
itemKind, (ItemId, ItemQuant)
_) -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Effect] -> Bool
forall a. [a] -> Bool
null ([Effect] -> Bool) -> [Effect] -> Bool
forall a b. (a -> b) -> a -> b
$ ItemKind -> [Effect]
IK.ieffects ItemKind
itemKind)
                           [(ItemKind, (ItemId, ItemQuant))]
embedKindList ]
      isToAction :: TileAction -> Bool
isToAction ToAction{} = Bool
True
      isToAction TileAction
_ = Bool
False
      isWithAction :: TileAction -> Bool
isWithAction WithAction{} = Bool
True
      isWithAction TileAction
_ = Bool
False
      isEmptyWithAction :: TileAction -> Bool
isEmptyWithAction (WithAction [] GroupName TileKind
_) = Bool
True
      isEmptyWithAction TileAction
_ = Bool
False
      alterVerb :: [Part]
alterVerb | (TileAction -> Bool) -> [TileAction] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any TileAction -> Bool
isEmptyWithAction [TileAction]
tileActions = [Part
"very easily modified"]
                | (TileAction -> Bool) -> [TileAction] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any TileAction -> Bool
isToAction [TileAction]
tileActions = [Part
"easily modified"]
                | (TileAction -> Bool) -> [TileAction] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any TileAction -> Bool
isWithAction [TileAction]
tileActions = [Part
"potentially modified"]
                | Bool
otherwise = []
      verbs :: [Part]
verbs = [Part]
embedVerb [Part] -> [Part] -> [Part]
forall a. [a] -> [a] -> [a]
++ [Part]
alterVerb
      alterBlurb :: Text
alterBlurb = if [Part] -> Bool
forall a. [a] -> Bool
null [Part]
verbs
                   then Text
""
                   else [Part] -> Text
makeSentence [Part
"can be", [Part] -> Part
MU.WWandW [Part]
verbs]
      toolFromAction :: TileAction -> Maybe [(Int, GroupName ItemKind)]
toolFromAction (WithAction [(Int, GroupName ItemKind)]
grps GroupName TileKind
_) = [(Int, GroupName ItemKind)] -> Maybe [(Int, GroupName ItemKind)]
forall a. a -> Maybe a
Just [(Int, GroupName ItemKind)]
grps
      toolFromAction TileAction
_ = Maybe [(Int, GroupName ItemKind)]
forall a. Maybe a
Nothing
      toolsToAlterWith :: [[(Int, GroupName ItemKind)]]
toolsToAlterWith = (TileAction -> Maybe [(Int, GroupName ItemKind)])
-> [TileAction] -> [[(Int, GroupName ItemKind)]]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe TileAction -> Maybe [(Int, GroupName ItemKind)]
toolFromAction [TileAction]
tileActions
      tItems :: Text
tItems = [[(Int, GroupName ItemKind)]] -> Text
describeToolsAlternative [[(Int, GroupName ItemKind)]]
toolsToAlterWith
      transformBlurb :: Text
transformBlurb = if Text -> Bool
T.null Text
tItems
                       then Text
""
                       else Text
"The following items on the ground or in equipment enable special transformations:"
                            Text -> Text -> Text
<+> Text
tItems Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."  -- not telling to what terrain
      modifyBlurb :: Text
modifyBlurb = Text
alterBlurb Text -> Text -> Text
<+> Text
transformBlurb
      midEOL :: Text
midEOL = if DetailLevel
detail DetailLevel -> DetailLevel -> Bool
forall a. Ord a => a -> a -> Bool
< DetailLevel
DetailHigh
                  Bool -> Bool -> Bool
|| Text -> Bool
T.null Text
stashBlurb Bool -> Bool -> Bool
&& Text -> Bool
T.null Text
actorsDesc
                  Bool -> Bool -> Bool
|| Text -> Bool
T.null Text
smellBlurb Bool -> Bool -> Bool
&& Text -> Bool
T.null Text
itemsBlurb
                  Bool -> Bool -> Bool
|| [(Int, Part)] -> Bool
forall a. [a] -> Bool
null [(Int, Part)]
embedsList Bool -> Bool -> Bool
&& Text -> Bool
T.null Text
modifyBlurb
               then Text
""
               else Text
"\n"
      ms :: [(MsgClassShow, Text)]
ms = [ (MsgClassShow
MsgPromptAction, Text
stashBlurb)
           , (MsgClassShow
actorMsgClass, Text
actorsBlurb)
           , (MsgClassShow
MsgPromptGeneric, Text
actorsDesc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
midEOL) ]
           [(MsgClassShow, Text)]
-> [(MsgClassShow, Text)] -> [(MsgClassShow, Text)]
forall a. [a] -> [a] -> [a]
++ [(MsgClassShow
MsgPromptGeneric, Text
smellBlurb) | DetailLevel
detail DetailLevel -> DetailLevel -> Bool
forall a. Ord a => a -> a -> Bool
>= DetailLevel
DetailHigh]
           [(MsgClassShow, Text)]
-> [(MsgClassShow, Text)] -> [(MsgClassShow, Text)]
forall a. [a] -> [a] -> [a]
++ [(MsgClassShow
MsgPromptItems, Text
itemsBlurb Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
midEOL)]
           [(MsgClassShow, Text)]
-> [(MsgClassShow, Text)] -> [(MsgClassShow, Text)]
forall a. [a] -> [a] -> [a]
++ [(MsgClassShow
MsgPromptFocus, Text
tileBlurb) | DetailLevel
detail DetailLevel -> DetailLevel -> Bool
forall a. Ord a => a -> a -> Bool
>= DetailLevel
DetailHigh
                                             Bool -> Bool -> Bool
|| DetailLevel
detail DetailLevel -> DetailLevel -> Bool
forall a. Eq a => a -> a -> Bool
== DetailLevel
DetailMedium
                                                Bool -> Bool -> Bool
&& Bool -> Bool
not ([(Int, Part)] -> Bool
forall a. [a] -> Bool
null [(Int, Part)]
embedsList)]
           [(MsgClassShow, Text)]
-> [(MsgClassShow, Text)] -> [(MsgClassShow, Text)]
forall a. [a] -> [a] -> [a]
++ [(MsgClassShow
MsgPromptGeneric, Text
placeBlurb) | DetailLevel
detail DetailLevel -> DetailLevel -> Bool
forall a. Ord a => a -> a -> Bool
>= DetailLevel
DetailHigh]
           [(MsgClassShow, Text)]
-> [(MsgClassShow, Text)] -> [(MsgClassShow, Text)]
forall a. [a] -> [a] -> [a]
++ case DetailLevel
detail of
                DetailLevel
DetailLow -> []  -- not to obscure aiming line
                DetailLevel
DetailMedium ->
                  [(MsgClassShow
MsgPromptMention, case [(Int, Part)]
embedsList of
                    [] -> Text
""
                    [(Int
k, Part
_)] ->
                      (Int, Part) -> Text
ppEmbedName (Int
1, if Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
                                      then Part
"an embedded item"
                                      else Part
"a stack of embedded items")
                    [(Int, Part)]
_ -> (Int, Part) -> Text
ppEmbedName (Int
9, Part
"some embedded items"))]
                DetailLevel
_ -> let n :: Int
n = [Int] -> Int
forall a. Num a => [a] -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ ((Int, Part) -> Int) -> [(Int, Part)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Part) -> Int
forall a b. (a, b) -> a
fst [(Int, Part)]
embedsList
                         wWandW :: Part
wWandW = [Part] -> Part
MU.WWandW ([Part] -> Part) -> [Part] -> Part
forall a b. (a -> b) -> a -> b
$ ((Int, Part) -> Part) -> [(Int, Part)] -> [Part]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Part) -> Part
forall a b. (a, b) -> b
snd [(Int, Part)]
embedsList
                     in [(MsgClassShow
MsgPromptMention, (Int, Part) -> Text
ppEmbedName (Int
n, Part
wWandW)) | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0]
           [(MsgClassShow, Text)]
-> [(MsgClassShow, Text)] -> [(MsgClassShow, Text)]
forall a. [a] -> [a] -> [a]
++ [(MsgClassShow
MsgPromptModify, Text
modifyBlurb) | DetailLevel
detail DetailLevel -> DetailLevel -> Bool
forall a. Eq a => a -> a -> Bool
== DetailLevel
DetailAll]
  [(MsgClassShow, Text)] -> m [(MsgClassShow, Text)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(MsgClassShow, Text)] -> m [(MsgClassShow, Text)])
-> [(MsgClassShow, Text)] -> m [(MsgClassShow, Text)]
forall a b. (a -> b) -> a -> b
$! if ((MsgClassShow, Text) -> Bool) -> [(MsgClassShow, Text)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Text -> Bool
T.null (Text -> Bool)
-> ((MsgClassShow, Text) -> Text) -> (MsgClassShow, Text) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MsgClassShow, Text) -> Text
forall a b. (a, b) -> b
snd) [(MsgClassShow, Text)]
ms Bool -> Bool -> Bool
&& DetailLevel
detail DetailLevel -> DetailLevel -> Bool
forall a. Ord a => a -> a -> Bool
> DetailLevel
DetailLow
            then [(MsgClassShow
MsgPromptFocus, Text
tileBlurb)]
            else [(MsgClassShow, Text)]
ms

displayOneMenuItem :: MonadClientUI m
                   => (MenuSlot -> m OKX) -> [K.KM] -> Int -> MenuSlot
                   -> m K.KM
displayOneMenuItem :: (MenuSlot -> m OKX) -> [KM] -> Int -> MenuSlot -> m KM
displayOneMenuItem MenuSlot -> m OKX
renderOneItem [KM]
extraKeys Int
slotBound MenuSlot
slot = do
  CCUI{coscreen :: CCUI -> ScreenContent
coscreen=ScreenContent{Int
rheight :: Int
rheight :: ScreenContent -> Int
rheight}} <- (SessionUI -> CCUI) -> m CCUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
  let keys :: [KM]
keys = [KM
K.spaceKM, KM
K.escKM]
             [KM] -> [KM] -> [KM]
forall a. [a] -> [a] -> [a]
++ [KM
K.upKM | MenuSlot -> Int
forall a. Enum a => a -> Int
fromEnum MenuSlot
slot Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0]
             [KM] -> [KM] -> [KM]
forall a. [a] -> [a] -> [a]
++ [KM
K.downKM | MenuSlot -> Int
forall a. Enum a => a -> Int
fromEnum MenuSlot
slot Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
slotBound]
             [KM] -> [KM] -> [KM]
forall a. [a] -> [a] -> [a]
++ [KM]
extraKeys
  OKX
okx <- MenuSlot -> m OKX
renderOneItem MenuSlot
slot
  Slideshow
slides <- Int -> [KM] -> OKX -> m Slideshow
forall (m :: * -> *).
MonadClientUI m =>
Int -> [KM] -> OKX -> m Slideshow
overlayToSlideshow (Int
rheight Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) [KM]
keys OKX
okx
  KM
km <- ColorMode -> [KM] -> Slideshow -> m KM
forall (m :: * -> *).
MonadClientUI m =>
ColorMode -> [KM] -> Slideshow -> m KM
getConfirms ColorMode
ColorFull [KM]
keys Slideshow
slides
  case KM -> Key
K.key KM
km of
    Key
K.Up -> (MenuSlot -> m OKX) -> [KM] -> Int -> MenuSlot -> m KM
forall (m :: * -> *).
MonadClientUI m =>
(MenuSlot -> m OKX) -> [KM] -> Int -> MenuSlot -> m KM
displayOneMenuItem MenuSlot -> m OKX
renderOneItem [KM]
extraKeys Int
slotBound (MenuSlot -> m KM) -> MenuSlot -> m KM
forall a b. (a -> b) -> a -> b
$ MenuSlot -> MenuSlot
forall a. Enum a => a -> a
pred MenuSlot
slot
    Key
K.Down -> (MenuSlot -> m OKX) -> [KM] -> Int -> MenuSlot -> m KM
forall (m :: * -> *).
MonadClientUI m =>
(MenuSlot -> m OKX) -> [KM] -> Int -> MenuSlot -> m KM
displayOneMenuItem MenuSlot -> m OKX
renderOneItem [KM]
extraKeys Int
slotBound (MenuSlot -> m KM) -> MenuSlot -> m KM
forall a b. (a -> b) -> a -> b
$ MenuSlot -> MenuSlot
forall a. Enum a => a -> a
succ MenuSlot
slot
    Key
_ -> KM -> m KM
forall (m :: * -> *) a. Monad m => a -> m a
return KM
km

okxItemLoreInline :: MonadClientUI m
                  => (ItemId -> ItemFull -> Int -> Text)
                  -> Int -> ItemDialogMode -> [(ItemId, ItemQuant)]
                  -> Int -> MenuSlot
                  -> m OKX
okxItemLoreInline :: (ItemId -> ItemFull -> Int -> Text)
-> Int
-> ItemDialogMode
-> [(ItemId, ItemQuant)]
-> Int
-> MenuSlot
-> m OKX
okxItemLoreInline ItemId -> ItemFull -> Int -> Text
promptFun Int
meleeSkill ItemDialogMode
dmode [(ItemId, ItemQuant)]
iids Int
widthRaw MenuSlot
slot = do
  FontSetup{DisplayFont
propFont :: DisplayFont
monoFont :: DisplayFont
squareFont :: DisplayFont
propFont :: FontSetup -> DisplayFont
monoFont :: FontSetup -> DisplayFont
squareFont :: FontSetup -> DisplayFont
..} <- m FontSetup
forall (m :: * -> *). MonadClientUI m => m FontSetup
getFontSetup
  let (ItemId
iid, kit :: ItemQuant
kit@(Int
k, ItemTimers
_)) = [(ItemId, ItemQuant)]
iids [(ItemId, ItemQuant)] -> Int -> (ItemId, ItemQuant)
forall a. [a] -> Int -> a
!! MenuSlot -> Int
forall a. Enum a => a -> Int
fromEnum MenuSlot
slot
      -- Some prop fonts are wider than mono (e.g., in dejavuBold font set),
      -- so the width in these artificial texts full of digits and strange
      -- characters needs to be smaller than @rwidth - 2@ that would suffice
      -- for mono.
      width :: Int
width = Int
widthRaw Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
5
  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
  (Overlay
ovLab, Overlay
ovDesc) <- Bool
-> Int
-> ItemDialogMode
-> ItemId
-> ItemQuant
-> ItemFull
-> Int
-> m (Overlay, Overlay)
forall (m :: * -> *).
MonadClientUI m =>
Bool
-> Int
-> ItemDialogMode
-> ItemId
-> ItemQuant
-> ItemFull
-> Int
-> m (Overlay, Overlay)
itemDescOverlays Bool
True Int
meleeSkill ItemDialogMode
dmode ItemId
iid ItemQuant
kit ItemFull
itemFull
                                      Int
width
  let prompt :: Text
prompt = ItemId -> ItemFull -> Int -> Text
promptFun ItemId
iid ItemFull
itemFull Int
k
      promptBlurb :: Overlay
promptBlurb | Text -> Bool
T.null Text
prompt = []
                  | Bool
otherwise = [AttrLine] -> Overlay
offsetOverlay ([AttrLine] -> Overlay) -> [AttrLine] -> Overlay
forall a b. (a -> b) -> a -> b
$ Int -> Int -> AttrString -> [AttrLine]
splitAttrString Int
width Int
width
                                (AttrString -> [AttrLine]) -> AttrString -> [AttrLine]
forall a b. (a -> b) -> a -> b
$ Color -> Text -> AttrString
textFgToAS Color
Color.Brown (Text -> AttrString) -> Text -> AttrString
forall a b. (a -> b) -> a -> b
$ Text
prompt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n\n"
      len :: Int
len = Overlay -> Int
forall a. [a] -> Int
length Overlay
promptBlurb
      descSym2 :: Overlay
descSym2 = Int -> Overlay -> Overlay
ytranslateOverlay Int
len Overlay
ovLab
      descBlurb2 :: Overlay
descBlurb2 = Overlay
promptBlurb Overlay -> Overlay -> Overlay
forall a. [a] -> [a] -> [a]
++ Int -> Overlay -> Overlay
ytranslateOverlay Int
len Overlay
ovDesc
      ov :: EnumMap DisplayFont Overlay
ov = (Overlay -> Overlay -> Overlay)
-> DisplayFont
-> Overlay
-> EnumMap DisplayFont Overlay
-> EnumMap DisplayFont Overlay
forall k a.
Enum k =>
(a -> a -> a) -> k -> a -> EnumMap k a -> EnumMap k a
EM.insertWith Overlay -> Overlay -> Overlay
forall a. [a] -> [a] -> [a]
(++) DisplayFont
squareFont Overlay
descSym2
           (EnumMap DisplayFont Overlay -> EnumMap DisplayFont Overlay)
-> EnumMap DisplayFont Overlay -> 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
descBlurb2
  OKX -> m OKX
forall (m :: * -> *) a. Monad m => a -> m a
return (EnumMap DisplayFont Overlay
ov, [])

okxItemLoreMsg :: MonadClientUI m
               => (ItemId -> ItemFull -> Int -> Text)
               -> Int -> ItemDialogMode -> [(ItemId, ItemQuant)]
               -> MenuSlot
               -> m OKX
okxItemLoreMsg :: (ItemId -> ItemFull -> Int -> Text)
-> Int
-> ItemDialogMode
-> [(ItemId, ItemQuant)]
-> MenuSlot
-> m OKX
okxItemLoreMsg ItemId -> ItemFull -> Int -> Text
promptFun Int
meleeSkill ItemDialogMode
dmode [(ItemId, ItemQuant)]
iids MenuSlot
slot = 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
  FontSetup{DisplayFont
propFont :: DisplayFont
monoFont :: DisplayFont
squareFont :: DisplayFont
propFont :: FontSetup -> DisplayFont
monoFont :: FontSetup -> DisplayFont
squareFont :: FontSetup -> DisplayFont
..} <- m FontSetup
forall (m :: * -> *). MonadClientUI m => m FontSetup
getFontSetup
  let (ItemId
iid, kit :: ItemQuant
kit@(Int
k, ItemTimers
_)) = [(ItemId, ItemQuant)]
iids [(ItemId, ItemQuant)] -> Int -> (ItemId, ItemQuant)
forall a. [a] -> Int -> a
!! MenuSlot -> Int
forall a. Enum a => a -> Int
fromEnum MenuSlot
slot
  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
  (Overlay
ovLab, Overlay
ovDesc) <- Bool
-> Int
-> ItemDialogMode
-> ItemId
-> ItemQuant
-> ItemFull
-> Int
-> m (Overlay, Overlay)
forall (m :: * -> *).
MonadClientUI m =>
Bool
-> Int
-> ItemDialogMode
-> ItemId
-> ItemQuant
-> ItemFull
-> Int
-> m (Overlay, Overlay)
itemDescOverlays Bool
True Int
meleeSkill ItemDialogMode
dmode ItemId
iid ItemQuant
kit ItemFull
itemFull
                                      Int
rwidth
  let prompt :: Text
prompt = ItemId -> ItemFull -> Int -> Text
promptFun ItemId
iid ItemFull
itemFull Int
k
  MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgPromptGeneric Text
prompt
  let ov :: EnumMap DisplayFont Overlay
ov = (Overlay -> Overlay -> Overlay)
-> DisplayFont
-> Overlay
-> EnumMap DisplayFont Overlay
-> EnumMap DisplayFont Overlay
forall k a.
Enum k =>
(a -> a -> a) -> k -> a -> EnumMap k a -> EnumMap k a
EM.insertWith Overlay -> Overlay -> Overlay
forall a. [a] -> [a] -> [a]
(++) DisplayFont
squareFont Overlay
ovLab
           (EnumMap DisplayFont Overlay -> EnumMap DisplayFont Overlay)
-> EnumMap DisplayFont Overlay -> 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
ovDesc
  OKX -> m OKX
forall (m :: * -> *) a. Monad m => a -> m a
return (EnumMap DisplayFont Overlay
ov, [])

itemDescOverlays :: MonadClientUI m
                 => Bool -> Int -> ItemDialogMode -> ItemId -> ItemQuant
                 -> ItemFull -> Int
                 -> m (Overlay, Overlay)
itemDescOverlays :: Bool
-> Int
-> ItemDialogMode
-> ItemId
-> ItemQuant
-> ItemFull
-> Int
-> m (Overlay, Overlay)
itemDescOverlays Bool
markParagraphs Int
meleeSkill ItemDialogMode
dmode ItemId
iid ItemQuant
kit ItemFull
itemFull Int
width = do
  FontSetup{DisplayFont
squareFont :: DisplayFont
squareFont :: FontSetup -> DisplayFont
squareFont} <- m FontSetup
forall (m :: * -> *). MonadClientUI m => m FontSetup
getFontSetup
  FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
  LevelId
arena <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
getArenaUI
  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
arena
  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
  -- The hacky level 0 marks items never seen, but sent by server at gameover.
  LevelId
jlid <- (SessionUI -> LevelId) -> m LevelId
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession ((SessionUI -> LevelId) -> m LevelId)
-> (SessionUI -> LevelId) -> m LevelId
forall a b. (a -> b) -> a -> b
$ LevelId -> Maybe LevelId -> LevelId
forall a. a -> Maybe a -> a
fromMaybe (Int -> LevelId
forall a. Enum a => Int -> a
toEnum Int
0) (Maybe LevelId -> LevelId)
-> (SessionUI -> Maybe LevelId) -> SessionUI -> LevelId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ItemId -> EnumMap ItemId LevelId -> Maybe LevelId
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup ItemId
iid (EnumMap ItemId LevelId -> Maybe LevelId)
-> (SessionUI -> EnumMap ItemId LevelId)
-> SessionUI
-> Maybe LevelId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessionUI -> EnumMap ItemId LevelId
sitemUI
  let descAs :: AttrString
descAs = Int
-> Bool
-> FactionId
-> EnumMap FactionId Faction
-> Int
-> ItemDialogMode
-> Time
-> LevelId
-> ItemFull
-> ItemQuant
-> AttrString
itemDesc Int
width Bool
markParagraphs FactionId
side EnumMap FactionId Faction
factionD Int
meleeSkill
                        ItemDialogMode
dmode Time
localTime LevelId
jlid ItemFull
itemFull ItemQuant
kit
  (Overlay, Overlay) -> m (Overlay, Overlay)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Overlay, Overlay) -> m (Overlay, Overlay))
-> (Overlay, Overlay) -> m (Overlay, Overlay)
forall a b. (a -> b) -> a -> b
$! DisplayFont -> Int -> AttrString -> (Overlay, Overlay)
labDescOverlay DisplayFont
squareFont Int
width AttrString
descAs

cycleLore :: MonadClientUI m => [m K.KM] -> [m K.KM] -> m ()
cycleLore :: [m KM] -> [m KM] -> m ()
cycleLore [m KM]
_ [] = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
cycleLore [m KM]
seen (m KM
m : [m KM]
rest) = do  -- @seen@ is needed for SPACE to end cycling
  KM
km <- m KM
m
  if | KM
km KM -> KM -> Bool
forall a. Eq a => a -> a -> Bool
== KM
K.spaceKM -> [m KM] -> [m KM] -> m ()
forall (m :: * -> *). MonadClientUI m => [m KM] -> [m KM] -> m ()
cycleLore (m KM
m m KM -> [m KM] -> [m KM]
forall a. a -> [a] -> [a]
: [m KM]
seen) [m KM]
rest
     | KM
km KM -> KM -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> KM
K.mkChar Char
'>' -> if [m KM] -> Bool
forall a. [a] -> Bool
null [m KM]
rest
                             then [m KM] -> [m KM] -> m ()
forall (m :: * -> *). MonadClientUI m => [m KM] -> [m KM] -> m ()
cycleLore [] ([m KM] -> [m KM]
forall a. [a] -> [a]
reverse ([m KM] -> [m KM]) -> [m KM] -> [m KM]
forall a b. (a -> b) -> a -> b
$ m KM
m m KM -> [m KM] -> [m KM]
forall a. a -> [a] -> [a]
: [m KM]
seen)
                             else [m KM] -> [m KM] -> m ()
forall (m :: * -> *). MonadClientUI m => [m KM] -> [m KM] -> m ()
cycleLore (m KM
m m KM -> [m KM] -> [m KM]
forall a. a -> [a] -> [a]
: [m KM]
seen) [m KM]
rest
     | KM
km KM -> KM -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> KM
K.mkChar Char
'<' -> case [m KM]
seen of
                               m KM
prev : [m KM]
ps -> [m KM] -> [m KM] -> m ()
forall (m :: * -> *). MonadClientUI m => [m KM] -> [m KM] -> m ()
cycleLore [m KM]
ps (m KM
prev m KM -> [m KM] -> [m KM]
forall a. a -> [a] -> [a]
: m KM
m m KM -> [m KM] -> [m KM]
forall a. a -> [a] -> [a]
: [m KM]
rest)
                               [] -> case [m KM] -> [m KM]
forall a. [a] -> [a]
reverse (m KM
m m KM -> [m KM] -> [m KM]
forall a. a -> [a] -> [a]
: [m KM]
rest) of
                                 m KM
prev : [m KM]
ps -> [m KM] -> [m KM] -> m ()
forall (m :: * -> *). MonadClientUI m => [m KM] -> [m KM] -> m ()
cycleLore [m KM]
ps [m KM
prev]
                                 [] -> String -> m ()
forall a. (?callStack::CallStack) => String -> a
error String
"cycleLore: screens disappeared"
     | KM
km KM -> KM -> Bool
forall a. Eq a => a -> a -> Bool
== KM
K.escKM -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     | Bool
otherwise -> String -> m ()
forall a. (?callStack::CallStack) => String -> a
error String
"cycleLore: unexpected key"

spoilsBlurb :: Text -> Int -> Int -> Text
spoilsBlurb :: Text -> Int -> Int -> Text
spoilsBlurb Text
currencyName Int
total Int
dungeonTotal =
  if | Int
dungeonTotal Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 ->
         Text
"All the spoils of your team are of the practical kind."
     | Int
total Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> Text
"Your team haven't found any genuine treasure yet."
     | Bool
otherwise -> [Part] -> Text
makeSentence
         [ Part
"your team's spoils are worth"
         , Int -> Part -> Part
MU.CarAWs Int
total (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ Text -> Part
MU.Text Text
currencyName
         , Part
"out of the rumoured total"
         , Int -> Part
MU.Cardinal Int
dungeonTotal ]

ppContainerWownW :: MonadClientUI m
                 => (ActorId -> m MU.Part) -> Bool -> Container -> m [MU.Part]
ppContainerWownW :: (ActorId -> m Part) -> Bool -> Container -> m [Part]
ppContainerWownW ActorId -> m Part
ownerFun Bool
addPrepositions Container
c = case Container
c of
  CFloor{} -> [Part] -> m [Part]
forall (m :: * -> *) a. Monad m => a -> m a
return [Part
"nearby"]
  CEmbed{} -> [Part] -> m [Part]
forall (m :: * -> *) a. Monad m => a -> m a
return [Part
"embedded nearby"]
  CActor ActorId
aid CStore
store -> do
    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
    Part
owner <- ActorId -> m Part
ownerFun ActorId
aid
    Text
fidName <- (State -> Text) -> m Text
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Text) -> m Text) -> (State -> Text) -> m Text
forall a b. (a -> b) -> a -> b
$ Faction -> Text
gname (Faction -> Text) -> (State -> Faction) -> State -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
b) (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 (Text
preposition, Text
noun) = CStore -> (Text, Text)
ppCStore CStore
store
        prep :: [Part]
prep = [Text -> Part
MU.Text Text
preposition | Bool
addPrepositions]
    [Part] -> m [Part]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Part] -> m [Part]) -> [Part] -> m [Part]
forall a b. (a -> b) -> a -> b
$! [Part]
prep [Part] -> [Part] -> [Part]
forall a. [a] -> [a] -> [a]
++ case CStore
store of
      CStore
CGround -> Text -> Part
MU.Text Text
noun Part -> [Part] -> [Part]
forall a. a -> [a] -> [a]
: if Actor -> Bool
bproj Actor
b then [] else [Part
"under", Part
owner]
      CStore
CStash -> if Actor -> FactionId
bfid Actor
b FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
/= FactionId
side
                then [Part -> Part -> Part
MU.WownW (Text -> Part
MU.Text Text
fidName) (Text -> Part
MU.Text Text
noun)]
                else [Text -> Part
MU.Text Text
noun]
      CStore
_ -> [Part -> Part -> Part
MU.WownW Part
owner (Text -> Part
MU.Text Text
noun)]
  CTrunk{} -> String -> m [Part]
forall a. (?callStack::CallStack) => String -> a
error (String -> m [Part]) -> String -> m [Part]
forall a b. (a -> b) -> a -> b
$ String
"" String -> Container -> String
forall v. Show v => String -> v -> String
`showFailure` Container
c

nxtGameMode :: COps -> Int -> (ContentId MK.ModeKind, MK.ModeKind)
nxtGameMode :: COps -> Int -> (ContentId ModeKind, ModeKind)
nxtGameMode COps{ContentData ModeKind
comode :: ContentData ModeKind
comode :: COps -> ContentData ModeKind
comode} Int
snxtScenario =
  let f :: [(a, b)] -> p -> a -> b -> [(a, b)]
f ![(a, b)]
acc p
_p !a
i !b
a = (a
i, b
a) (a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
: [(a, b)]
acc
      campaignModes :: [(ContentId ModeKind, ModeKind)]
campaignModes = ContentData ModeKind
-> GroupName ModeKind
-> ([(ContentId ModeKind, ModeKind)]
    -> Int
    -> ContentId ModeKind
    -> ModeKind
    -> [(ContentId ModeKind, ModeKind)])
-> [(ContentId ModeKind, ModeKind)]
-> [(ContentId ModeKind, ModeKind)]
forall a b.
ContentData a
-> GroupName a -> (b -> Int -> ContentId a -> a -> b) -> b -> b
ofoldlGroup' ContentData ModeKind
comode GroupName ModeKind
MK.CAMPAIGN_SCENARIO [(ContentId ModeKind, ModeKind)]
-> Int
-> ContentId ModeKind
-> ModeKind
-> [(ContentId ModeKind, ModeKind)]
forall a b p. [(a, b)] -> p -> a -> b -> [(a, b)]
f []
  in [(ContentId ModeKind, ModeKind)]
campaignModes [(ContentId ModeKind, ModeKind)]
-> Int -> (ContentId ModeKind, ModeKind)
forall a. [a] -> Int -> a
!! (Int
snxtScenario Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` [(ContentId ModeKind, ModeKind)] -> Int
forall a. [a] -> Int
length [(ContentId ModeKind, ModeKind)]
campaignModes)