-- | 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, memberBack, partyAfterLeader, pickLeader, pickLeaderWithPointer
  , itemOverlay, skillsOverlay, placesFromState, placeParts, placesOverlay
  , pickNumber, lookAtItems, lookAtPosition
  , displayItemLore, viewLoreItems, cycleLore, spoilsBlurb
#ifdef EXPOSE_INTERNAL
    -- * Internal operations
  , lookAtTile, lookAtActors
#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.Text as T
import qualified NLP.Miniutter.English as MU

import           Game.LambdaHack.Client.ClientOptions
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.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.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.Faction
import           Game.LambdaHack.Common.Item
import qualified Game.LambdaHack.Common.ItemAspect as IA
import           Game.LambdaHack.Common.Kind
import           Game.LambdaHack.Common.Level
import           Game.LambdaHack.Common.Misc
import           Game.LambdaHack.Common.MonadStateRead
import           Game.LambdaHack.Common.Perception
import           Game.LambdaHack.Common.Point
import           Game.LambdaHack.Common.ReqFailure
import           Game.LambdaHack.Common.State
import           Game.LambdaHack.Common.Time
import           Game.LambdaHack.Common.Types
import qualified Game.LambdaHack.Content.ItemKind as IK
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

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.
memberCycle :: MonadClientUI m => Bool -> m MError
memberCycle :: Bool -> m MError
memberCycle verbose :: Bool
verbose = 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
  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)]
hs 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 :: * -> *). 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.
memberBack :: MonadClientUI m => Bool -> m MError
memberBack :: Bool -> m MError
memberBack verbose :: Bool
verbose = 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
  case [(ActorId, Actor, ActorUI)] -> [(ActorId, Actor, ActorUI)]
forall a. [a] -> [a]
reverse [(ActorId, Actor, ActorUI)]
hs 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 :: * -> *). 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 :: 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
  Maybe AimMode
saimMode <- (SessionUI -> Maybe AimMode) -> m (Maybe AimMode)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe AimMode
saimMode
  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
$
        MsgClass -> Text -> m ()
