module Game.LambdaHack.Client.UI.HandleHelperM
( FailError, showFailError, MError, mergeMError, FailOrCmd, failWith
, failSer, failMsg, weaveJust
, pointmanCycle, pointmanCycleLevel, partyAfterLeader
, pickLeader, doLook, pickLeaderWithPointer
, itemOverlay, skillsOverlay, placesFromState, placesOverlay
, factionsFromState, factionsOverlay
, describeMode, modesOverlay
, pickNumber, guardItemSize, lookAtItems, lookAtStash, lookAtPosition
, displayOneMenuItem, okxItemLoreInline, okxItemLoreMsg, itemDescOverlays
, cycleLore, spoilsBlurb, ppContainerWownW, nxtGameMode
#ifdef EXPOSE_INTERNAL
, itemOverlayFromState, lookAtTile, lookAtActors, guardItemVerbs
#endif
) where
import Prelude ()
import Game.LambdaHack.Core.Prelude
import Control.Applicative
import qualified Data.Char as Char
import qualified Data.EnumMap.Strict as EM
import qualified Data.EnumSet as ES
import qualified Data.Map.Strict as M
import qualified Data.Text as T
import qualified NLP.Miniutter.English as MU
import Game.LambdaHack.Client.CommonM
import Game.LambdaHack.Client.MonadClient
import Game.LambdaHack.Client.State
import Game.LambdaHack.Client.UI.ActorUI
import Game.LambdaHack.Client.UI.Content.Screen
import Game.LambdaHack.Client.UI.ContentClientUI
import Game.LambdaHack.Client.UI.EffectDescription
import Game.LambdaHack.Client.UI.Frame
import Game.LambdaHack.Client.UI.ItemDescription
import qualified Game.LambdaHack.Client.UI.Key as K
import Game.LambdaHack.Client.UI.MonadClientUI
import Game.LambdaHack.Client.UI.Msg
import Game.LambdaHack.Client.UI.MsgM
import Game.LambdaHack.Client.UI.Overlay
import Game.LambdaHack.Client.UI.PointUI
import Game.LambdaHack.Client.UI.SessionUI
import Game.LambdaHack.Client.UI.Slideshow
import Game.LambdaHack.Client.UI.SlideshowM
import Game.LambdaHack.Common.Actor
import Game.LambdaHack.Common.ActorState
import Game.LambdaHack.Common.ClientOptions
import Game.LambdaHack.Common.Faction
import qualified Game.LambdaHack.Common.HighScore as HighScore
import Game.LambdaHack.Common.Item
import qualified Game.LambdaHack.Common.ItemAspect as IA
import Game.LambdaHack.Common.Kind
import Game.LambdaHack.Common.Level
import Game.LambdaHack.Common.Misc
import Game.LambdaHack.Common.MonadStateRead
import Game.LambdaHack.Common.Perception
import Game.LambdaHack.Common.Point
import Game.LambdaHack.Common.ReqFailure
import Game.LambdaHack.Common.State
import Game.LambdaHack.Common.Time
import Game.LambdaHack.Common.Types
import qualified Game.LambdaHack.Content.FactionKind as FK
import qualified Game.LambdaHack.Content.ItemKind as IK
import qualified Game.LambdaHack.Content.ModeKind as MK
import qualified Game.LambdaHack.Content.PlaceKind as PK
import qualified Game.LambdaHack.Content.TileKind as TK
import qualified Game.LambdaHack.Definition.Ability as Ability
import qualified Game.LambdaHack.Definition.Color as Color
import Game.LambdaHack.Definition.Defs
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
$cshowsPrec :: Int -> FailError -> ShowS
showsPrec :: Int -> FailError -> ShowS
$cshow :: FailError -> String
show :: FailError -> String
$cshowList :: [FailError] -> ShowS
showList :: [FailError] -> ShowS
Show, FailError -> FailError -> Bool
(FailError -> FailError -> Bool)
-> (FailError -> FailError -> Bool) -> Eq FailError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FailError -> FailError -> Bool
== :: FailError -> FailError -> Bool
$c/= :: FailError -> FailError -> Bool
/= :: FailError -> FailError -> Bool
Eq)
showFailError :: FailError -> Text
showFailError :: FailError -> Text
showFailError (FailError Text
err) = Text
"*" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
err Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"*"
type MError = Maybe FailError
mergeMError :: MError -> MError -> MError
mergeMError :: MError -> MError -> MError
mergeMError MError
Nothing MError
Nothing = MError
forall a. Maybe a
Nothing
mergeMError merr1 :: MError
merr1@Just{} MError
Nothing = MError
merr1
mergeMError MError
Nothing merr2 :: MError
merr2@Just{} = MError
merr2
mergeMError (Just FailError
err1) (Just FailError
err2) =
FailError -> MError
forall a. a -> Maybe a
Just (FailError -> MError) -> FailError -> MError
forall a b. (a -> b) -> a -> b
$ Text -> FailError
FailError (Text -> FailError) -> Text -> FailError
forall a b. (a -> b) -> a -> b
$ FailError -> Text
failError FailError
err1 Text -> Text -> Text
<+> Text
"and" Text -> Text -> Text
<+> FailError -> Text
failError FailError
err2
type FailOrCmd a = Either FailError a
failWith :: MonadClientUI m => Text -> m (FailOrCmd a)
failWith :: forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith Text
err = Bool -> m (FailOrCmd a) -> m (FailOrCmd a)
forall a. HasCallStack => 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 a. a -> m 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 :: forall (m :: * -> *) a.
MonadClientUI m =>
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 :: forall (m :: * -> *). MonadClientUI m => Text -> m MError
failMsg Text
err = Bool -> m MError -> m MError
forall a. HasCallStack => 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 a. a -> m a
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 :: forall a. FailOrCmd a -> Either MError a
weaveJust (Left FailError
ferr) = MError -> Either MError a
forall a b. a -> Either a b
Left (MError -> Either MError a) -> MError -> Either MError a
forall a b. (a -> b) -> a -> b
$ FailError -> MError
forall a. a -> Maybe a
Just FailError
ferr
weaveJust (Right a
a) = a -> Either MError a
forall a b. b -> Either a b
Right a
a
pointmanCycleLevel :: MonadClientUI m
=> ActorId -> Bool -> Direction -> m MError
pointmanCycleLevel :: forall (m :: * -> *).
MonadClientUI m =>
ActorId -> Bool -> Direction -> m MError
pointmanCycleLevel ActorId
leader Bool
verbose Direction
direction = do
FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
Faction
fact <- (State -> Faction) -> m Faction
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
side) (EnumMap FactionId Faction -> Faction)
-> (State -> EnumMap FactionId Faction) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap FactionId Faction
sfactionD
LevelId
lidV <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
viewedLevelUI
Actor
body <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
leader
[(ActorId, Actor, ActorUI)]
hs <- ActorId -> m [(ActorId, Actor, ActorUI)]
forall (m :: * -> *).
MonadClientUI m =>
ActorId -> m [(ActorId, Actor, ActorUI)]
partyAfterLeader ActorId
leader
let banned :: Bool
banned = Faction -> Bool
bannedPointmanSwitchBetweenLevels Faction
fact
hsSort :: [(ActorId, Actor, ActorUI)]
hsSort = case Direction
direction of
Direction
Forward -> [(ActorId, Actor, ActorUI)]
hs
Direction
Backward -> [(ActorId, Actor, ActorUI)] -> [(ActorId, Actor, ActorUI)]
forall a. [a] -> [a]
reverse [(ActorId, Actor, ActorUI)]
hs
case ((ActorId, Actor, ActorUI) -> Bool)
-> [(ActorId, Actor, ActorUI)] -> [(ActorId, Actor, ActorUI)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(ActorId
_, Actor
b, ActorUI
_) -> Actor -> LevelId
blid Actor
b LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== LevelId
lidV) [(ActorId, Actor, ActorUI)]
hsSort of
[(ActorId, Actor, ActorUI)]
_ | Bool
banned Bool -> Bool -> Bool
&& LevelId
lidV LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
/= Actor -> LevelId
blid Actor
body ->
Text -> m MError
forall (m :: * -> *). MonadClientUI m => Text -> m MError
failMsg (Text -> m MError) -> Text -> m MError
forall a b. (a -> b) -> a -> b
$ ReqFailure -> Text
showReqFailure ReqFailure
NoChangeDunLeader
[] -> Text -> m MError
forall (m :: * -> *). MonadClientUI m => Text -> m MError
failMsg Text
"cannot pick any other pointman on this level"
(ActorId
np, Actor
_b, ActorUI
_) : [(ActorId, Actor, ActorUI)]
_ -> do
Bool
_success <- Bool -> ActorId -> m Bool
forall (m :: * -> *). MonadClientUI m => Bool -> ActorId -> m Bool
pickLeader Bool
verbose ActorId
np
MError -> m MError
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return MError
forall a. Maybe a
Nothing
pointmanCycle :: MonadClientUI m
=> ActorId -> Bool -> Direction -> m MError
pointmanCycle :: forall (m :: * -> *).
MonadClientUI m =>
ActorId -> Bool -> Direction -> m MError
pointmanCycle ActorId
leader Bool
verbose Direction
direction = do
FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
Faction
fact <- (State -> Faction) -> m Faction
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
side) (EnumMap FactionId Faction -> Faction)
-> (State -> EnumMap FactionId Faction) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap FactionId Faction
sfactionD
[(ActorId, Actor, ActorUI)]
hs <- ActorId -> m [(ActorId, Actor, ActorUI)]
forall (m :: * -> *).
MonadClientUI m =>
ActorId -> m [(ActorId, Actor, ActorUI)]
partyAfterLeader ActorId
leader
let banned :: Bool
banned = Faction -> Bool
bannedPointmanSwitchBetweenLevels Faction
fact
hsSort :: [(ActorId, Actor, ActorUI)]
hsSort = case Direction
direction of
Direction
Forward -> [(ActorId, Actor, ActorUI)]
hs
Direction
Backward -> [(ActorId, Actor, ActorUI)] -> [(ActorId, Actor, ActorUI)]
forall a. [a] -> [a]
reverse [(ActorId, Actor, ActorUI)]
hs
case [(ActorId, Actor, ActorUI)]
hsSort of
[(ActorId, Actor, ActorUI)]
_ | Bool
banned -> Text -> m MError
forall (m :: * -> *). MonadClientUI m => Text -> m MError
failMsg (Text -> m MError) -> Text -> m MError
forall a b. (a -> b) -> a -> b
$ ReqFailure -> Text
showReqFailure ReqFailure
NoChangeDunLeader
[] -> Text -> m MError
forall (m :: * -> *). MonadClientUI m => Text -> m MError
failMsg Text
"no other member in the party"
(ActorId
np, Actor
b, ActorUI
_) : [(ActorId, Actor, ActorUI)]
_ -> do
Bool
success <- Bool -> ActorId -> m Bool
forall (m :: * -> *). MonadClientUI m => Bool -> ActorId -> m Bool
pickLeader Bool
verbose ActorId
np
let !_A :: ()
_A = Bool -> () -> ()
forall a. HasCallStack => Bool -> a -> a
assert (Bool
success Bool -> (String, (ActorId, ActorId, Actor)) -> Bool
forall v. Show v => Bool -> v -> Bool
`blame` String
"same leader"
String
-> (ActorId, ActorId, Actor) -> (String, (ActorId, ActorId, Actor))
forall v. String -> v -> (String, v)
`swith` (ActorId
leader, ActorId
np, Actor
b)) ()
MError -> m MError
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return MError
forall a. Maybe a
Nothing
partyAfterLeader :: MonadClientUI m => ActorId -> m [(ActorId, Actor, ActorUI)]
partyAfterLeader :: forall (m :: * -> *).
MonadClientUI m =>
ActorId -> m [(ActorId, Actor, ActorUI)]
partyAfterLeader ActorId
leader = do
FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
ActorDictUI
sactorUI <- (SessionUI -> ActorDictUI) -> m ActorDictUI
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> ActorDictUI
sactorUI
[(ActorId, Actor)]
allOurs <- (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
forall a. (State -> a) -> m a
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 (\(ActorId
aid, Actor
b) -> (ActorId
aid, Actor
b, ActorDictUI
sactorUI ActorDictUI -> ActorId -> ActorUI
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ActorId
aid)) [(ActorId, Actor)]
allOurs
hs :: [(ActorId, Actor, ActorUI)]
hs = ((ActorId, Actor, ActorUI)
-> (Bool, Bool, Bool, Char, Color, ActorId))
-> [(ActorId, Actor, ActorUI)] -> [(ActorId, Actor, ActorUI)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (ActorId, Actor, ActorUI)
-> (Bool, Bool, Bool, Char, Color, ActorId)
keySelected [(ActorId, Actor, ActorUI)]
allOursUI
i :: Int
i = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe (-Int
1) (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ ((ActorId, Actor, ActorUI) -> Bool)
-> [(ActorId, Actor, ActorUI)] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex (\(ActorId
aid, Actor
_, ActorUI
_) -> ActorId
aid ActorId -> ActorId -> Bool
forall a. Eq a => a -> a -> Bool
== ActorId
leader) [(ActorId, Actor, ActorUI)]
hs
([(ActorId, Actor, ActorUI)]
lt, [(ActorId, Actor, ActorUI)]
gt) = (Int -> [(ActorId, Actor, ActorUI)] -> [(ActorId, Actor, ActorUI)]
forall a. Int -> [a] -> [a]
take Int
i [(ActorId, Actor, ActorUI)]
hs, Int -> [(ActorId, Actor, ActorUI)] -> [(ActorId, Actor, ActorUI)]
forall a. Int -> [a] -> [a]
drop (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [(ActorId, Actor, ActorUI)]
hs)
[(ActorId, Actor, ActorUI)] -> m [(ActorId, Actor, ActorUI)]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(ActorId, Actor, ActorUI)] -> m [(ActorId, Actor, ActorUI)])
-> [(ActorId, Actor, ActorUI)] -> m [(ActorId, Actor, ActorUI)]
forall a b. (a -> b) -> a -> b
$! [(ActorId, Actor, ActorUI)]
gt [(ActorId, Actor, ActorUI)]
-> [(ActorId, Actor, ActorUI)] -> [(ActorId, Actor, ActorUI)]
forall a. [a] -> [a] -> [a]
++ [(ActorId, Actor, ActorUI)]
lt
pickLeader :: MonadClientUI m => Bool -> ActorId -> m Bool
pickLeader :: forall (m :: * -> *). MonadClientUI m => Bool -> ActorId -> m Bool
pickLeader Bool
verbose ActorId
aid = do
Maybe ActorId
mleader <- (StateClient -> Maybe ActorId) -> m (Maybe ActorId)
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Maybe ActorId
sleader
if Maybe ActorId
mleader Maybe ActorId -> Maybe ActorId -> Bool
forall a. Eq a => a -> a -> Bool
== ActorId -> Maybe ActorId
forall a. a -> Maybe a
Just ActorId
aid
then Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
else do
Actor
body <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
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 a. (SessionUI -> a) -> m a
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. HasCallStack => Bool -> a -> a
assert (Bool -> Bool
not (Actor -> Bool
bproj Actor
body)
Bool -> (String, (ActorId, Actor)) -> Bool
forall v. Show v => Bool -> v -> Bool
`blame` String
"projectile chosen as the pointman"
String -> (ActorId, Actor) -> (String, (ActorId, Actor))
forall v. String -> v -> (String, v)
`swith` (ActorId
aid, Actor
body)) ()
let subject :: Part
subject = ActorUI -> Part
partActor ActorUI
bodyUI
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
verbose (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
MsgPointmanSwap (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ [Part] -> Text
makeSentence [Part
subject, Part
"picked as a pointman"]
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
$ \SessionUI
sess -> SessionUI
sess {saimMode =
(\AimMode
aimMode -> AimMode
aimMode {aimLevelId = blid body}) <$> saimMode sess}
Maybe AimMode
saimMode <- (SessionUI -> Maybe AimMode) -> m (Maybe AimMode)
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe AimMode
saimMode
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
verbose (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
if Maybe AimMode -> Bool
forall a. Maybe a -> Bool
isJust Maybe AimMode
saimMode
then m ()
forall (m :: * -> *). MonadClientUI m => m ()
doLook
else do
(Text
itemsBlurb, Maybe Person
_) <-
Bool
-> Point
-> LevelId
-> Maybe ActorId
-> Maybe (Part, Bool)
-> m (Text, Maybe Person)
forall (m :: * -> *).
MonadClientUI m =>
Bool
-> Point
-> LevelId
-> Maybe ActorId
-> Maybe (Part, Bool)
-> m (Text, Maybe Person)
lookAtItems Bool
True (Actor -> Point
bpos Actor
body) (Actor -> LevelId
blid Actor
body) (ActorId -> Maybe ActorId
forall a. a -> Maybe a
Just ActorId
aid) Maybe (Part, Bool)
forall a. Maybe a
Nothing
Text
stashBlurb <- Point -> LevelId -> m Text
forall (m :: * -> *). MonadClientUI m => Point -> LevelId -> m Text
lookAtStash (Actor -> Point
bpos Actor
body) (Actor -> LevelId
blid Actor
body)
MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
MsgAtFeetMinor (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
stashBlurb Text -> Text -> Text
<+> Text
itemsBlurb
Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
doLook :: MonadClientUI m => m ()
doLook :: forall (m :: * -> *). MonadClientUI m => m ()
doLook = do
Maybe AimMode
saimMode <- (SessionUI -> Maybe AimMode) -> m (Maybe AimMode)
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe AimMode
saimMode
case Maybe AimMode
saimMode of
Just AimMode
aimMode -> do
let lidV :: LevelId
lidV = AimMode -> LevelId
aimLevelId AimMode
aimMode
Maybe Point
mxhairPos <- m (Maybe Point)
forall (m :: * -> *). MonadClientUI m => m (Maybe Point)
mxhairToPos
Point
xhairPos <- m Point
forall (m :: * -> *). MonadClientUI m => m Point
xhairToPos
[(MsgClassShow, Text)]
blurb <- Point -> LevelId -> m [(MsgClassShow, Text)]
forall (m :: * -> *).
MonadClientUI m =>
Point -> LevelId -> m [(MsgClassShow, Text)]
lookAtPosition Point
xhairPos LevelId
lidV
Maybe (ItemId, CStore, Bool)
itemSel <- (SessionUI -> Maybe (ItemId, CStore, Bool))
-> m (Maybe (ItemId, CStore, Bool))
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe (ItemId, CStore, Bool)
sitemSel
Maybe ActorId
mleader <- (StateClient -> Maybe ActorId) -> m (Maybe ActorId)
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Maybe ActorId
sleader
[(MsgClassShow, Text)]
outOfRangeBlurb <- case (Maybe (ItemId, CStore, Bool)
itemSel, Maybe Point
mxhairPos, Maybe ActorId
mleader) of
(Just (ItemId
iid, CStore
_, Bool
_), Just Point
pos, Just ActorId
leader) -> do
Actor
b <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
leader
if LevelId
lidV LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
/= Actor -> LevelId
blid Actor
b
Bool -> Bool -> Bool
|| AimMode -> DetailLevel
detailLevel AimMode
aimMode DetailLevel -> DetailLevel -> Bool
forall a. Ord a => a -> a -> Bool
< DetailLevel
DetailHigh
then [(MsgClassShow, Text)] -> m [(MsgClassShow, Text)]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return []
else do
ItemFull
itemFull <- (State -> ItemFull) -> m ItemFull
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemFull) -> m ItemFull)
-> (State -> ItemFull) -> m ItemFull
forall a b. (a -> b) -> a -> b
$ ItemId -> State -> ItemFull
itemToFull ItemId
iid
let arItem :: AspectRecord
arItem = ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFull
[(MsgClassShow, Text)] -> m [(MsgClassShow, Text)]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [ (MsgClassShow
MsgPromptGeneric, Text
"This position is out of range when flinging the selected item.")
| Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ AspectRecord -> ItemKind -> Int
IA.totalRange AspectRecord
arItem (ItemFull -> ItemKind
itemKind ItemFull
itemFull)
Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Point -> Point -> Int
chessDist (Actor -> Point
bpos Actor
b) Point
pos ]
(Maybe (ItemId, CStore, Bool), Maybe Point, Maybe ActorId)
_ -> [(MsgClassShow, Text)] -> m [(MsgClassShow, Text)]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return []
((MsgClassShow, Text) -> m ()) -> [(MsgClassShow, Text)] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
mapM_ ((MsgClassShow -> Text -> m ()) -> (MsgClassShow, Text) -> m ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd) ([(MsgClassShow, Text)] -> m ()) -> [(MsgClassShow, Text)] -> m ()
forall a b. (a -> b) -> a -> b
$ [(MsgClassShow, Text)]
blurb [(MsgClassShow, Text)]
-> [(MsgClassShow, Text)] -> [(MsgClassShow, Text)]
forall a. [a] -> [a] -> [a]
++ [(MsgClassShow, Text)]
outOfRangeBlurb
Maybe AimMode
_ -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
pickLeaderWithPointer :: MonadClientUI m => ActorId -> m MError
pickLeaderWithPointer :: forall (m :: * -> *). MonadClientUI m => ActorId -> m MError
pickLeaderWithPointer ActorId
leader = do
CCUI{coscreen :: CCUI -> ScreenContent
coscreen=ScreenContent{Int
rheight :: Int
rheight :: ScreenContent -> Int
rheight}} <- (SessionUI -> CCUI) -> m CCUI
forall a. (SessionUI -> a) -> m a
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 a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
Faction
fact <- (State -> Faction) -> m Faction
forall a. (State -> a) -> m a
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 a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> ActorDictUI
sactorUI
[(ActorId, Actor)]
ours <- (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)])
-> (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
forall a b. (a -> b) -> a -> b
$ ((ActorId, Actor) -> Bool)
-> [(ActorId, Actor)] -> [(ActorId, Actor)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((ActorId, Actor) -> Bool) -> (ActorId, Actor) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Actor -> Bool
bproj (Actor -> Bool)
-> ((ActorId, Actor) -> Actor) -> (ActorId, Actor) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ActorId, Actor) -> Actor
forall a b. (a, b) -> b
snd)
([(ActorId, Actor)] -> [(ActorId, Actor)])
-> (State -> [(ActorId, Actor)]) -> State -> [(ActorId, Actor)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FactionId -> Bool) -> LevelId -> State -> [(ActorId, Actor)]
actorAssocs (FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side) LevelId
lidV
let oursUI :: [(ActorId, Actor, ActorUI)]
oursUI = ((ActorId, Actor) -> (ActorId, Actor, ActorUI))
-> [(ActorId, Actor)] -> [(ActorId, Actor, ActorUI)]
forall a b. (a -> b) -> [a] -> [b]
map (\(ActorId
aid, Actor
b) -> (ActorId
aid, Actor
b, ActorDictUI
sactorUI ActorDictUI -> ActorId -> ActorUI
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ActorId
aid)) [(ActorId, Actor)]
ours
viewed :: [(ActorId, Actor, ActorUI)]
viewed = ((ActorId, Actor, ActorUI)
-> (Bool, Bool, Bool, Char, Color, ActorId))
-> [(ActorId, Actor, ActorUI)] -> [(ActorId, Actor, ActorUI)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (ActorId, Actor, ActorUI)
-> (Bool, Bool, Bool, Char, Color, ActorId)
keySelected [(ActorId, Actor, ActorUI)]
oursUI
banned :: Bool
banned = Faction -> Bool
bannedPointmanSwitchBetweenLevels Faction
fact
pick :: (ActorId, Actor) -> m MError
pick (ActorId
aid, Actor
b) = if Actor -> LevelId
blid Actor
b LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
/= LevelId
arena Bool -> Bool -> Bool
&& Bool
banned
then Text -> m MError
forall (m :: * -> *). MonadClientUI m => Text -> m MError
failMsg (Text -> m MError) -> Text -> m MError
forall a b. (a -> b) -> a -> b
$ ReqFailure -> Text
showReqFailure ReqFailure
NoChangeDunLeader
else do
m Bool -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m Bool -> m ()) -> m Bool -> m ()
forall a b. (a -> b) -> a -> b
$ Bool -> ActorId -> m Bool
forall (m :: * -> *). MonadClientUI m => Bool -> ActorId -> m Bool
pickLeader Bool
True ActorId
aid
MError -> m MError
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return MError
forall a. Maybe a
Nothing
PointUI
pUI <- (SessionUI -> PointUI) -> m PointUI
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> PointUI
spointer
let p :: Point
p@(Point Int
px Int
py) = PointSquare -> Point
squareToMap (PointSquare -> Point) -> PointSquare -> Point
forall a b. (a -> b) -> a -> b
$ PointUI -> PointSquare
uiToSquare PointUI
pUI
if | Int
py Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
rheight Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2 Bool -> Bool -> Bool
&& Int
px Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> ActorId -> Bool -> Direction -> m MError
forall (m :: * -> *).
MonadClientUI m =>
ActorId -> Bool -> Direction -> m MError
pointmanCycle ActorId
leader Bool
True Direction
Forward
| Int
py Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
rheight Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2 ->
case Int -> [(ActorId, Actor, ActorUI)] -> [(ActorId, Actor, ActorUI)]
forall a. Int -> [a] -> [a]
drop (Int
px Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [(ActorId, Actor, ActorUI)]
viewed of
[] -> MError -> m MError
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return MError
forall a. Maybe a
Nothing
(ActorId
aid, Actor
b, ActorUI
_) : [(ActorId, Actor, ActorUI)]
_ -> (ActorId, Actor) -> m MError
pick (ActorId
aid, Actor
b)
| Bool
otherwise ->
case ((ActorId, Actor, ActorUI) -> Bool)
-> [(ActorId, Actor, ActorUI)] -> Maybe (ActorId, Actor, ActorUI)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(ActorId
_, Actor
b, ActorUI
_) -> Actor -> Point
bpos Actor
b Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Point
p) [(ActorId, Actor, ActorUI)]
oursUI of
Maybe (ActorId, Actor, ActorUI)
Nothing -> Text -> m MError
forall (m :: * -> *). MonadClientUI m => Text -> m MError
failMsg Text
"not pointing at an actor"
Just (ActorId
aid, Actor
b, ActorUI
_) -> (ActorId, Actor) -> m MError
pick (ActorId
aid, Actor
b)
itemOverlayFromState :: LevelId -> [(ItemId, ItemQuant)] -> Bool
-> CCUI -> FactionId -> DiscoveryBenefit -> FontSetup
-> State
-> OKX
itemOverlayFromState :: LevelId
-> [(ItemId, ItemQuant)]
-> Bool
-> CCUI
-> FactionId
-> DiscoveryBenefit
-> FontSetup
-> State
-> OKX
itemOverlayFromState LevelId
arena [(ItemId, ItemQuant)]
iids Bool
displayRanged CCUI
sccui FactionId
side DiscoveryBenefit
discoBenefit
FontSetup{DisplayFont
squareFont :: DisplayFont
monoFont :: DisplayFont
propFont :: DisplayFont
squareFont :: FontSetup -> DisplayFont
monoFont :: FontSetup -> DisplayFont
propFont :: FontSetup -> DisplayFont
..} State
s =
let CCUI{coscreen :: CCUI -> ScreenContent
coscreen=ScreenContent{Int
rwidth :: Int
rwidth :: ScreenContent -> Int
rwidth}} = CCUI
sccui
localTime :: Time
localTime = LevelId -> State -> Time
getLocalTime LevelId
arena State
s
itemToF :: ItemId -> ItemFull
itemToF = (ItemId -> State -> ItemFull) -> State -> ItemId -> ItemFull
forall a b c. (a -> b -> c) -> b -> a -> c
flip ItemId -> State -> ItemFull
itemToFull State
s
factionD :: EnumMap FactionId Faction
factionD = State -> EnumMap FactionId Faction
sfactionD State
s
attrCursor :: Attr
attrCursor = Attr
Color.defAttr {Color.bg = Color.HighlightNoneCursor}
markEqp :: Bool -> a -> a -> Char
markEqp Bool
periodic a
k a
ncha =
if | Bool
periodic -> Char
'"'
| a
ncha a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 -> Char
'-'
| a
k a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
ncha -> Char
'~'
| Bool
otherwise -> Char
'+'
pr :: MenuSlot -> (ItemId, ItemQuant)
-> (AttrString, AttrString, KeyOrSlot)
pr :: MenuSlot
-> (ItemId, ItemQuant) -> (AttrString, AttrString, KeyOrSlot)
pr MenuSlot
c (ItemId
iid, kit :: ItemQuant
kit@(Int
k, ItemTimers
_)) =
let itemFull :: ItemFull
itemFull = ItemId -> ItemFull
itemToF ItemId
iid
arItem :: AspectRecord
arItem = ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFull
colorSymbol :: AttrCharW32
colorSymbol =
if Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Condition AspectRecord
arItem
then DiscoveryBenefit -> ItemId -> ItemFull -> AttrCharW32
viewItemBenefitColored DiscoveryBenefit
discoBenefit ItemId
iid ItemFull
itemFull
else ItemFull -> AttrCharW32
viewItem ItemFull
itemFull
phrase :: Text
phrase = [Part] -> Text
makePhrase
[Int
-> FactionId
-> EnumMap FactionId Faction
-> Bool
-> DetailLevel
-> Int
-> Int
-> Time
-> ItemFull
-> ItemQuant
-> Part
partItemWsRanged Int
rwidth FactionId
side EnumMap FactionId Faction
factionD Bool
displayRanged
DetailLevel
DetailLow Int
4 Int
k Time
localTime ItemFull
itemFull ItemQuant
kit]
ncha :: Int
ncha = Time -> ItemQuant -> Int
ncharges Time
localTime ItemQuant
kit
periodic :: Bool
periodic = Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Periodic AspectRecord
arItem
!cLab :: AttrChar
cLab = Color.AttrChar { acAttr :: Attr
acAttr = Attr
attrCursor
, acChar :: Char
acChar = Bool -> Int -> Int -> Char
forall {a}. (Num a, Ord a) => Bool -> a -> a -> Char
markEqp Bool
periodic Int
k Int
ncha }
asLab :: AttrString
asLab = [AttrChar -> AttrCharW32
Color.attrCharToW32 AttrChar
cLab]
AttrString -> AttrString -> AttrString
forall a. [a] -> [a] -> [a]
++ [AttrCharW32
Color.spaceAttrW32 | DisplayFont -> Bool
isSquareFont DisplayFont
propFont]
AttrString -> AttrString -> AttrString
forall a. [a] -> [a] -> [a]
++ [AttrCharW32
colorSymbol]
!tDesc :: Text
tDesc = Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
phrase
in (AttrString
asLab, Text -> AttrString
textToAS Text
tDesc, MenuSlot -> KeyOrSlot
forall a b. b -> Either a b
Right MenuSlot
c)
l :: [(AttrString, AttrString, KeyOrSlot)]
l = (MenuSlot
-> (ItemId, ItemQuant) -> (AttrString, AttrString, KeyOrSlot))
-> [MenuSlot]
-> [(ItemId, ItemQuant)]
-> [(AttrString, AttrString, KeyOrSlot)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith MenuSlot
-> (ItemId, ItemQuant) -> (AttrString, AttrString, KeyOrSlot)
pr [MenuSlot]
natSlots [(ItemId, ItemQuant)]
iids
in DisplayFont
-> DisplayFont -> [(AttrString, AttrString, KeyOrSlot)] -> OKX
labDescOKX DisplayFont
squareFont DisplayFont
propFont [(AttrString, AttrString, KeyOrSlot)]
l
placesFromState :: ContentData PK.PlaceKind -> Bool -> State
-> EM.EnumMap (ContentId PK.PlaceKind)
(ES.EnumSet LevelId, Int, Int, Int)
placesFromState :: ContentData PlaceKind
-> Bool
-> State
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
placesFromState ContentData PlaceKind
coplace Bool
sexposePlaces State
s =
let addEntries :: (EnumSet k, b, c, d)
-> (EnumSet k, b, c, d) -> (EnumSet k, b, c, d)
addEntries (!EnumSet k
es1, !b
nEntries1, !c
nArounds1, !d
nExists1)
(!EnumSet k
es2, !b
nEntries2, !c
nArounds2, !d
nExists2) =
let !es :: EnumSet k
es = EnumSet k -> EnumSet k -> EnumSet k
forall k. EnumSet k -> EnumSet k -> EnumSet k
ES.union EnumSet k
es1 EnumSet k
es2
!nEntries :: b
nEntries = b
nEntries1 b -> b -> b
forall a. Num a => a -> a -> a
+ b
nEntries2
!nArounds :: c
nArounds = c
nArounds1 c -> c -> c
forall a. Num a => a -> a -> a
+ c
nArounds2
!nExists :: d
nExists = d
nExists1 d -> d -> d
forall a. Num a => a -> a -> a
+ d
nExists2
in (EnumSet k
es, b
nEntries, c
nArounds, d
nExists)
placesFromLevel :: (LevelId, Level)
-> EM.EnumMap (ContentId PK.PlaceKind)
(ES.EnumSet LevelId, Int, Int, Int)
placesFromLevel :: (LevelId, Level)
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
placesFromLevel (!LevelId
lid, Level{EntryMap
lentry :: EntryMap
lentry :: Level -> EntryMap
lentry}) =
let f :: PlaceEntry
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
f (PK.PEntry ContentId PlaceKind
pk) EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
em =
((EnumSet LevelId, Int, Int, Int)
-> (EnumSet LevelId, Int, Int, Int)
-> (EnumSet LevelId, Int, Int, Int))
-> ContentId PlaceKind
-> (EnumSet LevelId, Int, Int, Int)
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
forall k a.
Enum k =>
(a -> a -> a) -> k -> a -> EnumMap k a -> EnumMap k a
EM.insertWith (EnumSet LevelId, Int, Int, Int)
-> (EnumSet LevelId, Int, Int, Int)
-> (EnumSet LevelId, Int, Int, Int)
forall {d} {c} {b} {k}.
(Num d, Num c, Num b) =>
(EnumSet k, b, c, d)
-> (EnumSet k, b, c, d) -> (EnumSet k, b, c, d)
addEntries ContentId PlaceKind
pk (LevelId -> EnumSet LevelId
forall k. Enum k => k -> EnumSet k
ES.singleton LevelId
lid, Int
1, Int
0, Int
0) EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
em
f (PK.PAround ContentId PlaceKind
pk) EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
em =
((EnumSet LevelId, Int, Int, Int)
-> (EnumSet LevelId, Int, Int, Int)
-> (EnumSet LevelId, Int, Int, Int))
-> ContentId PlaceKind
-> (EnumSet LevelId, Int, Int, Int)
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
forall k a.
Enum k =>
(a -> a -> a) -> k -> a -> EnumMap k a -> EnumMap k a
EM.insertWith (EnumSet LevelId, Int, Int, Int)
-> (EnumSet LevelId, Int, Int, Int)
-> (EnumSet LevelId, Int, Int, Int)
forall {d} {c} {b} {k}.
(Num d, Num c, Num b) =>
(EnumSet k, b, c, d)
-> (EnumSet k, b, c, d) -> (EnumSet k, b, c, d)
addEntries ContentId PlaceKind
pk (LevelId -> EnumSet LevelId
forall k. Enum k => k -> EnumSet k
ES.singleton LevelId
lid, Int
0, Int
1, Int
0) EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
em
f (PK.PExists ContentId PlaceKind
pk) EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
em =
((EnumSet LevelId, Int, Int, Int)
-> (EnumSet LevelId, Int, Int, Int)
-> (EnumSet LevelId, Int, Int, Int))
-> ContentId PlaceKind
-> (EnumSet LevelId, Int, Int, Int)
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
forall k a.
Enum k =>
(a -> a -> a) -> k -> a -> EnumMap k a -> EnumMap k a
EM.insertWith (EnumSet LevelId, Int, Int, Int)
-> (EnumSet LevelId, Int, Int, Int)
-> (EnumSet LevelId, Int, Int, Int)
forall {d} {c} {b} {k}.
(Num d, Num c, Num b) =>
(EnumSet k, b, c, d)
-> (EnumSet k, b, c, d) -> (EnumSet k, b, c, d)
addEntries ContentId PlaceKind
pk (LevelId -> EnumSet LevelId
forall k. Enum k => k -> EnumSet k
ES.singleton LevelId
lid, Int
0, Int
0, Int
1) EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
em
in (PlaceEntry
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int))
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
-> EntryMap
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
forall a b k. (a -> b -> b) -> b -> EnumMap k a -> b
EM.foldr' PlaceEntry
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
f EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
forall k a. EnumMap k a
EM.empty EntryMap
lentry
insertZeros :: EnumMap k (EnumSet k, b, c, d)
-> k -> p -> EnumMap k (EnumSet k, b, c, d)
insertZeros !EnumMap k (EnumSet k, b, c, d)
em !k
pk p
_ = k
-> (EnumSet k, b, c, d)
-> EnumMap k (EnumSet k, b, c, d)
-> EnumMap k (EnumSet k, b, c, d)
forall k a. Enum k => k -> a -> EnumMap k a -> EnumMap k a
EM.insert k
pk (EnumSet k
forall k. EnumSet k
ES.empty, b
0, c
0, d
0) EnumMap k (EnumSet k, b, c, d)
em
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)
factionsFromState :: ItemRoles -> State -> [(FactionId, Faction)]
factionsFromState :: ItemRoles -> State -> [(FactionId, Faction)]
factionsFromState (ItemRoles EnumMap SLore (EnumSet ItemId)
itemRoles) State
s =
let seenTrunks :: [ItemId]
seenTrunks = EnumSet ItemId -> [ItemId]
forall k. Enum k => EnumSet k -> [k]
ES.toList (EnumSet ItemId -> [ItemId]) -> EnumSet ItemId -> [ItemId]
forall a b. (a -> b) -> a -> b
$ EnumMap SLore (EnumSet ItemId)
itemRoles EnumMap SLore (EnumSet ItemId) -> SLore -> EnumSet ItemId
forall k a. Enum k => EnumMap k a -> k -> a
EM.! SLore
STrunk
trunkBelongs :: FactionId -> ItemId -> Bool
trunkBelongs FactionId
fid ItemId
iid = Item -> Maybe FactionId
jfid (ItemId -> State -> Item
getItemBody ItemId
iid State
s) Maybe FactionId -> Maybe FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId -> Maybe FactionId
forall a. a -> Maybe a
Just FactionId
fid
factionSeen :: (FactionId, Faction) -> Bool
factionSeen (FactionId
fid, Faction
fact) = Bool -> Bool
not (EnumMap (ContentId ItemKind) Int -> Bool
forall k a. EnumMap k a -> Bool
EM.null (Faction -> EnumMap (ContentId ItemKind) Int
gvictims Faction
fact))
Bool -> Bool -> Bool
|| (ItemId -> Bool) -> [ItemId] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (FactionId -> ItemId -> Bool
trunkBelongs FactionId
fid) [ItemId]
seenTrunks
in ((FactionId, Faction) -> Bool)
-> [(FactionId, Faction)] -> [(FactionId, Faction)]
forall a. (a -> Bool) -> [a] -> [a]
filter (FactionId, Faction) -> Bool
factionSeen ([(FactionId, Faction)] -> [(FactionId, Faction)])
-> [(FactionId, Faction)] -> [(FactionId, Faction)]
forall a b. (a -> b) -> a -> b
$ EnumMap FactionId Faction -> [(FactionId, Faction)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs (EnumMap FactionId Faction -> [(FactionId, Faction)])
-> EnumMap FactionId Faction -> [(FactionId, Faction)]
forall a b. (a -> b) -> a -> b
$ State -> EnumMap FactionId Faction
sfactionD State
s
itemOverlay :: MonadClientUI m
=> [(ItemId, ItemQuant)] -> ItemDialogMode -> m OKX
itemOverlay :: forall (m :: * -> *).
MonadClientUI m =>
[(ItemId, ItemQuant)] -> ItemDialogMode -> m OKX
itemOverlay [(ItemId, ItemQuant)]
iids ItemDialogMode
dmode = do
CCUI
sccui <- (SessionUI -> CCUI) -> m CCUI
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
LevelId
arena <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
getArenaUI
DiscoveryBenefit
discoBenefit <- (StateClient -> DiscoveryBenefit) -> m DiscoveryBenefit
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> DiscoveryBenefit
sdiscoBenefit
FontSetup
fontSetup <- m FontSetup
forall (m :: * -> *). MonadClientUI m => m FontSetup
getFontSetup
let displayRanged :: Bool
displayRanged =
ItemDialogMode
dmode ItemDialogMode -> [ItemDialogMode] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ CStore -> ItemDialogMode
MStore CStore
CGround, CStore -> ItemDialogMode
MStore CStore
CEqp, CStore -> ItemDialogMode
MStore CStore
CStash
, ItemDialogMode
MOwned, SLore -> ItemDialogMode
MLore SLore
SItem, SLore -> ItemDialogMode
MLore SLore
SBlast ]
OKX
okx <- (State -> OKX) -> m OKX
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> OKX) -> m OKX) -> (State -> OKX) -> m OKX
forall a b. (a -> b) -> a -> b
$ LevelId
-> [(ItemId, ItemQuant)]
-> Bool
-> CCUI
-> FactionId
-> DiscoveryBenefit
-> FontSetup
-> State
-> OKX
itemOverlayFromState LevelId
arena [(ItemId, ItemQuant)]
iids Bool
displayRanged
CCUI
sccui FactionId
side DiscoveryBenefit
discoBenefit FontSetup
fontSetup
OKX -> m OKX
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (OKX -> m OKX) -> OKX -> m OKX
forall a b. (a -> b) -> a -> b
$! OKX
okx
skillsOverlay :: MonadClientUI m => ActorId -> m OKX
skillsOverlay :: forall (m :: * -> *). MonadClientUI m => ActorId -> m OKX
skillsOverlay ActorId
aid = do
Actor
b <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
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 a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Skills) -> m Skills) -> (State -> Skills) -> m Skills
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Skills
getActorMaxSkills ActorId
aid
FontSetup{DisplayFont
squareFont :: FontSetup -> DisplayFont
monoFont :: FontSetup -> DisplayFont
propFont :: FontSetup -> DisplayFont
squareFont :: DisplayFont
monoFont :: DisplayFont
propFont :: DisplayFont
..} <- m FontSetup
forall (m :: * -> *). MonadClientUI m => m FontSetup
getFontSetup
let prSlot :: MenuSlot -> Ability.Skill
-> ((AttrLine, (Int, AttrLine), (Int, AttrLine)), KYX)
prSlot :: MenuSlot
-> Skill -> ((AttrLine, (Int, AttrLine), (Int, AttrLine)), KYX)
prSlot MenuSlot
c Skill
skill =
let skName :: Text
skName = Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Skill -> Text
skillName Skill
skill
attrCursor :: Attr
attrCursor = Attr
Color.defAttr {Color.bg = Color.HighlightNoneCursor}
labAc :: AttrChar
labAc = Color.AttrChar { acAttr :: Attr
acAttr = Attr
attrCursor
, acChar :: Char
acChar = Char
'+' }
lab :: AttrLine
lab = AttrString -> AttrLine
attrStringToAL [AttrChar -> AttrCharW32
Color.attrCharToW32 AttrChar
labAc]
labLen :: Int
labLen = DisplayFont -> AttrString -> Int
forall a. DisplayFont -> [a] -> Int
textSize DisplayFont
squareFont (AttrString -> Int) -> AttrString -> Int
forall a b. (a -> b) -> a -> b
$ AttrLine -> AttrString
attrLine AttrLine
lab
indentation :: Int
indentation = if DisplayFont -> Bool
isSquareFont DisplayFont
propFont then Int
52 else Int
26
valueText :: Text
valueText = Skill -> Actor -> Int -> Text
skillToDecorator Skill
skill Actor
b
(Int -> Text) -> Int -> Text
forall a b. (a -> b) -> a -> b
$ Skill -> Skills -> Int
Ability.getSk Skill
skill Skills
actorMaxSk
triple :: (AttrLine, (Int, AttrLine), (Int, AttrLine))
triple = ( AttrLine
lab
, (Int
labLen, Text -> AttrLine
textToAL Text
skName)
, (Int
indentation, Text -> AttrLine
textToAL Text
valueText) )
lenButton :: Int
lenButton = Int
26 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Text -> Int
T.length Text
valueText
in ((AttrLine, (Int, AttrLine), (Int, AttrLine))
triple, (MenuSlot -> KeyOrSlot
forall a b. b -> Either a b
Right MenuSlot
c, ( Int -> Int -> PointUI
PointUI Int
0 (MenuSlot -> Int
forall a. Enum a => a -> Int
fromEnum MenuSlot
c)
, DisplayFont -> Int -> ButtonWidth
ButtonWidth DisplayFont
propFont Int
lenButton )))
([(AttrLine, (Int, AttrLine), (Int, AttrLine))]
ts, [KYX]
kxs) = [((AttrLine, (Int, AttrLine), (Int, AttrLine)), KYX)]
-> ([(AttrLine, (Int, AttrLine), (Int, AttrLine))], [KYX])
forall a b. [(a, b)] -> ([a], [b])
unzip ([((AttrLine, (Int, AttrLine), (Int, AttrLine)), KYX)]
-> ([(AttrLine, (Int, AttrLine), (Int, AttrLine))], [KYX]))
-> [((AttrLine, (Int, AttrLine), (Int, AttrLine)), KYX)]
-> ([(AttrLine, (Int, AttrLine), (Int, AttrLine))], [KYX])
forall a b. (a -> b) -> a -> b
$ (MenuSlot
-> Skill -> ((AttrLine, (Int, AttrLine), (Int, AttrLine)), KYX))
-> [MenuSlot]
-> [Skill]
-> [((AttrLine, (Int, AttrLine), (Int, AttrLine)), KYX)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith MenuSlot
-> Skill -> ((AttrLine, (Int, AttrLine), (Int, AttrLine)), KYX)
prSlot [MenuSlot]
natSlots [Skill]
skillsInDisplayOrder
([AttrLine]
skLab, [(Int, AttrLine)]
skDescr, [(Int, AttrLine)]
skValue) = [(AttrLine, (Int, AttrLine), (Int, AttrLine))]
-> ([AttrLine], [(Int, AttrLine)], [(Int, AttrLine)])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 [(AttrLine, (Int, AttrLine), (Int, AttrLine))]
ts
skillLab :: EnumMap DisplayFont Overlay
skillLab = DisplayFont -> Overlay -> EnumMap DisplayFont Overlay
forall k a. Enum k => k -> a -> EnumMap k a
EM.singleton DisplayFont
squareFont (Overlay -> EnumMap DisplayFont Overlay)
-> Overlay -> EnumMap DisplayFont Overlay
forall a b. (a -> b) -> a -> b
$ [AttrLine] -> Overlay
offsetOverlay [AttrLine]
skLab
skillDescr :: EnumMap DisplayFont Overlay
skillDescr = DisplayFont -> Overlay -> EnumMap DisplayFont Overlay
forall k a. Enum k => k -> a -> EnumMap k a
EM.singleton DisplayFont
propFont (Overlay -> EnumMap DisplayFont Overlay)
-> Overlay -> EnumMap DisplayFont Overlay
forall a b. (a -> b) -> a -> b
$ [(Int, AttrLine)] -> Overlay
offsetOverlayX [(Int, AttrLine)]
skDescr
skillValue :: EnumMap DisplayFont Overlay
skillValue = DisplayFont -> Overlay -> EnumMap DisplayFont Overlay
forall k a. Enum k => k -> a -> EnumMap k a
EM.singleton DisplayFont
monoFont (Overlay -> EnumMap DisplayFont Overlay)
-> Overlay -> EnumMap DisplayFont Overlay
forall a b. (a -> b) -> a -> b
$ [(Int, AttrLine)] -> Overlay
offsetOverlayX [(Int, AttrLine)]
skValue
OKX -> m OKX
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Overlay -> Overlay -> Overlay)
-> [EnumMap DisplayFont Overlay] -> EnumMap DisplayFont Overlay
forall a k. (a -> a -> a) -> [EnumMap k a] -> EnumMap k a
EM.unionsWith Overlay -> Overlay -> Overlay
forall a. [a] -> [a] -> [a]
(++) [EnumMap DisplayFont Overlay
skillLab, EnumMap DisplayFont Overlay
skillDescr, EnumMap DisplayFont Overlay
skillValue], [KYX]
kxs)
placesOverlay :: MonadClientUI m => m OKX
placesOverlay :: forall (m :: * -> *). MonadClientUI m => m OKX
placesOverlay = do
COps{ContentData PlaceKind
coplace :: ContentData PlaceKind
coplace :: COps -> ContentData PlaceKind
coplace} <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
ClientOptions
soptions <- (StateClient -> ClientOptions) -> m ClientOptions
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> ClientOptions
soptions
FontSetup{DisplayFont
squareFont :: FontSetup -> DisplayFont
monoFont :: FontSetup -> DisplayFont
propFont :: FontSetup -> DisplayFont
squareFont :: DisplayFont
monoFont :: DisplayFont
propFont :: DisplayFont
..} <- m FontSetup
forall (m :: * -> *). MonadClientUI m => m FontSetup
getFontSetup
EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
places <- (State
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int))
-> m (EnumMap
(ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int))
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int))
-> m (EnumMap
(ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)))
-> (State
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int))
-> m (EnumMap
(ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int))
forall a b. (a -> b) -> a -> b
$ ContentData PlaceKind
-> Bool
-> State
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
placesFromState ContentData PlaceKind
coplace (ClientOptions -> Bool
sexposePlaces ClientOptions
soptions)
let prSlot :: MenuSlot
-> (ContentId PK.PlaceKind, (ES.EnumSet LevelId, Int, Int, Int))
-> (AttrString, AttrString, KeyOrSlot)
prSlot :: MenuSlot
-> (ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))
-> (AttrString, AttrString, KeyOrSlot)
prSlot MenuSlot
c (ContentId PlaceKind
pk, (EnumSet LevelId
es, Int
_, Int
_, Int
_)) =
let name :: Text
name = PlaceKind -> Text
PK.pname (PlaceKind -> Text) -> PlaceKind -> Text
forall a b. (a -> b) -> a -> b
$ ContentData PlaceKind -> ContentId PlaceKind -> PlaceKind
forall a. ContentData a -> ContentId a -> a
okind ContentData PlaceKind
coplace ContentId PlaceKind
pk
labChar :: Char
labChar = if EnumSet LevelId -> Bool
forall k. EnumSet k -> Bool
ES.null EnumSet LevelId
es then Char
'-' else Char
'+'
attrCursor :: Attr
attrCursor = Attr
Color.defAttr {Color.bg = Color.HighlightNoneCursor}
labAc :: AttrChar
labAc = Color.AttrChar { acAttr :: Attr
acAttr = Attr
attrCursor
, acChar :: Char
acChar = Char
labChar }
!asLab :: AttrString
asLab = [AttrChar -> AttrCharW32
Color.attrCharToW32 AttrChar
labAc]
!tDesc :: Text
tDesc = Text
" "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name
Text -> Text -> Text
<+> if EnumSet LevelId -> Bool
forall k. EnumSet k -> Bool
ES.null EnumSet LevelId
es
then Text
""
else Text
"("
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Part] -> Text
makePhrase [Int -> Part -> Part
MU.CarWs (EnumSet LevelId -> Int
forall k. EnumSet k -> Int
ES.size EnumSet LevelId
es) Part
"level"]
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
in (AttrString
asLab, Text -> AttrString
textToAS Text
tDesc, MenuSlot -> KeyOrSlot
forall a b. b -> Either a b
Right MenuSlot
c)
l :: [(AttrString, AttrString, KeyOrSlot)]
l = (MenuSlot
-> (ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))
-> (AttrString, AttrString, KeyOrSlot))
-> [MenuSlot]
-> [(ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))]
-> [(AttrString, AttrString, KeyOrSlot)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith MenuSlot
-> (ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))
-> (AttrString, AttrString, KeyOrSlot)
prSlot [MenuSlot]
natSlots ([(ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))]
-> [(AttrString, AttrString, KeyOrSlot)])
-> [(ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))]
-> [(AttrString, AttrString, KeyOrSlot)]
forall a b. (a -> b) -> a -> b
$ EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
-> [(ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
places
OKX -> m OKX
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (OKX -> m OKX) -> OKX -> m OKX
forall a b. (a -> b) -> a -> b
$! DisplayFont
-> DisplayFont -> [(AttrString, AttrString, KeyOrSlot)] -> OKX
labDescOKX DisplayFont
squareFont DisplayFont
propFont [(AttrString, AttrString, KeyOrSlot)]
l
factionsOverlay :: MonadClientUI m => m OKX
factionsOverlay :: forall (m :: * -> *). MonadClientUI m => m OKX
factionsOverlay = do
FontSetup{DisplayFont
squareFont :: FontSetup -> DisplayFont
monoFont :: FontSetup -> DisplayFont
propFont :: FontSetup -> DisplayFont
squareFont :: DisplayFont
monoFont :: DisplayFont
propFont :: DisplayFont
..} <- m FontSetup
forall (m :: * -> *). MonadClientUI m => m FontSetup
getFontSetup
ItemRoles
sroles <- (SessionUI -> ItemRoles) -> m ItemRoles
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> ItemRoles
sroles
[(FactionId, Faction)]
factions <- (State -> [(FactionId, Faction)]) -> m [(FactionId, Faction)]
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(FactionId, Faction)]) -> m [(FactionId, Faction)])
-> (State -> [(FactionId, Faction)]) -> m [(FactionId, Faction)]
forall a b. (a -> b) -> a -> b
$ ItemRoles -> State -> [(FactionId, Faction)]
factionsFromState ItemRoles
sroles
let prSlot :: MenuSlot
-> (FactionId, Faction)
-> (AttrString, AttrString, KeyOrSlot)
prSlot :: MenuSlot
-> (FactionId, Faction) -> (AttrString, AttrString, KeyOrSlot)
prSlot MenuSlot
c (FactionId
_, Faction
fact) =
let name :: Text
name = FactionKind -> Text
FK.fname (FactionKind -> Text) -> FactionKind -> Text
forall a b. (a -> b) -> a -> b
$ Faction -> FactionKind
gkind Faction
fact
gameOver :: Bool
gameOver = Maybe Status -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Status -> Bool) -> Maybe Status -> Bool
forall a b. (a -> b) -> a -> b
$ Faction -> Maybe Status
gquit Faction
fact
labChar :: Char
labChar = if Bool
gameOver then Char
'-' else Char
'+'
attrCursor :: Attr
attrCursor = Attr
Color.defAttr {Color.bg = Color.HighlightNoneCursor}
labAc :: AttrChar
labAc = Color.AttrChar { acAttr :: Attr
acAttr = Attr
attrCursor
, acChar :: Char
acChar = Char
labChar }
!asLab :: AttrString
asLab = [AttrChar -> AttrCharW32
Color.attrCharToW32 AttrChar
labAc]
!tDesc :: Text
tDesc = Text
" "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name
Text -> Text -> Text
<+> case Faction -> Maybe Status
gquit Faction
fact of
Just Status{Outcome
stOutcome :: Outcome
stOutcome :: Status -> Outcome
stOutcome} | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Faction -> Bool
isHorrorFact Faction
fact ->
Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Outcome -> Text
FK.nameOutcomePast Outcome
stOutcome Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
Maybe Status
_ -> Text
""
in (AttrString
asLab, Text -> AttrString
textToAS Text
tDesc, MenuSlot -> KeyOrSlot
forall a b. b -> Either a b
Right MenuSlot
c)
l :: [(AttrString, AttrString, KeyOrSlot)]
l = (MenuSlot
-> (FactionId, Faction) -> (AttrString, AttrString, KeyOrSlot))
-> [MenuSlot]
-> [(FactionId, Faction)]
-> [(AttrString, AttrString, KeyOrSlot)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith MenuSlot
-> (FactionId, Faction) -> (AttrString, AttrString, KeyOrSlot)
prSlot [MenuSlot]
natSlots [(FactionId, Faction)]
factions
OKX -> m OKX
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (OKX -> m OKX) -> OKX -> m OKX
forall a b. (a -> b) -> a -> b
$! DisplayFont
-> DisplayFont -> [(AttrString, AttrString, KeyOrSlot)] -> OKX
labDescOKX DisplayFont
squareFont DisplayFont
propFont [(AttrString, AttrString, KeyOrSlot)]
l
modesOverlay :: MonadClientUI m => m OKX
modesOverlay :: forall (m :: * -> *). MonadClientUI m => m OKX
modesOverlay = do
COps{ContentData ModeKind
comode :: ContentData ModeKind
comode :: COps -> ContentData ModeKind
comode} <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
FontSetup{DisplayFont
squareFont :: FontSetup -> DisplayFont
monoFont :: FontSetup -> DisplayFont
propFont :: FontSetup -> DisplayFont
squareFont :: DisplayFont
monoFont :: DisplayFont
propFont :: DisplayFont
..} <- m FontSetup
forall (m :: * -> *). MonadClientUI m => m FontSetup
getFontSetup
EnumMap (ContentId ModeKind) (Map Challenge Int)
svictories <- (SessionUI -> EnumMap (ContentId ModeKind) (Map Challenge Int))
-> m (EnumMap (ContentId ModeKind) (Map Challenge Int))
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> EnumMap (ContentId ModeKind) (Map Challenge Int)
svictories
Challenge
nxtChal <- (StateClient -> Challenge) -> m Challenge
forall a. (StateClient -> a) -> m a
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 !a
i !b
a = (a
i, b
a) (a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
: [(a, b)]
acc
campaignModes :: [(ContentId ModeKind, ModeKind)]
campaignModes = ContentData ModeKind
-> GroupName ModeKind
-> ([(ContentId ModeKind, ModeKind)]
-> Int
-> ContentId ModeKind
-> ModeKind
-> [(ContentId ModeKind, ModeKind)])
-> [(ContentId ModeKind, ModeKind)]
-> [(ContentId ModeKind, ModeKind)]
forall a b.
ContentData a
-> GroupName a -> (b -> Int -> ContentId a -> a -> b) -> b -> b
ofoldlGroup' ContentData ModeKind
comode GroupName ModeKind
MK.CAMPAIGN_SCENARIO [(ContentId ModeKind, ModeKind)]
-> Int
-> ContentId ModeKind
-> ModeKind
-> [(ContentId ModeKind, ModeKind)]
forall {a} {b} {p}. [(a, b)] -> p -> a -> b -> [(a, b)]
f []
prSlot :: MenuSlot
-> (ContentId MK.ModeKind, MK.ModeKind)
-> (AttrString, AttrString, KeyOrSlot)
prSlot :: MenuSlot
-> (ContentId ModeKind, ModeKind)
-> (AttrString, AttrString, KeyOrSlot)
prSlot MenuSlot
c (ContentId ModeKind
gameModeId, ModeKind
gameMode) =
let modeName :: Text
modeName = ModeKind -> Text
MK.mname ModeKind
gameMode
victories :: Int
victories = case ContentId ModeKind
-> EnumMap (ContentId ModeKind) (Map Challenge Int)
-> Maybe (Map Challenge Int)
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup ContentId ModeKind
gameModeId EnumMap (ContentId ModeKind) (Map Challenge Int)
svictories of
Maybe (Map Challenge Int)
Nothing -> Int
0
Just Map Challenge Int
cm -> Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (Challenge -> Map Challenge Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Challenge
nxtChal Map Challenge Int
cm)
labChar :: Char
labChar = if Int
victories Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then Char
'-' else Char
'+'
attrCursor :: Attr
attrCursor = Attr
Color.defAttr {Color.bg = Color.HighlightNoneCursor}
labAc :: AttrChar
labAc = Color.AttrChar { acAttr :: Attr
acAttr = Attr
attrCursor
, acChar :: Char
acChar = Char
labChar }
!asLab :: AttrString
asLab = [AttrChar -> AttrCharW32
Color.attrCharToW32 AttrChar
labAc]
!tDesc :: Text
tDesc = Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
modeName
in (AttrString
asLab, Text -> AttrString
textToAS Text
tDesc, MenuSlot -> KeyOrSlot
forall a b. b -> Either a b
Right MenuSlot
c)
l :: [(AttrString, AttrString, KeyOrSlot)]
l = (MenuSlot
-> (ContentId ModeKind, ModeKind)
-> (AttrString, AttrString, KeyOrSlot))
-> [MenuSlot]
-> [(ContentId ModeKind, ModeKind)]
-> [(AttrString, AttrString, KeyOrSlot)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith MenuSlot
-> (ContentId ModeKind, ModeKind)
-> (AttrString, AttrString, KeyOrSlot)
prSlot [MenuSlot]
natSlots [(ContentId ModeKind, ModeKind)]
campaignModes
OKX -> m OKX
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (OKX -> m OKX) -> OKX -> m OKX
forall a b. (a -> b) -> a -> b
$! DisplayFont
-> DisplayFont -> [(AttrString, AttrString, KeyOrSlot)] -> OKX
labDescOKX DisplayFont
squareFont DisplayFont
propFont [(AttrString, AttrString, KeyOrSlot)]
l
describeMode :: MonadClientUI m
=> Bool -> ContentId MK.ModeKind
-> m (EM.EnumMap DisplayFont Overlay)
describeMode :: forall (m :: * -> *).
MonadClientUI m =>
Bool -> ContentId ModeKind -> m (EnumMap DisplayFont Overlay)
describeMode Bool
addTitle ContentId ModeKind
gameModeId = do
COps{ContentData ModeKind
comode :: COps -> ContentData ModeKind
comode :: ContentData ModeKind
comode} <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
CCUI{coscreen :: CCUI -> ScreenContent
coscreen=ScreenContent{Int
rwidth :: ScreenContent -> Int
rwidth :: Int
rwidth}}
<- (SessionUI -> CCUI) -> m CCUI
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
FontSetup{DisplayFont
squareFont :: FontSetup -> DisplayFont
monoFont :: FontSetup -> DisplayFont
propFont :: FontSetup -> DisplayFont
squareFont :: DisplayFont
monoFont :: DisplayFont
propFont :: DisplayFont
..} <- m FontSetup
forall (m :: * -> *). MonadClientUI m => m FontSetup
getFontSetup
ScoreDict
scoreDict <- (State -> ScoreDict) -> m ScoreDict
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> ScoreDict
shigh
EnumSet (ContentId ModeKind)
scampings <- (SessionUI -> EnumSet (ContentId ModeKind))
-> m (EnumSet (ContentId ModeKind))
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> EnumSet (ContentId ModeKind)
scampings
EnumSet (ContentId ModeKind)
srestarts <- (SessionUI -> EnumSet (ContentId ModeKind))
-> m (EnumSet (ContentId ModeKind))
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> EnumSet (ContentId ModeKind)
srestarts
FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
Int
total <- (State -> Int) -> m Int
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Int) -> m Int) -> (State -> Int) -> m Int
forall a b. (a -> b) -> a -> b
$ (ItemBag, Int) -> Int
forall a b. (a, b) -> b
snd ((ItemBag, Int) -> Int)
-> (State -> (ItemBag, Int)) -> State -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FactionId -> State -> (ItemBag, Int)
calculateTotal FactionId
side
Int
dungeonTotal <- (State -> Int) -> m Int
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> Int
sgold
let screensaverBlurb :: Text
screensaverBlurb = Text
"This is one of the screensaver scenarios, not available from the main menu, with all factions controlled by AI. Feel free to take over or relinquish control at any moment, but to register a legitimate high score, choose a standard scenario instead.\n"
let gameMode :: ModeKind
gameMode = ContentData ModeKind -> ContentId ModeKind -> ModeKind
forall a. ContentData a -> ContentId a -> a
okind ContentData ModeKind
comode ContentId ModeKind
gameModeId
duplicateEOL :: Char -> Text
duplicateEOL Char
'\n' = Text
"\n\n"
duplicateEOL Char
c = Char -> Text
T.singleton Char
c
sections :: [(AttrString, Text)]
sections =
[ ( Color -> Text -> AttrString
textFgToAS Color
Color.BrGreen Text
"The story so far:"
, (Char -> Text) -> Text -> Text
T.concatMap Char -> Text
duplicateEOL (ModeKind -> Text
MK.mdesc ModeKind
gameMode) )
, ( Color -> Text -> AttrString
textFgToAS Color
Color.cMeta Text
"Rules of the game:"
, ModeKind -> Text
MK.mrules ModeKind
gameMode )
, ( Color -> Text -> AttrString
textFgToAS Color
Color.BrCyan Text
"Running commentary:"
, (Char -> Text) -> Text -> Text
T.concatMap Char -> Text
duplicateEOL
(if ModeKind -> Bool
MK.mattract ModeKind
gameMode
then Text
screensaverBlurb Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ModeKind -> Text
MK.mreason ModeKind
gameMode
else ModeKind -> Text
MK.mreason ModeKind
gameMode) )
, ( Color -> Text -> AttrString
textFgToAS Color
Color.cGreed Text
"Hints, not needed unless stuck:"
, (Char -> Text) -> Text -> Text
T.concatMap Char -> Text
duplicateEOL (ModeKind -> Text
MK.mhint ModeKind
gameMode) )
]
renderSection :: (AttrString, Text) -> Maybe [(DisplayFont, AttrString)]
renderSection :: (AttrString, Text) -> Maybe [(DisplayFont, AttrString)]
renderSection (AttrString
header, Text
desc) =
if Text -> Bool
T.null Text
desc
then Maybe [(DisplayFont, AttrString)]
forall a. Maybe a
Nothing
else [(DisplayFont, AttrString)] -> Maybe [(DisplayFont, AttrString)]
forall a. a -> Maybe a
Just [(DisplayFont
monoFont, AttrString
header), (DisplayFont
propFont, Text -> AttrString
textToAS Text
desc)]
survivingHow :: Text
survivingHow = if | Int
total Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> Text
"(barely)"
| Int
total Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
dungeonTotal Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2 -> Text
"(so far)"
| Bool
otherwise -> Text
""
title :: Text
title = if Bool
addTitle
then Text
"\nYou are"
Text -> Text -> Text
<+> Text
survivingHow
Text -> Text -> Text
<+> Text
"surviving the '"
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ModeKind -> Text
MK.mname ModeKind
gameMode
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' adventure.\n"
else Text
""
blurb :: [(DisplayFont, [AttrLine])]
blurb = ((DisplayFont, AttrString) -> (DisplayFont, [AttrLine]))
-> [(DisplayFont, AttrString)] -> [(DisplayFont, [AttrLine])]
forall a b. (a -> b) -> [a] -> [b]
map ((AttrString -> [AttrLine])
-> (DisplayFont, AttrString) -> (DisplayFont, [AttrLine])
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((AttrString -> [AttrLine])
-> (DisplayFont, AttrString) -> (DisplayFont, [AttrLine]))
-> (AttrString -> [AttrLine])
-> (DisplayFont, AttrString)
-> (DisplayFont, [AttrLine])
forall a b. (a -> b) -> a -> b
$ Int -> Int -> AttrString -> [AttrLine]
splitAttrString (Int
rwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) (Int
rwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2)) ([(DisplayFont, AttrString)] -> [(DisplayFont, [AttrLine])])
-> [(DisplayFont, AttrString)] -> [(DisplayFont, [AttrLine])]
forall a b. (a -> b) -> a -> b
$
(DisplayFont
propFont, Text -> AttrString
textToAS (Text
title Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"))
(DisplayFont, AttrString)
-> [(DisplayFont, AttrString)] -> [(DisplayFont, AttrString)]
forall a. a -> [a] -> [a]
: [(DisplayFont, AttrString)]
-> [[(DisplayFont, AttrString)]] -> [(DisplayFont, AttrString)]
forall a. [a] -> [[a]] -> [a]
intercalate [(DisplayFont
monoFont, Text -> AttrString
textToAS Text
"\n")]
(((AttrString, Text) -> Maybe [(DisplayFont, AttrString)])
-> [(AttrString, Text)] -> [[(DisplayFont, AttrString)]]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (AttrString, Text) -> Maybe [(DisplayFont, AttrString)]
renderSection [(AttrString, Text)]
sections)
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 b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((AttrString -> [AttrLine])
-> (DisplayFont, AttrString) -> (DisplayFont, [AttrLine]))
-> (AttrString -> [AttrLine])
-> (DisplayFont, AttrString)
-> (DisplayFont, [AttrLine])
forall a b. (a -> b) -> a -> b
$ Int -> Int -> AttrString -> [AttrLine]
splitAttrString (Int
rwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) (Int
rwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2)) ([(DisplayFont, AttrString)] -> [(DisplayFont, [AttrLine])])
-> [(DisplayFont, AttrString)] -> [(DisplayFont, [AttrLine])]
forall a b. (a -> b) -> a -> b
$
( DisplayFont
propFont
, Color -> Text -> AttrString
textFgToAS Color
Color.Brown
Text
"\nThis adventure's endings experienced so far:\n\n" )
(DisplayFont, AttrString)
-> [(DisplayFont, AttrString)] -> [(DisplayFont, AttrString)]
forall a. a -> [a] -> [a]
: if [(DisplayFont, AttrString)] -> Bool
forall a. [a] -> Bool
null [(DisplayFont, AttrString)]
sectionsEndAS
then [(DisplayFont
monoFont, Text -> AttrString
textToAS Text
"*none*")]
else [(DisplayFont, AttrString)]
sectionsEndAS
sectionsEndAS :: [(DisplayFont, AttrString)]
sectionsEndAS = [(DisplayFont, AttrString)]
-> [[(DisplayFont, AttrString)]] -> [(DisplayFont, AttrString)]
forall a. [a] -> [[a]] -> [a]
intercalate [(DisplayFont
monoFont, Text -> AttrString
textToAS Text
"\n")]
(((AttrString, Text) -> Maybe [(DisplayFont, AttrString)])
-> [(AttrString, Text)] -> [[(DisplayFont, AttrString)]]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (AttrString, Text) -> Maybe [(DisplayFont, AttrString)]
renderSection [(AttrString, Text)]
sectionsEnd)
sectionsEnd :: [(AttrString, Text)]
sectionsEnd = (Outcome -> (AttrString, Text))
-> [Outcome] -> [(AttrString, Text)]
forall a b. (a -> b) -> [a] -> [b]
map Outcome -> (AttrString, Text)
outcomeSection [Outcome
forall a. Bounded a => a
minBound..Outcome
forall a. Bounded a => a
maxBound]
outcomeSection :: FK.Outcome -> (AttrString, Text)
outcomeSection :: Outcome -> (AttrString, Text)
outcomeSection Outcome
outcome =
( Outcome -> AttrString
renderOutcome Outcome
outcome
, if Bool -> Bool
not (Outcome -> Bool
outcomeSeen Outcome
outcome)
then Text
""
else (Char -> Text) -> Text -> Text
T.concatMap Char -> Text
duplicateEOL
(Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Outcome -> [(Outcome, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Outcome
outcome
([(Outcome, Text)] -> Maybe Text)
-> [(Outcome, Text)] -> Maybe Text
forall a b. (a -> b) -> a -> b
$ ModeKind -> [(Outcome, Text)]
MK.mendMsg ModeKind
gameMode [(Outcome, Text)] -> [(Outcome, Text)] -> [(Outcome, Text)]
forall a. [a] -> [a] -> [a]
++ [(Outcome, Text)]
endMsgDefault
)
endMsgDefault :: [(Outcome, Text)]
endMsgDefault =
[ (Outcome
FK.Restart, Text
"No shame there is in noble defeat and there is honour in perseverance. Sometimes there are ways and places to turn rout into victory.")
, (Outcome
FK.Camping, Text
"Don't fear to take breaks. While you move, others move, even on distant floors, but while you stay still, the world stays still.")
]
scoreRecords :: [ScoreRecord]
scoreRecords = [ScoreRecord]
-> (ScoreTable -> [ScoreRecord])
-> Maybe ScoreTable
-> [ScoreRecord]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ScoreTable -> [ScoreRecord]
HighScore.unTable (Maybe ScoreTable -> [ScoreRecord])
-> Maybe ScoreTable -> [ScoreRecord]
forall a b. (a -> b) -> a -> b
$ ContentId ModeKind -> ScoreDict -> Maybe ScoreTable
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup ContentId ModeKind
gameModeId ScoreDict
scoreDict
outcomeSeen :: FK.Outcome -> Bool
outcomeSeen :: Outcome -> Bool
outcomeSeen Outcome
outcome = case Outcome
outcome of
Outcome
FK.Camping -> ContentId ModeKind
gameModeId ContentId ModeKind -> EnumSet (ContentId ModeKind) -> Bool
forall k. Enum k => k -> EnumSet k -> Bool
`ES.member` EnumSet (ContentId ModeKind)
scampings
Outcome
FK.Restart -> ContentId ModeKind
gameModeId ContentId ModeKind -> EnumSet (ContentId ModeKind) -> Bool
forall k. Enum k => k -> EnumSet k -> Bool
`ES.member` EnumSet (ContentId ModeKind)
srestarts
Outcome
_ -> Outcome
outcome Outcome -> [Outcome] -> Bool
forall a. Eq a => a -> [a] -> 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 :: FK.Outcome
lastOutcome :: Outcome
lastOutcome = if [ScoreRecord] -> Bool
forall a. [a] -> Bool
null [ScoreRecord]
scoreRecords
then Outcome
FK.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 :: FK.Outcome -> AttrString
renderOutcome :: Outcome -> AttrString
renderOutcome Outcome
outcome =
let color :: Color
color | Outcome
outcome Outcome -> [Outcome] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Outcome]
FK.deafeatOutcomes = Color
Color.cVeryBadEvent
| Outcome
outcome Outcome -> [Outcome] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Outcome]
FK.victoryOutcomes = Color
Color.cVeryGoodEvent
| Bool
otherwise = Color
Color.cNeutralEvent
lastRemark :: Text
lastRemark
| Outcome
outcome Outcome -> Outcome -> Bool
forall a. Eq a => a -> a -> Bool
/= Outcome
lastOutcome = Text
""
| Outcome
outcome Outcome -> [Outcome] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Outcome]
FK.deafeatOutcomes = Text
"(last suffered ending)"
| Outcome
outcome Outcome -> [Outcome] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Outcome]
FK.victoryOutcomes = Text
"(last achieved ending)"
| Bool
otherwise = Text
"(last seen ending)"
in Text -> AttrString
textToAS Text
"Game over message when"
AttrString -> AttrString -> AttrString
<+:> (Color -> Text -> AttrString
textFgToAS Color
color (Text -> Text
T.toTitle (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Outcome -> Text
FK.nameOutcomePast Outcome
outcome)
AttrString -> AttrString -> AttrString
<+:> Text -> AttrString
textToAS Text
lastRemark)
AttrString -> AttrString -> AttrString
forall a. Semigroup a => a -> a -> a
<> Text -> AttrString
textToAS Text
":"
EnumMap DisplayFont Overlay -> m (EnumMap DisplayFont Overlay)
forall a. a -> m a
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 -> Overlay -> Overlay
xtranslateOverlay Int
2 (Overlay -> Overlay) -> Overlay -> Overlay
forall a b. (a -> b) -> a -> b
$ [AttrLine] -> Overlay
offsetOverlay
([AttrLine] -> Overlay) -> [AttrLine] -> Overlay
forall a b. (a -> b) -> a -> b
$ ((DisplayFont, [AttrLine]) -> [AttrLine])
-> [(DisplayFont, [AttrLine])] -> [AttrLine]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (DisplayFont, [AttrLine]) -> [AttrLine]
forall a b. (a, b) -> b
snd ([(DisplayFont, [AttrLine])] -> [AttrLine])
-> [(DisplayFont, [AttrLine])] -> [AttrLine]
forall a b. (a -> b) -> a -> b
$ [(DisplayFont, [AttrLine])]
blurb [(DisplayFont, [AttrLine])]
-> [(DisplayFont, [AttrLine])] -> [(DisplayFont, [AttrLine])]
forall a. [a] -> [a] -> [a]
++ [(DisplayFont, [AttrLine])]
blurbEnd
else (Overlay -> Overlay -> Overlay)
-> EnumMap DisplayFont Overlay
-> EnumMap DisplayFont Overlay
-> EnumMap DisplayFont Overlay
forall a k.
(a -> a -> a) -> EnumMap k a -> EnumMap k a -> EnumMap k a
EM.unionWith Overlay -> Overlay -> Overlay
forall a. [a] -> [a] -> [a]
(++)
((Overlay -> Overlay)
-> EnumMap DisplayFont Overlay -> EnumMap DisplayFont Overlay
forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
EM.map (Int -> Overlay -> Overlay
xtranslateOverlay Int
1)
(EnumMap DisplayFont Overlay -> EnumMap DisplayFont Overlay)
-> EnumMap DisplayFont Overlay -> EnumMap DisplayFont Overlay
forall a b. (a -> b) -> a -> b
$ [(DisplayFont, [AttrLine])] -> EnumMap DisplayFont Overlay
attrLinesToFontMap [(DisplayFont, [AttrLine])]
blurb)
((Overlay -> Overlay)
-> EnumMap DisplayFont Overlay -> EnumMap DisplayFont Overlay
forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
EM.map (Int -> Overlay -> Overlay
xtranslateOverlay (Int -> Overlay -> Overlay) -> Int -> Overlay -> Overlay
forall a b. (a -> b) -> a -> b
$ Int
rwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
(EnumMap DisplayFont Overlay -> EnumMap DisplayFont Overlay)
-> EnumMap DisplayFont Overlay -> EnumMap DisplayFont Overlay
forall a b. (a -> b) -> a -> b
$ [(DisplayFont, [AttrLine])] -> EnumMap DisplayFont Overlay
attrLinesToFontMap [(DisplayFont, [AttrLine])]
blurbEnd)
pickNumber :: MonadClientUI m => Bool -> Int -> m (Either MError Int)
pickNumber :: forall (m :: * -> *).
MonadClientUI m =>
Bool -> Int -> m (Either MError Int)
pickNumber Bool
askNumber Int
kAll = Bool -> m (Either MError Int) -> m (Either MError Int)
forall a. HasCallStack => Bool -> a -> a
assert (Int
kAll Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1) (m (Either MError Int) -> m (Either MError Int))
-> m (Either MError Int) -> m (Either MError Int)
forall a b. (a -> b) -> a -> b
$ do
let shownKeys :: [KM]
shownKeys = [ KM
K.returnKM, KM
K.spaceKM, Char -> KM
K.mkChar Char
'+', Char -> KM
K.mkChar Char
'-'
, KM
K.backspaceKM, KM
K.escKM ]
frontKeyKeys :: [KM]
frontKeyKeys = [KM]
shownKeys [KM] -> [KM] -> [KM]
forall a. [a] -> [a] -> [a]
++ (Char -> KM) -> String -> [KM]
forall a b. (a -> b) -> [a] -> [b]
map Char -> KM
K.mkChar [Char
'0'..Char
'9']
gatherNumber :: Int -> m (Either MError Int)
gatherNumber Int
kCur = Bool -> m (Either MError Int) -> m (Either MError Int)
forall a. HasCallStack => Bool -> a -> a
assert (Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
kCur Bool -> Bool -> Bool
&& Int
kCur Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
kAll) (m (Either MError Int) -> m (Either MError Int))
-> m (Either MError Int) -> m (Either MError Int)
forall a b. (a -> b) -> a -> b
$ do
let kprompt :: Text
kprompt = Text
"Choose number:" Text -> Text -> Text
<+> Int -> Text
forall a. Show a => a -> Text
tshow Int
kCur
MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgPromptGeneric Text
kprompt
Slideshow
sli <- [KM] -> m Slideshow
forall (m :: * -> *). MonadClientUI m => [KM] -> m Slideshow
reportToSlideshow [KM]
shownKeys
KeyOrSlot
ekkm <- String -> ColorMode -> Bool -> Slideshow -> [KM] -> m KeyOrSlot
forall (m :: * -> *).
MonadClientUI m =>
String -> ColorMode -> Bool -> Slideshow -> [KM] -> m KeyOrSlot
displayChoiceScreen String
"" ColorMode
ColorFull Bool
False Slideshow
sli [KM]
frontKeyKeys
case KeyOrSlot
ekkm of
Left KM
kkm ->
case KM -> Key
K.key KM
kkm of
K.Char Char
'+' ->
Int -> m (Either MError Int)
gatherNumber (Int -> m (Either MError Int)) -> Int -> m (Either MError Int)
forall a b. (a -> b) -> a -> b
$ if Int
kCur Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
kAll then Int
1 else Int
kCur Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
K.Char Char
'-' ->
Int -> m (Either MError Int)
gatherNumber (Int -> m (Either MError Int)) -> Int -> m (Either MError Int)
forall a b. (a -> b) -> a -> b
$ if Int
kCur Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 then Int
kAll else Int
kCur Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
K.Char Char
l | Int
kCur Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
Char.digitToInt Char
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
kAll ->
Int -> m (Either MError Int)
gatherNumber (Int -> m (Either MError Int)) -> Int -> m (Either MError Int)
forall a b. (a -> b) -> a -> b
$ if Char -> Int
Char.digitToInt Char
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
then Int
kAll
else Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
kAll (Char -> Int
Char.digitToInt Char
l)
K.Char Char
l -> Int -> m (Either MError Int)
gatherNumber (Int -> m (Either MError Int)) -> Int -> m (Either MError Int)
forall a b. (a -> b) -> a -> b
$ Int
kCur Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
Char.digitToInt Char
l
Key
K.BackSpace -> Int -> m (Either MError Int)
gatherNumber (Int -> m (Either MError Int)) -> Int -> m (Either MError Int)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Int
kCur Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
10)
Key
K.Return -> Either MError Int -> m (Either MError Int)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either MError Int -> m (Either MError Int))
-> Either MError Int -> m (Either MError Int)
forall a b. (a -> b) -> a -> b
$ Int -> Either MError Int
forall a b. b -> Either a b
Right Int
kCur
Key
K.Esc -> FailOrCmd Int -> Either MError Int
forall a. FailOrCmd a -> Either MError a
weaveJust (FailOrCmd Int -> Either MError Int)
-> m (FailOrCmd Int) -> m (Either MError Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> m (FailOrCmd Int)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith Text
"never mind"
Key
K.Space -> Either MError Int -> m (Either MError Int)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either MError Int -> m (Either MError Int))
-> Either MError Int -> m (Either MError Int)
forall a b. (a -> b) -> a -> b
$ MError -> Either MError Int
forall a b. a -> Either a b
Left MError
forall a. Maybe a
Nothing
Key
_ -> String -> m (Either MError Int)
forall a. HasCallStack => String -> a
error (String -> m (Either MError Int))
-> String -> m (Either MError Int)
forall a b. (a -> b) -> a -> b
$ String
"unexpected key" String -> KM -> String
forall v. Show v => String -> v -> String
`showFailure` KM
kkm
Right MenuSlot
slot -> String -> m (Either MError Int)
forall a. HasCallStack => String -> a
error (String -> m (Either MError Int))
-> String -> m (Either MError Int)
forall a b. (a -> b) -> a -> b
$ String
"unexpected menu slot" String -> MenuSlot -> String
forall v. Show v => String -> v -> String
`showFailure` MenuSlot
slot
if Int
kAll Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
askNumber
then Either MError Int -> m (Either MError Int)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either MError Int -> m (Either MError Int))
-> Either MError Int -> m (Either MError Int)
forall a b. (a -> b) -> a -> b
$ Int -> Either MError Int
forall a b. b -> Either a b
Right Int
kAll
else do
Either MError Int
res <- Int -> m (Either MError Int)
gatherNumber Int
kAll
case Either MError Int
res of
Right Int
k | Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 -> String -> m (Either MError Int)
forall a. HasCallStack => String -> a
error (String -> m (Either MError Int))
-> String -> m (Either MError Int)
forall a b. (a -> b) -> a -> b
$ String
"" String -> (Either MError Int, Int) -> String
forall v. Show v => String -> v -> String
`showFailure` (Either MError Int
res, Int
kAll)
Either MError Int
_ -> Either MError Int -> m (Either MError Int)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Either MError Int
res
lookAtTile :: MonadClientUI m
=> Bool
-> Point
-> LevelId
-> Maybe ActorId
-> Maybe MU.Person
-> m (Text, Text, [(Int, MU.Part)])
lookAtTile :: forall (m :: * -> *).
MonadClientUI m =>
Bool
-> Point
-> LevelId
-> Maybe ActorId
-> Maybe Person
-> m (Text, Text, [(Int, Part)])
lookAtTile Bool
canSee Point
p LevelId
lidV Maybe ActorId
maid Maybe Person
mperson = do
CCUI{coscreen :: CCUI -> ScreenContent
coscreen=ScreenContent{Int
rwidth :: ScreenContent -> Int
rwidth :: Int
rwidth}} <- (SessionUI -> CCUI) -> m CCUI
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
cops :: COps
cops@COps{ContentData TileKind
cotile :: ContentData TileKind
cotile :: COps -> ContentData TileKind
cotile, ContentData PlaceKind
coplace :: COps -> ContentData PlaceKind
coplace :: ContentData PlaceKind
coplace} <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall a. (StateClient -> a) -> m a
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 a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> EnumMap FactionId Faction
sfactionD
Maybe Actor
mb <- (State -> Maybe Actor) -> m (Maybe Actor)
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Maybe Actor) -> m (Maybe Actor))
-> (State -> Maybe Actor) -> m (Maybe Actor)
forall a b. (a -> b) -> a -> b
$ \State
s -> (ActorId -> State -> Actor) -> State -> ActorId -> Actor
forall a b c. (a -> b -> c) -> b -> a -> c
flip ActorId -> State -> Actor
getActorBody State
s (ActorId -> Actor) -> Maybe ActorId -> Maybe Actor
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ActorId
maid
Level
lvl <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel LevelId
lidV
Maybe AimMode
saimMode <- (SessionUI -> Maybe AimMode) -> m (Maybe AimMode)
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe AimMode
saimMode
ItemBag
embeds <- (State -> ItemBag) -> m ItemBag
forall a. (State -> a) -> m a
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 a. (State -> a) -> m a
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 a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Int
seps
Time
localTime <- (State -> Time) -> m Time
forall a. (State -> a) -> m a
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 a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemId -> ItemKind) -> m (ItemId -> ItemKind))
-> (State -> ItemId -> ItemKind) -> m (ItemId -> ItemKind)
forall a b. (a -> b) -> a -> b
$ (ItemId -> State -> ItemKind) -> State -> ItemId -> ItemKind
forall a b c. (a -> b -> c) -> b -> a -> c
flip ItemId -> State -> ItemKind
getIidKind
let inhabitants :: [ActorId]
inhabitants = Point -> Level -> [ActorId]
posToAidsLvl Point
p Level
lvl
detail :: DetailLevel
detail = DetailLevel
-> (AimMode -> DetailLevel) -> Maybe AimMode -> DetailLevel
forall b a. b -> (a -> b) -> Maybe a -> b
maybe DetailLevel
DetailAll AimMode -> DetailLevel
detailLevel Maybe AimMode
saimMode
aims :: Bool
aims = Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Int -> Bool) -> Maybe Int -> Bool
forall a b. (a -> b) -> a -> b
$ (\Actor
b -> Bool -> Actor -> Point -> Int -> COps -> Level -> Maybe Int
makeLine Bool
False Actor
b Point
p Int
seps COps
cops Level
lvl) (Actor -> Maybe Int) -> Maybe Actor -> Maybe Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Actor
mb
tkid :: ContentId TileKind
tkid = Level
lvl Level -> Point -> ContentId TileKind
`at` Point
p
tile :: TileKind
tile = ContentData TileKind -> ContentId TileKind -> TileKind
forall a. ContentData a -> ContentId a -> a
okind ContentData TileKind
cotile ContentId TileKind
tkid
vis :: Part
vis | TileKind -> Text
TK.tname TileKind
tile Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"unknown space" = Part
"that is"
| Bool -> Bool
not ([ActorId] -> Bool
forall a. [a] -> Bool
null [ActorId]
inhabitants)
Bool -> Bool -> Bool
&& (Actor -> Point
bpos (Actor -> Point) -> Maybe Actor -> Maybe Point
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Actor
mb) Maybe Point -> Maybe Point -> Bool
forall a. Eq a => a -> a -> Bool
/= Point -> Maybe Point
forall a. a -> Maybe a
Just Point
p = Part
"the terrain here is"
| Bool -> Bool
not Bool
canSee = Part
"you remember"
| Bool -> Bool
not Bool
aims = Part
"you are aware of"
| Bool
otherwise = Part
"you see"
vperson :: Part
vperson = case Maybe Person
mperson of
Maybe Person
Nothing -> Part
vis
Just Person
MU.Sg1st -> String -> Part
forall a. HasCallStack => String -> a
error String
"an item speaks in first person"
Just Person
MU.Sg3rd -> Part
"It is laying on"
Just Person
MU.PlEtc -> Part
"They lay on"
tilePart :: Part
tilePart = Part -> Part
MU.AW (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ TileKind -> Text
TK.tname TileKind
tile
entrySentence :: ContentId PlaceKind -> Part -> Text
entrySentence ContentId PlaceKind
pk Part
blurb =
[Part] -> Text
makeSentence [Part
blurb, Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ PlaceKind -> Text
PK.pname (PlaceKind -> Text) -> PlaceKind -> Text
forall a b. (a -> b) -> a -> b
$ ContentData PlaceKind -> ContentId PlaceKind -> PlaceKind
forall a. ContentData a -> ContentId a -> a
okind ContentData PlaceKind
coplace ContentId PlaceKind
pk]
placeBlurb :: Text
placeBlurb = case Point -> EntryMap -> Maybe PlaceEntry
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup Point
p (EntryMap -> Maybe PlaceEntry) -> EntryMap -> Maybe PlaceEntry
forall a b. (a -> b) -> a -> b
$ Level -> EntryMap
lentry Level
lvl of
Maybe PlaceEntry
Nothing -> Text
""
Just (PK.PEntry ContentId PlaceKind
pk) -> ContentId PlaceKind -> Part -> Text
entrySentence ContentId PlaceKind
pk Part
"it is an entrance to"
Just (PK.PAround ContentId PlaceKind
pk) -> ContentId PlaceKind -> Part -> Text
entrySentence ContentId PlaceKind
pk Part
"it surrounds"
Just (PK.PExists ContentId PlaceKind
_) -> Text
""
embedLook :: (ItemId, ItemQuant) -> (Int, Part)
embedLook (ItemId
iid, kit :: ItemQuant
kit@(Int
k, ItemTimers
_)) =
let itemFull :: ItemFull
itemFull = ItemId -> ItemFull
itemToF ItemId
iid
nWs :: Part
nWs = DetailLevel
-> Int
-> FactionId
-> EnumMap FactionId Faction
-> Int
-> Time
-> ItemFull
-> ItemQuant
-> Part
partItemWsDetail DetailLevel
detail
Int
rwidth FactionId
side EnumMap FactionId Faction
factionD Int
k Time
localTime ItemFull
itemFull ItemQuant
kit
in (Int
k, Part
nWs)
embedKindList :: [(ItemKind, (ItemId, ItemQuant))]
embedKindList =
((ItemId, ItemQuant) -> (ItemKind, (ItemId, ItemQuant)))
-> [(ItemId, ItemQuant)] -> [(ItemKind, (ItemId, ItemQuant))]
forall a b. (a -> b) -> [a] -> [b]
map (\(ItemId
iid, ItemQuant
kit) -> (ItemId -> ItemKind
getKind ItemId
iid, (ItemId
iid, ItemQuant
kit))) (ItemBag -> [(ItemId, ItemQuant)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs ItemBag
embeds)
embedList :: [(Int, Part)]
embedList = ((ItemId, ItemQuant) -> (Int, Part))
-> [(ItemId, ItemQuant)] -> [(Int, Part)]
forall a b. (a -> b) -> [a] -> [b]
map (ItemId, ItemQuant) -> (Int, Part)
embedLook ([(ItemId, ItemQuant)] -> [(Int, Part)])
-> [(ItemId, ItemQuant)] -> [(Int, Part)]
forall a b. (a -> b) -> a -> b
$ COps
-> ContentId TileKind
-> [(ItemKind, (ItemId, ItemQuant))]
-> [(ItemId, ItemQuant)]
sortEmbeds COps
cops ContentId TileKind
tkid [(ItemKind, (ItemId, ItemQuant))]
embedKindList
(Text, Text, [(Int, Part)]) -> m (Text, Text, [(Int, Part)])
forall a. a -> m a
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 :: forall (m :: * -> *).
MonadClientUI m =>
Point -> LevelId -> m (Text, Maybe (Part, Bool), Text)
lookAtActors Point
p LevelId
lidV = do
CCUI{coscreen :: CCUI -> ScreenContent
coscreen=ScreenContent{Int
rwidth :: ScreenContent -> Int
rwidth :: Int
rwidth}} <- (SessionUI -> CCUI) -> m CCUI
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
[(ActorId, Actor)]
inhabitants <- (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
forall a. (State -> a) -> m a
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 a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> EnumMap FactionId Faction
sfactionD
Time
localTime <- (State -> Time) -> m Time
forall a. (State -> a) -> m a
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 a. (SessionUI -> a) -> m a
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 a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
"", Maybe (Part, Bool)
forall a. Maybe a
Nothing, Text
"")
(ActorId
aid, Actor
body) : [(ActorId, Actor)]
rest -> do
Part
actorPronoun <- ActorId -> m Part
forall (m :: * -> *). MonadClientUI m => ActorId -> m Part
partPronounLeader ActorId
aid
ItemFull
itemFull <- (State -> ItemFull) -> m ItemFull
forall a. (State -> a) -> m a
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 a. (State -> a) -> m a
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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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
(Part
subject, Person
person) = [Part] -> (Part, Person)
squashedWWandW [Part]
subjects
resideVerb :: Part
resideVerb = case Actor -> Watchfulness
bwatch Actor
body of
Watchfulness
WWatch -> Part
"be here"
WWait Int
0 -> Part
"idle here"
WWait Int
_ -> Part
"brace for impact"
Watchfulness
WSleep -> Part
"sleep here"
Watchfulness
WWake -> Part
"be waking up"
flyVerb :: Part
flyVerb | Actor -> Bool
bproj Actor
body = Part
"zip through here"
| Maybe ([Vector], Speed) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe ([Vector], Speed) -> Bool)
-> Maybe ([Vector], Speed) -> Bool
forall a b. (a -> b) -> a -> b
$ Actor -> Maybe ([Vector], Speed)
btrajectory Actor
body = Part
"move through here"
| Bool
otherwise = Part
resideVerb
verbs :: [Part]
verbs = Part
flyVerb Part -> [Part] -> [Part]
forall a. a -> [a] -> [a]
: [Part]
guardVerbs
projDesc :: Text
projDesc | Bool -> Bool
not (Actor -> Bool
bproj Actor
body) Bool -> Bool -> Bool
|| DetailLevel
detail DetailLevel -> DetailLevel -> Bool
forall a. Ord a => a -> a -> Bool
< DetailLevel
DetailHigh = Text
""
| Bool
otherwise =
let kit :: ItemQuant
kit = Actor -> ItemBag
beqp Actor
body ItemBag -> ItemId -> ItemQuant
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> ItemId
btrunk Actor
body
ps :: [Part]
ps = [Int
-> FactionId
-> EnumMap FactionId Faction
-> Time
-> ItemFull
-> ItemQuant
-> Part
partItemMediumAW Int
rwidth FactionId
side EnumMap FactionId Faction
factionD Time
localTime
ItemFull
itemFull ItemQuant
kit]
tailWords :: [Part] -> [Text]
tailWords = [Text] -> [Text]
forall a. HasCallStack => [a] -> [a]
tail ([Text] -> [Text]) -> ([Part] -> [Text]) -> [Part] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.words (Text -> [Text]) -> ([Part] -> Text) -> [Part] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Part] -> Text
makePhrase
in if [Part] -> [Text]
tailWords [Part]
ps [Text] -> [Text] -> Bool
forall a. Eq a => a -> a -> Bool
== [Part] -> [Text]
tailWords [Part]
subjects
then Text
""
else [Part] -> Text
makeSentence ([Part] -> Text) -> [Part] -> Text
forall a b. (a -> b) -> a -> b
$ Part
"this is" Part -> [Part] -> [Part]
forall a. a -> [a] -> [a]
: [Part]
ps
factDesc :: Text
factDesc = case Item -> Maybe FactionId
jfid (Item -> Maybe FactionId) -> Item -> Maybe FactionId
forall a b. (a -> b) -> a -> b
$ ItemFull -> Item
itemBase ItemFull
itemFull of
Just FactionId
tfid | FactionId
tfid FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
/= Actor -> FactionId
bfid Actor
body ->
let dominatedBy :: Text
dominatedBy = if Actor -> FactionId
bfid Actor
body FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side then Text
"us" else Faction -> Text
gname Faction
bfact
tfact :: Faction
tfact = EnumMap FactionId Faction
factionD EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
tfid
in Text
"Originally of" Text -> Text -> Text
<+> Faction -> Text
gname Faction
tfact
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", now fighting for" Text -> Text -> Text
<+> Text
dominatedBy Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
Maybe FactionId
_ | DetailLevel
detail DetailLevel -> DetailLevel -> Bool
forall a. Ord a => a -> a -> Bool
< DetailLevel
DetailHigh -> Text
""
Maybe FactionId
_ | Actor -> FactionId
bfid Actor
body FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side -> Text
""
Maybe FactionId
_ | Actor -> Bool
bproj Actor
body -> Text
"Launched by" Text -> Text -> Text
<+> Faction -> Text
gname Faction
bfact Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
Maybe FactionId
_ -> Text
"One of" Text -> Text -> Text
<+> Faction -> Text
gname Faction
bfact Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
idesc :: Text
idesc = if DetailLevel
detail DetailLevel -> DetailLevel -> Bool
forall a. Ord a => a -> a -> Bool
< DetailLevel
DetailHigh
then Text
""
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 (\(ActorId
_, Actor
b) -> Actor -> ItemId
btrunk Actor
b ItemId -> ItemId -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> ItemId
btrunk Actor
body) [(ActorId, Actor)]
rest
desc :: Text
desc = Text -> Text
wrapInParens (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
projDesc Text -> Text -> Text
<+> Text
factDesc Text -> Text -> Text
<+> Text
idesc
onlyIs :: Bool
onlyIs = Actor -> Watchfulness
bwatch Actor
body Watchfulness -> Watchfulness -> Bool
forall a. Eq a => a -> a -> Bool
== Watchfulness
WWatch Bool -> Bool -> Bool
&& [Part] -> Bool
forall a. [a] -> Bool
null [Part]
guardVerbs
allBlurb :: Text
allBlurb = [Part] -> Text
makeSentence [Part -> Person -> Polarity -> Part -> [Part] -> Part
MU.SubjectVVxV Part
"and" Person
person Polarity
MU.Yes
Part
subject [Part]
verbs]
headBlurb :: Text
headBlurb = [Part] -> Text
makeSentence [Part -> Person -> Polarity -> Part -> [Part] -> Part
MU.SubjectVVxV Part
"and" Person
MU.Sg3rd Polarity
MU.Yes
([Part] -> Part
forall a. HasCallStack => [a] -> a
head [Part]
subjects) [Part]
verbs]
andProjectiles :: Text
andProjectiles = case [Part]
subjects of
Part
_ : projs :: [Part]
projs@(Part
_ : [Part]
_) ->
let (Part
subjectProjs, Person
personProjs) =
[Part] -> (Part, Person)
squashedWWandW [Part]
projs
in [Part] -> Text
makeSentence
[Person -> Polarity -> Part -> Part -> Part
MU.SubjectVerb Person
personProjs Polarity
MU.Yes
Part
subjectProjs Part
"can be seen"]
[Part]
_ -> Text
""
actorAlive :: Bool
actorAlive = Actor -> Int64
bhp Actor
body Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int64
0
mactorPronounAlive :: Maybe (Part, Bool)
mactorPronounAlive =
if Actor -> Bool
bproj Actor
body then Maybe (Part, Bool)
forall a. Maybe a
Nothing else (Part, Bool) -> Maybe (Part, Bool)
forall a. a -> Maybe a
Just (Part
actorPronoun, Bool
actorAlive)
(Text, Maybe (Part, Bool), Text)
-> m (Text, Maybe (Part, Bool), Text)
forall a. a -> m a
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. HasCallStack => [a] -> a
head [Part]
subjects) Part
"lie here"
Part -> [Part] -> [Part]
forall a. a -> [a] -> [a]
: if [Part] -> Bool
forall a. [a] -> Bool
null [Part]
guardVerbs
then []
else [ Part -> Person -> Polarity -> Part -> [Part] -> Part
MU.SubjectVVxV Part
"and" Person
MU.Sg3rd Polarity
MU.No
Part
"and" [Part]
guardVerbs
, Part
"any more" ])
, Maybe (Part, Bool)
mactorPronounAlive
, Text -> Text
wrapInParens Text
desc Text -> Text -> Text
<+> Text
andProjectiles )
| Bool
sameTrunks ->
( Text
allBlurb
, Maybe (Part, Bool)
mactorPronounAlive
, Text
desc )
| Bool -> Bool
not (Actor -> Bool
bproj Actor
body) Bool -> Bool -> Bool
&& Bool
onlyIs ->
( Text
headBlurb
, Maybe (Part, Bool)
mactorPronounAlive
, Text
desc Text -> Text -> Text
<+> Text
andProjectiles )
| Bool -> Bool
not (Actor -> Bool
bproj Actor
body) ->
( [Part] -> Text
makeSentence [Part
subject, Part
"can be seen"] Text -> Text -> Text
<+> Text
headBlurb
, Maybe (Part, Bool)
mactorPronounAlive
, Text
desc )
| Bool
otherwise -> Bool
-> (Text, Maybe (Part, Bool), Text)
-> (Text, Maybe (Part, Bool), Text)
forall a. HasCallStack => Bool -> a -> a
assert (Actor -> Bool
bproj Actor
body Bool -> Bool -> Bool
&& Bool -> Bool
not ([(ActorId, Actor)] -> Bool
forall a. [a] -> Bool
null [(ActorId, Actor)]
rest))
( [Part] -> Text
makeSentence [Part
subject, Part
"can be seen"]
, Maybe (Part, Bool)
forall a. Maybe a
Nothing
, Text
"" )
guardItemVerbs :: Actor -> State -> [MU.Part]
guardItemVerbs :: Actor -> State -> [Part]
guardItemVerbs Actor
body State
s =
let itemsSize :: Int
itemsSize = Actor -> State -> Int
guardItemSize Actor
body State
s
belongingsVerbs :: [Part]
belongingsVerbs | Int
itemsSize Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = [Part
"fondle a trinket"]
| Int
itemsSize Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 = [Part
"haul a hoard"]
| Bool
otherwise = []
in if Actor -> Bool
bproj Actor
body then [] else [Part]
belongingsVerbs
guardItemSize :: Actor -> State -> Int
guardItemSize :: Actor -> State -> Int
guardItemSize Actor
body State
s =
let toReport :: ItemId -> Bool
toReport ItemId
iid =
let itemKind :: ItemKind
itemKind = ItemId -> State -> ItemKind
getIidKind ItemId
iid State
s
in Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (GroupName ItemKind -> [(GroupName ItemKind, Int)] -> Maybe Int
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup GroupName ItemKind
IK.UNREPORTED_INVENTORY (ItemKind -> [(GroupName ItemKind, Int)]
IK.ifreq ItemKind
itemKind)) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
in [ItemId] -> Int
forall a. [a] -> Int
length ([ItemId] -> Int) -> [ItemId] -> Int
forall a b. (a -> b) -> a -> b
$ (ItemId -> Bool) -> [ItemId] -> [ItemId]
forall a. (a -> Bool) -> [a] -> [a]
filter ItemId -> Bool
toReport ([ItemId] -> [ItemId]) -> [ItemId] -> [ItemId]
forall a b. (a -> b) -> a -> b
$ ItemBag -> [ItemId]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys (Actor -> ItemBag
beqp Actor
body)
lookAtItems :: MonadClientUI m
=> Bool
-> Point
-> LevelId
-> Maybe ActorId
-> Maybe (MU.Part, Bool)
-> m (Text, Maybe MU.Person)
lookAtItems :: forall (m :: * -> *).
MonadClientUI m =>
Bool
-> Point
-> LevelId
-> Maybe ActorId
-> Maybe (Part, Bool)
-> m (Text, Maybe Person)
lookAtItems Bool
canSee Point
p LevelId
lidV Maybe ActorId
maid Maybe (Part, Bool)
mactorPronounAlive = do
CCUI{coscreen :: CCUI -> ScreenContent
coscreen=ScreenContent{Int
rwidth :: ScreenContent -> Int
rwidth :: Int
rwidth}} <- (SessionUI -> CCUI) -> m CCUI
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
ItemId -> ItemFull
itemToF <- (State -> ItemId -> ItemFull) -> m (ItemId -> ItemFull)
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemId -> ItemFull) -> m (ItemId -> ItemFull))
-> (State -> ItemId -> ItemFull) -> m (ItemId -> ItemFull)
forall a b. (a -> b) -> a -> b
$ (ItemId -> State -> ItemFull) -> State -> ItemId -> ItemFull
forall a b c. (a -> b -> c) -> b -> a -> c
flip ItemId -> State -> ItemFull
itemToFull
Maybe Actor
mb <- (State -> Maybe Actor) -> m (Maybe Actor)
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Maybe Actor) -> m (Maybe Actor))
-> (State -> Maybe Actor) -> m (Maybe Actor)
forall a b. (a -> b) -> a -> b
$ \State
s -> (ActorId -> State -> Actor) -> State -> ActorId -> Actor
forall a b c. (a -> b -> c) -> b -> a -> c
flip ActorId -> State -> Actor
getActorBody State
s (ActorId -> Actor) -> Maybe ActorId -> Maybe Actor
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ActorId
maid
Maybe AimMode
saimMode <- (SessionUI -> Maybe AimMode) -> m (Maybe AimMode)
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe AimMode
saimMode
let standingOn :: Bool
standingOn = Point -> Maybe Point
forall a. a -> Maybe a
Just Point
p Maybe Point -> Maybe Point -> Bool
forall a. Eq a => a -> a -> Bool
== (Actor -> Point
bpos (Actor -> Point) -> Maybe Actor -> Maybe Point
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Actor
mb) Bool -> Bool -> Bool
&& LevelId -> Maybe LevelId
forall a. a -> Maybe a
Just LevelId
lidV Maybe LevelId -> Maybe LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== (Actor -> LevelId
blid (Actor -> LevelId) -> Maybe Actor -> Maybe LevelId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Actor
mb)
detailExploration :: DetailLevel
detailExploration = if Bool
standingOn Bool -> Bool -> Bool
&& FactionId -> Maybe FactionId
forall a. a -> Maybe a
Just FactionId
side Maybe FactionId -> Maybe FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== (Actor -> FactionId
bfid (Actor -> FactionId) -> Maybe Actor -> Maybe FactionId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Actor
mb)
then DetailLevel
DetailLow
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 a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Time) -> m Time) -> (State -> Time) -> m Time
forall a b. (a -> b) -> a -> b
$ LevelId -> State -> Time
getLocalTime LevelId
lidV
ItemBag
is <- (State -> ItemBag) -> m ItemBag
forall a. (State -> a) -> m a
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 a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> EnumMap FactionId Faction
sfactionD
Time
globalTime <- (State -> Time) -> m Time
forall a. (State -> a) -> m a
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 a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemId -> ContentId ItemKind)
-> m (ItemId -> ContentId ItemKind))
-> (State -> ItemId -> ContentId ItemKind)
-> m (ItemId -> ContentId ItemKind)
forall a b. (a -> b) -> a -> b
$ (ItemId -> State -> ContentId ItemKind)
-> State -> ItemId -> ContentId ItemKind
forall a b c. (a -> b -> c) -> b -> a -> c
flip ItemId -> State -> ContentId ItemKind
getIidKindId
Maybe (Part, Bool)
mLeader <- case Maybe ActorId
maid of
Just ActorId
aid | Bool
standingOn -> do
Part
leaderPronoun <- ActorId -> m Part
forall (m :: * -> *). MonadClientUI m => ActorId -> m Part
partPronounLeader ActorId
aid
Maybe (Part, Bool) -> m (Maybe (Part, Bool))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Part, Bool) -> m (Maybe (Part, Bool)))
-> Maybe (Part, Bool) -> m (Maybe (Part, Bool))
forall a b. (a -> b) -> a -> b
$ (Part, Bool) -> Maybe (Part, Bool)
forall a. a -> Maybe a
Just (Part
leaderPronoun, (Actor -> Int64
bhp (Actor -> Int64) -> Maybe Actor -> Maybe Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Actor
mb) Maybe Int64 -> Maybe Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int64 -> Maybe Int64
forall a. a -> Maybe a
Just Int64
0)
Maybe ActorId
_ -> Maybe (Part, Bool) -> m (Maybe (Part, Bool))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Part, Bool)
forall a. Maybe a
Nothing
let mactorPronounAliveLeader :: Maybe (Part, Bool)
mactorPronounAliveLeader = Maybe (Part, Bool)
mactorPronounAlive Maybe (Part, Bool) -> Maybe (Part, Bool) -> Maybe (Part, Bool)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (Part, Bool)
mLeader
(Part
subject, Text
verb) <- case Maybe (Part, Bool)
mactorPronounAliveLeader of
Just (Part
actorPronoun, Bool
actorAlive) ->
(Part, Text) -> m (Part, Text)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Part
actorPronoun, if Bool
actorAlive then Text
"stand over" else Text
"fall over")
Maybe (Part, Bool)
Nothing -> case Maybe ActorId
maid of
Just ActorId
aid -> do
Part
subjectAid <- ActorId -> m Part
forall (m :: * -> *). MonadClientUI m => ActorId -> m Part
partActorLeader ActorId
aid
(Part, Text) -> m (Part, Text)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Part
subjectAid, if Bool
canSee then Text
"notice" else Text
"remember")
Maybe ActorId
Nothing ->
(Part, Text) -> m (Part, Text)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Part
"one", if Bool
canSee then Text
"can see" else Text
"may remember")
let nWs :: (ItemId, ItemQuant) -> Part
nWs (ItemId
iid, kit :: ItemQuant
kit@(Int
k, ItemTimers
_)) =
DetailLevel
-> Int
-> FactionId
-> EnumMap FactionId Faction
-> Int
-> Time
-> ItemFull
-> ItemQuant
-> Part
partItemWsDetail DetailLevel
detail
Int
rwidth FactionId
side EnumMap FactionId Faction
factionD Int
k Time
localTime (ItemId -> ItemFull
itemToF ItemId
iid) ItemQuant
kit
(Part
object, Person
person) = case ItemBag -> [(ItemId, ItemQuant)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs ItemBag
is of
(ItemId, ItemQuant)
ii : (ItemId, ItemQuant)
_ : (ItemId, ItemQuant)
_ : [(ItemId, ItemQuant)]
_ | DetailLevel
detail DetailLevel -> DetailLevel -> Bool
forall a. Ord a => a -> a -> Bool
<= DetailLevel
DetailMedium ->
([Part] -> Part
MU.Phrase [(ItemId, ItemQuant) -> Part
nWs (ItemId, ItemQuant)
ii, Part
"and other items"], Person
MU.PlEtc)
[ii :: (ItemId, ItemQuant)
ii@(ItemId
_, (Int
1, ItemTimers
_))] -> ((ItemId, ItemQuant) -> Part
nWs (ItemId, ItemQuant)
ii, Person
MU.Sg3rd)
[(ItemId, ItemQuant)]
iis -> ([Part] -> Part
MU.WWandW ([Part] -> Part) -> [Part] -> Part
forall a b. (a -> b) -> a -> b
$ ((ItemId, ItemQuant) -> Part) -> [(ItemId, ItemQuant)] -> [Part]
forall a b. (a -> b) -> [a] -> [b]
map (ItemId, ItemQuant) -> Part
nWs ([(ItemId, ItemQuant)] -> [Part])
-> [(ItemId, ItemQuant)] -> [Part]
forall a b. (a -> b) -> a -> b
$ ((ItemId, ItemQuant) -> ContentId ItemKind)
-> [(ItemId, ItemQuant)] -> [(ItemId, ItemQuant)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (ItemId -> ContentId ItemKind
getKind (ItemId -> ContentId ItemKind)
-> ((ItemId, ItemQuant) -> ItemId)
-> (ItemId, ItemQuant)
-> ContentId ItemKind
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ItemId, ItemQuant) -> ItemId
forall a b. (a, b) -> a
fst) [(ItemId, ItemQuant)]
iis, Person
MU.PlEtc)
(Text, Maybe Person) -> m (Text, Maybe Person)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ( if ItemBag -> Bool
forall k a. EnumMap k a -> Bool
EM.null ItemBag
is Bool -> Bool -> Bool
|| Time
globalTime Time -> Time -> Bool
forall a. Eq a => a -> a -> Bool
== Time
timeZero
then Text
""
else [Part] -> Text
makeSentence [Part -> Part -> Part
MU.SubjectVerbSg Part
subject (Text -> Part
MU.Text Text
verb), Part
object]
, if Maybe (Part, Bool) -> Bool
forall a. Maybe a -> Bool
isNothing Maybe (Part, Bool)
mactorPronounAlive then Person -> Maybe Person
forall a. a -> Maybe a
Just Person
person else Maybe Person
forall a. Maybe a
Nothing )
lookAtStash :: MonadClientUI m => Point -> LevelId -> m Text
lookAtStash :: forall (m :: * -> *). MonadClientUI m => Point -> LevelId -> m Text
lookAtStash Point
p LevelId
lidV = do
FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall a. (StateClient -> a) -> m a
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 a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> EnumMap FactionId Faction
sfactionD
let locateStash :: (FactionId, Faction) -> Maybe Text
locateStash (FactionId
fid, Faction
fact) = case Faction -> Maybe (LevelId, Point)
gstash Faction
fact of
Just (LevelId
lid, Point
pos) | LevelId
lid LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== LevelId
lidV Bool -> Bool -> Bool
&& Point
pos Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Point
p ->
Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ if FactionId
fid FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side
then Text
"Here is the shared inventory stash of your team."
else Faction -> Text
gname Faction
fact
Text -> Text -> Text
<+> Text
"set up their shared inventory stash here."
Maybe (LevelId, Point)
_ -> Maybe Text
forall a. Maybe a
Nothing
Text -> m Text
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$! Text -> [Text] -> Text
T.intercalate Text
" " ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ ((FactionId, Faction) -> Maybe Text)
-> [(FactionId, Faction)] -> [Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (FactionId, Faction) -> Maybe Text
locateStash ([(FactionId, Faction)] -> [Text])
-> [(FactionId, Faction)] -> [Text]
forall a b. (a -> b) -> a -> b
$ EnumMap FactionId Faction -> [(FactionId, Faction)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs EnumMap FactionId Faction
factionD
lookAtPosition :: MonadClientUI m
=> Point -> LevelId -> m [(MsgClassShow, Text)]
lookAtPosition :: forall (m :: * -> *).
MonadClientUI m =>
Point -> LevelId -> m [(MsgClassShow, Text)]
lookAtPosition Point
p LevelId
lidV = do
COps{ContentData TileKind
cotile :: COps -> ContentData TileKind
cotile :: ContentData TileKind
cotile} <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
Perception
per <- LevelId -> m Perception
forall (m :: * -> *). MonadClientRead m => LevelId -> m Perception
getPerFid LevelId
lidV
let canSee :: Bool
canSee = Point -> EnumSet Point -> Bool
forall k. Enum k => k -> EnumSet k -> Bool
ES.member Point
p (Perception -> EnumSet Point
totalVisible Perception
per)
(Text
actorsBlurb, Maybe (Part, Bool)
mactorPronounAlive, Text
actorsDesc) <- Point -> LevelId -> m (Text, Maybe (Part, Bool), Text)
forall (m :: * -> *).
MonadClientUI m =>
Point -> LevelId -> m (Text, Maybe (Part, Bool), Text)
lookAtActors Point
p LevelId
lidV
Maybe ActorId
mleader <- (StateClient -> Maybe ActorId) -> m (Maybe ActorId)
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Maybe ActorId
sleader
(Text
itemsBlurb, Maybe Person
mperson) <-
Bool
-> Point
-> LevelId
-> Maybe ActorId
-> Maybe (Part, Bool)
-> m (Text, Maybe Person)
forall (m :: * -> *).
MonadClientUI m =>
Bool
-> Point
-> LevelId
-> Maybe ActorId
-> Maybe (Part, Bool)
-> m (Text, Maybe Person)
lookAtItems Bool
canSee Point
p LevelId
lidV Maybe ActorId
mleader Maybe (Part, Bool)
mactorPronounAlive
let tperson :: Maybe Person
tperson = if Text -> Bool
T.null Text
itemsBlurb then Maybe Person
forall a. Maybe a
Nothing else Maybe Person
mperson
(Text
tileBlurb, Text
placeBlurb, [(Int, Part)]
embedsList) <-
Bool
-> Point
-> LevelId
-> Maybe ActorId
-> Maybe Person
-> m (Text, Text, [(Int, Part)])
forall (m :: * -> *).
MonadClientUI m =>
Bool
-> Point
-> LevelId
-> Maybe ActorId
-> Maybe Person
-> m (Text, Text, [(Int, Part)])
lookAtTile Bool
canSee Point
p LevelId
lidV Maybe ActorId
mleader Maybe Person
tperson
[(ActorId, Actor)]
inhabitants <- (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
forall a. (State -> a) -> m a
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 <- Point -> LevelId -> m Text
forall (m :: * -> *). MonadClientUI m => Point -> LevelId -> m Text
lookAtStash Point
p LevelId
lidV
lvl :: Level
lvl@Level{SmellMap
lsmell :: SmellMap
lsmell :: Level -> SmellMap
lsmell, Time
ltime :: Time
ltime :: Level -> 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 a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe AimMode
saimMode
let detail :: DetailLevel
detail = DetailLevel
-> (AimMode -> DetailLevel) -> Maybe AimMode -> DetailLevel
forall b a. b -> (a -> b) -> Maybe a -> b
maybe DetailLevel
DetailAll AimMode -> DetailLevel
detailLevel Maybe AimMode
saimMode
smellBlurb :: Text
smellBlurb = case Point -> SmellMap -> Maybe Time
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup Point
p SmellMap
lsmell of
Just Time
sml | Time
sml Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
> Time
ltime ->
let Delta Time
t = Delta Time
smellTimeout Delta Time -> Delta Time -> Delta Time
`timeDeltaSubtract`
(Time
sml Time -> Time -> Delta Time
`timeDeltaToFrom` Time
ltime)
seconds :: Int
seconds = Time
t Time -> Time -> Int
`timeFitUp` Time
timeSecond
in Text
"A smelly body passed here around" Text -> Text -> Text
<+> Int -> Text
forall a. Show a => a -> Text
tshow Int
seconds Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"s ago."
Maybe Time
_ -> Text
""
ItemBag
embeds <- (State -> ItemBag) -> m ItemBag
forall a. (State -> a) -> m a
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 a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemId -> ItemKind) -> m (ItemId -> ItemKind))
-> (State -> ItemId -> ItemKind) -> m (ItemId -> ItemKind)
forall a b. (a -> b) -> a -> b
$ (ItemId -> State -> ItemKind) -> State -> ItemId -> ItemKind
forall a b c. (a -> b -> c) -> b -> a -> c
flip ItemId -> State -> ItemKind
getIidKind
let ppEmbedName :: (Int, MU.Part) -> Text
ppEmbedName :: (Int, Part) -> Text
ppEmbedName (Int
k, Part
part) =
let verb :: Part
verb = if Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then Part
"is" else Part
"are"
in [Part] -> Text
makeSentence [Part
"There", Part
verb, Part
part]
embedKindList :: [(ItemKind, (ItemId, ItemQuant))]
embedKindList = ((ItemId, ItemQuant) -> (ItemKind, (ItemId, ItemQuant)))
-> [(ItemId, ItemQuant)] -> [(ItemKind, (ItemId, ItemQuant))]
forall a b. (a -> b) -> [a] -> [b]
map (\(ItemId
iid, ItemQuant
kit) -> (ItemId -> ItemKind
getKind ItemId
iid, (ItemId
iid, ItemQuant
kit)))
(ItemBag -> [(ItemId, ItemQuant)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs ItemBag
embeds)
feats :: [Feature]
feats = TileKind -> [Feature]
TK.tfeature (TileKind -> [Feature]) -> TileKind -> [Feature]
forall a b. (a -> b) -> a -> b
$ ContentData TileKind -> ContentId TileKind -> TileKind
forall a. ContentData a -> ContentId a -> a
okind ContentData TileKind
cotile (ContentId TileKind -> TileKind) -> ContentId TileKind -> TileKind
forall a b. (a -> b) -> a -> b
$ Level
lvl Level -> Point -> ContentId TileKind
`at` Point
p
tileActions :: [TileAction]
tileActions = (Feature -> Maybe TileAction) -> [Feature] -> [TileAction]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Bool
-> Bool
-> [(ItemKind, (ItemId, ItemQuant))]
-> Feature
-> Maybe TileAction
parseTileAction Bool
False Bool
False [(ItemKind, (ItemId, ItemQuant))]
embedKindList)
[Feature]
feats
isEmbedAction :: TileAction -> Bool
isEmbedAction EmbedAction{} = Bool
True
isEmbedAction TileAction
_ = Bool
False
embedVerb :: [Part]
embedVerb = [ Part
"activated"
| (TileAction -> Bool) -> [TileAction] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any TileAction -> Bool
isEmbedAction [TileAction]
tileActions
Bool -> Bool -> Bool
&& ((ItemKind, (ItemId, ItemQuant)) -> Bool)
-> [(ItemKind, (ItemId, ItemQuant))] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\(ItemKind
itemKind, (ItemId, ItemQuant)
_) -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Effect] -> Bool
forall a. [a] -> Bool
null ([Effect] -> Bool) -> [Effect] -> Bool
forall a b. (a -> b) -> a -> b
$ ItemKind -> [Effect]
IK.ieffects ItemKind
itemKind)
[(ItemKind, (ItemId, ItemQuant))]
embedKindList ]
isToAction :: TileAction -> Bool
isToAction ToAction{} = Bool
True
isToAction TileAction
_ = Bool
False
isWithAction :: TileAction -> Bool
isWithAction WithAction{} = Bool
True
isWithAction TileAction
_ = Bool
False
isEmptyWithAction :: TileAction -> Bool
isEmptyWithAction (WithAction [] GroupName TileKind
_) = Bool
True
isEmptyWithAction TileAction
_ = Bool
False
alterVerb :: [Part]
alterVerb | (TileAction -> Bool) -> [TileAction] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any TileAction -> Bool
isEmptyWithAction [TileAction]
tileActions = [Part
"very easily modified"]
| (TileAction -> Bool) -> [TileAction] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any TileAction -> Bool
isToAction [TileAction]
tileActions = [Part
"easily modified"]
| (TileAction -> Bool) -> [TileAction] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any TileAction -> Bool
isWithAction [TileAction]
tileActions = [Part
"potentially modified"]
| Bool
otherwise = []
verbs :: [Part]
verbs = [Part]
embedVerb [Part] -> [Part] -> [Part]
forall a. [a] -> [a] -> [a]
++ [Part]
alterVerb
alterBlurb :: Text
alterBlurb = if [Part] -> Bool
forall a. [a] -> Bool
null [Part]
verbs
then Text
""
else [Part] -> Text
makeSentence [Part
"can be", [Part] -> Part
MU.WWandW [Part]
verbs]
toolFromAction :: TileAction -> Maybe [(Int, GroupName ItemKind)]
toolFromAction (WithAction [(Int, GroupName ItemKind)]
grps GroupName TileKind
_) = [(Int, GroupName ItemKind)] -> Maybe [(Int, GroupName ItemKind)]
forall a. a -> Maybe a
Just [(Int, GroupName ItemKind)]
grps
toolFromAction TileAction
_ = Maybe [(Int, GroupName ItemKind)]
forall a. Maybe a
Nothing
toolsToAlterWith :: [[(Int, GroupName ItemKind)]]
toolsToAlterWith = (TileAction -> Maybe [(Int, GroupName ItemKind)])
-> [TileAction] -> [[(Int, GroupName ItemKind)]]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe TileAction -> Maybe [(Int, GroupName ItemKind)]
toolFromAction [TileAction]
tileActions
tItems :: Text
tItems = [[(Int, GroupName ItemKind)]] -> Text
describeToolsAlternative [[(Int, GroupName ItemKind)]]
toolsToAlterWith
transformBlurb :: Text
transformBlurb = if Text -> Bool
T.null Text
tItems
then Text
""
else Text
"The following items on the ground or in equipment enable special transformations:"
Text -> Text -> Text
<+> Text
tItems Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
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
DetailMedium
Bool -> Bool -> Bool
|| Text -> Bool
T.null Text
stashBlurb Bool -> Bool -> Bool
&& Text -> Bool
T.null Text
actorsDesc
Bool -> Bool -> Bool
|| Text -> Bool
T.null Text
smellBlurb Bool -> Bool -> Bool
&& Text -> Bool
T.null Text
itemsBlurb
Bool -> Bool -> Bool
|| [(Int, Part)] -> Bool
forall a. [a] -> Bool
null [(Int, Part)]
embedsList Bool -> Bool -> Bool
&& Text -> Bool
T.null Text
modifyBlurb
then Text
""
else Text
"\n"
ms :: [(MsgClassShow, Text)]
ms = [ (MsgClassShow
MsgPromptAction, Text
stashBlurb)
, (MsgClassShow
actorMsgClass, Text
actorsBlurb)
, (MsgClassShow
MsgPromptGeneric, Text
actorsDesc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
midEOL) ]
[(MsgClassShow, Text)]
-> [(MsgClassShow, Text)] -> [(MsgClassShow, Text)]
forall a. [a] -> [a] -> [a]
++ [(MsgClassShow
MsgPromptGeneric, Text
smellBlurb) | DetailLevel
detail DetailLevel -> DetailLevel -> Bool
forall a. Ord a => a -> a -> Bool
>= DetailLevel
DetailMedium]
[(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
DetailMedium
Bool -> Bool -> Bool
|| DetailLevel
detail DetailLevel -> DetailLevel -> Bool
forall a. Eq a => a -> a -> Bool
== DetailLevel
DetailLow
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
DetailMedium]
[(MsgClassShow, Text)]
-> [(MsgClassShow, Text)] -> [(MsgClassShow, Text)]
forall a. [a] -> [a] -> [a]
++ case DetailLevel
detail of
DetailLevel
DetailLow -> []
DetailLevel
_ -> let n :: Int
n = [Int] -> Int
forall a. Num a => [a] -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ ((Int, Part) -> Int) -> [(Int, Part)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Part) -> Int
forall a b. (a, b) -> a
fst [(Int, Part)]
embedsList
wWandW :: Part
wWandW = [Part] -> Part
MU.WWandW ([Part] -> Part) -> [Part] -> Part
forall a b. (a -> b) -> a -> b
$ ((Int, Part) -> Part) -> [(Int, Part)] -> [Part]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Part) -> Part
forall a b. (a, b) -> b
snd [(Int, Part)]
embedsList
in [(MsgClassShow
MsgPromptMention, (Int, Part) -> Text
ppEmbedName (Int
n, Part
wWandW)) | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0]
[(MsgClassShow, Text)]
-> [(MsgClassShow, Text)] -> [(MsgClassShow, Text)]
forall a. [a] -> [a] -> [a]
++ [(MsgClassShow
MsgPromptModify, Text
modifyBlurb) | DetailLevel
detail DetailLevel -> DetailLevel -> Bool
forall a. Ord a => a -> a -> Bool
>= DetailLevel
DetailHigh]
[(MsgClassShow, Text)] -> m [(MsgClassShow, Text)]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(MsgClassShow, Text)] -> m [(MsgClassShow, Text)])
-> [(MsgClassShow, Text)] -> m [(MsgClassShow, Text)]
forall a b. (a -> b) -> a -> b
$! if ((MsgClassShow, Text) -> Bool) -> [(MsgClassShow, Text)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Text -> Bool
T.null (Text -> Bool)
-> ((MsgClassShow, Text) -> Text) -> (MsgClassShow, Text) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MsgClassShow, Text) -> Text
forall a b. (a, b) -> b
snd) [(MsgClassShow, Text)]
ms Bool -> Bool -> Bool
&& DetailLevel
detail DetailLevel -> DetailLevel -> Bool
forall a. Ord a => a -> a -> Bool
> DetailLevel
DetailLow
then [(MsgClassShow
MsgPromptFocus, Text
tileBlurb)]
else [(MsgClassShow, Text)]
ms
displayOneMenuItem :: MonadClientUI m
=> (MenuSlot -> m OKX) -> [K.KM] -> Int -> MenuSlot
-> m K.KM
MenuSlot -> m OKX
renderOneItem [KM]
extraKeys Int
slotBound MenuSlot
slot = do
CCUI{coscreen :: CCUI -> ScreenContent
coscreen=ScreenContent{Int
rheight :: ScreenContent -> Int
rheight :: Int
rheight}} <- (SessionUI -> CCUI) -> m CCUI
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
let keys :: [KM]
keys = [KM
K.spaceKM, KM
K.escKM]
[KM] -> [KM] -> [KM]
forall a. [a] -> [a] -> [a]
++ [KM
K.upKM | MenuSlot -> Int
forall a. Enum a => a -> Int
fromEnum MenuSlot
slot Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0]
[KM] -> [KM] -> [KM]
forall a. [a] -> [a] -> [a]
++ [KM
K.downKM | MenuSlot -> Int
forall a. Enum a => a -> Int
fromEnum MenuSlot
slot Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
slotBound]
[KM] -> [KM] -> [KM]
forall a. [a] -> [a] -> [a]
++ [KM]
extraKeys
OKX
okx <- MenuSlot -> m OKX
renderOneItem MenuSlot
slot
Slideshow
slides <- Int -> [KM] -> OKX -> m Slideshow
forall (m :: * -> *).
MonadClientUI m =>
Int -> [KM] -> OKX -> m Slideshow
overlayToSlideshow (Int
rheight Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) [KM]
keys OKX
okx
KM
km <- ColorMode -> [KM] -> Slideshow -> m KM
forall (m :: * -> *).
MonadClientUI m =>
ColorMode -> [KM] -> Slideshow -> m KM
getConfirms ColorMode
ColorFull [KM]
keys Slideshow
slides
case KM -> Key
K.key KM
km of
Key
K.Up -> (MenuSlot -> m OKX) -> [KM] -> Int -> MenuSlot -> m KM
forall (m :: * -> *).
MonadClientUI m =>
(MenuSlot -> m OKX) -> [KM] -> Int -> MenuSlot -> m KM
displayOneMenuItem MenuSlot -> m OKX
renderOneItem [KM]
extraKeys Int
slotBound (MenuSlot -> m KM) -> MenuSlot -> m KM
forall a b. (a -> b) -> a -> b
$ MenuSlot -> MenuSlot
forall a. Enum a => a -> a
pred MenuSlot
slot
Key
K.Down -> (MenuSlot -> m OKX) -> [KM] -> Int -> MenuSlot -> m KM
forall (m :: * -> *).
MonadClientUI m =>
(MenuSlot -> m OKX) -> [KM] -> Int -> MenuSlot -> m KM
displayOneMenuItem MenuSlot -> m OKX
renderOneItem [KM]
extraKeys Int
slotBound (MenuSlot -> m KM) -> MenuSlot -> m KM
forall a b. (a -> b) -> a -> b
$ MenuSlot -> MenuSlot
forall a. Enum a => a -> a
succ MenuSlot
slot
Key
_ -> KM -> m KM
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return KM
km
okxItemLoreInline :: MonadClientUI m
=> (ItemId -> ItemFull -> Int -> Text)
-> Int -> ItemDialogMode -> [(ItemId, ItemQuant)]
-> Int -> MenuSlot
-> m OKX
okxItemLoreInline :: forall (m :: * -> *).
MonadClientUI m =>
(ItemId -> ItemFull -> Int -> Text)
-> Int
-> ItemDialogMode
-> [(ItemId, ItemQuant)]
-> Int
-> MenuSlot
-> m OKX
okxItemLoreInline ItemId -> ItemFull -> Int -> Text
promptFun Int
meleeSkill ItemDialogMode
dmode [(ItemId, ItemQuant)]
iids Int
widthRaw MenuSlot
slot = do
FontSetup{DisplayFont
squareFont :: FontSetup -> DisplayFont
monoFont :: FontSetup -> DisplayFont
propFont :: FontSetup -> DisplayFont
squareFont :: DisplayFont
monoFont :: DisplayFont
propFont :: DisplayFont
..} <- m FontSetup
forall (m :: * -> *). MonadClientUI m => m FontSetup
getFontSetup
let (ItemId
iid, kit :: ItemQuant
kit@(Int
k, ItemTimers
_)) = [(ItemId, ItemQuant)]
iids [(ItemId, ItemQuant)] -> Int -> (ItemId, ItemQuant)
forall a. HasCallStack => [a] -> Int -> a
!! MenuSlot -> Int
forall a. Enum a => a -> Int
fromEnum MenuSlot
slot
width :: Int
width = Int
widthRaw Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
5
ItemFull
itemFull <- (State -> ItemFull) -> m ItemFull
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemFull) -> m ItemFull)
-> (State -> ItemFull) -> m ItemFull
forall a b. (a -> b) -> a -> b
$ ItemId -> State -> ItemFull
itemToFull ItemId
iid
(Overlay
ovLab, Overlay
ovDesc) <- Bool
-> Int
-> ItemDialogMode
-> ItemId
-> ItemQuant
-> ItemFull
-> Int
-> m (Overlay, Overlay)
forall (m :: * -> *).
MonadClientUI m =>
Bool
-> Int
-> ItemDialogMode
-> ItemId
-> ItemQuant
-> ItemFull
-> Int
-> m (Overlay, Overlay)
itemDescOverlays Bool
True Int
meleeSkill ItemDialogMode
dmode ItemId
iid ItemQuant
kit ItemFull
itemFull
Int
width
let prompt :: Text
prompt = ItemId -> ItemFull -> Int -> Text
promptFun ItemId
iid ItemFull
itemFull Int
k
promptBlurb :: Overlay
promptBlurb | Text -> Bool
T.null Text
prompt = []
| Bool
otherwise = [AttrLine] -> Overlay
offsetOverlay ([AttrLine] -> Overlay) -> [AttrLine] -> Overlay
forall a b. (a -> b) -> a -> b
$ Int -> Int -> AttrString -> [AttrLine]
splitAttrString Int
width Int
width
(AttrString -> [AttrLine]) -> AttrString -> [AttrLine]
forall a b. (a -> b) -> a -> b
$ Color -> Text -> AttrString
textFgToAS Color
Color.Brown (Text -> AttrString) -> Text -> AttrString
forall a b. (a -> b) -> a -> b
$ Text
prompt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n\n"
len :: Int
len = Overlay -> Int
forall a. [a] -> Int
length Overlay
promptBlurb
descSym2 :: Overlay
descSym2 = Int -> Overlay -> Overlay
ytranslateOverlay Int
len Overlay
ovLab
descBlurb2 :: Overlay
descBlurb2 = Overlay
promptBlurb Overlay -> Overlay -> Overlay
forall a. [a] -> [a] -> [a]
++ Int -> Overlay -> Overlay
ytranslateOverlay Int
len Overlay
ovDesc
ov :: EnumMap DisplayFont Overlay
ov = (Overlay -> Overlay -> Overlay)
-> DisplayFont
-> Overlay
-> EnumMap DisplayFont Overlay
-> EnumMap DisplayFont Overlay
forall k a.
Enum k =>
(a -> a -> a) -> k -> a -> EnumMap k a -> EnumMap k a
EM.insertWith Overlay -> Overlay -> Overlay
forall a. [a] -> [a] -> [a]
(++) DisplayFont
squareFont Overlay
descSym2
(EnumMap DisplayFont Overlay -> EnumMap DisplayFont Overlay)
-> EnumMap DisplayFont Overlay -> EnumMap DisplayFont Overlay
forall a b. (a -> b) -> a -> b
$ DisplayFont -> Overlay -> EnumMap DisplayFont Overlay
forall k a. Enum k => k -> a -> EnumMap k a
EM.singleton DisplayFont
propFont Overlay
descBlurb2
OKX -> m OKX
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (EnumMap DisplayFont Overlay
ov, [])
okxItemLoreMsg :: MonadClientUI m
=> (ItemId -> ItemFull -> Int -> Text)
-> Int -> ItemDialogMode -> [(ItemId, ItemQuant)]
-> MenuSlot
-> m OKX
okxItemLoreMsg :: forall (m :: * -> *).
MonadClientUI m =>
(ItemId -> ItemFull -> Int -> Text)
-> Int
-> ItemDialogMode
-> [(ItemId, ItemQuant)]
-> MenuSlot
-> m OKX
okxItemLoreMsg ItemId -> ItemFull -> Int -> Text
promptFun Int
meleeSkill ItemDialogMode
dmode [(ItemId, ItemQuant)]
iids MenuSlot
slot = do
CCUI{coscreen :: CCUI -> ScreenContent
coscreen=ScreenContent{Int
rwidth :: ScreenContent -> Int
rwidth :: Int
rwidth}} <- (SessionUI -> CCUI) -> m CCUI
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
FontSetup{DisplayFont
squareFont :: FontSetup -> DisplayFont
monoFont :: FontSetup -> DisplayFont
propFont :: FontSetup -> DisplayFont
squareFont :: DisplayFont
monoFont :: DisplayFont
propFont :: DisplayFont
..} <- m FontSetup
forall (m :: * -> *). MonadClientUI m => m FontSetup
getFontSetup
let (ItemId
iid, kit :: ItemQuant
kit@(Int
k, ItemTimers
_)) = [(ItemId, ItemQuant)]
iids [(ItemId, ItemQuant)] -> Int -> (ItemId, ItemQuant)
forall a. HasCallStack => [a] -> Int -> a
!! MenuSlot -> Int
forall a. Enum a => a -> Int
fromEnum MenuSlot
slot
ItemFull
itemFull <- (State -> ItemFull) -> m ItemFull
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemFull) -> m ItemFull)
-> (State -> ItemFull) -> m ItemFull
forall a b. (a -> b) -> a -> b
$ ItemId -> State -> ItemFull
itemToFull ItemId
iid
(Overlay
ovLab, Overlay
ovDesc) <- Bool
-> Int
-> ItemDialogMode
-> ItemId
-> ItemQuant
-> ItemFull
-> Int
-> m (Overlay, Overlay)
forall (m :: * -> *).
MonadClientUI m =>
Bool
-> Int
-> ItemDialogMode
-> ItemId
-> ItemQuant
-> ItemFull
-> Int
-> m (Overlay, Overlay)
itemDescOverlays Bool
True Int
meleeSkill ItemDialogMode
dmode ItemId
iid ItemQuant
kit ItemFull
itemFull
Int
rwidth
let prompt :: Text
prompt = ItemId -> ItemFull -> Int -> Text
promptFun ItemId
iid ItemFull
itemFull Int
k
MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgPromptGeneric Text
prompt
let ov :: EnumMap DisplayFont Overlay
ov = (Overlay -> Overlay -> Overlay)
-> DisplayFont
-> Overlay
-> EnumMap DisplayFont Overlay
-> EnumMap DisplayFont Overlay
forall k a.
Enum k =>
(a -> a -> a) -> k -> a -> EnumMap k a -> EnumMap k a
EM.insertWith Overlay -> Overlay -> Overlay
forall a. [a] -> [a] -> [a]
(++) DisplayFont
squareFont Overlay
ovLab
(EnumMap DisplayFont Overlay -> EnumMap DisplayFont Overlay)
-> EnumMap DisplayFont Overlay -> EnumMap DisplayFont Overlay
forall a b. (a -> b) -> a -> b
$ DisplayFont -> Overlay -> EnumMap DisplayFont Overlay
forall k a. Enum k => k -> a -> EnumMap k a
EM.singleton DisplayFont
propFont Overlay
ovDesc
OKX -> m OKX
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (EnumMap DisplayFont Overlay
ov, [])
itemDescOverlays :: MonadClientUI m
=> Bool -> Int -> ItemDialogMode -> ItemId -> ItemQuant
-> ItemFull -> Int
-> m (Overlay, Overlay)
itemDescOverlays :: forall (m :: * -> *).
MonadClientUI m =>
Bool
-> Int
-> ItemDialogMode
-> ItemId
-> ItemQuant
-> ItemFull
-> Int
-> m (Overlay, Overlay)
itemDescOverlays Bool
markParagraphs Int
meleeSkill ItemDialogMode
dmode ItemId
iid ItemQuant
kit ItemFull
itemFull Int
width = do
FontSetup{DisplayFont
squareFont :: FontSetup -> DisplayFont
squareFont :: DisplayFont
squareFont} <- m FontSetup
forall (m :: * -> *). MonadClientUI m => m FontSetup
getFontSetup
FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
LevelId
arena <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
getArenaUI
Time
localTime <- (State -> Time) -> m Time
forall a. (State -> a) -> m a
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 a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> EnumMap FactionId Faction
sfactionD
LevelId
jlid <- (SessionUI -> LevelId) -> m LevelId
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession ((SessionUI -> LevelId) -> m LevelId)
-> (SessionUI -> LevelId) -> m LevelId
forall a b. (a -> b) -> a -> b
$ LevelId -> Maybe LevelId -> LevelId
forall a. a -> Maybe a -> a
fromMaybe (Int -> LevelId
forall a. Enum a => Int -> a
toEnum Int
0) (Maybe LevelId -> LevelId)
-> (SessionUI -> Maybe LevelId) -> SessionUI -> LevelId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ItemId -> EnumMap ItemId LevelId -> Maybe LevelId
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup ItemId
iid (EnumMap ItemId LevelId -> Maybe LevelId)
-> (SessionUI -> EnumMap ItemId LevelId)
-> SessionUI
-> Maybe LevelId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessionUI -> EnumMap ItemId LevelId
sitemUI
let descAs :: AttrString
descAs = Int
-> Bool
-> FactionId
-> EnumMap FactionId Faction
-> Int
-> ItemDialogMode
-> Time
-> LevelId
-> ItemFull
-> ItemQuant
-> AttrString
itemDesc Int
width Bool
markParagraphs FactionId
side EnumMap FactionId Faction
factionD Int
meleeSkill
ItemDialogMode
dmode Time
localTime LevelId
jlid ItemFull
itemFull ItemQuant
kit
(Overlay, Overlay) -> m (Overlay, Overlay)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Overlay, Overlay) -> m (Overlay, Overlay))
-> (Overlay, Overlay) -> m (Overlay, Overlay)
forall a b. (a -> b) -> a -> b
$! DisplayFont -> Int -> AttrString -> (Overlay, Overlay)
labDescOverlay DisplayFont
squareFont Int
width AttrString
descAs
cycleLore :: MonadClientUI m => [m K.KM] -> [m K.KM] -> m ()
cycleLore :: forall (m :: * -> *). MonadClientUI m => [m KM] -> [m KM] -> m ()
cycleLore [m KM]
_ [] = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
cycleLore [m KM]
seen (m KM
m : [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 Char
'>' -> if [m KM] -> Bool
forall a. [a] -> Bool
null [m KM]
rest
then [m KM] -> [m KM] -> m ()
forall (m :: * -> *). MonadClientUI m => [m KM] -> [m KM] -> m ()
cycleLore [] ([m KM] -> [m KM]
forall a. [a] -> [a]
reverse ([m KM] -> [m KM]) -> [m KM] -> [m KM]
forall a b. (a -> b) -> a -> b
$ m KM
m m KM -> [m KM] -> [m KM]
forall a. a -> [a] -> [a]
: [m KM]
seen)
else [m KM] -> [m KM] -> m ()
forall (m :: * -> *). MonadClientUI m => [m KM] -> [m KM] -> m ()
cycleLore (m KM
m m KM -> [m KM] -> [m KM]
forall a. a -> [a] -> [a]
: [m KM]
seen) [m KM]
rest
| KM
km KM -> KM -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> KM
K.mkChar Char
'<' -> case [m KM]
seen of
m KM
prev : [m KM]
ps -> [m KM] -> [m KM] -> m ()
forall (m :: * -> *). MonadClientUI m => [m KM] -> [m KM] -> m ()
cycleLore [m KM]
ps (m KM
prev m KM -> [m KM] -> [m KM]
forall a. a -> [a] -> [a]
: m KM
m m KM -> [m KM] -> [m KM]
forall a. a -> [a] -> [a]
: [m KM]
rest)
[] -> case [m KM] -> [m KM]
forall a. [a] -> [a]
reverse (m KM
m m KM -> [m KM] -> [m KM]
forall a. a -> [a] -> [a]
: [m KM]
rest) of
m KM
prev : [m KM]
ps -> [m KM] -> [m KM] -> m ()
forall (m :: * -> *). MonadClientUI m => [m KM] -> [m KM] -> m ()
cycleLore [m KM]
ps [m KM
prev]
[] -> String -> m ()
forall a. HasCallStack => String -> a
error String
"cycleLore: screens disappeared"
| KM
km KM -> KM -> Bool
forall a. Eq a => a -> a -> Bool
== KM
K.escKM -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise -> String -> m ()
forall a. HasCallStack => String -> a
error String
"cycleLore: unexpected key"
spoilsBlurb :: Text -> Int -> Int -> Text
spoilsBlurb :: Text -> Int -> Int -> Text
spoilsBlurb Text
currencyName Int
total Int
dungeonTotal =
if | Int
dungeonTotal Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 ->
Text
"All the spoils of your team are of the practical kind."
| Int
total Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> Text
"Your team haven't found any genuine treasure yet."
| Bool
otherwise -> [Part] -> Text
makeSentence
[ Part
"your team's spoils are worth"
, Int -> Part -> Part
MU.CarAWs Int
total (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ Text -> Part
MU.Text Text
currencyName
, Part
"out of the rumoured total"
, Int -> Part
MU.Cardinal Int
dungeonTotal ]
ppContainerWownW :: MonadClientUI m
=> (ActorId -> m MU.Part) -> Bool -> Container -> m [MU.Part]
ppContainerWownW :: forall (m :: * -> *).
MonadClientUI m =>
(ActorId -> m Part) -> Bool -> Container -> m [Part]
ppContainerWownW ActorId -> m Part
ownerFun Bool
addPrepositions Container
c = case Container
c of
CFloor{} -> [Part] -> m [Part]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [Part
"nearby"]
CEmbed{} -> [Part] -> m [Part]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [Part
"embedded nearby"]
CActor ActorId
aid CStore
store -> do
FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
Actor
b <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
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 a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Text) -> m Text) -> (State -> Text) -> m Text
forall a b. (a -> b) -> a -> b
$ Faction -> Text
gname (Faction -> Text) -> (State -> Faction) -> State -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
b) (EnumMap FactionId Faction -> Faction)
-> (State -> EnumMap FactionId Faction) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap FactionId Faction
sfactionD
let (Text
preposition, Text
noun) = CStore -> (Text, Text)
ppCStore CStore
store
prep :: [Part]
prep = [Text -> Part
MU.Text Text
preposition | Bool
addPrepositions]
[Part] -> m [Part]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Part] -> m [Part]) -> [Part] -> m [Part]
forall a b. (a -> b) -> a -> b
$! [Part]
prep [Part] -> [Part] -> [Part]
forall a. [a] -> [a] -> [a]
++ case CStore
store of
CStore
CGround -> Text -> Part
MU.Text Text
noun Part -> [Part] -> [Part]
forall a. a -> [a] -> [a]
: if Actor -> Bool
bproj Actor
b then [] else [Part
"under", Part
owner]
CStore
CStash -> if Actor -> FactionId
bfid Actor
b FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
/= FactionId
side
then [Part -> Part -> Part
MU.WownW (Text -> Part
MU.Text Text
fidName) (Text -> Part
MU.Text Text
noun)]
else [Text -> Part
MU.Text Text
noun]
CStore
_ -> [Part -> Part -> Part
MU.WownW Part
owner (Text -> Part
MU.Text Text
noun)]
CTrunk{} -> String -> m [Part]
forall a. HasCallStack => String -> a
error (String -> m [Part]) -> String -> m [Part]
forall a b. (a -> b) -> a -> b
$ String
"" String -> Container -> String
forall v. Show v => String -> v -> String
`showFailure` Container
c
nxtGameMode :: COps -> Int -> (ContentId MK.ModeKind, MK.ModeKind)
nxtGameMode :: COps -> Int -> (ContentId ModeKind, ModeKind)
nxtGameMode COps{ContentData ModeKind
comode :: COps -> ContentData ModeKind
comode :: ContentData ModeKind
comode} Int
snxtScenario =
let f :: [(a, b)] -> p -> a -> b -> [(a, b)]
f ![(a, b)]
acc p
_p !a
i !b
a = (a
i, b
a) (a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
: [(a, b)]
acc
campaignModes :: [(ContentId ModeKind, ModeKind)]
campaignModes = ContentData ModeKind
-> GroupName ModeKind
-> ([(ContentId ModeKind, ModeKind)]
-> Int
-> ContentId ModeKind
-> ModeKind
-> [(ContentId ModeKind, ModeKind)])
-> [(ContentId ModeKind, ModeKind)]
-> [(ContentId ModeKind, ModeKind)]
forall a b.
ContentData a
-> GroupName a -> (b -> Int -> ContentId a -> a -> b) -> b -> b
ofoldlGroup' ContentData ModeKind
comode GroupName ModeKind
MK.CAMPAIGN_SCENARIO [(ContentId ModeKind, ModeKind)]
-> Int
-> ContentId ModeKind
-> ModeKind
-> [(ContentId ModeKind, ModeKind)]
forall {a} {b} {p}. [(a, b)] -> p -> a -> b -> [(a, b)]
f []
in [(ContentId ModeKind, ModeKind)]
campaignModes [(ContentId ModeKind, ModeKind)]
-> Int -> (ContentId ModeKind, ModeKind)
forall a. HasCallStack => [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)