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
, 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
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
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
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
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
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
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)) ()
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"]
ActorId -> m ()
forall (m :: * -> *). MonadClientUI m => ActorId -> m ()
updateClientLeader ActorId
aid
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}
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
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
(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) ']'
| 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) '}'
| 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
lookAtTile :: MonadClientUI m
=> Bool
-> Point
-> ActorId
-> LevelId
-> 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
lookAtActors :: MonadClientUI m
=> Point
-> LevelId
-> 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
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
(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 -> ""
_ | 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
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 ""
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 =
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
lookAtItems :: MonadClientUI m
=> Bool
-> Point
-> ActorId
-> 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
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"]
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
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]
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)
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
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
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
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 ]