forall (m :: * -> *). MonadClientUI m => MsgClass -> Text -> m ()
msgAdd MsgClass
MsgDone (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ [Part] -> Text
makeSentence [Part
subject, "picked as a leader"]
      -- Update client state.
      ActorId -> m ()
forall (m :: * -> *). MonadClientUI m => ActorId -> m ()
updateClientLeader ActorId
aid
      -- Move the xhair, if active, to the new level.
      case Maybe AimMode
saimMode of
        Nothing -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just _ ->
          (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 -> Maybe AimMode
forall a. a -> Maybe a
Just (AimMode -> Maybe AimMode) -> AimMode -> Maybe AimMode
forall a b. (a -> b) -> a -> b
$ LevelId -> AimMode
AimMode (LevelId -> AimMode) -> LevelId -> AimMode
forall a b. (a -> b) -> a -> b
$ Actor -> LevelId
blid Actor
body}
      -- Inform about items, etc.
      Text
itemsBlurb <- Bool -> Point -> ActorId -> m Text
forall (m :: * -> *).
MonadClientUI m =>
Bool -> Point -> ActorId -> m Text
lookAtItems Bool
True (Actor -> Point
bpos Actor
body) ActorId
aid
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
verbose (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ MsgClass -> Text -> m ()
forall (m :: * -> *). MonadClientUI m => MsgClass -> Text -> m ()
msgAdd MsgClass
MsgAtFeet Text
itemsBlurb
      Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True

pickLeaderWithPointer :: 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 :: * -> *). 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
  Point{..} <- (SessionUI -> Point) -> m Point
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Point
spointer
  -- 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
- 1 Bool -> Bool -> Bool
&& Int
px Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 -> Bool -> m MError
forall (m :: * -> *). MonadClientUI m => Bool -> m MError
memberBack Bool
True
     | Int
py Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
rheight Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1 ->
         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
== Int -> Int -> Point
Point Int
px (Int
py Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
mapStartY)) [(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 -> m OKX
itemOverlay :: SingleItemSlots -> LevelId -> ItemBag -> m OKX
itemOverlay lSlots :: SingleItemSlots
lSlots lid :: LevelId
lid bag :: ItemBag
bag = do
  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
combInv <- (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
combinedInv FactionId
side
  ItemBag
shaBag <- (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
$ \s :: State
s -> Faction -> ItemBag
gsha (Faction -> ItemBag) -> Faction -> ItemBag
forall a b. (a -> b) -> a -> b
$ State -> EnumMap FactionId Faction
sfactionD State
s EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
side
  DiscoveryBenefit
discoBenefit <- (StateClient -> DiscoveryBenefit) -> m DiscoveryBenefit
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> DiscoveryBenefit
sdiscoBenefit
  let !_A :: ()
_A = Bool -> () -> ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert ((ItemId -> Bool) -> [ItemId] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (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
combInv
             Bool -> Bool -> Bool
&& ItemId
iid ItemId -> ItemBag -> Bool
forall k a. Enum k => k -> EnumMap k a -> Bool
`EM.notMember` ItemBag
shaBag
             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
shaBag -> 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], (Either [KM] SlotChar, (Any, Int, Int)))
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], (Either [KM] SlotChar, (Any, Int, Int)))
forall a. Maybe a
Nothing
          Just kit :: ItemQuant
kit@(k :: Int
k, _) ->
            let itemFull :: ItemFull
itemFull = ItemId -> ItemFull
itemToF ItemId
iid
                colorSymbol :: AttrCharW32
colorSymbol =
                  if Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Int -> Bool) -> Maybe Int -> Bool
forall a b. (a -> b) -> a -> b
$ GroupName ItemKind -> [(GroupName ItemKind, Int)] -> Maybe Int
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup "condition" ([(GroupName ItemKind, Int)] -> Maybe Int)
-> [(GroupName ItemKind, Int)] -> Maybe Int
forall a b. (a -> b) -> a -> b
$ ItemKind -> [(GroupName ItemKind, Int)]
IK.ifreq (ItemKind -> [(GroupName ItemKind, Int)])
-> ItemKind -> [(GroupName ItemKind, Int)]
forall a b. (a -> b) -> a -> b
$ ItemFull -> ItemKind
itemKind ItemFull
itemFull
                  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
                  [FactionId
-> EnumMap FactionId Faction
-> Int
-> Time
-> ItemFull
-> ItemQuant
-> Part
partItemWsRanged FactionId
side EnumMap FactionId Faction
factionD Int
k Time
localTime ItemFull
itemFull ItemQuant
kit]
                al :: AttrLine
al = Text -> AttrLine
textToAL (ItemId -> Text -> Text
markEqp ItemId
iid (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ SlotChar -> Text
slotLabel SlotChar
l)
                     AttrLine -> AttrLine -> AttrLine
<+:> [AttrCharW32
colorSymbol]
                     AttrLine -> AttrLine -> AttrLine
<+:> Text -> AttrLine
textToAL Text
phrase
                kx :: (Either [KM] SlotChar, (Any, Int, Int))
kx = (SlotChar -> Either [KM] SlotChar
forall a b. b -> Either a b
Right SlotChar
l, (Any
forall a. (?callStack::CallStack) => a
undefined, 0, AttrLine -> Int
forall a. [a] -> Int
length AttrLine
al))
            in ([AttrLine], (Either [KM] SlotChar, (Any, Int, Int)))
-> Maybe ([AttrLine], (Either [KM] SlotChar, (Any, Int, Int)))
forall a. a -> Maybe a
Just ([AttrLine
al], (Either [KM] SlotChar, (Any, Int, Int))
kx)
      (ts :: [[AttrLine]]
ts, kxs :: [(Either [KM] SlotChar, (Any, Int, Int))]
kxs) = [([AttrLine], (Either [KM] SlotChar, (Any, Int, Int)))]
-> ([[AttrLine]], [(Either [KM] SlotChar, (Any, Int, Int))])
forall a b. [(a, b)] -> ([a], [b])
unzip ([([AttrLine], (Either [KM] SlotChar, (Any, Int, Int)))]
 -> ([[AttrLine]], [(Either [KM] SlotChar, (Any, Int, Int))]))
-> [([AttrLine], (Either [KM] SlotChar, (Any, Int, Int)))]
-> ([[AttrLine]], [(Either [KM] SlotChar, (Any, Int, Int))])
forall a b. (a -> b) -> a -> b
$ ((SlotChar, ItemId)
 -> Maybe ([AttrLine], (Either [KM] SlotChar, (Any, Int, Int))))
-> [(SlotChar, ItemId)]
-> [([AttrLine], (Either [KM] SlotChar, (Any, Int, Int)))]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (SlotChar, ItemId)
-> Maybe ([AttrLine], (Either [KM] SlotChar, (Any, Int, Int)))
pr ([(SlotChar, ItemId)]
 -> [([AttrLine], (Either [KM] SlotChar, (Any, Int, Int)))])
-> [(SlotChar, ItemId)]
-> [([AttrLine], (Either [KM] SlotChar, (Any, Int, Int)))]
forall a b. (a -> b) -> a -> b
$ SingleItemSlots -> [(SlotChar, ItemId)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs SingleItemSlots
lSlots
      renumber :: a -> (a, (a, b, c)) -> (a, (a, b, c))
renumber y :: a
y (km :: a
km, (_, x1 :: b
x1, x2 :: c
x2)) = (a
km, (a
y, b
x1, c
x2))
  OKX -> m OKX
forall (m :: * -> *) a. Monad m => a -> m a
return ([[AttrLine]] -> [AttrLine]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[AttrLine]]
ts, (Int
 -> (Either [KM] SlotChar, (Any, Int, Int))
 -> (Either [KM] SlotChar, (Int, Int, Int)))
-> [Int]
-> [(Either [KM] SlotChar, (Any, Int, Int))]
-> [(Either [KM] SlotChar, (Int, Int, Int))]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int
-> (Either [KM] SlotChar, (Any, Int, Int))
-> (Either [KM] SlotChar, (Int, Int, Int))
forall a a a b c. a -> (a, (a, b, c)) -> (a, (a, b, c))
renumber [0..] [(Either [KM] SlotChar, (Any, Int, Int))]
kxs)

skillsOverlay :: MonadClientRead 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
  let prSlot :: (Y, SlotChar) -> Ability.Skill -> (Text, KYX)
      prSlot :: (Int, SlotChar)
-> Skill -> (Text, (Either [KM] SlotChar, (Int, Int, Int)))
prSlot (y :: Int
y, c :: SlotChar
c) skill :: Skill
skill =
        let skName :: Text
skName = Skill -> Text
skillName Skill
skill
            fullText :: Text -> Text
fullText t :: Text
t =
              [Part] -> Text
makePhrase [ Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ SlotChar -> Text
slotLabel SlotChar
c
                         , Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ Int -> Char -> Text -> Text
T.justifyLeft 22 ' ' Text
skName
                         , Text -> Part
MU.Text Text
t ]
            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
            ft :: Text
ft = Text -> Text
fullText Text
valueText
        in (Text
ft, (SlotChar -> Either [KM] SlotChar
forall a b. b -> Either a b
Right SlotChar
c, (Int
y, 0, Text -> Int
T.length Text
ft)))
      (ts :: [Text]
ts, kxs :: [(Either [KM] SlotChar, (Int, Int, Int))]
kxs) = [(Text, (Either [KM] SlotChar, (Int, Int, Int)))]
-> ([Text], [(Either [KM] SlotChar, (Int, Int, Int))])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Text, (Either [KM] SlotChar, (Int, Int, Int)))]
 -> ([Text], [(Either [KM] SlotChar, (Int, Int, Int))]))
