{-# LANGUAGE TupleSections #-}
module Game.LambdaHack.Client.UI.HandleHelperM
( FailError, showFailError, MError, mergeMError, FailOrCmd, failWith
, failSer, failMsg, weaveJust
, memberCycle, memberCycleLevel, partyAfterLeader
, pickLeader, pickLeaderWithPointer
, itemOverlay, skillsOverlay
, placesFromState, placesOverlay
, describeMode, modesOverlay
, pickNumber, guardItemSize, lookAtItems, lookAtStash, lookAtPosition
, displayItemLore, displayItemLorePointedAt
, viewLoreItems, cycleLore, spoilsBlurb
, ppContainerWownW, nxtGameMode
#ifdef EXPOSE_INTERNAL
, lookAtTile, lookAtActors, guardItemVerbs
#endif
) where
import Prelude ()
import Game.LambdaHack.Core.Prelude
import qualified Data.Char as Char
import qualified Data.EnumMap.Strict as EM
import qualified Data.EnumSet as ES
import qualified Data.Map.Strict as M
import qualified Data.Text as T
import qualified NLP.Miniutter.English as MU
import Game.LambdaHack.Client.CommonM
import Game.LambdaHack.Client.MonadClient
import Game.LambdaHack.Client.State
import Game.LambdaHack.Client.UI.ActorUI
import Game.LambdaHack.Client.UI.Content.Screen
import Game.LambdaHack.Client.UI.ContentClientUI
import Game.LambdaHack.Client.UI.EffectDescription
import Game.LambdaHack.Client.UI.Frame
import Game.LambdaHack.Client.UI.ItemDescription
import Game.LambdaHack.Client.UI.ItemSlot
import qualified Game.LambdaHack.Client.UI.Key as K
import Game.LambdaHack.Client.UI.MonadClientUI
import Game.LambdaHack.Client.UI.Msg
import Game.LambdaHack.Client.UI.MsgM
import Game.LambdaHack.Client.UI.Overlay
import Game.LambdaHack.Client.UI.PointUI
import Game.LambdaHack.Client.UI.SessionUI
import Game.LambdaHack.Client.UI.Slideshow
import Game.LambdaHack.Client.UI.SlideshowM
import Game.LambdaHack.Common.Actor
import Game.LambdaHack.Common.ActorState
import Game.LambdaHack.Common.ClientOptions
import Game.LambdaHack.Common.Faction
import qualified Game.LambdaHack.Common.HighScore as HighScore
import Game.LambdaHack.Common.Item
import qualified Game.LambdaHack.Common.ItemAspect as IA
import Game.LambdaHack.Common.Kind
import Game.LambdaHack.Common.Level
import Game.LambdaHack.Common.Misc
import Game.LambdaHack.Common.MonadStateRead
import Game.LambdaHack.Common.Perception
import Game.LambdaHack.Common.Point
import Game.LambdaHack.Common.ReqFailure
import Game.LambdaHack.Common.State
import qualified Game.LambdaHack.Common.Tile as Tile
import Game.LambdaHack.Common.Time
import Game.LambdaHack.Common.Types
import qualified Game.LambdaHack.Content.ItemKind as IK
import qualified Game.LambdaHack.Content.ModeKind as MK
import qualified Game.LambdaHack.Content.PlaceKind as PK
import qualified Game.LambdaHack.Content.TileKind as TK
import qualified Game.LambdaHack.Definition.Ability as Ability
import qualified Game.LambdaHack.Definition.Color as Color
import Game.LambdaHack.Definition.Defs
newtype FailError = FailError {FailError -> Text
failError :: Text}
deriving (Int -> FailError -> ShowS
[FailError] -> ShowS
FailError -> String
(Int -> FailError -> ShowS)
-> (FailError -> String)
-> ([FailError] -> ShowS)
-> Show FailError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FailError] -> ShowS
$cshowList :: [FailError] -> ShowS
show :: FailError -> String
$cshow :: FailError -> String
showsPrec :: Int -> FailError -> ShowS
$cshowsPrec :: Int -> FailError -> ShowS
Show, FailError -> FailError -> Bool
(FailError -> FailError -> Bool)
-> (FailError -> FailError -> Bool) -> Eq FailError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FailError -> FailError -> Bool
$c/= :: FailError -> FailError -> Bool
== :: FailError -> FailError -> Bool
$c== :: FailError -> FailError -> Bool
Eq)
showFailError :: FailError -> Text
showFailError :: FailError -> Text
showFailError (FailError err :: Text
err) = "*" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
err Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "*"
type MError = Maybe FailError
mergeMError :: MError -> MError -> MError
mergeMError :: MError -> MError -> MError
mergeMError Nothing Nothing = MError
forall a. Maybe a
Nothing
mergeMError merr1 :: MError
merr1@Just{} Nothing = MError
merr1
mergeMError Nothing merr2 :: MError
merr2@Just{} = MError
merr2
mergeMError (Just err1 :: FailError
err1) (Just err2 :: FailError
err2) =
FailError -> MError
forall a. a -> Maybe a
Just (FailError -> MError) -> FailError -> MError
forall a b. (a -> b) -> a -> b
$ Text -> FailError
FailError (Text -> FailError) -> Text -> FailError
forall a b. (a -> b) -> a -> b
$ FailError -> Text
failError FailError
err1 Text -> Text -> Text
<+> "and" Text -> Text -> Text
<+> FailError -> Text
failError FailError
err2
type FailOrCmd a = Either FailError a
failWith :: MonadClientUI m => Text -> m (FailOrCmd a)
failWith :: Text -> m (FailOrCmd a)
failWith err :: Text
err = Bool -> m (FailOrCmd a) -> m (FailOrCmd a)
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Bool
T.null Text
err) (m (FailOrCmd a) -> m (FailOrCmd a))
-> m (FailOrCmd a) -> m (FailOrCmd a)
forall a b. (a -> b) -> a -> b
$ FailOrCmd a -> m (FailOrCmd a)
forall (m :: * -> *) a. Monad m => a -> m a
return (FailOrCmd a -> m (FailOrCmd a)) -> FailOrCmd a -> m (FailOrCmd a)
forall a b. (a -> b) -> a -> b
$ FailError -> FailOrCmd a
forall a b. a -> Either a b
Left (FailError -> FailOrCmd a) -> FailError -> FailOrCmd a
forall a b. (a -> b) -> a -> b
$ Text -> FailError
FailError Text
err
failSer :: MonadClientUI m => ReqFailure -> m (FailOrCmd a)
failSer :: ReqFailure -> m (FailOrCmd a)
failSer = Text -> m (FailOrCmd a)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith (Text -> m (FailOrCmd a))
-> (ReqFailure -> Text) -> ReqFailure -> m (FailOrCmd a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReqFailure -> Text
showReqFailure
failMsg :: MonadClientUI m => Text -> m MError
failMsg :: Text -> m MError
failMsg err :: Text
err = Bool -> m MError -> m MError
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Bool
T.null Text
err) (m MError -> m MError) -> m MError -> m MError
forall a b. (a -> b) -> a -> b
$ MError -> m MError
forall (m :: * -> *) a. Monad m => a -> m a
return (MError -> m MError) -> MError -> m MError
forall a b. (a -> b) -> a -> b
$ FailError -> MError
forall a. a -> Maybe a
Just (FailError -> MError) -> FailError -> MError
forall a b. (a -> b) -> a -> b
$ Text -> FailError
FailError Text
err
weaveJust :: FailOrCmd a -> Either MError a
weaveJust :: FailOrCmd a -> Either MError a
weaveJust (Left ferr :: FailError
ferr) = MError -> Either MError a
forall a b. a -> Either a b
Left (MError -> Either MError a) -> MError -> Either MError a
forall a b. (a -> b) -> a -> b
$ FailError -> MError
forall a. a -> Maybe a
Just FailError
ferr
weaveJust (Right a :: a
a) = a -> Either MError a
forall a b. b -> Either a b
Right a
a
memberCycleLevel :: (MonadClient m, MonadClientUI m)
=> Bool -> Direction -> m MError
memberCycleLevel :: Bool -> Direction -> m MError
memberCycleLevel verbose :: Bool
verbose direction :: Direction
direction = do
FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
Faction
fact <- (State -> Faction) -> m Faction
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
side) (EnumMap FactionId Faction -> Faction)
-> (State -> EnumMap FactionId Faction) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap FactionId Faction
sfactionD
LevelId
lidV <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
viewedLevelUI
ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
Actor
body <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
leader
[(ActorId, Actor, ActorUI)]
hs <- ActorId -> m [(ActorId, Actor, ActorUI)]
forall (m :: * -> *).
MonadClientUI m =>
ActorId -> m [(ActorId, Actor, ActorUI)]
partyAfterLeader ActorId
leader
let (autoDun :: Bool
autoDun, _) = Faction -> (Bool, Bool)
autoDungeonLevel Faction
fact
let hsSort :: [(ActorId, Actor, ActorUI)]
hsSort = case Direction
direction of
Forward -> [(ActorId, Actor, ActorUI)]
hs
Backward -> [(ActorId, Actor, ActorUI)] -> [(ActorId, Actor, ActorUI)]
forall a. [a] -> [a]
reverse [(ActorId, Actor, ActorUI)]
hs
case ((ActorId, Actor, ActorUI) -> Bool)
-> [(ActorId, Actor, ActorUI)] -> [(ActorId, Actor, ActorUI)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(_, b :: Actor
b, _) -> Actor -> LevelId
blid Actor
b LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== LevelId
lidV) [(ActorId, Actor, ActorUI)]
hsSort of
_ | Bool
autoDun Bool -> Bool -> Bool
&& LevelId
lidV LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
/= Actor -> LevelId
blid Actor
body ->
Text -> m MError
forall (m :: * -> *). MonadClientUI m => Text -> m MError
failMsg (Text -> m MError) -> Text -> m MError
forall a b. (a -> b) -> a -> b
$ ReqFailure -> Text
showReqFailure ReqFailure
NoChangeDunLeader
[] -> Text -> m MError
forall (m :: * -> *). MonadClientUI m => Text -> m MError
failMsg "cannot pick any other member on this level"
(np :: ActorId
np, b :: Actor
b, _) : _ -> do
Bool
success <- Bool -> ActorId -> m Bool
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
Bool -> ActorId -> m Bool
pickLeader Bool
verbose ActorId
np
let !_A :: ()
_A = Bool -> () -> ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Bool
success Bool -> (String, (ActorId, ActorId, Actor)) -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` "same leader"
String
-> (ActorId, ActorId, Actor) -> (String, (ActorId, ActorId, Actor))
forall v. String -> v -> (String, v)
`swith` (ActorId
leader, ActorId
np, Actor
b)) ()
MError -> m MError
forall (m :: * -> *) a. Monad m => a -> m a
return MError
forall a. Maybe a
Nothing
memberCycle :: (MonadClient m, MonadClientUI m) => Bool -> Direction -> m MError
memberCycle :: Bool -> Direction -> m MError
memberCycle verbose :: Bool
verbose direction :: Direction
direction = do
FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
Faction
fact <- (State -> Faction) -> m Faction
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
side) (EnumMap FactionId Faction -> Faction)
-> (State -> EnumMap FactionId Faction) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap FactionId Faction
sfactionD
ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
[(ActorId, Actor, ActorUI)]
hs <- ActorId -> m [(ActorId, Actor, ActorUI)]
forall (m :: * -> *).
MonadClientUI m =>
ActorId -> m [(ActorId, Actor, ActorUI)]
partyAfterLeader ActorId
leader
let (autoDun :: Bool
autoDun, _) = Faction -> (Bool, Bool)
autoDungeonLevel Faction
fact
let hsSort :: [(ActorId, Actor, ActorUI)]
hsSort = case Direction
direction of
Forward -> [(ActorId, Actor, ActorUI)]
hs
Backward -> [(ActorId, Actor, ActorUI)] -> [(ActorId, Actor, ActorUI)]
forall a. [a] -> [a]
reverse [(ActorId, Actor, ActorUI)]
hs
case [(ActorId, Actor, ActorUI)]
hsSort of
_ | Bool
autoDun -> Text -> m MError
forall (m :: * -> *). MonadClientUI m => Text -> m MError
failMsg (Text -> m MError) -> Text -> m MError
forall a b. (a -> b) -> a -> b
$ ReqFailure -> Text
showReqFailure ReqFailure
NoChangeDunLeader
[] -> Text -> m MError
forall (m :: * -> *). MonadClientUI m => Text -> m MError
failMsg "no other member in the party"
(np :: ActorId
np, b :: Actor
b, _) : _ -> do
Bool
success <- Bool -> ActorId -> m Bool
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
Bool -> ActorId -> m Bool
pickLeader Bool
verbose ActorId
np
let !_A :: ()
_A = Bool -> () -> ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Bool
success Bool -> (String, (ActorId, ActorId, Actor)) -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` "same leader"
String
-> (ActorId, ActorId, Actor) -> (String, (ActorId, ActorId, Actor))
forall v. String -> v -> (String, v)
`swith` (ActorId
leader, ActorId
np, Actor
b)) ()
MError -> m MError
forall (m :: * -> *) a. Monad m => a -> m a
return MError
forall a. Maybe a
Nothing
partyAfterLeader :: MonadClientUI m => ActorId -> m [(ActorId, Actor, ActorUI)]
partyAfterLeader :: ActorId -> m [(ActorId, Actor, ActorUI)]
partyAfterLeader leader :: ActorId
leader = do
FactionId
side <- (State -> FactionId) -> m FactionId
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> FactionId) -> m FactionId)
-> (State -> FactionId) -> m FactionId
forall a b. (a -> b) -> a -> b
$ Actor -> FactionId
bfid (Actor -> FactionId) -> (State -> Actor) -> State -> FactionId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ActorId -> State -> Actor
getActorBody ActorId
leader
ActorDictUI
sactorUI <- (SessionUI -> ActorDictUI) -> m ActorDictUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> ActorDictUI
sactorUI
[(ActorId, Actor)]
allOurs <- (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)])
-> (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
forall a b. (a -> b) -> a -> b
$ FactionId -> State -> [(ActorId, Actor)]
fidActorNotProjGlobalAssocs FactionId
side
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 :: (MonadClient m, MonadClientUI m) => Bool -> ActorId -> m Bool
pickLeader :: Bool -> ActorId -> m Bool
pickLeader verbose :: Bool
verbose aid :: ActorId
aid = do
ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
if ActorId
leader ActorId -> ActorId -> Bool
forall a. Eq a => a -> a -> Bool
== ActorId
aid
then Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
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
$
MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
MsgPointmanSwap (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ [Part] -> Text
makeSentence [Part
subject, "picked as a pointman"]
ActorId -> m ()
forall (m :: * -> *). MonadClientUI m => ActorId -> m ()
updateClientLeader ActorId
aid
(SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess -> SessionUI
sess {saimMode :: Maybe AimMode
saimMode =
(\aimMode :: AimMode
aimMode -> AimMode
aimMode {aimLevelId :: LevelId
aimLevelId = Actor -> LevelId
blid Actor
body}) (AimMode -> AimMode) -> Maybe AimMode -> Maybe AimMode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SessionUI -> Maybe AimMode
saimMode SessionUI
sess}
(itemsBlurb :: Text
itemsBlurb, _) <- Bool
-> Point -> ActorId -> Maybe (Part, Bool) -> m (Text, Maybe Person)
forall (m :: * -> *).
MonadClientUI m =>
Bool
-> Point -> ActorId -> Maybe (Part, Bool) -> m (Text, Maybe Person)
lookAtItems Bool
True (Actor -> Point
bpos Actor
body) ActorId
aid Maybe (Part, Bool)
forall a. Maybe a
Nothing
Text
stashBlurb <- LevelId -> Point -> m Text
forall (m :: * -> *). MonadClientUI m => LevelId -> Point -> m Text
lookAtStash (Actor -> LevelId
blid Actor
body) (Actor -> Point
bpos Actor
body)
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
verbose (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
MsgAtFeetMinor (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
stashBlurb Text -> Text -> Text
<+> Text
itemsBlurb
Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
pickLeaderWithPointer :: (MonadClient m, MonadClientUI m) => m MError
pickLeaderWithPointer :: m MError
pickLeaderWithPointer = do
CCUI{coscreen :: CCUI -> ScreenContent
coscreen=ScreenContent{Int
rheight :: ScreenContent -> Int
rheight :: Int
rheight}} <- (SessionUI -> CCUI) -> m CCUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
LevelId
lidV <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
viewedLevelUI
FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
Faction
fact <- (State -> Faction) -> m Faction
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
side) (EnumMap FactionId Faction -> Faction)
-> (State -> EnumMap FactionId Faction) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap FactionId Faction
sfactionD
LevelId
arena <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
getArenaUI
ActorDictUI
sactorUI <- (SessionUI -> ActorDictUI) -> m ActorDictUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> ActorDictUI
sactorUI
[(ActorId, Actor)]
ours <- (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)])
-> (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
forall a b. (a -> b) -> a -> b
$ ((ActorId, Actor) -> Bool)
-> [(ActorId, Actor)] -> [(ActorId, Actor)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((ActorId, Actor) -> Bool) -> (ActorId, Actor) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Actor -> Bool
bproj (Actor -> Bool)
-> ((ActorId, Actor) -> Actor) -> (ActorId, Actor) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ActorId, Actor) -> Actor
forall a b. (a, b) -> b
snd)
([(ActorId, Actor)] -> [(ActorId, Actor)])
-> (State -> [(ActorId, Actor)]) -> State -> [(ActorId, Actor)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FactionId -> Bool) -> LevelId -> State -> [(ActorId, Actor)]
actorAssocs (FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side) LevelId
lidV
let oursUI :: [(ActorId, Actor, ActorUI)]
oursUI = ((ActorId, Actor) -> (ActorId, Actor, ActorUI))
-> [(ActorId, Actor)] -> [(ActorId, Actor, ActorUI)]
forall a b. (a -> b) -> [a] -> [b]
map (\(aid :: ActorId
aid, b :: Actor
b) -> (ActorId
aid, Actor
b, ActorDictUI
sactorUI ActorDictUI -> ActorId -> ActorUI
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ActorId
aid)) [(ActorId, Actor)]
ours
viewed :: [(ActorId, Actor, ActorUI)]
viewed = ((ActorId, Actor, ActorUI)
-> (Bool, Bool, Bool, Char, Color, ActorId))
-> [(ActorId, Actor, ActorUI)] -> [(ActorId, Actor, ActorUI)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (ActorId, Actor, ActorUI)
-> (Bool, Bool, Bool, Char, Color, ActorId)
keySelected [(ActorId, Actor, ActorUI)]
oursUI
(autoDun :: Bool
autoDun, _) = Faction -> (Bool, Bool)
autoDungeonLevel Faction
fact
pick :: (ActorId, Actor) -> m MError
pick (aid :: ActorId
aid, b :: Actor
b) =
if | Actor -> LevelId
blid Actor
b LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
/= LevelId
arena Bool -> Bool -> Bool
&& Bool
autoDun ->
Text -> m MError
forall (m :: * -> *). MonadClientUI m => Text -> m MError
failMsg (Text -> m MError) -> Text -> m MError
forall a b. (a -> b) -> a -> b
$ ReqFailure -> Text
showReqFailure ReqFailure
NoChangeDunLeader
| Bool
otherwise -> do
m Bool -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m Bool -> m ()) -> m Bool -> m ()
forall a b. (a -> b) -> a -> b
$ Bool -> ActorId -> m Bool
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
Bool -> ActorId -> m Bool
pickLeader Bool
True ActorId
aid
MError -> m MError
forall (m :: * -> *) a. Monad m => a -> m a
return MError
forall a. Maybe a
Nothing
PointUI
pUI <- (SessionUI -> PointUI) -> m PointUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> PointUI
spointer
let p :: Point
p@(Point px :: Int
px py :: Int
py) = PointSquare -> Point
squareToMap (PointSquare -> Point) -> PointSquare -> Point
forall a b. (a -> b) -> a -> b
$ PointUI -> PointSquare
uiToSquare PointUI
pUI
if | Int
py Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
rheight Int -> Int -> Int
forall a. Num a => a -> a -> a
- 2 Bool -> Bool -> Bool
&& Int
px Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 -> Bool -> Direction -> m MError
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
Bool -> Direction -> m MError
memberCycle Bool
True Direction
Forward
| Int
py Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
rheight Int -> Int -> Int
forall a. Num a => a -> a -> a
- 2 ->
case Int -> [(ActorId, Actor, ActorUI)] -> [(ActorId, Actor, ActorUI)]
forall a. Int -> [a] -> [a]
drop (Int
px Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) [(ActorId, Actor, ActorUI)]
viewed of
[] -> MError -> m MError
forall (m :: * -> *) a. Monad m => a -> m a
return MError
forall a. Maybe a
Nothing
(aid :: ActorId
aid, b :: Actor
b, _) : _ -> (ActorId, Actor) -> m MError
pick (ActorId
aid, Actor
b)
| Bool
otherwise ->
case ((ActorId, Actor, ActorUI) -> Bool)
-> [(ActorId, Actor, ActorUI)] -> Maybe (ActorId, Actor, ActorUI)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(_, b :: Actor
b, _) -> Actor -> Point
bpos Actor
b Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Point
p) [(ActorId, Actor, ActorUI)]
oursUI of
Nothing -> Text -> m MError
forall (m :: * -> *). MonadClientUI m => Text -> m MError
failMsg "not pointing at an actor"
Just (aid :: ActorId
aid, b :: Actor
b, _) -> (ActorId, Actor) -> m MError
pick (ActorId
aid, Actor
b)
itemOverlay :: MonadClientUI m
=> SingleItemSlots -> LevelId -> ItemBag -> Bool -> m OKX
itemOverlay :: SingleItemSlots -> LevelId -> ItemBag -> Bool -> m OKX
itemOverlay lSlots :: SingleItemSlots
lSlots lid :: LevelId
lid bag :: ItemBag
bag displayRanged :: Bool
displayRanged = do
CCUI{coscreen :: CCUI -> ScreenContent
coscreen=ScreenContent{Int
rwidth :: ScreenContent -> Int
rwidth :: Int
rwidth}} <- (SessionUI -> CCUI) -> m CCUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
Time
localTime <- (State -> Time) -> m Time
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Time) -> m Time) -> (State -> Time) -> m Time
forall a b. (a -> b) -> a -> b
$ LevelId -> State -> Time
getLocalTime LevelId
lid
ItemId -> ItemFull
itemToF <- (State -> ItemId -> ItemFull) -> m (ItemId -> ItemFull)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemId -> ItemFull) -> m (ItemId -> ItemFull))
-> (State -> ItemId -> ItemFull) -> m (ItemId -> ItemFull)
forall a b. (a -> b) -> a -> b
$ (ItemId -> State -> ItemFull) -> State -> ItemId -> ItemFull
forall a b c. (a -> b -> c) -> b -> a -> c
flip ItemId -> State -> ItemFull
itemToFull
FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
EnumMap FactionId Faction
factionD <- (State -> EnumMap FactionId Faction)
-> m (EnumMap FactionId Faction)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> EnumMap FactionId Faction
sfactionD
ItemBag
combGround <- (State -> ItemBag) -> m ItemBag
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemBag) -> m ItemBag)
-> (State -> ItemBag) -> m ItemBag
forall a b. (a -> b) -> a -> b
$ FactionId -> State -> ItemBag
combinedGround FactionId
side
ItemBag
combOrgan <- (State -> ItemBag) -> m ItemBag
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemBag) -> m ItemBag)
-> (State -> ItemBag) -> m ItemBag
forall a b. (a -> b) -> a -> b
$ FactionId -> State -> ItemBag
combinedOrgan FactionId
side
ItemBag
combEqp <- (State -> ItemBag) -> m ItemBag
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemBag) -> m ItemBag)
-> (State -> ItemBag) -> m ItemBag
forall a b. (a -> b) -> a -> b
$ FactionId -> State -> ItemBag
combinedEqp FactionId
side
ItemBag
stashBag <- (State -> ItemBag) -> m ItemBag
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemBag) -> m ItemBag)
-> (State -> ItemBag) -> m ItemBag
forall a b. (a -> b) -> a -> b
$ FactionId -> State -> ItemBag
getFactionStashBag FactionId
side
DiscoveryBenefit
discoBenefit <- (StateClient -> DiscoveryBenefit) -> m DiscoveryBenefit
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> DiscoveryBenefit
sdiscoBenefit
FontSetup{..} <- m FontSetup
forall (m :: * -> *). MonadClientUI m => m FontSetup
getFontSetup
let !_A :: ()
_A = Bool -> () -> ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert ((ItemId -> Bool) -> [ItemId] -> Bool
forall a. Show a => (a -> Bool) -> [a] -> Bool
allB (ItemId -> [ItemId] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` SingleItemSlots -> [ItemId]
forall k a. EnumMap k a -> [a]
EM.elems SingleItemSlots
lSlots) (ItemBag -> [ItemId]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys ItemBag
bag)
Bool -> (LevelId, ItemBag, SingleItemSlots) -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` (LevelId
lid, ItemBag
bag, SingleItemSlots
lSlots)) ()
markEqp :: ItemId -> Text -> Text
markEqp iid :: ItemId
iid t :: Text
t =
if | (ItemId
iid ItemId -> ItemBag -> Bool
forall k a. Enum k => k -> EnumMap k a -> Bool
`EM.member` ItemBag
combOrgan
Bool -> Bool -> Bool
|| ItemId
iid ItemId -> ItemBag -> Bool
forall k a. Enum k => k -> EnumMap k a -> Bool
`EM.member` ItemBag
combEqp)
Bool -> Bool -> Bool
&& ItemId
iid ItemId -> ItemBag -> Bool
forall k a. Enum k => k -> EnumMap k a -> Bool
`EM.notMember` ItemBag
stashBag
Bool -> Bool -> Bool
&& ItemId
iid ItemId -> ItemBag -> Bool
forall k a. Enum k => k -> EnumMap k a -> Bool
`EM.notMember` ItemBag
combGround -> Text -> Char -> Text
T.snoc (Text -> Text
T.init Text
t) ']'
| ItemId
iid ItemId -> ItemBag -> Bool
forall k a. Enum k => k -> EnumMap k a -> Bool
`EM.member` ItemBag
stashBag -> Text -> Char -> Text
T.snoc (Text -> Text
T.init Text
t) '}'
| Bool
otherwise -> Text
t
pr :: (SlotChar, ItemId)
-> Maybe
((AttrLine, (Int, AttrLine)),
(Either [KM] SlotChar, (PointUI, ButtonWidth)))
pr (l :: SlotChar
l, iid :: ItemId
iid) =
case ItemId -> ItemBag -> Maybe ItemQuant
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup ItemId
iid ItemBag
bag of
Nothing -> Maybe
((AttrLine, (Int, AttrLine)),
(Either [KM] SlotChar, (PointUI, ButtonWidth)))
forall a. Maybe a
Nothing
Just kit :: ItemQuant
kit@(k :: Int
k, _) ->
let itemFull :: ItemFull
itemFull = ItemId -> ItemFull
itemToF ItemId
iid
arItem :: AspectRecord
arItem = ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFull
colorSymbol :: AttrCharW32
colorSymbol =
if Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Condition AspectRecord
arItem
then let color :: Color
color = if Benefit -> Bool
benInEqp (DiscoveryBenefit
discoBenefit DiscoveryBenefit -> ItemId -> Benefit
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ItemId
iid)
then Color
Color.BrGreen
else Color
Color.BrRed
in Color -> Char -> AttrCharW32
Color.attrChar2ToW32 Color
color
(ItemKind -> Char
IK.isymbol (ItemKind -> Char) -> ItemKind -> Char
forall a b. (a -> b) -> a -> b
$ ItemFull -> ItemKind
itemKind ItemFull
itemFull)
else ItemFull -> AttrCharW32
viewItem ItemFull
itemFull
phrase :: Text
phrase = [Part] -> Text
makePhrase
[Int
-> FactionId
-> EnumMap FactionId Faction
-> Bool
-> DetailLevel
-> Int
-> Int
-> Time
-> ItemFull
-> ItemQuant
-> Part
partItemWsRanged Int
rwidth FactionId
side EnumMap FactionId Faction
factionD Bool
displayRanged
DetailLevel
DetailMedium 4 Int
k Time
localTime ItemFull
itemFull ItemQuant
kit]
al1 :: AttrLine
al1 = AttrString -> AttrLine
attrStringToAL
(AttrString -> AttrLine) -> AttrString -> AttrLine
forall a b. (a -> b) -> a -> b
$ Text -> AttrString
textToAS (ItemId -> Text -> Text
markEqp ItemId
iid (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ SlotChar -> Text
slotLabel SlotChar
l)
AttrString -> AttrString -> AttrString
forall a. [a] -> [a] -> [a]
++ [AttrCharW32
Color.spaceAttrW32 | DisplayFont -> Bool
isSquareFont DisplayFont
propFont]
AttrString -> AttrString -> AttrString
forall a. [a] -> [a] -> [a]
++ [AttrCharW32
colorSymbol]
xal2 :: (Int, AttrLine)
xal2 = ( DisplayFont -> AttrString -> Int
forall a. DisplayFont -> [a] -> Int
textSize DisplayFont
squareFont (AttrString -> Int) -> AttrString -> Int
forall a b. (a -> b) -> a -> b
$ AttrLine -> AttrString
attrLine AttrLine
al1
, AttrString -> AttrLine
attrStringToAL (AttrString -> AttrLine) -> AttrString -> AttrLine
forall a b. (a -> b) -> a -> b
$ AttrCharW32
Color.spaceAttrW32 AttrCharW32 -> AttrString -> AttrString
forall a. a -> [a] -> [a]
: Text -> AttrString
textToAS Text
phrase )
kx :: (Either [KM] SlotChar, (PointUI, ButtonWidth))
kx = (SlotChar -> Either [KM] SlotChar
forall a b. b -> Either a b
Right SlotChar
l, ( Int -> Int -> PointUI
PointUI 0 0
, DisplayFont -> Int -> ButtonWidth
ButtonWidth DisplayFont
propFont (5 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Text -> Int
T.length Text
phrase) ))
in ((AttrLine, (Int, AttrLine)),
(Either [KM] SlotChar, (PointUI, ButtonWidth)))
-> Maybe
((AttrLine, (Int, AttrLine)),
(Either [KM] SlotChar, (PointUI, ButtonWidth)))
forall a. a -> Maybe a
Just ((AttrLine
al1, (Int, AttrLine)
xal2), (Either [KM] SlotChar, (PointUI, ButtonWidth))
kx)
(ts :: [(AttrLine, (Int, AttrLine))]
ts, kxs :: [(Either [KM] SlotChar, (PointUI, ButtonWidth))]
kxs) = [((AttrLine, (Int, AttrLine)),
(Either [KM] SlotChar, (PointUI, ButtonWidth)))]
-> ([(AttrLine, (Int, AttrLine))],
[(Either [KM] SlotChar, (PointUI, ButtonWidth))])
forall a b. [(a, b)] -> ([a], [b])
unzip ([((AttrLine, (Int, AttrLine)),
(Either [KM] SlotChar, (PointUI, ButtonWidth)))]
-> ([(AttrLine, (Int, AttrLine))],
[(Either [KM] SlotChar, (PointUI, ButtonWidth))]))
-> [((AttrLine, (Int, AttrLine)),
(Either [KM] SlotChar, (PointUI, ButtonWidth)))]
-> ([(AttrLine, (Int, AttrLine))],
[(Either [KM] SlotChar, (PointUI, ButtonWidth))])
forall a b. (a -> b) -> a -> b
$ ((SlotChar, ItemId)
-> Maybe
((AttrLine, (Int, AttrLine)),
(Either [KM] SlotChar, (PointUI, ButtonWidth))))
-> [(SlotChar, ItemId)]
-> [((AttrLine, (Int, AttrLine)),
(Either [KM] SlotChar, (PointUI, ButtonWidth)))]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (SlotChar, ItemId)
-> Maybe
((AttrLine, (Int, AttrLine)),
(Either [KM] SlotChar, (PointUI, ButtonWidth)))
pr ([(SlotChar, ItemId)]
-> [((AttrLine, (Int, AttrLine)),
(Either [KM] SlotChar, (PointUI, ButtonWidth)))])
-> [(SlotChar, ItemId)]
-> [((AttrLine, (Int, AttrLine)),
(Either [KM] SlotChar, (PointUI, ButtonWidth)))]
forall a b. (a -> b) -> a -> b
$ SingleItemSlots -> [(SlotChar, ItemId)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs SingleItemSlots
lSlots
(tsLab :: [AttrLine]
tsLab, tsDesc :: [(Int, AttrLine)]
tsDesc) = [(AttrLine, (Int, AttrLine))] -> ([AttrLine], [(Int, AttrLine)])
forall a b. [(a, b)] -> ([a], [b])
unzip [(AttrLine, (Int, AttrLine))]
ts
ovsLab :: EnumMap DisplayFont Overlay
ovsLab = DisplayFont -> Overlay -> EnumMap DisplayFont Overlay
forall k a. Enum k => k -> a -> EnumMap k a
EM.singleton DisplayFont
squareFont (Overlay -> EnumMap DisplayFont Overlay)
-> Overlay -> EnumMap DisplayFont Overlay
forall a b. (a -> b) -> a -> b
$ [AttrLine] -> Overlay
offsetOverlay [AttrLine]
tsLab
ovsDesc :: EnumMap DisplayFont Overlay
ovsDesc = DisplayFont -> Overlay -> EnumMap DisplayFont Overlay
forall k a. Enum k => k -> a -> EnumMap k a
EM.singleton DisplayFont
propFont (Overlay -> EnumMap DisplayFont Overlay)
-> Overlay -> EnumMap DisplayFont Overlay
forall a b. (a -> b) -> a -> b
$ [(Int, AttrLine)] -> Overlay
offsetOverlayX [(Int, AttrLine)]
tsDesc
renumber :: Int -> (a, (PointUI, b)) -> (a, (PointUI, b))
renumber y :: Int
y (km :: a
km, (PointUI x :: Int
x _, len :: b
len)) = (a
km, (Int -> Int -> PointUI
PointUI Int
x Int
y, b
len))
OKX -> m OKX
forall (m :: * -> *) a. Monad m => a -> m a
return ((Overlay -> Overlay -> Overlay)
-> EnumMap DisplayFont Overlay
-> EnumMap DisplayFont Overlay
-> EnumMap DisplayFont Overlay
forall a k.
(a -> a -> a) -> EnumMap k a -> EnumMap k a -> EnumMap k a
EM.unionWith Overlay -> Overlay -> Overlay
forall a. [a] -> [a] -> [a]
(++) EnumMap DisplayFont Overlay
ovsLab EnumMap DisplayFont Overlay
ovsDesc, (Int
-> (Either [KM] SlotChar, (PointUI, ButtonWidth))
-> (Either [KM] SlotChar, (PointUI, ButtonWidth)))
-> [Int]
-> [(Either [KM] SlotChar, (PointUI, ButtonWidth))]
-> [(Either [KM] SlotChar, (PointUI, ButtonWidth))]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int
-> (Either [KM] SlotChar, (PointUI, ButtonWidth))
-> (Either [KM] SlotChar, (PointUI, ButtonWidth))
forall a b. Int -> (a, (PointUI, b)) -> (a, (PointUI, b))
renumber [0..] [(Either [KM] SlotChar, (PointUI, ButtonWidth))]
kxs )
skillsOverlay :: MonadClientUI m => ActorId -> m OKX
skillsOverlay :: ActorId -> m OKX
skillsOverlay aid :: ActorId
aid = do
Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
Skills
actorMaxSk <- (State -> Skills) -> m Skills
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Skills) -> m Skills) -> (State -> Skills) -> m Skills
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Skills
getActorMaxSkills ActorId
aid
FontSetup{..} <- m FontSetup
forall (m :: * -> *). MonadClientUI m => m FontSetup
getFontSetup
let prSlot :: (Int, SlotChar) -> Ability.Skill
-> ((AttrLine, (Int, AttrLine), (Int, AttrLine)), KYX)
prSlot :: (Int, SlotChar)
-> Skill
-> ((AttrLine, (Int, AttrLine), (Int, AttrLine)),
(Either [KM] SlotChar, (PointUI, ButtonWidth)))
prSlot (y :: Int
y, c :: SlotChar
c) skill :: Skill
skill =
let skName :: Text
skName = " " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Skill -> Text
skillName Skill
skill
slotLab :: Text
slotLab = SlotChar -> Text
slotLabel SlotChar
c
lab :: AttrLine
lab = Text -> AttrLine
textToAL Text
slotLab
labLen :: Int
labLen = DisplayFont -> AttrString -> Int
forall a. DisplayFont -> [a] -> Int
textSize DisplayFont
squareFont (AttrString -> Int) -> AttrString -> Int
forall a b. (a -> b) -> a -> b
$ AttrLine -> AttrString
attrLine AttrLine
lab
indentation :: Int
indentation = if DisplayFont -> Bool
isSquareFont DisplayFont
propFont then 42 else 20
valueText :: Text
valueText = Skill -> Actor -> Int -> Text
skillToDecorator Skill
skill Actor
b
(Int -> Text) -> Int -> Text
forall a b. (a -> b) -> a -> b
$ Skill -> Skills -> Int
Ability.getSk Skill
skill Skills
actorMaxSk
triple :: (AttrLine, (Int, AttrLine), (Int, AttrLine))
triple = ( AttrLine
lab
, (Int
labLen, Text -> AttrLine
textToAL Text
skName)
, (Int
labLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
indentation, Text -> AttrLine
textToAL Text
valueText) )
in ((AttrLine, (Int, AttrLine), (Int, AttrLine))
triple, (SlotChar -> Either [KM] SlotChar
forall a b. b -> Either a b
Right SlotChar
c, ( Int -> Int -> PointUI
PointUI 0 Int
y
, DisplayFont -> Int -> ButtonWidth
ButtonWidth DisplayFont
propFont (28 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Text -> Int
T.length Text
slotLab) )))
(ts :: [(AttrLine, (Int, AttrLine), (Int, AttrLine))]
ts, kxs :: [(Either [KM] SlotChar, (PointUI, ButtonWidth))]
kxs) = [((AttrLine, (Int, AttrLine), (Int, AttrLine)),
(Either [KM] SlotChar, (PointUI, ButtonWidth)))]
-> ([(AttrLine, (Int, AttrLine), (Int, AttrLine))],
[(Either [KM] SlotChar, (PointUI, ButtonWidth))])
forall a b. [(a, b)] -> ([a], [b])
unzip ([((AttrLine, (Int, AttrLine), (Int, AttrLine)),
(Either [KM] SlotChar, (PointUI, ButtonWidth)))]
-> ([(AttrLine, (Int, AttrLine), (Int, AttrLine))],
[(Either [KM] SlotChar, (PointUI, ButtonWidth))]))
-> [((AttrLine, (Int, AttrLine), (Int, AttrLine)),
(Either [KM] SlotChar, (PointUI, ButtonWidth)))]
-> ([(AttrLine, (Int, AttrLine), (Int, AttrLine))],
[(Either [KM] SlotChar, (PointUI, ButtonWidth))])
forall a b. (a -> b) -> a -> b
$ ((Int, SlotChar)
-> Skill
-> ((AttrLine, (Int, AttrLine), (Int, AttrLine)),
(Either [KM] SlotChar, (PointUI, ButtonWidth))))
-> [(Int, SlotChar)]
-> [Skill]
-> [((AttrLine, (Int, AttrLine), (Int, AttrLine)),
(Either [KM] SlotChar, (PointUI, ButtonWidth)))]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Int, SlotChar)
-> Skill
-> ((AttrLine, (Int, AttrLine), (Int, AttrLine)),
(Either [KM] SlotChar, (PointUI, ButtonWidth)))
prSlot ([Int] -> [SlotChar] -> [(Int, SlotChar)]
forall a b. [a] -> [b] -> [(a, b)]
zip [0..] [SlotChar]
allSlots) [Skill]
skillSlots
(skLab :: [AttrLine]
skLab, skDescr :: [(Int, AttrLine)]
skDescr, skValue :: [(Int, AttrLine)]
skValue) = [(AttrLine, (Int, AttrLine), (Int, AttrLine))]
-> ([AttrLine], [(Int, AttrLine)], [(Int, AttrLine)])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 [(AttrLine, (Int, AttrLine), (Int, AttrLine))]
ts
skillLab :: EnumMap DisplayFont Overlay
skillLab = DisplayFont -> Overlay -> EnumMap DisplayFont Overlay
forall k a. Enum k => k -> a -> EnumMap k a
EM.singleton DisplayFont
squareFont (Overlay -> EnumMap DisplayFont Overlay)
-> Overlay -> EnumMap DisplayFont Overlay
forall a b. (a -> b) -> a -> b
$ [AttrLine] -> Overlay
offsetOverlay [AttrLine]
skLab
skillDescr :: EnumMap DisplayFont Overlay
skillDescr = DisplayFont -> Overlay -> EnumMap DisplayFont Overlay
forall k a. Enum k => k -> a -> EnumMap k a
EM.singleton DisplayFont
propFont (Overlay -> EnumMap DisplayFont Overlay)
-> Overlay -> EnumMap DisplayFont Overlay
forall a b. (a -> b) -> a -> b
$ [(Int, AttrLine)] -> Overlay
offsetOverlayX [(Int, AttrLine)]
skDescr
skillValue :: EnumMap DisplayFont Overlay
skillValue = DisplayFont -> Overlay -> EnumMap DisplayFont Overlay
forall k a. Enum k => k -> a -> EnumMap k a
EM.singleton DisplayFont
monoFont (Overlay -> EnumMap DisplayFont Overlay)
-> Overlay -> EnumMap DisplayFont Overlay
forall a b. (a -> b) -> a -> b
$ [(Int, AttrLine)] -> Overlay
offsetOverlayX [(Int, AttrLine)]
skValue
OKX -> m OKX
forall (m :: * -> *) a. Monad m => a -> m a
return ((Overlay -> Overlay -> Overlay)
-> [EnumMap DisplayFont Overlay] -> EnumMap DisplayFont Overlay
forall a k. (a -> a -> a) -> [EnumMap k a] -> EnumMap k a
EM.unionsWith Overlay -> Overlay -> Overlay
forall a. [a] -> [a] -> [a]
(++) [EnumMap DisplayFont Overlay
skillLab, EnumMap DisplayFont Overlay
skillDescr, EnumMap DisplayFont Overlay
skillValue], [(Either [KM] SlotChar, (PointUI, ButtonWidth))]
kxs)
placesFromState :: ContentData PK.PlaceKind -> ClientOptions -> State
-> EM.EnumMap (ContentId PK.PlaceKind)
(ES.EnumSet LevelId, Int, Int, Int)
placesFromState :: ContentData PlaceKind
-> ClientOptions
-> State
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
placesFromState coplace :: ContentData PlaceKind
coplace ClientOptions{Bool
sexposePlaces :: ClientOptions -> Bool
sexposePlaces :: Bool
sexposePlaces} s :: State
s =
let addEntries :: (EnumSet k, b, c, d)
-> (EnumSet k, b, c, d) -> (EnumSet k, b, c, d)
addEntries (!EnumSet k
es1, !b
ne1, !c
na1, !d
nd1) (!EnumSet k
es2, !b
ne2, !c
na2, !d
nd2) =
let !es :: EnumSet k
es = EnumSet k -> EnumSet k -> EnumSet k
forall k. EnumSet k -> EnumSet k -> EnumSet k
ES.union EnumSet k
es1 EnumSet k
es2
!ne :: b
ne = b
ne1 b -> b -> b
forall a. Num a => a -> a -> a
+ b
ne2
!na :: c
na = c
na1 c -> c -> c
forall a. Num a => a -> a -> a
+ c
na2
!nd :: d
nd = d
nd1 d -> d -> d
forall a. Num a => a -> a -> a
+ d
nd2
in (EnumSet k
es, b
ne, c
na, d
nd)
placesFromLevel :: (LevelId, Level)
-> EM.EnumMap (ContentId PK.PlaceKind)
(ES.EnumSet LevelId, Int, Int, Int)
placesFromLevel :: (LevelId, Level)
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
placesFromLevel (!LevelId
lid, Level{EntryMap
lentry :: Level -> EntryMap
lentry :: EntryMap
lentry}) =
let f :: PlaceEntry
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
f (PK.PEntry pk :: ContentId PlaceKind
pk) em :: EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
em =
((EnumSet LevelId, Int, Int, Int)
-> (EnumSet LevelId, Int, Int, Int)
-> (EnumSet LevelId, Int, Int, Int))
-> ContentId PlaceKind
-> (EnumSet LevelId, Int, Int, Int)
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
forall k a.
Enum k =>
(a -> a -> a) -> k -> a -> EnumMap k a -> EnumMap k a
EM.insertWith (EnumSet LevelId, Int, Int, Int)
-> (EnumSet LevelId, Int, Int, Int)
-> (EnumSet LevelId, Int, Int, Int)
forall d c b k.
(Num d, Num c, Num b) =>
(EnumSet k, b, c, d)
-> (EnumSet k, b, c, d) -> (EnumSet k, b, c, d)
addEntries ContentId PlaceKind
pk (LevelId -> EnumSet LevelId
forall k. Enum k => k -> EnumSet k
ES.singleton LevelId
lid, 1, 0, 0) EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
em
f (PK.PAround pk :: ContentId PlaceKind
pk) em :: EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
em =
((EnumSet LevelId, Int, Int, Int)
-> (EnumSet LevelId, Int, Int, Int)
-> (EnumSet LevelId, Int, Int, Int))
-> ContentId PlaceKind
-> (EnumSet LevelId, Int, Int, Int)
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
forall k a.
Enum k =>
(a -> a -> a) -> k -> a -> EnumMap k a -> EnumMap k a
EM.insertWith (EnumSet LevelId, Int, Int, Int)
-> (EnumSet LevelId, Int, Int, Int)
-> (EnumSet LevelId, Int, Int, Int)
forall d c b k.
(Num d, Num c, Num b) =>
(EnumSet k, b, c, d)
-> (EnumSet k, b, c, d) -> (EnumSet k, b, c, d)
addEntries ContentId PlaceKind
pk (LevelId -> EnumSet LevelId
forall k. Enum k => k -> EnumSet k
ES.singleton LevelId
lid, 0, 1, 0) EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
em
f (PK.PExists pk :: ContentId PlaceKind
pk) em :: EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
em =
((EnumSet LevelId, Int, Int, Int)
-> (EnumSet LevelId, Int, Int, Int)
-> (EnumSet LevelId, Int, Int, Int))
-> ContentId PlaceKind
-> (EnumSet LevelId, Int, Int, Int)
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
forall k a.
Enum k =>
(a -> a -> a) -> k -> a -> EnumMap k a -> EnumMap k a
EM.insertWith (EnumSet LevelId, Int, Int, Int)
-> (EnumSet LevelId, Int, Int, Int)
-> (EnumSet LevelId, Int, Int, Int)
forall d c b k.
(Num d, Num c, Num b) =>
(EnumSet k, b, c, d)
-> (EnumSet k, b, c, d) -> (EnumSet k, b, c, d)
addEntries ContentId PlaceKind
pk (LevelId -> EnumSet LevelId
forall k. Enum k => k -> EnumSet k
ES.singleton LevelId
lid, 0, 0, 1) EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
em
in (PlaceEntry
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int))
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
-> EntryMap
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
forall a b k. (a -> b -> b) -> b -> EnumMap k a -> b
EM.foldr' PlaceEntry
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
f EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
forall k a. EnumMap k a
EM.empty EntryMap
lentry
insertZeros :: EnumMap k (EnumSet k, b, c, d)
-> k -> p -> EnumMap k (EnumSet k, b, c, d)
insertZeros !EnumMap k (EnumSet k, b, c, d)
em !k
pk _ = k
-> (EnumSet k, b, c, d)
-> EnumMap k (EnumSet k, b, c, d)
-> EnumMap k (EnumSet k, b, c, d)
forall k a. Enum k => k -> a -> EnumMap k a -> EnumMap k a
EM.insert k
pk (EnumSet k
forall k. EnumSet k
ES.empty, 0, 0, 0) EnumMap k (EnumSet k, b, c, d)
em
initialPlaces :: EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
initialPlaces | Bool -> Bool
not Bool
sexposePlaces = EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
forall k a. EnumMap k a
EM.empty
| Bool
otherwise = ContentData PlaceKind
-> (EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
-> ContentId PlaceKind
-> PlaceKind
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int))
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
forall a b. ContentData a -> (b -> ContentId a -> a -> b) -> b -> b
ofoldlWithKey' ContentData PlaceKind
coplace EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
-> ContentId PlaceKind
-> PlaceKind
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
forall k b c d k p.
(Enum k, Num b, Num c, Num d) =>
EnumMap k (EnumSet k, b, c, d)
-> k -> p -> EnumMap k (EnumSet k, b, c, d)
insertZeros EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
forall k a. EnumMap k a
EM.empty
in ((EnumSet LevelId, Int, Int, Int)
-> (EnumSet LevelId, Int, Int, Int)
-> (EnumSet LevelId, Int, Int, Int))
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
forall a k.
(a -> a -> a) -> EnumMap k a -> EnumMap k a -> EnumMap k a
EM.unionWith (EnumSet LevelId, Int, Int, Int)
-> (EnumSet LevelId, Int, Int, Int)
-> (EnumSet LevelId, Int, Int, Int)
forall d c b k.
(Num d, Num c, Num b) =>
(EnumSet k, b, c, d)
-> (EnumSet k, b, c, d) -> (EnumSet k, b, c, d)
addEntries
EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
initialPlaces
(((EnumSet LevelId, Int, Int, Int)
-> (EnumSet LevelId, Int, Int, Int)
-> (EnumSet LevelId, Int, Int, Int))
-> [EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)]
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
forall a k. (a -> a -> a) -> [EnumMap k a] -> EnumMap k a
EM.unionsWith (EnumSet LevelId, Int, Int, Int)
-> (EnumSet LevelId, Int, Int, Int)
-> (EnumSet LevelId, Int, Int, Int)
forall d c b k.
(Num d, Num c, Num b) =>
(EnumSet k, b, c, d)
-> (EnumSet k, b, c, d) -> (EnumSet k, b, c, d)
addEntries ([EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)]
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int))
-> [EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)]
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
forall a b. (a -> b) -> a -> b
$ ((LevelId, Level)
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int))
-> [(LevelId, Level)]
-> [EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (LevelId, Level)
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
placesFromLevel ([(LevelId, Level)]
-> [EnumMap
(ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)])
-> [(LevelId, Level)]
-> [EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)]
forall a b. (a -> b) -> a -> b
$ EnumMap LevelId Level -> [(LevelId, Level)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs (EnumMap LevelId Level -> [(LevelId, Level)])
-> EnumMap LevelId Level -> [(LevelId, Level)]
forall a b. (a -> b) -> a -> b
$ State -> EnumMap LevelId Level
sdungeon State
s)
placesOverlay :: MonadClientUI m => m OKX
placesOverlay :: m OKX
placesOverlay = do
COps{ContentData PlaceKind
coplace :: COps -> ContentData PlaceKind
coplace :: ContentData PlaceKind
coplace} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
ClientOptions
soptions <- (StateClient -> ClientOptions) -> m ClientOptions
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> ClientOptions
soptions
FontSetup{..} <- m FontSetup
forall (m :: * -> *). MonadClientUI m => m FontSetup
getFontSetup
EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
places <- (State
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int))
-> m (EnumMap
(ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int))
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int))
-> m (EnumMap
(ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)))
-> (State
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int))
-> m (EnumMap
(ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int))
forall a b. (a -> b) -> a -> b
$ ContentData PlaceKind
-> ClientOptions
-> State
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
placesFromState ContentData PlaceKind
coplace ClientOptions
soptions
let prSlot :: (Int, SlotChar)
-> (ContentId PK.PlaceKind, (ES.EnumSet LevelId, Int, Int, Int))
-> (AttrLine, (Int, AttrLine), KYX)
prSlot :: (Int, SlotChar)
-> (ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))
-> (AttrLine, (Int, AttrLine),
(Either [KM] SlotChar, (PointUI, ButtonWidth)))
prSlot (y :: Int
y, c :: SlotChar
c) (pk :: ContentId PlaceKind
pk, (es :: EnumSet LevelId
es, _, _, _)) =
let placeName :: Text
placeName = PlaceKind -> Text
PK.pname (PlaceKind -> Text) -> PlaceKind -> Text
forall a b. (a -> b) -> a -> b
$ ContentData PlaceKind -> ContentId PlaceKind -> PlaceKind
forall a. ContentData a -> ContentId a -> a
okind ContentData PlaceKind
coplace ContentId PlaceKind
pk
markPlace :: Text -> Text
markPlace t :: Text
t = if EnumSet LevelId -> Bool
forall k. EnumSet k -> Bool
ES.null EnumSet LevelId
es
then Text -> Char -> Text
T.snoc (Text -> Text
T.init Text
t) '>'
else Text
t
!tSlot :: Text
tSlot = Text -> Text
markPlace (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ SlotChar -> Text
slotLabel SlotChar
c
!lenSlot :: Int
lenSlot = 2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Text -> Int
T.length Text
tSlot
!tBlurb :: Text
tBlurb = " "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
placeName
Text -> Text -> Text
<+> if EnumSet LevelId -> Bool
forall k. EnumSet k -> Bool
ES.null EnumSet LevelId
es
then ""
else "("
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Part] -> Text
makePhrase [Int -> Part -> Part
MU.CarWs (EnumSet LevelId -> Int
forall k. EnumSet k -> Int
ES.size EnumSet LevelId
es) "level"]
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ")"
!lenButton :: Int
lenButton = Int
lenSlot Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Text -> Int
T.length Text
tBlurb
!pButton :: PointUI
pButton = Int -> Int -> PointUI
PointUI 0 Int
y
!widthButton :: ButtonWidth
widthButton = DisplayFont -> Int -> ButtonWidth
ButtonWidth DisplayFont
propFont Int
lenButton
in ( Text -> AttrLine
textToAL Text
tSlot
, (Int
lenSlot, Text -> AttrLine
textToAL Text
tBlurb)
, (SlotChar -> Either [KM] SlotChar
forall a b. b -> Either a b
Right SlotChar
c, (PointUI
pButton, ButtonWidth
widthButton)) )
(plLab :: [AttrLine]
plLab, plDesc :: [(Int, AttrLine)]
plDesc, kxs :: [(Either [KM] SlotChar, (PointUI, ButtonWidth))]
kxs) = [(AttrLine, (Int, AttrLine),
(Either [KM] SlotChar, (PointUI, ButtonWidth)))]
-> ([AttrLine], [(Int, AttrLine)],
[(Either [KM] SlotChar, (PointUI, ButtonWidth))])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 ([(AttrLine, (Int, AttrLine),
(Either [KM] SlotChar, (PointUI, ButtonWidth)))]
-> ([AttrLine], [(Int, AttrLine)],
[(Either [KM] SlotChar, (PointUI, ButtonWidth))]))
-> [(AttrLine, (Int, AttrLine),
(Either [KM] SlotChar, (PointUI, ButtonWidth)))]
-> ([AttrLine], [(Int, AttrLine)],
[(Either [KM] SlotChar, (PointUI, ButtonWidth))])
forall a b. (a -> b) -> a -> b
$ ((Int, SlotChar)
-> (ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))
-> (AttrLine, (Int, AttrLine),
(Either [KM] SlotChar, (PointUI, ButtonWidth))))
-> [(Int, SlotChar)]
-> [(ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))]
-> [(AttrLine, (Int, AttrLine),
(Either [KM] SlotChar, (PointUI, ButtonWidth)))]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Int, SlotChar)
-> (ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))
-> (AttrLine, (Int, AttrLine),
(Either [KM] SlotChar, (PointUI, ButtonWidth)))
prSlot ([Int] -> [SlotChar] -> [(Int, SlotChar)]
forall a b. [a] -> [b] -> [(a, b)]
zip [0..] [SlotChar]
allSlots)
([(ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))]
-> [(AttrLine, (Int, AttrLine),
(Either [KM] SlotChar, (PointUI, ButtonWidth)))])
-> [(ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))]
-> [(AttrLine, (Int, AttrLine),
(Either [KM] SlotChar, (PointUI, ButtonWidth)))]
forall a b. (a -> b) -> a -> b
$ EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
-> [(ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
places
placeLab :: EnumMap DisplayFont Overlay
placeLab = DisplayFont -> Overlay -> EnumMap DisplayFont Overlay
forall k a. Enum k => k -> a -> EnumMap k a
EM.singleton DisplayFont
squareFont (Overlay -> EnumMap DisplayFont Overlay)
-> Overlay -> EnumMap DisplayFont Overlay
forall a b. (a -> b) -> a -> b
$ [AttrLine] -> Overlay
offsetOverlay [AttrLine]
plLab
placeDesc :: EnumMap DisplayFont Overlay
placeDesc = DisplayFont -> Overlay -> EnumMap DisplayFont Overlay
forall k a. Enum k => k -> a -> EnumMap k a
EM.singleton DisplayFont
propFont (Overlay -> EnumMap DisplayFont Overlay)
-> Overlay -> EnumMap DisplayFont Overlay
forall a b. (a -> b) -> a -> b
$ [(Int, AttrLine)] -> Overlay
offsetOverlayX [(Int, AttrLine)]
plDesc
OKX -> m OKX
forall (m :: * -> *) a. Monad m => a -> m a
return ((Overlay -> Overlay -> Overlay)
-> EnumMap DisplayFont Overlay
-> EnumMap DisplayFont Overlay
-> EnumMap DisplayFont Overlay
forall a k.
(a -> a -> a) -> EnumMap k a -> EnumMap k a -> EnumMap k a
EM.unionWith Overlay -> Overlay -> Overlay
forall a. [a] -> [a] -> [a]
(++) EnumMap DisplayFont Overlay
placeLab EnumMap DisplayFont Overlay
placeDesc, [(Either [KM] SlotChar, (PointUI, ButtonWidth))]
kxs)
describeMode :: MonadClientUI m
=> Bool -> ContentId MK.ModeKind
-> m (EM.EnumMap DisplayFont Overlay)
describeMode :: Bool -> ContentId ModeKind -> m (EnumMap DisplayFont Overlay)
describeMode addTitle :: Bool
addTitle gameModeId :: ContentId ModeKind
gameModeId = do
COps{ContentData ModeKind
comode :: COps -> ContentData ModeKind
comode :: ContentData ModeKind
comode} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
CCUI{coscreen :: CCUI -> ScreenContent
coscreen=ScreenContent{Int
rwidth :: Int
rwidth :: ScreenContent -> Int
rwidth}}
<- (SessionUI -> CCUI) -> m CCUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
FontSetup{..} <- m FontSetup
forall (m :: * -> *). MonadClientUI m => m FontSetup
getFontSetup
ScoreDict
scoreDict <- (State -> ScoreDict) -> m ScoreDict
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> ScoreDict
shigh
EnumSet (ContentId ModeKind)
scampings <- (StateClient -> EnumSet (ContentId ModeKind))
-> m (EnumSet (ContentId ModeKind))
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> EnumSet (ContentId ModeKind)
scampings
EnumSet (ContentId ModeKind)
srestarts <- (StateClient -> EnumSet (ContentId ModeKind))
-> m (EnumSet (ContentId ModeKind))
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> EnumSet (ContentId ModeKind)
srestarts
let gameMode :: ModeKind
gameMode = ContentData ModeKind -> ContentId ModeKind -> ModeKind
forall a. ContentData a -> ContentId a -> a
okind ContentData ModeKind
comode ContentId ModeKind
gameModeId
duplicateEOL :: Char -> Text
duplicateEOL '\n' = "\n\n"
duplicateEOL c :: Char
c = Char -> Text
T.singleton Char
c
sections :: [(AttrString, Text)]
sections =
[ ( Color -> Text -> AttrString
textFgToAS Color
Color.BrGreen "The story so far:"
, (Char -> Text) -> Text -> Text
T.concatMap Char -> Text
duplicateEOL (ModeKind -> Text
MK.mdesc ModeKind
gameMode) )
, ( Color -> Text -> AttrString
textFgToAS Color
Color.cMeta "Rules of the game:"
, ModeKind -> Text
MK.mrules ModeKind
gameMode )
, ( Color -> Text -> AttrString
textFgToAS Color
Color.BrCyan "Running commentary:"
, (Char -> Text) -> Text -> Text
T.concatMap Char -> Text
duplicateEOL (ModeKind -> Text
MK.mreason ModeKind
gameMode) )
, ( Color -> Text -> AttrString
textFgToAS Color
Color.cGreed "Hints, not needed unless stuck:"
, (Char -> Text) -> Text -> Text
T.concatMap Char -> Text
duplicateEOL (ModeKind -> Text
MK.mhint ModeKind
gameMode) )
]
renderSection :: (AttrString, Text) -> Maybe [(DisplayFont, AttrString)]
renderSection :: (AttrString, Text) -> Maybe [(DisplayFont, AttrString)]
renderSection (header :: AttrString
header, desc :: Text
desc) =
if Text -> Bool
T.null Text
desc
then Maybe [(DisplayFont, AttrString)]
forall a. Maybe a
Nothing
else [(DisplayFont, AttrString)] -> Maybe [(DisplayFont, AttrString)]
forall a. a -> Maybe a
Just [(DisplayFont
monoFont, AttrString
header), (DisplayFont
propFont, Text -> AttrString
textToAS Text
desc)]
title :: Text
title = if Bool
addTitle
then "\nYou are surviving the '"
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ModeKind -> Text
MK.mname ModeKind
gameMode
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "' adventure.\n"
else ""
blurb :: [(DisplayFont, [AttrLine])]
blurb = ((DisplayFont, AttrString) -> (DisplayFont, [AttrLine]))
-> [(DisplayFont, AttrString)] -> [(DisplayFont, [AttrLine])]
forall a b. (a -> b) -> [a] -> [b]
map ((AttrString -> [AttrLine])
-> (DisplayFont, AttrString) -> (DisplayFont, [AttrLine])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((AttrString -> [AttrLine])
-> (DisplayFont, AttrString) -> (DisplayFont, [AttrLine]))
-> (AttrString -> [AttrLine])
-> (DisplayFont, AttrString)
-> (DisplayFont, [AttrLine])
forall a b. (a -> b) -> a -> b
$ Int -> Int -> AttrString -> [AttrLine]
splitAttrString (Int
rwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- 2) (Int
rwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- 2)) ([(DisplayFont, AttrString)] -> [(DisplayFont, [AttrLine])])
-> [(DisplayFont, AttrString)] -> [(DisplayFont, [AttrLine])]
forall a b. (a -> b) -> a -> b
$
(DisplayFont
propFont, Text -> AttrString
textToAS (Text
title Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\n"))
(DisplayFont, AttrString)
-> [(DisplayFont, AttrString)] -> [(DisplayFont, AttrString)]
forall a. a -> [a] -> [a]
: [[(DisplayFont, AttrString)]] -> [(DisplayFont, AttrString)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([(DisplayFont, AttrString)]
-> [[(DisplayFont, AttrString)]] -> [[(DisplayFont, AttrString)]]
forall a. a -> [a] -> [a]
intersperse [(DisplayFont
monoFont, Text -> AttrString
textToAS "\n")]
(((AttrString, Text) -> Maybe [(DisplayFont, AttrString)])
-> [(AttrString, Text)] -> [[(DisplayFont, AttrString)]]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (AttrString, Text) -> Maybe [(DisplayFont, AttrString)]
renderSection [(AttrString, Text)]
sections))
blurbEnd :: [(DisplayFont, [AttrLine])]
blurbEnd = ((DisplayFont, AttrString) -> (DisplayFont, [AttrLine]))
-> [(DisplayFont, AttrString)] -> [(DisplayFont, [AttrLine])]
forall a b. (a -> b) -> [a] -> [b]
map ((AttrString -> [AttrLine])
-> (DisplayFont, AttrString) -> (DisplayFont, [AttrLine])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((AttrString -> [AttrLine])
-> (DisplayFont, AttrString) -> (DisplayFont, [AttrLine]))
-> (AttrString -> [AttrLine])
-> (DisplayFont, AttrString)
-> (DisplayFont, [AttrLine])
forall a b. (a -> b) -> a -> b
$ Int -> Int -> AttrString -> [AttrLine]
splitAttrString (Int
rwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- 2) (Int
rwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- 2)) ([(DisplayFont, AttrString)] -> [(DisplayFont, [AttrLine])])
-> [(DisplayFont, AttrString)] -> [(DisplayFont, [AttrLine])]
forall a b. (a -> b) -> a -> b
$
( DisplayFont
propFont
, Color -> Text -> AttrString
textFgToAS Color
Color.Brown
"\nThis adventure's endings experienced so far:\n\n" )
(DisplayFont, AttrString)
-> [(DisplayFont, AttrString)] -> [(DisplayFont, AttrString)]
forall a. a -> [a] -> [a]
: if [(DisplayFont, AttrString)] -> Bool
forall a. [a] -> Bool
null [(DisplayFont, AttrString)]
sectionsEndAS
then [(DisplayFont
monoFont, Text -> AttrString
textToAS "*none*")]
else [(DisplayFont, AttrString)]
sectionsEndAS
sectionsEndAS :: [(DisplayFont, AttrString)]
sectionsEndAS = [[(DisplayFont, AttrString)]] -> [(DisplayFont, AttrString)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([(DisplayFont, AttrString)]
-> [[(DisplayFont, AttrString)]] -> [[(DisplayFont, AttrString)]]
forall a. a -> [a] -> [a]
intersperse [(DisplayFont
monoFont, Text -> AttrString
textToAS "\n")]
(((AttrString, Text) -> Maybe [(DisplayFont, AttrString)])
-> [(AttrString, Text)] -> [[(DisplayFont, AttrString)]]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (AttrString, Text) -> Maybe [(DisplayFont, AttrString)]
renderSection [(AttrString, Text)]
sectionsEnd))
sectionsEnd :: [(AttrString, Text)]
sectionsEnd = (Outcome -> (AttrString, Text))
-> [Outcome] -> [(AttrString, Text)]
forall a b. (a -> b) -> [a] -> [b]
map Outcome -> (AttrString, Text)
outcomeSection [Outcome
forall a. Bounded a => a
minBound..Outcome
forall a. Bounded a => a
maxBound]
outcomeSection :: MK.Outcome -> (AttrString, Text)
outcomeSection :: Outcome -> (AttrString, Text)
outcomeSection outcome :: Outcome
outcome =
( Outcome -> AttrString
renderOutcome Outcome
outcome
, if Bool -> Bool
not (Outcome -> Bool
outcomeSeen Outcome
outcome)
then ""
else (Char -> Text) -> Text -> Text
T.concatMap Char -> Text
duplicateEOL
(Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe "" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Outcome -> [(Outcome, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Outcome
outcome
([(Outcome, Text)] -> Maybe Text)
-> [(Outcome, Text)] -> Maybe Text
forall a b. (a -> b) -> a -> b
$ ModeKind -> [(Outcome, Text)]
MK.mendMsg ModeKind
gameMode [(Outcome, Text)] -> [(Outcome, Text)] -> [(Outcome, Text)]
forall a. [a] -> [a] -> [a]
++ [(Outcome, Text)]
endMsgDefault
)
endMsgDefault :: [(Outcome, Text)]
endMsgDefault =
[ (Outcome
MK.Restart, "No shame there is in noble defeat and there is honour in perseverance. Sometimes there are ways and places to turn rout into victory.")
, (Outcome
MK.Camping, "Don't fear to take breaks. While you move, others move, even on distant floors, but while you stay still, the world stays still.")
]
scoreRecords :: [ScoreRecord]
scoreRecords = [ScoreRecord]
-> (ScoreTable -> [ScoreRecord])
-> Maybe ScoreTable
-> [ScoreRecord]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ScoreTable -> [ScoreRecord]
HighScore.unTable (Maybe ScoreTable -> [ScoreRecord])
-> Maybe ScoreTable -> [ScoreRecord]
forall a b. (a -> b) -> a -> b
$ ContentId ModeKind -> ScoreDict -> Maybe ScoreTable
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup ContentId ModeKind
gameModeId ScoreDict
scoreDict
outcomeSeen :: MK.Outcome -> Bool
outcomeSeen :: Outcome -> Bool
outcomeSeen outcome :: Outcome
outcome = case Outcome
outcome of
MK.Camping -> ContentId ModeKind
gameModeId ContentId ModeKind -> EnumSet (ContentId ModeKind) -> Bool
forall k. Enum k => k -> EnumSet k -> Bool
`ES.member` EnumSet (ContentId ModeKind)
scampings
MK.Restart -> ContentId ModeKind
gameModeId ContentId ModeKind -> EnumSet (ContentId ModeKind) -> Bool
forall k. Enum k => k -> EnumSet k -> Bool
`ES.member` EnumSet (ContentId ModeKind)
srestarts
_ -> Outcome
outcome Outcome -> [Outcome] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (ScoreRecord -> Outcome) -> [ScoreRecord] -> [Outcome]
forall a b. (a -> b) -> [a] -> [b]
map (Status -> Outcome
stOutcome (Status -> Outcome)
-> (ScoreRecord -> Status) -> ScoreRecord -> Outcome
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScoreRecord -> Status
HighScore.getStatus) [ScoreRecord]
scoreRecords
lastOutcome :: MK.Outcome
lastOutcome :: Outcome
lastOutcome = if [ScoreRecord] -> Bool
forall a. [a] -> Bool
null [ScoreRecord]
scoreRecords
then Outcome
MK.Restart
else Status -> Outcome
stOutcome (Status -> Outcome)
-> (ScoreRecord -> Status) -> ScoreRecord -> Outcome
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScoreRecord -> Status
HighScore.getStatus
(ScoreRecord -> Outcome) -> ScoreRecord -> Outcome
forall a b. (a -> b) -> a -> b
$ (ScoreRecord -> ScoreRecord -> Ordering)
-> [ScoreRecord] -> ScoreRecord
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy ((ScoreRecord -> POSIXTime)
-> ScoreRecord -> ScoreRecord -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing ScoreRecord -> POSIXTime
HighScore.getDate) [ScoreRecord]
scoreRecords
renderOutcome :: MK.Outcome -> AttrString
renderOutcome :: Outcome -> AttrString
renderOutcome outcome :: Outcome
outcome =
let color :: Color
color | Outcome
outcome Outcome -> [Outcome] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Outcome]
MK.deafeatOutcomes = Color
Color.cVeryBadEvent
| Outcome
outcome Outcome -> [Outcome] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Outcome]
MK.victoryOutcomes = Color
Color.cVeryGoodEvent
| Bool
otherwise = Color
Color.cNeutralEvent
lastRemark :: Text
lastRemark
| Outcome
outcome Outcome -> Outcome -> Bool
forall a. Eq a => a -> a -> Bool
/= Outcome
lastOutcome = ""
| Outcome
outcome Outcome -> [Outcome] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Outcome]
MK.deafeatOutcomes = "(last suffered ending)"
| Outcome
outcome Outcome -> [Outcome] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Outcome]
MK.victoryOutcomes = "(last achieved ending)"
| Bool
otherwise = "(last seen ending)"
in Text -> AttrString
textToAS "Game over message when"
AttrString -> AttrString -> AttrString
<+:> (Color -> Text -> AttrString
textFgToAS Color
color (Text -> Text
T.toTitle (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Outcome -> Text
MK.nameOutcomePast Outcome
outcome)
AttrString -> AttrString -> AttrString
<+:> Text -> AttrString
textToAS Text
lastRemark)
AttrString -> AttrString -> AttrString
forall a. Semigroup a => a -> a -> a
<> Text -> AttrString
textToAS ":"
shiftPointUI :: Int -> PointUI -> PointUI
shiftPointUI x :: Int
x (PointUI x0 :: Int
x0 y0 :: Int
y0) = Int -> Int -> PointUI
PointUI (Int
x0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x) Int
y0
EnumMap DisplayFont Overlay -> m (EnumMap DisplayFont Overlay)
forall (m :: * -> *) a. Monad m => a -> m a
return (EnumMap DisplayFont Overlay -> m (EnumMap DisplayFont Overlay))
-> EnumMap DisplayFont Overlay -> m (EnumMap DisplayFont Overlay)
forall a b. (a -> b) -> a -> b
$! if DisplayFont -> Bool
isSquareFont DisplayFont
propFont
then DisplayFont -> Overlay -> EnumMap DisplayFont Overlay
forall k a. Enum k => k -> a -> EnumMap k a
EM.singleton DisplayFont
squareFont
(Overlay -> EnumMap DisplayFont Overlay)
-> Overlay -> EnumMap DisplayFont Overlay
forall a b. (a -> b) -> a -> b
$ [(Int, AttrLine)] -> Overlay
offsetOverlayX
([(Int, AttrLine)] -> Overlay) -> [(Int, AttrLine)] -> Overlay
forall a b. (a -> b) -> a -> b
$ (AttrLine -> (Int, AttrLine)) -> [AttrLine] -> [(Int, AttrLine)]
forall a b. (a -> b) -> [a] -> [b]
map (\t :: AttrLine
t -> (2, AttrLine
t))
([AttrLine] -> [(Int, AttrLine)])
-> [AttrLine] -> [(Int, AttrLine)]
forall a b. (a -> b) -> a -> b
$ ((DisplayFont, [AttrLine]) -> [AttrLine])
-> [(DisplayFont, [AttrLine])] -> [AttrLine]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (DisplayFont, [AttrLine]) -> [AttrLine]
forall a b. (a, b) -> b
snd ([(DisplayFont, [AttrLine])] -> [AttrLine])
-> [(DisplayFont, [AttrLine])] -> [AttrLine]
forall a b. (a -> b) -> a -> b
$ [(DisplayFont, [AttrLine])]
blurb [(DisplayFont, [AttrLine])]
-> [(DisplayFont, [AttrLine])] -> [(DisplayFont, [AttrLine])]
forall a. [a] -> [a] -> [a]
++ [(DisplayFont, [AttrLine])]
blurbEnd
else (Overlay -> Overlay -> Overlay)
-> EnumMap DisplayFont Overlay
-> EnumMap DisplayFont Overlay
-> EnumMap DisplayFont Overlay
forall a k.
(a -> a -> a) -> EnumMap k a -> EnumMap k a -> EnumMap k a
EM.unionWith Overlay -> Overlay -> Overlay
forall a. [a] -> [a] -> [a]
(++)
((Overlay -> Overlay)
-> EnumMap DisplayFont Overlay -> EnumMap DisplayFont Overlay
forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
EM.map (((PointUI, AttrLine) -> (PointUI, AttrLine)) -> Overlay -> Overlay
forall a b. (a -> b) -> [a] -> [b]
map ((PointUI -> PointUI) -> (PointUI, AttrLine) -> (PointUI, AttrLine)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first ((PointUI -> PointUI)
-> (PointUI, AttrLine) -> (PointUI, AttrLine))
-> (PointUI -> PointUI)
-> (PointUI, AttrLine)
-> (PointUI, AttrLine)
forall a b. (a -> b) -> a -> b
$ Int -> PointUI -> PointUI
shiftPointUI 1))
(EnumMap DisplayFont Overlay -> EnumMap DisplayFont Overlay)
-> EnumMap DisplayFont Overlay -> EnumMap DisplayFont Overlay
forall a b. (a -> b) -> a -> b
$ Int -> [(DisplayFont, [AttrLine])] -> EnumMap DisplayFont Overlay
attrLinesToFontMap 0 [(DisplayFont, [AttrLine])]
blurb)
((Overlay -> Overlay)
-> EnumMap DisplayFont Overlay -> EnumMap DisplayFont Overlay
forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
EM.map (((PointUI, AttrLine) -> (PointUI, AttrLine)) -> Overlay -> Overlay
forall a b. (a -> b) -> [a] -> [b]
map ((PointUI -> PointUI) -> (PointUI, AttrLine) -> (PointUI, AttrLine)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first ((PointUI -> PointUI)
-> (PointUI, AttrLine) -> (PointUI, AttrLine))
-> (PointUI -> PointUI)
-> (PointUI, AttrLine)
-> (PointUI, AttrLine)
forall a b. (a -> b) -> a -> b
$ Int -> PointUI -> PointUI
shiftPointUI (Int -> PointUI -> PointUI) -> Int -> PointUI -> PointUI
forall a b. (a -> b) -> a -> b
$ Int
rwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1))
(EnumMap DisplayFont Overlay -> EnumMap DisplayFont Overlay)
-> EnumMap DisplayFont Overlay -> EnumMap DisplayFont Overlay
forall a b. (a -> b) -> a -> b
$ Int -> [(DisplayFont, [AttrLine])] -> EnumMap DisplayFont Overlay
attrLinesToFontMap 0 [(DisplayFont, [AttrLine])]
blurbEnd)
modesOverlay :: MonadClientUI m => m OKX
modesOverlay :: m OKX
modesOverlay = do
COps{ContentData ModeKind
comode :: ContentData ModeKind
comode :: COps -> ContentData ModeKind
comode} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
FontSetup{..} <- m FontSetup
forall (m :: * -> *). MonadClientUI m => m FontSetup
getFontSetup
EnumMap (ContentId ModeKind) (Map Challenge Int)
svictories <- (StateClient -> EnumMap (ContentId ModeKind) (Map Challenge Int))
-> m (EnumMap (ContentId ModeKind) (Map Challenge Int))
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> EnumMap (ContentId ModeKind) (Map Challenge Int)
svictories
Challenge
nxtChal <- (StateClient -> Challenge) -> m Challenge
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Challenge
snxtChal
let f :: [(a, b)] -> p -> a -> b -> [(a, b)]
f ![(a, b)]
acc _p :: p
_p !a
i !b
a = (a
i, b
a) (a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
: [(a, b)]
acc
campaignModes :: [(ContentId ModeKind, ModeKind)]
campaignModes = ContentData ModeKind
-> GroupName ModeKind
-> ([(ContentId ModeKind, ModeKind)]
-> Int
-> ContentId ModeKind
-> ModeKind
-> [(ContentId ModeKind, ModeKind)])
-> [(ContentId ModeKind, ModeKind)]
-> [(ContentId ModeKind, ModeKind)]
forall a b.
ContentData a
-> GroupName a -> (b -> Int -> ContentId a -> a -> b) -> b -> b
ofoldlGroup' ContentData ModeKind
comode GroupName ModeKind
MK.CAMPAIGN_SCENARIO [(ContentId ModeKind, ModeKind)]
-> Int
-> ContentId ModeKind
-> ModeKind
-> [(ContentId ModeKind, ModeKind)]
forall a b p. [(a, b)] -> p -> a -> b -> [(a, b)]
f []
prSlot :: (Int, SlotChar)
-> (ContentId MK.ModeKind, MK.ModeKind)
-> (AttrLine, (Int, AttrLine), KYX)
prSlot :: (Int, SlotChar)
-> (ContentId ModeKind, ModeKind)
-> (AttrLine, (Int, AttrLine),
(Either [KM] SlotChar, (PointUI, ButtonWidth)))
prSlot (y :: Int
y, c :: SlotChar
c) (gameModeId :: ContentId ModeKind
gameModeId, gameMode :: ModeKind
gameMode) =
let modeName :: Text
modeName = ModeKind -> Text
MK.mname ModeKind
gameMode
victories :: Int
victories = case ContentId ModeKind
-> EnumMap (ContentId ModeKind) (Map Challenge Int)
-> Maybe (Map Challenge Int)
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup ContentId ModeKind
gameModeId EnumMap (ContentId ModeKind) (Map Challenge Int)
svictories of
Nothing -> 0
Just cm :: Map Challenge Int
cm -> Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe 0 (Challenge -> Map Challenge Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Challenge
nxtChal Map Challenge Int
cm)
markMode :: Text -> Text
markMode t :: Text
t = if Int
victories Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0
then Text -> Char -> Text
T.snoc (Text -> Text
T.init Text
t) '>'
else Text
t
!tSlot :: Text
tSlot = Text -> Text
markMode (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ SlotChar -> Text
slotLabel SlotChar
c
!lenSlot :: Int
lenSlot = 2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Text -> Int
T.length Text
tSlot
!tBlurb :: Text
tBlurb = " " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
modeName
!lenButton :: Int
lenButton = Int
lenSlot Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Text -> Int
T.length Text
tBlurb
!pButton :: PointUI
pButton = Int -> Int -> PointUI
PointUI 0 Int
y
!widthButton :: ButtonWidth
widthButton = DisplayFont -> Int -> ButtonWidth
ButtonWidth DisplayFont
propFont Int
lenButton
in ( Text -> AttrLine
textToAL Text
tSlot
, (Int
lenSlot, Text -> AttrLine
textToAL Text
tBlurb)
, (SlotChar -> Either [KM] SlotChar
forall a b. b -> Either a b
Right SlotChar
c, (PointUI
pButton, ButtonWidth
widthButton)) )
(plLab :: [AttrLine]
plLab, plDesc :: [(Int, AttrLine)]
plDesc, kxs :: [(Either [KM] SlotChar, (PointUI, ButtonWidth))]
kxs) =
[(AttrLine, (Int, AttrLine),
(Either [KM] SlotChar, (PointUI, ButtonWidth)))]
-> ([AttrLine], [(Int, AttrLine)],
[(Either [KM] SlotChar, (PointUI, ButtonWidth))])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 ([(AttrLine, (Int, AttrLine),
(Either [KM] SlotChar, (PointUI, ButtonWidth)))]
-> ([AttrLine], [(Int, AttrLine)],
[(Either [KM] SlotChar, (PointUI, ButtonWidth))]))
-> [(AttrLine, (Int, AttrLine),
(Either [KM] SlotChar, (PointUI, ButtonWidth)))]
-> ([AttrLine], [(Int, AttrLine)],
[(Either [KM] SlotChar, (PointUI, ButtonWidth))])
forall a b. (a -> b) -> a -> b
$ ((Int, SlotChar)
-> (ContentId ModeKind, ModeKind)
-> (AttrLine, (Int, AttrLine),
(Either [KM] SlotChar, (PointUI, ButtonWidth))))
-> [(Int, SlotChar)]
-> [(ContentId ModeKind, ModeKind)]
-> [(AttrLine, (Int, AttrLine),
(Either [KM] SlotChar, (PointUI, ButtonWidth)))]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Int, SlotChar)
-> (ContentId ModeKind, ModeKind)
-> (AttrLine, (Int, AttrLine),
(Either [KM] SlotChar, (PointUI, ButtonWidth)))
prSlot ([Int] -> [SlotChar] -> [(Int, SlotChar)]
forall a b. [a] -> [b] -> [(a, b)]
zip [0..] [SlotChar]
allSlots) [(ContentId ModeKind, ModeKind)]
campaignModes
placeLab :: EnumMap DisplayFont Overlay
placeLab = DisplayFont -> Overlay -> EnumMap DisplayFont Overlay
forall k a. Enum k => k -> a -> EnumMap k a
EM.singleton DisplayFont
squareFont (Overlay -> EnumMap DisplayFont Overlay)
-> Overlay -> EnumMap DisplayFont Overlay
forall a b. (a -> b) -> a -> b
$ [AttrLine] -> Overlay
offsetOverlay [AttrLine]
plLab
placeDesc :: EnumMap DisplayFont Overlay
placeDesc = DisplayFont -> Overlay -> EnumMap DisplayFont Overlay
forall k a. Enum k => k -> a -> EnumMap k a
EM.singleton DisplayFont
propFont (Overlay -> EnumMap DisplayFont Overlay)
-> Overlay -> EnumMap DisplayFont Overlay
forall a b. (a -> b) -> a -> b
$ [(Int, AttrLine)] -> Overlay
offsetOverlayX [(Int, AttrLine)]
plDesc
OKX -> m OKX
forall (m :: * -> *) a. Monad m => a -> m a
return ((Overlay -> Overlay -> Overlay)
-> EnumMap DisplayFont Overlay
-> EnumMap DisplayFont Overlay
-> EnumMap DisplayFont Overlay
forall a k.
(a -> a -> a) -> EnumMap k a -> EnumMap k a -> EnumMap k a
EM.unionWith Overlay -> Overlay -> Overlay
forall a. [a] -> [a] -> [a]
(++) EnumMap DisplayFont Overlay
placeLab EnumMap DisplayFont Overlay
placeDesc, [(Either [KM] SlotChar, (PointUI, ButtonWidth))]
kxs)
pickNumber :: (MonadClient m, MonadClientUI m)
=> Bool -> Int -> m (Either MError Int)
pickNumber :: Bool -> Int -> m (Either MError Int)
pickNumber askNumber :: Bool
askNumber kAll :: Int
kAll = Bool -> m (Either MError Int) -> m (Either MError Int)
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
kAll Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 1) (m (Either MError Int) -> m (Either MError Int))
-> m (Either MError Int) -> m (Either MError Int)
forall a b. (a -> b) -> a -> b
$ do
let shownKeys :: [KM]
shownKeys = [ KM
K.returnKM, KM
K.spaceKM, Char -> KM
K.mkChar '+', Char -> KM
K.mkChar '-'
, KM
K.backspaceKM, KM
K.escKM ]
frontKeyKeys :: [KM]
frontKeyKeys = [KM]
shownKeys [KM] -> [KM] -> [KM]
forall a. [a] -> [a] -> [a]
++ (Char -> KM) -> String -> [KM]
forall a b. (a -> b) -> [a] -> [b]
map Char -> KM
K.mkChar ['0'..'9']
gatherNumber :: Int -> m (Either MError Int)
gatherNumber kCur :: Int
kCur = Bool -> m (Either MError Int) -> m (Either MError Int)
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
kCur Bool -> Bool -> Bool
&& Int
kCur Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
kAll) (m (Either MError Int) -> m (Either MError Int))
-> m (Either MError Int) -> m (Either MError Int)
forall a b. (a -> b) -> a -> b
$ do
let kprompt :: Text
kprompt = "Choose number:" Text -> Text -> Text
<+> Int -> Text
forall a. Show a => a -> Text
tshow Int
kCur
MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgPromptGeneric Text
kprompt
Slideshow
sli <- [KM] -> m Slideshow
forall (m :: * -> *). MonadClientUI m => [KM] -> m Slideshow
reportToSlideshow [KM]
shownKeys
Either KM SlotChar
ekkm <- String
-> ColorMode -> Bool -> Slideshow -> [KM] -> m (Either KM SlotChar)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
String
-> ColorMode -> Bool -> Slideshow -> [KM] -> m (Either KM SlotChar)
displayChoiceScreen "" ColorMode
ColorFull Bool
False Slideshow
sli [KM]
frontKeyKeys
case Either KM SlotChar
ekkm of
Left kkm :: KM
kkm ->
case KM -> Key
K.key KM
kkm of
K.Char '+' ->
Int -> m (Either MError Int)
gatherNumber (Int -> m (Either MError Int)) -> Int -> m (Either MError Int)
forall a b. (a -> b) -> a -> b
$ if Int
kCur Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
kAll then 1 else Int
kCur Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1
K.Char '-' ->
Int -> m (Either MError Int)
gatherNumber (Int -> m (Either MError Int)) -> Int -> m (Either MError Int)
forall a b. (a -> b) -> a -> b
$ if Int
kCur Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 1 then Int
kAll else Int
kCur Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1
K.Char l :: Char
l | Int
kCur Int -> Int -> Int
forall a. Num a => a -> a -> a
* 10 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
Char.digitToInt Char
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
kAll ->
Int -> m (Either MError Int)
gatherNumber (Int -> m (Either MError Int)) -> Int -> m (Either MError Int)
forall a b. (a -> b) -> a -> b
$ if Char -> Int
Char.digitToInt Char
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0
then Int
kAll
else Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
kAll (Char -> Int
Char.digitToInt Char
l)
K.Char l :: Char
l -> Int -> m (Either MError Int)
gatherNumber (Int -> m (Either MError Int)) -> Int -> m (Either MError Int)
forall a b. (a -> b) -> a -> b
$ Int
kCur Int -> Int -> Int
forall a. Num a => a -> a -> a
* 10 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
Char.digitToInt Char
l
K.BackSpace -> Int -> m (Either MError Int)
gatherNumber (Int -> m (Either MError Int)) -> Int -> m (Either MError Int)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max 1 (Int
kCur Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 10)
K.Return -> Either MError Int -> m (Either MError Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either MError Int -> m (Either MError Int))
-> Either MError Int -> m (Either MError Int)
forall a b. (a -> b) -> a -> b
$ Int -> Either MError Int
forall a b. b -> Either a b
Right Int
kCur
K.Esc -> FailOrCmd Int -> Either MError Int
forall a. FailOrCmd a -> Either MError a
weaveJust (FailOrCmd Int -> Either MError Int)
-> m (FailOrCmd Int) -> m (Either MError Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> m (FailOrCmd Int)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "never mind"
K.Space -> Either MError Int -> m (Either MError Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either MError Int -> m (Either MError Int))
-> Either MError Int -> m (Either MError Int)
forall a b. (a -> b) -> a -> b
$ MError -> Either MError Int
forall a b. a -> Either a b
Left MError
forall a. Maybe a
Nothing
_ -> String -> m (Either MError Int)
forall a. (?callStack::CallStack) => String -> a
error (String -> m (Either MError Int))
-> String -> m (Either MError Int)
forall a b. (a -> b) -> a -> b
$ "unexpected key" String -> KM -> String
forall v. Show v => String -> v -> String
`showFailure` KM
kkm
Right sc :: SlotChar
sc -> String -> m (Either MError Int)
forall a. (?callStack::CallStack) => String -> a
error (String -> m (Either MError Int))
-> String -> m (Either MError Int)
forall a b. (a -> b) -> a -> b
$ "unexpected slot char" String -> SlotChar -> String
forall v. Show v => String -> v -> String
`showFailure` SlotChar
sc
if | Int
kAll Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
askNumber -> Either MError Int -> m (Either MError Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either MError Int -> m (Either MError Int))
-> Either MError Int -> m (Either MError Int)
forall a b. (a -> b) -> a -> b
$ Int -> Either MError Int
forall a b. b -> Either a b
Right Int
kAll
| Bool
otherwise -> do
Either MError Int
res <- Int -> m (Either MError Int)
gatherNumber Int
kAll
case Either MError Int
res of
Right k :: Int
k | Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 -> String -> m (Either MError Int)
forall a. (?callStack::CallStack) => String -> a
error (String -> m (Either MError Int))
-> String -> m (Either MError Int)
forall a b. (a -> b) -> a -> b
$ "" String -> (Either MError Int, Int) -> String
forall v. Show v => String -> v -> String
`showFailure` (Either MError Int
res, Int
kAll)
_ -> Either MError Int -> m (Either MError Int)
forall (m :: * -> *) a. Monad m => a -> m a
return Either MError Int
res
lookAtTile :: MonadClientUI m
=> Bool
-> Point
-> ActorId
-> LevelId
-> Maybe MU.Person
-> m (Text, Text, [(Int, MU.Part)])
lookAtTile :: Bool
-> Point
-> ActorId
-> LevelId
-> Maybe Person
-> m (Text, Text, [(Int, Part)])
lookAtTile canSee :: Bool
canSee p :: Point
p aid :: ActorId
aid lidV :: LevelId
lidV mperson :: Maybe Person
mperson = do
CCUI{coscreen :: CCUI -> ScreenContent
coscreen=ScreenContent{Int
rwidth :: Int
rwidth :: ScreenContent -> Int
rwidth}} <- (SessionUI -> CCUI) -> m CCUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
cops :: COps
cops@COps{ContentData TileKind
cotile :: COps -> ContentData TileKind
cotile :: ContentData TileKind
cotile, ContentData PlaceKind
coplace :: ContentData PlaceKind
coplace :: COps -> ContentData PlaceKind
coplace} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
EnumMap FactionId Faction
factionD <- (State -> EnumMap FactionId Faction)
-> m (EnumMap FactionId Faction)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> EnumMap FactionId Faction
sfactionD
Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
Level
lvl <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel LevelId
lidV
Maybe AimMode
saimMode <- (SessionUI -> Maybe AimMode) -> m (Maybe AimMode)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe AimMode
saimMode
ItemBag
embeds <- (State -> ItemBag) -> m ItemBag
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemBag) -> m ItemBag)
-> (State -> ItemBag) -> m ItemBag
forall a b. (a -> b) -> a -> b
$ LevelId -> Point -> State -> ItemBag
getEmbedBag LevelId
lidV Point
p
ItemId -> ItemFull
itemToF <- (State -> ItemId -> ItemFull) -> m (ItemId -> ItemFull)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemId -> ItemFull) -> m (ItemId -> ItemFull))
-> (State -> ItemId -> ItemFull) -> m (ItemId -> ItemFull)
forall a b. (a -> b) -> a -> b
$ (ItemId -> State -> ItemFull) -> State -> ItemId -> ItemFull
forall a b c. (a -> b -> c) -> b -> a -> c
flip ItemId -> State -> ItemFull
itemToFull
Int
seps <- (StateClient -> Int) -> m Int
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Int
seps
Time
localTime <- (State -> Time) -> m Time
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Time) -> m Time) -> (State -> Time) -> m Time
forall a b. (a -> b) -> a -> b
$ LevelId -> State -> Time
getLocalTime LevelId
lidV
ItemId -> ItemKind
getKind <- (State -> ItemId -> ItemKind) -> m (ItemId -> ItemKind)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemId -> ItemKind) -> m (ItemId -> ItemKind))
-> (State -> ItemId -> ItemKind) -> m (ItemId -> ItemKind)
forall a b. (a -> b) -> a -> b
$ (ItemId -> State -> ItemKind) -> State -> ItemId -> ItemKind
forall a b c. (a -> b -> c) -> b -> a -> c
flip ItemId -> State -> ItemKind
getIidKind
let inhabitants :: [ActorId]
inhabitants = Point -> Level -> [ActorId]
posToAidsLvl Point
p Level
lvl
detail :: DetailLevel
detail = DetailLevel
-> (AimMode -> DetailLevel) -> Maybe AimMode -> DetailLevel
forall b a. b -> (a -> b) -> Maybe a -> b
maybe DetailLevel
DetailAll AimMode -> DetailLevel
detailLevel Maybe AimMode
saimMode
aims :: Bool
aims = Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Int -> Bool) -> Maybe Int -> Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Actor -> Point -> Int -> COps -> Level -> Maybe Int
makeLine Bool
False Actor
b Point
p Int
seps COps
cops Level
lvl
tkid :: ContentId TileKind
tkid = Level
lvl Level -> Point -> ContentId TileKind
`at` Point
p
tile :: TileKind
tile = ContentData TileKind -> ContentId TileKind -> TileKind
forall a. ContentData a -> ContentId a -> a
okind ContentData TileKind
cotile ContentId TileKind
tkid
vis :: Part
vis | TileKind -> Text
TK.tname TileKind
tile Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "unknown space" = "that is"
| Bool -> Bool
not ([ActorId] -> Bool
forall a. [a] -> Bool
null [ActorId]
inhabitants) Bool -> Bool -> Bool
&& Actor -> Point
bpos Actor
b Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
/= Point
p = "the terrain here is"
| Bool -> Bool
not Bool
canSee = "you remember"
| Bool -> Bool
not Bool
aims = "you are aware of"
| Bool
otherwise = "you see"
vperson :: Part
vperson = case Maybe Person
mperson of
Nothing -> Part
vis
Just MU.Sg1st -> String -> Part
forall a. (?callStack::CallStack) => String -> a
error "an item speaks in first person"
Just MU.Sg3rd -> "It is laying on"
Just MU.PlEtc -> "They lay on"
tilePart :: Part
tilePart = Part -> Part
MU.AW (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ TileKind -> Text
TK.tname TileKind
tile
entrySentence :: ContentId PlaceKind -> Part -> Text
entrySentence pk :: ContentId PlaceKind
pk blurb :: Part
blurb =
[Part] -> Text
makeSentence [Part
blurb, Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ PlaceKind -> Text
PK.pname (PlaceKind -> Text) -> PlaceKind -> Text
forall a b. (a -> b) -> a -> b
$ ContentData PlaceKind -> ContentId PlaceKind -> PlaceKind
forall a. ContentData a -> ContentId a -> a
okind ContentData PlaceKind
coplace ContentId PlaceKind
pk]
placeBlurb :: Text
placeBlurb = case Point -> EntryMap -> Maybe PlaceEntry
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup Point
p (EntryMap -> Maybe PlaceEntry) -> EntryMap -> Maybe PlaceEntry
forall a b. (a -> b) -> a -> b
$ Level -> EntryMap
lentry Level
lvl of
Nothing -> ""
Just (PK.PEntry pk :: ContentId PlaceKind
pk) -> ContentId PlaceKind -> Part -> Text
entrySentence ContentId PlaceKind
pk "it is an entrance to"
Just (PK.PAround pk :: ContentId PlaceKind
pk) -> ContentId PlaceKind -> Part -> Text
entrySentence ContentId PlaceKind
pk "it surrounds"
Just (PK.PExists _) -> ""
embedLook :: (ItemId, ItemQuant) -> (Int, Part)
embedLook (iid :: ItemId
iid, kit :: ItemQuant
kit@(k :: Int
k, _)) =
let itemFull :: ItemFull
itemFull = ItemId -> ItemFull
itemToF ItemId
iid
nWs :: Part
nWs = DetailLevel
-> Int
-> FactionId
-> EnumMap FactionId Faction
-> Int
-> Time
-> ItemFull
-> ItemQuant
-> Part
partItemWsDetail DetailLevel
detail
Int
rwidth FactionId
side EnumMap FactionId Faction
factionD Int
k Time
localTime ItemFull
itemFull ItemQuant
kit
in (Int
k, Part
nWs)
embedKindList :: [(ItemKind, (ItemId, ItemQuant))]
embedKindList =
((ItemId, ItemQuant) -> (ItemKind, (ItemId, ItemQuant)))
-> [(ItemId, ItemQuant)] -> [(ItemKind, (ItemId, ItemQuant))]
forall a b. (a -> b) -> [a] -> [b]
map (\(iid :: ItemId
iid, kit :: ItemQuant
kit) -> (ItemId -> ItemKind
getKind ItemId
iid, (ItemId
iid, ItemQuant
kit))) (ItemBag -> [(ItemId, ItemQuant)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs ItemBag
embeds)
embedList :: [(Int, Part)]
embedList = ((ItemId, ItemQuant) -> (Int, Part))
-> [(ItemId, ItemQuant)] -> [(Int, Part)]
forall a b. (a -> b) -> [a] -> [b]
map (ItemId, ItemQuant) -> (Int, Part)
embedLook ([(ItemId, ItemQuant)] -> [(Int, Part)])
-> [(ItemId, ItemQuant)] -> [(Int, Part)]
forall a b. (a -> b) -> a -> b
$ COps
-> ContentId TileKind
-> [(ItemKind, (ItemId, ItemQuant))]
-> [(ItemId, ItemQuant)]
sortEmbeds COps
cops ContentId TileKind
tkid [(ItemKind, (ItemId, ItemQuant))]
embedKindList
(Text, Text, [(Int, Part)]) -> m (Text, Text, [(Int, Part)])
forall (m :: * -> *) a. Monad m => a -> m a
return ([Part] -> Text
makeSentence [Part
vperson, Part
tilePart], Text
placeBlurb, [(Int, Part)]
embedList)
lookAtActors :: MonadClientUI m
=> Point
-> LevelId
-> m (Text, Maybe (MU.Part, Bool), Text)
lookAtActors :: Point -> LevelId -> m (Text, Maybe (Part, Bool), Text)
lookAtActors p :: Point
p lidV :: LevelId
lidV = do
CCUI{coscreen :: CCUI -> ScreenContent
coscreen=ScreenContent{Int
rwidth :: Int
rwidth :: ScreenContent -> Int
rwidth}} <- (SessionUI -> CCUI) -> m CCUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
[(ActorId, Actor)]
inhabitants <- (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)])
-> (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
forall a b. (a -> b) -> a -> b
$ Point -> LevelId -> State -> [(ActorId, Actor)]
posToAidAssocs Point
p LevelId
lidV
EnumMap FactionId Faction
factionD <- (State -> EnumMap FactionId Faction)
-> m (EnumMap FactionId Faction)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> EnumMap FactionId Faction
sfactionD
Time
localTime <- (State -> Time) -> m Time
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Time) -> m Time) -> (State -> Time) -> m Time
forall a b. (a -> b) -> a -> b
$ LevelId -> State -> Time
getLocalTime LevelId
lidV
Maybe AimMode
saimMode <- (SessionUI -> Maybe AimMode) -> m (Maybe AimMode)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe AimMode
saimMode
let detail :: DetailLevel
detail = DetailLevel
-> (AimMode -> DetailLevel) -> Maybe AimMode -> DetailLevel
forall b a. b -> (a -> b) -> Maybe a -> b
maybe DetailLevel
DetailAll AimMode -> DetailLevel
detailLevel Maybe AimMode
saimMode
case [(ActorId, Actor)]
inhabitants of
[] -> (Text, Maybe (Part, Bool), Text)
-> m (Text, Maybe (Part, Bool), Text)
forall (m :: * -> *) a. Monad m => a -> m a
return ("", Maybe (Part, Bool)
forall a. Maybe a
Nothing, "")
(aid :: ActorId
aid, body :: Actor
body) : rest :: [(ActorId, Actor)]
rest -> do
Part
actorPronoun <- ActorId -> m Part
forall (m :: * -> *). MonadClientUI m => ActorId -> m Part
partPronounLeader ActorId
aid
ItemFull
itemFull <- (State -> ItemFull) -> m ItemFull
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemFull) -> m ItemFull)
-> (State -> ItemFull) -> m ItemFull
forall a b. (a -> b) -> a -> b
$ ItemId -> State -> ItemFull
itemToFull (ItemId -> State -> ItemFull) -> ItemId -> State -> ItemFull
forall a b. (a -> b) -> a -> b
$ Actor -> ItemId
btrunk Actor
body
[Part]
guardVerbs <- (State -> [Part]) -> m [Part]
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [Part]) -> m [Part]) -> (State -> [Part]) -> m [Part]
forall a b. (a -> b) -> a -> b
$ Actor -> State -> [Part]
guardItemVerbs Actor
body
[Part]
subjects <- ((ActorId, Actor) -> m Part) -> [(ActorId, Actor)] -> m [Part]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ActorId -> m Part
forall (m :: * -> *). MonadClientUI m => ActorId -> m Part
partActorLeader (ActorId -> m Part)
-> ((ActorId, Actor) -> ActorId) -> (ActorId, Actor) -> m Part
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ActorId, Actor) -> ActorId
forall a b. (a, b) -> a
fst) [(ActorId, Actor)]
inhabitants
let bfact :: Faction
bfact = EnumMap FactionId Faction
factionD EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
body
(subject :: Part
subject, person :: Person
person) = [Part] -> (Part, Person)
squashedWWandW [Part]
subjects
resideVerb :: Part
resideVerb = case Actor -> Watchfulness
bwatch Actor
body of
WWatch -> "be here"
WWait 0 -> "idle here"
WWait _ -> "brace for impact"
WSleep -> "sleep here"
WWake -> "be waking up"
flyVerb :: Part
flyVerb | Actor -> Bool
bproj Actor
body = "zip through here"
| Maybe ([Vector], Speed) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe ([Vector], Speed) -> Bool)
-> Maybe ([Vector], Speed) -> Bool
forall a b. (a -> b) -> a -> b
$ Actor -> Maybe ([Vector], Speed)
btrajectory Actor
body = "move through here"
| Bool
otherwise = Part
resideVerb
verbs :: [Part]
verbs = Part
flyVerb Part -> [Part] -> [Part]
forall a. a -> [a] -> [a]
: [Part]
guardVerbs
projDesc :: Text
projDesc | Bool -> Bool
not (Actor -> Bool
bproj Actor
body) Bool -> Bool -> Bool
|| DetailLevel
detail DetailLevel -> DetailLevel -> Bool
forall a. Ord a => a -> a -> Bool
< DetailLevel
DetailAll = ""
| Bool
otherwise =
let kit :: ItemQuant
kit = Actor -> ItemBag
beqp Actor
body ItemBag -> ItemId -> ItemQuant
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> ItemId
btrunk Actor
body
ps :: [Part]
ps = [Int
-> FactionId
-> EnumMap FactionId Faction
-> Time
-> ItemFull
-> ItemQuant
-> Part
partItemMediumAW Int
rwidth FactionId
side EnumMap FactionId Faction
factionD Time
localTime
ItemFull
itemFull ItemQuant
kit]
tailWords :: [Part] -> [Text]
tailWords = [Text] -> [Text]
forall a. [a] -> [a]
tail ([Text] -> [Text]) -> ([Part] -> [Text]) -> [Part] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.words (Text -> [Text]) -> ([Part] -> Text) -> [Part] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Part] -> Text
makePhrase
in if [Part] -> [Text]
tailWords [Part]
ps [Text] -> [Text] -> Bool
forall a. Eq a => a -> a -> Bool
== [Part] -> [Text]
tailWords [Part]
subjects
then ""
else [Part] -> Text
makeSentence ([Part] -> Text) -> [Part] -> Text
forall a b. (a -> b) -> a -> b
$ "this is" Part -> [Part] -> [Part]
forall a. a -> [a] -> [a]
: [Part]
ps
factDesc :: Text
factDesc = case Item -> Maybe FactionId
jfid (Item -> Maybe FactionId) -> Item -> Maybe FactionId
forall a b. (a -> b) -> a -> b
$ ItemFull -> Item
itemBase ItemFull
itemFull of
Just tfid :: FactionId
tfid | FactionId
tfid FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
/= Actor -> FactionId
bfid Actor
body ->
let dominatedBy :: Text
dominatedBy = if Actor -> FactionId
bfid Actor
body FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side then "us" else Faction -> Text
gname Faction
bfact
tfact :: Faction
tfact = EnumMap FactionId Faction
factionD EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
tfid
in "Originally of" Text -> Text -> Text
<+> Faction -> Text
gname Faction
tfact
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ", now fighting for" Text -> Text -> Text
<+> Text
dominatedBy Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "."
_ | DetailLevel
detail DetailLevel -> DetailLevel -> Bool
forall a. Ord a => a -> a -> Bool
< DetailLevel
DetailAll -> ""
_ | 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 = if DetailLevel
detail DetailLevel -> DetailLevel -> Bool
forall a. Ord a => a -> a -> Bool
< DetailLevel
DetailAll
then ""
else ItemKind -> Text
IK.idesc (ItemKind -> Text) -> ItemKind -> Text
forall a b. (a -> b) -> a -> b
$ ItemFull -> ItemKind
itemKind ItemFull
itemFull
sameTrunks :: Bool
sameTrunks = ((ActorId, Actor) -> Bool) -> [(ActorId, Actor)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\(_, b :: Actor
b) -> Actor -> ItemId
btrunk Actor
b ItemId -> ItemId -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> ItemId
btrunk Actor
body) [(ActorId, Actor)]
rest
desc :: Text
desc = Text -> Text
wrapInParens (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
projDesc Text -> Text -> Text
<+> Text
factDesc Text -> Text -> Text
<+> Text
idesc
onlyIs :: Bool
onlyIs = Actor -> Watchfulness
bwatch Actor
body Watchfulness -> Watchfulness -> Bool
forall a. Eq a => a -> a -> Bool
== Watchfulness
WWatch Bool -> Bool -> Bool
&& [Part] -> Bool
forall a. [a] -> Bool
null [Part]
guardVerbs
allBlurb :: Text
allBlurb = [Part] -> Text
makeSentence [Part -> Person -> Polarity -> Part -> [Part] -> Part
MU.SubjectVVxV "and" Person
person Polarity
MU.Yes
Part
subject [Part]
verbs]
headBlurb :: Text
headBlurb = [Part] -> Text
makeSentence [Part -> Person -> Polarity -> Part -> [Part] -> Part
MU.SubjectVVxV "and" Person
MU.Sg3rd Polarity
MU.Yes
([Part] -> Part
forall a. [a] -> a
head [Part]
subjects) [Part]
verbs]
andProjectiles :: Text
andProjectiles = case [Part]
subjects of
_ : projs :: [Part]
projs@(_ : _) ->
let (subjectProjs :: Part
subjectProjs, personProjs :: Person
personProjs) =
[Part] -> (Part, Person)
squashedWWandW [Part]
projs
in [Part] -> Text
makeSentence
[Person -> Polarity -> Part -> Part -> Part
MU.SubjectVerb Person
personProjs Polarity
MU.Yes
Part
subjectProjs "can be seen"]
_ -> ""
actorAlive :: Bool
actorAlive = Actor -> Int64
bhp Actor
body Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= 0
mactorPronounAlive :: Maybe (Part, Bool)
mactorPronounAlive =
if Actor -> Bool
bproj Actor
body then Maybe (Part, Bool)
forall a. Maybe a
Nothing else (Part, Bool) -> Maybe (Part, Bool)
forall a. a -> Maybe a
Just (Part
actorPronoun, Bool
actorAlive)
(Text, Maybe (Part, Bool), Text)
-> m (Text, Maybe (Part, Bool), Text)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Text, Maybe (Part, Bool), Text)
-> m (Text, Maybe (Part, Bool), Text))
-> (Text, Maybe (Part, Bool), Text)
-> m (Text, Maybe (Part, Bool), Text)
forall a b. (a -> b) -> a -> b
$!
if | Bool -> Bool
not Bool
actorAlive Bool -> Bool -> Bool
&& Bool -> Bool
not (Actor -> Bool
bproj Actor
body) ->
( [Part] -> Text
makeSentence
(Part -> Part -> Part
MU.SubjectVerbSg ([Part] -> Part
forall a. [a] -> a
head [Part]
subjects) "lie here"
Part -> [Part] -> [Part]
forall a. a -> [a] -> [a]
: if [Part] -> Bool
forall a. [a] -> Bool
null [Part]
guardVerbs
then []
else [ Part -> Person -> Polarity -> Part -> [Part] -> Part
MU.SubjectVVxV "and" Person
MU.Sg3rd Polarity
MU.No
"and" [Part]
guardVerbs
, "any more" ])
, Maybe (Part, Bool)
mactorPronounAlive
, Text -> Text
wrapInParens Text
desc Text -> Text -> Text
<+> Text
andProjectiles )
| Bool
sameTrunks ->
( Text
allBlurb
, Maybe (Part, Bool)
mactorPronounAlive
, Text
desc )
| Bool -> Bool
not (Actor -> Bool
bproj Actor
body) Bool -> Bool -> Bool
&& Bool
onlyIs ->
( Text
headBlurb
, Maybe (Part, Bool)
mactorPronounAlive
, Text
desc Text -> Text -> Text
<+> Text
andProjectiles )
| Bool -> Bool
not (Actor -> Bool
bproj Actor
body) ->
( [Part] -> Text
makeSentence [Part
subject, "can be seen"] Text -> Text -> Text
<+> Text
headBlurb
, Maybe (Part, Bool)
mactorPronounAlive
, Text
desc )
| Bool
otherwise -> Bool
-> (Text, Maybe (Part, Bool), Text)
-> (Text, Maybe (Part, Bool), Text)
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Actor -> Bool
bproj Actor
body Bool -> Bool -> Bool
&& Bool -> Bool
not ([(ActorId, Actor)] -> Bool
forall a. [a] -> Bool
null [(ActorId, Actor)]
rest))
( [Part] -> Text
makeSentence [Part
subject, "can be seen"]
, Maybe (Part, Bool)
forall a. Maybe a
Nothing
, "" )
guardItemVerbs :: Actor -> State -> [MU.Part]
guardItemVerbs :: Actor -> State -> [Part]
guardItemVerbs body :: Actor
body s :: State
s =
let itemsSize :: Int
itemsSize = Actor -> State -> Int
guardItemSize Actor
body State
s
belongingsVerbs :: [Part]
belongingsVerbs | Int
itemsSize Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 = ["fondle a trinket"]
| Int
itemsSize Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1 = ["haul a hoard"]
| Bool
otherwise = []
in if Actor -> Bool
bproj Actor
body then [] else [Part]
belongingsVerbs
guardItemSize :: Actor -> State -> Int
guardItemSize :: Actor -> State -> Int
guardItemSize body :: Actor
body s :: State
s =
let toReport :: ItemId -> Bool
toReport iid :: ItemId
iid =
let itemKind :: ItemKind
itemKind = ItemId -> State -> ItemKind
getIidKind ItemId
iid State
s
in Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe 0 (GroupName ItemKind -> [(GroupName ItemKind, Int)] -> Maybe Int
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup GroupName ItemKind
IK.UNREPORTED_INVENTORY (ItemKind -> [(GroupName ItemKind, Int)]
IK.ifreq ItemKind
itemKind)) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0
in [ItemId] -> Int
forall a. [a] -> Int
length ([ItemId] -> Int) -> [ItemId] -> Int
forall a b. (a -> b) -> a -> b
$ (ItemId -> Bool) -> [ItemId] -> [ItemId]
forall a. (a -> Bool) -> [a] -> [a]
filter ItemId -> Bool
toReport ([ItemId] -> [ItemId]) -> [ItemId] -> [ItemId]
forall a b. (a -> b) -> a -> b
$ ItemBag -> [ItemId]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys (Actor -> ItemBag
beqp Actor
body)
lookAtItems :: MonadClientUI m
=> Bool
-> Point
-> ActorId
-> Maybe (MU.Part, Bool)
-> m (Text, Maybe MU.Person)
lookAtItems :: Bool
-> Point -> ActorId -> Maybe (Part, Bool) -> m (Text, Maybe Person)
lookAtItems canSee :: Bool
canSee p :: Point
p aid :: ActorId
aid mactorPronounAlive :: Maybe (Part, Bool)
mactorPronounAlive = do
CCUI{coscreen :: CCUI -> ScreenContent
coscreen=ScreenContent{Int
rwidth :: Int
rwidth :: ScreenContent -> Int
rwidth}} <- (SessionUI -> CCUI) -> m CCUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
ItemId -> ItemFull
itemToF <- (State -> ItemId -> ItemFull) -> m (ItemId -> ItemFull)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemId -> ItemFull) -> m (ItemId -> ItemFull))
-> (State -> ItemId -> ItemFull) -> m (ItemId -> ItemFull)
forall a b. (a -> b) -> a -> b
$ (ItemId -> State -> ItemFull) -> State -> ItemId -> ItemFull
forall a b c. (a -> b -> c) -> b -> a -> c
flip ItemId -> State -> ItemFull
itemToFull
Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
Maybe AimMode
saimMode <- (SessionUI -> Maybe AimMode) -> m (Maybe AimMode)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe AimMode
saimMode
let lidV :: LevelId
lidV = LevelId -> (AimMode -> LevelId) -> Maybe AimMode -> LevelId
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Actor -> LevelId
blid Actor
b) AimMode -> LevelId
aimLevelId Maybe AimMode
saimMode
standingOn :: Bool
standingOn = Point
p Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> Point
bpos Actor
b Bool -> Bool -> Bool
&& LevelId
lidV LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> LevelId
blid Actor
b
detailExploration :: DetailLevel
detailExploration =
if Bool
standingOn Bool -> Bool -> Bool
&& Actor -> FactionId
bfid Actor
b FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side then DetailLevel
DetailMedium else DetailLevel
DetailAll
detail :: DetailLevel
detail = DetailLevel
-> (AimMode -> DetailLevel) -> Maybe AimMode -> DetailLevel
forall b a. b -> (a -> b) -> Maybe a -> b
maybe DetailLevel
detailExploration AimMode -> DetailLevel
detailLevel Maybe AimMode
saimMode
Time
localTime <- (State -> Time) -> m Time
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Time) -> m Time) -> (State -> Time) -> m Time
forall a b. (a -> b) -> a -> b
$ LevelId -> State -> Time
getLocalTime LevelId
lidV
Part
subjectAid <- ActorId -> m Part
forall (m :: * -> *). MonadClientUI m => ActorId -> m Part
partActorLeader ActorId
aid
ItemBag
is <- (State -> ItemBag) -> m ItemBag
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemBag) -> m ItemBag)
-> (State -> ItemBag) -> m ItemBag
forall a b. (a -> b) -> a -> b
$ LevelId -> Point -> State -> ItemBag
getFloorBag LevelId
lidV Point
p
EnumMap FactionId Faction
factionD <- (State -> EnumMap FactionId Faction)
-> m (EnumMap FactionId Faction)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> EnumMap FactionId Faction
sfactionD
Time
globalTime <- (State -> Time) -> m Time
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> Time
stime
ItemId -> ContentId ItemKind
getKind <- (State -> ItemId -> ContentId ItemKind)
-> m (ItemId -> ContentId ItemKind)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemId -> ContentId ItemKind)
-> m (ItemId -> ContentId ItemKind))
-> (State -> ItemId -> ContentId ItemKind)
-> m (ItemId -> ContentId ItemKind)
forall a b. (a -> b) -> a -> b
$ (ItemId -> State -> ContentId ItemKind)
-> State -> ItemId -> ContentId ItemKind
forall a b c. (a -> b -> c) -> b -> a -> c
flip ItemId -> State -> ContentId ItemKind
getIidKindId
Part
leaderPronoun <- ActorId -> m Part
forall (m :: * -> *). MonadClientUI m => ActorId -> m Part
partPronounLeader ActorId
aid
let mLeader :: Maybe (Part, Bool)
mLeader = if Bool
standingOn then (Part, Bool) -> Maybe (Part, Bool)
forall a. a -> Maybe a
Just (Part
leaderPronoun, Actor -> Int64
bhp Actor
b Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= 0) else Maybe (Part, Bool)
forall a. Maybe a
Nothing
mactorPronounAliveLeader :: Maybe (Part, Bool)
mactorPronounAliveLeader = Maybe (Part, Bool)
-> ((Part, Bool) -> Maybe (Part, Bool))
-> Maybe (Part, Bool)
-> Maybe (Part, Bool)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe (Part, Bool)
mLeader (Part, Bool) -> Maybe (Part, Bool)
forall a. a -> Maybe a
Just Maybe (Part, Bool)
mactorPronounAlive
(subject :: Part
subject, verb :: Text
verb) = case Maybe (Part, Bool)
mactorPronounAliveLeader of
Just (actorPronoun :: Part
actorPronoun, actorAlive :: Bool
actorAlive) ->
(Part
actorPronoun, if Bool
actorAlive then "stand over" else "fall over")
Nothing -> (Part
subjectAid, if Bool
canSee then "notice" else "remember")
nWs :: (ItemId, ItemQuant) -> Part
nWs (iid :: ItemId
iid, kit :: ItemQuant
kit@(k :: Int
k, _)) =
DetailLevel
-> Int
-> FactionId
-> EnumMap FactionId Faction
-> Int
-> Time
-> ItemFull
-> ItemQuant
-> Part
partItemWsDetail DetailLevel
detail
Int
rwidth FactionId
side EnumMap FactionId Faction
factionD Int
k Time
localTime (ItemId -> ItemFull
itemToF ItemId
iid) ItemQuant
kit
(object :: Part
object, person :: Person
person) = case ItemBag -> [(ItemId, ItemQuant)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs ItemBag
is of
[(_, (k :: Int
k, _))] | DetailLevel
detail DetailLevel -> DetailLevel -> Bool
forall a. Eq a => a -> a -> Bool
== DetailLevel
DetailLow ->
(if Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 then "an item" else "an item stack", Person
MU.Sg3rd)
_ | DetailLevel
detail DetailLevel -> DetailLevel -> Bool
forall a. Eq a => a -> a -> Bool
== DetailLevel
DetailLow -> ("some items", Person
MU.PlEtc)
ii :: (ItemId, ItemQuant)
ii : _ : _ : _ | DetailLevel
detail DetailLevel -> DetailLevel -> Bool
forall a. Ord a => a -> a -> Bool
<= DetailLevel
DetailMedium ->
([Part] -> Part
MU.Phrase [(ItemId, ItemQuant) -> Part
nWs (ItemId, ItemQuant)
ii, "and other items"], Person
MU.PlEtc)
[ii :: (ItemId, ItemQuant)
ii@(_, (1, _))] -> ((ItemId, ItemQuant) -> Part
nWs (ItemId, ItemQuant)
ii, Person
MU.Sg3rd)
iis :: [(ItemId, ItemQuant)]
iis -> ([Part] -> Part
MU.WWandW ([Part] -> Part) -> [Part] -> Part
forall a b. (a -> b) -> a -> b
$ ((ItemId, ItemQuant) -> Part) -> [(ItemId, ItemQuant)] -> [Part]
forall a b. (a -> b) -> [a] -> [b]
map (ItemId, ItemQuant) -> Part
nWs ([(ItemId, ItemQuant)] -> [Part])
-> [(ItemId, ItemQuant)] -> [Part]
forall a b. (a -> b) -> a -> b
$ ((ItemId, ItemQuant) -> ContentId ItemKind)
-> [(ItemId, ItemQuant)] -> [(ItemId, ItemQuant)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (ItemId -> ContentId ItemKind
getKind (ItemId -> ContentId ItemKind)
-> ((ItemId, ItemQuant) -> ItemId)
-> (ItemId, ItemQuant)
-> ContentId ItemKind
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ItemId, ItemQuant) -> ItemId
forall a b. (a, b) -> a
fst) [(ItemId, ItemQuant)]
iis, Person
MU.PlEtc)
(Text, Maybe Person) -> m (Text, Maybe Person)
forall (m :: * -> *) a. Monad m => a -> m a
return ( if ItemBag -> Bool
forall k a. EnumMap k a -> Bool
EM.null ItemBag
is Bool -> Bool -> Bool
|| Time
globalTime Time -> Time -> Bool
forall a. Eq a => a -> a -> Bool
== Time
timeZero
then ""
else [Part] -> Text
makeSentence [Part -> Part -> Part
MU.SubjectVerbSg Part
subject (Text -> Part
MU.Text Text
verb), Part
object]
, if Maybe (Part, Bool) -> Bool
forall a. Maybe a -> Bool
isNothing Maybe (Part, Bool)
mactorPronounAlive then Person -> Maybe Person
forall a. a -> Maybe a
Just Person
person else Maybe Person
forall a. Maybe a
Nothing )
lookAtStash :: MonadClientUI m => LevelId -> Point -> m Text
lookAtStash :: LevelId -> Point -> m Text
lookAtStash lidV :: LevelId
lidV p :: Point
p = do
FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
EnumMap FactionId Faction
factionD <- (State -> EnumMap FactionId Faction)
-> m (EnumMap FactionId Faction)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> EnumMap FactionId Faction
sfactionD
let locateStash :: (FactionId, Faction) -> Maybe Text
locateStash (fid :: FactionId
fid, fact :: Faction
fact) = case Faction -> Maybe (LevelId, Point)
gstash Faction
fact of
Just (lid :: LevelId
lid, pos :: Point
pos) | LevelId
lid LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== LevelId
lidV Bool -> Bool -> Bool
&& Point
pos Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Point
p ->
Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ if FactionId
fid FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side
then "Here is the shared inventory stash of your team."
else Faction -> Text
gname Faction
fact
Text -> Text -> Text
<+> "set up their shared inventory stash here."
_ -> Maybe Text
forall a. Maybe a
Nothing
Text -> m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$! Text -> [Text] -> Text
T.intercalate " " ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ ((FactionId, Faction) -> Maybe Text)
-> [(FactionId, Faction)] -> [Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (FactionId, Faction) -> Maybe Text
locateStash ([(FactionId, Faction)] -> [Text])
-> [(FactionId, Faction)] -> [Text]
forall a b. (a -> b) -> a -> b
$ EnumMap FactionId Faction -> [(FactionId, Faction)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs EnumMap FactionId Faction
factionD
lookAtPosition :: MonadClientUI m
=> LevelId -> Point -> m [(MsgClassShow, Text)]
lookAtPosition :: LevelId -> Point -> m [(MsgClassShow, Text)]
lookAtPosition lidV :: LevelId
lidV p :: Point
p = do
COps{ContentData TileKind
cotile :: ContentData TileKind
cotile :: COps -> ContentData TileKind
cotile} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
Perception
per <- LevelId -> m Perception
forall (m :: * -> *). MonadClientRead m => LevelId -> m Perception
getPerFid LevelId
lidV
let canSee :: Bool
canSee = Point -> EnumSet Point -> Bool
forall k. Enum k => k -> EnumSet k -> Bool
ES.member Point
p (Perception -> EnumSet Point
totalVisible Perception
per)
(actorsBlurb :: Text
actorsBlurb, mactorPronounAlive :: Maybe (Part, Bool)
mactorPronounAlive, actorsDesc :: Text
actorsDesc) <- Point -> LevelId -> m (Text, Maybe (Part, Bool), Text)
forall (m :: * -> *).
MonadClientUI m =>
Point -> LevelId -> m (Text, Maybe (Part, Bool), Text)
lookAtActors Point
p LevelId
lidV
(itemsBlurb :: Text
itemsBlurb, mperson :: Maybe Person
mperson) <- Bool
-> Point -> ActorId -> Maybe (Part, Bool) -> m (Text, Maybe Person)
forall (m :: * -> *).
MonadClientUI m =>
Bool
-> Point -> ActorId -> Maybe (Part, Bool) -> m (Text, Maybe Person)
lookAtItems Bool
canSee Point
p ActorId
leader Maybe (Part, Bool)
mactorPronounAlive
let tperson :: Maybe Person
tperson = if Text -> Bool
T.null Text
itemsBlurb then Maybe Person
forall a. Maybe a
Nothing else Maybe Person
mperson
(tileBlurb :: Text
tileBlurb, placeBlurb :: Text
placeBlurb, embedsList :: [(Int, Part)]
embedsList) <- Bool
-> Point
-> ActorId
-> LevelId
-> Maybe Person
-> m (Text, Text, [(Int, Part)])
forall (m :: * -> *).
MonadClientUI m =>
Bool
-> Point
-> ActorId
-> LevelId
-> Maybe Person
-> m (Text, Text, [(Int, Part)])
lookAtTile Bool
canSee Point
p ActorId
leader LevelId
lidV Maybe Person
tperson
[(ActorId, Actor)]
inhabitants <- (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)])
-> (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
forall a b. (a -> b) -> a -> b
$ Point -> LevelId -> State -> [(ActorId, Actor)]
posToAidAssocs Point
p LevelId
lidV
let actorMsgClass :: MsgClassShow
actorMsgClass =
if (Actor -> FactionId
bfid (Actor -> FactionId)
-> ((ActorId, Actor) -> Actor) -> (ActorId, Actor) -> FactionId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ActorId, Actor) -> Actor
forall a b. (a, b) -> b
snd ((ActorId, Actor) -> FactionId)
-> [(ActorId, Actor)] -> [FactionId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(ActorId, Actor)]
inhabitants) [FactionId] -> [FactionId] -> Bool
forall a. Eq a => a -> a -> Bool
== [FactionId
side]
then MsgClassShow
MsgPromptGeneric
else MsgClassShow
MsgPromptActors
Text
stashBlurb <- LevelId -> Point -> m Text
forall (m :: * -> *). MonadClientUI m => LevelId -> Point -> m Text
lookAtStash LevelId
lidV Point
p
lvl :: Level
lvl@Level{SmellMap
lsmell :: Level -> SmellMap
lsmell :: SmellMap
lsmell, Time
ltime :: Level -> Time
ltime :: Time
ltime} <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel LevelId
lidV
Maybe AimMode
saimMode <- (SessionUI -> Maybe AimMode) -> m (Maybe AimMode)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe AimMode
saimMode
let detail :: DetailLevel
detail = DetailLevel
-> (AimMode -> DetailLevel) -> Maybe AimMode -> DetailLevel
forall b a. b -> (a -> b) -> Maybe a -> b
maybe DetailLevel
DetailAll AimMode -> DetailLevel
detailLevel Maybe AimMode
saimMode
smellBlurb :: Text
smellBlurb = case Point -> SmellMap -> Maybe Time
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup Point
p SmellMap
lsmell of
Just sml :: Time
sml | Time
sml Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
> Time
ltime ->
let Delta t :: Time
t = Delta Time
smellTimeout Delta Time -> Delta Time -> Delta Time
`timeDeltaSubtract`
(Time
sml Time -> Time -> Delta Time
`timeDeltaToFrom` Time
ltime)
seconds :: Int
seconds = Time
t Time -> Time -> Int
`timeFitUp` Time
timeSecond
in "A smelly body passed here around" Text -> Text -> Text
<+> Int -> Text
forall a. Show a => a -> Text
tshow Int
seconds Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "s ago."
_ -> ""
ItemBag
embeds <- (State -> ItemBag) -> m ItemBag
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemBag) -> m ItemBag)
-> (State -> ItemBag) -> m ItemBag
forall a b. (a -> b) -> a -> b
$ LevelId -> Point -> State -> ItemBag
getEmbedBag LevelId
lidV Point
p
ItemId -> ItemKind
getKind <- (State -> ItemId -> ItemKind) -> m (ItemId -> ItemKind)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemId -> ItemKind) -> m (ItemId -> ItemKind))
-> (State -> ItemId -> ItemKind) -> m (ItemId -> ItemKind)
forall a b. (a -> b) -> a -> b
$ (ItemId -> State -> ItemKind) -> State -> ItemId -> ItemKind
forall a b c. (a -> b -> c) -> b -> a -> c
flip ItemId -> State -> ItemKind
getIidKind
let ppEmbedName :: (Int, MU.Part) -> Text
ppEmbedName :: (Int, Part) -> Text
ppEmbedName (k :: Int
k, part :: Part
part) =
let verb :: Part
verb = if Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 then "is" else "are"
in [Part] -> Text
makeSentence ["There", Part
verb, Part
part]
embedKindList :: [(ItemKind, (ItemId, ItemQuant))]
embedKindList = ((ItemId, ItemQuant) -> (ItemKind, (ItemId, ItemQuant)))
-> [(ItemId, ItemQuant)] -> [(ItemKind, (ItemId, ItemQuant))]
forall a b. (a -> b) -> [a] -> [b]
map (\(iid :: ItemId
iid, kit :: ItemQuant
kit) -> (ItemId -> ItemKind
getKind ItemId
iid, (ItemId
iid, ItemQuant
kit)))
(ItemBag -> [(ItemId, ItemQuant)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs ItemBag
embeds)
feats :: [Feature]
feats = TileKind -> [Feature]
TK.tfeature (TileKind -> [Feature]) -> TileKind -> [Feature]
forall a b. (a -> b) -> a -> b
$ ContentData TileKind -> ContentId TileKind -> TileKind
forall a. ContentData a -> ContentId a -> a
okind ContentData TileKind
cotile (ContentId TileKind -> TileKind) -> ContentId TileKind -> TileKind
forall a b. (a -> b) -> a -> b
$ Level
lvl Level -> Point -> ContentId TileKind
`at` Point
p
tileActions :: [TileAction]
tileActions = (Feature -> Maybe TileAction) -> [Feature] -> [TileAction]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Bool
-> Bool
-> [(ItemKind, (ItemId, ItemQuant))]
-> Feature
-> Maybe TileAction
Tile.parseTileAction Bool
False Bool
False [(ItemKind, (ItemId, ItemQuant))]
embedKindList)
[Feature]
feats
isEmbedAction :: TileAction -> Bool
isEmbedAction Tile.EmbedAction{} = Bool
True
isEmbedAction _ = Bool
False
embedVerb :: [Part]
embedVerb = [ "activated"
| (TileAction -> Bool) -> [TileAction] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any TileAction -> Bool
isEmbedAction [TileAction]
tileActions
Bool -> Bool -> Bool
&& ((ItemKind, (ItemId, ItemQuant)) -> Bool)
-> [(ItemKind, (ItemId, ItemQuant))] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\(itemKind :: ItemKind
itemKind, _) -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Effect] -> Bool
forall a. [a] -> Bool
null ([Effect] -> Bool) -> [Effect] -> Bool
forall a b. (a -> b) -> a -> b
$ ItemKind -> [Effect]
IK.ieffects ItemKind
itemKind)
[(ItemKind, (ItemId, ItemQuant))]
embedKindList ]
isToAction :: TileAction -> Bool
isToAction Tile.ToAction{} = Bool
True
isToAction _ = Bool
False
isWithAction :: TileAction -> Bool
isWithAction Tile.WithAction{} = Bool
True
isWithAction _ = Bool
False
isEmptyWithAction :: TileAction -> Bool
isEmptyWithAction (Tile.WithAction [] _) = Bool
True
isEmptyWithAction _ = Bool
False
alterVerb :: [Part]
alterVerb | (TileAction -> Bool) -> [TileAction] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any TileAction -> Bool
isEmptyWithAction [TileAction]
tileActions = ["very easily modified"]
| (TileAction -> Bool) -> [TileAction] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any TileAction -> Bool
isToAction [TileAction]
tileActions = ["easily modified"]
| (TileAction -> Bool) -> [TileAction] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any TileAction -> Bool
isWithAction [TileAction]
tileActions = ["potentially modified"]
| Bool
otherwise = []
verbs :: [Part]
verbs = [Part]
embedVerb [Part] -> [Part] -> [Part]
forall a. [a] -> [a] -> [a]
++ [Part]
alterVerb
alterBlurb :: Text
alterBlurb = if [Part] -> Bool
forall a. [a] -> Bool
null [Part]
verbs
then ""
else [Part] -> Text
makeSentence ["can be", [Part] -> Part
MU.WWandW [Part]
verbs]
toolFromAction :: TileAction -> Maybe [(Int, GroupName ItemKind)]
toolFromAction (Tile.WithAction grps :: [(Int, GroupName ItemKind)]
grps _) = [(Int, GroupName ItemKind)] -> Maybe [(Int, GroupName ItemKind)]
forall a. a -> Maybe a
Just [(Int, GroupName ItemKind)]
grps
toolFromAction _ = Maybe [(Int, GroupName ItemKind)]
forall a. Maybe a
Nothing
toolsToAlterWith :: [[(Int, GroupName ItemKind)]]
toolsToAlterWith = (TileAction -> Maybe [(Int, GroupName ItemKind)])
-> [TileAction] -> [[(Int, GroupName ItemKind)]]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe TileAction -> Maybe [(Int, GroupName ItemKind)]
toolFromAction [TileAction]
tileActions
tItems :: Text
tItems = [[(Int, GroupName ItemKind)]] -> Text
describeToolsAlternative [[(Int, GroupName ItemKind)]]
toolsToAlterWith
transformBlurb :: Text
transformBlurb = if Text -> Bool
T.null Text
tItems
then ""
else "The following items on the ground or in equipment enable special transformations:"
Text -> Text -> Text
<+> Text
tItems Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "."
modifyBlurb :: Text
modifyBlurb = Text
alterBlurb Text -> Text -> Text
<+> Text
transformBlurb
midEOL :: Text
midEOL = if DetailLevel
detail DetailLevel -> DetailLevel -> Bool
forall a. Ord a => a -> a -> Bool
< DetailLevel
DetailHigh
Bool -> Bool -> Bool
|| Text -> Bool
T.null Text
stashBlurb Bool -> Bool -> Bool
&& Text -> Bool
T.null Text
actorsDesc
Bool -> Bool -> Bool
|| Text -> Bool
T.null Text
smellBlurb Bool -> Bool -> Bool
&& Text -> Bool
T.null Text
itemsBlurb
Bool -> Bool -> Bool
|| [(Int, Part)] -> Bool
forall a. [a] -> Bool
null [(Int, Part)]
embedsList Bool -> Bool -> Bool
&& Text -> Bool
T.null Text
modifyBlurb
then ""
else "\n"
ms :: [(MsgClassShow, Text)]
ms = [ (MsgClassShow
MsgPromptAction, Text
stashBlurb)
, (MsgClassShow
actorMsgClass, Text
actorsBlurb)
, (MsgClassShow
MsgPromptGeneric, Text
actorsDesc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
midEOL) ]
[(MsgClassShow, Text)]
-> [(MsgClassShow, Text)] -> [(MsgClassShow, Text)]
forall a. [a] -> [a] -> [a]
++ [(MsgClassShow
MsgPromptGeneric, Text
smellBlurb) | DetailLevel
detail DetailLevel -> DetailLevel -> Bool
forall a. Ord a => a -> a -> Bool
>= DetailLevel
DetailHigh]
[(MsgClassShow, Text)]
-> [(MsgClassShow, Text)] -> [(MsgClassShow, Text)]
forall a. [a] -> [a] -> [a]
++ [(MsgClassShow
MsgPromptItems, Text
itemsBlurb Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
midEOL)]
[(MsgClassShow, Text)]
-> [(MsgClassShow, Text)] -> [(MsgClassShow, Text)]
forall a. [a] -> [a] -> [a]
++ [(MsgClassShow
MsgPromptFocus, Text
tileBlurb) | DetailLevel
detail DetailLevel -> DetailLevel -> Bool
forall a. Ord a => a -> a -> Bool
>= DetailLevel
DetailHigh
Bool -> Bool -> Bool
|| DetailLevel
detail DetailLevel -> DetailLevel -> Bool
forall a. Eq a => a -> a -> Bool
== DetailLevel
DetailMedium
Bool -> Bool -> Bool
&& Bool -> Bool
not ([(Int, Part)] -> Bool
forall a. [a] -> Bool
null [(Int, Part)]
embedsList)]
[(MsgClassShow, Text)]
-> [(MsgClassShow, Text)] -> [(MsgClassShow, Text)]
forall a. [a] -> [a] -> [a]
++ [(MsgClassShow
MsgPromptGeneric, Text
placeBlurb) | DetailLevel
detail DetailLevel -> DetailLevel -> Bool
forall a. Ord a => a -> a -> Bool
>= DetailLevel
DetailHigh]
[(MsgClassShow, Text)]
-> [(MsgClassShow, Text)] -> [(MsgClassShow, Text)]
forall a. [a] -> [a] -> [a]
++ case DetailLevel
detail of
DetailLow -> []
DetailMedium ->
[(MsgClassShow
MsgPromptMention, case [(Int, Part)]
embedsList of
[] -> ""
[(k :: Int
k, _)] ->
(Int, Part) -> Text
ppEmbedName (1, if Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1
then "an embedded item"
else "a stack of embedded items")
_ -> (Int, Part) -> Text
ppEmbedName (9, "some embedded items"))]
_ -> let n :: Int
n = [Int] -> Int
forall a. Num a => [a] -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ ((Int, Part) -> Int) -> [(Int, Part)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Part) -> Int
forall a b. (a, b) -> a
fst [(Int, Part)]
embedsList
wWandW :: Part
wWandW = [Part] -> Part
MU.WWandW ([Part] -> Part) -> [Part] -> Part
forall a b. (a -> b) -> a -> b
$ ((Int, Part) -> Part) -> [(Int, Part)] -> [Part]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Part) -> Part
forall a b. (a, b) -> b
snd [(Int, Part)]
embedsList
in [(MsgClassShow
MsgPromptMention, (Int, Part) -> Text
ppEmbedName (Int
n, Part
wWandW)) | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0]
[(MsgClassShow, Text)]
-> [(MsgClassShow, Text)] -> [(MsgClassShow, Text)]
forall a. [a] -> [a] -> [a]
++ [(MsgClassShow
MsgPromptModify, Text
modifyBlurb) | DetailLevel
detail DetailLevel -> DetailLevel -> Bool
forall a. Eq a => a -> a -> Bool
== DetailLevel
DetailAll]
[(MsgClassShow, Text)] -> m [(MsgClassShow, Text)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(MsgClassShow, Text)] -> m [(MsgClassShow, Text)])
-> [(MsgClassShow, Text)] -> m [(MsgClassShow, Text)]
forall a b. (a -> b) -> a -> b
$! if ((MsgClassShow, Text) -> Bool) -> [(MsgClassShow, Text)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Text -> Bool
T.null (Text -> Bool)
-> ((MsgClassShow, Text) -> Text) -> (MsgClassShow, Text) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MsgClassShow, Text) -> Text
forall a b. (a, b) -> b
snd) [(MsgClassShow, Text)]
ms Bool -> Bool -> Bool
&& DetailLevel
detail DetailLevel -> DetailLevel -> Bool
forall a. Ord a => a -> a -> Bool
> DetailLevel
DetailLow
then [(MsgClassShow
MsgPromptFocus, Text
tileBlurb)]
else [(MsgClassShow, Text)]
ms
displayItemLore :: (MonadClient m, MonadClientUI m)
=> ItemBag -> Int -> (ItemId -> ItemFull -> Int -> Text) -> Int
-> SingleItemSlots
-> m Bool
displayItemLore :: ItemBag
-> Int
-> (ItemId -> ItemFull -> Int -> Text)
-> Int
-> SingleItemSlots
-> m Bool
displayItemLore itemBag :: ItemBag
itemBag meleeSkill :: Int
meleeSkill promptFun :: ItemId -> ItemFull -> Int -> Text
promptFun slotIndex :: Int
slotIndex lSlots :: SingleItemSlots
lSlots = do
KM
km <- ItemBag
-> Int
-> (ItemId -> ItemFull -> Int -> Text)
-> Int
-> SingleItemSlots
-> Bool
-> m KM
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
ItemBag
-> Int
-> (ItemId -> ItemFull -> Int -> Text)
-> Int
-> SingleItemSlots
-> Bool
-> m KM
displayItemLorePointedAt ItemBag
itemBag Int
meleeSkill ItemId -> ItemFull -> Int -> Text
promptFun Int
slotIndex
SingleItemSlots
lSlots Bool
False
case KM -> Key
K.key KM
km of
K.Space -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
K.Esc -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
_ -> String -> m Bool
forall a. (?callStack::CallStack) => String -> a
error (String -> m Bool) -> String -> m Bool
forall a b. (a -> b) -> a -> b
$ "" String -> KM -> String
forall v. Show v => String -> v -> String
`showFailure` KM
km
displayItemLorePointedAt
:: (MonadClient m, MonadClientUI m)
=> ItemBag -> Int -> (ItemId -> ItemFull -> Int -> Text) -> Int
-> SingleItemSlots -> Bool
-> m K.KM
displayItemLorePointedAt :: ItemBag
-> Int
-> (ItemId -> ItemFull -> Int -> Text)
-> Int
-> SingleItemSlots
-> Bool
-> m KM
displayItemLorePointedAt itemBag :: ItemBag
itemBag meleeSkill :: Int
meleeSkill promptFun :: ItemId -> ItemFull -> Int -> Text
promptFun slotIndex :: Int
slotIndex
lSlots :: SingleItemSlots
lSlots addTilde :: Bool
addTilde = do
CCUI{coscreen :: CCUI -> ScreenContent
coscreen=ScreenContent{Int
rwidth :: Int
rwidth :: ScreenContent -> Int
rwidth, Int
rheight :: Int
rheight :: ScreenContent -> Int
rheight}} <- (SessionUI -> CCUI) -> m CCUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
LevelId
arena <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
getArenaUI
let lSlotsElems :: [ItemId]
lSlotsElems = SingleItemSlots -> [ItemId]
forall k a. EnumMap k a -> [a]
EM.elems SingleItemSlots
lSlots
lSlotsBound :: Int
lSlotsBound = [ItemId] -> Int
forall a. [a] -> Int
length [ItemId]
lSlotsElems Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1
iid2 :: ItemId
iid2 = [ItemId]
lSlotsElems [ItemId] -> Int -> ItemId
forall a. [a] -> Int -> a
!! Int
slotIndex
kit2 :: ItemQuant
kit2@(k :: Int
k, _) = ItemBag
itemBag ItemBag -> ItemId -> ItemQuant
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ItemId
iid2
ItemFull
itemFull2 <- (State -> ItemFull) -> m ItemFull
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemFull) -> m ItemFull)
-> (State -> ItemFull) -> m ItemFull
forall a b. (a -> b) -> a -> b
$ ItemId -> State -> ItemFull
itemToFull ItemId
iid2
Time
localTime <- (State -> Time) -> m Time
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Time) -> m Time) -> (State -> Time) -> m Time
forall a b. (a -> b) -> a -> b
$ LevelId -> State -> Time
getLocalTime LevelId
arena
EnumMap FactionId Faction
factionD <- (State -> EnumMap FactionId Faction)
-> m (EnumMap FactionId Faction)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> EnumMap FactionId Faction
sfactionD
LevelId
jlid <- (SessionUI -> LevelId) -> m LevelId
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession ((SessionUI -> LevelId) -> m LevelId)
-> (SessionUI -> LevelId) -> m LevelId
forall a b. (a -> b) -> a -> b
$ LevelId -> Maybe LevelId -> LevelId
forall a. a -> Maybe a -> a
fromMaybe (Int -> LevelId
forall a. Enum a => Int -> a
toEnum 0) (Maybe LevelId -> LevelId)
-> (SessionUI -> Maybe LevelId) -> SessionUI -> LevelId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ItemId -> EnumMap ItemId LevelId -> Maybe LevelId
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup ItemId
iid2 (EnumMap ItemId LevelId -> Maybe LevelId)
-> (SessionUI -> EnumMap ItemId LevelId)
-> SessionUI
-> Maybe LevelId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessionUI -> EnumMap ItemId LevelId
sitemUI
FontSetup{..} <- m FontSetup
forall (m :: * -> *). MonadClientUI m => m FontSetup
getFontSetup
let descAl :: AttrString
descAl = Int
-> Bool
-> FactionId
-> EnumMap FactionId Faction
-> Int
-> CStore
-> Time
-> LevelId
-> ItemFull
-> ItemQuant
-> AttrString
itemDesc Int
rwidth Bool
True FactionId
side EnumMap FactionId Faction
factionD Int
meleeSkill
CStore
CGround Time
localTime LevelId
jlid ItemFull
itemFull2 ItemQuant
kit2
(descSymAl :: AttrString
descSymAl, descBlurbAl :: AttrString
descBlurbAl) = (AttrCharW32 -> Bool) -> AttrString -> (AttrString, AttrString)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (AttrCharW32 -> AttrCharW32 -> Bool
forall a. Eq a => a -> a -> Bool
/= AttrCharW32
Color.spaceAttrW32) AttrString
descAl
descSym :: Overlay
descSym = [AttrLine] -> Overlay
offsetOverlay ([AttrLine] -> Overlay) -> [AttrLine] -> Overlay
forall a b. (a -> b) -> a -> b
$ Int -> Int -> AttrString -> [AttrLine]
splitAttrString Int
rwidth Int
rwidth AttrString
descSymAl
descBlurb :: Overlay
descBlurb = [(Int, AttrLine)] -> Overlay
offsetOverlayX ([(Int, AttrLine)] -> Overlay) -> [(Int, AttrLine)] -> Overlay
forall a b. (a -> b) -> a -> b
$
case Int -> Int -> AttrString -> [AttrLine]
splitAttrString Int
rwidth Int
rwidth (AttrString -> [AttrLine]) -> AttrString -> [AttrLine]
forall a b. (a -> b) -> a -> b
$ String -> AttrString
stringToAS "xx" AttrString -> AttrString -> AttrString
forall a. [a] -> [a] -> [a]
++ AttrString
descBlurbAl of
[] -> String -> [(Int, AttrLine)]
forall a. (?callStack::CallStack) => String -> a
error "splitting AttrString loses characters"
al1 :: AttrLine
al1 : rest :: [AttrLine]
rest ->
(2, AttrString -> AttrLine
attrStringToAL (AttrString -> AttrLine) -> AttrString -> AttrLine
forall a b. (a -> b) -> a -> b
$ Int -> AttrString -> AttrString
forall a. Int -> [a] -> [a]
drop 2 (AttrString -> AttrString) -> AttrString -> AttrString
forall a b. (a -> b) -> a -> b
$ AttrLine -> AttrString
attrLine AttrLine
al1) (Int, AttrLine) -> [(Int, AttrLine)] -> [(Int, AttrLine)]
forall a. a -> [a] -> [a]
: (AttrLine -> (Int, AttrLine)) -> [AttrLine] -> [(Int, AttrLine)]
forall a b. (a -> b) -> [a] -> [b]
map (0,) [AttrLine]
rest
ov :: EnumMap DisplayFont Overlay
ov = (Overlay -> Overlay -> Overlay)
-> DisplayFont
-> Overlay
-> EnumMap DisplayFont Overlay
-> EnumMap DisplayFont Overlay
forall k a.
Enum k =>
(a -> a -> a) -> k -> a -> EnumMap k a -> EnumMap k a
EM.insertWith Overlay -> Overlay -> Overlay
forall a. [a] -> [a] -> [a]
(++) DisplayFont
squareFont Overlay
descSym
(EnumMap DisplayFont Overlay -> EnumMap DisplayFont Overlay)
-> EnumMap DisplayFont Overlay -> EnumMap DisplayFont Overlay
forall a b. (a -> b) -> a -> b
$ DisplayFont -> Overlay -> EnumMap DisplayFont Overlay
forall k a. Enum k => k -> a -> EnumMap k a
EM.singleton DisplayFont
propFont Overlay
descBlurb
keys :: [KM]
keys = [KM
K.spaceKM, KM
K.escKM]
[KM] -> [KM] -> [KM]
forall a. [a] -> [a] -> [a]
++ [Char -> KM
K.mkChar '~' | Bool
addTilde]
[KM] -> [KM] -> [KM]
forall a. [a] -> [a] -> [a]
++ [KM
K.upKM | Int
slotIndex Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= 0]
[KM] -> [KM] -> [KM]
forall a. [a] -> [a] -> [a]
++ [KM
K.downKM | Int
slotIndex Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
lSlotsBound]
MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgPromptGeneric (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ ItemId -> ItemFull -> Int -> Text
promptFun ItemId
iid2 ItemFull
itemFull2 Int
k
Slideshow
slides <- Int -> [KM] -> OKX -> m Slideshow
forall (m :: * -> *).
MonadClientUI m =>
Int -> [KM] -> OKX -> m Slideshow
overlayToSlideshow (Int
rheight Int -> Int -> Int
forall a. Num a => a -> a -> a
- 2) [KM]
keys (EnumMap DisplayFont Overlay
ov, [])
KM
km <- ColorMode -> [KM] -> Slideshow -> m KM
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
ColorMode -> [KM] -> Slideshow -> m KM
getConfirms ColorMode
ColorFull [KM]
keys Slideshow
slides
case KM -> Key
K.key KM
km of
K.Up ->
ItemBag
-> Int
-> (ItemId -> ItemFull -> Int -> Text)
-> Int
-> SingleItemSlots
-> Bool
-> m KM
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
ItemBag
-> Int
-> (ItemId -> ItemFull -> Int -> Text)
-> Int
-> SingleItemSlots
-> Bool
-> m KM
displayItemLorePointedAt ItemBag
itemBag Int
meleeSkill ItemId -> ItemFull -> Int -> Text
promptFun (Int
slotIndex Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1)
SingleItemSlots
lSlots Bool
addTilde
K.Down ->
ItemBag
-> Int
-> (ItemId -> ItemFull -> Int -> Text)
-> Int
-> SingleItemSlots
-> Bool
-> m KM
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
ItemBag
-> Int
-> (ItemId -> ItemFull -> Int -> Text)
-> Int
-> SingleItemSlots
-> Bool
-> m KM
displayItemLorePointedAt ItemBag
itemBag Int
meleeSkill ItemId -> ItemFull -> Int -> Text
promptFun (Int
slotIndex Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1)
SingleItemSlots
lSlots Bool
addTilde
_ -> KM -> m KM
forall (m :: * -> *) a. Monad m => a -> m a
return KM
km
viewLoreItems :: (MonadClient m, MonadClientUI m)
=> String -> SingleItemSlots -> ItemBag -> Text
-> (Int -> SingleItemSlots -> m Bool) -> Bool
-> m K.KM
viewLoreItems :: String
-> SingleItemSlots
-> ItemBag
-> Text
-> (Int -> SingleItemSlots -> m Bool)
-> Bool
-> m KM
viewLoreItems menuName :: String
menuName lSlotsRaw :: SingleItemSlots
lSlotsRaw trunkBag :: ItemBag
trunkBag prompt :: Text
prompt examItem :: Int -> SingleItemSlots -> m Bool
examItem displayRanged :: Bool
displayRanged = do
CCUI{coscreen :: CCUI -> ScreenContent
coscreen=ScreenContent{Int
rheight :: Int
rheight :: ScreenContent -> Int
rheight}} <- (SessionUI -> CCUI) -> m CCUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
LevelId
arena <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
getArenaUI
ItemId -> ItemFull
itemToF <- (State -> ItemId -> ItemFull) -> m (ItemId -> ItemFull)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemId -> ItemFull) -> m (ItemId -> ItemFull))
-> (State -> ItemId -> ItemFull) -> m (ItemId -> ItemFull)
forall a b. (a -> b) -> a -> b
$ (ItemId -> State -> ItemFull) -> State -> ItemId -> ItemFull
forall a b c. (a -> b -> c) -> b -> a -> c
flip ItemId -> State -> ItemFull
itemToFull
let keysPre :: [KM]
keysPre = [KM
K.spaceKM, Char -> KM
K.mkChar '<', Char -> KM
K.mkChar '>', KM
K.escKM]
lSlots :: SingleItemSlots
lSlots = (ItemId -> ItemFull) -> SingleItemSlots -> SingleItemSlots
sortSlotMap ItemId -> ItemFull
itemToF SingleItemSlots
lSlotsRaw
MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgPromptGeneric Text
prompt
OKX
io <- SingleItemSlots -> LevelId -> ItemBag -> Bool -> m OKX
forall (m :: * -> *).
MonadClientUI m =>
SingleItemSlots -> LevelId -> ItemBag -> Bool -> m OKX
itemOverlay SingleItemSlots
lSlots LevelId
arena ItemBag
trunkBag Bool
displayRanged
Slideshow
itemSlides <- Int -> [KM] -> OKX -> m Slideshow
forall (m :: * -> *).
MonadClientUI m =>
Int -> [KM] -> OKX -> m Slideshow
overlayToSlideshow (Int
rheight Int -> Int -> Int
forall a. Num a => a -> a -> a
- 2) [KM]
keysPre OKX
io
let keyOfEKM :: Either [KM] SlotChar -> [KM]
keyOfEKM (Left km :: [KM]
km) = [KM]
km
keyOfEKM (Right SlotChar{Char
slotChar :: SlotChar -> Char
slotChar :: Char
slotChar}) = [Char -> KM
K.mkChar Char
slotChar]
allOKX :: [(Either [KM] SlotChar, (PointUI, ButtonWidth))]
allOKX = (OKX -> [(Either [KM] SlotChar, (PointUI, ButtonWidth))])
-> [OKX] -> [(Either [KM] SlotChar, (PointUI, ButtonWidth))]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap OKX -> [(Either [KM] SlotChar, (PointUI, ButtonWidth))]
forall a b. (a, b) -> b
snd ([OKX] -> [(Either [KM] SlotChar, (PointUI, ButtonWidth))])
-> [OKX] -> [(Either [KM] SlotChar, (PointUI, ButtonWidth))]
forall a b. (a -> b) -> a -> b
$ Slideshow -> [OKX]
slideshow Slideshow
itemSlides
keysMain :: [KM]
keysMain = [KM]
keysPre [KM] -> [KM] -> [KM]
forall a. [a] -> [a] -> [a]
++ ((Either [KM] SlotChar, (PointUI, ButtonWidth)) -> [KM])
-> [(Either [KM] SlotChar, (PointUI, ButtonWidth))] -> [KM]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Either [KM] SlotChar -> [KM]
keyOfEKM (Either [KM] SlotChar -> [KM])
-> ((Either [KM] SlotChar, (PointUI, ButtonWidth))
-> Either [KM] SlotChar)
-> (Either [KM] SlotChar, (PointUI, ButtonWidth))
-> [KM]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either [KM] SlotChar, (PointUI, ButtonWidth))
-> Either [KM] SlotChar
forall a b. (a, b) -> a
fst) [(Either [KM] SlotChar, (PointUI, ButtonWidth))]
allOKX
viewAtSlot :: SlotChar -> m KM
viewAtSlot slot :: SlotChar
slot = do
let ix0 :: Int
ix0 = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe (String -> Int
forall a. (?callStack::CallStack) => String -> a
error (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ SlotChar -> String
forall a. Show a => a -> String
show SlotChar
slot)
((SlotChar -> Bool) -> [SlotChar] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex (SlotChar -> SlotChar -> Bool
forall a. Eq a => a -> a -> Bool
== SlotChar
slot) ([SlotChar] -> Maybe Int) -> [SlotChar] -> Maybe Int
forall a b. (a -> b) -> a -> b
$ SingleItemSlots -> [SlotChar]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys SingleItemSlots
lSlots)
Bool
go2 <- Int -> SingleItemSlots -> m Bool
examItem Int
ix0 SingleItemSlots
lSlots
if Bool
go2
then String
-> SingleItemSlots
-> ItemBag
-> Text
-> (Int -> SingleItemSlots -> m Bool)
-> Bool
-> m KM
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
String
-> SingleItemSlots
-> ItemBag
-> Text
-> (Int -> SingleItemSlots -> m Bool)
-> Bool
-> m KM
viewLoreItems String
menuName SingleItemSlots
lSlots ItemBag
trunkBag Text
prompt
Int -> SingleItemSlots -> m Bool
examItem Bool
displayRanged
else KM -> m KM
forall (m :: * -> *) a. Monad m => a -> m a
return KM
K.escKM
Either KM SlotChar
ekm <- String
-> ColorMode -> Bool -> Slideshow -> [KM] -> m (Either KM SlotChar)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
String
-> ColorMode -> Bool -> Slideshow -> [KM] -> m (Either KM SlotChar)
displayChoiceScreen String
menuName ColorMode
ColorFull Bool
False Slideshow
itemSlides [KM]
keysMain
case Either KM SlotChar
ekm of
Left km :: KM
km | KM
km KM -> [KM] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [KM
K.spaceKM, Char -> KM
K.mkChar '<', Char -> KM
K.mkChar '>', KM
K.escKM] ->
KM -> m KM
forall (m :: * -> *) a. Monad m => a -> m a
return KM
km
Left K.KM{key :: KM -> Key
key=K.Char l :: Char
l} -> SlotChar -> m KM
viewAtSlot (SlotChar -> m KM) -> SlotChar -> m KM
forall a b. (a -> b) -> a -> b
$ Int -> Char -> SlotChar
SlotChar 0 Char
l
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 the spoils of your team are of the practical kind."
| Int
total Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 -> "Your team haven't found any genuine treasure yet."
| Bool
otherwise -> [Part] -> Text
makeSentence
[ "your team's spoils are worth"
, Int -> Part -> Part
MU.CarAWs Int
total (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ Text -> Part
MU.Text Text
currencyName
, "out of the rumoured total"
, Int -> Part
MU.Cardinal Int
dungeonTotal ]
ppContainerWownW :: MonadClientUI m
=> (ActorId -> m MU.Part) -> Bool -> Container -> m [MU.Part]
ppContainerWownW :: (ActorId -> m Part) -> Bool -> Container -> m [Part]
ppContainerWownW ownerFun :: ActorId -> m Part
ownerFun addPrepositions :: Bool
addPrepositions c :: Container
c = case Container
c of
CFloor{} -> [Part] -> m [Part]
forall (m :: * -> *) a. Monad m => a -> m a
return ["nearby"]
CEmbed{} -> [Part] -> m [Part]
forall (m :: * -> *) a. Monad m => a -> m a
return ["embedded nearby"]
CActor aid :: ActorId
aid store :: CStore
store -> do
FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
Part
owner <- ActorId -> m Part
ownerFun ActorId
aid
Text
fidName <- (State -> Text) -> m Text
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Text) -> m Text) -> (State -> Text) -> m Text
forall a b. (a -> b) -> a -> b
$ Faction -> Text
gname (Faction -> Text) -> (State -> Faction) -> State -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
b) (EnumMap FactionId Faction -> Faction)
-> (State -> EnumMap FactionId Faction) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap FactionId Faction
sfactionD
let (preposition :: Text
preposition, noun :: Text
noun) = CStore -> (Text, Text)
ppCStore CStore
store
prep :: [Part]
prep = [Text -> Part
MU.Text Text
preposition | Bool
addPrepositions]
[Part] -> m [Part]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Part] -> m [Part]) -> [Part] -> m [Part]
forall a b. (a -> b) -> a -> b
$! [Part]
prep [Part] -> [Part] -> [Part]
forall a. [a] -> [a] -> [a]
++ case CStore
store of
CGround -> Text -> Part
MU.Text Text
noun Part -> [Part] -> [Part]
forall a. a -> [a] -> [a]
: if Actor -> Bool
bproj Actor
b then [] else ["under", Part
owner]
CStash -> if Actor -> FactionId
bfid Actor
b FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
/= FactionId
side
then [Part -> Part -> Part
MU.WownW (Text -> Part
MU.Text Text
fidName) (Text -> Part
MU.Text Text
noun)]
else [Text -> Part
MU.Text Text
noun]
_ -> [Part -> Part -> Part
MU.WownW Part
owner (Text -> Part
MU.Text Text
noun)]
CTrunk{} -> String -> m [Part]
forall a. (?callStack::CallStack) => String -> a
error (String -> m [Part]) -> String -> m [Part]
forall a b. (a -> b) -> a -> b
$ "" String -> Container -> String
forall v. Show v => String -> v -> String
`showFailure` Container
c
nxtGameMode :: COps -> Int -> (ContentId MK.ModeKind, MK.ModeKind)
nxtGameMode :: COps -> Int -> (ContentId ModeKind, ModeKind)
nxtGameMode COps{ContentData ModeKind
comode :: ContentData ModeKind
comode :: COps -> ContentData ModeKind
comode} snxtScenario :: Int
snxtScenario =
let f :: [(a, b)] -> p -> a -> b -> [(a, b)]
f ![(a, b)]
acc _p :: p
_p !a
i !b
a = (a
i, b
a) (a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
: [(a, b)]
acc
campaignModes :: [(ContentId ModeKind, ModeKind)]
campaignModes = ContentData ModeKind
-> GroupName ModeKind
-> ([(ContentId ModeKind, ModeKind)]
-> Int
-> ContentId ModeKind
-> ModeKind
-> [(ContentId ModeKind, ModeKind)])
-> [(ContentId ModeKind, ModeKind)]
-> [(ContentId ModeKind, ModeKind)]
forall a b.
ContentData a
-> GroupName a -> (b -> Int -> ContentId a -> a -> b) -> b -> b
ofoldlGroup' ContentData ModeKind
comode GroupName ModeKind
MK.CAMPAIGN_SCENARIO [(ContentId ModeKind, ModeKind)]
-> Int
-> ContentId ModeKind
-> ModeKind
-> [(ContentId ModeKind, ModeKind)]
forall a b p. [(a, b)] -> p -> a -> b -> [(a, b)]
f []
in [(ContentId ModeKind, ModeKind)]
campaignModes [(ContentId ModeKind, ModeKind)]
-> Int -> (ContentId ModeKind, ModeKind)
forall a. [a] -> Int -> a
!! (Int
snxtScenario Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` [(ContentId ModeKind, ModeKind)] -> Int
forall a. [a] -> Int
length [(ContentId ModeKind, ModeKind)]
campaignModes)