{-# LANGUAGE TupleSections #-}
-- | Helper functions for both inventory management and human commands.
module Game.LambdaHack.Client.UI.HandleHelperM
  ( FailError, showFailError, MError, mergeMError, FailOrCmd, failWith
  , failSer, failMsg, weaveJust
  , memberCycle, memberCycleLevel, partyAfterLeader
  , pickLeader, pickLeaderWithPointer
  , itemOverlay, skillsOverlay
  , placesFromState, placesOverlay
  , describeMode, modesOverlay
  , pickNumber, guardItemSize, lookAtItems, lookAtStash, lookAtPosition
  , displayItemLore, displayItemLorePointedAt
  , viewLoreItems, cycleLore, spoilsBlurb
  , ppContainerWownW, nxtGameMode
#ifdef EXPOSE_INTERNAL
    -- * Internal operations
  , lookAtTile, lookAtActors, guardItemVerbs
#endif
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

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           Game.LambdaHack.Client.UI.ItemSlot
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 qualified Game.LambdaHack.Common.Tile as Tile
import           Game.LambdaHack.Common.Time
import           Game.LambdaHack.Common.Types
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 err :: Text
err) = "*" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
err Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "*"

type MError = Maybe FailError

mergeMError :: MError -> MError -> MError
mergeMError :: MError -> MError -> MError
mergeMError Nothing Nothing = MError
forall a. Maybe a
Nothing
mergeMError merr1 :: MError
merr1@Just{} Nothing = MError
merr1
mergeMError Nothing merr2 :: MError
merr2@Just{} = MError
merr2
mergeMError (Just err1 :: FailError
err1) (Just err2 :: 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
<+> "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 err :: 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 err :: 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 ferr :: 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) = a -> Either MError a
forall a b. b -> Either a b
Right a
a

-- | Switches current member to the next on the level, if any, wrapping.
memberCycleLevel :: (MonadClient m, MonadClientUI m)
                 => Bool -> Direction -> m MError
memberCycleLevel :: Bool -> Direction -> m MError
memberCycleLevel verbose :: Bool
verbose direction :: 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
  ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
  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 (autoDun :: Bool
autoDun, _) = Faction -> (Bool, Bool)
autoDungeonLevel Faction
fact
  let hsSort :: [(ActorId, Actor, ActorUI)]
hsSort = case Direction
direction of
        Forward -> [(ActorId, Actor, ActorUI)]
hs
        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 (\(_, b :: Actor
b, _) -> Actor -> LevelId
blid Actor
b LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== LevelId
lidV) [(ActorId, Actor, ActorUI)]
hsSort of
    _ | Bool
autoDun 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 "cannot pick any other member on this level"
    (np :: ActorId
np, b :: Actor
b, _) : _ -> do
      Bool
success <- Bool -> ActorId -> m Bool
forall (m :: * -> *).
(MonadClient 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` "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 member to the previous in the whole dungeon, wrapping.
memberCycle :: (MonadClient m, MonadClientUI m) => Bool -> Direction -> m MError
memberCycle :: Bool -> Direction -> m MError
memberCycle verbose :: Bool
verbose direction :: 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
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
  [(ActorId, Actor, ActorUI)]
hs <- ActorId -> m [(ActorId, Actor, ActorUI)]
forall (m :: * -> *).
MonadClientUI m =>
ActorId -> m [(ActorId, Actor, ActorUI)]
partyAfterLeader ActorId
leader
  let (autoDun :: Bool
autoDun, _) = Faction -> (Bool, Bool)
autoDungeonLevel Faction
fact
  let hsSort :: [(ActorId, Actor, ActorUI)]
hsSort = case Direction
direction of
        Forward -> [(ActorId, Actor, ActorUI)]
hs
        Backward -> [(ActorId, Actor, ActorUI)] -> [(ActorId, Actor, ActorUI)]
forall a. [a] -> [a]
reverse [(ActorId, Actor, ActorUI)]
hs
  case [(ActorId, Actor, ActorUI)]
hsSort of
    _ | Bool
autoDun -> 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 "no other member in the party"
    (np :: ActorId
np, b :: Actor
b, _) : _ -> do
      Bool
success <- Bool -> ActorId -> m Bool
forall (m :: * -> *).
(MonadClient 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` "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 leader :: ActorId
leader = do
  FactionId
side <- (State -> FactionId) -> m FactionId
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> FactionId) -> m FactionId)
-> (State -> FactionId) -> m FactionId
forall a b. (a -> b) -> a -> b
$ Actor -> FactionId
bfid (Actor -> FactionId) -> (State -> Actor) -> State -> FactionId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ActorId -> State -> Actor
getActorBody ActorId
leader
  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 (\(aid :: ActorId
aid, b :: 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 (-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 (\(aid :: ActorId
aid, _, _) -> ActorId
aid ActorId -> ActorId -> Bool
forall a. Eq a => a -> a -> Bool
== ActorId
leader) [(ActorId, Actor, ActorUI)]
hs
      (lt :: [(ActorId, Actor, ActorUI)]
lt, gt :: [(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
+ 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 :: (MonadClient m, MonadClientUI m) => Bool -> ActorId -> m Bool
pickLeader :: Bool -> ActorId -> m Bool
pickLeader verbose :: Bool
verbose aid :: ActorId
aid = do
  ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
  if ActorId
leader ActorId -> ActorId -> Bool
forall a. Eq a => a -> a -> Bool
== 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` "projectile chosen as the leader"
                        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.
(MonadClient m, 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, "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
$ \sess :: SessionUI
sess -> SessionUI
sess {saimMode :: Maybe AimMode
saimMode =
        (\aimMode :: 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.
      (itemsBlurb :: Text
itemsBlurb, _) <- Bool
-> Point -> ActorId -> Maybe (Part, Bool) -> m (Text, Maybe Person)
forall (m :: * -> *).
MonadClientUI m =>
Bool
-> Point -> ActorId -> Maybe (Part, Bool) -> m (Text, Maybe Person)
lookAtItems Bool
True (Actor -> Point
bpos Actor
body) ActorId
aid Maybe (Part, Bool)
forall a. Maybe a
Nothing
      Text
stashBlurb <- LevelId -> Point -> m Text
forall (m :: * -> *). MonadClientUI m => LevelId -> Point -> m Text
lookAtStash (Actor -> LevelId
blid Actor
body) (Actor -> Point
bpos Actor
body)
      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.
(MonadClient m, 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

pickLeaderWithPointer :: (MonadClient m, MonadClientUI m) => m MError
pickLeaderWithPointer :: m MError
pickLeaderWithPointer = 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 (\(aid :: ActorId
aid, b :: 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
      (autoDun :: Bool
autoDun, _) = Faction -> (Bool, Bool)
autoDungeonLevel Faction
fact
      pick :: (ActorId, Actor) -> m MError
pick (aid :: ActorId
aid, b :: Actor
b) =
        if | Actor -> LevelId
blid Actor
b LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
/= LevelId
arena Bool -> Bool -> Bool
&& Bool
autoDun ->
               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
           | Bool
otherwise -> 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 :: * -> *).
(MonadClient 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 px :: Int
px py :: 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
- 2 Bool -> Bool -> Bool
&& Int
px Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 -> Bool -> Direction -> m MError
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
Bool -> Direction -> m MError
memberCycle 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
- 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
- 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
           (aid :: ActorId
aid, b :: Actor
b, _) : _ -> (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 (\(_, b :: Actor
b, _) -> Actor -> Point
bpos Actor
b Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Point
p) [(ActorId, Actor, ActorUI)]
oursUI of
           Nothing -> Text -> m MError
forall (m :: * -> *). MonadClientUI m => Text -> m MError
failMsg "not pointing at an actor"
           Just (aid :: ActorId
aid, b :: Actor
b, _) -> (ActorId, Actor) -> m MError
pick (ActorId
aid, Actor
b)

itemOverlay :: MonadClientUI m
            => SingleItemSlots -> LevelId -> ItemBag -> Bool -> m OKX
itemOverlay :: SingleItemSlots -> LevelId -> ItemBag -> Bool -> m OKX
itemOverlay lSlots :: SingleItemSlots
lSlots lid :: LevelId
lid bag :: ItemBag
bag displayRanged :: Bool
displayRanged = do
  CCUI{coscreen :: CCUI -> ScreenContent
coscreen=ScreenContent{Int
rwidth :: ScreenContent -> Int
rwidth :: Int
rwidth}} <- (SessionUI -> CCUI) -> m CCUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
  Time
localTime <- (State -> Time) -> m Time
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Time) -> m Time) -> (State -> Time) -> m Time
forall a b. (a -> b) -> a -> b
$ LevelId -> State -> Time
getLocalTime LevelId
lid
  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
  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
  ItemBag
combGround <- (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
$ FactionId -> State -> ItemBag
combinedGround FactionId
side
  ItemBag
combOrgan <- (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
$ FactionId -> State -> ItemBag
combinedOrgan FactionId
side
  ItemBag
combEqp <- (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
$ FactionId -> State -> ItemBag
combinedEqp FactionId
side
  ItemBag
stashBag <- (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
$ FactionId -> State -> ItemBag
getFactionStashBag FactionId
side
  DiscoveryBenefit
discoBenefit <- (StateClient -> DiscoveryBenefit) -> m DiscoveryBenefit
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> DiscoveryBenefit
sdiscoBenefit
  FontSetup{..} <- m FontSetup
forall (m :: * -> *). MonadClientUI m => m FontSetup
getFontSetup
  let !_A :: ()
_A = Bool -> () -> ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert ((ItemId -> Bool) -> [ItemId] -> Bool
forall a. Show a => (a -> Bool) -> [a] -> Bool
allB (ItemId -> [ItemId] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` SingleItemSlots -> [ItemId]
forall k a. EnumMap k a -> [a]
EM.elems SingleItemSlots
lSlots) (ItemBag -> [ItemId]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys ItemBag
bag)
                    Bool -> (LevelId, ItemBag, SingleItemSlots) -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` (LevelId
lid, ItemBag
bag, SingleItemSlots
lSlots)) ()
      markEqp :: ItemId -> Text -> Text
markEqp iid :: ItemId
iid t :: Text
t =
        if | (ItemId
iid ItemId -> ItemBag -> Bool
forall k a. Enum k => k -> EnumMap k a -> Bool
`EM.member` ItemBag
combOrgan
             Bool -> Bool -> Bool
|| ItemId
iid ItemId -> ItemBag -> Bool
forall k a. Enum k => k -> EnumMap k a -> Bool
`EM.member` ItemBag
combEqp)
             Bool -> Bool -> Bool
&& ItemId
iid ItemId -> ItemBag -> Bool
forall k a. Enum k => k -> EnumMap k a -> Bool
`EM.notMember` ItemBag
stashBag
             Bool -> Bool -> Bool
&& ItemId
iid ItemId -> ItemBag -> Bool
forall k a. Enum k => k -> EnumMap k a -> Bool
`EM.notMember` ItemBag
combGround -> Text -> Char -> Text
T.snoc (Text -> Text
T.init Text
t) ']'
               -- all ready to fight with
           | ItemId
iid ItemId -> ItemBag -> Bool
forall k a. Enum k => k -> EnumMap k a -> Bool
`EM.member` ItemBag
stashBag -> Text -> Char -> Text
T.snoc (Text -> Text
T.init Text
t) '}'
               -- some spares in shared stash
           | Bool
otherwise -> Text
t
      pr :: (SlotChar, ItemId)
-> Maybe
     ((AttrLine, (Int, AttrLine)),
      (Either [KM] SlotChar, (PointUI, ButtonWidth)))
pr (l :: SlotChar
l, iid :: ItemId
iid) =
        case ItemId -> ItemBag -> Maybe ItemQuant
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup ItemId
iid ItemBag
bag of
          Nothing -> Maybe
  ((AttrLine, (Int, AttrLine)),
   (Either [KM] SlotChar, (PointUI, ButtonWidth)))
forall a. Maybe a
Nothing
          Just kit :: ItemQuant
kit@(k :: Int
k, _) ->
            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 let color :: Color
color = if Benefit -> Bool
benInEqp (DiscoveryBenefit
discoBenefit DiscoveryBenefit -> ItemId -> Benefit
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ItemId
iid)
                                   then Color
Color.BrGreen
                                   else Color
Color.BrRed
                       in Color -> Char -> AttrCharW32
Color.attrChar2ToW32 Color
color
                                               (ItemKind -> Char
IK.isymbol (ItemKind -> Char) -> ItemKind -> Char
forall a b. (a -> b) -> a -> b
$ ItemFull -> ItemKind
itemKind 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 4 Int
k Time
localTime ItemFull
itemFull ItemQuant
kit]
                al1 :: AttrLine
al1 = AttrString -> AttrLine
attrStringToAL
                      (AttrString -> AttrLine) -> AttrString -> AttrLine
forall a b. (a -> b) -> a -> b
$ Text -> AttrString
textToAS (ItemId -> Text -> Text
markEqp ItemId
iid (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ SlotChar -> Text
slotLabel SlotChar
l)
                        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]
                xal2 :: (Int, AttrLine)
xal2 = ( 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
al1
                       , AttrString -> AttrLine
attrStringToAL (AttrString -> AttrLine) -> AttrString -> AttrLine
forall a b. (a -> b) -> a -> b
$ AttrCharW32
Color.spaceAttrW32 AttrCharW32 -> AttrString -> AttrString
forall a. a -> [a] -> [a]
: Text -> AttrString
textToAS Text
phrase )
                kx :: (Either [KM] SlotChar, (PointUI, ButtonWidth))
kx = (SlotChar -> Either [KM] SlotChar
forall a b. b -> Either a b
Right SlotChar
l, ( Int -> Int -> PointUI
PointUI 0 0
                               , DisplayFont -> Int -> ButtonWidth
ButtonWidth DisplayFont
propFont (5 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Text -> Int
T.length Text
phrase) ))
            in ((AttrLine, (Int, AttrLine)),
 (Either [KM] SlotChar, (PointUI, ButtonWidth)))
-> Maybe
     ((AttrLine, (Int, AttrLine)),
      (Either [KM] SlotChar, (PointUI, ButtonWidth)))
forall a. a -> Maybe a
Just ((AttrLine
al1, (Int, AttrLine)
xal2), (Either [KM] SlotChar, (PointUI, ButtonWidth))
kx)
      (ts :: [(AttrLine, (Int, AttrLine))]
ts, kxs :: [(Either [KM] SlotChar, (PointUI, ButtonWidth))]
kxs) = [((AttrLine, (Int, AttrLine)),
  (Either [KM] SlotChar, (PointUI, ButtonWidth)))]
-> ([(AttrLine, (Int, AttrLine))],
    [(Either [KM] SlotChar, (PointUI, ButtonWidth))])
forall a b. [(a, b)] -> ([a], [b])
unzip ([((AttrLine, (Int, AttrLine)),
   (Either [KM] SlotChar, (PointUI, ButtonWidth)))]
 -> ([(AttrLine, (Int, AttrLine))],
     [(Either [KM] SlotChar, (PointUI, ButtonWidth))]))
-> [((AttrLine, (Int, AttrLine)),
     (Either [KM] SlotChar, (PointUI, ButtonWidth)))]
-> ([(AttrLine, (Int, AttrLine))],
    [(Either [KM] SlotChar, (PointUI, ButtonWidth))])
forall a b. (a -> b) -> a -> b
$ ((SlotChar, ItemId)
 -> Maybe
      ((AttrLine, (Int, AttrLine)),
       (Either [KM] SlotChar, (PointUI, ButtonWidth))))
-> [(SlotChar, ItemId)]
-> [((AttrLine, (Int, AttrLine)),
     (Either [KM] SlotChar, (PointUI, ButtonWidth)))]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (SlotChar, ItemId)
-> Maybe
     ((AttrLine, (Int, AttrLine)),
      (Either [KM] SlotChar, (PointUI, ButtonWidth)))
pr ([(SlotChar, ItemId)]
 -> [((AttrLine, (Int, AttrLine)),
      (Either [KM] SlotChar, (PointUI, ButtonWidth)))])
-> [(SlotChar, ItemId)]
-> [((AttrLine, (Int, AttrLine)),
     (Either [KM] SlotChar, (PointUI, ButtonWidth)))]
forall a b. (a -> b) -> a -> b
$ SingleItemSlots -> [(SlotChar, ItemId)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs SingleItemSlots
lSlots
      (tsLab :: [AttrLine]
tsLab, tsDesc :: [(Int, AttrLine)]
tsDesc) = [(AttrLine, (Int, AttrLine))] -> ([AttrLine], [(Int, AttrLine)])
forall a b. [(a, b)] -> ([a], [b])
unzip [(AttrLine, (Int, AttrLine))]
ts
      ovsLab :: EnumMap DisplayFont Overlay
ovsLab = 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]
tsLab
      ovsDesc :: EnumMap DisplayFont Overlay
ovsDesc = 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)]
tsDesc
      renumber :: Int -> (a, (PointUI, b)) -> (a, (PointUI, b))
renumber y :: Int
y (km :: a
km, (PointUI x :: Int
x _, len :: b
len)) = (a
km, (Int -> Int -> PointUI
PointUI Int
x Int
y, b
len))
  OKX -> m OKX
forall (m :: * -> *) a. Monad m => a -> m a
return ((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]
(++) EnumMap DisplayFont Overlay
ovsLab EnumMap DisplayFont Overlay
ovsDesc, (Int
 -> (Either [KM] SlotChar, (PointUI, ButtonWidth))
 -> (Either [KM] SlotChar, (PointUI, ButtonWidth)))
-> [Int]
-> [(Either [KM] SlotChar, (PointUI, ButtonWidth))]
-> [(Either [KM] SlotChar, (PointUI, ButtonWidth))]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int
-> (Either [KM] SlotChar, (PointUI, ButtonWidth))
-> (Either [KM] SlotChar, (PointUI, ButtonWidth))
forall a b. Int -> (a, (PointUI, b)) -> (a, (PointUI, b))
renumber [0..] [(Either [KM] SlotChar, (PointUI, ButtonWidth))]
kxs )

skillsOverlay :: MonadClientUI m => ActorId -> m OKX
skillsOverlay :: ActorId -> m OKX
skillsOverlay aid :: 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{..} <- m FontSetup
forall (m :: * -> *). MonadClientUI m => m FontSetup
getFontSetup
  let prSlot :: (Int, SlotChar) -> Ability.Skill
             -> ((AttrLine, (Int, AttrLine), (Int, AttrLine)), KYX)
      prSlot :: (Int, SlotChar)
-> Skill
-> ((AttrLine, (Int, AttrLine), (Int, AttrLine)),
    (Either [KM] SlotChar, (PointUI, ButtonWidth)))
prSlot (y :: Int
y, c :: SlotChar
c) skill :: Skill
skill =
        let skName :: Text
skName = " " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Skill -> Text
skillName Skill
skill
            slotLab :: Text
slotLab = SlotChar -> Text
slotLabel SlotChar
c
            lab :: AttrLine
lab = Text -> AttrLine
textToAL Text
slotLab
            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 42 else 20
            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
labLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
indentation, Text -> AttrLine
textToAL Text
valueText) )
        in ((AttrLine, (Int, AttrLine), (Int, AttrLine))
triple, (SlotChar -> Either [KM] SlotChar
forall a b. b -> Either a b
Right SlotChar
c, ( Int -> Int -> PointUI
PointUI 0 Int
y
                              , DisplayFont -> Int -> ButtonWidth
ButtonWidth DisplayFont
propFont (28 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Text -> Int
T.length Text
slotLab) )))
      (ts :: [(AttrLine, (Int, AttrLine), (Int, AttrLine))]
ts, kxs :: [(Either [KM] SlotChar, (PointUI, ButtonWidth))]
kxs) = [((AttrLine, (Int, AttrLine), (Int, AttrLine)),
  (Either [KM] SlotChar, (PointUI, ButtonWidth)))]
-> ([(AttrLine, (Int, AttrLine), (Int, AttrLine))],
    [(Either [KM] SlotChar, (PointUI, ButtonWidth))])
forall a b. [(a, b)] -> ([a], [b])
unzip ([((AttrLine, (Int, AttrLine), (Int, AttrLine)),
   (Either [KM] SlotChar, (PointUI, ButtonWidth)))]
 -> ([(AttrLine, (Int, AttrLine), (Int, AttrLine))],
     [(Either [KM] SlotChar, (PointUI, ButtonWidth))]))
-> [((AttrLine, (Int, AttrLine), (Int, AttrLine)),
     (Either [KM] SlotChar, (PointUI, ButtonWidth)))]
-> ([(AttrLine, (Int, AttrLine), (Int, AttrLine))],
    [(Either [KM] SlotChar, (PointUI, ButtonWidth))])
forall a b. (a -> b) -> a -> b
$ ((Int, SlotChar)
 -> Skill
 -> ((AttrLine, (Int, AttrLine), (Int, AttrLine)),
     (Either [KM] SlotChar, (PointUI, ButtonWidth))))
-> [(Int, SlotChar)]
-> [Skill]
-> [((AttrLine, (Int, AttrLine), (Int, AttrLine)),
     (Either [KM] SlotChar, (PointUI, ButtonWidth)))]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Int, SlotChar)
-> Skill
-> ((AttrLine, (Int, AttrLine), (Int, AttrLine)),
    (Either [KM] SlotChar, (PointUI, ButtonWidth)))
prSlot ([Int] -> [SlotChar] -> [(Int, SlotChar)]
forall a b. [a] -> [b] -> [(a, b)]
zip [0..] [SlotChar]
allSlots) [Skill]
skillSlots
      (skLab :: [AttrLine]
skLab, skDescr :: [(Int, AttrLine)]
skDescr, skValue :: [(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], [(Either [KM] SlotChar, (PointUI, ButtonWidth))]
kxs)

placesFromState :: ContentData PK.PlaceKind -> ClientOptions -> State
                -> EM.EnumMap (ContentId PK.PlaceKind)
                              (ES.EnumSet LevelId, Int, Int, Int)
placesFromState :: ContentData PlaceKind
-> ClientOptions
-> State
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
placesFromState coplace :: ContentData PlaceKind
coplace ClientOptions{Bool
sexposePlaces :: ClientOptions -> Bool
sexposePlaces :: Bool
sexposePlaces} s :: State
s =
  let addEntries :: (EnumSet k, b, c, d)
-> (EnumSet k, b, c, d) -> (EnumSet k, b, c, d)
addEntries (!EnumSet k
es1, !b
ne1, !c
na1, !d
nd1) (!EnumSet k
es2, !b
ne2, !c
na2, !d
nd2) =
        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
            !ne :: b
ne = b
ne1 b -> b -> b
forall a. Num a => a -> a -> a
+ b
ne2
            !na :: c
na = c
na1 c -> c -> c
forall a. Num a => a -> a -> a
+ c
na2
            !nd :: d
nd = d
nd1 d -> d -> d
forall a. Num a => a -> a -> a
+ d
nd2
        in (EnumSet k
es, b
ne, c
na, d
nd)
      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 pk :: ContentId PlaceKind
pk) em :: 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, 1, 0, 0) EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
em
            f (PK.PAround pk :: ContentId PlaceKind
pk) em :: 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, 0, 1, 0) EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
em
            f (PK.PExists pk :: ContentId PlaceKind
pk) em :: 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, 0, 0, 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
      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 _ = 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, 0, 0, 0) EnumMap k (EnumSet k, b, c, d)
em
      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)

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{..} <- 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
-> ClientOptions
-> State
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
placesFromState ContentData PlaceKind
coplace ClientOptions
soptions
  let prSlot :: (Int, SlotChar)
             -> (ContentId PK.PlaceKind, (ES.EnumSet LevelId, Int, Int, Int))
             -> (AttrLine, (Int, AttrLine), KYX)
      prSlot :: (Int, SlotChar)
-> (ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))
-> (AttrLine, (Int, AttrLine),
    (Either [KM] SlotChar, (PointUI, ButtonWidth)))
prSlot (y :: Int
y, c :: SlotChar
c) (pk :: ContentId PlaceKind
pk, (es :: EnumSet LevelId
es, _, _, _)) =
        let placeName :: Text
placeName = 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
            markPlace :: Text -> Text
markPlace t :: Text
t = if EnumSet LevelId -> Bool
forall k. EnumSet k -> Bool
ES.null EnumSet LevelId
es
                          then Text -> Char -> Text
T.snoc (Text -> Text
T.init Text
t) '>'
                          else Text
t
            !tSlot :: Text
tSlot = Text -> Text
markPlace (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ SlotChar -> Text
slotLabel SlotChar
c  -- free @places@ as you go
            !lenSlot :: Int
lenSlot = 2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Text -> Int
T.length Text
tSlot
            !tBlurb :: Text
tBlurb = " "
                      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
placeName
                      Text -> Text -> Text
<+> if EnumSet LevelId -> Bool
forall k. EnumSet k -> Bool
ES.null EnumSet LevelId
es
                          then ""
                          else "("
                               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) "level"]
                               Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ")"
            !lenButton :: Int
lenButton = Int
lenSlot Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Text -> Int
T.length Text
tBlurb
            !pButton :: PointUI
pButton = Int -> Int -> PointUI
PointUI 0 Int
y
            !widthButton :: ButtonWidth
widthButton = DisplayFont -> Int -> ButtonWidth
ButtonWidth DisplayFont
propFont Int
lenButton
        in ( Text -> AttrLine
textToAL Text
tSlot
           , (Int
lenSlot, Text -> AttrLine
textToAL Text
tBlurb)
           , (SlotChar -> Either [KM] SlotChar
forall a b. b -> Either a b
Right SlotChar
c, (PointUI
pButton, ButtonWidth
widthButton)) )
      (plLab :: [AttrLine]
plLab, plDesc :: [(Int, AttrLine)]
plDesc, kxs :: [(Either [KM] SlotChar, (PointUI, ButtonWidth))]
kxs) = [(AttrLine, (Int, AttrLine),
  (Either [KM] SlotChar, (PointUI, ButtonWidth)))]
-> ([AttrLine], [(Int, AttrLine)],
    [(Either [KM] SlotChar, (PointUI, ButtonWidth))])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 ([(AttrLine, (Int, AttrLine),
   (Either [KM] SlotChar, (PointUI, ButtonWidth)))]
 -> ([AttrLine], [(Int, AttrLine)],
     [(Either [KM] SlotChar, (PointUI, ButtonWidth))]))
-> [(AttrLine, (Int, AttrLine),
     (Either [KM] SlotChar, (PointUI, ButtonWidth)))]
-> ([AttrLine], [(Int, AttrLine)],
    [(Either [KM] SlotChar, (PointUI, ButtonWidth))])
forall a b. (a -> b) -> a -> b
$ ((Int, SlotChar)
 -> (ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))
 -> (AttrLine, (Int, AttrLine),
     (Either [KM] SlotChar, (PointUI, ButtonWidth))))
-> [(Int, SlotChar)]
-> [(ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))]
-> [(AttrLine, (Int, AttrLine),
     (Either [KM] SlotChar, (PointUI, ButtonWidth)))]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Int, SlotChar)
-> (ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))
-> (AttrLine, (Int, AttrLine),
    (Either [KM] SlotChar, (PointUI, ButtonWidth)))
prSlot ([Int] -> [SlotChar] -> [(Int, SlotChar)]
forall a b. [a] -> [b] -> [(a, b)]
zip [0..] [SlotChar]
allSlots)
                                    ([(ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))]
 -> [(AttrLine, (Int, AttrLine),
      (Either [KM] SlotChar, (PointUI, ButtonWidth)))])
-> [(ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))]
-> [(AttrLine, (Int, AttrLine),
     (Either [KM] SlotChar, (PointUI, ButtonWidth)))]
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
      placeLab :: EnumMap DisplayFont Overlay
placeLab = 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]
plLab
      placeDesc :: EnumMap DisplayFont Overlay
placeDesc = 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)]
plDesc
  OKX -> m OKX
forall (m :: * -> *) a. Monad m => a -> m a
return ((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]
(++) EnumMap DisplayFont Overlay
placeLab EnumMap DisplayFont Overlay
placeDesc, [(Either [KM] SlotChar, (PointUI, ButtonWidth))]
kxs)

describeMode :: MonadClientUI m
             => Bool -> ContentId MK.ModeKind
             -> m (EM.EnumMap DisplayFont Overlay)
describeMode :: Bool -> ContentId ModeKind -> m (EnumMap DisplayFont Overlay)
describeMode addTitle :: Bool
addTitle gameModeId :: ContentId ModeKind
gameModeId = 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
  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{..} <- 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 <- (StateClient -> EnumSet (ContentId ModeKind))
-> m (EnumSet (ContentId ModeKind))
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> EnumSet (ContentId ModeKind)
scampings
  EnumSet (ContentId ModeKind)
srestarts <- (StateClient -> EnumSet (ContentId ModeKind))
-> m (EnumSet (ContentId ModeKind))
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> EnumSet (ContentId ModeKind)
srestarts
  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 '\n' = "\n\n"
      duplicateEOL c :: Char
c = Char -> Text
T.singleton Char
c
      sections :: [(AttrString, Text)]
sections =
        [ ( Color -> Text -> AttrString
textFgToAS Color
Color.BrGreen "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 "Rules of the game:"
          , ModeKind -> Text
MK.mrules ModeKind
gameMode )
        , ( Color -> Text -> AttrString
textFgToAS Color
Color.BrCyan "Running commentary:"
          , (Char -> Text) -> Text -> Text
T.concatMap Char -> Text
duplicateEOL (ModeKind -> Text
MK.mreason ModeKind
gameMode) )
        , ( Color -> Text -> AttrString
textFgToAS Color
Color.cGreed "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 (header :: AttrString
header, desc :: 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)]
      title :: Text
title = if Bool
addTitle
              then "\nYou are 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
<> "' adventure.\n"
              else ""
      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
- 2) (Int
rwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- 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
<> "\n"))
        (DisplayFont, AttrString)
-> [(DisplayFont, AttrString)] -> [(DisplayFont, AttrString)]
forall a. a -> [a] -> [a]
: [[(DisplayFont, AttrString)]] -> [(DisplayFont, AttrString)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([(DisplayFont, AttrString)]
-> [[(DisplayFont, AttrString)]] -> [[(DisplayFont, AttrString)]]
forall a. a -> [a] -> [a]
intersperse [(DisplayFont
monoFont, Text -> AttrString
textToAS "\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
- 2) (Int
rwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- 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
                     "\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 "*none*")]
            else [(DisplayFont, AttrString)]
sectionsEndAS
      sectionsEndAS :: [(DisplayFont, AttrString)]
sectionsEndAS = [[(DisplayFont, AttrString)]] -> [(DisplayFont, AttrString)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([(DisplayFont, AttrString)]
-> [[(DisplayFont, AttrString)]] -> [[(DisplayFont, AttrString)]]
forall a. a -> [a] -> [a]
intersperse [(DisplayFont
monoFont, Text -> AttrString
textToAS "\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 :: MK.Outcome -> (AttrString, Text)
      outcomeSection :: Outcome -> (AttrString, Text)
outcomeSection outcome :: Outcome
outcome =
        ( Outcome -> AttrString
renderOutcome Outcome
outcome
        , if Bool -> Bool
not (Outcome -> Bool
outcomeSeen Outcome
outcome)
          then ""  -- 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 "" (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
MK.Restart, "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
MK.Camping, "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
      outcomeSeen :: MK.Outcome -> Bool
      outcomeSeen :: Outcome -> Bool
outcomeSeen outcome :: Outcome
outcome = case Outcome
outcome of
        MK.Camping -> ContentId ModeKind
gameModeId ContentId ModeKind -> EnumSet (ContentId ModeKind) -> Bool
forall k. Enum k => k -> EnumSet k -> Bool
`ES.member` EnumSet (ContentId ModeKind)
scampings
        MK.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] -> 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 :: MK.Outcome
      lastOutcome :: Outcome
lastOutcome = if [ScoreRecord] -> Bool
forall a. [a] -> Bool
null [ScoreRecord]
scoreRecords
                    then Outcome
MK.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 :: MK.Outcome -> AttrString
      renderOutcome :: Outcome -> AttrString
renderOutcome outcome :: Outcome
outcome =
        let color :: Color
color | Outcome
outcome Outcome -> [Outcome] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Outcome]
MK.deafeatOutcomes = Color
Color.cVeryBadEvent
                  | Outcome
outcome Outcome -> [Outcome] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Outcome]
MK.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 = ""
              | Outcome
outcome Outcome -> [Outcome] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Outcome]
MK.deafeatOutcomes = "(last suffered ending)"
              | Outcome
outcome Outcome -> [Outcome] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Outcome]
MK.victoryOutcomes = "(last achieved ending)"
              | Bool
otherwise = "(last seen ending)"
        in Text -> AttrString
textToAS "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
MK.nameOutcomePast Outcome
outcome)
                 AttrString -> AttrString -> AttrString
<+:> Text -> AttrString
textToAS Text
lastRemark)
           AttrString -> AttrString -> AttrString
forall a. Semigroup a => a -> a -> a
<> Text -> AttrString
textToAS ":"
      shiftPointUI :: Int -> PointUI -> PointUI
shiftPointUI x :: Int
x (PointUI x0 :: Int
x0 y0 :: Int
y0) = Int -> Int -> PointUI
PointUI (Int
x0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x) Int
y0
  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, AttrLine)] -> Overlay
offsetOverlayX
                 ([(Int, AttrLine)] -> Overlay) -> [(Int, AttrLine)] -> Overlay
forall a b. (a -> b) -> a -> b
$ (AttrLine -> (Int, AttrLine)) -> [AttrLine] -> [(Int, AttrLine)]
forall a b. (a -> b) -> [a] -> [b]
map (\t :: AttrLine
t -> (2, AttrLine
t))
                 ([AttrLine] -> [(Int, AttrLine)])
-> [AttrLine] -> [(Int, AttrLine)]
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 (((PointUI, AttrLine) -> (PointUI, AttrLine)) -> Overlay -> Overlay
forall a b. (a -> b) -> [a] -> [b]
map ((PointUI -> PointUI) -> (PointUI, AttrLine) -> (PointUI, AttrLine)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first ((PointUI -> PointUI)
 -> (PointUI, AttrLine) -> (PointUI, AttrLine))
-> (PointUI -> PointUI)
-> (PointUI, AttrLine)
-> (PointUI, AttrLine)
forall a b. (a -> b) -> a -> b
$ Int -> PointUI -> PointUI
shiftPointUI 1))
                  (EnumMap DisplayFont Overlay -> EnumMap DisplayFont Overlay)
-> EnumMap DisplayFont Overlay -> EnumMap DisplayFont Overlay
forall a b. (a -> b) -> a -> b
$ Int -> [(DisplayFont, [AttrLine])] -> EnumMap DisplayFont Overlay
attrLinesToFontMap 0 [(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 (((PointUI, AttrLine) -> (PointUI, AttrLine)) -> Overlay -> Overlay
forall a b. (a -> b) -> [a] -> [b]
map ((PointUI -> PointUI) -> (PointUI, AttrLine) -> (PointUI, AttrLine)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first ((PointUI -> PointUI)
 -> (PointUI, AttrLine) -> (PointUI, AttrLine))
-> (PointUI -> PointUI)
-> (PointUI, AttrLine)
-> (PointUI, AttrLine)
forall a b. (a -> b) -> a -> b
$ Int -> PointUI -> PointUI
shiftPointUI (Int -> PointUI -> PointUI) -> Int -> PointUI -> PointUI
forall a b. (a -> b) -> a -> b
$ Int
rwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1))
                  (EnumMap DisplayFont Overlay -> EnumMap DisplayFont Overlay)
-> EnumMap DisplayFont Overlay -> EnumMap DisplayFont Overlay
forall a b. (a -> b) -> a -> b
$ Int -> [(DisplayFont, [AttrLine])] -> EnumMap DisplayFont Overlay
attrLinesToFontMap 0 [(DisplayFont, [AttrLine])]
blurbEnd)

modesOverlay :: MonadClientUI m => m OKX
modesOverlay :: m OKX
modesOverlay = 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
  FontSetup{..} <- m FontSetup
forall (m :: * -> *). MonadClientUI m => m FontSetup
getFontSetup
  EnumMap (ContentId ModeKind) (Map Challenge Int)
svictories <- (StateClient -> EnumMap (ContentId ModeKind) (Map Challenge Int))
-> m (EnumMap (ContentId ModeKind) (Map Challenge Int))
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> 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
_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 :: (Int, SlotChar)
             -> (ContentId MK.ModeKind, MK.ModeKind)
             -> (AttrLine, (Int, AttrLine), KYX)
      prSlot :: (Int, SlotChar)
-> (ContentId ModeKind, ModeKind)
-> (AttrLine, (Int, AttrLine),
    (Either [KM] SlotChar, (PointUI, ButtonWidth)))
prSlot (y :: Int
y, c :: SlotChar
c) (gameModeId :: ContentId ModeKind
gameModeId, gameMode :: 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
              Nothing -> 0
              Just cm :: Map Challenge Int
cm -> Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe 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)
            markMode :: Text -> Text
markMode t :: Text
t = if Int
victories Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0
                         then Text -> Char -> Text
T.snoc (Text -> Text
T.init Text
t) '>'
                         else Text
t
            !tSlot :: Text
tSlot = Text -> Text
markMode (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ SlotChar -> Text
slotLabel SlotChar
c
            !lenSlot :: Int
lenSlot = 2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Text -> Int
T.length Text
tSlot
            !tBlurb :: Text
tBlurb = " " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
modeName
            !lenButton :: Int
lenButton = Int
lenSlot Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Text -> Int
T.length Text
tBlurb
            !pButton :: PointUI
pButton = Int -> Int -> PointUI
PointUI 0 Int
y
            !widthButton :: ButtonWidth
widthButton = DisplayFont -> Int -> ButtonWidth
ButtonWidth DisplayFont
propFont Int
lenButton
        in ( Text -> AttrLine
textToAL Text
tSlot
           , (Int
lenSlot, Text -> AttrLine
textToAL Text
tBlurb)
           , (SlotChar -> Either [KM] SlotChar
forall a b. b -> Either a b
Right SlotChar
c, (PointUI
pButton, ButtonWidth
widthButton)) )
      (plLab :: [AttrLine]
plLab, plDesc :: [(Int, AttrLine)]
plDesc, kxs :: [(Either [KM] SlotChar, (PointUI, ButtonWidth))]
kxs) =
        [(AttrLine, (Int, AttrLine),
  (Either [KM] SlotChar, (PointUI, ButtonWidth)))]
-> ([AttrLine], [(Int, AttrLine)],
    [(Either [KM] SlotChar, (PointUI, ButtonWidth))])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 ([(AttrLine, (Int, AttrLine),
   (Either [KM] SlotChar, (PointUI, ButtonWidth)))]
 -> ([AttrLine], [(Int, AttrLine)],
     [(Either [KM] SlotChar, (PointUI, ButtonWidth))]))
-> [(AttrLine, (Int, AttrLine),
     (Either [KM] SlotChar, (PointUI, ButtonWidth)))]
-> ([AttrLine], [(Int, AttrLine)],
    [(Either [KM] SlotChar, (PointUI, ButtonWidth))])
forall a b. (a -> b) -> a -> b
$ ((Int, SlotChar)
 -> (ContentId ModeKind, ModeKind)
 -> (AttrLine, (Int, AttrLine),
     (Either [KM] SlotChar, (PointUI, ButtonWidth))))
-> [(Int, SlotChar)]
-> [(ContentId ModeKind, ModeKind)]
-> [(AttrLine, (Int, AttrLine),
     (Either [KM] SlotChar, (PointUI, ButtonWidth)))]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Int, SlotChar)
-> (ContentId ModeKind, ModeKind)
-> (AttrLine, (Int, AttrLine),
    (Either [KM] SlotChar, (PointUI, ButtonWidth)))
prSlot ([Int] -> [SlotChar] -> [(Int, SlotChar)]
forall a b. [a] -> [b] -> [(a, b)]
zip [0..] [SlotChar]
allSlots) [(ContentId ModeKind, ModeKind)]
campaignModes
      placeLab :: EnumMap DisplayFont Overlay
placeLab = 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]
plLab
      placeDesc :: EnumMap DisplayFont Overlay
placeDesc = 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)]
plDesc
  OKX -> m OKX
forall (m :: * -> *) a. Monad m => a -> m a
return ((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]
(++) EnumMap DisplayFont Overlay
placeLab EnumMap DisplayFont Overlay
placeDesc, [(Either [KM] SlotChar, (PointUI, ButtonWidth))]
kxs)

pickNumber :: (MonadClient m, MonadClientUI m)
           => Bool -> Int -> m (Either MError Int)
pickNumber :: Bool -> Int -> m (Either MError Int)
pickNumber askNumber :: Bool
askNumber kAll :: 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
>= 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 -> KM
K.mkChar '-'
                  , 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 ['0'..'9']
      gatherNumber :: Int -> m (Either MError Int)
gatherNumber kCur :: Int
kCur = Bool -> m (Either MError Int) -> m (Either MError Int)
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (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 = "Choose number:" Text -> Text -> Text
<+> Int -> Text
forall a. Show a => a -> Text
tshow Int
kCur
        MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClient m, 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
        Either KM SlotChar
ekkm <- String
-> ColorMode -> Bool -> Slideshow -> [KM] -> m (Either KM SlotChar)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
String
-> ColorMode -> Bool -> Slideshow -> [KM] -> m (Either KM SlotChar)
displayChoiceScreen "" ColorMode
ColorFull Bool
False Slideshow
sli [KM]
frontKeyKeys
        case Either KM SlotChar
ekkm of
          Left kkm :: KM
kkm ->
            case KM -> Key
K.key KM
kkm of
              K.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
+ 1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
kAll then 1 else Int
kCur Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1
              K.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
- 1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 1 then Int
kAll else Int
kCur Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1
              K.Char l :: Char
l | Int
kCur Int -> Int -> Int
forall a. Num a => a -> a -> a
* 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
== 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 l :: 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
* 10 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
Char.digitToInt Char
l
              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 1 (Int
kCur Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 10)
              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
              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 "never mind"
              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
              _ -> 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
$ "unexpected key" String -> KM -> String
forall v. Show v => String -> v -> String
`showFailure` KM
kkm
          Right sc :: SlotChar
sc -> 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
$ "unexpected slot char" String -> SlotChar -> String
forall v. Show v => String -> v -> String
`showFailure` SlotChar
sc
  if | Int
kAll Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
askNumber -> 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
     | Bool
otherwise -> do
         Either MError Int
res <- Int -> m (Either MError Int)
gatherNumber Int
kAll
         case Either MError Int
res of
           Right k :: Int
k | Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 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 -> (Either MError Int, Int) -> String
forall v. Show v => String -> v -> String
`showFailure` (Either MError Int
res, Int
kAll)
           _ -> 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
           -> ActorId          -- ^ the actor that looks
           -> LevelId          -- ^ level the position is at
           -> Maybe MU.Person  -- ^ grammatical person of the item(s), if any
           -> m (Text, Text, [(Int, MU.Part)])
lookAtTile :: Bool
-> Point
-> ActorId
-> LevelId
-> Maybe Person
-> m (Text, Text, [(Int, Part)])
lookAtTile canSee :: Bool
canSee p :: Point
p aid :: ActorId
aid lidV :: LevelId
lidV mperson :: 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
  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
  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
$ Bool -> Actor -> Point -> Int -> COps -> Level -> Maybe Int
makeLine Bool
False Actor
b Point
p Int
seps COps
cops Level
lvl
      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
== "unknown space" = "that is"
          | Bool -> Bool
not ([ActorId] -> Bool
forall a. [a] -> Bool
null [ActorId]
inhabitants) Bool -> Bool -> Bool
&& Actor -> Point
bpos Actor
b Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
/= Point
p = "the terrain here is"
          | Bool -> Bool
not Bool
canSee = "you remember"
          | Bool -> Bool
not Bool
aims = "you are aware of"  -- walkable path a proxy for in LOS
          | Bool
otherwise = "you see"
      vperson :: Part
vperson = case Maybe Person
mperson of
        Nothing -> Part
vis
        Just MU.Sg1st -> String -> Part
forall a. (?callStack::CallStack) => String -> a
error "an item speaks in first person"
        Just MU.Sg3rd -> "It is laying on"
        Just MU.PlEtc -> "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 pk :: ContentId PlaceKind
pk blurb :: 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
        Nothing -> ""
        Just (PK.PEntry pk :: ContentId PlaceKind
pk) -> ContentId PlaceKind -> Part -> Text
entrySentence ContentId PlaceKind
pk "it is an entrance to"
        Just (PK.PAround pk :: ContentId PlaceKind
pk) -> ContentId PlaceKind -> Part -> Text
entrySentence ContentId PlaceKind
pk "it surrounds"
        Just (PK.PExists _) -> ""
      embedLook :: (ItemId, ItemQuant) -> (Int, Part)
embedLook (iid :: ItemId
iid, kit :: ItemQuant
kit@(k :: Int
k, _)) =
        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 (\(iid :: ItemId
iid, kit :: 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 p :: Point
p lidV :: 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 ("", Maybe (Part, Bool)
forall a. Maybe a
Nothing, "")
    (aid :: ActorId
aid, body :: Actor
body) : rest :: [(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).
          (subject :: Part
subject, person :: Person
person) = [Part] -> (Part, Person)
squashedWWandW [Part]
subjects
          resideVerb :: Part
resideVerb = case Actor -> Watchfulness
bwatch Actor
body of
            WWatch -> "be here"
            WWait 0 -> "idle here"
            WWait _ -> "brace for impact"
            WSleep -> "sleep here"
            WWake -> "be waking up"
          flyVerb :: Part
flyVerb | Actor -> Bool
bproj Actor
body = "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 = "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 = ""
                   | 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 ""
               else [Part] -> Text
makeSentence ([Part] -> Text) -> [Part] -> Text
forall a b. (a -> b) -> a -> b
$ "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 tfid :: 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 "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 "Originally of" Text -> Text -> Text
<+> Faction -> Text
gname Faction
tfact
                 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ", now fighting for" Text -> Text -> Text
<+> Text
dominatedBy Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "."
            _ | DetailLevel
detail DetailLevel -> DetailLevel -> Bool
forall a. Ord a => a -> a -> Bool
< DetailLevel
DetailAll -> ""  -- only domination worth spamming
            _ | Actor -> FactionId
bfid Actor
body FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side -> ""  -- just one of us
            _ | Actor -> Bool
bproj Actor
body -> "Launched by" Text -> Text -> Text
<+> Faction -> Text
gname Faction
bfact Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "."
            _ -> "One of" Text -> Text -> Text
<+> Faction -> Text
gname Faction
bfact Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "."
          idesc :: Text
idesc = if DetailLevel
detail DetailLevel -> DetailLevel -> Bool
forall a. Ord a => a -> a -> Bool
< DetailLevel
DetailAll
                  then ""
                  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 (\(_, b :: 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 "and" Person
person Polarity
MU.Yes
                                                  Part
subject [Part]
verbs]
          headBlurb :: Text
headBlurb = [Part] -> Text
makeSentence [Part -> Person -> Polarity -> Part -> [Part] -> Part
MU.SubjectVVxV "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
            _ : projs :: [Part]
projs@(_ : _) ->
              let (subjectProjs :: Part
subjectProjs, personProjs :: 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 "can be seen"]
            _ -> ""
          actorAlive :: Bool
actorAlive = Actor -> Int64
bhp Actor
body Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= 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) "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 "and" Person
MU.Sg3rd Polarity
MU.No
                                          "and" [Part]
guardVerbs
                         , "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, "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, "can be seen"]
             , Maybe (Part, Bool)
forall a. Maybe a
Nothing
             , "" )

guardItemVerbs :: Actor -> State -> [MU.Part]
guardItemVerbs :: Actor -> State -> [Part]
guardItemVerbs body :: Actor
body s :: 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
== 1 = ["fondle a trinket"]
                      | Int
itemsSize Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1 = ["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 body :: Actor
body s :: State
s =
  let toReport :: ItemId -> Bool
toReport iid :: 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 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
<= 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
            -> 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 -> ActorId -> Maybe (Part, Bool) -> m (Text, Maybe Person)
lookAtItems canSee :: Bool
canSee p :: Point
p aid :: ActorId
aid mactorPronounAlive :: 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
  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
  -- 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 lidV :: LevelId
lidV = LevelId -> (AimMode -> LevelId) -> Maybe AimMode -> LevelId
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Actor -> LevelId
blid Actor
b) AimMode -> LevelId
aimLevelId Maybe AimMode
saimMode
      standingOn :: Bool
standingOn = Point
p Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> Point
bpos Actor
b Bool -> Bool -> Bool
&& LevelId
lidV LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> LevelId
blid Actor
b
      -- 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
&& Actor -> FactionId
bfid Actor
b FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side 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
  Part
subjectAid <- ActorId -> m Part
forall (m :: * -> *). MonadClientUI m => ActorId -> m Part
partActorLeader ActorId
aid
  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
  Part
leaderPronoun <- ActorId -> m Part
forall (m :: * -> *). MonadClientUI m => ActorId -> m Part
partPronounLeader ActorId
aid
  let mLeader :: Maybe (Part, Bool)
mLeader = if Bool
standingOn then (Part, Bool) -> Maybe (Part, Bool)
forall a. a -> Maybe a
Just (Part
leaderPronoun, Actor -> Int64
bhp Actor
b Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= 0) else Maybe (Part, Bool)
forall a. Maybe a
Nothing
      mactorPronounAliveLeader :: Maybe (Part, Bool)
mactorPronounAliveLeader = Maybe (Part, Bool)
-> ((Part, Bool) -> Maybe (Part, Bool))
-> Maybe (Part, Bool)
-> Maybe (Part, Bool)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe (Part, Bool)
mLeader (Part, Bool) -> Maybe (Part, Bool)
forall a. a -> Maybe a
Just Maybe (Part, Bool)
mactorPronounAlive
      (subject :: Part
subject, verb :: Text
verb) = case Maybe (Part, Bool)
mactorPronounAliveLeader of
        Just (actorPronoun :: Part
actorPronoun, actorAlive :: Bool
actorAlive) ->
          (Part
actorPronoun, if Bool
actorAlive then "stand over" else "fall over")
        Nothing -> (Part
subjectAid, if Bool
canSee then "notice" else "remember")
      nWs :: (ItemId, ItemQuant) -> Part
nWs (iid :: ItemId
iid, kit :: ItemQuant
kit@(k :: Int
k, _)) =
        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
      (object :: Part
object, person :: Person
person) = case ItemBag -> [(ItemId, ItemQuant)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs ItemBag
is of
        [(_, (k :: Int
k, _))] | 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
== 1 then "an item" else "an item stack", Person
MU.Sg3rd)
        _ | DetailLevel
detail DetailLevel -> DetailLevel -> Bool
forall a. Eq a => a -> a -> Bool
== DetailLevel
DetailLow -> ("some items", Person
MU.PlEtc)
        ii :: (ItemId, ItemQuant)
ii : _ : _ : _ | 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, "and other items"], Person
MU.PlEtc)
        [ii :: (ItemId, ItemQuant)
ii@(_, (1, _))] -> ((ItemId, ItemQuant) -> Part
nWs (ItemId, ItemQuant)
ii, Person
MU.Sg3rd)
        iis :: [(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 ""
           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 => LevelId -> Point -> m Text
lookAtStash :: LevelId -> Point -> m Text
lookAtStash lidV :: LevelId
lidV p :: Point
p = 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 (fid :: FactionId
fid, fact :: Faction
fact) = case Faction -> Maybe (LevelId, Point)
gstash Faction
fact of
        Just (lid :: LevelId
lid, pos :: 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 "Here is the shared inventory stash of your team."
                 else Faction -> Text
gname Faction
fact
                      Text -> Text -> Text
<+> "set up their shared inventory stash here."
        _ -> 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
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
               => LevelId -> Point -> m [(MsgClassShow, Text)]
lookAtPosition :: LevelId -> Point -> m [(MsgClassShow, Text)]
lookAtPosition lidV :: LevelId
lidV p :: Point
p = 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
  ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
  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)
  (actorsBlurb :: Text
actorsBlurb, mactorPronounAlive :: Maybe (Part, Bool)
mactorPronounAlive, actorsDesc :: 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
  (itemsBlurb :: Text
itemsBlurb, mperson :: Maybe Person
mperson) <- Bool
-> Point -> ActorId -> Maybe (Part, Bool) -> m (Text, Maybe Person)
forall (m :: * -> *).
MonadClientUI m =>
Bool
-> Point -> ActorId -> Maybe (Part, Bool) -> m (Text, Maybe Person)
lookAtItems Bool
canSee Point
p ActorId
leader 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
  (tileBlurb :: Text
tileBlurb, placeBlurb :: Text
placeBlurb, embedsList :: [(Int, Part)]
embedsList) <- Bool
-> Point
-> ActorId
-> LevelId
-> Maybe Person
-> m (Text, Text, [(Int, Part)])
forall (m :: * -> *).
MonadClientUI m =>
Bool
-> Point
-> ActorId
-> LevelId
-> Maybe Person
-> m (Text, Text, [(Int, Part)])
lookAtTile Bool
canSee Point
p ActorId
leader LevelId
lidV 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 <- LevelId -> Point -> m Text
forall (m :: * -> *). MonadClientUI m => LevelId -> Point -> m Text
lookAtStash LevelId
lidV Point
p
  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 sml :: Time
sml | Time
sml Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
> Time
ltime ->
          let Delta t :: 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 "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
<> "s ago."
        _ -> ""
  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 (k :: Int
k, part :: Part
part) =
        let verb :: Part
verb = if Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 then "is" else "are"
        in [Part] -> Text
makeSentence ["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 (\(iid :: ItemId
iid, kit :: 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
Tile.parseTileAction Bool
False Bool
False [(ItemKind, (ItemId, ItemQuant))]
embedKindList)
                             [Feature]
feats
      isEmbedAction :: TileAction -> Bool
isEmbedAction Tile.EmbedAction{} = Bool
True
      isEmbedAction _ = Bool
False
      embedVerb :: [Part]
embedVerb = [ "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
itemKind, _) -> 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 Tile.ToAction{} = Bool
True
      isToAction _ = Bool
False
      isWithAction :: TileAction -> Bool
isWithAction Tile.WithAction{} = Bool
True
      isWithAction _ = Bool
False
      isEmptyWithAction :: TileAction -> Bool
isEmptyWithAction (Tile.WithAction [] _) = Bool
True
      isEmptyWithAction _ = 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 = ["very easily modified"]
                | (TileAction -> Bool) -> [TileAction] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any TileAction -> Bool
isToAction [TileAction]
tileActions = ["easily modified"]
                | (TileAction -> Bool) -> [TileAction] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any TileAction -> Bool
isWithAction [TileAction]
tileActions = ["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 ""
                   else [Part] -> Text
makeSentence ["can be", [Part] -> Part
MU.WWandW [Part]
verbs]
      toolFromAction :: TileAction -> Maybe [(Int, GroupName ItemKind)]
toolFromAction (Tile.WithAction grps :: [(Int, GroupName ItemKind)]
grps _) = [(Int, GroupName ItemKind)] -> Maybe [(Int, GroupName ItemKind)]
forall a. a -> Maybe a
Just [(Int, GroupName ItemKind)]
grps
      toolFromAction _ = 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 ""
                       else "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
<> "."  -- 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 ""
               else "\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
                DetailLow -> []  -- not to obscure aiming line
                DetailMedium ->
                  [(MsgClassShow
MsgPromptMention, case [(Int, Part)]
embedsList of
                    [] -> ""
                    [(k :: Int
k, _)] ->
                      (Int, Part) -> Text
ppEmbedName (1, if Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1
                                      then "an embedded item"
                                      else "a stack of embedded items")
                    _ -> (Int, Part) -> Text
ppEmbedName (9, "some embedded items"))]
                _ -> 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
> 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

displayItemLore :: (MonadClient m, MonadClientUI m)
                => ItemBag -> Int -> (ItemId -> ItemFull -> Int -> Text) -> Int
                -> SingleItemSlots
                -> m Bool
displayItemLore :: ItemBag
-> Int
-> (ItemId -> ItemFull -> Int -> Text)
-> Int
-> SingleItemSlots
-> m Bool
displayItemLore itemBag :: ItemBag
itemBag meleeSkill :: Int
meleeSkill promptFun :: ItemId -> ItemFull -> Int -> Text
promptFun slotIndex :: Int
slotIndex lSlots :: SingleItemSlots
lSlots = do
  KM
km <- ItemBag
-> Int
-> (ItemId -> ItemFull -> Int -> Text)
-> Int
-> SingleItemSlots
-> Bool
-> m KM
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
ItemBag
-> Int
-> (ItemId -> ItemFull -> Int -> Text)
-> Int
-> SingleItemSlots
-> Bool
-> m KM
displayItemLorePointedAt ItemBag
itemBag Int
meleeSkill ItemId -> ItemFull -> Int -> Text
promptFun Int
slotIndex
                                 SingleItemSlots
lSlots Bool
False
  case KM -> Key
K.key KM
km of
    K.Space -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    K.Esc -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    _ -> String -> m Bool
forall a. (?callStack::CallStack) => String -> a
error (String -> m Bool) -> String -> m Bool
forall a b. (a -> b) -> a -> b
$ "" String -> KM -> String
forall v. Show v => String -> v -> String
`showFailure` KM
km

displayItemLorePointedAt
  :: (MonadClient m, MonadClientUI m)
  => ItemBag -> Int -> (ItemId -> ItemFull -> Int -> Text) -> Int
  -> SingleItemSlots -> Bool
  -> m K.KM
displayItemLorePointedAt :: ItemBag
-> Int
-> (ItemId -> ItemFull -> Int -> Text)
-> Int
-> SingleItemSlots
-> Bool
-> m KM
displayItemLorePointedAt itemBag :: ItemBag
itemBag meleeSkill :: Int
meleeSkill promptFun :: ItemId -> ItemFull -> Int -> Text
promptFun slotIndex :: Int
slotIndex
                         lSlots :: SingleItemSlots
lSlots addTilde :: Bool
addTilde = do
  CCUI{coscreen :: CCUI -> ScreenContent
coscreen=ScreenContent{Int
rwidth :: Int
rwidth :: ScreenContent -> Int
rwidth, Int
rheight :: Int
rheight :: ScreenContent -> Int
rheight}} <- (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
  let lSlotsElems :: [ItemId]
lSlotsElems = SingleItemSlots -> [ItemId]
forall k a. EnumMap k a -> [a]
EM.elems SingleItemSlots
lSlots
      lSlotsBound :: Int
lSlotsBound = [ItemId] -> Int
forall a. [a] -> Int
length [ItemId]
lSlotsElems Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1
      iid2 :: ItemId
iid2 = [ItemId]
lSlotsElems [ItemId] -> Int -> ItemId
forall a. [a] -> Int -> a
!! Int
slotIndex
      kit2 :: ItemQuant
kit2@(k :: Int
k, _) = ItemBag
itemBag ItemBag -> ItemId -> ItemQuant
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ItemId
iid2
  ItemFull
itemFull2 <- (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
iid2
  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 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
iid2 (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
  FontSetup{..} <- m FontSetup
forall (m :: * -> *). MonadClientUI m => m FontSetup
getFontSetup
  let descAl :: AttrString
descAl = Int
-> Bool
-> FactionId
-> EnumMap FactionId Faction
-> Int
-> CStore
-> Time
-> LevelId
-> ItemFull
-> ItemQuant
-> AttrString
itemDesc Int
rwidth Bool
True FactionId
side EnumMap FactionId Faction
factionD Int
meleeSkill
                        CStore
CGround Time
localTime LevelId
jlid ItemFull
itemFull2 ItemQuant
kit2
      (descSymAl :: AttrString
descSymAl, descBlurbAl :: AttrString
descBlurbAl) = (AttrCharW32 -> Bool) -> AttrString -> (AttrString, AttrString)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (AttrCharW32 -> AttrCharW32 -> Bool
forall a. Eq a => a -> a -> Bool
/= AttrCharW32
Color.spaceAttrW32) AttrString
descAl
      descSym :: Overlay
descSym = [AttrLine] -> Overlay
offsetOverlay ([AttrLine] -> Overlay) -> [AttrLine] -> Overlay
forall a b. (a -> b) -> a -> b
$ Int -> Int -> AttrString -> [AttrLine]
splitAttrString Int
rwidth Int
rwidth AttrString
descSymAl
      descBlurb :: Overlay
descBlurb = [(Int, AttrLine)] -> Overlay
offsetOverlayX ([(Int, AttrLine)] -> Overlay) -> [(Int, AttrLine)] -> Overlay
forall a b. (a -> b) -> a -> b
$
        case Int -> Int -> AttrString -> [AttrLine]
splitAttrString Int
rwidth Int
rwidth (AttrString -> [AttrLine]) -> AttrString -> [AttrLine]
forall a b. (a -> b) -> a -> b
$ String -> AttrString
stringToAS "xx" AttrString -> AttrString -> AttrString
forall a. [a] -> [a] -> [a]
++ AttrString
descBlurbAl of
          [] -> String -> [(Int, AttrLine)]
forall a. (?callStack::CallStack) => String -> a
error "splitting AttrString loses characters"
          al1 :: AttrLine
al1 : rest :: [AttrLine]
rest ->
            (2, AttrString -> AttrLine
attrStringToAL (AttrString -> AttrLine) -> AttrString -> AttrLine
forall a b. (a -> b) -> a -> b
$ Int -> AttrString -> AttrString
forall a. Int -> [a] -> [a]
drop 2 (AttrString -> AttrString) -> AttrString -> AttrString
forall a b. (a -> b) -> a -> b
$ AttrLine -> AttrString
attrLine AttrLine
al1) (Int, AttrLine) -> [(Int, AttrLine)] -> [(Int, AttrLine)]
forall a. a -> [a] -> [a]
: (AttrLine -> (Int, AttrLine)) -> [AttrLine] -> [(Int, AttrLine)]
forall a b. (a -> b) -> [a] -> [b]
map (0,) [AttrLine]
rest
      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
descSym
           (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
descBlurb
      keys :: [KM]
keys = [KM
K.spaceKM, KM
K.escKM]
             [KM] -> [KM] -> [KM]
forall a. [a] -> [a] -> [a]
++ [Char -> KM
K.mkChar '~' | Bool
addTilde]
             [KM] -> [KM] -> [KM]
forall a. [a] -> [a] -> [a]
++ [KM
K.upKM | Int
slotIndex Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= 0]
             [KM] -> [KM] -> [KM]
forall a. [a] -> [a] -> [a]
++ [KM
K.downKM | Int
slotIndex Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
lSlotsBound]
  MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgPromptGeneric (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ ItemId -> ItemFull -> Int -> Text
promptFun ItemId
iid2 ItemFull
itemFull2 Int
k
  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
- 2) [KM]
keys (EnumMap DisplayFont Overlay
ov, [])
  KM
km <- ColorMode -> [KM] -> Slideshow -> m KM
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
ColorMode -> [KM] -> Slideshow -> m KM
getConfirms ColorMode
ColorFull [KM]
keys Slideshow
slides
  case KM -> Key
K.key KM
km of
    K.Up ->
      ItemBag
-> Int
-> (ItemId -> ItemFull -> Int -> Text)
-> Int
-> SingleItemSlots
-> Bool
-> m KM
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
ItemBag
-> Int
-> (ItemId -> ItemFull -> Int -> Text)
-> Int
-> SingleItemSlots
-> Bool
-> m KM
displayItemLorePointedAt ItemBag
itemBag Int
meleeSkill ItemId -> ItemFull -> Int -> Text
promptFun (Int
slotIndex Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1)
                               SingleItemSlots
lSlots Bool
addTilde
    K.Down ->
      ItemBag
-> Int
-> (ItemId -> ItemFull -> Int -> Text)
-> Int
-> SingleItemSlots
-> Bool
-> m KM
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
ItemBag
-> Int
-> (ItemId -> ItemFull -> Int -> Text)
-> Int
-> SingleItemSlots
-> Bool
-> m KM
displayItemLorePointedAt ItemBag
itemBag Int
meleeSkill ItemId -> ItemFull -> Int -> Text
promptFun (Int
slotIndex Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1)
                               SingleItemSlots
lSlots Bool
addTilde
    _ -> KM -> m KM
forall (m :: * -> *) a. Monad m => a -> m a
return KM
km

viewLoreItems :: (MonadClient m, MonadClientUI m)
              => String -> SingleItemSlots -> ItemBag -> Text
              -> (Int -> SingleItemSlots -> m Bool) -> Bool
              -> m K.KM
viewLoreItems :: String
-> SingleItemSlots
-> ItemBag
-> Text
-> (Int -> SingleItemSlots -> m Bool)
-> Bool
-> m KM
viewLoreItems menuName :: String
menuName lSlotsRaw :: SingleItemSlots
lSlotsRaw trunkBag :: ItemBag
trunkBag prompt :: Text
prompt examItem :: Int -> SingleItemSlots -> m Bool
examItem displayRanged :: Bool
displayRanged = 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
  LevelId
arena <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
getArenaUI
  ItemId -> ItemFull
itemToF <- (State -> ItemId -> ItemFull) -> m (ItemId -> ItemFull)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemId -> ItemFull) -> m (ItemId -> ItemFull))
-> (State -> ItemId -> ItemFull) -> m (ItemId -> ItemFull)
forall a b. (a -> b) -> a -> b
$ (ItemId -> State -> ItemFull) -> State -> ItemId -> ItemFull
forall a b c. (a -> b -> c) -> b -> a -> c
flip ItemId -> State -> ItemFull
itemToFull
  let keysPre :: [KM]
keysPre = [KM
K.spaceKM, Char -> KM
K.mkChar '<', Char -> KM
K.mkChar '>', KM
K.escKM]
      lSlots :: SingleItemSlots
lSlots = (ItemId -> ItemFull) -> SingleItemSlots -> SingleItemSlots
sortSlotMap ItemId -> ItemFull
itemToF SingleItemSlots
lSlotsRaw
  MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgPromptGeneric Text
prompt
  OKX
io <- SingleItemSlots -> LevelId -> ItemBag -> Bool -> m OKX
forall (m :: * -> *).
MonadClientUI m =>
SingleItemSlots -> LevelId -> ItemBag -> Bool -> m OKX
itemOverlay SingleItemSlots
lSlots LevelId
arena ItemBag
trunkBag Bool
displayRanged
  Slideshow
itemSlides <- 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
- 2) [KM]
keysPre OKX
io
  let keyOfEKM :: Either [KM] SlotChar -> [KM]
keyOfEKM (Left km :: [KM]
km) = [KM]
km
      keyOfEKM (Right SlotChar{Char
slotChar :: SlotChar -> Char
slotChar :: Char
slotChar}) = [Char -> KM
K.mkChar Char
slotChar]
      allOKX :: [(Either [KM] SlotChar, (PointUI, ButtonWidth))]
allOKX = (OKX -> [(Either [KM] SlotChar, (PointUI, ButtonWidth))])
-> [OKX] -> [(Either [KM] SlotChar, (PointUI, ButtonWidth))]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap OKX -> [(Either [KM] SlotChar, (PointUI, ButtonWidth))]
forall a b. (a, b) -> b
snd ([OKX] -> [(Either [KM] SlotChar, (PointUI, ButtonWidth))])
-> [OKX] -> [(Either [KM] SlotChar, (PointUI, ButtonWidth))]
forall a b. (a -> b) -> a -> b
$ Slideshow -> [OKX]
slideshow Slideshow
itemSlides
      keysMain :: [KM]
keysMain = [KM]
keysPre [KM] -> [KM] -> [KM]
forall a. [a] -> [a] -> [a]
++ ((Either [KM] SlotChar, (PointUI, ButtonWidth)) -> [KM])
-> [(Either [KM] SlotChar, (PointUI, ButtonWidth))] -> [KM]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Either [KM] SlotChar -> [KM]
keyOfEKM (Either [KM] SlotChar -> [KM])
-> ((Either [KM] SlotChar, (PointUI, ButtonWidth))
    -> Either [KM] SlotChar)
-> (Either [KM] SlotChar, (PointUI, ButtonWidth))
-> [KM]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either [KM] SlotChar, (PointUI, ButtonWidth))
-> Either [KM] SlotChar
forall a b. (a, b) -> a
fst) [(Either [KM] SlotChar, (PointUI, ButtonWidth))]
allOKX
      viewAtSlot :: SlotChar -> m KM
viewAtSlot slot :: SlotChar
slot = do
        let ix0 :: Int
ix0 = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe (String -> Int
forall a. (?callStack::CallStack) => String -> a
error (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ SlotChar -> String
forall a. Show a => a -> String
show SlotChar
slot)
                            ((SlotChar -> Bool) -> [SlotChar] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex (SlotChar -> SlotChar -> Bool
forall a. Eq a => a -> a -> Bool
== SlotChar
slot) ([SlotChar] -> Maybe Int) -> [SlotChar] -> Maybe Int
forall a b. (a -> b) -> a -> b
$ SingleItemSlots -> [SlotChar]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys SingleItemSlots
lSlots)
        Bool
go2 <- Int -> SingleItemSlots -> m Bool
examItem Int
ix0 SingleItemSlots
lSlots
        if Bool
go2
        then String
-> SingleItemSlots
-> ItemBag
-> Text
-> (Int -> SingleItemSlots -> m Bool)
-> Bool
-> m KM
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
String
-> SingleItemSlots
-> ItemBag
-> Text
-> (Int -> SingleItemSlots -> m Bool)
-> Bool
-> m KM
viewLoreItems String
menuName SingleItemSlots
lSlots ItemBag
trunkBag Text
prompt
                           Int -> SingleItemSlots -> m Bool
examItem Bool
displayRanged
        else KM -> m KM
forall (m :: * -> *) a. Monad m => a -> m a
return KM
K.escKM
  Either KM SlotChar
ekm <- String
-> ColorMode -> Bool -> Slideshow -> [KM] -> m (Either KM SlotChar)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
String
-> ColorMode -> Bool -> Slideshow -> [KM] -> m (Either KM SlotChar)
displayChoiceScreen String
menuName ColorMode
ColorFull Bool
False Slideshow
itemSlides [KM]
keysMain
  case Either KM SlotChar
ekm of
    Left km :: KM
km | KM
km KM -> [KM] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [KM
K.spaceKM, Char -> KM
K.mkChar '<', Char -> KM
K.mkChar '>', KM
K.escKM] ->
      KM -> m KM
forall (m :: * -> *) a. Monad m => a -> m a
return KM
km
    Left K.KM{key :: KM -> Key
key=K.Char l :: Char
l} -> SlotChar -> m KM
viewAtSlot (SlotChar -> m KM) -> SlotChar -> m KM
forall a b. (a -> b) -> a -> b
$ Int -> Char -> SlotChar
SlotChar 0 Char
l
      -- other prefixes are not accessible via keys; tough luck; waste of effort
    Left km :: KM
km -> String -> m KM
forall a. (?callStack::CallStack) => String -> a
error (String -> m KM) -> String -> m KM
forall a b. (a -> b) -> a -> b
$ "" String -> KM -> String
forall v. Show v => String -> v -> String
`showFailure` KM
km
    Right slot :: SlotChar
slot -> SlotChar -> m KM
viewAtSlot SlotChar
slot

cycleLore :: MonadClientUI m => [m K.KM] -> [m K.KM] -> m ()
cycleLore :: [m KM] -> [m KM] -> m ()
cycleLore _ [] = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
cycleLore seen :: [m KM]
seen (m :: m KM
m : rest :: [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 '>' -> 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 '<' -> case [m KM]
seen of
                               prev :: m KM
prev : ps :: [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
                                 prev :: m KM
prev : ps :: [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 "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 "cycleLore: unexpected key"

spoilsBlurb :: Text -> Int -> Int -> Text
spoilsBlurb :: Text -> Int -> Int -> Text
spoilsBlurb currencyName :: Text
currencyName total :: Int
total dungeonTotal :: Int
dungeonTotal =
  if | Int
dungeonTotal Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 ->
         "All the spoils of your team are of the practical kind."
     | Int
total Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 -> "Your team haven't found any genuine treasure yet."
     | Bool
otherwise -> [Part] -> Text
makeSentence
         [ "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
         , "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 ownerFun :: ActorId -> m Part
ownerFun addPrepositions :: Bool
addPrepositions c :: Container
c = case Container
c of
  CFloor{} -> [Part] -> m [Part]
forall (m :: * -> *) a. Monad m => a -> m a
return ["nearby"]
  CEmbed{} -> [Part] -> m [Part]
forall (m :: * -> *) a. Monad m => a -> m a
return ["embedded nearby"]
  CActor aid :: ActorId
aid store :: 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 (preposition :: Text
preposition, noun :: 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
      CGround -> Text -> Part
MU.Text Text
noun Part -> [Part] -> [Part]
forall a. a -> [a] -> [a]
: if Actor -> Bool
bproj Actor
b then [] else ["under", Part
owner]
      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]
      _ -> [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 -> 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} snxtScenario :: Int
snxtScenario =
  let f :: [(a, b)] -> p -> a -> b -> [(a, b)]
f ![(a, b)]
acc _p :: 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)