-> [(Text, (Either [KM] SlotChar, (Int, Int, Int)))]
-> ([Text], [(Either [KM] SlotChar, (Int, Int, Int))])
forall a b. (a -> b) -> a -> b
$ ((Int, SlotChar)
 -> Skill -> (Text, (Either [KM] SlotChar, (Int, Int, Int))))
-> [(Int, SlotChar)]
-> [Skill]
-> [(Text, (Either [KM] SlotChar, (Int, Int, Int)))]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Int, SlotChar)
-> Skill -> (Text, (Either [KM] SlotChar, (Int, Int, Int)))
prSlot ([Int] -> [SlotChar] -> [(Int, SlotChar)]
forall a b. [a] -> [b] -> [(a, b)]
zip [0..] [SlotChar]
allSlots) [Skill]
skillSlots
  OKX -> m OKX
forall (m :: * -> *) a. Monad m => a -> m a
return ((Text -> AttrLine) -> [Text] -> [AttrLine]
forall a b. (a -> b) -> [a] -> [b]
map Text -> AttrLine
textToAL [Text]
ts, [(Either [KM] SlotChar, (Int, Int, Int))]
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} =
  let addEntries :: (EnumSet k, b, c, d)
-> (EnumSet k, b, c, d) -> (EnumSet k, b, c, d)
addEntries (es1 :: EnumSet k
es1, ne1 :: b
ne1, na1 :: c
na1, nd1 :: d
nd1) (es2 :: EnumSet k
es2, ne2 :: b
ne2, na2 :: c
na2, nd2 :: d
nd2) =
        (EnumSet k -> EnumSet k -> EnumSet k
forall k. EnumSet k -> EnumSet k -> EnumSet k
ES.union EnumSet k
es1 EnumSet k
es2, b
ne1 b -> b -> b
forall a. Num a => a -> a -> a
+ b
ne2, c
na1 c -> c -> c
forall a. Num a => a -> a -> a
+ c
na2, d
nd1 d -> d -> d
forall a. Num a => a -> a -> a
+ d
nd2)
      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
      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 (lid :: 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 b c d k.
(Num b, Num c, Num d) =>
(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 b c d k.
(Num b, Num c, Num d) =>
(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.PEnd 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 b c d k.
(Num b, Num c, Num d) =>
(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)
initialPlaces EntryMap
lentry
  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)
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 b c d k.
(Num b, Num c, Num d) =>
(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))
-> (State
    -> [EnumMap
          (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)])
-> State
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((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)])
-> (State -> [(LevelId, Level)])
-> State
-> [EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnumMap LevelId Level -> [(LevelId, Level)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs (EnumMap LevelId Level -> [(LevelId, Level)])
-> (State -> EnumMap LevelId Level) -> State -> [(LevelId, Level)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap LevelId Level
sdungeon

placeParts :: (ES.EnumSet LevelId, Int, Int, Int) -> [MU.Part]
placeParts :: (EnumSet LevelId, Int, Int, Int) -> [Part]
placeParts (_, ne :: Int
ne, na :: Int
na, nd :: Int
nd) =
  ["(" Part -> Part -> Part
forall a. Semigroup a => a -> a -> a
<> Int -> Part -> Part
MU.CarWs Int
ne "entrance" Part -> Part -> Part
forall a. Semigroup a => a -> a -> a
<> ")" | Int
ne Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0]
  [Part] -> [Part] -> [Part]
forall a. [a] -> [a] -> [a]
++ ["(" Part -> Part -> Part
forall a. Semigroup a => a -> a -> a
<> Int -> Part -> Part
MU.CarWs Int
na "surrounding" Part -> Part -> Part
forall a. Semigroup a => a -> a -> a
<> ")" | Int
na Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0]
  [Part] -> [Part] -> [Part]
forall a. [a] -> [a] -> [a]
++ ["(" Part -> Part -> Part
forall a. Semigroup a => a -> a -> a
<> Int -> Part -> Part
MU.CarWs Int
nd "end" Part -> Part -> Part
forall a. Semigroup a => a -> a -> a
<> ")" | Int
nd Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0]

placesOverlay :: MonadClientRead 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
  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 :: (Y, SlotChar)
             -> (ContentId PK.PlaceKind, (ES.EnumSet LevelId, Int, Int, Int))
             -> (Text, KYX)
      prSlot :: (Int, SlotChar)
-> (ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))
-> (Text, (Either [KM] SlotChar, (Int, Int, Int)))
prSlot (y :: Int
y, c :: SlotChar
c) (pk :: ContentId PlaceKind
pk, (es :: EnumSet LevelId
es, ne :: Int
ne, na :: Int
na, nd :: Int
nd)) =
        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
            parts :: [Part]
parts = (EnumSet LevelId, Int, Int, Int) -> [Part]
placeParts (EnumSet LevelId
es, Int
ne, Int
na, Int
nd)
            markPlace :: Text -> Text
markPlace t :: Text
t = if Int
ne Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
na Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
nd Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0
                          then Text -> Char -> Text
T.snoc (Text -> Text
T.init Text
t) '>'
                          else Text
t
            ft :: Text
ft = [Part] -> Text
makePhrase ([Part] -> Text) -> [Part] -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Part
MU.Text (Text -> Text
markPlace (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ SlotChar -> Text
slotLabel SlotChar
c)
                 Part -> [Part] -> [Part]
forall a. a -> [a] -> [a]
: Text -> Part
MU.Text Text
placeName
                 Part -> [Part] -> [Part]
forall a. a -> [a] -> [a]
: [Part]
parts
        in (Text
ft, (SlotChar -> Either [KM] SlotChar
forall a b. b -> Either a b
Right SlotChar
c, (Int
y, 0, Text -> Int
T.length Text
ft)))
      (ts :: [Text]
ts, kxs :: [(Either [KM] SlotChar, (Int, Int, Int))]
kxs) = [(Text, (Either [KM] SlotChar, (Int, Int, Int)))]
-> ([Text], [(Either [KM] SlotChar, (Int, Int, Int))])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Text, (Either [KM] SlotChar, (Int, Int, Int)))]
 -> ([Text], [(Either [KM] SlotChar, (Int, Int, Int))]))
