module Game.LambdaHack.Client.UI.Watch.WatchUpdAtomicM
( watchRespUpdAtomicUI
#ifdef EXPOSE_INTERNAL
, updateItemSlot, Threat, createActorUI, destroyActorUI, spotItemBag
, recordItemLid, moveActor, displaceActorUI, moveItemUI
, discover, ppHearMsg, ppHearDistanceAdjective, ppHearDistanceAdverb
#endif
) where
import Prelude ()
import Game.LambdaHack.Core.Prelude
import Control.Concurrent (threadDelay)
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 Data.Tuple
import GHC.Exts (inline)
import qualified NLP.Miniutter.English as MU
import Game.LambdaHack.Atomic
import Game.LambdaHack.Client.MonadClient
import Game.LambdaHack.Client.State
import Game.LambdaHack.Client.UI.ActorUI
import Game.LambdaHack.Client.UI.Animation
import Game.LambdaHack.Client.UI.Content.Screen
import Game.LambdaHack.Client.UI.ContentClientUI
import Game.LambdaHack.Client.UI.DrawM
import Game.LambdaHack.Client.UI.Frame
import Game.LambdaHack.Client.UI.FrameM
import Game.LambdaHack.Client.UI.HandleHelperM
import Game.LambdaHack.Client.UI.ItemDescription
import Game.LambdaHack.Client.UI.ItemSlot
import qualified Game.LambdaHack.Client.UI.Key as K
import Game.LambdaHack.Client.UI.MonadClientUI
import Game.LambdaHack.Client.UI.Msg
import Game.LambdaHack.Client.UI.MsgM
import Game.LambdaHack.Client.UI.SessionUI
import Game.LambdaHack.Client.UI.SlideshowM
import Game.LambdaHack.Client.UI.UIOptions
import Game.LambdaHack.Client.UI.Watch.WatchCommonM
import Game.LambdaHack.Client.UI.Watch.WatchQuitM
import Game.LambdaHack.Common.Actor
import Game.LambdaHack.Common.ActorState
import Game.LambdaHack.Common.Faction
import Game.LambdaHack.Common.Item
import qualified Game.LambdaHack.Common.ItemAspect as IA
import Game.LambdaHack.Common.Kind
import Game.LambdaHack.Common.Level
import Game.LambdaHack.Common.Misc
import Game.LambdaHack.Common.MonadStateRead
import Game.LambdaHack.Common.Point
import Game.LambdaHack.Common.State
import qualified Game.LambdaHack.Common.Tile as Tile
import Game.LambdaHack.Common.Time
import Game.LambdaHack.Common.Types
import Game.LambdaHack.Content.CaveKind (cdesc)
import qualified Game.LambdaHack.Content.ItemKind as IK
import Game.LambdaHack.Content.ModeKind
import qualified Game.LambdaHack.Content.ModeKind as MK
import Game.LambdaHack.Content.RuleKind
import qualified Game.LambdaHack.Content.TileKind as TK
import Game.LambdaHack.Core.Random
import qualified Game.LambdaHack.Definition.Ability as Ability
import qualified Game.LambdaHack.Definition.Color as Color
import Game.LambdaHack.Definition.Defs
import Game.LambdaHack.Definition.Flavour
watchRespUpdAtomicUI :: MonadClientUI m => UpdAtomic -> m ()
{-# INLINE watchRespUpdAtomicUI #-}
watchRespUpdAtomicUI :: UpdAtomic -> m ()
watchRespUpdAtomicUI UpdAtomic
cmd = case UpdAtomic
cmd of
UpdRegisterItems{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
UpdCreateActor ActorId
aid Actor
body [(ItemId, Item)]
_ -> Bool -> ActorId -> Actor -> m ()
forall (m :: * -> *).
MonadClientUI m =>
Bool -> ActorId -> Actor -> m ()
createActorUI Bool
True ActorId
aid Actor
body
UpdDestroyActor ActorId
aid Actor
body [(ItemId, Item)]
_ -> Bool -> ActorId -> Actor -> m ()
forall (m :: * -> *).
MonadClientUI m =>
Bool -> ActorId -> Actor -> m ()
destroyActorUI Bool
True ActorId
aid Actor
body
UpdCreateItem Bool
verbose ItemId
iid Item
_ kit :: ItemQuant
kit@(Int
kAdd, ItemTimers
_) Container
c -> do
ItemId -> Container -> m ()
forall (m :: * -> *).
MonadClientUI m =>
ItemId -> Container -> m ()
recordItemLid ItemId
iid Container
c
Container -> ItemId -> m ()
forall (m :: * -> *).
MonadClientUI m =>
Container -> ItemId -> m ()
updateItemSlot Container
c ItemId
iid
if Bool
verbose then case Container
c of
CActor ActorId
aid CStore
store -> do
Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
case CStore
store of
CStore
_ | Actor -> Bool
bproj Actor
b ->
MsgClassShowAndSave
-> ItemId -> ItemQuant -> Part -> Container -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> ItemId -> ItemQuant -> Part -> Container -> m ()
itemVerbMU MsgClassShowAndSave
MsgItemCreation ItemId
iid ItemQuant
kit Part
"appear" Container
c
CStore
COrgan -> do
Time
localTime <- (State -> Time) -> m Time
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Time) -> m Time) -> (State -> Time) -> m Time
forall a b. (a -> b) -> a -> b
$ LevelId -> State -> Time
getLocalTime (Actor -> LevelId
blid Actor
b)
AspectRecord
arItem <- (State -> AspectRecord) -> m AspectRecord
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> AspectRecord) -> m AspectRecord)
-> (State -> AspectRecord) -> m AspectRecord
forall a b. (a -> b) -> a -> b
$ ItemId -> State -> AspectRecord
aspectRecordFromIid ItemId
iid
if | Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Blast AspectRecord
arItem -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Condition AspectRecord
arItem -> do
FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
DiscoveryBenefit
discoBenefit <- (StateClient -> DiscoveryBenefit) -> m DiscoveryBenefit
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> DiscoveryBenefit
sdiscoBenefit
ItemBag
bag <- (State -> ItemBag) -> m ItemBag
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemBag) -> m ItemBag)
-> (State -> ItemBag) -> m ItemBag
forall a b. (a -> b) -> a -> b
$ Container -> State -> ItemBag
getContainerBag Container
c
ItemKind
itemKind <- (State -> ItemKind) -> m ItemKind
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemKind) -> m ItemKind)
-> (State -> ItemKind) -> m ItemKind
forall a b. (a -> b) -> a -> b
$ ItemId -> State -> ItemKind
getIidKind ItemId
iid
let more :: Maybe Int
more = case ItemId -> ItemBag -> Maybe ItemQuant
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup ItemId
iid ItemBag
bag of
Just (Int
kTotal, ItemTimers
_) | Int
kTotal Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
kAdd -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
kTotal
Maybe ItemQuant
_ -> Maybe Int
forall a. Maybe a
Nothing
verbShow :: Part
verbShow = Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$
Text
"become"
Text -> Text -> Text
<+> case ItemQuant
kit of
(Int
1, ItemTimer
_ : ItemTimers
_) -> Text
"somewhat"
(Int
1, []) | Maybe Int -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Int
more -> Text
""
ItemQuant
_ | Maybe Int -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Int
more -> Text
"many-fold"
ItemQuant
_ -> Text
"additionally"
verbSave :: Part
verbSave = Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$
Text
"become"
Text -> Text -> Text
<+> case ItemQuant
kit of
(Int
1, ItemTimer
t:ItemTimers
_) ->
let total :: Delta Time
total = Time -> ItemTimer -> Delta Time
deltaOfItemTimer Time
localTime ItemTimer
t
in Delta Time -> Text
timeDeltaInSecondsText Delta Time
total
(Int
1, []) | Maybe Int -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Int
more -> Text
""
(Int
k, ItemTimers
_) ->
(if Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust Maybe Int
more then Text
"additionally" else Text
"")
Text -> Text -> Text
<+> Int -> Text
forall a. Show a => a -> Text
tshow Int
k Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"-fold"
Text -> Text -> Text
<+> case Maybe Int
more of
Maybe Int
Nothing -> Text
""
Just Int
kTotal ->
Text
"(total:" Text -> Text -> Text
<+> Int -> Text
forall a. Show a => a -> Text
tshow Int
kTotal Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"-fold)"
good :: Bool
good = Benefit -> Bool
benInEqp (DiscoveryBenefit
discoBenefit DiscoveryBenefit -> ItemId -> Benefit
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ItemId
iid)
msgClass :: MsgClassDistinct
msgClass = case GroupName ItemKind -> [(GroupName ItemKind, Int)] -> Maybe Int
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup GroupName ItemKind
IK.S_ASLEEP ([(GroupName ItemKind, Int)] -> Maybe Int)
-> [(GroupName ItemKind, Int)] -> Maybe Int
forall a b. (a -> b) -> a -> b
$ ItemKind -> [(GroupName ItemKind, Int)]
IK.ifreq ItemKind
itemKind of
Just Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 -> MsgClassDistinct
MsgStatusSleep
Maybe Int
_ -> if | Actor -> FactionId
bfid Actor
b FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
/= FactionId
side -> MsgClassDistinct
MsgStatusOthers
| Bool
good -> MsgClassDistinct
MsgStatusGoodUs
| Bool
otherwise -> MsgClassDistinct
MsgStatusBadUs
MsgClassDistinct -> ActorId -> Part -> Part -> ItemId -> m ()
forall (m :: * -> *).
MonadClientUI m =>
MsgClassDistinct -> ActorId -> Part -> Part -> ItemId -> m ()
itemAidDistinctMU MsgClassDistinct
msgClass ActorId
aid Part
verbShow Part
verbSave ItemId
iid
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Actor -> FactionId
bfid Actor
b FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
good) (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
MsgTutorialHint Text
"Temporary conditions, especially the bad ones, pass quickly, usually after just a few turns. While active, they are listed in the '@' organ menu and the effects of most of them are seen in the '#' skill menu."
| Bool
otherwise -> do
[Part]
wown <- (ActorId -> m Part) -> Bool -> Container -> m [Part]
forall (m :: * -> *).
MonadClientUI m =>
(ActorId -> m Part) -> Bool -> Container -> m [Part]
ppContainerWownW ActorId -> m Part
forall (m :: * -> *). MonadClientUI m => ActorId -> m Part
partActorLeader Bool
True Container
c
MsgClassShowAndSave
-> ItemId -> ItemQuant -> Part -> Container -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> ItemId -> ItemQuant -> Part -> Container -> m ()
itemVerbMU MsgClassShowAndSave
MsgItemCreation ItemId
iid ItemQuant
kit
(Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ [Part] -> Text
makePhrase ([Part] -> Text) -> [Part] -> Text
forall a b. (a -> b) -> a -> b
$ Part
"grow" Part -> [Part] -> [Part]
forall a. a -> [a] -> [a]
: [Part]
wown) Container
c
CStore
_ -> do
[Part]
wown <- (ActorId -> m Part) -> Bool -> Container -> m [Part]
forall (m :: * -> *).
MonadClientUI m =>
(ActorId -> m Part) -> Bool -> Container -> m [Part]
ppContainerWownW ActorId -> m Part
forall (m :: * -> *). MonadClientUI m => ActorId -> m Part
partActorLeader Bool
True Container
c
MsgClassShowAndSave
-> ItemId -> ItemQuant -> Part -> Container -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> ItemId -> ItemQuant -> Part -> Container -> m ()
itemVerbMU MsgClassShowAndSave
MsgItemCreation ItemId
iid ItemQuant
kit
(Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ [Part] -> Text
makePhrase ([Part] -> Text) -> [Part] -> Text
forall a b. (a -> b) -> a -> b
$ Part
"appear" Part -> [Part] -> [Part]
forall a. a -> [a] -> [a]
: [Part]
wown) Container
c
CEmbed LevelId
lid Point
_ -> LevelId -> m ()
forall (m :: * -> *). MonadClientUI m => LevelId -> m ()
markDisplayNeeded LevelId
lid
CFloor LevelId
lid Point
_ -> do
FactionDict
factionD <- (State -> FactionDict) -> m FactionDict
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> FactionDict
sfactionD
MsgClassShowAndSave
-> ItemId -> ItemQuant -> Part -> Container -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> ItemId -> ItemQuant -> Part -> Container -> m ()
itemVerbMU MsgClassShowAndSave
MsgItemCreation ItemId
iid ItemQuant
kit
(Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ Text
"appear" Text -> Text -> Text
<+> FactionDict -> Container -> Text
ppContainer FactionDict
factionD Container
c) Container
c
LevelId -> m ()
forall (m :: * -> *). MonadClientUI m => LevelId -> m ()
markDisplayNeeded LevelId
lid
CTrunk{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
else do
LevelId
lid <- (State -> LevelId) -> m LevelId
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> LevelId) -> m LevelId)
-> (State -> LevelId) -> m LevelId
forall a b. (a -> b) -> a -> b
$ Container -> State -> LevelId
lidFromC Container
c
LevelId -> m ()
forall (m :: * -> *). MonadClientUI m => LevelId -> m ()
markDisplayNeeded LevelId
lid
UpdDestroyItem Bool
verbose ItemId
iid Item
_ ItemQuant
kit Container
c ->
if Bool
verbose then case Container
c of
CActor ActorId
aid CStore
_ -> do
Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
if Actor -> Bool
bproj Actor
b then
MsgClassShowAndSave
-> ItemId -> ItemQuant -> Part -> Container -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> ItemId -> ItemQuant -> Part -> Container -> m ()
itemVerbMUShort MsgClassShowAndSave
MsgItemRuination ItemId
iid ItemQuant
kit Part
"break" Container
c
else do
[Part]
ownW <- (ActorId -> m Part) -> Bool -> Container -> m [Part]
forall (m :: * -> *).
MonadClientUI m =>
(ActorId -> m Part) -> Bool -> Container -> m [Part]
ppContainerWownW ActorId -> m Part
forall (m :: * -> *). MonadClientUI m => ActorId -> m Part
partActorLeader Bool
False Container
c
let verb :: Part
verb = Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ [Part] -> Text
makePhrase ([Part] -> Text) -> [Part] -> Text
forall a b. (a -> b) -> a -> b
$ Part
"vanish from" Part -> [Part] -> [Part]
forall a. a -> [a] -> [a]
: [Part]
ownW
MsgClassShowAndSave
-> ItemId -> ItemQuant -> Part -> Container -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> ItemId -> ItemQuant -> Part -> Container -> m ()
itemVerbMUShort MsgClassShowAndSave
MsgItemRuination ItemId
iid ItemQuant
kit Part
verb Container
c
CEmbed LevelId
lid Point
_ -> LevelId -> m ()
forall (m :: * -> *). MonadClientUI m => LevelId -> m ()
markDisplayNeeded LevelId
lid
CFloor LevelId
lid Point
_ -> do
FactionDict
factionD <- (State -> FactionDict) -> m FactionDict
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> FactionDict
sfactionD
MsgClassShowAndSave
-> ItemId -> ItemQuant -> Part -> Container -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> ItemId -> ItemQuant -> Part -> Container -> m ()
itemVerbMUShort MsgClassShowAndSave
MsgItemRuination ItemId
iid ItemQuant
kit
(Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ Text
"break" Text -> Text -> Text
<+> FactionDict -> Container -> Text
ppContainer FactionDict
factionD Container
c) Container
c
LevelId -> m ()
forall (m :: * -> *). MonadClientUI m => LevelId -> m ()
markDisplayNeeded LevelId
lid
CTrunk{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
else do
LevelId
lid <- (State -> LevelId) -> m LevelId
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> LevelId) -> m LevelId)
-> (State -> LevelId) -> m LevelId
forall a b. (a -> b) -> a -> b
$ Container -> State -> LevelId
lidFromC Container
c
LevelId -> m ()
forall (m :: * -> *). MonadClientUI m => LevelId -> m ()
markDisplayNeeded LevelId
lid
UpdSpotActor ActorId
aid Actor
body -> Bool -> ActorId -> Actor -> m ()
forall (m :: * -> *).
MonadClientUI m =>
Bool -> ActorId -> Actor -> m ()
createActorUI Bool
False ActorId
aid Actor
body
UpdLoseActor ActorId
aid Actor
body -> Bool -> ActorId -> Actor -> m ()
forall (m :: * -> *).
MonadClientUI m =>
Bool -> ActorId -> Actor -> m ()
destroyActorUI Bool
False ActorId
aid Actor
body
UpdSpotItem Bool
verbose ItemId
iid ItemQuant
kit Container
c -> Bool -> Container -> ItemBag -> m ()
forall (m :: * -> *).
MonadClientUI m =>
Bool -> Container -> ItemBag -> m ()
spotItemBag Bool
verbose Container
c (ItemBag -> m ()) -> ItemBag -> m ()
forall a b. (a -> b) -> a -> b
$ ItemId -> ItemQuant -> ItemBag
forall k a. Enum k => k -> a -> EnumMap k a
EM.singleton ItemId
iid ItemQuant
kit
UpdLoseItem Bool
True ItemId
iid ItemQuant
kit c :: Container
c@(CActor ActorId
aid CStore
_) -> do
Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Actor -> Bool
bproj Actor
b) Bool -> Bool -> Bool
&& Actor -> Int64
bhp Actor
b Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
[Part]
ownW <- (ActorId -> m Part) -> Bool -> Container -> m [Part]
forall (m :: * -> *).
MonadClientUI m =>
(ActorId -> m Part) -> Bool -> Container -> m [Part]
ppContainerWownW ActorId -> m Part
forall (m :: * -> *). MonadClientUI m => ActorId -> m Part
partActorLeader Bool
False Container
c
let verb :: Part
verb = Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ [Part] -> Text
makePhrase ([Part] -> Text) -> [Part] -> Text
forall a b. (a -> b) -> a -> b
$ Part
"be removed from" Part -> [Part] -> [Part]
forall a. a -> [a] -> [a]
: [Part]
ownW
MsgClassShowAndSave
-> ItemId -> ItemQuant -> Part -> Container -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> ItemId -> ItemQuant -> Part -> Container -> m ()
itemVerbMUShort MsgClassShowAndSave
MsgItemMovement ItemId
iid ItemQuant
kit Part
verb Container
c
UpdLoseItem{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
UpdSpotItemBag Bool
verbose Container
c ItemBag
bag -> Bool -> Container -> ItemBag -> m ()
forall (m :: * -> *).
MonadClientUI m =>
Bool -> Container -> ItemBag -> m ()
spotItemBag Bool
verbose Container
c ItemBag
bag
UpdLoseItemBag{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
UpdMoveActor ActorId
aid Point
source Point
target -> ActorId -> Point -> Point -> m ()
forall (m :: * -> *).
MonadClientUI m =>
ActorId -> Point -> Point -> m ()
moveActor ActorId
aid Point
source Point
target
UpdWaitActor ActorId
aid Watchfulness
WSleep Watchfulness
_ -> do
MsgClassShowAndSave -> ActorId -> Part -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> ActorId -> Part -> m ()
aidVerbMU MsgClassShowAndSave
MsgStatusWakeup ActorId
aid Part
"wake up"
MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
MsgTutorialHint Text
"Woken up actors regain stats and skills, including sight radius and melee armor, over several turns."
UpdWaitActor ActorId
aid Watchfulness
WWake Watchfulness
_ -> do
FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Actor -> FactionId
bfid Actor
b FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side) (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
MsgTutorialHint Text
"To avoid waking enemies up, make sure they don't lose HP nor too much Calm through noises, particularly close ones. Beware, however, that they slowly regenerate HP as they sleep and eventually wake up at full HP."
UpdWaitActor{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
UpdDisplaceActor ActorId
source ActorId
target -> ActorId -> ActorId -> m ()
forall (m :: * -> *). MonadClientUI m => ActorId -> ActorId -> m ()
displaceActorUI ActorId
source ActorId
target
UpdMoveItem ItemId
iid Int
k ActorId
aid CStore
c1 CStore
c2 -> ItemId -> Int -> ActorId -> CStore -> CStore -> m ()
forall (m :: * -> *).
MonadClientUI m =>
ItemId -> Int -> ActorId -> CStore -> CStore -> m ()
moveItemUI ItemId
iid Int
k ActorId
aid CStore
c1 CStore
c2
UpdRefillHP ActorId
_ Int64
0 -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
UpdRefillHP ActorId
aid Int64
hpDelta -> do
let coarseDelta :: Int64
coarseDelta = Int64 -> Int64
forall a. Num a => a -> a
abs Int64
hpDelta Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`div` Int64
oneM
tDelta :: Text
tDelta = if Int64
coarseDelta Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
0
then if Int64
hpDelta Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
0 then Text
"a little" else Text
"a fraction of an HP"
else Int64 -> Text
forall a. Show a => a -> Text
tshow Int64
coarseDelta Text -> Text -> Text
<+> Text
"HP"
Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Actor -> Bool
bproj Actor
b) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
MsgClassSave -> ActorId -> Part -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> ActorId -> Part -> m ()
aidVerbMU MsgClassSave
MsgNumericReport ActorId
aid (Part -> m ()) -> Part -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Part
MU.Text
((if Int64
hpDelta Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
0 then Text
"heal" else Text
"lose") Text -> Text -> Text
<+> Text
tDelta)
LevelId
arena <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
getArenaUI
FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
if | Actor -> Bool
bproj Actor
b Bool -> Bool -> Bool
&& (ItemBag -> Bool
forall k a. EnumMap k a -> Bool
EM.null (Actor -> ItemBag
beqp Actor
b) Bool -> Bool -> Bool
|| Maybe ([Vector], Speed) -> Bool
forall a. Maybe a -> Bool
isNothing (Actor -> Maybe ([Vector], Speed)
btrajectory Actor
b)) ->
() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Actor -> Int64
bhp Actor
b Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int64
0 Bool -> Bool -> Bool
&& Int64
hpDelta Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int64
0
Bool -> Bool -> Bool
&& (Actor -> FactionId
bfid Actor
b FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side Bool -> Bool -> Bool
&& Bool -> Bool
not (Actor -> Bool
bproj Actor
b) Bool -> Bool -> Bool
|| LevelId
arena LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> LevelId
blid Actor
b) -> do
let (Part
firstFall, Part
hurtExtra) = case (Actor -> FactionId
bfid Actor
b FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side, Actor -> Bool
bproj Actor
b) of
(Bool
True, Bool
True) -> (Part
"drop down", Part
"tumble down")
(Bool
True, Bool
False) -> (Part
"fall down", Part
"suffer woeful mutilation")
(Bool
False, Bool
True) -> (Part
"plummet", Part
"crash")
(Bool
False, Bool
False) -> (Part
"collapse", Part
"be reduced to a bloody pulp")
verbDie :: Part
verbDie = if Bool
alreadyDeadBefore then Part
hurtExtra else Part
firstFall
alreadyDeadBefore :: Bool
alreadyDeadBefore = Actor -> Int64
bhp Actor
b Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
hpDelta Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int64
0
Faction
tfact <- (State -> Faction) -> m Faction
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (FactionDict -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
b) (FactionDict -> Faction)
-> (State -> FactionDict) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> FactionDict
sfactionD
ActorUI
bUI <- (SessionUI -> ActorUI) -> m ActorUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession ((SessionUI -> ActorUI) -> m ActorUI)
-> (SessionUI -> ActorUI) -> m ActorUI
forall a b. (a -> b) -> a -> b
$ ActorId -> SessionUI -> ActorUI
getActorUI ActorId
aid
Part
subjectRaw <- ActorId -> m Part
forall (m :: * -> *). MonadClientUI m => ActorId -> m Part
partActorLeader ActorId
aid
let subject :: Part
subject = if Bool
alreadyDeadBefore Bool -> Bool -> Bool
|| Part
subjectRaw Part -> Part -> Bool
forall a. Eq a => a -> a -> Bool
== Part
"you"
then Part
subjectRaw
else ActorUI -> Part
partActor ActorUI
bUI
msgDie :: Text
msgDie = [Part] -> Text
makeSentence [Part -> Part -> Part
MU.SubjectVerbSg Part
subject Part
verbDie]
targetIsFoe :: Bool
targetIsFoe = FactionId -> Faction -> FactionId -> Bool
isFoe (Actor -> FactionId
bfid Actor
b) Faction
tfact FactionId
side
targetIsFriend :: Bool
targetIsFriend = FactionId -> Faction -> FactionId -> Bool
isFriend (Actor -> FactionId
bfid Actor
b) Faction
tfact FactionId
side
msgClass :: MsgClassShowAndSave
msgClass | Actor -> Bool
bproj Actor
b = MsgClassShowAndSave
MsgDeathBoring
| Bool
targetIsFoe = MsgClassShowAndSave
MsgDeathVictory
| Bool
targetIsFriend = MsgClassShowAndSave
MsgDeathDeafeat
| Bool
otherwise = MsgClassShowAndSave
MsgDeathBoring
if | Actor -> Bool
bproj Actor
b -> MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
msgClass Text
msgDie
| Actor -> FactionId
bfid Actor
b FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side -> do
MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgLnAdd MsgClassShowAndSave
msgClass (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
msgDie Text -> Text -> Text
<+> Text
"Alas!"
ColorMode -> Text -> m ()
forall (m :: * -> *). MonadClientUI m => ColorMode -> Text -> m ()
displayMore ColorMode
ColorBW Text
""
| Bool
otherwise -> MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgLnAdd MsgClassShowAndSave
msgClass Text
msgDie
let deathAct :: Animation
deathAct = if Actor -> FactionId
bfid Actor
b FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side
then Point -> Animation
deathBody (Actor -> Point
bpos Actor
b)
else Point -> Animation
shortDeathBody (Actor -> Point
bpos Actor
b)
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Actor -> Bool
bproj Actor
b Bool -> Bool -> Bool
|| Bool
alreadyDeadBefore) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ LevelId -> Animation -> m ()
forall (m :: * -> *).
MonadClientUI m =>
LevelId -> Animation -> m ()
animate (Actor -> LevelId
blid Actor
b) Animation
deathAct
| Bool
otherwise -> do
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int64
hpDelta Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Actor -> Int64
bhp Actor
b Bool -> Bool -> Bool
&& Actor -> Int64
bhp Actor
b Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
MsgClassShowAndSave -> ActorId -> Part -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> ActorId -> Part -> m ()
aidVerbMU MsgClassShowAndSave
MsgActionWarning ActorId
aid Part
"return from the brink of death"
Maybe ActorId
mleader <- (StateClient -> Maybe ActorId) -> m (Maybe ActorId)
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Maybe ActorId
sleader
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ActorId -> Maybe ActorId
forall a. a -> Maybe a
Just ActorId
aid Maybe ActorId -> Maybe ActorId -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe ActorId
mleader) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Skills
actorMaxSk <- (State -> Skills) -> m Skills
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Skills) -> m Skills) -> (State -> Skills) -> m Skills
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Skills
getActorMaxSkills ActorId
aid
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Actor -> Int64
bhp Actor
b Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int -> Int64
xM (Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkMaxHP Skills
actorMaxSk)
Bool -> Bool -> Bool
&& Actor -> Int64
bhp Actor
b Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
hpDelta Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int -> Int64
xM (Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkMaxHP
Skills
actorMaxSk)) (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
MsgSpecialEvent Text
"You recover your health fully. Any further gains will be transient."
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Actor -> FactionId
bfid Actor
b FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side Bool -> Bool -> Bool
&& Bool -> Bool
not (Actor -> Bool
bproj Actor
b)) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int64 -> Int64
forall a. Num a => a -> a
abs Int64
hpDelta Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int64
oneM) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ LevelId -> m ()
forall (m :: * -> *). MonadClientUI m => LevelId -> m ()
markDisplayNeeded (Actor -> LevelId
blid Actor
b)
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int64
hpDelta Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int64
0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int64
hpDelta Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int -> Int64
xM (-Int
3)) (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
MsgTutorialHint Text
"You took a lot of damage from one source. If the danger persists, consider retreating towards your teammates or buffing up or an instant escape, if consumables permit."
UIOptions
sUIOptions <- (SessionUI -> UIOptions) -> m UIOptions
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> UIOptions
sUIOptions
Bool
currentWarning <-
(State -> Bool) -> m Bool
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Bool) -> m Bool) -> (State -> Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ UIOptions -> ActorId -> Int64 -> State -> Bool
checkWarningHP UIOptions
sUIOptions ActorId
aid (Actor -> Int64
bhp Actor
b)
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
currentWarning (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Bool
previousWarning <-
(State -> Bool) -> m Bool
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Bool) -> m Bool) -> (State -> Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ UIOptions -> ActorId -> Int64 -> State -> Bool
checkWarningHP UIOptions
sUIOptions ActorId
aid (Actor -> Int64
bhp Actor
b Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
hpDelta)
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
previousWarning (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
MsgClassShowAndSave -> ActorId -> Part -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> ActorId -> Part -> m ()
aidVerbMU MsgClassShowAndSave
MsgRiskOfDeath ActorId
aid
Part
"be down to a dangerous health level"
UpdRefillCalm ActorId
_ Int64
0 -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
UpdRefillCalm ActorId
aid Int64
calmDelta -> do
FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Actor -> FactionId
bfid Actor
b FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side Bool -> Bool -> Bool
&& Bool -> Bool
not (Actor -> Bool
bproj Actor
b)) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
if | Int64
calmDelta Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
0 -> do
Maybe ActorId
mleader <- (StateClient -> Maybe ActorId) -> m (Maybe ActorId)
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Maybe ActorId
sleader
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ActorId -> Maybe ActorId
forall a. a -> Maybe a
Just ActorId
aid Maybe ActorId -> Maybe ActorId -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe ActorId
mleader) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Skills
actorMaxSk <- (State -> Skills) -> m Skills
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Skills) -> m Skills) -> (State -> Skills) -> m Skills
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Skills
getActorMaxSkills ActorId
aid
let bPrev :: Actor
bPrev = Actor
b {bcalm :: Int64
bcalm = Actor -> Int64
bcalm Actor
b Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
calmDelta}
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Actor -> Skills -> Bool
calmEnough Actor
b Skills
actorMaxSk
Bool -> Bool -> Bool
&& Bool -> Bool
not (Actor -> Skills -> Bool
calmEnough Actor
bPrev Skills
actorMaxSk)) (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
MsgNeutralEvent Text
"You are again calm enough to manage your equipment outfit."
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int64 -> Int64
forall a. Num a => a -> a
abs Int64
calmDelta Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
oneM) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ LevelId -> m ()
forall (m :: * -> *). MonadClientUI m => LevelId -> m ()
markDisplayNeeded (Actor -> LevelId
blid Actor
b)
| Int64
calmDelta Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
minusM1 -> do
Faction
fact <- (State -> Faction) -> m Faction
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (FactionDict -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
side) (FactionDict -> Faction)
-> (State -> FactionDict) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> FactionDict
sfactionD
State
s <- m State
forall (m :: * -> *). MonadStateRead m => m State
getState
let closeFoe :: (Point, ActorId) -> Bool
closeFoe (!Point
p, ActorId
aid2) =
let b2 :: Actor
b2 = ActorId -> State -> Actor
getActorBody ActorId
aid2 State
s
in (Point -> Point -> Int) -> Point -> Point -> Int
forall a. a -> a
inline Point -> Point -> Int
chessDist Point
p (Actor -> Point
bpos Actor
b) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
3
Bool -> Bool -> Bool
&& Bool -> Bool
not (Actor -> Bool
actorWaitsOrSleeps Actor
b2)
Bool -> Bool -> Bool
&& (FactionId -> Faction -> FactionId -> Bool)
-> FactionId -> Faction -> FactionId -> Bool
forall a. a -> a
inline FactionId -> Faction -> FactionId -> Bool
isFoe FactionId
side Faction
fact (Actor -> FactionId
bfid Actor
b2)
anyCloseFoes :: Bool
anyCloseFoes = ((Point, ActorId) -> Bool) -> [(Point, ActorId)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Point, ActorId) -> Bool
closeFoe ([(Point, ActorId)] -> Bool) -> [(Point, ActorId)] -> Bool
forall a b. (a -> b) -> a -> b
$ EnumMap Point ActorId -> [(Point, ActorId)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs (EnumMap Point ActorId -> [(Point, ActorId)])
-> EnumMap Point ActorId -> [(Point, ActorId)]
forall a b. (a -> b) -> a -> b
$ Level -> EnumMap Point ActorId
lbig
(Level -> EnumMap Point ActorId) -> Level -> EnumMap Point ActorId
forall a b. (a -> b) -> a -> b
$ State -> Dungeon
sdungeon State
s Dungeon -> LevelId -> Level
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> LevelId
blid Actor
b
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
anyCloseFoes (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Bool
duplicated <- MsgClassShowAndSave -> ActorId -> Part -> m Bool
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> ActorId -> Part -> m Bool
aidVerbDuplicateMU MsgClassShowAndSave
MsgHeardNearby ActorId
aid
Part
"hear something"
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
duplicated m ()
forall (m :: * -> *). MonadClientUI m => m ()
stopPlayBack
| Bool
otherwise ->
() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int64
calmDelta Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int64
0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
UIOptions
sUIOptions <- (SessionUI -> UIOptions) -> m UIOptions
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> UIOptions
sUIOptions
Bool
currentWarning <-
(State -> Bool) -> m Bool
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Bool) -> m Bool) -> (State -> Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ UIOptions -> ActorId -> Int64 -> State -> Bool
checkWarningCalm UIOptions
sUIOptions ActorId
aid (Actor -> Int64
bcalm Actor
b)
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
currentWarning (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Bool
previousWarning <-
(State -> Bool) -> m Bool
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Bool) -> m Bool) -> (State -> Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ UIOptions -> ActorId -> Int64 -> State -> Bool
checkWarningCalm UIOptions
sUIOptions ActorId
aid (Actor -> Int64
bcalm Actor
b Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
calmDelta)
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
previousWarning (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
MsgClassShowAndSave -> ActorId -> Part -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> ActorId -> Part -> m ()
aidVerbMU MsgClassShowAndSave
MsgRiskOfDeath ActorId
aid
Part
"have grown agitated and impressed enough to be in danger of defecting"
UpdTrajectory ActorId
_ Maybe ([Vector], Speed)
_ Maybe ([Vector], Speed)
mt ->
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe ([Vector], Speed) -> Bool
forall a. Maybe a -> Bool
isNothing Maybe ([Vector], Speed)
mt) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Bool -> m ()
forall (m :: * -> *). MonadClientUI m => Bool -> m ()
pushFrame Bool
False
UpdQuitFaction FactionId
fid Maybe Status
_ Maybe Status
toSt Maybe (FactionAnalytics, GenerationAnalytics)
manalytics -> FactionId
-> Maybe Status
-> Maybe (FactionAnalytics, GenerationAnalytics)
-> m ()
forall (m :: * -> *).
MonadClientUI m =>
FactionId
-> Maybe Status
-> Maybe (FactionAnalytics, GenerationAnalytics)
-> m ()
quitFactionUI FactionId
fid Maybe Status
toSt Maybe (FactionAnalytics, GenerationAnalytics)
manalytics
UpdSpotStashFaction Bool
verbose FactionId
fid LevelId
lid Point
pos -> do
FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
verbose (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
if FactionId
fid FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side then
MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgLnAdd MsgClassShowAndSave
MsgFactionIntel
Text
"You set up the shared inventory stash of your team."
else do
Faction
fact <- (State -> Faction) -> m Faction
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (FactionDict -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
fid) (FactionDict -> Faction)
-> (State -> FactionDict) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> FactionDict
sfactionD
let fidName :: Part
fidName = Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ Faction -> Text
gname Faction
fact
MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
MsgFactionIntel (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
[Part] -> Text
makeSentence [ Part
"you have found the current"
, Part -> Part -> Part
MU.WownW Part
fidName Part
"hoard location" ]
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FactionId
fid FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
LevelId -> Animation -> m ()
forall (m :: * -> *).
MonadClientUI m =>
LevelId -> Animation -> m ()
animate LevelId
lid (Animation -> m ()) -> Animation -> m ()
forall a b. (a -> b) -> a -> b
$ Point -> Animation
actorX Point
pos
UpdLoseStashFaction Bool
verbose FactionId
fid LevelId
lid Point
pos -> do
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
verbose (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
if FactionId
fid FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side then
MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
MsgFactionIntel
Text
"You've lost access to your shared inventory stash!"
else do
Faction
fact <- (State -> Faction) -> m Faction
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (FactionDict -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
fid) (FactionDict -> Faction)
-> (State -> FactionDict) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> FactionDict
sfactionD
let fidName :: Part
fidName = Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ Faction -> Text
gname Faction
fact
MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
MsgFactionIntel (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
[Part] -> Text
makeSentence [Part
fidName, Part
"no longer control their hoard"]
LevelId -> Animation -> m ()
forall (m :: * -> *).
MonadClientUI m =>
LevelId -> Animation -> m ()
animate LevelId
lid (Animation -> m ()) -> Animation -> m ()
forall a b. (a -> b) -> a -> b
$ Point -> Animation
vanish Point
pos
UpdLeadFaction FactionId
fid (Just ActorId
source) mtgt :: Maybe ActorId
mtgt@(Just ActorId
target) -> do
Maybe ActorId
mleader <- (StateClient -> Maybe ActorId) -> m (Maybe ActorId)
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Maybe ActorId
sleader
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe ActorId
mtgt Maybe ActorId -> Maybe ActorId -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe ActorId
mleader) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Faction
fact <- (State -> Faction) -> m Faction
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (FactionDict -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
fid) (FactionDict -> Faction)
-> (State -> FactionDict) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> FactionDict
sfactionD
LevelId
lidV <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
viewedLevelUI
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Faction -> Bool
isAIFact Faction
fact) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ LevelId -> m ()
forall (m :: * -> *). MonadClientUI m => LevelId -> m ()
markDisplayNeeded LevelId
lidV
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Faction -> Bool
noRunWithMulti Faction
fact) m ()
forall (m :: * -> *). MonadClientUI m => m ()
stopPlayBack
ActorDict
actorD <- (State -> ActorDict) -> m ActorDict
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> ActorDict
sactorD
case ActorId -> ActorDict -> Maybe Actor
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup ActorId
source ActorDict
actorD of
Just Actor
sb | Actor -> Int64
bhp Actor
sb Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int64
0 -> Bool -> m () -> m ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Actor -> Bool
bproj Actor
sb) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
ActorUI
sbUI <- (SessionUI -> ActorUI) -> m ActorUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession ((SessionUI -> ActorUI) -> m ActorUI)
-> (SessionUI -> ActorUI) -> m ActorUI
forall a b. (a -> b) -> a -> b
$ ActorId -> SessionUI -> ActorUI
getActorUI ActorId
source
ActorUI
tbUI <- (SessionUI -> ActorUI) -> m ActorUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession ((SessionUI -> ActorUI) -> m ActorUI)
-> (SessionUI -> ActorUI) -> m ActorUI
forall a b. (a -> b) -> a -> b
$ ActorId -> SessionUI -> ActorUI
getActorUI ActorId
target
let subject :: Part
subject = ActorUI -> Part
partActor ActorUI
tbUI
object :: Part
object = ActorUI -> Part
partActor ActorUI
sbUI
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 -> Part -> Part
MU.SubjectVerbSg Part
subject Part
"take command"
, Part
"from", Part
object ]
Maybe Actor
_ -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
ActorId -> m ()
forall (m :: * -> *). MonadClientUI m => ActorId -> m ()
lookAtMove ActorId
target
UpdLeadFaction FactionId
_ Maybe ActorId
Nothing mtgt :: Maybe ActorId
mtgt@(Just ActorId
target) -> do
Maybe ActorId
mleader <- (StateClient -> Maybe ActorId) -> m (Maybe ActorId)
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Maybe ActorId
sleader
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe ActorId
mtgt Maybe ActorId -> Maybe ActorId -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe ActorId
mleader) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
ActorId -> m ()
forall (m :: * -> *). MonadClientUI m => ActorId -> m ()
lookAtMove ActorId
target
UpdLeadFaction{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
UpdDiplFaction FactionId
fid1 FactionId
fid2 Diplomacy
_ Diplomacy
toDipl -> do
Text
name1 <- (State -> Text) -> m Text
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Text) -> m Text) -> (State -> Text) -> m Text
forall a b. (a -> b) -> a -> b
$ Faction -> Text
gname (Faction -> Text) -> (State -> Faction) -> State -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FactionDict -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
fid1) (FactionDict -> Faction)
-> (State -> FactionDict) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> FactionDict
sfactionD
Text
name2 <- (State -> Text) -> m Text
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Text) -> m Text) -> (State -> Text) -> m Text
forall a b. (a -> b) -> a -> b
$ Faction -> Text
gname (Faction -> Text) -> (State -> Faction) -> State -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FactionDict -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
fid2) (FactionDict -> Faction)
-> (State -> FactionDict) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> FactionDict
sfactionD
let showDipl :: Diplomacy -> p
showDipl Diplomacy
Unknown = p
"unknown to each other"
showDipl Diplomacy
Neutral = p
"in neutral diplomatic relations"
showDipl Diplomacy
Alliance = p
"allied"
showDipl Diplomacy
War = p
"at war"
MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
MsgFactionIntel (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
Text
name1 Text -> Text -> Text
<+> Text
"and" Text -> Text -> Text
<+> Text
name2 Text -> Text -> Text
<+> Text
"are now" Text -> Text -> Text
<+> Diplomacy -> Text
forall p. IsString p => Diplomacy -> p
showDipl Diplomacy
toDipl Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
UpdDoctrineFaction{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
UpdAutoFaction FactionId
fid Bool
b -> do
FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
LevelId
lidV <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
viewedLevelUI
LevelId -> m ()
forall (m :: * -> *). MonadClientUI m => LevelId -> m ()
markDisplayNeeded LevelId
lidV
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (FactionId
fid FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
b (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
(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 { smacroFrame :: KeyMacroFrame
smacroFrame =
KeyMacroFrame
emptyMacroFrame {keyPending :: KeyMacro
keyPending = [KM] -> KeyMacro
KeyMacro [KM
K.controlEscKM]}
, smacroStack :: [KeyMacroFrame]
smacroStack = [] }
Bool -> m ()
forall (m :: * -> *). MonadClientUI m => Bool -> m ()
setFrontAutoYes Bool
b
UpdRecordKill{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
UpdAlterTile LevelId
lid Point
p ContentId TileKind
fromTile ContentId TileKind
toTile -> do
COps{ContentData TileKind
cotile :: COps -> ContentData TileKind
cotile :: ContentData TileKind
cotile} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
LevelId -> m ()
forall (m :: * -> *). MonadClientUI m => LevelId -> m ()
markDisplayNeeded LevelId
lid
let 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
fromTile
toAlter :: Feature -> Maybe (GroupName TileKind)
toAlter Feature
feat =
case Feature
feat of
TK.OpenTo GroupName TileKind
tgroup -> GroupName TileKind -> Maybe (GroupName TileKind)
forall a. a -> Maybe a
Just GroupName TileKind
tgroup
TK.CloseTo GroupName TileKind
tgroup -> GroupName TileKind -> Maybe (GroupName TileKind)
forall a. a -> Maybe a
Just GroupName TileKind
tgroup
TK.ChangeTo GroupName TileKind
tgroup -> GroupName TileKind -> Maybe (GroupName TileKind)
forall a. a -> Maybe a
Just GroupName TileKind
tgroup
TK.OpenWith ProjectileTriggers
_ [(Int, GroupName ItemKind)]
_ GroupName TileKind
tgroup -> GroupName TileKind -> Maybe (GroupName TileKind)
forall a. a -> Maybe a
Just GroupName TileKind
tgroup
TK.CloseWith ProjectileTriggers
_ [(Int, GroupName ItemKind)]
_ GroupName TileKind
tgroup -> GroupName TileKind -> Maybe (GroupName TileKind)
forall a. a -> Maybe a
Just GroupName TileKind
tgroup
TK.ChangeWith ProjectileTriggers
_ [(Int, GroupName ItemKind)]
_ GroupName TileKind
tgroup -> GroupName TileKind -> Maybe (GroupName TileKind)
forall a. a -> Maybe a
Just GroupName TileKind
tgroup
Feature
_ -> Maybe (GroupName TileKind)
forall a. Maybe a
Nothing
groupsToAlterTo :: [GroupName TileKind]
groupsToAlterTo = (Feature -> Maybe (GroupName TileKind))
-> [Feature] -> [GroupName TileKind]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Feature -> Maybe (GroupName TileKind)
toAlter [Feature]
feats
freq :: [GroupName TileKind]
freq = ((GroupName TileKind, Int) -> GroupName TileKind)
-> [(GroupName TileKind, Int)] -> [GroupName TileKind]
forall a b. (a -> b) -> [a] -> [b]
map (GroupName TileKind, Int) -> GroupName TileKind
forall a b. (a, b) -> a
fst ([(GroupName TileKind, Int)] -> [GroupName TileKind])
-> [(GroupName TileKind, Int)] -> [GroupName TileKind]
forall a b. (a -> b) -> a -> b
$ ((GroupName TileKind, Int) -> Bool)
-> [(GroupName TileKind, Int)] -> [(GroupName TileKind, Int)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(GroupName TileKind
_, Int
q) -> Int
q Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0)
([(GroupName TileKind, Int)] -> [(GroupName TileKind, Int)])
-> [(GroupName TileKind, Int)] -> [(GroupName TileKind, Int)]
forall a b. (a -> b) -> a -> b
$ TileKind -> [(GroupName TileKind, Int)]
TK.tfreq (TileKind -> [(GroupName TileKind, Int)])
-> TileKind -> [(GroupName TileKind, Int)]
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
toTile
unexpected :: Bool
unexpected = [GroupName TileKind] -> Bool
forall a. [a] -> Bool
null ([GroupName TileKind] -> Bool) -> [GroupName TileKind] -> Bool
forall a b. (a -> b) -> a -> b
$ [GroupName TileKind]
-> [GroupName TileKind] -> [GroupName TileKind]
forall a. Eq a => [a] -> [a] -> [a]
intersect [GroupName TileKind]
freq [GroupName TileKind]
groupsToAlterTo
Maybe ActorId
mactorAtPos <- (State -> Maybe ActorId) -> m (Maybe ActorId)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Maybe ActorId) -> m (Maybe ActorId))
-> (State -> Maybe ActorId) -> m (Maybe ActorId)
forall a b. (a -> b) -> a -> b
$ Point -> LevelId -> State -> Maybe ActorId
posToBig Point
p LevelId
lid
Maybe ActorId
mleader <- (StateClient -> Maybe ActorId) -> m (Maybe ActorId)
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Maybe ActorId
sleader
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
unexpected Bool -> Bool -> Bool
|| Maybe ActorId -> Bool
forall a. Maybe a -> Bool
isJust Maybe ActorId
mactorAtPos Bool -> Bool -> Bool
&& Maybe ActorId
mactorAtPos Maybe ActorId -> Maybe ActorId -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe ActorId
mleader) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
let subject :: Part
subject = Part
""
verb :: Part
verb = Part
"turn into"
msg :: Text
msg = [Part] -> Text
makeSentence ([Part] -> Text) -> [Part] -> Text
forall a b. (a -> b) -> a -> b
$
[ Part
"the", Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ TileKind -> Text
TK.tname (TileKind -> Text) -> TileKind -> Text
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
fromTile
, Part
"at position", Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ Point -> Text
forall a. Show a => a -> Text
tshow Point
p ]
[Part] -> [Part] -> [Part]
forall a. [a] -> [a] -> [a]
++ [Part
"suddenly" | Bool
unexpected]
[Part] -> [Part] -> [Part]
forall a. [a] -> [a] -> [a]
++ [ Part -> Part -> Part
MU.SubjectVerbSg Part
subject Part
verb
, 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 -> Text) -> TileKind -> Text
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
toTile ]
MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd (if Bool
unexpected then MsgClassShowAndSave
MsgSpecialEvent else MsgClassShowAndSave
MsgNeutralEvent) Text
msg
UpdAlterExplorable LevelId
lid Int
_ -> LevelId -> m ()
forall (m :: * -> *). MonadClientUI m => LevelId -> m ()
markDisplayNeeded LevelId
lid
UpdAlterGold{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
UpdSearchTile ActorId
aid Point
_p ContentId TileKind
toTile -> do
COps{ContentData TileKind
cotile :: ContentData TileKind
cotile :: COps -> ContentData TileKind
cotile} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
Part
subject <- ActorId -> m Part
forall (m :: * -> *). MonadClientUI m => ActorId -> m Part
partActorLeader ActorId
aid
let fromTile :: ContentId TileKind
fromTile = ContentId TileKind
-> Maybe (ContentId TileKind) -> ContentId TileKind
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> ContentId TileKind
forall a. (?callStack::CallStack) => [Char] -> a
error ([Char] -> ContentId TileKind) -> [Char] -> ContentId TileKind
forall a b. (a -> b) -> a -> b
$ ContentId TileKind -> [Char]
forall a. Show a => a -> [Char]
show ContentId TileKind
toTile) (Maybe (ContentId TileKind) -> ContentId TileKind)
-> Maybe (ContentId TileKind) -> ContentId TileKind
forall a b. (a -> b) -> a -> b
$ ContentData TileKind
-> ContentId TileKind -> Maybe (ContentId TileKind)
Tile.hideAs ContentData TileKind
cotile ContentId TileKind
toTile
subject2 :: Part
subject2 = Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ TileKind -> Text
TK.tname (TileKind -> Text) -> TileKind -> Text
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
fromTile
object :: Part
object = Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ TileKind -> Text
TK.tname (TileKind -> Text) -> TileKind -> Text
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
toTile
let msg :: Text
msg = [Part] -> Text
makeSentence [ Part -> Part -> Part
MU.SubjectVerbSg Part
subject Part
"reveal"
, Part
"that the"
, Part -> Part -> Part
MU.SubjectVerbSg Part
subject2 Part
"be"
, Part -> Part
MU.AW Part
object ]
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Part
subject2 Part -> Part -> Bool
forall a. Eq a => a -> a -> Bool
== Part
object) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
MsgTerrainReveal Text
msg
MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
MsgTutorialHint Text
"Solid terrain drawn in pink is not fully known until searched. This is usually done by bumping into it, which also triggers effects and transformations the terrain is capable of. Once revealed, the terrain can be inspected in aiming mode started with the '*' key or with mouse."
UpdHideTile{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
UpdSpotTile{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
UpdLoseTile{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
UpdSpotEntry{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
UpdLoseEntry{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
UpdAlterSmell{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
UpdSpotSmell{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
UpdLoseSmell{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
UpdTimeItem{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
UpdAgeGame{} -> do
Bool
sdisplayNeeded <- (SessionUI -> Bool) -> m Bool
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Bool
sdisplayNeeded
Bool
sturnDisplayed <- (SessionUI -> Bool) -> m Bool
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Bool
sturnDisplayed
Time
time <- (State -> Time) -> m Time
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> Time
stime
let clipN :: Int
clipN = Time
time Time -> Time -> Int
`timeFit` Time
timeClip
clipMod :: Int
clipMod = Int
clipN Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
clipsInTurn
turnPing :: Bool
turnPing = Int
clipMod Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
if | Bool
sdisplayNeeded -> Bool -> m ()
forall (m :: * -> *). MonadClientUI m => Bool -> m ()
pushFrame Bool
True
| Bool
turnPing Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
sturnDisplayed -> Bool -> m ()
forall (m :: * -> *). MonadClientUI m => Bool -> m ()
pushFrame Bool
False
| Bool
otherwise -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
turnPing (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
(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 {sturnDisplayed :: Bool
sturnDisplayed = Bool
False}
UpdUnAgeGame{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
UpdDiscover Container
c ItemId
iid ContentId ItemKind
_ AspectRecord
_ -> Container -> ItemId -> m ()
forall (m :: * -> *).
MonadClientUI m =>
Container -> ItemId -> m ()
discover Container
c ItemId
iid
UpdCover{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
UpdDiscoverKind{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
UpdCoverKind{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
UpdDiscoverAspect{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
UpdCoverAspect{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
UpdDiscoverServer{} -> [Char] -> m ()
forall a. (?callStack::CallStack) => [Char] -> a
error [Char]
"server command leaked to client"
UpdCoverServer{} -> [Char] -> m ()
forall a. (?callStack::CallStack) => [Char] -> a
error [Char]
"server command leaked to client"
UpdPerception{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
UpdRestart FactionId
fid PerLid
_ State
_ Challenge
_ ClientOptions
_ SMGen
srandom -> do
cops :: COps
cops@COps{ContentData CaveKind
cocave :: COps -> ContentData CaveKind
cocave :: ContentData CaveKind
cocave, ContentData ModeKind
comode :: COps -> ContentData ModeKind
comode :: ContentData ModeKind
comode, RuleContent
corule :: COps -> RuleContent
corule :: RuleContent
corule} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
SessionUI
oldSess <- m SessionUI
forall (m :: * -> *). MonadClientUI m => m SessionUI
getSession
EnumMap (ContentId ModeKind) (Map Challenge Int)
svictories <- (StateClient -> EnumMap (ContentId ModeKind) (Map Challenge Int))
-> m (EnumMap (ContentId ModeKind) (Map Challenge Int))
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> EnumMap (ContentId ModeKind) (Map Challenge Int)
svictories
Challenge
snxtChal <- (StateClient -> Challenge) -> m Challenge
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Challenge
snxtChal
let uiOptions :: UIOptions
uiOptions = SessionUI -> UIOptions
sUIOptions SessionUI
oldSess
f :: [a] -> p -> a -> p -> [a]
f ![a]
acc p
_p !a
i p
_a = a
i a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
acc
modes :: [(Int, ContentId ModeKind)]
modes = [Int] -> [ContentId ModeKind] -> [(Int, ContentId ModeKind)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([ContentId ModeKind] -> [(Int, ContentId ModeKind)])
-> [ContentId ModeKind] -> [(Int, ContentId ModeKind)]
forall a b. (a -> b) -> a -> b
$ ContentData ModeKind
-> GroupName ModeKind
-> ([ContentId ModeKind]
-> Int -> ContentId ModeKind -> ModeKind -> [ContentId ModeKind])
-> [ContentId ModeKind]
-> [ContentId ModeKind]
forall a b.
ContentData a
-> GroupName a -> (b -> Int -> ContentId a -> a -> b) -> b -> b
ofoldlGroup' ContentData ModeKind
comode GroupName ModeKind
CAMPAIGN_SCENARIO [ContentId ModeKind]
-> Int -> ContentId ModeKind -> ModeKind -> [ContentId ModeKind]
forall a p p. [a] -> p -> a -> p -> [a]
f []
g :: (Int, ContentId ModeKind) -> Int
g :: (Int, ContentId ModeKind) -> Int
g (Int
_, ContentId ModeKind
mode) = 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
mode 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
snxtChal Map Challenge Int
cm)
(Int
snxtScenario, ContentId ModeKind
_) = ((Int, ContentId ModeKind)
-> (Int, ContentId ModeKind) -> Ordering)
-> [(Int, ContentId ModeKind)] -> (Int, ContentId ModeKind)
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
minimumBy (((Int, ContentId ModeKind) -> Int)
-> (Int, ContentId ModeKind)
-> (Int, ContentId ModeKind)
-> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Int, ContentId ModeKind) -> Int
g) [(Int, ContentId ModeKind)]
modes
nxtGameTutorial :: Bool
nxtGameTutorial = ModeKind -> Bool
MK.mtutorial (ModeKind -> Bool) -> ModeKind -> Bool
forall a b. (a -> b) -> a -> b
$ (ContentId ModeKind, ModeKind) -> ModeKind
forall a b. (a, b) -> b
snd ((ContentId ModeKind, ModeKind) -> ModeKind)
-> (ContentId ModeKind, ModeKind) -> ModeKind
forall a b. (a -> b) -> a -> b
$ COps -> Int -> (ContentId ModeKind, ModeKind)
nxtGameMode COps
cops Int
snxtScenario
SessionUI -> m ()
forall (m :: * -> *). MonadClientUI m => SessionUI -> m ()
putSession (SessionUI -> m ()) -> SessionUI -> m ()
forall a b. (a -> b) -> a -> b
$
(UIOptions -> SessionUI
emptySessionUI UIOptions
uiOptions)
{ schanF :: ChanFrontend
schanF = SessionUI -> ChanFrontend
schanF SessionUI
oldSess
, sccui :: CCUI
sccui = SessionUI -> CCUI
sccui SessionUI
oldSess
, shistory :: History
shistory = SessionUI -> History
shistory SessionUI
oldSess
, smarkVision :: Int
smarkVision = SessionUI -> Int
smarkVision SessionUI
oldSess
, smarkSmell :: Bool
smarkSmell = SessionUI -> Bool
smarkSmell SessionUI
oldSess
, Int
snxtScenario :: Int
snxtScenario :: Int
snxtScenario
, scurTutorial :: Bool
scurTutorial = SessionUI -> Bool
snxtTutorial SessionUI
oldSess
, snxtTutorial :: Bool
snxtTutorial = Bool
nxtGameTutorial
, soverrideTut :: Maybe Bool
soverrideTut = SessionUI -> Maybe Bool
soverrideTut SessionUI
oldSess
, sstart :: POSIXTime
sstart = SessionUI -> POSIXTime
sstart SessionUI
oldSess
, sgstart :: POSIXTime
sgstart = SessionUI -> POSIXTime
sgstart SessionUI
oldSess
, sallTime :: Time
sallTime = SessionUI -> Time
sallTime SessionUI
oldSess
, snframes :: Int
snframes = SessionUI -> Int
snframes SessionUI
oldSess
, sallNframes :: Int
sallNframes = SessionUI -> Int
sallNframes SessionUI
oldSess
, srandomUI :: SMGen
srandomUI = SMGen
srandom
}
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (SessionUI -> POSIXTime
sstart SessionUI
oldSess POSIXTime -> POSIXTime -> Bool
forall a. Eq a => a -> a -> Bool
== POSIXTime
0) m ()
forall (m :: * -> *). MonadClientUI m => m ()
resetSessionStart
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (History -> Int
lengthHistory (SessionUI -> History
shistory SessionUI
oldSess) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
let title :: Text
title = [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ RuleContent -> [Char]
rtitle RuleContent
corule
MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
MsgBookKeeping (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Welcome to" Text -> Text -> Text
<+> Text
title Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"!"
History
shistory <- m History
forall (m :: * -> *). MonadClientUI m => m History
defaultHistory
(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 {History
shistory :: History
shistory :: History
shistory}
m ()
forall (m :: * -> *). MonadClientUI m => m ()
recordHistory
LevelId
lid <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
getArenaUI
Level
lvl <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel LevelId
lid
ModeKind
gameMode <- m ModeKind
forall (m :: * -> *). MonadStateRead m => m ModeKind
getGameMode
Challenge
curChal <- (StateClient -> Challenge) -> m Challenge
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Challenge
scurChal
Faction
fact <- (State -> Faction) -> m Faction
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (FactionDict -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
fid) (FactionDict -> Faction)
-> (State -> FactionDict) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> FactionDict
sfactionD
let loneMode :: Bool
loneMode = case Faction -> [(Int, Int, GroupName ItemKind)]
ginitial Faction
fact of
[] -> Bool
True
[(Int
_, Int
1, GroupName ItemKind
_)] -> Bool
True
[(Int, Int, GroupName ItemKind)]
_ -> Bool
False
MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
MsgBookKeeping Text
"-------------------------------------------------"
m ()
forall (m :: * -> *). MonadClientUI m => m ()
recordHistory
MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
MsgActionWarning
(Text
"New game started in" Text -> Text -> Text
<+> ModeKind -> Text
mname ModeKind
gameMode Text -> Text -> Text
<+> Text
"mode.")
MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
MsgPlotExposition (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ ModeKind -> Text
mdesc ModeKind
gameMode
let desc :: Text
desc = CaveKind -> Text
cdesc (CaveKind -> Text) -> CaveKind -> Text
forall a b. (a -> b) -> a -> b
$ ContentData CaveKind -> ContentId CaveKind -> CaveKind
forall a. ContentData a -> ContentId a -> a
okind ContentData CaveKind
cocave (ContentId CaveKind -> CaveKind) -> ContentId CaveKind -> CaveKind
forall a b. (a -> b) -> a -> b
$ Level -> ContentId CaveKind
lkind Level
lvl
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> Bool
T.null Text
desc) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgLnAdd MsgClassShowAndSave
MsgBackdropFocus Text
"You take in your surroundings."
MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
MsgBackdropInfo Text
desc
Text
blurb <- Rnd Text -> m Text
forall (m :: * -> *) a. MonadClientUI m => Rnd a -> m a
rndToActionUI (Rnd Text -> m Text) -> Rnd Text -> m Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Rnd Text
forall a. [a] -> Rnd a
oneOf
[ Text
"You think you saw movement."
, Text
"Something catches your peripherial vision."
, Text
"You think you felt a tremor under your feet."
, Text
"A whiff of chilly air passes around you."
, Text
"You notice a draft just when it dies down."
, Text
"The ground nearby is stained along some faint lines."
, Text
"Scarce black motes slowly settle on the ground."
, Text
"The ground in the immediate area is empty, as if just swiped."
]
MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgLnAdd MsgClassShowAndSave
MsgBadMiscEvent Text
blurb
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Challenge -> Bool
cwolf Challenge
curChal Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
loneMode) (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
MsgActionWarning Text
"Being a lone wolf, you begin without companions."
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (History -> Int
lengthHistory (SessionUI -> History
shistory SessionUI
oldSess) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
Bool -> m ()
forall (m :: * -> *). MonadClientUI m => Bool -> m ()
fadeOutOrIn Bool
False
Bool -> m ()
forall (m :: * -> *). MonadClientUI m => Bool -> m ()
setFrontAutoYes (Bool -> m ()) -> Bool -> m ()
forall a b. (a -> b) -> a -> b
$ Faction -> Bool
isAIFact Faction
fact
m ()
forall (m :: * -> *). MonadClientUI m => m ()
resetPressedKeys
ColorMode -> Text -> m ()
forall (m :: * -> *). MonadClientUI m => ColorMode -> Text -> m ()
displayMore ColorMode
ColorFull Text
"\nAre you up for the challenge?"
MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgPromptGeneric
Text
"A grand story starts right here! (Press '?' for context and help.)"
UpdRestartServer{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
UpdResume FactionId
fid PerLid
_ -> do
COps{ContentData CaveKind
cocave :: ContentData CaveKind
cocave :: COps -> ContentData CaveKind
cocave} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
m ()
forall (m :: * -> *). MonadClientUI m => m ()
resetSessionStart
Faction
fact <- (State -> Faction) -> m Faction
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (FactionDict -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
fid) (FactionDict -> Faction)
-> (State -> FactionDict) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> FactionDict
sfactionD
Bool -> m ()
forall (m :: * -> *). MonadClientUI m => Bool -> m ()
setFrontAutoYes (Bool -> m ()) -> Bool -> m ()
forall a b. (a -> b) -> a -> b
$ Faction -> Bool
isAIFact Faction
fact
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Faction -> Bool
isAIFact Faction
fact) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
LevelId
lid <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
getArenaUI
Level
lvl <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel LevelId
lid
ModeKind
gameMode <- m ModeKind
forall (m :: * -> *). MonadStateRead m => m ModeKind
getGameMode
MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgActionAlert (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Continuing" Text -> Text -> Text
<+> ModeKind -> Text
mname ModeKind
gameMode Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgPromptGeneric (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ ModeKind -> Text
mdesc ModeKind
gameMode
let desc :: Text
desc = CaveKind -> Text
cdesc (CaveKind -> Text) -> CaveKind -> Text
forall a b. (a -> b) -> a -> b
$ ContentData CaveKind -> ContentId CaveKind -> CaveKind
forall a. ContentData a -> ContentId a -> a
okind ContentData CaveKind
cocave (ContentId CaveKind -> CaveKind) -> ContentId CaveKind -> CaveKind
forall a b. (a -> b) -> a -> b
$ Level -> ContentId CaveKind
lkind Level
lvl
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> Bool
T.null Text
desc) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgLnAdd MsgClassShow
MsgPromptFocus Text
"You remember your surroundings."
MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgPromptGeneric Text
desc
ColorMode -> Text -> m ()
forall (m :: * -> *). MonadClientUI m => ColorMode -> Text -> m ()
displayMore ColorMode
ColorFull Text
"\nAre you up for the challenge?"
MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgPromptGeneric
Text
"Prove yourself! (Press '?' for context and help.)"
UpdResumeServer{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
UpdKillExit{} -> do
#ifdef USE_JSFILE
liftIO $ threadDelay 2000000
#else
IO () -> m ()
forall (m :: * -> *) a. MonadClientRead m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> IO ()
threadDelay Int
200000
#endif
m () -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ ColorMode -> Text -> m ()
forall (m :: * -> *). MonadClientUI m => ColorMode -> Text -> m ()
displayMore ColorMode
ColorBW Text
"Done."
FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
Text -> m ()
forall (m :: * -> *). MonadClientUI m => Text -> m ()
debugPossiblyPrintUI (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Client" Text -> Text -> Text
<+> FactionId -> Text
forall a. Show a => a -> Text
tshow FactionId
side Text -> Text -> Text
<+> Text
"closing frontend."
m ()
forall (m :: * -> *). MonadClientUI m => m ()
frontendShutdown
Text -> m ()
forall (m :: * -> *). MonadClientUI m => Text -> m ()
debugPossiblyPrintUI (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Client" Text -> Text -> Text
<+> FactionId -> Text
forall a. Show a => a -> Text
tshow FactionId
side Text -> Text -> Text
<+> Text
"closed frontend."
UpdAtomic
UpdWriteSave -> MsgClassSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassSave
MsgInnerWorkSpam Text
"Saving backup."
UpdHearFid FactionId
_ Maybe Int
distance HearMsg
hearMsg -> do
Maybe ActorId
mleader <- (StateClient -> Maybe ActorId) -> m (Maybe ActorId)
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Maybe ActorId
sleader
case Maybe ActorId
mleader of
Just{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Maybe ActorId
Nothing -> do
LevelId
lidV <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
viewedLevelUI
LevelId -> m ()
forall (m :: * -> *). MonadClientUI m => LevelId -> m ()
markDisplayNeeded LevelId
lidV
m ()
forall (m :: * -> *). MonadClientUI m => m ()
recordHistory
Text
msg <- Maybe Int -> HearMsg -> m Text
forall (m :: * -> *).
MonadClientUI m =>
Maybe Int -> HearMsg -> m Text
ppHearMsg Maybe Int
distance HearMsg
hearMsg
let msgClass :: MsgClassShowAndSave
msgClass = case Maybe Int
distance of
Maybe Int
Nothing -> MsgClassShowAndSave
MsgHeardOutside
Just Int
0 -> MsgClassShowAndSave
MsgHeardNearby
Just Int
_ -> MsgClassShowAndSave
MsgHeardFaraway
MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
msgClass Text
msg
case HearMsg
hearMsg of
HearUpd UpdDestroyActor{} ->
MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
MsgTutorialHint Text
"Events out of your sight radius (as listed in the '#' skill menu) can sometimes be heard, depending on your hearing radius skill. Some, such as death shrieks, can always be heard regardless of skill and distance, including when they come from a different floor."
HearTaunt{} -> do
Time
globalTime <- (State -> Time) -> m Time
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> Time
stime
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Time
globalTime Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
> Time
timeTurn) (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
MsgTutorialHint Text
"Enemies you can't see are sometimes heard yelling and emitting other noises. Whether you can hear them, depends on their distance and your hearing radius, as listed in the '#' skill menu."
HearMsg
_ -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
UpdMuteMessages FactionId
_ Bool
smuteMessages ->
(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 {Bool
smuteMessages :: Bool
smuteMessages :: Bool
smuteMessages}
updateItemSlot :: MonadClientUI m => Container -> ItemId -> m ()
updateItemSlot :: Container -> ItemId -> m ()
updateItemSlot Container
c ItemId
iid = do
AspectRecord
arItem <- (State -> AspectRecord) -> m AspectRecord
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> AspectRecord) -> m AspectRecord)
-> (State -> AspectRecord) -> m AspectRecord
forall a b. (a -> b) -> a -> b
$ ItemId -> State -> AspectRecord
aspectRecordFromIid ItemId
iid
ItemSlots EnumMap SLore SingleItemSlots
itemSlots <- (SessionUI -> ItemSlots) -> m ItemSlots
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> ItemSlots
sslots
let slore :: SLore
slore = AspectRecord -> Container -> SLore
IA.loreFromContainer AspectRecord
arItem Container
c
lSlots :: SingleItemSlots
lSlots = EnumMap SLore SingleItemSlots
itemSlots EnumMap SLore SingleItemSlots -> SLore -> SingleItemSlots
forall k a. Enum k => EnumMap k a -> k -> a
EM.! SLore
slore
case ItemId -> [(ItemId, SlotChar)] -> Maybe SlotChar
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ItemId
iid ([(ItemId, SlotChar)] -> Maybe SlotChar)
-> [(ItemId, SlotChar)] -> Maybe SlotChar
forall a b. (a -> b) -> a -> b
$ ((SlotChar, ItemId) -> (ItemId, SlotChar))
-> [(SlotChar, ItemId)] -> [(ItemId, SlotChar)]
forall a b. (a -> b) -> [a] -> [b]
map (SlotChar, ItemId) -> (ItemId, SlotChar)
forall a b. (a, b) -> (b, a)
swap ([(SlotChar, ItemId)] -> [(ItemId, SlotChar)])
-> [(SlotChar, ItemId)] -> [(ItemId, SlotChar)]
forall a b. (a -> b) -> a -> b
$ SingleItemSlots -> [(SlotChar, ItemId)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs SingleItemSlots
lSlots of
Maybe SlotChar
Nothing -> do
let l :: SlotChar
l = SingleItemSlots -> SlotChar
assignSlot SingleItemSlots
lSlots
f :: SingleItemSlots -> SingleItemSlots
f = SlotChar -> ItemId -> SingleItemSlots -> SingleItemSlots
forall k a. Enum k => k -> a -> EnumMap k a -> EnumMap k a
EM.insert SlotChar
l ItemId
iid
newSlots :: ItemSlots
newSlots = EnumMap SLore SingleItemSlots -> ItemSlots
ItemSlots (EnumMap SLore SingleItemSlots -> ItemSlots)
-> EnumMap SLore SingleItemSlots -> ItemSlots
forall a b. (a -> b) -> a -> b
$ (SingleItemSlots -> SingleItemSlots)
-> SLore
-> EnumMap SLore SingleItemSlots
-> EnumMap SLore SingleItemSlots
forall k a. Enum k => (a -> a) -> k -> EnumMap k a -> EnumMap k a
EM.adjust SingleItemSlots -> SingleItemSlots
f SLore
slore EnumMap SLore SingleItemSlots
itemSlots
(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 {sslots :: ItemSlots
sslots = ItemSlots
newSlots}
Just SlotChar
_l -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
data Threat =
ThreatNone
| ThreatUnarmed
| ThreatArmed
| ThreatAnotherUnarmed
| ThreatAnotherArmed
deriving Threat -> Threat -> Bool
(Threat -> Threat -> Bool)
-> (Threat -> Threat -> Bool) -> Eq Threat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Threat -> Threat -> Bool
$c/= :: Threat -> Threat -> Bool
== :: Threat -> Threat -> Bool
$c== :: Threat -> Threat -> Bool
Eq
createActorUI :: MonadClientUI m => Bool -> ActorId -> Actor -> m ()
createActorUI :: Bool -> ActorId -> Actor -> m ()
createActorUI Bool
born ActorId
aid Actor
body = do
CCUI{coscreen :: CCUI -> ScreenContent
coscreen=ScreenContent{Int
rwidth :: ScreenContent -> Int
rwidth :: Int
rwidth}} <- (SessionUI -> CCUI) -> m CCUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
FactionDict
factionD <- (State -> FactionDict) -> m FactionDict
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> FactionDict
sfactionD
let fact :: Faction
fact = FactionDict
factionD FactionDict -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
body
Time
localTime <- (State -> Time) -> m Time
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Time) -> m Time) -> (State -> Time) -> m Time
forall a b. (a -> b) -> a -> b
$ LevelId -> State -> Time
getLocalTime (LevelId -> State -> Time) -> LevelId -> State -> Time
forall a b. (a -> b) -> a -> b
$ Actor -> LevelId
blid Actor
body
itemFull :: ItemFull
itemFull@ItemFull{Item
itemBase :: ItemFull -> Item
itemBase :: Item
itemBase, ItemKind
itemKind :: ItemFull -> ItemKind
itemKind :: ItemKind
itemKind} <- (State -> ItemFull) -> m ItemFull
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemFull) -> m ItemFull)
-> (State -> ItemFull) -> m ItemFull
forall a b. (a -> b) -> a -> b
$ ItemId -> State -> ItemFull
itemToFull (Actor -> ItemId
btrunk Actor
body)
ActorDictUI
actorUI <- (SessionUI -> ActorDictUI) -> m ActorDictUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> ActorDictUI
sactorUI
let arItem :: AspectRecord
arItem = ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFull
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ActorId
aid ActorId -> ActorDictUI -> Bool
forall k a. Enum k => k -> EnumMap k a -> Bool
`EM.member` ActorDictUI
actorUI) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
UIOptions{[(Int, (Text, Text))]
uHeroNames :: UIOptions -> [(Int, (Text, Text))]
uHeroNames :: [(Int, (Text, Text))]
uHeroNames} <- (SessionUI -> UIOptions) -> m UIOptions
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> UIOptions
sUIOptions
let baseColor :: Color
baseColor = Flavour -> Color
flavourToColor (Flavour -> Color) -> Flavour -> Color
forall a b. (a -> b) -> a -> b
$ Item -> Flavour
jflavour Item
itemBase
basePronoun :: Text
basePronoun | Bool -> Bool
not (Actor -> Bool
bproj Actor
body)
Bool -> Bool -> Bool
&& ItemKind -> Char
IK.isymbol ItemKind
itemKind Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'@'
Bool -> Bool -> Bool
&& Player -> Bool
fhasGender (Faction -> Player
gplayer Faction
fact) = Text
"he"
| Bool
otherwise = Text
"it"
nameFromNumber :: Text -> a -> Text
nameFromNumber Text
fn a
k = if a
k a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0
then [Part] -> Text
makePhrase [Part -> Part
MU.Ws (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ Text -> Part
MU.Text Text
fn, Part
"Captain"]
else Text
fn Text -> Text -> Text
<+> a -> Text
forall a. Show a => a -> Text
tshow a
k
heroNamePronoun :: Int -> (Text, Text)
heroNamePronoun Int
k =
if Faction -> Color
gcolor Faction
fact Color -> Color -> Bool
forall a. Eq a => a -> a -> Bool
/= Color
Color.BrWhite
then (Text -> Int -> Text
forall a. (Eq a, Num a, Show a) => Text -> a -> Text
nameFromNumber (Player -> Text
fname (Player -> Text) -> Player -> Text
forall a b. (a -> b) -> a -> b
$ Faction -> Player
gplayer Faction
fact) Int
k, Text
"he")
else (Text, Text) -> Maybe (Text, Text) -> (Text, Text)
forall a. a -> Maybe a -> a
fromMaybe (Text -> Int -> Text
forall a. (Eq a, Num a, Show a) => Text -> a -> Text
nameFromNumber (Player -> Text
fname (Player -> Text) -> Player -> Text
forall a b. (a -> b) -> a -> b
$ Faction -> Player
gplayer Faction
fact) Int
k, Text
"he")
(Maybe (Text, Text) -> (Text, Text))
-> Maybe (Text, Text) -> (Text, Text)
forall a b. (a -> b) -> a -> b
$ Int -> [(Int, (Text, Text))] -> Maybe (Text, Text)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Int
k [(Int, (Text, Text))]
uHeroNames
(Int
n, Char
bsymbol) =
if | Actor -> Bool
bproj Actor
body -> (Int
0, if Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Blast AspectRecord
arItem
then ItemKind -> Char
IK.isymbol ItemKind
itemKind
else Char
'*')
| Color
baseColor Color -> Color -> Bool
forall a. Eq a => a -> a -> Bool
/= Color
Color.BrWhite -> (Int
0, ItemKind -> Char
IK.isymbol ItemKind
itemKind)
| Bool
otherwise -> case Actor -> Maybe Int
bnumber Actor
body of
Maybe Int
Nothing ->
[Char] -> (Int, Char)
forall a. (?callStack::CallStack) => [Char] -> a
error ([Char] -> (Int, Char)) -> [Char] -> (Int, Char)
forall a b. (a -> b) -> a -> b
$ [Char]
"numbered actor without server-assigned number"
[Char] -> (ActorId, Actor) -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` (ActorId
aid, Actor
body)
Just Int
bn -> (Int
bn, if Int
0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
bn Bool -> Bool -> Bool
&& Int
bn Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
10
then Int -> Char
Char.intToDigit Int
bn
else Char
'@')
(Part
object1, Part
object2) =
Int
-> FactionId
-> FactionDict
-> Time
-> ItemFull
-> ItemQuant
-> (Part, Part)
partItemShortest Int
rwidth (Actor -> FactionId
bfid Actor
body) FactionDict
factionD Time
localTime
ItemFull
itemFull ItemQuant
quantSingle
(Text
bname, Text
bpronoun) =
if | Actor -> Bool
bproj Actor
body ->
let adj :: Part
adj = case Actor -> Maybe ([Vector], Speed)
btrajectory Actor
body of
Just ([Vector]
tra, Speed
_) | [Vector] -> Int
forall a. [a] -> Int
length [Vector]
tra Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
5 -> Part
"falling"
Maybe ([Vector], Speed)
_ -> Part
"flying"
in ([Part] -> Text
makePhrase [Part
adj, Part
object1, Part
object2], Text
basePronoun)
| Color
baseColor Color -> Color -> Bool
forall a. Eq a => a -> a -> Bool
/= Color
Color.BrWhite ->
([Part] -> Text
makePhrase [Part
object1, Part
object2], Text
basePronoun)
| Bool
otherwise -> Int -> (Text, Text)
heroNamePronoun Int
n
bcolor :: Color
bcolor | Actor -> Bool
bproj Actor
body = if Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Blast AspectRecord
arItem
then Color
baseColor
else Color
Color.BrWhite
| Color
baseColor Color -> Color -> Bool
forall a. Eq a => a -> a -> Bool
== Color
Color.BrWhite = Faction -> Color
gcolor Faction
fact
| Bool
otherwise = Color
baseColor
bUI :: ActorUI
bUI = ActorUI :: Char -> Text -> Text -> Color -> ActorUI
ActorUI{Char
Text
Color
bcolor :: Color
bpronoun :: Text
bname :: Text
bsymbol :: Char
bcolor :: Color
bpronoun :: Text
bname :: Text
bsymbol :: Char
..}
(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 {sactorUI :: ActorDictUI
sactorUI = ActorId -> ActorUI -> ActorDictUI -> ActorDictUI
forall k a. Enum k => k -> a -> EnumMap k a -> EnumMap k a
EM.insert ActorId
aid ActorUI
bUI ActorDictUI
actorUI}
((ItemId, CStore) -> m ()) -> [(ItemId, CStore)] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
mapM_ (\(ItemId
iid, CStore
store) -> do
let c :: Container
c = if Bool -> Bool
not (Actor -> Bool
bproj Actor
body) Bool -> Bool -> Bool
&& ItemId
iid ItemId -> ItemId -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> ItemId
btrunk Actor
body
then FactionId -> LevelId -> Point -> Container
CTrunk (Actor -> FactionId
bfid Actor
body) (Actor -> LevelId
blid Actor
body) (Actor -> Point
bpos Actor
body)
else ActorId -> CStore -> Container
CActor ActorId
aid CStore
store
Container -> ItemId -> m ()
forall (m :: * -> *).
MonadClientUI m =>
Container -> ItemId -> m ()
updateItemSlot Container
c ItemId
iid
ItemId -> Container -> m ()
forall (m :: * -> *).
MonadClientUI m =>
ItemId -> Container -> m ()
recordItemLid ItemId
iid Container
c)
((Actor -> ItemId
btrunk Actor
body, CStore
CEqp)
(ItemId, CStore) -> [(ItemId, CStore)] -> [(ItemId, CStore)]
forall a. a -> [a] -> [a]
: ((ItemId, CStore) -> Bool)
-> [(ItemId, CStore)] -> [(ItemId, CStore)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((ItemId -> ItemId -> Bool
forall a. Eq a => a -> a -> Bool
/= Actor -> ItemId
btrunk Actor
body) (ItemId -> Bool)
-> ((ItemId, CStore) -> ItemId) -> (ItemId, CStore) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ItemId, CStore) -> ItemId
forall a b. (a, b) -> a
fst) (Actor -> [(ItemId, CStore)]
getCarriedIidCStore Actor
body))
if | Actor -> Bool
bproj Actor
body -> do
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Actor -> FactionId
bfid Actor
body FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
/= FactionId
side)
m ()
forall (m :: * -> *). MonadClientUI m => m ()
stopPlayBack
Bool -> m ()
forall (m :: * -> *). MonadClientUI m => Bool -> m ()
pushFrame Bool
False
| Actor -> FactionId
bfid Actor
body FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side -> do
let upd :: EnumSet ActorId -> EnumSet ActorId
upd = ActorId -> EnumSet ActorId -> EnumSet ActorId
forall k. Enum k => k -> EnumSet k -> EnumSet k
ES.insert 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 {sselected :: EnumSet ActorId
sselected = EnumSet ActorId -> EnumSet ActorId
upd (EnumSet ActorId -> EnumSet ActorId)
-> EnumSet ActorId -> EnumSet ActorId
forall a b. (a -> b) -> a -> b
$ SessionUI -> EnumSet ActorId
sselected SessionUI
sess}
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ActorDictUI -> Bool
forall k a. EnumMap k a -> Bool
EM.null ActorDictUI
actorUI) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
born (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
let verb :: Part
verb = Part
"join you"
MsgClassShowAndSave -> ActorId -> Part -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> ActorId -> Part -> m ()
aidVerbMU MsgClassShowAndSave
MsgSpottedActor ActorId
aid Part
verb
MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
MsgTutorialHint Text
"You survive this mission, or die trying, as a team. After a few moves, feel free to switch the controlled teammate (marked on the map with the yellow box) using the Tab key to another party member (marked with a green box)."
LevelId -> Animation -> m ()
forall (m :: * -> *).
MonadClientUI m =>
LevelId -> Animation -> m ()
animate (Actor -> LevelId
blid Actor
body) (Animation -> m ()) -> Animation -> m ()
forall a b. (a -> b) -> a -> b
$ Point -> Animation
actorX (Actor -> Point
bpos Actor
body)
| Bool
otherwise -> do
EnumSet ActorId
lastLost <- (SessionUI -> EnumSet ActorId) -> m (EnumSet ActorId)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> EnumSet ActorId
slastLost
if ActorId -> EnumSet ActorId -> Bool
forall k. Enum k => k -> EnumSet k -> Bool
ES.member ActorId
aid EnumSet ActorId
lastLost
then LevelId -> m ()
forall (m :: * -> *). MonadClientUI m => LevelId -> m ()
markDisplayNeeded (Actor -> LevelId
blid Actor
body)
else do
m ()
forall (m :: * -> *). MonadClientUI m => m ()
stopPlayBack
let verb :: Part
verb = if Bool
born then Part
"appear suddenly" else Part
"be spotted"
Threat
threat <-
if FactionId -> Faction -> FactionId -> Bool
isFoe (Actor -> FactionId
bfid Actor
body) Faction
fact FactionId
side then do
Maybe Target
xhair <- (SessionUI -> Maybe Target) -> m (Maybe Target)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe Target
sxhair
case Maybe Target
xhair of
Just (TVector Vector
_) -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Maybe Target
_ -> (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 { sxhair :: Maybe Target
sxhair = Target -> Maybe Target
forall a. a -> Maybe a
Just (Target -> Maybe Target) -> Target -> Maybe Target
forall a b. (a -> b) -> a -> b
$ ActorId -> Target
TEnemy ActorId
aid
, sitemSel :: Maybe (ItemId, CStore, Bool)
sitemSel = Maybe (ItemId, CStore, Bool)
forall a. Maybe a
Nothing }
[Actor]
foes <- (State -> [Actor]) -> m [Actor]
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [Actor]) -> m [Actor])
-> (State -> [Actor]) -> m [Actor]
forall a b. (a -> b) -> a -> b
$ FactionId -> LevelId -> State -> [Actor]
foeRegularList FactionId
side (Actor -> LevelId
blid Actor
body)
Int
itemsSize <- (State -> Int) -> m Int
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
$ Actor -> State -> Int
guardItemSize Actor
body
if [Actor] -> Int
forall a. [a] -> Int
length [Actor]
foes Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1 then
if Int
itemsSize Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then do
MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgSpottedThreat Text
"You are not alone!"
Threat -> m Threat
forall (m :: * -> *) a. Monad m => a -> m a
return Threat
ThreatUnarmed
else do
MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgSpottedThreat Text
"Armed intrusion ahead!"
Threat -> m Threat
forall (m :: * -> *) a. Monad m => a -> m a
return Threat
ThreatArmed
else
if Int
itemsSize Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then
Threat -> m Threat
forall (m :: * -> *) a. Monad m => a -> m a
return Threat
ThreatAnotherUnarmed
else do
MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgSpottedThreat Text
"Another threat, armed!"
Threat -> m Threat
forall (m :: * -> *) a. Monad m => a -> m a
return Threat
ThreatAnotherArmed
else Threat -> m Threat
forall (m :: * -> *) a. Monad m => a -> m a
return Threat
ThreatNone
MsgClassShowAndSave -> ActorId -> Part -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> ActorId -> Part -> m ()
aidVerbMU MsgClassShowAndSave
MsgSpottedActor ActorId
aid Part
verb
[(ActorId, Actor)]
friendAssocs <- (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)])
-> (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
forall a b. (a -> b) -> a -> b
$ FactionId -> LevelId -> State -> [(ActorId, Actor)]
friendRegularAssocs FactionId
side (Actor -> LevelId
blid Actor
body)
case Threat
threat of
Threat
ThreatNone -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Threat
ThreatUnarmed ->
MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
MsgTutorialHint Text
"Enemies are normally dealt with using melee (by bumping when adjacent) or ranged combat (by 'f'linging items at them)."
Threat
ThreatArmed ->
MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
MsgTutorialHint Text
"Enemies can be dealt with not only via combat, but also with clever use of terrain effects, stealth (not emitting nor reflecting light) or hasty retreat (particularly when foes are asleep or drowsy)."
Threat
_ | [(ActorId, Actor)] -> Int
forall a. [a] -> Int
length [(ActorId, Actor)]
friendAssocs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1 -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Threat
ThreatAnotherUnarmed ->
MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
MsgTutorialHint Text
"When dealing with groups of enemies, remember than you fight as a team. Switch the pointman (marked on the map with the yellow box) using the Tab key until you move each teammate to a tactically advantageous position. Avoid meleeing alone."
Threat
ThreatAnotherArmed ->
MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
MsgTutorialHint Text
"When dealing with groups of armed enemies, remember than you fight as a team. Switch the pointman (marked on the map with the yellow box) using the Tab key until you move each teammate to a tactically advantageous position. Retreat, if necessary to form a front line. Soften the foes with missiles, especially of exploding kind."
LevelId -> Animation -> m ()
forall (m :: * -> *).
MonadClientUI m =>
LevelId -> Animation -> m ()
animate (Actor -> LevelId
blid Actor
body) (Animation -> m ()) -> Animation -> m ()
forall a b. (a -> b) -> a -> b
$ Point -> Animation
actorX (Actor -> Point
bpos Actor
body)
destroyActorUI :: MonadClientUI m => Bool -> ActorId -> Actor -> m ()
destroyActorUI :: Bool -> ActorId -> Actor -> m ()
destroyActorUI Bool
destroy ActorId
aid Actor
b = do
Item
trunk <- (State -> Item) -> m Item
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Item) -> m Item) -> (State -> Item) -> m Item
forall a b. (a -> b) -> a -> b
$ ItemId -> State -> Item
getItemBody (ItemId -> State -> Item) -> ItemId -> State -> Item
forall a b. (a -> b) -> a -> b
$ Actor -> ItemId
btrunk Actor
b
let baseColor :: Color
baseColor = Flavour -> Color
flavourToColor (Flavour -> Color) -> Flavour -> Color
forall a b. (a -> b) -> a -> b
$ Item -> Flavour
jflavour Item
trunk
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Color
baseColor Color -> Color -> Bool
forall a. Eq a => a -> a -> Bool
== Color
Color.BrWhite) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
(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 {sactorUI :: ActorDictUI
sactorUI = ActorId -> ActorDictUI -> ActorDictUI
forall k a. Enum k => k -> EnumMap k a -> EnumMap k a
EM.delete ActorId
aid (ActorDictUI -> ActorDictUI) -> ActorDictUI -> ActorDictUI
forall a b. (a -> b) -> a -> b
$ SessionUI -> ActorDictUI
sactorUI SessionUI
sess}
let dummyTarget :: Target
dummyTarget = TGoal -> LevelId -> Point -> Target
TPoint TGoal
TKnown (Actor -> LevelId
blid Actor
b) (Actor -> Point
bpos Actor
b)
affect :: Maybe Target -> Maybe Target
affect Maybe Target
tgt = case Maybe Target
tgt of
Just (TEnemy ActorId
a) | ActorId
a ActorId -> ActorId -> Bool
forall a. Eq a => a -> a -> Bool
== ActorId
aid -> Target -> Maybe Target
forall a. a -> Maybe a
Just (Target -> Maybe Target) -> Target -> Maybe Target
forall a b. (a -> b) -> a -> b
$
if Bool
destroy then
Target
dummyTarget
else
TGoal -> LevelId -> Point -> Target
TPoint (ActorId -> TGoal
TEnemyPos ActorId
a) (Actor -> LevelId
blid Actor
b) (Actor -> Point
bpos Actor
b)
Just (TNonEnemy ActorId
a) | ActorId
a ActorId -> ActorId -> Bool
forall a. Eq a => a -> a -> Bool
== ActorId
aid -> Target -> Maybe Target
forall a. a -> Maybe a
Just Target
dummyTarget
Maybe Target
_ -> Maybe Target
tgt
(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 {sxhair :: Maybe Target
sxhair = Maybe Target -> Maybe Target
affect (Maybe Target -> Maybe Target) -> Maybe Target -> Maybe Target
forall a b. (a -> b) -> a -> b
$ SessionUI -> Maybe Target
sxhair SessionUI
sess}
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Actor -> Bool
bproj Actor
b Bool -> Bool -> Bool
|| Bool
destroy) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
(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 {slastLost :: EnumSet ActorId
slastLost = ActorId -> EnumSet ActorId -> EnumSet ActorId
forall k. Enum k => k -> EnumSet k -> EnumSet k
ES.insert ActorId
aid (EnumSet ActorId -> EnumSet ActorId)
-> EnumSet ActorId -> EnumSet ActorId
forall a b. (a -> b) -> a -> b
$ SessionUI -> EnumSet ActorId
slastLost SessionUI
sess}
FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
Faction
fact <- (State -> Faction) -> m Faction
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (FactionDict -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
side) (FactionDict -> Faction)
-> (State -> FactionDict) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> FactionDict
sfactionD
let 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
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
gameOver (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Actor -> FactionId
bfid Actor
b FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side Bool -> Bool -> Bool
&& Bool -> Bool
not (Actor -> Bool
bproj Actor
b)) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
m ()
forall (m :: * -> *). MonadClientUI m => m ()
stopPlayBack
let upd :: EnumSet ActorId -> EnumSet ActorId
upd = ActorId -> EnumSet ActorId -> EnumSet ActorId
forall k. Enum k => k -> EnumSet k -> EnumSet k
ES.delete 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 {sselected :: EnumSet ActorId
sselected = EnumSet ActorId -> EnumSet ActorId
upd (EnumSet ActorId -> EnumSet ActorId)
-> EnumSet ActorId -> EnumSet ActorId
forall a b. (a -> b) -> a -> b
$ SessionUI -> EnumSet ActorId
sselected SessionUI
sess}
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
destroy (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Maybe ActorId
mleader <- (StateClient -> Maybe ActorId) -> m (Maybe ActorId)
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Maybe ActorId
sleader
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe ActorId -> Bool
forall a. Maybe a -> Bool
isJust Maybe ActorId
mleader)
m ()
forall (m :: * -> *). MonadClientUI m => m ()
clearAimMode
LevelId -> m ()
forall (m :: * -> *). MonadClientUI m => LevelId -> m ()
markDisplayNeeded (Actor -> LevelId
blid Actor
b)
spotItemBag :: forall m. MonadClientUI m
=> Bool -> Container -> ItemBag -> m ()
spotItemBag :: Bool -> Container -> ItemBag -> m ()
spotItemBag Bool
verbose Container
c ItemBag
bag = do
CCUI{coscreen :: CCUI -> ScreenContent
coscreen=ScreenContent{Int
rwidth :: Int
rwidth :: ScreenContent -> Int
rwidth}} <- (SessionUI -> CCUI) -> m CCUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
ItemId -> ContentId ItemKind
getKind <- (State -> ItemId -> ContentId ItemKind)
-> m (ItemId -> ContentId ItemKind)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemId -> ContentId ItemKind)
-> m (ItemId -> ContentId ItemKind))
-> (State -> ItemId -> ContentId ItemKind)
-> m (ItemId -> ContentId ItemKind)
forall a b. (a -> b) -> a -> b
$ (ItemId -> State -> ContentId ItemKind)
-> State -> ItemId -> ContentId ItemKind
forall a b c. (a -> b -> c) -> b -> a -> c
flip ItemId -> State -> ContentId ItemKind
getIidKindId
LevelId
lid <- (State -> LevelId) -> m LevelId
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> LevelId) -> m LevelId)
-> (State -> LevelId) -> m LevelId
forall a b. (a -> b) -> a -> b
$ Container -> State -> LevelId
lidFromC Container
c
Time
localTime <- (State -> Time) -> m Time
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Time) -> m Time) -> (State -> Time) -> m Time
forall a b. (a -> b) -> a -> b
$ LevelId -> State -> Time
getLocalTime LevelId
lid
FactionDict
factionD <- (State -> FactionDict) -> m FactionDict
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> FactionDict
sfactionD
ItemSlots EnumMap SLore SingleItemSlots
itemSlots <- (SessionUI -> ItemSlots) -> m ItemSlots
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> ItemSlots
sslots
Maybe Target
sxhairOld <- (SessionUI -> Maybe Target) -> m (Maybe Target)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe Target
sxhair
let resetXhair :: m ()
resetXhair = case Container
c of
CFloor LevelId
_ Point
p -> case Maybe Target
sxhairOld of
Just TEnemy{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just (TPoint TEnemyPos{} LevelId
_ Point
_) -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just (TPoint TStash{} LevelId
_ Point
_) -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just (TVector Vector
_) -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Maybe Target
_ -> do
LevelId
lidV <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
viewedLevelUI
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (LevelId
lid LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== LevelId
lidV) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
ItemBag
bagFloor <- (State -> ItemBag) -> m ItemBag
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemBag) -> m ItemBag)
-> (State -> ItemBag) -> m ItemBag
forall a b. (a -> b) -> a -> b
$ LevelId -> Point -> State -> ItemBag
getFloorBag LevelId
lid Point
p
(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 { sxhair :: Maybe Target
sxhair = Target -> Maybe Target
forall a. a -> Maybe a
Just (Target -> Maybe Target) -> Target -> Maybe Target
forall a b. (a -> b) -> a -> b
$ TGoal -> LevelId -> Point -> Target
TPoint (ItemBag -> TGoal
TItem ItemBag
bagFloor) LevelId
lidV Point
p
, sitemSel :: Maybe (ItemId, CStore, Bool)
sitemSel = Maybe (ItemId, CStore, Bool)
forall a. Maybe a
Nothing }
Container
_ -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
locatedWhere :: Text
locatedWhere = FactionDict -> Container -> Text
ppContainer FactionDict
factionD Container
c
beLocated :: Part
beLocated = Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$
Text
"be located" Text -> Text -> Text
<+> if Text
locatedWhere Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== FactionDict -> Container -> Text
ppContainer FactionDict
forall k a. EnumMap k a
EM.empty Container
c
then Text
""
else Text
locatedWhere
subjectMaybe :: (ItemId, ItemQuant) -> m (Maybe (Int, MU.Part, MU.Part))
subjectMaybe :: (ItemId, ItemQuant) -> m (Maybe (Int, Part, Part))
subjectMaybe (ItemId
iid, kit :: ItemQuant
kit@(Int
k, ItemTimers
_)) = do
ItemId -> Container -> m ()
forall (m :: * -> *).
MonadClientUI m =>
ItemId -> Container -> m ()
recordItemLid ItemId
iid Container
c
ItemFull
itemFull <- (State -> ItemFull) -> m ItemFull
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemFull) -> m ItemFull)
-> (State -> ItemFull) -> m ItemFull
forall a b. (a -> b) -> a -> b
$ ItemId -> State -> ItemFull
itemToFull ItemId
iid
let arItem :: AspectRecord
arItem = ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFull
slore :: SLore
slore = AspectRecord -> Container -> SLore
IA.loreFromContainer AspectRecord
arItem Container
c
case ItemId -> [(ItemId, SlotChar)] -> Maybe SlotChar
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ItemId
iid ([(ItemId, SlotChar)] -> Maybe SlotChar)
-> [(ItemId, SlotChar)] -> Maybe SlotChar
forall a b. (a -> b) -> a -> b
$ ((SlotChar, ItemId) -> (ItemId, SlotChar))
-> [(SlotChar, ItemId)] -> [(ItemId, SlotChar)]
forall a b. (a -> b) -> [a] -> [b]
map (SlotChar, ItemId) -> (ItemId, SlotChar)
forall a b. (a, b) -> (b, a)
swap ([(SlotChar, ItemId)] -> [(ItemId, SlotChar)])
-> [(SlotChar, ItemId)] -> [(ItemId, SlotChar)]
forall a b. (a -> b) -> a -> b
$ SingleItemSlots -> [(SlotChar, ItemId)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs (SingleItemSlots -> [(SlotChar, ItemId)])
-> SingleItemSlots -> [(SlotChar, ItemId)]
forall a b. (a -> b) -> a -> b
$ EnumMap SLore SingleItemSlots
itemSlots EnumMap SLore SingleItemSlots -> SLore -> SingleItemSlots
forall k a. Enum k => EnumMap k a -> k -> a
EM.! SLore
slore of
Maybe SlotChar
Nothing -> do
Container -> ItemId -> m ()
forall (m :: * -> *).
MonadClientUI m =>
Container -> ItemId -> m ()
updateItemSlot Container
c ItemId
iid
case Container
c of
CFloor{} -> do
let subjectShort :: Part
subjectShort = Int
-> FactionId
-> FactionDict
-> Int
-> Time
-> ItemFull
-> ItemQuant
-> Part
partItemWsShortest Int
rwidth FactionId
side FactionDict
factionD Int
k
Time
localTime ItemFull
itemFull ItemQuant
kit
subjectLong :: Part
subjectLong = Int
-> FactionId
-> FactionDict
-> Int
-> Time
-> ItemFull
-> ItemQuant
-> Part
partItemWsLong Int
rwidth FactionId
side FactionDict
factionD Int
k
Time
localTime ItemFull
itemFull ItemQuant
kit
Maybe (Int, Part, Part) -> m (Maybe (Int, Part, Part))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Int, Part, Part) -> m (Maybe (Int, Part, Part)))
-> Maybe (Int, Part, Part) -> m (Maybe (Int, Part, Part))
forall a b. (a -> b) -> a -> b
$ (Int, Part, Part) -> Maybe (Int, Part, Part)
forall a. a -> Maybe a
Just (Int
k, Part
subjectShort, Part
subjectLong)
Container
_ -> Maybe (Int, Part, Part) -> m (Maybe (Int, Part, Part))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Int, Part, Part)
forall a. Maybe a
Nothing
Maybe SlotChar
_ -> Maybe (Int, Part, Part) -> m (Maybe (Int, Part, Part))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Int, Part, Part)
forall a. Maybe a
Nothing
sortItems :: [(ItemId, ItemQuant)] -> [(ItemId, ItemQuant)]
sortItems = ((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)
sortedAssocs :: [(ItemId, ItemQuant)]
sortedAssocs = [(ItemId, ItemQuant)] -> [(ItemId, ItemQuant)]
sortItems ([(ItemId, ItemQuant)] -> [(ItemId, ItemQuant)])
-> [(ItemId, ItemQuant)] -> [(ItemId, ItemQuant)]
forall a b. (a -> b) -> a -> b
$ ItemBag -> [(ItemId, ItemQuant)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs ItemBag
bag
[Maybe (Int, Part, Part)]
subjectMaybes <- ((ItemId, ItemQuant) -> m (Maybe (Int, Part, Part)))
-> [(ItemId, ItemQuant)] -> m [Maybe (Int, Part, Part)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ItemId, ItemQuant) -> m (Maybe (Int, Part, Part))
subjectMaybe [(ItemId, ItemQuant)]
sortedAssocs
let subjects :: [(Int, Part, Part)]
subjects = [Maybe (Int, Part, Part)] -> [(Int, Part, Part)]
forall a. [Maybe a] -> [a]
catMaybes [Maybe (Int, Part, Part)]
subjectMaybes
sendMsg :: Bool -> m ()
sendMsg Bool
plural = do
let subjectShort :: Part
subjectShort = [Part] -> Part
MU.WWandW ([Part] -> Part) -> [Part] -> Part
forall a b. (a -> b) -> a -> b
$ ((Int, Part, Part) -> Part) -> [(Int, Part, Part)] -> [Part]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
_, Part
part, Part
_) -> Part
part) [(Int, Part, Part)]
subjects
subjectLong :: Part
subjectLong = [Part] -> Part
MU.WWandW ([Part] -> Part) -> [Part] -> Part
forall a b. (a -> b) -> a -> b
$ ((Int, Part, Part) -> Part) -> [(Int, Part, Part)] -> [Part]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
_, Part
_, Part
part) -> Part
part) [(Int, Part, Part)]
subjects
msg :: Part -> Text
msg Part
subject =
if Bool
plural
then [Part] -> Text
makeSentence [Person -> Polarity -> Part -> Part -> Part
MU.SubjectVerb Person
MU.PlEtc Polarity
MU.Yes
Part
subject Part
beLocated]
else [Part] -> Text
makeSentence [Part -> Part -> Part
MU.SubjectVerbSg Part
subject Part
beLocated]
msgShort :: Text
msgShort = Part -> Text
msg Part
subjectShort
msgLong :: Text
msgLong = Part -> Text
msg Part
subjectLong
dotsIfShorter :: Text
dotsIfShorter = if Text
msgShort Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
msgLong then Text
"" else Text
".."
m ()
resetXhair
MsgClassDistinct -> (Text, Text) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
MsgClassDistinct -> (Text, Text) -> m ()
msgAddDistinct MsgClassDistinct
MsgSpottedItem (Text
msgShort Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
dotsIfShorter, Text
msgLong)
case [(Int, Part, Part)]
subjects of
[] -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
[(Int
1, Part
_, Part
_)] -> Bool -> m ()
sendMsg Bool
False
[(Int, Part, Part)]
_ -> Bool -> m ()
sendMsg Bool
True
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
verbose (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ case Container
c of
CActor ActorId
aid CStore
store -> do
let verb :: Part
verb = Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ CStore -> Text
verbCStore CStore
store
Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
Faction
fact <- (State -> Faction) -> m Faction
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (FactionDict -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
b) (FactionDict -> Faction)
-> (State -> FactionDict) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> FactionDict
sfactionD
let underAI :: Bool
underAI = Faction -> Bool
isAIFact Faction
fact
Maybe ActorId
mleader <- (StateClient -> Maybe ActorId) -> m (Maybe ActorId)
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Maybe ActorId
sleader
if ActorId -> Maybe ActorId
forall a. a -> Maybe a
Just ActorId
aid Maybe ActorId -> Maybe ActorId -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe ActorId
mleader Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
underAI then
MsgClassShowAndSave
-> ActorId
-> Part
-> [(ItemId, ItemQuant)]
-> (Int -> Either (Maybe Int) Int)
-> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a
-> ActorId
-> Part
-> [(ItemId, ItemQuant)]
-> (Int -> Either (Maybe Int) Int)
-> m ()
manyItemsAidVerbMU MsgClassShowAndSave
MsgItemMovement ActorId
aid Part
verb [(ItemId, ItemQuant)]
sortedAssocs Int -> Either (Maybe Int) Int
forall a b. b -> Either a b
Right
else Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Actor -> Bool
bproj Actor
b) Bool -> Bool -> Bool
&& Actor -> Int64
bhp Actor
b Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
MsgClassShowAndSave
-> ActorId
-> Part
-> [(ItemId, ItemQuant)]
-> (Int -> Either (Maybe Int) Int)
-> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a
-> ActorId
-> Part
-> [(ItemId, ItemQuant)]
-> (Int -> Either (Maybe Int) Int)
-> m ()
manyItemsAidVerbMU MsgClassShowAndSave
MsgItemMovement ActorId
aid Part
verb [(ItemId, ItemQuant)]
sortedAssocs (Maybe Int -> Either (Maybe Int) Int
forall a b. a -> Either a b
Left (Maybe Int -> Either (Maybe Int) Int)
-> (Int -> Maybe Int) -> Int -> Either (Maybe Int) Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Maybe Int
forall a. a -> Maybe a
Just)
Container
_ -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
recordItemLid :: MonadClientUI m => ItemId -> Container -> m ()
recordItemLid :: ItemId -> Container -> m ()
recordItemLid ItemId
iid Container
c = do
Maybe LevelId
mjlid <- (SessionUI -> Maybe LevelId) -> m (Maybe LevelId)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession ((SessionUI -> Maybe LevelId) -> m (Maybe LevelId))
-> (SessionUI -> Maybe LevelId) -> m (Maybe LevelId)
forall a b. (a -> b) -> a -> 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
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe LevelId -> Bool
forall a. Maybe a -> Bool
isNothing Maybe LevelId
mjlid) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
LevelId
lid <- (State -> LevelId) -> m LevelId
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> LevelId) -> m LevelId)
-> (State -> LevelId) -> m LevelId
forall a b. (a -> b) -> a -> b
$ Container -> State -> LevelId
lidFromC Container
c
(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 {sitemUI :: EnumMap ItemId LevelId
sitemUI = ItemId
-> LevelId -> EnumMap ItemId LevelId -> EnumMap ItemId LevelId
forall k a. Enum k => k -> a -> EnumMap k a -> EnumMap k a
EM.insert ItemId
iid LevelId
lid (EnumMap ItemId LevelId -> EnumMap ItemId LevelId)
-> EnumMap ItemId LevelId -> EnumMap ItemId LevelId
forall a b. (a -> b) -> a -> b
$ SessionUI -> EnumMap ItemId LevelId
sitemUI SessionUI
sess}
moveActor :: MonadClientUI m => ActorId -> Point -> Point -> m ()
moveActor :: ActorId -> Point -> Point -> m ()
moveActor ActorId
aid Point
source Point
target = do
Actor
body <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
if Point -> Point -> Bool
adjacent Point
source Point
target
then LevelId -> m ()
forall (m :: * -> *). MonadClientUI m => LevelId -> m ()
markDisplayNeeded (Actor -> LevelId
blid Actor
body)
else do
let ps :: (Point, Point)
ps = (Point
source, Point
target)
LevelId -> Animation -> m ()
forall (m :: * -> *).
MonadClientUI m =>
LevelId -> Animation -> m ()
animate (Actor -> LevelId
blid Actor
body) (Animation -> m ()) -> Animation -> m ()
forall a b. (a -> b) -> a -> b
$ (Point, Point) -> Animation
teleport (Point, Point)
ps
ActorId -> m ()
forall (m :: * -> *). MonadClientUI m => ActorId -> m ()
lookAtMove ActorId
aid
ActorId -> m ()
forall (m :: * -> *). MonadClientUI m => ActorId -> m ()
stopAtMove ActorId
aid
displaceActorUI :: MonadClientUI m => ActorId -> ActorId -> m ()
displaceActorUI :: ActorId -> ActorId -> m ()
displaceActorUI ActorId
source ActorId
target = do
Maybe ActorId
mleader <- (StateClient -> Maybe ActorId) -> m (Maybe ActorId)
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Maybe ActorId
sleader
Actor
sb <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
source
Actor
tb <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
target
Part
spart <- ActorId -> m Part
forall (m :: * -> *). MonadClientUI m => ActorId -> m Part
partActorLeader ActorId
source
Part
tpart <- ActorId -> m Part
forall (m :: * -> *). MonadClientUI m => ActorId -> m Part
partActorLeader ActorId
target
let msgClass :: MsgClassShowAndSave
msgClass = if Maybe ActorId
mleader Maybe ActorId -> [Maybe ActorId] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (ActorId -> Maybe ActorId) -> [ActorId] -> [Maybe ActorId]
forall a b. (a -> b) -> [a] -> [b]
map ActorId -> Maybe ActorId
forall a. a -> Maybe a
Just [ActorId
source, ActorId
target]
then MsgClassShowAndSave
MsgActionMajor
else MsgClassShowAndSave
MsgActionMinor
msg :: Text
msg = [Part] -> Text
makeSentence [Part -> Part -> Part
MU.SubjectVerbSg Part
spart Part
"displace", Part
tpart]
MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
msgClass Text
msg
ActorId -> m ()
forall (m :: * -> *). MonadClientUI m => ActorId -> m ()
lookAtMove ActorId
source
ActorId -> m ()
forall (m :: * -> *). MonadClientUI m => ActorId -> m ()
stopAtMove ActorId
source
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Actor -> FactionId
bfid Actor
sb FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
/= Actor -> FactionId
bfid Actor
tb) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
ActorId -> m ()
forall (m :: * -> *). MonadClientUI m => ActorId -> m ()
lookAtMove ActorId
target
ActorId -> m ()
forall (m :: * -> *). MonadClientUI m => ActorId -> m ()
stopAtMove ActorId
target
FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (FactionId
side FactionId -> [FactionId] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Actor -> FactionId
bfid Actor
sb, Actor -> FactionId
bfid Actor
tb] Bool -> Bool -> Bool
&& 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
source) m ()
forall (m :: * -> *). MonadClientUI m => m ()
stopPlayBack
let ps :: (Point, Point)
ps = (Actor -> Point
bpos Actor
tb, Actor -> Point
bpos Actor
sb)
LevelId -> Animation -> m ()
forall (m :: * -> *).
MonadClientUI m =>
LevelId -> Animation -> m ()
animate (Actor -> LevelId
blid Actor
sb) (Animation -> m ()) -> Animation -> m ()
forall a b. (a -> b) -> a -> b
$ (Point, Point) -> Animation
swapPlaces (Point, Point)
ps
moveItemUI :: MonadClientUI m
=> ItemId -> Int -> ActorId -> CStore -> CStore
-> m ()
moveItemUI :: ItemId -> Int -> ActorId -> CStore -> CStore -> m ()
moveItemUI ItemId
iid Int
k ActorId
aid CStore
cstore1 CStore
cstore2 = do
let verb :: Part
verb = Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ CStore -> Text
verbCStore CStore
cstore2
Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
Faction
fact <- (State -> Faction) -> m Faction
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (FactionDict -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
b) (FactionDict -> Faction)
-> (State -> FactionDict) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> FactionDict
sfactionD
let underAI :: Bool
underAI = Faction -> Bool
isAIFact Faction
fact
Maybe ActorId
mleader <- (StateClient -> Maybe ActorId) -> m (Maybe ActorId)
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Maybe ActorId
sleader
ItemSlots EnumMap SLore SingleItemSlots
itemSlots <- (SessionUI -> ItemSlots) -> m ItemSlots
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> ItemSlots
sslots
case ItemId -> [(ItemId, SlotChar)] -> Maybe SlotChar
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ItemId
iid ([(ItemId, SlotChar)] -> Maybe SlotChar)
-> [(ItemId, SlotChar)] -> Maybe SlotChar
forall a b. (a -> b) -> a -> b
$ ((SlotChar, ItemId) -> (ItemId, SlotChar))
-> [(SlotChar, ItemId)] -> [(ItemId, SlotChar)]
forall a b. (a -> b) -> [a] -> [b]
map (SlotChar, ItemId) -> (ItemId, SlotChar)
forall a b. (a, b) -> (b, a)
swap ([(SlotChar, ItemId)] -> [(ItemId, SlotChar)])
-> [(SlotChar, ItemId)] -> [(ItemId, SlotChar)]
forall a b. (a -> b) -> a -> b
$ SingleItemSlots -> [(SlotChar, ItemId)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs (SingleItemSlots -> [(SlotChar, ItemId)])
-> SingleItemSlots -> [(SlotChar, ItemId)]
forall a b. (a -> b) -> a -> b
$ EnumMap SLore SingleItemSlots
itemSlots EnumMap SLore SingleItemSlots -> SLore -> SingleItemSlots
forall k a. Enum k => EnumMap k a -> k -> a
EM.! SLore
SItem of
Just SlotChar
_l ->
if CStore
cstore1 CStore -> CStore -> Bool
forall a. Eq a => a -> a -> Bool
== CStore
CGround Bool -> Bool -> Bool
&& ActorId -> Maybe ActorId
forall a. a -> Maybe a
Just ActorId
aid Maybe ActorId -> Maybe ActorId -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe ActorId
mleader Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
underAI then
MsgClassShowAndSave
-> ActorId -> Part -> ItemId -> Either Int Int -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> ActorId -> Part -> ItemId -> Either Int Int -> m ()
itemAidVerbMU MsgClassShowAndSave
MsgActionMajor ActorId
aid Part
verb ItemId
iid (Int -> Either Int Int
forall a b. b -> Either a b
Right Int
k)
else Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Actor -> Bool
bproj Actor
b) Bool -> Bool -> Bool
&& Actor -> Int64
bhp Actor
b Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
MsgClassShowAndSave
-> ActorId -> Part -> ItemId -> Either Int Int -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> ActorId -> Part -> ItemId -> Either Int Int -> m ()
itemAidVerbMU MsgClassShowAndSave
MsgActionMajor ActorId
aid Part
verb ItemId
iid (Int -> Either Int Int
forall a b. a -> Either a b
Left Int
k)
Maybe SlotChar
Nothing -> [Char] -> m ()
forall a. (?callStack::CallStack) => [Char] -> a
error ([Char] -> m ()) -> [Char] -> m ()
forall a b. (a -> b) -> a -> b
$
[Char]
"" [Char] -> (ItemId, Int, ActorId, CStore, CStore) -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` (ItemId
iid, Int
k, ActorId
aid, CStore
cstore1, CStore
cstore2)
discover :: MonadClientUI m => Container -> ItemId -> m ()
discover :: Container -> ItemId -> m ()
discover Container
c ItemId
iid = do
COps{ContentData ItemKind
coitem :: COps -> ContentData ItemKind
coitem :: ContentData ItemKind
coitem} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
CCUI{coscreen :: CCUI -> ScreenContent
coscreen=ScreenContent{Int
rwidth :: Int
rwidth :: ScreenContent -> Int
rwidth}} <- (SessionUI -> CCUI) -> m CCUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
LevelId
lid <- (State -> LevelId) -> m LevelId
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> LevelId) -> m LevelId)
-> (State -> LevelId) -> m LevelId
forall a b. (a -> b) -> a -> b
$ Container -> State -> LevelId
lidFromC Container
c
Time
globalTime <- (State -> Time) -> m Time
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> Time
stime
Time
localTime <- (State -> Time) -> m Time
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Time) -> m Time) -> (State -> Time) -> m Time
forall a b. (a -> b) -> a -> b
$ LevelId -> State -> Time
getLocalTime LevelId
lid
ItemFull
itemFull <- (State -> ItemFull) -> m ItemFull
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemFull) -> m ItemFull)
-> (State -> ItemFull) -> m ItemFull
forall a b. (a -> b) -> a -> b
$ ItemId -> State -> ItemFull
itemToFull ItemId
iid
ItemBag
bag <- (State -> ItemBag) -> m ItemBag
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemBag) -> m ItemBag)
-> (State -> ItemBag) -> m ItemBag
forall a b. (a -> b) -> a -> b
$ Container -> State -> ItemBag
getContainerBag Container
c
FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
FactionDict
factionD <- (State -> FactionDict) -> m FactionDict
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> FactionDict
sfactionD
(Bool
noMsg, [Part]
nameWhere) <- case Container
c of
CActor ActorId
aidOwner CStore
storeOwner -> do
Actor
bOwner <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aidOwner
[Part]
name <- if Actor -> Bool
bproj Actor
bOwner
then [Part] -> m [Part]
forall (m :: * -> *) a. Monad m => a -> m a
return []
else (ActorId -> m Part) -> Bool -> Container -> m [Part]
forall (m :: * -> *).
MonadClientUI m =>
(ActorId -> m Part) -> Bool -> Container -> m [Part]
ppContainerWownW ActorId -> m Part
forall (m :: * -> *). MonadClientUI m => ActorId -> m Part
partActorLeader Bool
True Container
c
let arItem :: AspectRecord
arItem = ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFull
inMetaGame :: Bool
inMetaGame = Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.MetaGame AspectRecord
arItem
isOurOrgan :: Bool
isOurOrgan = Actor -> FactionId
bfid Actor
bOwner FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side
Bool -> Bool -> Bool
&& CStore
storeOwner CStore -> CStore -> Bool
forall a. Eq a => a -> a -> Bool
== CStore
COrgan
Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
inMetaGame
(Bool, [Part]) -> m (Bool, [Part])
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
isOurOrgan, [Part]
name)
CTrunk FactionId
_ LevelId
_ Point
p | Point
p Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Point
originPoint -> (Bool, [Part]) -> m (Bool, [Part])
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
True, [])
Container
_ -> (Bool, [Part]) -> m (Bool, [Part])
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
False, [])
let kit :: ItemQuant
kit = ItemQuant -> ItemId -> ItemBag -> ItemQuant
forall k a. Enum k => a -> k -> EnumMap k a -> a
EM.findWithDefault ItemQuant
quantSingle ItemId
iid ItemBag
bag
knownName :: Text
knownName = [Part] -> Text
makePhrase
[Int
-> FactionId
-> FactionDict
-> Time
-> ItemFull
-> ItemQuant
-> Part
partItemMediumAW Int
rwidth FactionId
side FactionDict
factionD Time
localTime ItemFull
itemFull ItemQuant
kit]
flav :: Text
flav = Flavour -> Text
flavourToName (Flavour -> Text) -> Flavour -> Text
forall a b. (a -> b) -> a -> b
$ Item -> Flavour
jflavour (Item -> Flavour) -> Item -> Flavour
forall a b. (a -> b) -> a -> b
$ ItemFull -> Item
itemBase ItemFull
itemFull
(Part
object1, Part
object2) =
Int
-> FactionId
-> FactionDict
-> Time
-> ItemFull
-> ItemQuant
-> (Part, Part)
partItemShortest Int
rwidth FactionId
side FactionDict
factionD Time
localTime ItemFull
itemFull ItemQuant
kit
name1 :: Text
name1 = [Part] -> Text
makePhrase [Part
object1, Part
object2]
(Bool
ikObvious, ContentId ItemKind
itemKind) = case Item -> ItemIdentity
jkind (Item -> ItemIdentity) -> Item -> ItemIdentity
forall a b. (a -> b) -> a -> b
$ ItemFull -> Item
itemBase ItemFull
itemFull of
IdentityObvious ContentId ItemKind
ik -> (Bool
True, ContentId ItemKind
ik)
IdentityCovered ItemKindIx
_ix ContentId ItemKind
ik -> (Bool
False, ContentId ItemKind
ik)
name2 :: Text
name2 = ItemKind -> Text
IK.iname (ItemKind -> Text) -> ItemKind -> Text
forall a b. (a -> b) -> a -> b
$ ContentData ItemKind -> ContentId ItemKind -> ItemKind
forall a. ContentData a -> ContentId a -> a
okind ContentData ItemKind
coitem ContentId ItemKind
itemKind
name :: Text
name = if Bool
ikObvious Bool -> Bool -> Bool
&& [Text] -> Text
T.unwords ([Text] -> [Text]
forall a. [a] -> [a]
tail (Text -> [Text]
T.words Text
knownName)) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
name1
then Text
name1
else Text
name2
unknownName :: Part
unknownName = [Part] -> Part
MU.Phrase ([Part] -> Part) -> [Part] -> Part
forall a b. (a -> b) -> a -> b
$ [Text -> Part
MU.Text Text
flav, Text -> Part
MU.Text Text
name] [Part] -> [Part] -> [Part]
forall a. [a] -> [a] -> [a]
++ [Part]
nameWhere
msg :: Text
msg = [Part] -> Text
makeSentence
[ Part
"the"
, Part -> Part -> Part
MU.SubjectVerbSg Part
unknownName Part
"turn out to be"
, Text -> Part
MU.Text Text
knownName ]
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool
noMsg Bool -> Bool -> Bool
|| Time
globalTime Time -> Time -> Bool
forall a. Eq a => a -> a -> Bool
== Time
timeZero) (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
MsgItemDiscovery Text
msg
ppHearMsg :: MonadClientUI m => Maybe Int -> HearMsg -> m Text
ppHearMsg :: Maybe Int -> HearMsg -> m Text
ppHearMsg Maybe Int
distance HearMsg
hearMsg = case HearMsg
hearMsg of
HearUpd UpdAtomic
cmd -> do
COps{TileSpeedup
coTileSpeedup :: COps -> TileSpeedup
coTileSpeedup :: TileSpeedup
coTileSpeedup} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
let sound :: Part
sound = case UpdAtomic
cmd of
UpdDestroyActor{} -> Part
"shriek"
UpdCreateItem{} -> Part
"clatter"
UpdTrajectory{} -> Part
"thud"
UpdAlterTile LevelId
_ Point
_ ContentId TileKind
fromTile ContentId TileKind
toTile ->
if | TileSpeedup -> ContentId TileKind -> Bool
Tile.isOpenable TileSpeedup
coTileSpeedup ContentId TileKind
fromTile
Bool -> Bool -> Bool
&& TileSpeedup -> ContentId TileKind -> Bool
Tile.isClosable TileSpeedup
coTileSpeedup ContentId TileKind
toTile
Bool -> Bool -> Bool
|| TileSpeedup -> ContentId TileKind -> Bool
Tile.isClosable TileSpeedup
coTileSpeedup ContentId TileKind
fromTile
Bool -> Bool -> Bool
&& TileSpeedup -> ContentId TileKind -> Bool
Tile.isOpenable TileSpeedup
coTileSpeedup ContentId TileKind
toTile -> Part
"creaking sound"
| TileSpeedup -> ContentId TileKind -> Bool
Tile.isWalkable TileSpeedup
coTileSpeedup ContentId TileKind
fromTile
Bool -> Bool -> Bool
&& TileSpeedup -> ContentId TileKind -> Bool
Tile.isWalkable TileSpeedup
coTileSpeedup ContentId TileKind
toTile -> Part
"splash"
| Bool
otherwise -> Part
"rumble"
UpdAlterExplorable LevelId
_ Int
k ->
if Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then Part
"grinding noise" else Part
"fizzing noise"
UpdAtomic
_ -> [Char] -> Part
forall a. (?callStack::CallStack) => [Char] -> a
error ([Char] -> Part) -> [Char] -> Part
forall a b. (a -> b) -> a -> b
$ [Char]
"" [Char] -> UpdAtomic -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` UpdAtomic
cmd
adjective :: Part
adjective = Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Text
ppHearDistanceAdjective Maybe Int
distance
msg :: Text
msg = [Part] -> Text
makeSentence [Part
"you hear", Part -> Part
MU.AW (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ [Part] -> Part
MU.Phrase [Part
adjective, Part
sound]]
Text -> m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$! Text
msg
HearStrike ContentId ItemKind
ik -> do
COps{ContentData ItemKind
coitem :: ContentData ItemKind
coitem :: COps -> ContentData ItemKind
coitem} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
let verb :: Text
verb = ItemKind -> Text
IK.iverbHit (ItemKind -> Text) -> ItemKind -> Text
forall a b. (a -> b) -> a -> b
$ ContentData ItemKind -> ContentId ItemKind -> ItemKind
forall a. ContentData a -> ContentId a -> a
okind ContentData ItemKind
coitem ContentId ItemKind
ik
adverb :: Part
adverb = Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Text
ppHearDistanceAdverb Maybe Int
distance
msg :: Text
msg = [Part] -> Text
makeSentence [ Part
"you", Part
adverb, Part
"hear something"
, Text -> Part
MU.Text Text
verb, Part
"someone" ]
Text -> m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$! Text
msg
HearSummon Bool
isProj GroupName ItemKind
grp Dice
p -> do
let verb :: Part
verb = if Bool
isProj then Part
"something lure" else Part
"somebody summon"
part :: Part
part = Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ GroupName ItemKind -> Text
forall c. GroupName c -> Text
displayGroupName GroupName ItemKind
grp
object :: Part
object = if Dice
p Dice -> Dice -> Bool
forall a. Eq a => a -> a -> Bool
== Dice
1
then Part -> Part
MU.AW Part
part
else Part -> Part
MU.Ws Part
part
adverb :: Part
adverb = Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Text
ppHearDistanceAdverb Maybe Int
distance
Text -> m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$! [Part] -> Text
makeSentence [Part
"you", Part
adverb, Part
"hear", Part
verb, Part
object]
HearMsg
HearCollideTile -> do
let adverb :: Part
adverb = Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Text
ppHearDistanceAdverb Maybe Int
distance
Text -> m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$! [Part] -> Text
makeSentence [Part
"you", Part
adverb, Part
"hear someone crash into something"]
HearTaunt Text
t -> do
let adverb :: Part
adverb = Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Text
ppHearDistanceAdverb Maybe Int
distance
Text -> m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$! [Part] -> Text
makePhrase [Part
"You", Part
adverb, Part
"overhear", Text -> Part
MU.Text Text
t]
ppHearDistanceAdjective :: Maybe Int -> Text
ppHearDistanceAdjective :: Maybe Int -> Text
ppHearDistanceAdjective Maybe Int
Nothing = Text
"indistinct"
ppHearDistanceAdjective (Just Int
0) = Text
"very close"
ppHearDistanceAdjective (Just Int
1) = Text
"close"
ppHearDistanceAdjective (Just Int
2) = Text
""
ppHearDistanceAdjective (Just Int
3) = Text
"remote"
ppHearDistanceAdjective (Just Int
4) = Text
"distant"
ppHearDistanceAdjective (Just Int
_) = Text
"far-off"
ppHearDistanceAdverb :: Maybe Int -> Text
ppHearDistanceAdverb :: Maybe Int -> Text
ppHearDistanceAdverb Maybe Int
Nothing = Text
"indistinctly"
ppHearDistanceAdverb (Just Int
0) = Text
"very clearly"
ppHearDistanceAdverb (Just Int
1) = Text
"clearly"
ppHearDistanceAdverb (Just Int
2) = Text
""
ppHearDistanceAdverb (Just Int
3) = Text
"remotely"
ppHearDistanceAdverb (Just Int
4) = Text
"distantly"
ppHearDistanceAdverb (Just Int
_) = Text
"barely"