-> [(Text, (Either [KM] SlotChar, (Int, Int, Int)))]
-> ([Text], [(Either [KM] SlotChar, (Int, Int, Int))])
forall a b. (a -> b) -> a -> b
$ ((Int, SlotChar)
 -> (ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))
 -> (Text, (Either [KM] SlotChar, (Int, Int, Int))))
-> [(Int, SlotChar)]
-> [(ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))]
-> [(Text, (Either [KM] SlotChar, (Int, Int, Int)))]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Int, SlotChar)
-> (ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))
-> (Text, (Either [KM] SlotChar, (Int, Int, Int)))
prSlot ([Int] -> [SlotChar] -> [(Int, SlotChar)]
forall a b. [a] -> [b] -> [(a, b)]
zip [0..] [SlotChar]
allSlots) ([(ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))]
 -> [(Text, (Either [KM] SlotChar, (Int, Int, Int)))])
-> [(ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))]
-> [(Text, (Either [KM] SlotChar, (Int, Int, Int)))]
forall a b. (a -> b) -> a -> b
$ EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
-> [(ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
places
  OKX -> m OKX
forall (m :: * -> *) a. Monad m => a -> m a
return ((Text -> AttrLine) -> [Text] -> [AttrLine]
forall a b. (a -> b) -> [a] -> [b]
map Text -> AttrLine
textToAL [Text]
ts, [(Either [KM] SlotChar, (Int, Int, Int))]
kxs)

pickNumber :: 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
        Text -> m ()
forall (m :: * -> *). MonadClientUI m => Text -> m ()
promptAdd0 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 :: * -> *).
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
           -> m Text
lookAtTile :: Bool -> Point -> ActorId -> LevelId -> m Text
lookAtTile canSee :: Bool
canSee p :: Point
p aid :: ActorId
aid lidV :: LevelId
lidV = do
  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
  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
  Maybe Int
mnewEps <- Bool -> Actor -> Point -> Int -> m (Maybe Int)
forall (m :: * -> *).
MonadStateRead m =>
Bool -> Actor -> Point -> Int -> m (Maybe Int)
makeLine Bool
False Actor
b Point
p 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 aims :: Bool
aims = Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust Maybe Int
mnewEps
      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 Bool
canSee = "you remember"
          | Bool -> Bool
not Bool
aims = "you are aware of"
          | Bool
otherwise = "you see"
      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]
      elooks :: Text
elooks = 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.PEnd pk :: ContentId PlaceKind
pk) -> ContentId PlaceKind -> Part -> Text
entrySentence ContentId PlaceKind
pk "it ends"
      itemLook :: (ItemId, ItemQuant) -> Text
itemLook (iid :: ItemId
iid, kit :: ItemQuant
kit@(k :: Int
k, _)) =
        let itemFull :: ItemFull
itemFull = ItemId -> ItemFull
itemToF ItemId
iid
            arItem :: AspectRecord
arItem = ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFull
            nWs :: Part
nWs = FactionId
-> EnumMap FactionId Faction
-> Int
-> Time
-> ItemFull
-> ItemQuant
-> Part
partItemWs FactionId
side EnumMap FactionId Faction
factionD Int
k Time
localTime ItemFull
itemFull ItemQuant
kit
            verb :: Part
verb = if Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 Bool -> Bool -> Bool
|| Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Condition AspectRecord
arItem
                   then "is"
                   else "are"
            ik :: ItemKind
ik = ItemFull -> ItemKind
itemKind ItemFull
itemFull
            desc :: Text
desc = ItemKind -> Text
IK.idesc ItemKind
ik
        in [Part] -> Text
makeSentence ["There", Part
verb, Part
nWs] Text -> Text -> Text
<+> Text
desc
      ilooks :: Text
ilooks = Text -> [Text] -> Text
T.intercalate " " ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ ((ItemId, ItemQuant) -> Text) -> [(ItemId, ItemQuant)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (ItemId, ItemQuant) -> Text
itemLook
                                 ([(ItemId, ItemQuant)] -> [Text])
-> [(ItemId, ItemQuant)] -> [Text]
forall a b. (a -> b) -> a -> b
$ COps
-> (ItemId -> ItemKind)
-> ContentId TileKind
-> ItemBag
-> [(ItemId, ItemQuant)]
sortEmbeds COps
cops ItemId -> ItemKind
getKind ContentId TileKind
tkid ItemBag
embeds
  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
$! [Part] -> Text
makeSentence [Part
vis, Part
tilePart] Text -> Text -> Text
<+> Text
elooks Text -> Text -> Text
<+> Text
ilooks

-- | Produces a textual description of actors at a position.
lookAtActors :: MonadClientUI m
             => Point      -- ^ position to describe
             -> LevelId    -- ^ level the position is at
             -> m Text
lookAtActors :: Point -> LevelId -> m Text
lookAtActors p :: Point
p lidV :: LevelId
lidV = do
  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
$ \s :: State
s -> Point -> LevelId -> State -> [(ActorId, Actor)]
posToAidAssocs Point
p LevelId
lidV State
s
  ActorDictUI
sactorUI <- (SessionUI -> ActorDictUI) -> m ActorDictUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> ActorDictUI
sactorUI
  let inhabitantsUI :: [(ActorId, Actor, ActorUI)]
inhabitantsUI =
        ((ActorId, Actor) -> (ActorId, Actor, ActorUI))
-> [(ActorId, Actor)] -> [(ActorId, Actor, ActorUI)]
forall a b. (a -> b) -> [a] -> [b]
map (\(aid2 :: ActorId
aid2, b2 :: Actor
b2) -> (ActorId
aid2, Actor
b2, ActorDictUI
sactorUI ActorDictUI -> ActorId -> ActorUI
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ActorId
aid2)) [(ActorId, Actor)]
inhabitants
  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
  State
s <- m State
forall (m :: * -> *). MonadStateRead m => m State
getState
  let actorsBlurb :: Text
actorsBlurb = case [(ActorId, Actor)]
inhabitants of
        [] -> ""
        (_, body :: Actor
body) : rest :: [(ActorId, Actor)]
rest ->
          let itemFull :: ItemFull
itemFull = ItemId -> State -> ItemFull
itemToFull (Actor -> ItemId
btrunk Actor
body) State
s
              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
              -- Even if it's the leader, give his proper name, not 'you'.
              subjects :: [Part]
subjects = ((ActorId, Actor, ActorUI) -> Part)
-> [(ActorId, Actor, ActorUI)] -> [Part]
forall a b. (a -> b) -> [a] -> [b]
map (\(_, _, bUI :: ActorUI
bUI) -> ActorUI -> Part
partActor ActorUI
bUI)
                             [(ActorId, Actor, ActorUI)]
inhabitantsUI
              -- 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"
              guardVerbs :: [Part]
guardVerbs = Actor -> Faction -> State -> [Part]
guardItemVerbs Actor
body Faction
bfact State
s
              verbs :: [Part]
verbs = Part
resideVerb Part -> [Part] -> [Part]
forall a. a -> [a] -> [a]
: [Part]
guardVerbs
              projDesc :: Text
projDesc | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Actor -> Bool
bproj Actor
body = ""
                       | 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 = [FactionId
-> EnumMap FactionId Faction
-> Time
-> ItemFull
-> ItemQuant
-> Part
partItemMediumAW 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
<> "."
                _ | 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 = 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 = if Bool
sameTrunks then Text
projDesc Text -> Text -> Text
<+> Text
factDesc Text -> Text -> Text
<+> Text
idesc else ""
              -- Both description and faction blurb may be empty.
              pdesc :: Text
pdesc = if Text
desc Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "" then "" else "(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
desc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ")"
              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
          in if | Actor -> Int64
bhp Actor
body Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 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" ])
                  Text -> Text -> Text
<+> 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"]
                        _ -> ""
                | [(ActorId, Actor)] -> Bool
forall a. [a] -> Bool
null [(ActorId, Actor)]
rest Bool -> Bool -> Bool
|| Bool
onlyIs ->
                  [Part] -> Text
makeSentence
                    [Part -> Person -> Polarity -> Part -> [Part] -> Part
MU.SubjectVVxV "and" Person
person Polarity
MU.Yes Part
subject [Part]
verbs]
                  Text -> Text -> Text
<+> Text
pdesc
                | Bool
otherwise ->
                  [Part] -> Text
makeSentence [Part
subject, "can be seen"]
                  Text -> Text -> Text
<+> if Bool
onlyIs
                      then ""
                      else [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]
  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
actorsBlurb

guardItemVerbs :: Actor -> Faction -> State -> [MU.Part]
guardItemVerbs :: Actor -> Faction -> State -> [Part]
guardItemVerbs body :: Actor
body _fact :: Faction
_fact s :: State
s =
  -- In reality, currently the client knows all the items
  -- in eqp and inv 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.
  --
  -- OTOH, shares stash is currently secret for other factions, so that
  -- case would never be triggered except for our own actors.
  -- We may want to relax that secrecy, but there are technical hurdles.
  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 "unreported inventory" (ItemKind -> [(GroupName ItemKind, Int)]
IK.ifreq ItemKind
itemKind)) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0
      itemsSize :: Int
itemsSize = [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) [ItemId] -> [ItemId] -> [ItemId]
forall a. [a] -> [a] -> [a]
++ ItemBag -> [ItemId]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys (Actor -> ItemBag
binv Actor
body)
      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 = ["guard a hoard"]
                      | Bool
otherwise = []
  in if Actor -> Bool
bproj Actor
body
     then []
     else [Part]
belongingsVerbs
--        ++ ["defend a shared stash" | not $ EM.null $ gsha fact]

-- | 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
            -> m Text
lookAtItems :: Bool -> Point -> ActorId -> m Text
lookAtItems canSee :: Bool
canSee p :: Point
p aid :: ActorId
aid = do
  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
  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
subject <- 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
  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 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
      verb :: Part
verb = Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ if | Bool
standingOn -> if Actor -> Int64
bhp Actor
b Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> 0
                                          then "stand on"
                                          else "fall over"
                          | Bool
canSee -> "notice"
                          | Bool
otherwise -> "remember"
      nWs :: (ItemId, ItemQuant) -> Part
nWs (iid :: ItemId
iid, kit :: ItemQuant
kit@(k :: Int
k, _)) =
        FactionId
-> EnumMap FactionId Faction
-> Int
-> Time
-> ItemFull
-> ItemQuant
-> Part
partItemWs FactionId
side EnumMap FactionId Faction
factionD Int
k Time
localTime (ItemId -> ItemFull
itemToF ItemId
iid) ItemQuant
kit
      object :: Part
object = case ItemBag -> [(ItemId, ItemQuant)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs ItemBag
is of
        ii :: (ItemId, ItemQuant)
ii : _ : _ : _ | Bool
standingOn Bool -> Bool -> Bool
&& Actor -> FactionId
bfid Actor
b FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side ->
          [Part] -> Part
MU.Phrase [(ItemId, ItemQuant) -> Part
nWs (ItemId, ItemQuant)
ii, "and other items"]
          -- the actor is ours, so can see details with inventory commands
        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)]
iis
  -- 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 -> m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$! if ItemBag -> Bool
forall k a. EnumMap k a -> Bool
EM.null ItemBag
is
            then ""
            else [Part] -> Text
makeSentence [Part -> Part -> Part
MU.SubjectVerbSg Part
subject Part
verb, Part
object]

-- | Produces a textual description of everything at the requested
-- level's position.
lookAtPosition :: MonadClientUI m => LevelId -> Point -> m Text
lookAtPosition :: LevelId -> Point -> m Text
lookAtPosition lidV :: LevelId
lidV p :: Point
p = do
  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)
  -- Show general info about current position.
  Text
tileBlurb <- Bool -> Point -> ActorId -> LevelId -> m Text
forall (m :: * -> *).
MonadClientUI m =>
Bool -> Point -> ActorId -> LevelId -> m Text
lookAtTile Bool
canSee Point
p ActorId
leader LevelId
lidV
  Text
actorsBlurb <- Point -> LevelId -> m Text
forall (m :: * -> *). MonadClientUI m => Point -> LevelId -> m Text
lookAtActors Point
p LevelId
lidV
  Text
itemsBlurb <- Bool -> Point -> ActorId -> m Text
forall (m :: * -> *).
MonadClientUI m =>
Bool -> Point -> ActorId -> m Text
lookAtItems Bool
canSee Point
p ActorId
leader
  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
  let 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."
        _ -> ""
  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
tileBlurb Text -> Text -> Text
<+> Text
actorsBlurb Text -> Text -> Text
<+> Text
itemsBlurb Text -> Text -> Text
<+> Text
smellBlurb

displayItemLore :: 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
  CCUI{coscreen :: CCUI -> ScreenContent
coscreen=ScreenContent{Int
rwidth :: ScreenContent -> Int
rwidth :: 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
  let attrLine :: AttrLine
attrLine = Bool
-> FactionId
-> EnumMap FactionId Faction
-> Int
-> CStore
-> Time
-> LevelId
-> ItemFull
-> ItemQuant
-> AttrLine
itemDesc Bool
True FactionId
side EnumMap FactionId Faction
factionD Int
meleeSkill
                          CStore
CGround Time
localTime LevelId
jlid ItemFull
itemFull2 ItemQuant
kit2
      ov :: [AttrLine]
ov = Int -> AttrLine -> [AttrLine]
splitAttrLine Int
rwidth AttrLine
attrLine
      keys :: [KM]
keys = [KM
K.spaceKM, KM
K.escKM]
             [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]
  Text -> m ()
forall (m :: * -> *). MonadClientUI m => Text -> m ()
promptAdd0 (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 ([AttrLine]
ov, [])
  KM
km <- ColorMode -> [KM] -> Slideshow -> m KM
forall (m :: * -> *).
MonadClientUI m =>
ColorMode -> [KM] -> Slideshow -> m KM
getConfirms ColorMode
ColorFull [KM]
keys Slideshow
slides
  case KM -> Key
K.key KM
km of
    K.Space -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    K.Up ->
      ItemBag
-> Int
-> (ItemId -> ItemFull -> Int -> Text)
-> Int
-> SingleItemSlots
-> m Bool
forall (m :: * -> *).
MonadClientUI m =>
ItemBag
-> Int
-> (ItemId -> ItemFull -> Int -> Text)
-> Int
-> SingleItemSlots
-> m Bool
displayItemLore ItemBag
itemBag Int
meleeSkill ItemId -> ItemFull -> Int -> Text
promptFun (Int
slotIndex Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) SingleItemSlots
lSlots
    K.Down ->
      ItemBag
-> Int
-> (ItemId -> ItemFull -> Int -> Text)
-> Int
-> SingleItemSlots
-> m Bool
forall (m :: * -> *).
MonadClientUI m =>
ItemBag
-> Int
-> (ItemId -> ItemFull -> Int -> Text)
-> Int
-> SingleItemSlots
-> m Bool
displayItemLore ItemBag
itemBag Int
meleeSkill ItemId -> ItemFull -> Int -> Text
promptFun (Int
slotIndex Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) SingleItemSlots
lSlots
    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

viewLoreItems :: MonadClientUI m
              => String -> SingleItemSlots -> ItemBag -> Text
              -> (Int -> SingleItemSlots -> m Bool)
              -> m K.KM
viewLoreItems :: String
-> SingleItemSlots
-> ItemBag
-> Text
-> (Int -> SingleItemSlots -> m Bool)
-> m KM
viewLoreItems menuName :: String
menuName lSlotsRaw :: SingleItemSlots
lSlotsRaw trunkBag :: ItemBag
trunkBag prompt :: Text
prompt examItem :: Int -> SingleItemSlots -> m Bool
examItem = 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
  Text -> m ()
forall (m :: * -> *). MonadClientUI m => Text -> m ()
promptAdd0 Text
prompt
  OKX
io <- SingleItemSlots -> LevelId -> ItemBag -> m OKX
forall (m :: * -> *).
MonadClientUI m =>
SingleItemSlots -> LevelId -> ItemBag -> m OKX
itemOverlay SingleItemSlots
lSlots LevelId
arena ItemBag
trunkBag
  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, (Int, Int, Int))]
allOKX = (OKX -> [(Either [KM] SlotChar, (Int, Int, Int))])
-> [OKX] -> [(Either [KM] SlotChar, (Int, Int, Int))]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap OKX -> [(Either [KM] SlotChar, (Int, Int, Int))]
forall a b. (a, b) -> b
snd ([OKX] -> [(Either [KM] SlotChar, (Int, Int, Int))])
-> [OKX] -> [(Either [KM] SlotChar, (Int, Int, Int))]
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, (Int, Int, Int)) -> [KM])
-> [(Either [KM] SlotChar, (Int, Int, Int))] -> [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, (Int, Int, Int))
    -> Either [KM] SlotChar)
-> (Either [KM] SlotChar, (Int, Int, Int))
-> [KM]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either [KM] SlotChar, (Int, Int, Int)) -> Either [KM] SlotChar
forall a b. (a, b) -> a
fst) [(Either [KM] SlotChar, (Int, Int, Int))]
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)
-> m KM
forall (m :: * -> *).
MonadClientUI m =>
String
-> SingleItemSlots
-> ItemBag
-> Text
-> (Int -> SingleItemSlots -> m Bool)
-> m KM
viewLoreItems String
menuName SingleItemSlots
lSlots ItemBag
trunkBag Text
prompt Int -> SingleItemSlots -> m Bool
examItem
        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 :: * -> *).
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 a. Eq a => a -> a -> Bool
== KM
K.spaceKM -> KM -> m KM
forall (m :: * -> *) a. Monad m => a -> m a
return KM
km
    Left km :: KM
km | KM
km KM -> KM -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> KM
K.mkChar '/' -> KM -> m KM
forall (m :: * -> *) a. Monad m => a -> m a
return KM
km
    Left km :: KM
km | KM
km KM -> KM -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> KM
K.mkChar '?' -> KM -> m KM
forall (m :: * -> *) a. Monad m => a -> m a
return KM
km
    Left km :: KM
km | KM
km KM -> KM -> Bool
forall a. Eq a => a -> a -> Bool
== 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 your spoils are of the practical kind."
     | Int
total Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 -> "You haven't found any genuine treasure yet."
     | Bool
otherwise -> [Part] -> Text
makeSentence
         [ "your 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 ]