{-# LANGUAGE TupleSections #-}
module Game.LambdaHack.Client.UI.DisplayAtomicM
( displayRespUpdAtomicUI, displayRespSfxAtomicUI
#ifdef EXPOSE_INTERNAL
, updateItemSlot, markDisplayNeeded, lookAtMove
, aidVerbMU, aidVerbMU0, aidVerbDuplicateMU
, itemVerbMU, itemAidVerbMU
, createActorUI, destroyActorUI, spotItem, moveActor, displaceActorUI
, moveItemUI, quitFactionUI
, displayGameOverLoot, displayGameOverAnalytics
, discover, ppSfxMsg, strike
#endif
) where
import Prelude ()
import Game.LambdaHack.Core.Prelude
import qualified Data.Char as Char
import qualified Data.EnumMap.Strict as EM
import qualified Data.EnumSet as ES
import Data.Key (mapWithKeyM_)
import qualified Data.Ord as Ord
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.ClientOptions
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.EffectDescription
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.Overlay
import Game.LambdaHack.Client.UI.SessionUI
import Game.LambdaHack.Client.UI.SlideshowM
import Game.LambdaHack.Client.UI.UIOptions
import Game.LambdaHack.Common.Actor
import Game.LambdaHack.Common.ActorState
import Game.LambdaHack.Common.Analytics
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.ReqFailure
import Game.LambdaHack.Common.State
import qualified Game.LambdaHack.Common.Tile as Tile
import Game.LambdaHack.Common.Time
import Game.LambdaHack.Common.Types
import Game.LambdaHack.Content.CaveKind (cdesc)
import qualified Game.LambdaHack.Content.ItemKind as IK
import Game.LambdaHack.Content.ModeKind
import Game.LambdaHack.Content.RuleKind
import qualified Game.LambdaHack.Content.TileKind as TK
import qualified Game.LambdaHack.Core.Dice as Dice
import Game.LambdaHack.Core.Frequency
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
displayRespUpdAtomicUI :: MonadClientUI m => UpdAtomic -> m ()
{-# INLINE displayRespUpdAtomicUI #-}
displayRespUpdAtomicUI :: UpdAtomic -> m ()
displayRespUpdAtomicUI cmd :: UpdAtomic
cmd = case UpdAtomic
cmd of
UpdCreateActor aid :: ActorId
aid body :: Actor
body _ -> Bool -> ActorId -> Actor -> m ()
forall (m :: * -> *).
MonadClientUI m =>
Bool -> ActorId -> Actor -> m ()
createActorUI Bool
True ActorId
aid Actor
body
UpdDestroyActor aid :: ActorId
aid body :: Actor
body _ -> Bool -> ActorId -> Actor -> m ()
forall (m :: * -> *).
MonadClientUI m =>
Bool -> ActorId -> Actor -> m ()
destroyActorUI Bool
True ActorId
aid Actor
body
UpdCreateItem iid :: ItemId
iid _item :: Item
_item kit :: ItemQuant
kit c :: 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
case Container
c of
CActor aid :: ActorId
aid store :: CStore
store -> do
case CStore
store of
COrgan -> 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
if Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Condition AspectRecord
arItem then do
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
let more :: Bool
more = case ItemId -> ItemBag -> Maybe ItemQuant
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup ItemId
iid ItemBag
bag of
Nothing -> Bool
False
Just kit2 :: ItemQuant
kit2 -> ItemQuant -> Int
forall a b. (a, b) -> a
fst ItemQuant
kit2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= ItemQuant -> Int
forall a b. (a, b) -> a
fst ItemQuant
kit
verb :: Part
verb = Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$
"become" Text -> Text -> Text
<+> case ItemQuant -> Int
forall a b. (a, b) -> a
fst ItemQuant
kit of
1 -> if Bool
more then "more" else ""
k :: Int
k -> (if Bool
more then "additionally" else "")
Text -> Text -> Text
<+> Int -> Text
forall a. Show a => a -> Text
tshow Int
k Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "-fold"
MsgClass
-> ActorId
-> Part
-> ItemId
-> Either (Maybe Int) Int
-> CStore
-> m ()
forall (m :: * -> *).
MonadClientUI m =>
MsgClass
-> ActorId
-> Part
-> ItemId
-> Either (Maybe Int) Int
-> CStore
-> m ()
itemAidVerbMU MsgClass
MsgBecome ActorId
aid Part
verb ItemId
iid (Maybe Int -> Either (Maybe Int) Int
forall a b. a -> Either a b
Left Maybe Int
forall a. Maybe a
Nothing) CStore
COrgan
else do
ActorId -> Part
ownerFun <- m (ActorId -> Part)
forall (m :: * -> *). MonadClientUI m => m (ActorId -> Part)
partActorLeaderFun
let wown :: [Part]
wown = (ActorId -> Part) -> Bool -> Container -> [Part]
ppContainerWownW ActorId -> Part
ownerFun Bool
True Container
c
MsgClass -> ItemId -> ItemQuant -> Part -> Container -> m ()
forall (m :: * -> *).
MonadClientUI m =>
MsgClass -> ItemId -> ItemQuant -> Part -> Container -> m ()
itemVerbMU MsgClass
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
$ "grow" Part -> [Part] -> [Part]
forall a. a -> [a] -> [a]
: [Part]
wown) Container
c
_ -> do
ActorId -> Part
ownerFun <- m (ActorId -> Part)
forall (m :: * -> *). MonadClientUI m => m (ActorId -> Part)
partActorLeaderFun
let wown :: [Part]
wown = (ActorId -> Part) -> Bool -> Container -> [Part]
ppContainerWownW ActorId -> Part
ownerFun Bool
True Container
c
MsgClass -> ItemId -> ItemQuant -> Part -> Container -> m ()
forall (m :: * -> *).
MonadClientUI m =>
MsgClass -> ItemId -> ItemQuant -> Part -> Container -> m ()
itemVerbMU MsgClass
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
$ "appear" Part -> [Part] -> [Part]
forall a. a -> [a] -> [a]
: [Part]
wown) Container
c
CEmbed lid :: LevelId
lid _ -> LevelId -> m ()
forall (m :: * -> *). MonadClientUI m => LevelId -> m ()
markDisplayNeeded LevelId
lid
CFloor lid :: LevelId
lid _ -> do
MsgClass -> ItemId -> ItemQuant -> Part -> Container -> m ()
forall (m :: * -> *).
MonadClientUI m =>
MsgClass -> ItemId -> ItemQuant -> Part -> Container -> m ()
itemVerbMU MsgClass
MsgItemCreation ItemId
iid ItemQuant
kit
(Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ "appear" Text -> Text -> Text
<+> Container -> Text
ppContainer Container
c) Container
c
LevelId -> m ()
forall (m :: * -> *). MonadClientUI m => LevelId -> m ()
markDisplayNeeded LevelId
lid
CTrunk{} -> [Char] -> m ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> m ()) -> [Char] -> m ()
forall a b. (a -> b) -> a -> b
$ "" [Char] -> Container -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` Container
c
UpdDestroyItem iid :: ItemId
iid _ kit :: ItemQuant
kit c :: Container
c -> do
MsgClass -> ItemId -> ItemQuant -> Part -> Container -> m ()
forall (m :: * -> *).
MonadClientUI m =>
MsgClass -> ItemId -> ItemQuant -> Part -> Container -> m ()
itemVerbMU MsgClass
MsgItemDestruction ItemId
iid ItemQuant
kit "disappear" Container
c
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 aid :: ActorId
aid body :: Actor
body _ -> Bool -> ActorId -> Actor -> m ()
forall (m :: * -> *).
MonadClientUI m =>
Bool -> ActorId -> Actor -> m ()
createActorUI Bool
False ActorId
aid Actor
body
UpdLoseActor aid :: ActorId
aid body :: Actor
body _ -> Bool -> ActorId -> Actor -> m ()
forall (m :: * -> *).
MonadClientUI m =>
Bool -> ActorId -> Actor -> m ()
destroyActorUI Bool
False ActorId
aid Actor
body
UpdSpotItem verbose :: Bool
verbose iid :: ItemId
iid _ kit :: ItemQuant
kit c :: Container
c -> Bool -> ItemId -> ItemQuant -> Container -> m ()
forall (m :: * -> *).
MonadClientUI m =>
Bool -> ItemId -> ItemQuant -> Container -> m ()
spotItem Bool
verbose ItemId
iid ItemQuant
kit Container
c
UpdLoseItem{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
UpdSpotItemBag c :: Container
c bag :: ItemBag
bag _ ->
(Key (EnumMap ItemId) -> ItemQuant -> m ()) -> ItemBag -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(FoldableWithKey t, Monad m) =>
(Key t -> a -> m b) -> t a -> m ()
mapWithKeyM_ (\iid :: Key (EnumMap ItemId)
iid kit :: ItemQuant
kit -> Bool -> ItemId -> ItemQuant -> Container -> m ()
forall (m :: * -> *).
MonadClientUI m =>
Bool -> ItemId -> ItemQuant -> Container -> m ()
spotItem Bool
True Key (EnumMap ItemId)
ItemId
iid ItemQuant
kit Container
c) ItemBag
bag
UpdLoseItemBag{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
UpdMoveActor aid :: ActorId
aid source :: Point
source target :: Point
target -> ActorId -> Point -> Point -> m ()
forall (m :: * -> *).
MonadClientUI m =>
ActorId -> Point -> Point -> m ()
moveActor ActorId
aid Point
source Point
target
UpdWaitActor{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
UpdDisplaceActor source :: ActorId
source target :: ActorId
target -> ActorId -> ActorId -> m ()
forall (m :: * -> *). MonadClientUI m => ActorId -> ActorId -> m ()
displaceActorUI ActorId
source ActorId
target
UpdMoveItem iid :: ItemId
iid k :: Int
k aid :: ActorId
aid c1 :: CStore
c1 c2 :: 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 _ 0 -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
UpdRefillHP aid :: ActorId
aid hpDelta :: Int64
hpDelta -> do
CCUI{ScreenContent
coscreen :: CCUI -> ScreenContent
coscreen :: ScreenContent
coscreen} <- (SessionUI -> CCUI) -> m CCUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
MsgClass -> ActorId -> Part -> m ()
forall (m :: * -> *).
MonadClientUI m =>
MsgClass -> ActorId -> Part -> m ()
aidVerbMU MsgClass
MsgNumeric ActorId
aid (Part -> m ()) -> Part -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Part
MU.Text
(Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ (if Int64
hpDelta Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> 0 then "heal" else "lose")
Text -> Text -> Text
<+> Int64 -> Text
forall a. Show a => a -> Text
tshow (Int64 -> Int64
forall a. Num a => a -> a
abs Int64
hpDelta Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`divUp` Int64
oneM) 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
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
<= 0 Bool -> Bool -> Bool
&& Int64
hpDelta Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< 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 (firstFall :: Part
firstFall, hurtExtra :: 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
(True, True) -> ("drop down", "tumble down")
(True, False) -> ("fall down", "suffers woeful mutilation")
(False, True) -> ("plummet", "crash")
(False, False) -> ("collapse", "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
<= 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
$ (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
b) (EnumMap FactionId Faction -> Faction)
-> (State -> EnumMap FactionId Faction) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap FactionId Faction
sfactionD
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
== "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 :: MsgClass
msgClass | Actor -> Bool
bproj Actor
b = MsgClass
MsgDeath
| Bool
targetIsFoe = MsgClass
MsgDeathGood
| Bool
targetIsFriend = MsgClass
MsgDeathBad
| Bool
otherwise = MsgClass
MsgDeath
MsgClass -> Text -> m ()
forall (m :: * -> *). MonadClientUI m => MsgClass -> Text -> m ()
msgAdd MsgClass
msgClass Text
msgDie
let deathAct :: Animation
deathAct
| Bool
alreadyDeadBefore =
ScreenContent -> (Point, Point) -> Color -> Color -> Animation
twirlSplash ScreenContent
coscreen (Actor -> Point
bpos Actor
b, Actor -> Point
bpos Actor
b) Color
Color.Red Color
Color.Red
| Actor -> FactionId
bfid Actor
b FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side = ScreenContent -> Point -> Animation
deathBody ScreenContent
coscreen (Actor -> Point
bpos Actor
b)
| Bool
otherwise = ScreenContent -> Point -> Animation
shortDeathBody ScreenContent
coscreen (Actor -> Point
bpos Actor
b)
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
$ 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
> 0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
MsgClass -> ActorId -> Part -> m ()
forall (m :: * -> *).
MonadClientUI m =>
MsgClass -> ActorId -> Part -> m ()
aidVerbMU MsgClass
MsgWarning ActorId
aid "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
$
MsgClass -> Text -> m ()
forall (m :: * -> *). MonadClientUI m => MsgClass -> Text -> m ()
msgAdd MsgClass
MsgVeryRare "You recover your health fully."
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
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
< 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
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
$
MsgClass -> ActorId -> Part -> m ()
forall (m :: * -> *).
MonadClientUI m =>
MsgClass -> ActorId -> Part -> m ()
aidVerbMU0 MsgClass
MsgDeathThreat ActorId
aid
"be down to a dangerous health level"
UpdRefillCalm _ 0 -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
UpdRefillCalm aid :: ActorId
aid calmDelta :: 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
> 0 ->
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
$ (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
side) (EnumMap FactionId Faction -> Faction)
-> (State -> EnumMap FactionId Faction) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap FactionId Faction
sfactionD
State
s <- m State
forall (m :: * -> *). MonadStateRead m => m State
getState
let closeFoe :: (Point, ActorId) -> Bool
closeFoe (!Point
p, aid2 :: 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
<= 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 <- MsgClass -> ActorId -> Part -> m Bool
forall (m :: * -> *).
MonadClientUI m =>
MsgClass -> ActorId -> Part -> m Bool
aidVerbDuplicateMU MsgClass
MsgHeardClose ActorId
aid "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
< 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
$
MsgClass -> ActorId -> Part -> m ()
forall (m :: * -> *).
MonadClientUI m =>
MsgClass -> ActorId -> Part -> m ()
aidVerbMU0 MsgClass
MsgDeathThreat ActorId
aid
"have grown agitated and impressed enough to be in danger of defecting"
UpdTrajectory _ _ mt :: Maybe ([Vector], Speed)
mt ->
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
-> (([Vector], Speed) -> Bool) -> Maybe ([Vector], Speed) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True ([Vector] -> Bool
forall a. [a] -> Bool
null ([Vector] -> Bool)
-> (([Vector], Speed) -> [Vector]) -> ([Vector], Speed) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Vector], Speed) -> [Vector]
forall a b. (a, b) -> a
fst) Maybe ([Vector], Speed)
mt) m ()
forall (m :: * -> *). MonadClientUI m => m ()
pushFrame
UpdQuitFaction fid :: FactionId
fid _ toSt :: Maybe Status
toSt manalytics :: 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
UpdLeadFaction fid :: FactionId
fid (Just source :: ActorId
source) (Just target :: ActorId
target) -> 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
$ (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
fid) (EnumMap FactionId Faction -> Faction)
-> (State -> EnumMap FactionId Faction) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap FactionId Faction
sfactionD
LevelId
lidV <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
viewedLevelUI
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 sb :: Actor
sb | Actor -> Int64
bhp Actor
sb Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 -> Bool -> m () -> m ()
forall a. HasCallStack => 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
MsgClass -> Text -> m ()
forall (m :: * -> *). MonadClientUI m => MsgClass -> Text -> m ()
msgAdd MsgClass
MsgLeader (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
[Part] -> Text
makeSentence [ Part -> Part -> Part
MU.SubjectVerbSg Part
subject "take command"
, "from", Part
object ]
_ -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
ActorId -> m ()
forall (m :: * -> *). MonadClientUI m => ActorId -> m ()
lookAtMove ActorId
target
UpdLeadFaction _ Nothing (Just target :: ActorId
target) -> ActorId -> m ()
forall (m :: * -> *). MonadClientUI m => ActorId -> m ()
lookAtMove ActorId
target
UpdLeadFaction{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
UpdDiplFaction fid1 :: FactionId
fid1 fid2 :: FactionId
fid2 _ toDipl :: 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
. (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
fid1) (EnumMap FactionId Faction -> Faction)
-> (State -> EnumMap FactionId Faction) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap FactionId Faction
sfactionD
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
. (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
fid2) (EnumMap FactionId Faction -> Faction)
-> (State -> EnumMap FactionId Faction) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap FactionId Faction
sfactionD
let showDipl :: Diplomacy -> p
showDipl Unknown = "unknown to each other"
showDipl Neutral = "in neutral diplomatic relations"
showDipl Alliance = "allied"
showDipl War = "at war"
MsgClass -> Text -> m ()
forall (m :: * -> *). MonadClientUI m => MsgClass -> Text -> m ()
msgAdd MsgClass
MsgDiplomacy (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
Text
name1 Text -> Text -> Text
<+> "and" Text -> Text -> Text
<+> Text
name2 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
<> "."
UpdTacticFaction{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
UpdAutoFaction fid :: FactionId
fid b :: 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
$ m ()
forall (m :: * -> *). MonadClientUI m => m ()
addPressedControlEsc
Bool -> m ()
forall (m :: * -> *). MonadClientUI m => Bool -> m ()
setFrontAutoYes Bool
b
UpdRecordKill{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
UpdAlterTile lid :: LevelId
lid p :: Point
p fromTile :: ContentId TileKind
fromTile toTile :: ContentId TileKind
toTile -> do
LevelId -> m ()
forall (m :: * -> *). MonadClientUI m => LevelId -> m ()
markDisplayNeeded LevelId
lid
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
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 feat :: Feature
feat =
case Feature
feat of
TK.OpenTo tgroup :: GroupName TileKind
tgroup -> GroupName TileKind -> Maybe (GroupName TileKind)
forall a. a -> Maybe a
Just GroupName TileKind
tgroup
TK.CloseTo tgroup :: GroupName TileKind
tgroup -> GroupName TileKind -> Maybe (GroupName TileKind)
forall a. a -> Maybe a
Just GroupName TileKind
tgroup
TK.ChangeTo tgroup :: GroupName TileKind
tgroup -> GroupName TileKind -> Maybe (GroupName TileKind)
forall a. a -> Maybe a
Just GroupName TileKind
tgroup
_ -> 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 (\(_, q :: Int
q) -> Int
q Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 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
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([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) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
let subject :: Part
subject = ""
verb :: Part
verb = "turn into"
msg :: Text
msg = [Part] -> Text
makeSentence
[ "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
, "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
, "suddenly"
, 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 ]
MsgClass -> Text -> m ()
forall (m :: * -> *). MonadClientUI m => MsgClass -> Text -> m ()
msgAdd MsgClass
MsgTileDisco Text
msg
UpdAlterExplorable lid :: LevelId
lid _ -> LevelId -> m ()
forall (m :: * -> *). MonadClientUI m => LevelId -> m ()
markDisplayNeeded LevelId
lid
UpdAlterGold{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
UpdSearchTile aid :: ActorId
aid _p :: Point
_p toTile :: 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. HasCallStack => [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 "reveal"
, "that the"
, Part -> Part -> Part
MU.SubjectVerbSg Part
subject2 "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
$ MsgClass -> Text -> m ()
forall (m :: * -> *). MonadClientUI m => MsgClass -> Text -> m ()
msgAdd MsgClass
MsgTileDisco Text
msg
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
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
ping :: Bool
ping = Int
clipMod Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
sdisplayNeeded Bool -> Bool -> Bool
|| Bool
ping) m ()
forall (m :: * -> *). MonadClientUI m => m ()
pushFrame
UpdUnAgeGame{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
UpdDiscover c :: Container
c iid :: ItemId
iid _ _ -> 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. HasCallStack => [Char] -> a
error "server command leaked to client"
UpdCoverServer{} -> [Char] -> m ()
forall a. HasCallStack => [Char] -> a
error "server command leaked to client"
UpdPerception{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
UpdRestart fid :: FactionId
fid _ _ _ _ _ -> do
COps{ContentData CaveKind
cocave :: COps -> ContentData CaveKind
cocave :: ContentData CaveKind
cocave, RuleContent
corule :: COps -> RuleContent
corule :: RuleContent
corule} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
POSIXTime
sstart <- (SessionUI -> POSIXTime) -> m POSIXTime
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> POSIXTime
sstart
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (POSIXTime
sstart POSIXTime -> POSIXTime -> Bool
forall a. Eq a => a -> a -> Bool
== 0) m ()
forall (m :: * -> *). MonadClientUI m => m ()
resetSessionStart
History
history <- (SessionUI -> History) -> m History
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> History
shistory
if History -> Int
lengthHistory History
history Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 then do
let title :: Text
title = RuleContent -> Text
rtitle RuleContent
corule
MsgClass -> Text -> m ()
forall (m :: * -> *). MonadClientUI m => MsgClass -> Text -> m ()
msgAdd MsgClass
MsgAdmin (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ "Welcome to" Text -> Text -> Text
<+> Text
title Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "!"
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
$ \sess :: SessionUI
sess -> SessionUI
sess {History
shistory :: History
shistory :: History
shistory}
else
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
mode <- 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
$ (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
fid) (EnumMap FactionId Faction -> Faction)
-> (State -> EnumMap FactionId Faction) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap FactionId Faction
sfactionD
let loneMode :: Bool
loneMode = case Faction -> [(Int, Int, GroupName ItemKind)]
ginitial Faction
fact of
[] -> Bool
True
[(_, 1, _)] -> Bool
True
_ -> Bool
False
MsgClass -> Text -> m ()
forall (m :: * -> *). MonadClientUI m => MsgClass -> Text -> m ()
msgAdd MsgClass
MsgWarning (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ "New game started in" Text -> Text -> Text
<+> ModeKind -> Text
mname ModeKind
mode Text -> Text -> Text
<+> "mode."
MsgClass -> Text -> m ()
forall (m :: * -> *). MonadClientUI m => MsgClass -> Text -> m ()
msgAdd MsgClass
MsgAdmin (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ ModeKind -> Text
mdesc ModeKind
mode
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
MsgClass -> Text -> m ()
forall (m :: * -> *). MonadClientUI m => MsgClass -> Text -> m ()
msgAdd0 MsgClass
MsgFocus "You take in your surroundings."
MsgClass -> Text -> m ()
forall (m :: * -> *). MonadClientUI m => MsgClass -> Text -> m ()
msgAdd0 MsgClass
MsgLandscape Text
desc
Text
blurb <- Rnd Text -> m Text
forall (m :: * -> *) a. MonadClientRead m => Rnd a -> m a
rndToActionForget (Rnd Text -> m Text) -> Rnd Text -> m Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Rnd Text
forall a. [a] -> Rnd a
oneOf
[ "You think you saw movement."
, "Something catches your peripherial vision."
, "You think you felt a tremor under your feet."
, "A whiff of chilly air passes around you."
, "You notice a draft just when it dies down."
, "The ground nearby is stained along some faint lines."
, "Scarce black motes slowly settle on the ground."
, "The ground in the immediate area is empty, as if just swiped."
]
MsgClass -> Text -> m ()
forall (m :: * -> *). MonadClientUI m => MsgClass -> Text -> m ()
msgAdd MsgClass
MsgWarning 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
$
MsgClass -> Text -> m ()
forall (m :: * -> *). MonadClientUI m => MsgClass -> Text -> m ()
msgAdd MsgClass
MsgWarning "Being a lone wolf, you begin without companions."
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (History -> Int
lengthHistory History
history Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 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
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
$ do
Slideshow
slides <- [KM] -> m Slideshow
forall (m :: * -> *). MonadClientUI m => [KM] -> m Slideshow
reportToSlideshow []
m KM -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m KM -> m ()) -> m KM -> m ()
forall a b. (a -> b) -> a -> b
$ ColorMode -> [KM] -> Slideshow -> m KM
forall (m :: * -> *).
MonadClientUI m =>
ColorMode -> [KM] -> Slideshow -> m KM
getConfirms ColorMode
ColorFull [KM
K.spaceKM, KM
K.escKM] Slideshow
slides
m ()
forall (m :: * -> *). MonadClientUI m => m ()
resetPressedKeys
UpdRestartServer{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
UpdResume fid :: FactionId
fid _ -> 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
$ (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
fid) (EnumMap FactionId Faction -> Faction)
-> (State -> EnumMap FactionId Faction) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap FactionId Faction
sfactionD
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
mode <- m ModeKind
forall (m :: * -> *). MonadStateRead m => m ModeKind
getGameMode
MsgClass -> Text -> m ()
forall (m :: * -> *). MonadClientUI m => MsgClass -> Text -> m ()
msgAdd MsgClass
MsgAlert (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ "Continuing" Text -> Text -> Text
<+> ModeKind -> Text
mname ModeKind
mode Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "."
MsgClass -> Text -> m ()
forall (m :: * -> *). MonadClientUI m => MsgClass -> Text -> m ()
msgAdd MsgClass
MsgPrompt (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ ModeKind -> Text
mdesc ModeKind
mode
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
MsgClass -> Text -> m ()
forall (m :: * -> *). MonadClientUI m => MsgClass -> Text -> m ()
msgAdd MsgClass
MsgPromptFocus "You remember your surroundings."
MsgClass -> Text -> m ()
forall (m :: * -> *). MonadClientUI m => MsgClass -> Text -> m ()
msgAdd MsgClass
MsgPrompt Text
desc
ColorMode -> Text -> m ()
forall (m :: * -> *). MonadClientUI m => ColorMode -> Text -> m ()
displayMore ColorMode
ColorFull "Are you up for the challenge?"
Text -> m ()
forall (m :: * -> *). MonadClientUI m => Text -> m ()
promptAdd0 "Prove yourself!"
UpdResumeServer{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
UpdKillExit{} -> m ()
forall (m :: * -> *). MonadClientUI m => m ()
frontendShutdown
UpdWriteSave -> MsgClass -> Text -> m ()
forall (m :: * -> *). MonadClientUI m => MsgClass -> Text -> m ()
msgAdd MsgClass
MsgSpam "Saving backup."
UpdHearFid _ hearMsg :: 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 ()
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 <- HearMsg -> m Text
forall (m :: * -> *). MonadClientUI m => HearMsg -> m Text
ppHearMsg HearMsg
hearMsg
MsgClass -> Text -> m ()
forall (m :: * -> *). MonadClientUI m => MsgClass -> Text -> m ()
msgAdd MsgClass
MsgHeard Text
msg
updateItemSlot :: MonadClientUI m => Container -> ItemId -> m ()
updateItemSlot :: Container -> ItemId -> m ()
updateItemSlot c :: Container
c iid :: 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 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
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
$ \sess :: SessionUI
sess -> SessionUI
sess {sslots :: ItemSlots
sslots = ItemSlots
newSlots}
Just _l :: SlotChar
_l -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
markDisplayNeeded :: MonadClientUI m => LevelId -> m ()
markDisplayNeeded :: LevelId -> m ()
markDisplayNeeded lid :: LevelId
lid = do
LevelId
lidV <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
viewedLevelUI
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (LevelId
lidV LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== LevelId
lid) (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
$ \sess :: SessionUI
sess -> SessionUI
sess {sdisplayNeeded :: Bool
sdisplayNeeded = Bool
True}
lookAtMove :: MonadClientUI m => ActorId -> m ()
lookAtMove :: ActorId -> m ()
lookAtMove aid :: ActorId
aid = 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
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
FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
Maybe AimMode
aimMode <- (SessionUI -> Maybe AimMode) -> m (Maybe AimMode)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe AimMode
saimMode
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Actor -> Bool
bproj Actor
body)
Bool -> Bool -> Bool
&& Actor -> FactionId
bfid Actor
body FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side
Bool -> Bool -> Bool
&& Maybe AimMode -> Bool
forall a. Maybe a -> Bool
isNothing Maybe AimMode
aimMode) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Text
itemsBlurb <- Bool -> Point -> ActorId -> m Text
forall (m :: * -> *).
MonadClientUI m =>
Bool -> Point -> ActorId -> m Text
lookAtItems Bool
True (Actor -> Point
bpos Actor
body) ActorId
aid
let msgClass :: MsgClass
msgClass = 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 then MsgClass
MsgAtFeetMajor else MsgClass
MsgAtFeet
MsgClass -> Text -> m ()
forall (m :: * -> *). MonadClientUI m => MsgClass -> Text -> m ()
msgAdd MsgClass
msgClass Text
itemsBlurb
Faction
fact <- (State -> Faction) -> m Faction
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
body) (EnumMap FactionId Faction -> Faction)
-> (State -> EnumMap FactionId Faction) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap FactionId Faction
sfactionD
[(ActorId, Actor)]
adjBigAssocs <- (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
$ Actor -> State -> [(ActorId, Actor)]
adjacentBigAssocs Actor
body
[(ActorId, Actor)]
adjProjAssocs <- (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
$ Actor -> State -> [(ActorId, Actor)]
adjacentProjAssocs Actor
body
if Bool -> Bool
not (Actor -> Bool
bproj Actor
body) Bool -> Bool -> Bool
&& Actor -> FactionId
bfid Actor
body FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side then do
let foe :: (ActorId, Actor) -> Bool
foe (_, b2 :: Actor
b2) = FactionId -> Faction -> FactionId -> Bool
isFoe (Actor -> FactionId
bfid Actor
body) Faction
fact (Actor -> FactionId
bfid Actor
b2)
adjFoes :: [(ActorId, Actor)]
adjFoes = ((ActorId, Actor) -> Bool)
-> [(ActorId, Actor)] -> [(ActorId, Actor)]
forall a. (a -> Bool) -> [a] -> [a]
filter (ActorId, Actor) -> Bool
foe ([(ActorId, Actor)] -> [(ActorId, Actor)])
-> [(ActorId, Actor)] -> [(ActorId, Actor)]
forall a b. (a -> b) -> a -> b
$ [(ActorId, Actor)]
adjBigAssocs [(ActorId, Actor)] -> [(ActorId, Actor)] -> [(ActorId, Actor)]
forall a. [a] -> [a] -> [a]
++ [(ActorId, Actor)]
adjProjAssocs
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([(ActorId, Actor)] -> Bool
forall a. [a] -> Bool
null [(ActorId, Actor)]
adjFoes) m ()
forall (m :: * -> *). MonadClientUI m => m ()
stopPlayBack
else Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (FactionId -> Faction -> FactionId -> Bool
isFoe (Actor -> FactionId
bfid Actor
body) Faction
fact FactionId
side) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
let our :: (ActorId, Actor) -> Bool
our (_, b2 :: Actor
b2) = Actor -> FactionId
bfid Actor
b2 FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side
adjOur :: [(ActorId, Actor)]
adjOur = ((ActorId, Actor) -> Bool)
-> [(ActorId, Actor)] -> [(ActorId, Actor)]
forall a. (a -> Bool) -> [a] -> [a]
filter (ActorId, Actor) -> Bool
our [(ActorId, Actor)]
adjBigAssocs
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([(ActorId, Actor)] -> Bool
forall a. [a] -> Bool
null [(ActorId, Actor)]
adjOur) m ()
forall (m :: * -> *). MonadClientUI m => m ()
stopPlayBack
aidVerbMU :: MonadClientUI m => MsgClass -> ActorId -> MU.Part -> m ()
aidVerbMU :: MsgClass -> ActorId -> Part -> m ()
aidVerbMU msgClass :: MsgClass
msgClass aid :: ActorId
aid verb :: Part
verb = do
Part
subject <- ActorId -> m Part
forall (m :: * -> *). MonadClientUI m => ActorId -> m Part
partActorLeader ActorId
aid
MsgClass -> Text -> m ()
forall (m :: * -> *). MonadClientUI m => MsgClass -> Text -> m ()
msgAdd MsgClass
msgClass (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ [Part] -> Text
makeSentence [Part -> Part -> Part
MU.SubjectVerbSg Part
subject Part
verb]
aidVerbMU0 :: MonadClientUI m => MsgClass -> ActorId -> MU.Part -> m ()
aidVerbMU0 :: MsgClass -> ActorId -> Part -> m ()
aidVerbMU0 msgClass :: MsgClass
msgClass aid :: ActorId
aid verb :: Part
verb = do
Part
subject <- ActorId -> m Part
forall (m :: * -> *). MonadClientUI m => ActorId -> m Part
partActorLeader ActorId
aid
MsgClass -> Text -> m ()
forall (m :: * -> *). MonadClientUI m => MsgClass -> Text -> m ()
msgAdd0 MsgClass
msgClass (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ [Part] -> Text
makeSentence [Part -> Part -> Part
MU.SubjectVerbSg Part
subject Part
verb]
aidVerbDuplicateMU :: MonadClientUI m
=> MsgClass -> ActorId -> MU.Part -> m Bool
aidVerbDuplicateMU :: MsgClass -> ActorId -> Part -> m Bool
aidVerbDuplicateMU msgClass :: MsgClass
msgClass aid :: ActorId
aid verb :: Part
verb = do
Part
subject <- ActorId -> m Part
forall (m :: * -> *). MonadClientUI m => ActorId -> m Part
partActorLeader ActorId
aid
Text -> MsgClass -> Int -> m Bool
forall (m :: * -> *).
MonadClientUI m =>
Text -> MsgClass -> Int -> m Bool
msgAddDuplicate ([Part] -> Text
makeSentence [Part -> Part -> Part
MU.SubjectVerbSg Part
subject Part
verb]) MsgClass
msgClass 1
itemVerbMU :: MonadClientUI m
=> MsgClass -> ItemId -> ItemQuant -> MU.Part -> Container -> m ()
itemVerbMU :: MsgClass -> ItemId -> ItemQuant -> Part -> Container -> m ()
itemVerbMU msgClass :: MsgClass
msgClass iid :: ItemId
iid kit :: ItemQuant
kit@(k :: Int
k, _) verb :: Part
verb c :: Container
c = Bool -> m () -> m ()
forall a. HasCallStack => Bool -> a -> a
assert (Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0) (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
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
FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
EnumMap FactionId Faction
factionD <- (State -> EnumMap FactionId Faction)
-> m (EnumMap FactionId Faction)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> EnumMap FactionId Faction
sfactionD
let arItem :: AspectRecord
arItem = ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFull
subject :: Part
subject = FactionId
-> EnumMap FactionId Faction
-> Int
-> Time
-> ItemFull
-> ItemQuant
-> Part
partItemWs FactionId
side EnumMap FactionId Faction
factionD Int
k Time
localTime ItemFull
itemFull ItemQuant
kit
msg :: Text
msg | Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1 Bool -> Bool -> Bool
&& Bool -> Bool
not (Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Condition AspectRecord
arItem) =
[Part] -> Text
makeSentence [Person -> Polarity -> Part -> Part -> Part
MU.SubjectVerb Person
MU.PlEtc Polarity
MU.Yes Part
subject Part
verb]
| Bool
otherwise = [Part] -> Text
makeSentence [Part -> Part -> Part
MU.SubjectVerbSg Part
subject Part
verb]
MsgClass -> Text -> m ()
forall (m :: * -> *). MonadClientUI m => MsgClass -> Text -> m ()
msgAdd MsgClass
msgClass Text
msg
itemAidVerbMU :: MonadClientUI m
=> MsgClass -> ActorId -> MU.Part
-> ItemId -> Either (Maybe Int) Int -> CStore
-> m ()
itemAidVerbMU :: MsgClass
-> ActorId
-> Part
-> ItemId
-> Either (Maybe Int) Int
-> CStore
-> m ()
itemAidVerbMU msgClass :: MsgClass
msgClass aid :: ActorId
aid verb :: Part
verb iid :: ItemId
iid ek :: Either (Maybe Int) Int
ek cstore :: CStore
cstore = 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
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
$ Actor -> CStore -> State -> ItemBag
getBodyStoreBag Actor
body CStore
cstore
FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
EnumMap FactionId Faction
factionD <- (State -> EnumMap FactionId Faction)
-> m (EnumMap FactionId Faction)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> EnumMap FactionId Faction
sfactionD
case ItemId
iid ItemId -> ItemBag -> Maybe ItemQuant
forall k a. Enum k => k -> EnumMap k a -> Maybe a
`EM.lookup` ItemBag
bag of
Nothing -> [Char] -> m ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> m ()) -> [Char] -> m ()
forall a b. (a -> b) -> a -> b
$ "" [Char] -> (ActorId, Part, ItemId, CStore) -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` (ActorId
aid, Part
verb, ItemId
iid, CStore
cstore)
Just kit :: ItemQuant
kit@(k :: Int
k, _) -> do
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 lid :: LevelId
lid = Actor -> LevelId
blid 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
lid
Part
subject <- ActorId -> m Part
forall (m :: * -> *). MonadClientUI m => ActorId -> m Part
partActorLeader ActorId
aid
let object :: Part
object = case Either (Maybe Int) Int
ek of
Left (Just n :: Int
n) ->
Bool -> Part -> Part
forall a. HasCallStack => Bool -> a -> a
assert (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
k Bool -> (ActorId, Part, ItemId, CStore) -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` (ActorId
aid, Part
verb, ItemId
iid, CStore
cstore))
(Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ FactionId
-> EnumMap FactionId Faction
-> Int
-> Time
-> ItemFull
-> ItemQuant
-> Part
partItemWs FactionId
side EnumMap FactionId Faction
factionD Int
n Time
localTime ItemFull
itemFull ItemQuant
kit
Left Nothing ->
let (name :: Part
name, powers :: Part
powers) =
FactionId
-> EnumMap FactionId Faction
-> Time
-> ItemFull
-> ItemQuant
-> (Part, Part)
partItem FactionId
side EnumMap FactionId Faction
factionD Time
localTime ItemFull
itemFull ItemQuant
kit
in [Part] -> Part
MU.Phrase [Part
name, Part
powers]
Right n :: Int
n ->
Bool -> Part -> Part
forall a. HasCallStack => Bool -> a -> a
assert (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
k Bool -> (ActorId, Part, ItemId, CStore) -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` (ActorId
aid, Part
verb, ItemId
iid, CStore
cstore))
(Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ let (name1 :: Part
name1, powers :: Part
powers) =
FactionId
-> EnumMap FactionId Faction
-> Time
-> ItemFull
-> ItemQuant
-> (Part, Part)
partItemShort FactionId
side EnumMap FactionId Faction
factionD Time
localTime ItemFull
itemFull ItemQuant
kit
in [Part] -> Part
MU.Phrase ["the", Int -> Part -> Part
MU.Car1Ws Int
n Part
name1, Part
powers]
msg :: Text
msg = [Part] -> Text
makeSentence [Part -> Part -> Part
MU.SubjectVerbSg Part
subject Part
verb, Part
object]
MsgClass -> Text -> m ()
forall (m :: * -> *). MonadClientUI m => MsgClass -> Text -> m ()
msgAdd MsgClass
msgClass Text
msg
createActorUI :: MonadClientUI m => Bool -> ActorId -> Actor -> m ()
createActorUI :: Bool -> ActorId -> Actor -> m ()
createActorUI born :: Bool
born aid :: ActorId
aid body :: Actor
body = do
CCUI{ScreenContent
coscreen :: ScreenContent
coscreen :: CCUI -> ScreenContent
coscreen} <- (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
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 Bool -> Bool -> Bool
&& Bool -> Bool
not (Actor -> Bool
bproj Actor
body)) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ 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
$ \sess :: 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}
EnumMap FactionId Faction
factionD <- (State -> EnumMap FactionId Faction)
-> m (EnumMap FactionId Faction)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> EnumMap FactionId Faction
sfactionD
let fact :: Faction
fact = EnumMap FactionId Faction
factionD EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
body
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
== '@'
Bool -> Bool -> Bool
&& Player -> Bool
fhasGender (Faction -> Player
gplayer Faction
fact) = "he"
| Bool
otherwise = "it"
nameFromNumber :: Text -> a -> Text
nameFromNumber fn :: Text
fn k :: a
k = if a
k a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== 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, "Captain"]
else Text
fn Text -> Text -> Text
<+> a -> Text
forall a. Show a => a -> Text
tshow a
k
heroNamePronoun :: Int -> (Text, Text)
heroNamePronoun k :: 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, "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, "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
(n :: Int
n, bsymbol :: Char
bsymbol) <-
if | Actor -> Bool
bproj Actor
body -> (Int, Char) -> m (Int, Char)
forall (m :: * -> *) a. Monad m => a -> m a
return (0, if Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Blast AspectRecord
arItem
then ItemKind -> Char
IK.isymbol ItemKind
itemKind
else '*')
| Color
baseColor Color -> Color -> Bool
forall a. Eq a => a -> a -> Bool
/= Color
Color.BrWhite -> (Int, Char) -> m (Int, Char)
forall (m :: * -> *) a. Monad m => a -> m a
return (0, ItemKind -> Char
IK.isymbol ItemKind
itemKind)
| Bool
otherwise -> do
let hasNameK :: Int -> ActorUI -> Bool
hasNameK k :: Int
k bUI :: ActorUI
bUI = ActorUI -> Text
bname ActorUI
bUI Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== (Text, Text) -> Text
forall a b. (a, b) -> a
fst (Int -> (Text, Text)
heroNamePronoun Int
k)
Bool -> Bool -> Bool
&& ActorUI -> Color
bcolor ActorUI
bUI Color -> Color -> Bool
forall a. Eq a => a -> a -> Bool
== Faction -> Color
gcolor Faction
fact
findHeroK :: Int -> Bool
findHeroK k :: Int
k = Maybe ActorUI -> Bool
forall a. Maybe a -> Bool
isJust (Maybe ActorUI -> Bool) -> Maybe ActorUI -> Bool
forall a b. (a -> b) -> a -> b
$ (ActorUI -> Bool) -> [ActorUI] -> Maybe ActorUI
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Int -> ActorUI -> Bool
hasNameK Int
k) (ActorDictUI -> [ActorUI]
forall k a. EnumMap k a -> [a]
EM.elems ActorDictUI
actorUI)
mhs :: [Bool]
mhs = (Int -> Bool) -> [Int] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Bool
findHeroK [0..]
n :: Int
n = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> Int
forall a. HasCallStack => [Char] -> a
error ([Char] -> Int) -> [Char] -> Int
forall a b. (a -> b) -> a -> b
$ [Bool] -> [Char]
forall a. Show a => a -> [Char]
show [Bool]
mhs) (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ Bool -> [Bool] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex Bool
False [Bool]
mhs
(Int, Char) -> m (Int, Char)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
n, if 0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 10 then Int -> Char
Char.intToDigit Int
n else '@')
let (object1 :: Part
object1, object2 :: Part
object2) = FactionId
-> EnumMap FactionId Faction
-> Time
-> ItemFull
-> ItemQuant
-> (Part, Part)
partItemShortest (Actor -> FactionId
bfid Actor
body) EnumMap FactionId Faction
factionD Time
localTime
ItemFull
itemFull (1, [])
(bname :: Text
bname, bpronoun :: Text
bpronoun) =
if | Actor -> Bool
bproj Actor
body ->
let adj :: Part
adj = case Actor -> Maybe ([Vector], Speed)
btrajectory Actor
body of
Just (tra :: [Vector]
tra, _) | [Vector] -> Int
forall a. [a] -> Int
length [Vector]
tra Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 5 -> "falling"
_ -> "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 ->
let name :: Text
name = [Part] -> Text
makePhrase [Part
object1, Part
object2]
in ( if Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Unique AspectRecord
arItem
then [Part] -> Text
makePhrase [Part -> Part
MU.Capitalize (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
$ "the" Text -> Text -> Text
<+> Text
name]
else Text
name
, 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 = $WActorUI :: Char -> Text -> Text -> Color -> ActorUI
ActorUI{..}
(SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess ->
SessionUI
sess {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}
let verb :: Part
verb = Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$
if Bool
born
then if Actor -> FactionId
bfid Actor
body FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side then "join you" else "appear suddenly"
else "be spotted"
((ItemId, CStore) -> m ()) -> [(ItemId, CStore)] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(iid :: ItemId
iid, store :: 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))
EnumSet ActorId
lastLost <- (SessionUI -> EnumSet ActorId) -> m (EnumSet ActorId)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> EnumSet ActorId
slastLost
if | ActorDictUI -> Bool
forall k a. EnumMap k a -> Bool
EM.null ActorDictUI
actorUI Bool -> Bool -> Bool
&& Actor -> FactionId
bfid Actor
body FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side ->
() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
born Bool -> Bool -> Bool
&& Actor -> Bool
bproj Actor
body -> m ()
forall (m :: * -> *). MonadClientUI m => m ()
pushFrame
| ActorId -> EnumSet ActorId -> Bool
forall k. Enum k => k -> EnumSet k -> Bool
ES.member ActorId
aid EnumSet ActorId
lastLost Bool -> Bool -> Bool
|| Actor -> Bool
bproj Actor
body -> LevelId -> m ()
forall (m :: * -> *). MonadClientUI m => LevelId -> m ()
markDisplayNeeded (Actor -> LevelId
blid Actor
body)
| Bool
otherwise -> do
MsgClass -> ActorId -> Part -> m ()
forall (m :: * -> *).
MonadClientUI m =>
MsgClass -> ActorId -> Part -> m ()
aidVerbMU MsgClass
MsgActorSpot ActorId
aid Part
verb
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
$ ScreenContent -> Point -> Animation
actorX ScreenContent
coscreen (Actor -> Point
bpos Actor
body)
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 () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Actor -> Bool
bproj Actor
body) Bool -> Bool -> Bool
&& FactionId -> Faction -> FactionId -> Bool
isFoe (Actor -> FactionId
bfid Actor
body) Faction
fact FactionId
side) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
(SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess -> SessionUI
sess {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}
[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)
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ActorId -> EnumSet ActorId -> Bool
forall k. Enum k => k -> EnumSet k -> Bool
ES.member ActorId
aid EnumSet ActorId
lastLost Bool -> Bool -> Bool
|| [Actor] -> Int
forall a. [a] -> Int
length [Actor]
foes Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
MsgClass -> Text -> m ()
forall (m :: * -> *). MonadClientUI m => MsgClass -> Text -> m ()
msgAdd0 MsgClass
MsgFirstEnemySpot "You are not alone!"
m ()
forall (m :: * -> *). MonadClientUI m => m ()
stopPlayBack
destroyActorUI :: MonadClientUI m => Bool -> ActorId -> Actor -> m ()
destroyActorUI :: Bool -> ActorId -> Actor -> m ()
destroyActorUI destroy :: Bool
destroy aid :: ActorId
aid b :: 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
$ \sess :: 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 affect :: Maybe Target -> Maybe Target
affect tgt :: Maybe Target
tgt = case Maybe Target
tgt of
Just (TEnemy a :: 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
TGoal -> LevelId -> Point -> Target
TPoint TGoal
TKnown (Actor -> LevelId
blid Actor
b) (Actor -> Point
bpos Actor
b)
else
TGoal -> LevelId -> Point -> Target
TPoint (ActorId -> TGoal
TEnemyPos ActorId
a) (Actor -> LevelId
blid Actor
b) (Actor -> Point
bpos Actor
b)
Just (TNonEnemy a :: 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
$ TGoal -> LevelId -> Point -> Target
TPoint TGoal
TKnown (Actor -> LevelId
blid Actor
b) (Actor -> Point
bpos Actor
b)
_ -> 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
$ \sess :: 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) (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
$ \sess :: 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
$ (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
side) (EnumMap FactionId Faction -> Faction)
-> (State -> EnumMap FactionId Faction) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap FactionId Faction
sfactionD
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
$ \sess :: 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
ColorMode -> Text -> m ()
forall (m :: * -> *). MonadClientUI m => ColorMode -> Text -> m ()
displayMore ColorMode
ColorBW "Alas!"
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)
spotItem :: MonadClientUI m
=> Bool -> ItemId -> ItemQuant -> Container -> m ()
spotItem :: Bool -> ItemId -> ItemQuant -> Container -> m ()
spotItem verbose :: Bool
verbose iid :: ItemId
iid kit :: ItemQuant
kit c :: Container
c = do
ItemId -> Container -> m ()
forall (m :: * -> *).
MonadClientUI m =>
ItemId -> Container -> m ()
recordItemLid ItemId
iid Container
c
ItemSlots itemSlots :: EnumMap SLore SingleItemSlots
itemSlots <- (SessionUI -> ItemSlots) -> m ItemSlots
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> ItemSlots
sslots
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
let 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
Nothing -> do
Container -> ItemId -> m ()
forall (m :: * -> *).
MonadClientUI m =>
Container -> ItemId -> m ()
updateItemSlot Container
c ItemId
iid
case Container
c of
CFloor lid :: LevelId
lid p :: Point
p -> do
Maybe Target
sxhairOld <- (SessionUI -> Maybe Target) -> m (Maybe Target)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe Target
sxhair
case Maybe Target
sxhairOld of
Just TEnemy{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just (TPoint TEnemyPos{} _ _) -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
_ -> 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
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
$ 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
$ \sess :: 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
bag) LevelId
lidV Point
p}
MsgClass -> ItemId -> ItemQuant -> Part -> Container -> m ()
forall (m :: * -> *).
MonadClientUI m =>
MsgClass -> ItemId -> ItemQuant -> Part -> Container -> m ()
itemVerbMU MsgClass
MsgItemSpot ItemId
iid ItemQuant
kit "be located" Container
c
_ -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
_ -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
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 aid :: ActorId
aid store :: CStore
store | CStore
store CStore -> [CStore] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CStore
CEqp, CStore
CInv, CStore
CGround, CStore
CSha] -> do
Part
subject <- ActorId -> m Part
forall (m :: * -> *). MonadClientUI m => ActorId -> m Part
partActorLeader ActorId
aid
let ownW :: [Part]
ownW = Bool -> CStore -> Part -> [Part]
ppCStoreWownW Bool
False CStore
store Part
subject
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
$ "be added to" Part -> [Part] -> [Part]
forall a. a -> [a] -> [a]
: [Part]
ownW
MsgClass -> ItemId -> ItemQuant -> Part -> Container -> m ()
forall (m :: * -> *).
MonadClientUI m =>
MsgClass -> ItemId -> ItemQuant -> Part -> Container -> m ()
itemVerbMU MsgClass
MsgItemMove ItemId
iid ItemQuant
kit Part
verb Container
c
_ -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
recordItemLid :: MonadClientUI m => ItemId -> Container -> m ()
recordItemLid :: ItemId -> Container -> m ()
recordItemLid iid :: ItemId
iid c :: 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
$ \sess :: 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 aid :: ActorId
aid source :: Point
source target :: Point
target = do
CCUI{ScreenContent
coscreen :: ScreenContent
coscreen :: CCUI -> ScreenContent
coscreen} <- (SessionUI -> CCUI) -> m CCUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
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
$ ScreenContent -> (Point, Point) -> Animation
teleport ScreenContent
coscreen (Point, Point)
ps
ActorId -> m ()
forall (m :: * -> *). MonadClientUI m => ActorId -> m ()
lookAtMove ActorId
aid
displaceActorUI :: MonadClientUI m => ActorId -> ActorId -> m ()
displaceActorUI :: ActorId -> ActorId -> m ()
displaceActorUI source :: ActorId
source target :: ActorId
target = do
CCUI{ScreenContent
coscreen :: ScreenContent
coscreen :: CCUI -> ScreenContent
coscreen} <- (SessionUI -> CCUI) -> m CCUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
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 :: MsgClass
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 MsgClass
MsgAction
else MsgClass
MsgActionMinor
msg :: Text
msg = [Part] -> Text
makeSentence [Part -> Part -> Part
MU.SubjectVerbSg Part
spart "displace", Part
tpart]
MsgClass -> Text -> m ()
forall (m :: * -> *). MonadClientUI m => MsgClass -> Text -> m ()
msgAdd MsgClass
msgClass Text
msg
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
source
ActorId -> m ()
forall (m :: * -> *). MonadClientUI m => ActorId -> m ()
lookAtMove 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
$ ScreenContent -> (Point, Point) -> Animation
swapPlaces ScreenContent
coscreen (Point, Point)
ps
moveItemUI :: MonadClientUI m
=> ItemId -> Int -> ActorId -> CStore -> CStore
-> m ()
moveItemUI :: ItemId -> Int -> ActorId -> CStore -> CStore -> m ()
moveItemUI iid :: ItemId
iid k :: Int
k aid :: ActorId
aid cstore1 :: CStore
cstore1 cstore2 :: CStore
cstore2 = do
let verb :: Text
verb = 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
$ (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
b) (EnumMap FactionId Faction -> Faction)
-> (State -> EnumMap FactionId Faction) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap FactionId Faction
sfactionD
let 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 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 _l :: 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
MsgClass
-> ActorId
-> Part
-> ItemId
-> Either (Maybe Int) Int
-> CStore
-> m ()
forall (m :: * -> *).
MonadClientUI m =>
MsgClass
-> ActorId
-> Part
-> ItemId
-> Either (Maybe Int) Int
-> CStore
-> m ()
itemAidVerbMU MsgClass
MsgItemMove ActorId
aid (Text -> Part
MU.Text Text
verb) ItemId
iid (Int -> Either (Maybe Int) Int
forall a b. b -> Either a b
Right Int
k) CStore
cstore2
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
> 0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
MsgClass
-> ActorId
-> Part
-> ItemId
-> Either (Maybe Int) Int
-> CStore
-> m ()
forall (m :: * -> *).
MonadClientUI m =>
MsgClass
-> ActorId
-> Part
-> ItemId
-> Either (Maybe Int) Int
-> CStore
-> m ()
itemAidVerbMU MsgClass
MsgItemMove ActorId
aid (Text -> Part
MU.Text Text
verb) ItemId
iid (Maybe Int -> Either (Maybe Int) Int
forall a b. a -> Either a b
Left (Maybe Int -> Either (Maybe Int) Int)
-> Maybe Int -> Either (Maybe Int) Int
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int
forall a. a -> Maybe a
Just Int
k) CStore
cstore2
Nothing -> [Char] -> m ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> m ()) -> [Char] -> m ()
forall a b. (a -> b) -> a -> b
$
"" [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)
quitFactionUI :: MonadClientUI m
=> FactionId -> Maybe Status
-> Maybe (FactionAnalytics, GenerationAnalytics)
-> m ()
quitFactionUI :: FactionId
-> Maybe Status
-> Maybe (FactionAnalytics, GenerationAnalytics)
-> m ()
quitFactionUI fid :: FactionId
fid toSt :: Maybe Status
toSt manalytics :: Maybe (FactionAnalytics, GenerationAnalytics)
manalytics = do
ClientOptions{Bool
sexposeItems :: ClientOptions -> Bool
sexposeItems :: Bool
sexposeItems} <- (StateClient -> ClientOptions) -> m ClientOptions
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> ClientOptions
soptions
Faction
fact <- (State -> Faction) -> m Faction
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
fid) (EnumMap FactionId Faction -> Faction)
-> (State -> EnumMap FactionId Faction) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap FactionId Faction
sfactionD
let fidName :: Part
fidName = Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ Faction -> Text
gname Faction
fact
person :: Person
person = if Player -> Bool
fhasGender (Player -> Bool) -> Player -> Bool
forall a b. (a -> b) -> a -> b
$ Faction -> Player
gplayer Faction
fact then Person
MU.PlEtc else Person
MU.Sg3rd
horror :: Bool
horror = Faction -> Bool
isHorrorFact Faction
fact
camping :: Bool
camping = Bool -> (Status -> Bool) -> Maybe Status -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True ((Outcome -> Outcome -> Bool
forall a. Eq a => a -> a -> Bool
== Outcome
Camping) (Outcome -> Bool) -> (Status -> Outcome) -> Status -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Status -> Outcome
stOutcome) Maybe Status
toSt
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
fid FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
camping) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
m ()
forall (m :: * -> *). MonadClientUI m => m ()
tellGameClipPS
m ()
forall (m :: * -> *). MonadClientUI m => m ()
resetGameStart
ModeKind
mode <- m ModeKind
forall (m :: * -> *). MonadStateRead m => m ModeKind
getGameMode
Int
allNframes <- (SessionUI -> Int) -> m Int
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Int
sallNframes
let startingPart :: Maybe Part
startingPart = case Maybe Status
toSt of
_ | Bool
horror -> Maybe Part
forall a. Maybe a
Nothing
Just Status{stOutcome :: Status -> Outcome
stOutcome=Outcome
Killed} -> Part -> Maybe Part
forall a. a -> Maybe a
Just "be eliminated"
Just Status{stOutcome :: Status -> Outcome
stOutcome=Outcome
Defeated} -> Part -> Maybe Part
forall a. a -> Maybe a
Just "be decisively defeated"
Just Status{stOutcome :: Status -> Outcome
stOutcome=Outcome
Camping} -> Part -> Maybe Part
forall a. a -> Maybe a
Just "order save and exit"
Just Status{stOutcome :: Status -> Outcome
stOutcome=Outcome
Conquer} -> Part -> Maybe Part
forall a. a -> Maybe a
Just "vanquish all foes"
Just Status{stOutcome :: Status -> Outcome
stOutcome=Outcome
Escape} -> Part -> Maybe Part
forall a. a -> Maybe a
Just "achieve victory"
Just Status{stOutcome :: Status -> Outcome
stOutcome=Outcome
Restart, stNewGame :: Status -> Maybe (GroupName ModeKind)
stNewGame=Just gn :: GroupName ModeKind
gn} ->
Part -> Maybe Part
forall a. a -> Maybe a
Just (Part -> Maybe Part) -> Part -> Maybe Part
forall a b. (a -> b) -> a -> b
$ Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ "order mission restart in"
Text -> Text -> Text
<+> GroupName ModeKind -> Text
forall a. GroupName a -> Text
fromGroupName GroupName ModeKind
gn Text -> Text -> Text
<+> "mode"
Just Status{stOutcome :: Status -> Outcome
stOutcome=Outcome
Restart, stNewGame :: Status -> Maybe (GroupName ModeKind)
stNewGame=Maybe (GroupName ModeKind)
Nothing} ->
[Char] -> Maybe Part
forall a. HasCallStack => [Char] -> a
error ([Char] -> Maybe Part) -> [Char] -> Maybe Part
forall a b. (a -> b) -> a -> b
$ "" [Char] -> (FactionId, Maybe Status) -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` (FactionId
fid, Maybe Status
toSt)
Nothing -> Maybe Part
forall a. Maybe a
Nothing
middlePart :: Maybe Text
middlePart = case Maybe Status
toSt of
_ | FactionId
fid FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
/= FactionId
side -> Maybe Text
forall a. Maybe a
Nothing
Just Status{Outcome
stOutcome :: Outcome
stOutcome :: Status -> Outcome
stOutcome} -> Outcome -> [(Outcome, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Outcome
stOutcome ([(Outcome, Text)] -> Maybe Text)
-> [(Outcome, Text)] -> Maybe Text
forall a b. (a -> b) -> a -> b
$ ModeKind -> [(Outcome, Text)]
mendMsg ModeKind
mode
Nothing -> Maybe Text
forall a. Maybe a
Nothing
partingPart :: Maybe Text
partingPart = case Maybe Status
toSt of
_ | FactionId
fid FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
/= FactionId
side Bool -> Bool -> Bool
|| Int
allNframes Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== -1 -> Maybe Text
forall a. Maybe a
Nothing
Just Status{Outcome
stOutcome :: Outcome
stOutcome :: Status -> Outcome
stOutcome} -> Outcome -> [(Outcome, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Outcome
stOutcome [(Outcome, Text)]
genericEndMessages
Nothing -> Maybe Text
forall a. Maybe a
Nothing
case Maybe Part
startingPart of
Nothing -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just sp :: Part
sp ->
let msgClass :: MsgClass
msgClass = if FactionId
fid FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side then MsgClass
MsgOutcome else MsgClass
MsgDiplomacy
in MsgClass -> Text -> m ()
forall (m :: * -> *). MonadClientUI m => MsgClass -> Text -> m ()
msgAdd MsgClass
msgClass
(Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ [Part] -> Text
makeSentence [Person -> Polarity -> Part -> Part -> Part
MU.SubjectVerb Person
person Polarity
MU.Yes Part
fidName Part
sp]
case (Maybe Status
toSt, Maybe Text
partingPart) of
(Just status :: Status
status, Just pp :: Text
pp) -> do
Bool
isNoConfirms <- m Bool
forall (m :: * -> *). MonadStateRead m => m Bool
isNoConfirmsGame
Bool
go <- if Bool
isNoConfirms
then Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
else ColorMode -> Text -> m Bool
forall (m :: * -> *).
MonadClientUI m =>
ColorMode -> Text -> m Bool
displaySpaceEsc ColorMode
ColorFull ""
m ()
forall (m :: * -> *). MonadClientUI m => m ()
recordHistory
(itemBag :: ItemBag
itemBag, total :: Int
total) <- (State -> (ItemBag, Int)) -> m (ItemBag, Int)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> (ItemBag, Int)) -> m (ItemBag, Int))
-> (State -> (ItemBag, Int)) -> m (ItemBag, Int)
forall a b. (a -> b) -> a -> b
$ FactionId -> State -> (ItemBag, Int)
calculateTotal FactionId
side
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
go (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
case Maybe Text
middlePart of
Nothing -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just sp1 :: Text
sp1 -> do
EnumMap FactionId Faction
factionD <- (State -> EnumMap FactionId Faction)
-> m (EnumMap FactionId Faction)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> EnumMap FactionId Faction
sfactionD
ItemId -> ItemFull
itemToF <- (State -> ItemId -> ItemFull) -> m (ItemId -> ItemFull)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemId -> ItemFull) -> m (ItemId -> ItemFull))
-> (State -> ItemId -> ItemFull) -> m (ItemId -> ItemFull)
forall a b. (a -> b) -> a -> b
$ (ItemId -> State -> ItemFull) -> State -> ItemId -> ItemFull
forall a b c. (a -> b -> c) -> b -> a -> c
flip ItemId -> State -> ItemFull
itemToFull
let getTrunkFull :: (ActorId, Actor) -> ItemFull
getTrunkFull (_, b :: Actor
b) = ItemId -> ItemFull
itemToF (ItemId -> ItemFull) -> ItemId -> ItemFull
forall a b. (a -> b) -> a -> b
$ Actor -> ItemId
btrunk Actor
b
[ItemFull]
ourTrunks <- (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
$ ((ActorId, Actor) -> ItemFull) -> [(ActorId, Actor)] -> [ItemFull]
forall a b. (a -> b) -> [a] -> [b]
map (ActorId, Actor) -> ItemFull
getTrunkFull
([(ActorId, Actor)] -> [ItemFull])
-> (State -> [(ActorId, Actor)]) -> State -> [ItemFull]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FactionId -> State -> [(ActorId, Actor)]
fidActorNotProjGlobalAssocs FactionId
side
let smartFaction :: Faction -> Bool
smartFaction fact2 :: Faction
fact2 = Player -> LeaderMode
fleaderMode (Faction -> Player
gplayer Faction
fact2) LeaderMode -> LeaderMode -> Bool
forall a. Eq a => a -> a -> Bool
/= LeaderMode
LeaderNull
smartEnemy :: ItemFull -> Bool
smartEnemy trunkFull :: ItemFull
trunkFull =
((FactionId, Faction) -> Bool) -> [(FactionId, Faction)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Faction -> Bool
smartFaction (Faction -> Bool)
-> ((FactionId, Faction) -> Faction)
-> (FactionId, Faction)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FactionId, Faction) -> Faction
forall a b. (a, b) -> b
snd)
([(FactionId, Faction)] -> Bool) -> [(FactionId, Faction)] -> Bool
forall a b. (a -> b) -> a -> b
$ ((FactionId, Faction) -> Bool)
-> [(FactionId, Faction)] -> [(FactionId, Faction)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(fid2 :: FactionId
fid2, _) -> FactionId
fid2 FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
/= FactionId
side)
([(FactionId, Faction)] -> [(FactionId, Faction)])
-> [(FactionId, Faction)] -> [(FactionId, Faction)]
forall a b. (a -> b) -> a -> b
$ ItemKind -> EnumMap FactionId Faction -> [(FactionId, Faction)]
possibleActorFactions (ItemFull -> ItemKind
itemKind ItemFull
trunkFull) EnumMap FactionId Faction
factionD
smartEnemyOurs :: [ItemFull]
smartEnemyOurs = (ItemFull -> Bool) -> [ItemFull] -> [ItemFull]
forall a. (a -> Bool) -> [a] -> [a]
filter ItemFull -> Bool
smartEnemy [ItemFull]
ourTrunks
uniqueActor :: ItemFull -> Bool
uniqueActor trunkFull :: ItemFull
trunkFull = Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Unique
(AspectRecord -> Bool) -> AspectRecord -> Bool
forall a b. (a -> b) -> a -> b
$ ItemFull -> AspectRecord
aspectRecordFull ItemFull
trunkFull
smartUniqueEnemyCaptured :: Bool
smartUniqueEnemyCaptured = (ItemFull -> Bool) -> [ItemFull] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ItemFull -> Bool
uniqueActor [ItemFull]
smartEnemyOurs
smartEnemyCaptured :: Bool
smartEnemyCaptured = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [ItemFull] -> Bool
forall a. [a] -> Bool
null [ItemFull]
smartEnemyOurs
sp2 :: Text
sp2 | Bool
smartUniqueEnemyCaptured =
"\nOh, wait, who is this, towering behind your escaping crew? This changes everything. For everybody. Everywhere. Forever. Did you plan for this? What was exactly the idea and who decided to carry it through?"
| Bool
smartEnemyCaptured =
"\nOh, wait, who is this, hunched among your escaping crew? Suddenly, this makes your crazy story credible. Suddenly, the door of knowledge opens again. How will you play that move?"
| Bool
otherwise = ""
MsgClass -> Text -> m ()
forall (m :: * -> *). MonadClientUI m => MsgClass -> Text -> m ()
msgAdd0 MsgClass
MsgPlot (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
sp1 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
sp2
m Bool -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m Bool -> m ()) -> m Bool -> m ()
forall a b. (a -> b) -> a -> b
$ ColorMode -> Text -> m Bool
forall (m :: * -> *).
MonadClientUI m =>
ColorMode -> Text -> m Bool
displaySpaceEsc ColorMode
ColorFull ""
case Maybe (FactionAnalytics, GenerationAnalytics)
manalytics of
Nothing -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just (factionAn :: FactionAnalytics
factionAn, generationAn :: GenerationAnalytics
generationAn) ->
[m KM] -> [m KM] -> m ()
forall (m :: * -> *). MonadClientUI m => [m KM] -> [m KM] -> m ()
cycleLore []
[ (ItemBag, Int) -> GenerationAnalytics -> m KM
forall (m :: * -> *).
MonadClientUI m =>
(ItemBag, Int) -> GenerationAnalytics -> m KM
displayGameOverLoot (ItemBag
itemBag, Int
total) GenerationAnalytics
generationAn
, FactionAnalytics -> GenerationAnalytics -> m KM
forall (m :: * -> *).
MonadClientUI m =>
FactionAnalytics -> GenerationAnalytics -> m KM
displayGameOverAnalytics FactionAnalytics
factionAn GenerationAnalytics
generationAn
, SLore -> Bool -> GenerationAnalytics -> m KM
forall (m :: * -> *).
MonadClientUI m =>
SLore -> Bool -> GenerationAnalytics -> m KM
displayGameOverLore SLore
SEmbed Bool
True GenerationAnalytics
generationAn
, SLore -> Bool -> GenerationAnalytics -> m KM
forall (m :: * -> *).
MonadClientUI m =>
SLore -> Bool -> GenerationAnalytics -> m KM
displayGameOverLore SLore
SOrgan Bool
True GenerationAnalytics
generationAn
, SLore -> Bool -> GenerationAnalytics -> m KM
forall (m :: * -> *).
MonadClientUI m =>
SLore -> Bool -> GenerationAnalytics -> m KM
displayGameOverLore SLore
SCondition Bool
sexposeItems GenerationAnalytics
generationAn
, SLore -> Bool -> GenerationAnalytics -> m KM
forall (m :: * -> *).
MonadClientUI m =>
SLore -> Bool -> GenerationAnalytics -> m KM
displayGameOverLore SLore
SBlast Bool
True GenerationAnalytics
generationAn ]
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
isNoConfirms (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Slideshow
scoreSlides <- Int -> Status -> m Slideshow
forall (m :: * -> *).
MonadClientUI m =>
Int -> Status -> m Slideshow
scoreToSlideshow Int
total Status
status
m KM -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m KM -> m ()) -> m KM -> m ()
forall a b. (a -> b) -> a -> b
$ ColorMode -> [KM] -> Slideshow -> m KM
forall (m :: * -> *).
MonadClientUI m =>
ColorMode -> [KM] -> Slideshow -> m KM
getConfirms ColorMode
ColorFull [KM
K.spaceKM, KM
K.escKM] Slideshow
scoreSlides
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
isNoConfirms Bool -> Bool -> Bool
|| Bool
camping) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
m Bool -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m Bool -> m ()) -> m Bool -> m ()
forall a b. (a -> b) -> a -> b
$ ColorMode -> Text -> m Bool
forall (m :: * -> *).
MonadClientUI m =>
ColorMode -> Text -> m Bool
displaySpaceEsc ColorMode
ColorFull Text
pp
_ -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
displayGameOverLoot :: MonadClientUI m
=> (ItemBag, Int) -> GenerationAnalytics -> m K.KM
displayGameOverLoot :: (ItemBag, Int) -> GenerationAnalytics -> m KM
displayGameOverLoot (heldBag :: ItemBag
heldBag, total :: Int
total) generationAn :: GenerationAnalytics
generationAn = do
ClientOptions{Bool
sexposeItems :: Bool
sexposeItems :: ClientOptions -> Bool
sexposeItems} <- (StateClient -> ClientOptions) -> m ClientOptions
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> ClientOptions
soptions
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
ItemSlots itemSlots :: EnumMap SLore SingleItemSlots
itemSlots <- (SessionUI -> ItemSlots) -> m ItemSlots
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> ItemSlots
sslots
let currencyName :: Text
currencyName = 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) -> ContentId ItemKind -> ItemKind
forall a b. (a -> b) -> a -> b
$ ContentData ItemKind -> GroupName ItemKind -> ContentId ItemKind
forall a. Show a => ContentData a -> GroupName a -> ContentId a
ouniqGroup ContentData ItemKind
coitem "currency"
lSlotsRaw :: SingleItemSlots
lSlotsRaw = (ItemId -> Bool) -> SingleItemSlots -> SingleItemSlots
forall a k. (a -> Bool) -> EnumMap k a -> EnumMap k a
EM.filter (ItemId -> ItemBag -> Bool
forall k a. Enum k => k -> EnumMap k a -> Bool
`EM.member` ItemBag
heldBag) (SingleItemSlots -> SingleItemSlots)
-> SingleItemSlots -> SingleItemSlots
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
generationItem :: EnumMap ItemId Int
generationItem = GenerationAnalytics
generationAn GenerationAnalytics -> SLore -> EnumMap ItemId Int
forall k a. Enum k => EnumMap k a -> k -> a
EM.! SLore
SItem
(itemBag :: ItemBag
itemBag, lSlots :: SingleItemSlots
lSlots) =
if Bool
sexposeItems
then let generationBag :: ItemBag
generationBag = (Int -> ItemQuant) -> EnumMap ItemId Int -> ItemBag
forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
EM.map (\k :: Int
k -> (-Int
k, [])) EnumMap ItemId Int
generationItem
bag :: ItemBag
bag = ItemBag
heldBag ItemBag -> ItemBag -> ItemBag
forall k a. EnumMap k a -> EnumMap k a -> EnumMap k a
`EM.union` ItemBag
generationBag
slots :: SingleItemSlots
slots = [(SlotChar, ItemId)] -> SingleItemSlots
forall k a. Enum k => [(k, a)] -> EnumMap k a
EM.fromAscList ([(SlotChar, ItemId)] -> SingleItemSlots)
-> [(SlotChar, ItemId)] -> SingleItemSlots
forall a b. (a -> b) -> a -> b
$ [SlotChar] -> [ItemId] -> [(SlotChar, ItemId)]
forall a b. [a] -> [b] -> [(a, b)]
zip [SlotChar]
allSlots ([ItemId] -> [(SlotChar, ItemId)])
-> [ItemId] -> [(SlotChar, ItemId)]
forall a b. (a -> b) -> a -> b
$ ItemBag -> [ItemId]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys ItemBag
bag
in (ItemBag
bag, SingleItemSlots
slots)
else (ItemBag
heldBag, SingleItemSlots
lSlotsRaw)
promptFun :: ItemId -> ItemFull -> Int -> Text
promptFun iid :: ItemId
iid itemFull2 :: ItemFull
itemFull2 k :: Int
k =
let worth :: Int
worth = Int -> ItemKind -> Int
itemPrice 1 (ItemKind -> Int) -> ItemKind -> Int
forall a b. (a -> b) -> a -> b
$ ItemFull -> ItemKind
itemKind ItemFull
itemFull2
lootMsg :: Text
lootMsg = if Int
worth Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 then "" else
let pile :: Part
pile = if Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 then "exemplar" else "hoard"
in [Part] -> Text
makeSentence ([Part] -> Text) -> [Part] -> Text
forall a b. (a -> b) -> a -> b
$
["this treasure", Part
pile, "is worth"]
[Part] -> [Part] -> [Part]
forall a. [a] -> [a] -> [a]
++ (if Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1 then [ Int -> Part
MU.Cardinal Int
k, "times"] else [])
[Part] -> [Part] -> [Part]
forall a. [a] -> [a] -> [a]
++ [Int -> Part -> Part
MU.CarWs Int
worth (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ Text -> Part
MU.Text Text
currencyName]
holdsMsg :: Text
holdsMsg =
let n :: Int
n = EnumMap ItemId Int
generationItem EnumMap ItemId Int -> ItemId -> Int
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ItemId
iid
in if | Int -> Int -> Int
forall a. Ord a => a -> a -> a
max 0 Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 ->
"You keep the only specimen extant:"
| Int -> Int -> Int
forall a. Ord a => a -> a -> a
max 0 Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 ->
"You don't have the only hypothesized specimen:"
| Int -> Int -> Int
forall a. Ord a => a -> a -> a
max 0 Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 ->
"No such specimen was recorded:"
| Bool
otherwise -> [Part] -> Text
makePhrase [ "You hold"
, Int -> Part -> Part
MU.CardinalAWs (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max 0 Int
k) "piece"
, "out of"
, Int -> Part
MU.Car Int
n
, "scattered:" ]
in Text
lootMsg Text -> Text -> Text
<+> Text
holdsMsg
Int
dungeonTotal <- (State -> Int) -> m Int
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> Int
sgold
let promptGold :: Text
promptGold = Text -> Int -> Int -> Text
spoilsBlurb Text
currencyName Int
total Int
dungeonTotal
prompt :: Text
prompt = Text
promptGold
Text -> Text -> Text
<+> (if Bool
sexposeItems
then "Non-positive count means none held but this many generated."
else "")
examItem :: Int -> SingleItemSlots -> m Bool
examItem = ItemBag
-> Int
-> (ItemId -> ItemFull -> Int -> Text)
-> Int
-> SingleItemSlots
-> m Bool
forall (m :: * -> *).
MonadClientUI m =>
ItemBag
-> Int
-> (ItemId -> ItemFull -> Int -> Text)
-> Int
-> SingleItemSlots
-> m Bool
displayItemLore ItemBag
itemBag 0 ItemId -> ItemFull -> Int -> Text
promptFun
[Char]
-> SingleItemSlots
-> ItemBag
-> Text
-> (Int -> SingleItemSlots -> m Bool)
-> m KM
forall (m :: * -> *).
MonadClientUI m =>
[Char]
-> SingleItemSlots
-> ItemBag
-> Text
-> (Int -> SingleItemSlots -> m Bool)
-> m KM
viewLoreItems "GameOverLoot" SingleItemSlots
lSlots ItemBag
itemBag Text
prompt Int -> SingleItemSlots -> m Bool
examItem
displayGameOverAnalytics :: MonadClientUI m
=> FactionAnalytics -> GenerationAnalytics
-> m K.KM
displayGameOverAnalytics :: FactionAnalytics -> GenerationAnalytics -> m KM
displayGameOverAnalytics factionAn :: FactionAnalytics
factionAn generationAn :: GenerationAnalytics
generationAn = do
ClientOptions{Bool
sexposeActors :: ClientOptions -> Bool
sexposeActors :: Bool
sexposeActors} <- (StateClient -> ClientOptions) -> m ClientOptions
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> ClientOptions
soptions
FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
ItemSlots itemSlots :: EnumMap SLore SingleItemSlots
itemSlots <- (SessionUI -> ItemSlots) -> m ItemSlots
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> ItemSlots
sslots
let ourAn :: EnumMap KillHow KillMap
ourAn = Analytics -> EnumMap KillHow KillMap
akillCounts
(Analytics -> EnumMap KillHow KillMap)
-> Analytics -> EnumMap KillHow KillMap
forall a b. (a -> b) -> a -> b
$ Analytics -> FactionId -> FactionAnalytics -> Analytics
forall k a. Enum k => a -> k -> EnumMap k a -> a
EM.findWithDefault Analytics
emptyAnalytics FactionId
side FactionAnalytics
factionAn
foesAn :: EnumMap ItemId Int
foesAn = (Int -> Int -> Int) -> [EnumMap ItemId Int] -> EnumMap ItemId Int
forall a k. (a -> a -> a) -> [EnumMap k a] -> EnumMap k a
EM.unionsWith Int -> Int -> Int
forall a. Num a => a -> a -> a
(+)
([EnumMap ItemId Int] -> EnumMap ItemId Int)
-> [EnumMap ItemId Int] -> EnumMap ItemId Int
forall a b. (a -> b) -> a -> b
$ (KillMap -> [EnumMap ItemId Int])
-> [KillMap] -> [EnumMap ItemId Int]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap KillMap -> [EnumMap ItemId Int]
forall k a. EnumMap k a -> [a]
EM.elems ([KillMap] -> [EnumMap ItemId Int])
-> [KillMap] -> [EnumMap ItemId Int]
forall a b. (a -> b) -> a -> b
$ [Maybe KillMap] -> [KillMap]
forall a. [Maybe a] -> [a]
catMaybes
([Maybe KillMap] -> [KillMap]) -> [Maybe KillMap] -> [KillMap]
forall a b. (a -> b) -> a -> b
$ (KillHow -> Maybe KillMap) -> [KillHow] -> [Maybe KillMap]
forall a b. (a -> b) -> [a] -> [b]
map (KillHow -> EnumMap KillHow KillMap -> Maybe KillMap
forall k a. Enum k => k -> EnumMap k a -> Maybe a
`EM.lookup` EnumMap KillHow KillMap
ourAn) [KillHow
KillKineticMelee .. KillHow
KillOtherPush]
trunkBagRaw :: ItemBag
trunkBagRaw = (Int -> ItemQuant) -> EnumMap ItemId Int -> ItemBag
forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
EM.map (, []) EnumMap ItemId Int
foesAn
lSlotsRaw :: SingleItemSlots
lSlotsRaw = (ItemId -> Bool) -> SingleItemSlots -> SingleItemSlots
forall a k. (a -> Bool) -> EnumMap k a -> EnumMap k a
EM.filter (ItemId -> ItemBag -> Bool
forall k a. Enum k => k -> EnumMap k a -> Bool
`EM.member` ItemBag
trunkBagRaw) (SingleItemSlots -> SingleItemSlots)
-> SingleItemSlots -> SingleItemSlots
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
STrunk
killedBag :: ItemBag
killedBag = [(ItemId, ItemQuant)] -> ItemBag
forall k a. Enum k => [(k, a)] -> EnumMap k a
EM.fromList ([(ItemId, ItemQuant)] -> ItemBag)
-> [(ItemId, ItemQuant)] -> ItemBag
forall a b. (a -> b) -> a -> b
$ (ItemId -> (ItemId, ItemQuant))
-> [ItemId] -> [(ItemId, ItemQuant)]
forall a b. (a -> b) -> [a] -> [b]
map (\iid :: ItemId
iid -> (ItemId
iid, ItemBag
trunkBagRaw ItemBag -> ItemId -> ItemQuant
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ItemId
iid))
(SingleItemSlots -> [ItemId]
forall k a. EnumMap k a -> [a]
EM.elems SingleItemSlots
lSlotsRaw)
generationTrunk :: EnumMap ItemId Int
generationTrunk = GenerationAnalytics
generationAn GenerationAnalytics -> SLore -> EnumMap ItemId Int
forall k a. Enum k => EnumMap k a -> k -> a
EM.! SLore
STrunk
(trunkBag :: ItemBag
trunkBag, lSlots :: SingleItemSlots
lSlots) =
if Bool
sexposeActors
then let generationBag :: ItemBag
generationBag = (Int -> ItemQuant) -> EnumMap ItemId Int -> ItemBag
forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
EM.map (\k :: Int
k -> (-Int
k, [])) EnumMap ItemId Int
generationTrunk
bag :: ItemBag
bag = ItemBag
killedBag ItemBag -> ItemBag -> ItemBag
forall k a. EnumMap k a -> EnumMap k a -> EnumMap k a
`EM.union` ItemBag
generationBag
slots :: SingleItemSlots
slots = [(SlotChar, ItemId)] -> SingleItemSlots
forall k a. Enum k => [(k, a)] -> EnumMap k a
EM.fromAscList ([(SlotChar, ItemId)] -> SingleItemSlots)
-> [(SlotChar, ItemId)] -> SingleItemSlots
forall a b. (a -> b) -> a -> b
$ [SlotChar] -> [ItemId] -> [(SlotChar, ItemId)]
forall a b. [a] -> [b] -> [(a, b)]
zip [SlotChar]
allSlots ([ItemId] -> [(SlotChar, ItemId)])
-> [ItemId] -> [(SlotChar, ItemId)]
forall a b. (a -> b) -> a -> b
$ ItemBag -> [ItemId]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys ItemBag
bag
in (ItemBag
bag, SingleItemSlots
slots)
else (ItemBag
killedBag, SingleItemSlots
lSlotsRaw)
total :: Int
total = [Int] -> Int
forall a. Num a => [a] -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
filter (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0) ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ (ItemQuant -> Int) -> [ItemQuant] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ItemQuant -> Int
forall a b. (a, b) -> a
fst ([ItemQuant] -> [Int]) -> [ItemQuant] -> [Int]
forall a b. (a -> b) -> a -> b
$ ItemBag -> [ItemQuant]
forall k a. EnumMap k a -> [a]
EM.elems ItemBag
trunkBag
promptFun :: ItemId -> ItemFull-> Int -> Text
promptFun :: ItemId -> ItemFull -> Int -> Text
promptFun iid :: ItemId
iid _ k :: Int
k =
let n :: Int
n = EnumMap ItemId Int
generationTrunk EnumMap ItemId Int -> ItemId -> Int
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ItemId
iid
in [Part] -> Text
makePhrase [ "You recall the adversary, which you killed"
, Int -> Part -> Part
MU.CarWs (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max 0 Int
k) "time", "out of"
, Int -> Part -> Part
MU.CarWs Int
n "individual", "reported:" ]
prompt :: Text
prompt = [Part] -> Text
makeSentence ["your team vanquished", Int -> Part -> Part
MU.CarWs Int
total "adversary"]
Text -> Text -> Text
<+> (if Bool
sexposeActors
then "Non-positive count means none killed but this many reported."
else "")
examItem :: Int -> SingleItemSlots -> m Bool
examItem = ItemBag
-> Int
-> (ItemId -> ItemFull -> Int -> Text)
-> Int
-> SingleItemSlots
-> m Bool
forall (m :: * -> *).
MonadClientUI m =>
ItemBag
-> Int
-> (ItemId -> ItemFull -> Int -> Text)
-> Int
-> SingleItemSlots
-> m Bool
displayItemLore ItemBag
trunkBag 0 ItemId -> ItemFull -> Int -> Text
promptFun
[Char]
-> SingleItemSlots
-> ItemBag
-> Text
-> (Int -> SingleItemSlots -> m Bool)
-> m KM
forall (m :: * -> *).
MonadClientUI m =>
[Char]
-> SingleItemSlots
-> ItemBag
-> Text
-> (Int -> SingleItemSlots -> m Bool)
-> m KM
viewLoreItems "GameOverAnalytics" SingleItemSlots
lSlots ItemBag
trunkBag Text
prompt Int -> SingleItemSlots -> m Bool
examItem
displayGameOverLore :: MonadClientUI m
=> SLore -> Bool -> GenerationAnalytics -> m K.KM
displayGameOverLore :: SLore -> Bool -> GenerationAnalytics -> m KM
displayGameOverLore slore :: SLore
slore exposeCount :: Bool
exposeCount generationAn :: GenerationAnalytics
generationAn = do
let generationLore :: EnumMap ItemId Int
generationLore = GenerationAnalytics
generationAn GenerationAnalytics -> SLore -> EnumMap ItemId Int
forall k a. Enum k => EnumMap k a -> k -> a
EM.! SLore
slore
generationBag :: ItemBag
generationBag = (Int -> ItemQuant) -> EnumMap ItemId Int -> ItemBag
forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
EM.map (\k :: Int
k -> (if Bool
exposeCount then Int
k else 1, []))
EnumMap ItemId Int
generationLore
total :: Int
total = [Int] -> Int
forall a. Num a => [a] -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (ItemQuant -> Int) -> [ItemQuant] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ItemQuant -> Int
forall a b. (a, b) -> a
fst ([ItemQuant] -> [Int]) -> [ItemQuant] -> [Int]
forall a b. (a -> b) -> a -> b
$ ItemBag -> [ItemQuant]
forall k a. EnumMap k a -> [a]
EM.elems ItemBag
generationBag
slots :: SingleItemSlots
slots = [(SlotChar, ItemId)] -> SingleItemSlots
forall k a. Enum k => [(k, a)] -> EnumMap k a
EM.fromAscList ([(SlotChar, ItemId)] -> SingleItemSlots)
-> [(SlotChar, ItemId)] -> SingleItemSlots
forall a b. (a -> b) -> a -> b
$ [SlotChar] -> [ItemId] -> [(SlotChar, ItemId)]
forall a b. [a] -> [b] -> [(a, b)]
zip [SlotChar]
allSlots ([ItemId] -> [(SlotChar, ItemId)])
-> [ItemId] -> [(SlotChar, ItemId)]
forall a b. (a -> b) -> a -> b
$ ItemBag -> [ItemId]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys ItemBag
generationBag
promptFun :: ItemId -> ItemFull-> Int -> Text
promptFun :: ItemId -> ItemFull -> Int -> Text
promptFun _ _ k :: Int
k =
[Part] -> Text
makeSentence
[ "this", Text -> Part
MU.Text (SLore -> Text
ppSLore SLore
slore), "manifested during your quest"
, Int -> Part -> Part
MU.CarWs Int
k "time" ]
prompt :: Text
prompt | Int
total Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 =
[Part] -> Text
makeSentence [ "you didn't experience any"
, Part -> Part
MU.Ws (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ Text -> Part
MU.Text (SLore -> Text
headingSLore SLore
slore)
, "this time" ]
| Bool
otherwise =
[Part] -> Text
makeSentence [ "you experienced the following variety of"
, Int -> Part -> Part
MU.CarWs Int
total (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ Text -> Part
MU.Text (SLore -> Text
headingSLore SLore
slore) ]
examItem :: Int -> SingleItemSlots -> m Bool
examItem = ItemBag
-> Int
-> (ItemId -> ItemFull -> Int -> Text)
-> Int
-> SingleItemSlots
-> m Bool
forall (m :: * -> *).
MonadClientUI m =>
ItemBag
-> Int
-> (ItemId -> ItemFull -> Int -> Text)
-> Int
-> SingleItemSlots
-> m Bool
displayItemLore ItemBag
generationBag 0 ItemId -> ItemFull -> Int -> Text
promptFun
[Char]
-> SingleItemSlots
-> ItemBag
-> Text
-> (Int -> SingleItemSlots -> m Bool)
-> m KM
forall (m :: * -> *).
MonadClientUI m =>
[Char]
-> SingleItemSlots
-> ItemBag
-> Text
-> (Int -> SingleItemSlots -> m Bool)
-> m KM
viewLoreItems ("GameOverLore" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ SLore -> [Char]
forall a. Show a => a -> [Char]
show SLore
slore)
SingleItemSlots
slots ItemBag
generationBag Text
prompt Int -> SingleItemSlots -> m Bool
examItem
discover :: MonadClientUI m => Container -> ItemId -> m ()
discover :: Container -> ItemId -> m ()
discover c :: Container
c iid :: ItemId
iid = 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
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
EnumMap FactionId Faction
factionD <- (State -> EnumMap FactionId Faction)
-> m (EnumMap FactionId Faction)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> EnumMap FactionId Faction
sfactionD
(noMsg :: Bool
noMsg, nameWhere :: [Part]
nameWhere) <- case Container
c of
CActor aidOwner :: ActorId
aidOwner storeOwner :: 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
partOwner <- ActorId -> m Part
forall (m :: * -> *). MonadClientUI m => ActorId -> m Part
partActorLeader ActorId
aidOwner
let name :: [Part]
name = if Actor -> Bool
bproj Actor
bOwner
then []
else Bool -> CStore -> Part -> [Part]
ppCStoreWownW Bool
True CStore
storeOwner Part
partOwner
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, [Part]) -> m (Bool, [Part])
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
isOurOrgan, [Part]
name)
CTrunk _ _ p :: 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, [])
_ -> (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 (1, []) ItemId
iid ItemBag
bag
knownName :: Part
knownName = FactionId
-> EnumMap FactionId Faction
-> Time
-> ItemFull
-> ItemQuant
-> Part
partItemMediumAW FactionId
side EnumMap FactionId Faction
factionD Time
localTime ItemFull
itemFull ItemQuant
kit
name :: Text
name = 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) -> ContentId ItemKind -> ItemKind
forall a b. (a -> b) -> a -> b
$ case Item -> ItemIdentity
jkind (Item -> ItemIdentity) -> Item -> ItemIdentity
forall a b. (a -> b) -> a -> b
$ ItemFull -> Item
itemBase ItemFull
itemFull of
IdentityObvious ik :: ContentId ItemKind
ik -> ContentId ItemKind
ik
IdentityCovered _ix :: ItemKindIx
_ix ik :: ContentId ItemKind
ik -> ContentId ItemKind
ik
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
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
["the", Part -> Part -> Part
MU.SubjectVerbSg Part
unknownName "turn out to be", Part
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
$
MsgClass -> Text -> m ()
forall (m :: * -> *). MonadClientUI m => MsgClass -> Text -> m ()
msgAdd MsgClass
MsgItemDisco Text
msg
ppHearMsg :: MonadClientUI m => HearMsg -> m Text
ppHearMsg :: HearMsg -> m Text
ppHearMsg hearMsg :: HearMsg
hearMsg = case HearMsg
hearMsg of
HearUpd local :: Bool
local cmd :: 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{} -> "shriek"
UpdCreateItem{} -> "clatter"
UpdTrajectory{} -> "thud"
UpdAlterTile _ _ _ toTile :: ContentId TileKind
toTile -> if TileSpeedup -> ContentId TileKind -> Bool
Tile.isDoor TileSpeedup
coTileSpeedup ContentId TileKind
toTile
then "creaking sound"
else "rumble"
UpdAlterExplorable _ k :: Int
k -> if Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 then "grinding noise"
else "fizzing noise"
_ -> [Char] -> Part
forall a. HasCallStack => [Char] -> a
error ([Char] -> Part) -> [Char] -> Part
forall a b. (a -> b) -> a -> b
$ "" [Char] -> UpdAtomic -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` UpdAtomic
cmd
distant :: [Part]
distant = if Bool
local then [] else ["distant"]
msg :: Text
msg = [Part] -> Text
makeSentence [ "you hear"
, Part -> Part
MU.AW (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ [Part] -> Part
MU.Phrase ([Part] -> Part) -> [Part] -> Part
forall a b. (a -> b) -> a -> b
$ [Part]
distant [Part] -> [Part] -> [Part]
forall a. [a] -> [a] -> [a]
++ [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 ik :: 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
msg :: Text
msg = [Part] -> Text
makeSentence [ "you hear something", Text -> Part
MU.Text Text
verb, "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 isProj :: Bool
isProj grp :: GroupName ItemKind
grp p :: Dice
p -> do
let verb :: Part
verb = if Bool
isProj then "something lure" else "somebody summon"
object :: Part
object = if Dice
p Dice -> Dice -> Bool
forall a. Eq a => a -> a -> Bool
== 1
then Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ GroupName ItemKind -> Text
forall a. GroupName a -> Text
fromGroupName GroupName ItemKind
grp
else Part -> Part
MU.Ws (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
$ GroupName ItemKind -> Text
forall a. GroupName a -> Text
fromGroupName GroupName ItemKind
grp
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 ["you hear", Part
verb, Part
object]
HearTaunt t :: Text
t ->
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 ["you overhear", Text -> Part
MU.Text Text
t]
displayRespSfxAtomicUI :: MonadClientUI m => SfxAtomic -> m ()
{-# INLINE displayRespSfxAtomicUI #-}
displayRespSfxAtomicUI :: SfxAtomic -> m ()
displayRespSfxAtomicUI sfx :: SfxAtomic
sfx = case SfxAtomic
sfx of
SfxStrike source :: ActorId
source target :: ActorId
target iid :: ItemId
iid store :: CStore
store ->
Bool -> ActorId -> ActorId -> ItemId -> CStore -> m ()
forall (m :: * -> *).
MonadClientUI m =>
Bool -> ActorId -> ActorId -> ItemId -> CStore -> m ()
strike Bool
False ActorId
source ActorId
target ItemId
iid CStore
store
SfxRecoil source :: ActorId
source target :: ActorId
target _ _ -> do
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
MsgClass -> Text -> m ()
forall (m :: * -> *). MonadClientUI m => MsgClass -> Text -> m ()
msgAdd MsgClass
MsgAction (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
[Part] -> Text
makeSentence [Part -> Part -> Part
MU.SubjectVerbSg Part
spart "shrink away from", Part
tpart]
SfxSteal source :: ActorId
source target :: ActorId
target iid :: ItemId
iid store :: CStore
store ->
Bool -> ActorId -> ActorId -> ItemId -> CStore -> m ()
forall (m :: * -> *).
MonadClientUI m =>
Bool -> ActorId -> ActorId -> ItemId -> CStore -> m ()
strike Bool
True ActorId
source ActorId
target ItemId
iid CStore
store
SfxRelease source :: ActorId
source target :: ActorId
target _ _ -> do
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
MsgClass -> Text -> m ()
forall (m :: * -> *). MonadClientUI m => MsgClass -> Text -> m ()
msgAdd MsgClass
MsgAction (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ [Part] -> Text
makeSentence [Part -> Part -> Part
MU.SubjectVerbSg Part
spart "release", Part
tpart]
SfxProject aid :: ActorId
aid iid :: ItemId
iid cstore :: CStore
cstore ->
MsgClass
-> ActorId
-> Part
-> ItemId
-> Either (Maybe Int) Int
-> CStore
-> m ()
forall (m :: * -> *).
MonadClientUI m =>
MsgClass
-> ActorId
-> Part
-> ItemId
-> Either (Maybe Int) Int
-> CStore
-> m ()
itemAidVerbMU MsgClass
MsgAction ActorId
aid "fling" ItemId
iid (Maybe Int -> Either (Maybe Int) Int
forall a b. a -> Either a b
Left (Maybe Int -> Either (Maybe Int) Int)
-> Maybe Int -> Either (Maybe Int) Int
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int
forall a. a -> Maybe a
Just 1) CStore
cstore
SfxReceive aid :: ActorId
aid iid :: ItemId
iid cstore :: CStore
cstore ->
MsgClass
-> ActorId
-> Part
-> ItemId
-> Either (Maybe Int) Int
-> CStore
-> m ()
forall (m :: * -> *).
MonadClientUI m =>
MsgClass
-> ActorId
-> Part
-> ItemId
-> Either (Maybe Int) Int
-> CStore
-> m ()
itemAidVerbMU MsgClass
MsgAction ActorId
aid "receive" ItemId
iid (Maybe Int -> Either (Maybe Int) Int
forall a b. a -> Either a b
Left (Maybe Int -> Either (Maybe Int) Int)
-> Maybe Int -> Either (Maybe Int) Int
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int
forall a. a -> Maybe a
Just 1) CStore
cstore
SfxApply aid :: ActorId
aid iid :: ItemId
iid cstore :: CStore
cstore -> do
CCUI{coscreen :: CCUI -> ScreenContent
coscreen=ScreenContent{EnumMap Char Text
rapplyVerbMap :: ScreenContent -> EnumMap Char Text
rapplyVerbMap :: EnumMap Char Text
rapplyVerbMap}} <- (SessionUI -> CCUI) -> m CCUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
ItemFull{ItemKind
itemKind :: ItemKind
itemKind :: ItemFull -> 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 ItemId
iid
let actionPart :: Part
actionPart = case Char -> EnumMap Char Text -> Maybe Text
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup (ItemKind -> Char
IK.isymbol ItemKind
itemKind) EnumMap Char Text
rapplyVerbMap of
Just verb :: Text
verb -> Text -> Part
MU.Text Text
verb
Nothing -> "use"
MsgClass
-> ActorId
-> Part
-> ItemId
-> Either (Maybe Int) Int
-> CStore
-> m ()
forall (m :: * -> *).
MonadClientUI m =>
MsgClass
-> ActorId
-> Part
-> ItemId
-> Either (Maybe Int) Int
-> CStore
-> m ()
itemAidVerbMU MsgClass
MsgAction ActorId
aid Part
actionPart ItemId
iid (Maybe Int -> Either (Maybe Int) Int
forall a b. a -> Either a b
Left (Maybe Int -> Either (Maybe Int) Int)
-> Maybe Int -> Either (Maybe Int) Int
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int
forall a. a -> Maybe a
Just 1) CStore
cstore
SfxCheck aid :: ActorId
aid iid :: ItemId
iid cstore :: CStore
cstore ->
MsgClass
-> ActorId
-> Part
-> ItemId
-> Either (Maybe Int) Int
-> CStore
-> m ()
forall (m :: * -> *).
MonadClientUI m =>
MsgClass
-> ActorId
-> Part
-> ItemId
-> Either (Maybe Int) Int
-> CStore
-> m ()
itemAidVerbMU MsgClass
MsgAction ActorId
aid "deapply" ItemId
iid (Maybe Int -> Either (Maybe Int) Int
forall a b. a -> Either a b
Left (Maybe Int -> Either (Maybe Int) Int)
-> Maybe Int -> Either (Maybe Int) Int
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int
forall a. a -> Maybe a
Just 1) CStore
cstore
SfxTrigger aid :: ActorId
aid p :: Point
p -> do
COps{ContentData TileKind
cotile :: ContentData TileKind
cotile :: COps -> ContentData TileKind
cotile} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
Level
lvl <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel (LevelId -> m Level) -> LevelId -> m Level
forall a b. (a -> b) -> a -> b
$ Actor -> LevelId
blid Actor
b
let name :: Text
name = 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 -> TileKind) -> ContentId TileKind -> TileKind
forall a b. (a -> b) -> a -> b
$ Level
lvl Level -> Point -> ContentId TileKind
`at` Point
p
(msgClass :: MsgClass
msgClass, verb :: Text
verb) = if Point
p Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> Point
bpos Actor
b
then (MsgClass
MsgActionMinor, "walk over")
else (MsgClass
MsgAction, "exploit")
MsgClass -> ActorId -> Part -> m ()
forall (m :: * -> *).
MonadClientUI m =>
MsgClass -> ActorId -> Part -> m ()
aidVerbMU MsgClass
msgClass ActorId
aid (Part -> m ()) -> Part -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ Text
verb Text -> Text -> Text
<+> Text
name
SfxShun aid :: ActorId
aid _p :: Point
_p ->
MsgClass -> ActorId -> Part -> m ()
forall (m :: * -> *).
MonadClientUI m =>
MsgClass -> ActorId -> Part -> m ()
aidVerbMU MsgClass
MsgAction ActorId
aid "shun it"
SfxEffect fidSource :: FactionId
fidSource aid :: ActorId
aid effect :: Effect
effect hpDelta :: Int64
hpDelta -> do
CCUI{ScreenContent
coscreen :: ScreenContent
coscreen :: CCUI -> ScreenContent
coscreen} <- (SessionUI -> CCUI) -> m CCUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
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
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
FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
Maybe ActorId
mleader <- (StateClient -> Maybe ActorId) -> m (Maybe ActorId)
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Maybe ActorId
sleader
let fid :: FactionId
fid = Actor -> FactionId
bfid Actor
b
isOurCharacter :: Bool
isOurCharacter = FactionId
fid FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side Bool -> Bool -> Bool
&& Bool -> Bool
not (Actor -> Bool
bproj Actor
b)
isOurAlive :: Bool
isOurAlive = Bool
isOurCharacter Bool -> Bool -> Bool
&& Actor -> Int64
bhp Actor
b Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> 0
isOurLeader :: Bool
isOurLeader = 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
feelLookHP :: Text -> m ()
feelLookHP = MsgClass -> Text -> m ()
feelLook MsgClass
MsgEffect
feelLookCalm :: Text -> m ()
feelLookCalm adjective :: Text
adjective =
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
> 0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ MsgClass -> Text -> m ()
feelLook MsgClass
MsgEffectMinor Text
adjective
feelLook :: MsgClass -> Text -> m ()
feelLook msgClass :: MsgClass
msgClass adjective :: Text
adjective =
let verb :: Text
verb = if Bool
isOurCharacter then "feel" else "look"
in MsgClass -> ActorId -> Part -> m ()
forall (m :: * -> *).
MonadClientUI m =>
MsgClass -> ActorId -> Part -> m ()
aidVerbMU MsgClass
msgClass ActorId
aid (Part -> m ()) -> Part -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ Text
verb Text -> Text -> Text
<+> Text
adjective
case Effect
effect of
IK.Burn{} -> do
Text -> m ()
feelLookHP "burned"
let ps :: (Point, Point)
ps = (Actor -> Point
bpos Actor
b, Actor -> Point
bpos Actor
b)
LevelId -> Animation -> m ()
forall (m :: * -> *).
MonadClientUI m =>
LevelId -> Animation -> m ()
animate (Actor -> LevelId
blid Actor
b) (Animation -> m ()) -> Animation -> m ()
forall a b. (a -> b) -> a -> b
$ ScreenContent -> (Point, Point) -> Color -> Color -> Animation
twirlSplash ScreenContent
coscreen (Point, Point)
ps Color
Color.BrRed Color
Color.Brown
IK.Explode{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
IK.RefillHP p :: Int
p | Int
p Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
IK.RefillHP p :: Int
p | Int
p Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== -1 -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
IK.RefillHP{} | Int64
hpDelta Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> 0 -> do
Text -> m ()
feelLookHP "healthier"
let ps :: (Point, Point)
ps = (Actor -> Point
bpos Actor
b, Actor -> Point
bpos Actor
b)
LevelId -> Animation -> m ()
forall (m :: * -> *).
MonadClientUI m =>
LevelId -> Animation -> m ()
animate (Actor -> LevelId
blid Actor
b) (Animation -> m ()) -> Animation -> m ()
forall a b. (a -> b) -> a -> b
$ ScreenContent -> (Point, Point) -> Color -> Color -> Animation
twirlSplash ScreenContent
coscreen (Point, Point)
ps Color
Color.BrGreen Color
Color.Green
IK.RefillHP{} -> do
Text -> m ()
feelLookHP "wounded"
let ps :: (Point, Point)
ps = (Actor -> Point
bpos Actor
b, Actor -> Point
bpos Actor
b)
LevelId -> Animation -> m ()
forall (m :: * -> *).
MonadClientUI m =>
LevelId -> Animation -> m ()
animate (Actor -> LevelId
blid Actor
b) (Animation -> m ()) -> Animation -> m ()
forall a b. (a -> b) -> a -> b
$ ScreenContent -> (Point, Point) -> Color -> Color -> Animation
twirlSplash ScreenContent
coscreen (Point, Point)
ps Color
Color.BrRed Color
Color.Red
IK.RefillCalm{} | Actor -> Bool
bproj Actor
b -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
IK.RefillCalm p :: Int
p | Int
p Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
IK.RefillCalm p :: Int
p | Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 -> Text -> m ()
feelLookCalm "calmer"
IK.RefillCalm _ -> Text -> m ()
feelLookCalm "agitated"
IK.Dominate -> do
let subject :: Part
subject = ActorUI -> Part
partActor ActorUI
bUI
if FactionId
fid FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
/= FactionId
fidSource then do
if | Actor -> Int64
bcalm Actor
b Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== 0 ->
MsgClass -> ActorId -> Part -> m ()
forall (m :: * -> *).
MonadClientUI m =>
MsgClass -> ActorId -> Part -> m ()
aidVerbMU MsgClass
MsgEffectMinor ActorId
aid
(Part -> m ()) -> Part -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Part
MU.Text "yield, under extreme pressure"
| Bool
isOurAlive ->
MsgClass -> ActorId -> Part -> m ()
forall (m :: * -> *).
MonadClientUI m =>
MsgClass -> ActorId -> Part -> m ()
aidVerbMU MsgClass
MsgEffectMinor ActorId
aid
(Part -> m ()) -> Part -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Part
MU.Text "black out, dominated by foes"
| Bool
otherwise ->
MsgClass -> ActorId -> Part -> m ()
forall (m :: * -> *).
MonadClientUI m =>
MsgClass -> ActorId -> Part -> m ()
aidVerbMU MsgClass
MsgEffectMinor ActorId
aid
(Part -> m ()) -> Part -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Part
MU.Text "decide abruptly to switch allegiance"
Text
fidName <- (State -> Text) -> m Text
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Text) -> m Text) -> (State -> Text) -> m Text
forall a b. (a -> b) -> a -> b
$ Faction -> Text
gname (Faction -> Text) -> (State -> Faction) -> State -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
fid) (EnumMap FactionId Faction -> Faction)
-> (State -> EnumMap FactionId Faction) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap FactionId Faction
sfactionD
let verb :: Part
verb = "be no longer controlled by"
MsgClass -> Text -> m ()
forall (m :: * -> *). MonadClientUI m => MsgClass -> Text -> m ()
msgAdd MsgClass
MsgEffectMajor (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ [Part] -> Text
makeSentence
[Part -> Part -> Part
MU.SubjectVerbSg Part
subject Part
verb, Text -> Part
MU.Text Text
fidName]
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isOurAlive (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ ColorMode -> Text -> m ()
forall (m :: * -> *). MonadClientUI m => ColorMode -> Text -> m ()
displayMoreKeep ColorMode
ColorFull ""
else do
Text
fidSourceName <- (State -> Text) -> m Text
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Text) -> m Text) -> (State -> Text) -> m Text
forall a b. (a -> b) -> a -> b
$ Faction -> Text
gname (Faction -> Text) -> (State -> Faction) -> State -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
fidSource) (EnumMap FactionId Faction -> Faction)
-> (State -> EnumMap FactionId Faction) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap FactionId Faction
sfactionD
let verb :: Part
verb = "be now under"
MsgClass -> Text -> m ()
forall (m :: * -> *). MonadClientUI m => MsgClass -> Text -> m ()
msgAdd MsgClass
MsgEffectMajor (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ [Part] -> Text
makeSentence
[Part -> Part -> Part
MU.SubjectVerbSg Part
subject Part
verb, Text -> Part
MU.Text Text
fidSourceName, "control"]
IK.Impress -> MsgClass -> ActorId -> Part -> m ()
forall (m :: * -> *).
MonadClientUI m =>
MsgClass -> ActorId -> Part -> m ()
aidVerbMU MsgClass
MsgEffectMinor ActorId
aid "be awestruck"
IK.PutToSleep -> MsgClass -> ActorId -> Part -> m ()
forall (m :: * -> *).
MonadClientUI m =>
MsgClass -> ActorId -> Part -> m ()
aidVerbMU MsgClass
MsgEffectMajor ActorId
aid "be put to sleep"
IK.Yell -> MsgClass -> ActorId -> Part -> m ()
forall (m :: * -> *).
MonadClientUI m =>
MsgClass -> ActorId -> Part -> m ()
aidVerbMU MsgClass
MsgMisc ActorId
aid "start"
IK.Summon grp :: GroupName ItemKind
grp p :: Dice
p -> do
let verb :: Part
verb = if Actor -> Bool
bproj Actor
b then "lure" else "summon"
object :: Part
object = (if Dice
p Dice -> Dice -> Bool
forall a. Eq a => a -> a -> Bool
== 1
then Part -> Part
MU.AW
else Part -> Part
MU.Ws) (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
$ GroupName ItemKind -> Text
forall a. GroupName a -> Text
fromGroupName GroupName ItemKind
grp
MsgClass -> ActorId -> Part -> m ()
forall (m :: * -> *).
MonadClientUI m =>
MsgClass -> ActorId -> Part -> m ()
aidVerbMU MsgClass
MsgEffectMajor ActorId
aid (Part -> m ()) -> Part -> m ()
forall a b. (a -> b) -> a -> b
$ [Part] -> Part
MU.Phrase [Part
verb, Part
object]
IK.Ascend up :: Bool
up -> 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
MsgClass -> ActorId -> Part -> m ()
forall (m :: * -> *).
MonadClientUI m =>
MsgClass -> ActorId -> Part -> m ()
aidVerbMU MsgClass
MsgEffectMajor ActorId
aid (Part -> m ()) -> Part -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$
"find a way" Text -> Text -> Text
<+> if Bool
up then "upstairs" else "downstairs"
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isOurLeader (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
[(LevelId, Point)]
destinations <- (State -> [(LevelId, Point)]) -> m [(LevelId, Point)]
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(LevelId, Point)]) -> m [(LevelId, Point)])
-> (State -> [(LevelId, Point)]) -> m [(LevelId, Point)]
forall a b. (a -> b) -> a -> b
$ LevelId -> Point -> Bool -> Dungeon -> [(LevelId, Point)]
whereTo (Actor -> LevelId
blid Actor
b) (Actor -> Point
bpos Actor
b) Bool
up
(Dungeon -> [(LevelId, Point)])
-> (State -> Dungeon) -> State -> [(LevelId, Point)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> Dungeon
sdungeon
case [(LevelId, Point)]
destinations of
(lid :: LevelId
lid, _) : _ -> do
Level
lvl <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel LevelId
lid
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
MsgClass -> Text -> m ()
forall (m :: * -> *). MonadClientUI m => MsgClass -> Text -> m ()
msgAdd0 MsgClass
MsgLandscape Text
desc
MsgClass -> Text -> m ()
forall (m :: * -> *). MonadClientUI m => MsgClass -> Text -> m ()
msgAdd0 MsgClass
MsgFocus
"You turn your attention to nearby positions."
[] -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
IK.Escape{} | Bool
isOurCharacter -> do
[(ActorId, Actor)]
ours <- (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)])
-> (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
forall a b. (a -> b) -> a -> b
$ FactionId -> State -> [(ActorId, Actor)]
fidActorNotProjGlobalAssocs FactionId
side
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([(ActorId, Actor)] -> Int
forall a. [a] -> Int
length [(ActorId, Actor)]
ours Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
let object :: Part
object = ActorUI -> Part
partActor ActorUI
bUI
MsgClass -> Text -> m ()
forall (m :: * -> *). MonadClientUI m => MsgClass -> Text -> m ()
msgAdd MsgClass
MsgOutcome (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
"The team joins" Text -> Text -> Text
<+> [Part] -> Text
makePhrase [Part
object]
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ", forms a perimeter, repacks its belongings and leaves triumphant."
IK.Escape{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
IK.Paralyze{} -> MsgClass -> ActorId -> Part -> m ()
forall (m :: * -> *).
MonadClientUI m =>
MsgClass -> ActorId -> Part -> m ()
aidVerbMU MsgClass
MsgEffect ActorId
aid "be paralyzed"
IK.ParalyzeInWater{} ->
MsgClass -> ActorId -> Part -> m ()
forall (m :: * -> *).
MonadClientUI m =>
MsgClass -> ActorId -> Part -> m ()
aidVerbMU MsgClass
MsgEffectMinor ActorId
aid "move with difficulty"
IK.InsertMove d :: Dice
d ->
if Dice -> Int
Dice.supDice Dice
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 10
then MsgClass -> ActorId -> Part -> m ()
forall (m :: * -> *).
MonadClientUI m =>
MsgClass -> ActorId -> Part -> m ()
aidVerbMU MsgClass
MsgEffect ActorId
aid "act with extreme speed"
else MsgClass -> ActorId -> Part -> m ()
forall (m :: * -> *).
MonadClientUI m =>
MsgClass -> ActorId -> Part -> m ()
aidVerbMU MsgClass
MsgEffectMinor ActorId
aid "move swiftly"
IK.Teleport t :: Dice
t | Dice -> Int
Dice.supDice Dice
t Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 9 ->
MsgClass -> ActorId -> Part -> m ()
forall (m :: * -> *).
MonadClientUI m =>
MsgClass -> ActorId -> Part -> m ()
aidVerbMU MsgClass
MsgEffectMinor ActorId
aid "blink"
IK.Teleport{} -> MsgClass -> ActorId -> Part -> m ()
forall (m :: * -> *).
MonadClientUI m =>
MsgClass -> ActorId -> Part -> m ()
aidVerbMU MsgClass
MsgEffect ActorId
aid "teleport"
IK.CreateItem{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
IK.DropItem _ _ COrgan _ -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
IK.DropItem{} -> MsgClass -> ActorId -> Part -> m ()
forall (m :: * -> *).
MonadClientUI m =>
MsgClass -> ActorId -> Part -> m ()
aidVerbMU MsgClass
MsgEffect ActorId
aid "be stripped"
IK.PolyItem -> do
Part
subject <- ActorId -> m Part
forall (m :: * -> *). MonadClientUI m => ActorId -> m Part
partActorLeader ActorId
aid
let ppstore :: Part
ppstore = Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ CStore -> Text
ppCStoreIn CStore
CGround
MsgClass -> Text -> m ()
forall (m :: * -> *). MonadClientUI m => MsgClass -> Text -> m ()
msgAdd MsgClass
MsgEffect (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ [Part] -> Text
makeSentence
[ Part -> Part -> Part
MU.SubjectVerbSg Part
subject "repurpose", "what lies", Part
ppstore
, "to a common item of the current level" ]
IK.RerollItem -> do
Part
subject <- ActorId -> m Part
forall (m :: * -> *). MonadClientUI m => ActorId -> m Part
partActorLeader ActorId
aid
let ppstore :: Part
ppstore = Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ CStore -> Text
ppCStoreIn CStore
CGround
MsgClass -> Text -> m ()
forall (m :: * -> *). MonadClientUI m => MsgClass -> Text -> m ()
msgAdd MsgClass
MsgEffect (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ [Part] -> Text
makeSentence
[ Part -> Part -> Part
MU.SubjectVerbSg Part
subject "reshape", "what lies", Part
ppstore
, "striving for the highest possible standards" ]
IK.DupItem -> do
Part
subject <- ActorId -> m Part
forall (m :: * -> *). MonadClientUI m => ActorId -> m Part
partActorLeader ActorId
aid
let ppstore :: Part
ppstore = Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ CStore -> Text
ppCStoreIn CStore
CGround
MsgClass -> Text -> m ()
forall (m :: * -> *). MonadClientUI m => MsgClass -> Text -> m ()
msgAdd MsgClass
MsgEffect (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ [Part] -> Text
makeSentence
[Part -> Part -> Part
MU.SubjectVerbSg Part
subject "multiply", "what lies", Part
ppstore]
IK.Identify -> do
Part
subject <- ActorId -> m Part
forall (m :: * -> *). MonadClientUI m => ActorId -> m Part
partActorLeader ActorId
aid
Part
pronoun <- ActorId -> m Part
forall (m :: * -> *). MonadClientUI m => ActorId -> m Part
partPronounLeader ActorId
aid
MsgClass -> Text -> m ()
forall (m :: * -> *). MonadClientUI m => MsgClass -> Text -> m ()
msgAdd MsgClass
MsgEffectMinor (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ [Part] -> Text
makeSentence
[ Part -> Part -> Part
MU.SubjectVerbSg Part
subject "look at"
, Part -> Part -> Part
MU.WownW Part
pronoun (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ Text -> Part
MU.Text "inventory"
, "intensely" ]
IK.Detect d :: DetectKind
d _ -> do
Part
subject <- ActorId -> m Part
forall (m :: * -> *). MonadClientUI m => ActorId -> m Part
partActorLeader ActorId
aid
let verb :: Part
verb = Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ DetectKind -> Text
detectToVerb DetectKind
d
object :: Part
object = Part -> Part
MU.Ws (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
$ DetectKind -> Text
detectToObject DetectKind
d
MsgClass -> Text -> m ()
forall (m :: * -> *). MonadClientUI m => MsgClass -> Text -> m ()
msgAdd MsgClass
MsgEffectMinor (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
[Part] -> Text
makeSentence [Part -> Part -> Part
MU.SubjectVerbSg Part
subject Part
verb, Part
object]
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (DetectKind
d DetectKind -> [DetectKind] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [DetectKind
IK.DetectHidden, DetectKind
IK.DetectExit]) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
ColorMode -> Text -> m ()
forall (m :: * -> *). MonadClientUI m => ColorMode -> Text -> m ()
displayMore ColorMode
ColorFull ""
IK.SendFlying{} -> MsgClass -> ActorId -> Part -> m ()
forall (m :: * -> *).
MonadClientUI m =>
MsgClass -> ActorId -> Part -> m ()
aidVerbMU MsgClass
MsgEffect ActorId
aid "be sent flying"
IK.PushActor{} -> MsgClass -> ActorId -> Part -> m ()
forall (m :: * -> *).
MonadClientUI m =>
MsgClass -> ActorId -> Part -> m ()
aidVerbMU MsgClass
MsgEffect ActorId
aid "be pushed"
IK.PullActor{} -> MsgClass -> ActorId -> Part -> m ()
forall (m :: * -> *).
MonadClientUI m =>
MsgClass -> ActorId -> Part -> m ()
aidVerbMU MsgClass
MsgEffect ActorId
aid "be pulled"
IK.DropBestWeapon -> MsgClass -> ActorId -> Part -> m ()
forall (m :: * -> *).
MonadClientUI m =>
MsgClass -> ActorId -> Part -> m ()
aidVerbMU MsgClass
MsgEffectMajor ActorId
aid "be disarmed"
IK.ActivateInv{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
IK.ApplyPerfume ->
MsgClass -> Text -> m ()
forall (m :: * -> *). MonadClientUI m => MsgClass -> Text -> m ()
msgAdd MsgClass
MsgEffectMinor
"The fragrance quells all scents in the vicinity."
IK.OneOf{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
IK.OnSmash{} -> [Char] -> m ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> m ()) -> [Char] -> m ()
forall a b. (a -> b) -> a -> b
$ "" [Char] -> SfxAtomic -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` SfxAtomic
sfx
IK.VerbNoLonger t :: Text
t -> MsgClass -> ActorId -> Part -> m ()
forall (m :: * -> *).
MonadClientUI m =>
MsgClass -> ActorId -> Part -> m ()
aidVerbMU MsgClass
MsgNoLonger ActorId
aid (Part -> m ()) -> Part -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Part
MU.Text Text
t
IK.VerbMsg t :: Text
t -> MsgClass -> ActorId -> Part -> m ()
forall (m :: * -> *).
MonadClientUI m =>
MsgClass -> ActorId -> Part -> m ()
aidVerbMU MsgClass
MsgEffectMinor ActorId
aid (Part -> m ()) -> Part -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Part
MU.Text Text
t
IK.Composite{} -> [Char] -> m ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> m ()) -> [Char] -> m ()
forall a b. (a -> b) -> a -> b
$ "" [Char] -> SfxAtomic -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` SfxAtomic
sfx
SfxMsgFid _ sfxMsg :: SfxMsg
sfxMsg -> 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 ()
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
Maybe (MsgClass, Text)
mmsg <- SfxMsg -> m (Maybe (MsgClass, Text))
forall (m :: * -> *).
MonadClientUI m =>
SfxMsg -> m (Maybe (MsgClass, Text))
ppSfxMsg SfxMsg
sfxMsg
case Maybe (MsgClass, Text)
mmsg of
Just (msgClass :: MsgClass
msgClass, msg :: Text
msg) -> MsgClass -> Text -> m ()
forall (m :: * -> *). MonadClientUI m => MsgClass -> Text -> m ()
msgAdd MsgClass
msgClass Text
msg
Nothing -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
SfxRestart -> Bool -> m ()
forall (m :: * -> *). MonadClientUI m => Bool -> m ()
fadeOutOrIn Bool
True
SfxCollideTile source :: ActorId
source pos :: Point
pos -> 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
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
Level
lvl <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel (LevelId -> m Level) -> LevelId -> m Level
forall a b. (a -> b) -> a -> b
$ Actor -> LevelId
blid Actor
sb
Part
spart <- ActorId -> m Part
forall (m :: * -> *). MonadClientUI m => ActorId -> m Part
partActorLeader ActorId
source
let object :: Part
object = 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 -> TileKind) -> ContentId TileKind -> TileKind
forall a b. (a -> b) -> a -> b
$ Level
lvl Level -> Point -> ContentId TileKind
`at` Point
pos
MsgClass -> Text -> m ()
forall (m :: * -> *). MonadClientUI m => MsgClass -> Text -> m ()
msgAdd MsgClass
MsgVeryRare (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$! [Part] -> Text
makeSentence
[Part -> Part -> Part
MU.SubjectVerbSg Part
spart "collide", "painfully with", Part
object]
SfxTaunt voluntary :: Bool
voluntary aid :: ActorId
aid -> do
Part
spart <- ActorId -> m Part
forall (m :: * -> *). MonadClientUI m => ActorId -> m Part
partActorLeader ActorId
aid
(_heardSubject :: Text
_heardSubject, verb :: Text
verb) <- Bool
-> (Rnd (Text, Text) -> m (Text, Text))
-> ActorId
-> m (Text, Text)
forall (m :: * -> *).
MonadStateRead m =>
Bool
-> (Rnd (Text, Text) -> m (Text, Text))
-> ActorId
-> m (Text, Text)
displayTaunt Bool
voluntary Rnd (Text, Text) -> m (Text, Text)
forall (m :: * -> *) a. MonadClientRead m => Rnd a -> m a
rndToActionForget ActorId
aid
MsgClass -> Text -> m ()
forall (m :: * -> *). MonadClientUI m => MsgClass -> Text -> m ()
msgAdd MsgClass
MsgMisc (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$! [Part] -> Text
makeSentence [Part -> Part -> Part
MU.SubjectVerbSg Part
spart (Text -> Part
MU.Text Text
verb)]
ppSfxMsg :: MonadClientUI m => SfxMsg -> m (Maybe (MsgClass, Text))
ppSfxMsg :: SfxMsg -> m (Maybe (MsgClass, Text))
ppSfxMsg sfxMsg :: SfxMsg
sfxMsg = case SfxMsg
sfxMsg of
SfxUnexpected reqFailure :: ReqFailure
reqFailure -> Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text)))
-> Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text))
forall a b. (a -> b) -> a -> b
$
(MsgClass, Text) -> Maybe (MsgClass, Text)
forall a. a -> Maybe a
Just ( MsgClass
MsgWarning
, "Unexpected problem:" Text -> Text -> Text
<+> ReqFailure -> Text
showReqFailure ReqFailure
reqFailure Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "." )
SfxExpected itemName :: Text
itemName reqFailure :: ReqFailure
reqFailure -> Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text)))
-> Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text))
forall a b. (a -> b) -> a -> b
$
(MsgClass, Text) -> Maybe (MsgClass, Text)
forall a. a -> Maybe a
Just ( MsgClass
MsgWarning
, "The" Text -> Text -> Text
<+> Text
itemName Text -> Text -> Text
<+> "is not triggered:"
Text -> Text -> Text
<+> ReqFailure -> Text
showReqFailure ReqFailure
reqFailure Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "." )
SfxFizzles -> Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text)))
-> Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text))
forall a b. (a -> b) -> a -> b
$ (MsgClass, Text) -> Maybe (MsgClass, Text)
forall a. a -> Maybe a
Just (MsgClass
MsgWarning, "It didn't work.")
SfxNothingHappens -> Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text)))
-> Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text))
forall a b. (a -> b) -> a -> b
$ (MsgClass, Text) -> Maybe (MsgClass, Text)
forall a. a -> Maybe a
Just (MsgClass
MsgMisc, "Nothing happens.")
SfxVoidDetection d :: DetectKind
d -> Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text)))
-> Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text))
forall a b. (a -> b) -> a -> b
$
(MsgClass, Text) -> Maybe (MsgClass, Text)
forall a. a -> Maybe a
Just ( MsgClass
MsgMisc
, [Part] -> Text
makeSentence ["no new", Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ DetectKind -> Text
detectToObject DetectKind
d, "detected"] )
SfxUnimpressed aid :: ActorId
aid -> do
Maybe ActorUI
msbUI <- (SessionUI -> Maybe ActorUI) -> m (Maybe ActorUI)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession ((SessionUI -> Maybe ActorUI) -> m (Maybe ActorUI))
-> (SessionUI -> Maybe ActorUI) -> m (Maybe ActorUI)
forall a b. (a -> b) -> a -> b
$ ActorId -> ActorDictUI -> Maybe ActorUI
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup ActorId
aid (ActorDictUI -> Maybe ActorUI)
-> (SessionUI -> ActorDictUI) -> SessionUI -> Maybe ActorUI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessionUI -> ActorDictUI
sactorUI
case Maybe ActorUI
msbUI of
Nothing -> Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MsgClass, Text)
forall a. Maybe a
Nothing
Just sbUI :: ActorUI
sbUI -> do
let subject :: Part
subject = ActorUI -> Part
partActor ActorUI
sbUI
verb :: Part
verb = "be unimpressed"
Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text)))
-> Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text))
forall a b. (a -> b) -> a -> b
$ (MsgClass, Text) -> Maybe (MsgClass, Text)
forall a. a -> Maybe a
Just (MsgClass
MsgWarning, [Part] -> Text
makeSentence [Part -> Part -> Part
MU.SubjectVerbSg Part
subject Part
verb])
SfxSummonLackCalm aid :: ActorId
aid -> do
Maybe ActorUI
msbUI <- (SessionUI -> Maybe ActorUI) -> m (Maybe ActorUI)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession ((SessionUI -> Maybe ActorUI) -> m (Maybe ActorUI))
-> (SessionUI -> Maybe ActorUI) -> m (Maybe ActorUI)
forall a b. (a -> b) -> a -> b
$ ActorId -> ActorDictUI -> Maybe ActorUI
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup ActorId
aid (ActorDictUI -> Maybe ActorUI)
-> (SessionUI -> ActorDictUI) -> SessionUI -> Maybe ActorUI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessionUI -> ActorDictUI
sactorUI
case Maybe ActorUI
msbUI of
Nothing -> Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MsgClass, Text)
forall a. Maybe a
Nothing
Just sbUI :: ActorUI
sbUI -> do
let subject :: Part
subject = ActorUI -> Part
partActor ActorUI
sbUI
verb :: Part
verb = "lack Calm to summon"
Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text)))
-> Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text))
forall a b. (a -> b) -> a -> b
$ (MsgClass, Text) -> Maybe (MsgClass, Text)
forall a. a -> Maybe a
Just (MsgClass
MsgWarning, [Part] -> Text
makeSentence [Part -> Part -> Part
MU.SubjectVerbSg Part
subject Part
verb])
SfxSummonTooManyOwn aid :: ActorId
aid -> do
Maybe ActorUI
msbUI <- (SessionUI -> Maybe ActorUI) -> m (Maybe ActorUI)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession ((SessionUI -> Maybe ActorUI) -> m (Maybe ActorUI))
-> (SessionUI -> Maybe ActorUI) -> m (Maybe ActorUI)
forall a b. (a -> b) -> a -> b
$ ActorId -> ActorDictUI -> Maybe ActorUI
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup ActorId
aid (ActorDictUI -> Maybe ActorUI)
-> (SessionUI -> ActorDictUI) -> SessionUI -> Maybe ActorUI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessionUI -> ActorDictUI
sactorUI
case Maybe ActorUI
msbUI of
Nothing -> Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MsgClass, Text)
forall a. Maybe a
Nothing
Just sbUI :: ActorUI
sbUI -> do
let subject :: Part
subject = ActorUI -> Part
partActor ActorUI
sbUI
verb :: Part
verb = "can't keep track of their numerous friends, let alone summon any more"
Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text)))
-> Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text))
forall a b. (a -> b) -> a -> b
$ (MsgClass, Text) -> Maybe (MsgClass, Text)
forall a. a -> Maybe a
Just (MsgClass
MsgWarning, [Part] -> Text
makeSentence [Part
subject, Part
verb])
SfxSummonTooManyAll aid :: ActorId
aid -> do
Maybe ActorUI
msbUI <- (SessionUI -> Maybe ActorUI) -> m (Maybe ActorUI)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession ((SessionUI -> Maybe ActorUI) -> m (Maybe ActorUI))
-> (SessionUI -> Maybe ActorUI) -> m (Maybe ActorUI)
forall a b. (a -> b) -> a -> b
$ ActorId -> ActorDictUI -> Maybe ActorUI
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup ActorId
aid (ActorDictUI -> Maybe ActorUI)
-> (SessionUI -> ActorDictUI) -> SessionUI -> Maybe ActorUI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessionUI -> ActorDictUI
sactorUI
case Maybe ActorUI
msbUI of
Nothing -> Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MsgClass, Text)
forall a. Maybe a
Nothing
Just sbUI :: ActorUI
sbUI -> do
let subject :: Part
subject = ActorUI -> Part
partActor ActorUI
sbUI
verb :: Part
verb = "can't keep track of everybody around, let alone summon anyone else"
Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text)))
-> Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text))
forall a b. (a -> b) -> a -> b
$ (MsgClass, Text) -> Maybe (MsgClass, Text)
forall a. a -> Maybe a
Just (MsgClass
MsgWarning, [Part] -> Text
makeSentence [Part
subject, Part
verb])
SfxSummonFailure aid :: ActorId
aid -> do
Maybe ActorUI
msbUI <- (SessionUI -> Maybe ActorUI) -> m (Maybe ActorUI)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession ((SessionUI -> Maybe ActorUI) -> m (Maybe ActorUI))
-> (SessionUI -> Maybe ActorUI) -> m (Maybe ActorUI)
forall a b. (a -> b) -> a -> b
$ ActorId -> ActorDictUI -> Maybe ActorUI
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup ActorId
aid (ActorDictUI -> Maybe ActorUI)
-> (SessionUI -> ActorDictUI) -> SessionUI -> Maybe ActorUI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessionUI -> ActorDictUI
sactorUI
case Maybe ActorUI
msbUI of
Nothing -> Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MsgClass, Text)
forall a. Maybe a
Nothing
Just sbUI :: ActorUI
sbUI -> do
let subject :: Part
subject = ActorUI -> Part
partActor ActorUI
sbUI
verb :: Part
verb = "fail to summon anything"
Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text)))
-> Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text))
forall a b. (a -> b) -> a -> b
$ (MsgClass, Text) -> Maybe (MsgClass, Text)
forall a. a -> Maybe a
Just (MsgClass
MsgWarning, [Part] -> Text
makeSentence [Part -> Part -> Part
MU.SubjectVerbSg Part
subject Part
verb])
SfxLevelNoMore ->
Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text)))
-> Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text))
forall a b. (a -> b) -> a -> b
$ (MsgClass, Text) -> Maybe (MsgClass, Text)
forall a. a -> Maybe a
Just (MsgClass
MsgWarning, "No more levels in this direction.")
SfxLevelPushed ->
Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text)))
-> Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text))
forall a b. (a -> b) -> a -> b
$ (MsgClass, Text) -> Maybe (MsgClass, Text)
forall a. a -> Maybe a
Just (MsgClass
MsgWarning, "You notice somebody pushed to another level.")
SfxBracedImmune aid :: ActorId
aid -> do
Maybe ActorUI
msbUI <- (SessionUI -> Maybe ActorUI) -> m (Maybe ActorUI)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession ((SessionUI -> Maybe ActorUI) -> m (Maybe ActorUI))
-> (SessionUI -> Maybe ActorUI) -> m (Maybe ActorUI)
forall a b. (a -> b) -> a -> b
$ ActorId -> ActorDictUI -> Maybe ActorUI
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup ActorId
aid (ActorDictUI -> Maybe ActorUI)
-> (SessionUI -> ActorDictUI) -> SessionUI -> Maybe ActorUI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessionUI -> ActorDictUI
sactorUI
case Maybe ActorUI
msbUI of
Nothing -> Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MsgClass, Text)
forall a. Maybe a
Nothing
Just sbUI :: ActorUI
sbUI -> do
let subject :: Part
subject = ActorUI -> Part
partActor ActorUI
sbUI
verb :: Part
verb = "be braced and so immune to translocation"
Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text)))
-> Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text))
forall a b. (a -> b) -> a -> b
$ (MsgClass, Text) -> Maybe (MsgClass, Text)
forall a. a -> Maybe a
Just (MsgClass
MsgMisc, [Part] -> Text
makeSentence [Part -> Part -> Part
MU.SubjectVerbSg Part
subject Part
verb])
SfxEscapeImpossible -> Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text)))
-> Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text))
forall a b. (a -> b) -> a -> b
$
(MsgClass, Text) -> Maybe (MsgClass, Text)
forall a. a -> Maybe a
Just ( MsgClass
MsgWarning
, "Escaping outside is unthinkable for members of this faction." )
SfxStasisProtects -> Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text)))
-> Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text))
forall a b. (a -> b) -> a -> b
$
(MsgClass, Text) -> Maybe (MsgClass, Text)
forall a. a -> Maybe a
Just ( MsgClass
MsgMisc
, "Paralysis and speed surge require recovery time." )
SfxWaterParalysisResisted -> Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MsgClass, Text)
forall a. Maybe a
Nothing
SfxTransImpossible -> Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text)))
-> Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text))
forall a b. (a -> b) -> a -> b
$
(MsgClass, Text) -> Maybe (MsgClass, Text)
forall a. a -> Maybe a
Just (MsgClass
MsgWarning, "Translocation not possible.")
SfxIdentifyNothing -> Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text)))
-> Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text))
forall a b. (a -> b) -> a -> b
$ (MsgClass, Text) -> Maybe (MsgClass, Text)
forall a. a -> Maybe a
Just (MsgClass
MsgWarning, "Nothing to identify.")
SfxPurposeNothing -> Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text)))
-> Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text))
forall a b. (a -> b) -> a -> b
$
(MsgClass, Text) -> Maybe (MsgClass, Text)
forall a. a -> Maybe a
Just ( MsgClass
MsgWarning
, "The purpose of repurpose cannot be availed without an item"
Text -> Text -> Text
<+> CStore -> Text
ppCStoreIn CStore
CGround Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "." )
SfxPurposeTooFew maxCount :: Int
maxCount itemK :: Int
itemK -> Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text)))
-> Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text))
forall a b. (a -> b) -> a -> b
$
(MsgClass, Text) -> Maybe (MsgClass, Text)
forall a. a -> Maybe a
Just ( MsgClass
MsgWarning
, "The purpose of repurpose is served by" Text -> Text -> Text
<+> Int -> Text
forall a. Show a => a -> Text
tshow Int
maxCount
Text -> Text -> Text
<+> "pieces of this item, not by" Text -> Text -> Text
<+> Int -> Text
forall a. Show a => a -> Text
tshow Int
itemK Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "." )
SfxPurposeUnique -> Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text)))
-> Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text))
forall a b. (a -> b) -> a -> b
$
(MsgClass, Text) -> Maybe (MsgClass, Text)
forall a. a -> Maybe a
Just (MsgClass
MsgWarning, "Unique items can't be repurposed.")
SfxPurposeNotCommon -> Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text)))
-> Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text))
forall a b. (a -> b) -> a -> b
$
(MsgClass, Text) -> Maybe (MsgClass, Text)
forall a. a -> Maybe a
Just (MsgClass
MsgWarning, "Only ordinary common items can be repurposed.")
SfxRerollNothing -> Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text)))
-> Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text))
forall a b. (a -> b) -> a -> b
$
(MsgClass, Text) -> Maybe (MsgClass, Text)
forall a. a -> Maybe a
Just ( MsgClass
MsgWarning
, "The shape of reshape cannot be assumed without an item"
Text -> Text -> Text
<+> CStore -> Text
ppCStoreIn CStore
CGround Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "." )
SfxRerollNotRandom -> Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text)))
-> Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text))
forall a b. (a -> b) -> a -> b
$
(MsgClass, Text) -> Maybe (MsgClass, Text)
forall a. a -> Maybe a
Just (MsgClass
MsgWarning, "Only items of variable shape can be reshaped.")
SfxDupNothing -> Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text)))
-> Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text))
forall a b. (a -> b) -> a -> b
$
(MsgClass, Text) -> Maybe (MsgClass, Text)
forall a. a -> Maybe a
Just ( MsgClass
MsgWarning
, "Mutliplicity won't rise above zero without an item"
Text -> Text -> Text
<+> CStore -> Text
ppCStoreIn CStore
CGround Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "." )
SfxDupUnique -> Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text)))
-> Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text))
forall a b. (a -> b) -> a -> b
$
(MsgClass, Text) -> Maybe (MsgClass, Text)
forall a. a -> Maybe a
Just (MsgClass
MsgWarning, "Unique items can't be multiplied.")
SfxDupValuable -> Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text)))
-> Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text))
forall a b. (a -> b) -> a -> b
$
(MsgClass, Text) -> Maybe (MsgClass, Text)
forall a. a -> Maybe a
Just (MsgClass
MsgWarning, "Valuable items can't be multiplied.")
SfxColdFish -> Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text)))
-> Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text))
forall a b. (a -> b) -> a -> b
$
(MsgClass, Text) -> Maybe (MsgClass, Text)
forall a. a -> Maybe a
Just ( MsgClass
MsgMisc
, "Healing attempt from another faction is thwarted by your cold fish attitude." )
SfxTimerExtended lid :: LevelId
lid aid :: ActorId
aid iid :: ItemId
iid cstore :: CStore
cstore delta :: Delta Time
delta -> do
Bool
aidSeen <- (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
$ ActorId -> LevelId -> State -> Bool
memActor ActorId
aid LevelId
lid
if Bool
aidSeen then 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
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
aidPronoun <- ActorId -> m Part
forall (m :: * -> *). MonadClientUI m => ActorId -> m Part
partPronounLeader ActorId
aid
EnumMap FactionId Faction
factionD <- (State -> EnumMap FactionId Faction)
-> m (EnumMap FactionId Faction)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> EnumMap FactionId Faction
sfactionD
Time
localTime <- (State -> Time) -> m Time
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Time) -> m Time) -> (State -> Time) -> m Time
forall a b. (a -> b) -> a -> b
$ LevelId -> State -> Time
getLocalTime (Actor -> LevelId
blid Actor
b)
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
FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
let kit :: (Int, [a])
kit = (1, [])
(name :: Part
name, powers :: Part
powers) = FactionId
-> EnumMap FactionId Faction
-> Time
-> ItemFull
-> ItemQuant
-> (Part, Part)
partItem (Actor -> FactionId
bfid Actor
b) EnumMap FactionId Faction
factionD Time
localTime ItemFull
itemFull ItemQuant
forall a. (Int, [a])
kit
storeOwn :: [Part]
storeOwn = Bool -> CStore -> Part -> [Part]
ppCStoreWownW Bool
True CStore
cstore Part
aidPronoun
cond :: [Part]
cond = [ "condition"
| Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Condition (AspectRecord -> Bool) -> AspectRecord -> Bool
forall a b. (a -> b) -> a -> b
$ ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFull ]
(msgClass :: MsgClass
msgClass, parts :: [Part]
parts) | Actor -> FactionId
bfid Actor
b FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side =
( MsgClass
MsgLongerUs
, ["the", Part
name, Part
powers] [Part] -> [Part] -> [Part]
forall a. [a] -> [a] -> [a]
++ [Part]
cond [Part] -> [Part] -> [Part]
forall a. [a] -> [a] -> [a]
++ [Part]
storeOwn [Part] -> [Part] -> [Part]
forall a. [a] -> [a] -> [a]
++ ["will now last"]
[Part] -> [Part] -> [Part]
forall a. [a] -> [a] -> [a]
++ [Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ Delta Time -> Text
timeDeltaInSecondsText Delta Time
delta] [Part] -> [Part] -> [Part]
forall a. [a] -> [a] -> [a]
++ ["longer"] )
| Bool
otherwise =
( MsgClass
MsgLonger
, [FactionId
-> EnumMap FactionId Faction
-> Part
-> Time
-> ItemFull
-> ItemQuant
-> Part
partItemShortWownW FactionId
side EnumMap FactionId Faction
factionD (ActorUI -> Part
partActor ActorUI
bUI) Time
localTime
ItemFull
itemFull (1, [])]
[Part] -> [Part] -> [Part]
forall a. [a] -> [a] -> [a]
++ [Part]
cond [Part] -> [Part] -> [Part]
forall a. [a] -> [a] -> [a]
++ ["is extended"] )
Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text)))
-> Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text))
forall a b. (a -> b) -> a -> b
$ (MsgClass, Text) -> Maybe (MsgClass, Text)
forall a. a -> Maybe a
Just (MsgClass
msgClass, [Part] -> Text
makeSentence [Part]
parts)
else Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MsgClass, Text)
forall a. Maybe a
Nothing
SfxCollideActor lid :: LevelId
lid source :: ActorId
source target :: ActorId
target -> do
Bool
sourceSeen <- (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
$ ActorId -> LevelId -> State -> Bool
memActor ActorId
source LevelId
lid
Bool
targetSeen <- (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
$ ActorId -> LevelId -> State -> Bool
memActor ActorId
target LevelId
lid
if Bool
sourceSeen Bool -> Bool -> Bool
&& Bool
targetSeen then do
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
Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text)))
-> Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text))
forall a b. (a -> b) -> a -> b
$
(MsgClass, Text) -> Maybe (MsgClass, Text)
forall a. a -> Maybe a
Just ( MsgClass
MsgWarning
, [Part] -> Text
makeSentence
[Part -> Part -> Part
MU.SubjectVerbSg Part
spart "collide", "awkwardly with", Part
tpart] )
else Maybe (MsgClass, Text) -> m (Maybe (MsgClass, Text))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MsgClass, Text)
forall a. Maybe a
Nothing
strike :: MonadClientUI m
=> Bool -> ActorId -> ActorId -> ItemId -> CStore -> m ()
strike :: Bool -> ActorId -> ActorId -> ItemId -> CStore -> m ()
strike catch :: Bool
catch source :: ActorId
source target :: ActorId
target iid :: ItemId
iid cstore :: CStore
cstore = Bool -> m () -> m ()
forall a. HasCallStack => Bool -> a -> a
assert (ActorId
source ActorId -> ActorId -> Bool
forall a. Eq a => a -> a -> Bool
/= ActorId
target) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
CCUI{ScreenContent
coscreen :: ScreenContent
coscreen :: CCUI -> ScreenContent
coscreen} <- (SessionUI -> CCUI) -> m CCUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
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
Bool
sourceSeen <- (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
$ ActorId -> LevelId -> State -> Bool
memActor ActorId
source (Actor -> LevelId
blid Actor
tb)
if Bool -> Bool
not Bool
sourceSeen then
LevelId -> Animation -> m ()
forall (m :: * -> *).
MonadClientUI m =>
LevelId -> Animation -> m ()
animate (Actor -> LevelId
blid Actor
tb) (Animation -> m ()) -> Animation -> m ()
forall a b. (a -> b) -> a -> b
$ ScreenContent -> Point -> Animation
subtleHit ScreenContent
coscreen (Actor -> Point
bpos Actor
tb)
else do
Int
hurtMult <- (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
$ ActorId -> ActorId -> State -> Int
armorHurtBonus ActorId
source ActorId
target
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
Skills
sMaxSk <- (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
source
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
Part
spronoun <- ActorId -> m Part
forall (m :: * -> *). MonadClientUI m => ActorId -> m Part
partPronounLeader ActorId
source
Part
tpronoun <- ActorId -> m Part
forall (m :: * -> *). MonadClientUI m => ActorId -> m Part
partPronounLeader ActorId
target
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
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
tb)
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
$ Actor -> CStore -> State -> ItemBag
getBodyStoreBag Actor
sb CStore
cstore
ItemFull
itemFullWeapon <- (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 kitWeapon :: ItemQuant
kitWeapon = ItemQuant -> ItemId -> ItemBag -> ItemQuant
forall k a. Enum k => a -> k -> EnumMap k a -> a
EM.findWithDefault (1, []) ItemId
iid ItemBag
bag
FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
EnumMap FactionId Faction
factionD <- (State -> EnumMap FactionId Faction)
-> m (EnumMap FactionId Faction)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> EnumMap FactionId Faction
sfactionD
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
$ (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
tb) (EnumMap FactionId Faction -> Faction)
-> (State -> EnumMap FactionId Faction) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap FactionId Faction
sfactionD
[(ItemId, ItemFullKit)]
eqpOrgKit <- (State -> [(ItemId, ItemFullKit)]) -> m [(ItemId, ItemFullKit)]
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(ItemId, ItemFullKit)]) -> m [(ItemId, ItemFullKit)])
-> (State -> [(ItemId, ItemFullKit)]) -> m [(ItemId, ItemFullKit)]
forall a b. (a -> b) -> a -> b
$ ActorId -> [CStore] -> State -> [(ItemId, ItemFullKit)]
kitAssocs ActorId
target [CStore
CEqp, CStore
COrgan]
[(ItemId, ItemFullKit)]
orgKit <- (State -> [(ItemId, ItemFullKit)]) -> m [(ItemId, ItemFullKit)]
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(ItemId, ItemFullKit)]) -> m [(ItemId, ItemFullKit)])
-> (State -> [(ItemId, ItemFullKit)]) -> m [(ItemId, ItemFullKit)]
forall a b. (a -> b) -> a -> b
$ ActorId -> [CStore] -> State -> [(ItemId, ItemFullKit)]
kitAssocs ActorId
target [CStore
COrgan]
let notCond :: (a, (ItemFull, b)) -> Bool
notCond (_, (itemFullArmor :: ItemFull
itemFullArmor, _)) =
Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Condition (AspectRecord -> Bool) -> AspectRecord -> Bool
forall a b. (a -> b) -> a -> b
$ ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFullArmor
isOrdinaryCond :: (a, (ItemFull, b)) -> Bool
isOrdinaryCond (_, (itemFullArmor :: ItemFull
itemFullArmor, _)) =
Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Int -> Bool) -> Maybe Int -> Bool
forall a b. (a -> b) -> a -> b
$ GroupName ItemKind -> [(GroupName ItemKind, Int)] -> Maybe Int
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup "condition" ([(GroupName ItemKind, Int)] -> Maybe Int)
-> [(GroupName ItemKind, Int)] -> Maybe Int
forall a b. (a -> b) -> a -> b
$ ItemKind -> [(GroupName ItemKind, Int)]
IK.ifreq (ItemKind -> [(GroupName ItemKind, Int)])
-> ItemKind -> [(GroupName ItemKind, Int)]
forall a b. (a -> b) -> a -> b
$ ItemFull -> ItemKind
itemKind ItemFull
itemFullArmor
rateArmor :: (a, (ItemFull, (Int, b))) -> (Int, (a, ItemFull))
rateArmor (iidArmor :: a
iidArmor, (itemFullArmor :: ItemFull
itemFullArmor, (k :: Int
k, _))) =
( Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
* Skill -> AspectRecord -> Int
IA.getSkill Skill
Ability.SkArmorMelee
(ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFullArmor)
, ( a
iidArmor
, ItemFull
itemFullArmor ) )
abs15 :: (a, b) -> Bool
abs15 (v :: a
v, _) = a -> a
forall a. Num a => a -> a
abs a
v a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= 15
condArmor :: [(Int, (ItemId, ItemFull))]
condArmor = ((Int, (ItemId, ItemFull)) -> Bool)
-> [(Int, (ItemId, ItemFull))] -> [(Int, (ItemId, ItemFull))]
forall a. (a -> Bool) -> [a] -> [a]
filter (Int, (ItemId, ItemFull)) -> Bool
forall a b. (Ord a, Num a) => (a, b) -> Bool
abs15 ([(Int, (ItemId, ItemFull))] -> [(Int, (ItemId, ItemFull))])
-> [(Int, (ItemId, ItemFull))] -> [(Int, (ItemId, ItemFull))]
forall a b. (a -> b) -> a -> b
$ ((ItemId, ItemFullKit) -> (Int, (ItemId, ItemFull)))
-> [(ItemId, ItemFullKit)] -> [(Int, (ItemId, ItemFull))]
forall a b. (a -> b) -> [a] -> [b]
map (ItemId, ItemFullKit) -> (Int, (ItemId, ItemFull))
forall a b. (a, (ItemFull, (Int, b))) -> (Int, (a, ItemFull))
rateArmor ([(ItemId, ItemFullKit)] -> [(Int, (ItemId, ItemFull))])
-> [(ItemId, ItemFullKit)] -> [(Int, (ItemId, ItemFull))]
forall a b. (a -> b) -> a -> b
$ ((ItemId, ItemFullKit) -> Bool)
-> [(ItemId, ItemFullKit)] -> [(ItemId, ItemFullKit)]
forall a. (a -> Bool) -> [a] -> [a]
filter (ItemId, ItemFullKit) -> Bool
forall a b. (a, (ItemFull, b)) -> Bool
isOrdinaryCond [(ItemId, ItemFullKit)]
orgKit
fstGt0 :: (a, b) -> Bool
fstGt0 (v :: a
v, _) = a
v a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> 0
eqpAndOrgArmor :: [(Int, (ItemId, ItemFull))]
eqpAndOrgArmor = ((Int, (ItemId, ItemFull)) -> Bool)
-> [(Int, (ItemId, ItemFull))] -> [(Int, (ItemId, ItemFull))]
forall a. (a -> Bool) -> [a] -> [a]
filter (Int, (ItemId, ItemFull)) -> Bool
forall a b. (Ord a, Num a) => (a, b) -> Bool
fstGt0 ([(Int, (ItemId, ItemFull))] -> [(Int, (ItemId, ItemFull))])
-> [(Int, (ItemId, ItemFull))] -> [(Int, (ItemId, ItemFull))]
forall a b. (a -> b) -> a -> b
$ ((ItemId, ItemFullKit) -> (Int, (ItemId, ItemFull)))
-> [(ItemId, ItemFullKit)] -> [(Int, (ItemId, ItemFull))]
forall a b. (a -> b) -> [a] -> [b]
map (ItemId, ItemFullKit) -> (Int, (ItemId, ItemFull))
forall a b. (a, (ItemFull, (Int, b))) -> (Int, (a, ItemFull))
rateArmor
([(ItemId, ItemFullKit)] -> [(Int, (ItemId, ItemFull))])
-> [(ItemId, ItemFullKit)] -> [(Int, (ItemId, ItemFull))]
forall a b. (a -> b) -> a -> b
$ ((ItemId, ItemFullKit) -> Bool)
-> [(ItemId, ItemFullKit)] -> [(ItemId, ItemFullKit)]
forall a. (a -> Bool) -> [a] -> [a]
filter (ItemId, ItemFullKit) -> Bool
forall a b. (a, (ItemFull, b)) -> Bool
notCond [(ItemId, ItemFullKit)]
eqpOrgKit
Maybe (ItemId, ItemFull)
mblockArmor <- case [(Int, (ItemId, ItemFull))]
eqpAndOrgArmor of
[] -> Maybe (ItemId, ItemFull) -> m (Maybe (ItemId, ItemFull))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (ItemId, ItemFull)
forall a. Maybe a
Nothing
_ -> (ItemId, ItemFull) -> Maybe (ItemId, ItemFull)
forall a. a -> Maybe a
Just
((ItemId, ItemFull) -> Maybe (ItemId, ItemFull))
-> m (ItemId, ItemFull) -> m (Maybe (ItemId, ItemFull))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Rnd (ItemId, ItemFull) -> m (ItemId, ItemFull)
forall (m :: * -> *) a. MonadClientRead m => Rnd a -> m a
rndToActionForget (Frequency (ItemId, ItemFull) -> Rnd (ItemId, ItemFull)
forall a. Show a => Frequency a -> Rnd a
frequency (Frequency (ItemId, ItemFull) -> Rnd (ItemId, ItemFull))
-> Frequency (ItemId, ItemFull) -> Rnd (ItemId, ItemFull)
forall a b. (a -> b) -> a -> b
$ Text -> [(Int, (ItemId, ItemFull))] -> Frequency (ItemId, ItemFull)
forall a. Text -> [(Int, a)] -> Frequency a
toFreq "msg armor" [(Int, (ItemId, ItemFull))]
eqpAndOrgArmor)
let (blockWithWhat :: [Part]
blockWithWhat, blockWithWeapon :: Bool
blockWithWeapon) = case Maybe (ItemId, ItemFull)
mblockArmor of
Nothing -> ([], Bool
False)
Just (iidArmor :: ItemId
iidArmor, itemFullArmor :: ItemFull
itemFullArmor) ->
let (object1 :: Part
object1, object2 :: Part
object2) =
FactionId
-> EnumMap FactionId Faction
-> Time
-> ItemFull
-> ItemQuant
-> (Part, Part)
partItemShortest (Actor -> FactionId
bfid Actor
tb) EnumMap FactionId Faction
factionD Time
localTime
ItemFull
itemFullArmor (1, [])
name :: Part
name | ItemId
iidArmor ItemId -> ItemId -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> ItemId
btrunk Actor
tb = "trunk"
| Bool
otherwise = [Part] -> Part
MU.Phrase [Part
object1, Part
object2]
in ( ["with", Part -> Part -> Part
MU.WownW Part
tpronoun Part
name]
, Dice -> Int
Dice.supDice (ItemKind -> Dice
IK.idamage (ItemKind -> Dice) -> ItemKind -> Dice
forall a b. (a -> b) -> a -> b
$ ItemFull -> ItemKind
itemKind ItemFull
itemFullArmor) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 )
verb :: Part
verb = Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ ItemKind -> Text
IK.iverbHit (ItemKind -> Text) -> ItemKind -> Text
forall a b. (a -> b) -> a -> b
$ ItemFull -> ItemKind
itemKind ItemFull
itemFullWeapon
partItemChoice :: ItemFull -> ItemQuant -> Part
partItemChoice =
if ItemId
iid ItemId -> ItemBag -> Bool
forall k a. Enum k => k -> EnumMap k a -> Bool
`EM.member` Actor -> ItemBag
borgan Actor
sb
then FactionId
-> EnumMap FactionId Faction
-> Part
-> Time
-> ItemFull
-> ItemQuant
-> Part
partItemShortWownW FactionId
side EnumMap FactionId Faction
factionD Part
spronoun Time
localTime
else FactionId
-> EnumMap FactionId Faction
-> Time
-> ItemFull
-> ItemQuant
-> Part
partItemShortAW FactionId
side EnumMap FactionId Faction
factionD Time
localTime
weaponName :: Part
weaponName = ItemFull -> ItemQuant -> Part
partItemChoice ItemFull
itemFullWeapon ItemQuant
kitWeapon
sleepy :: Part
sleepy = if Actor -> Watchfulness
bwatch Actor
tb Watchfulness -> [Watchfulness] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Watchfulness
WSleep, Watchfulness
WWake]
Bool -> Bool -> Bool
&& Part
tpart Part -> Part -> Bool
forall a. Eq a => a -> a -> Bool
/= "you"
Bool -> Bool -> Bool
&& Actor -> Int64
bhp Actor
tb Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> 0
then "the sleepy"
else ""
sHurt :: Int
sHurt = Bool -> Skills -> Skills -> Int
armorHurtCalculation (Actor -> Bool
bproj Actor
sb) Skills
sMaxSk Skills
Ability.zeroSkills
sDamage :: Int64
sDamage =
let dmg :: Int
dmg = Dice -> Int
Dice.supDice (Dice -> Int) -> Dice -> Int
forall a b. (a -> b) -> a -> b
$ ItemKind -> Dice
IK.idamage (ItemKind -> Dice) -> ItemKind -> Dice
forall a b. (a -> b) -> a -> b
$ ItemFull -> ItemKind
itemKind ItemFull
itemFullWeapon
rawDeltaHP :: Int64
rawDeltaHP = Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sHurt Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int -> Int64
xM Int
dmg Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`divUp` 100
speedDeltaHP :: Int64
speedDeltaHP = case Actor -> Maybe ([Vector], Speed)
btrajectory Actor
sb of
Just (_, speed :: Speed
speed) | Actor -> Bool
bproj Actor
sb ->
- Int64 -> Speed -> Int64
modifyDamageBySpeed Int64
rawDeltaHP Speed
speed
_ -> - Int64
rawDeltaHP
in Int64 -> Int64 -> Int64
forall a. Ord a => a -> a -> a
min 0 Int64
speedDeltaHP
deadliness :: Int64
deadliness = 1000 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* (- Int64
sDamage) Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`div` Int64 -> Int64 -> Int64
forall a. Ord a => a -> a -> a
max 1 (Actor -> Int64
bhp Actor
tb)
strongly :: Part
strongly
| Int64
deadliness Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= 10000 = "artfully"
| Int64
deadliness Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= 5000 = "madly"
| Int64
deadliness Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= 2000 = "mercilessly"
| Int64
deadliness Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= 1000 = "murderously"
| Int64
deadliness Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= 700 = "devastatingly"
| Int64
deadliness Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= 500 = "vehemently"
| Int64
deadliness Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= 400 = "forcefully"
| Int64
deadliness Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= 350 = "sturdily"
| Int64
deadliness Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= 300 = "accurately"
| Int64
deadliness Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= 20 = ""
| Int64
deadliness Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= 10 = "cautiously"
| Int64
deadliness Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= 5 = "guardedly"
| Int64
deadliness Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= 3 = "hesitantly"
| Int64
deadliness Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= 2 = "clumsily"
| Int64
deadliness Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= 1 = "haltingly"
| Bool
otherwise = "feebly"
blockHowWell :: Part
blockHowWell
| Int
hurtMult Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 90 = "incompetently"
| Int
hurtMult Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 80 = "too late"
| Int
hurtMult Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 70 = "too slowly"
| Int
hurtMult Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 20 = if | Int64
deadliness Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= 2000 -> "marginally"
| Int64
deadliness Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= 1000 -> "partially"
| Int64
deadliness Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= 100 -> "partly"
| Int64
deadliness Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= 50 -> "to an extent"
| Int64
deadliness Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= 20 -> "to a large extent"
| Int64
deadliness Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= 5 -> "for the major part"
| Bool
otherwise -> "for the most part"
| Int
hurtMult Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1 = if | Actor -> Bool
actorWaits Actor
tb -> "doggedly"
| Int
hurtMult Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 10 -> "nonchalantly"
| Bool
otherwise -> "bemusedly"
| Bool
otherwise = "almost completely"
blockPhrase :: Part
blockPhrase =
let (subjectBlock :: Part
subjectBlock, verbBlock :: Part
verbBlock) =
if | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Actor -> Bool
bproj Actor
sb ->
(Part
tpronoun, if Bool
blockWithWeapon
then "parry"
else "block")
| Part
tpronoun Part -> Part -> Bool
forall a. Eq a => a -> a -> Bool
== "it"
Bool -> Bool -> Bool
|| Bool
projectileHitsWeakly Bool -> Bool -> Bool
&& Part
tpronoun Part -> Part -> Bool
forall a. Eq a => a -> a -> Bool
/= "you" ->
(ActorUI -> Part
partActor ActorUI
tbUI, if Actor -> Bool
actorWaits Actor
tb
then "deflect it"
else "fend it off")
| Bool
otherwise ->
(Part
tpronoun, if Actor -> Bool
actorWaits Actor
tb
then "avert it"
else "ward it off")
in Part -> Part -> Part
MU.SubjectVerbSg Part
subjectBlock Part
verbBlock
surprisinglyGoodDefense :: Bool
surprisinglyGoodDefense = Int64
deadliness Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= 20 Bool -> Bool -> Bool
&& Int
hurtMult Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 70
surprisinglyBadDefense :: Bool
surprisinglyBadDefense = Int64
deadliness Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< 20 Bool -> Bool -> Bool
&& Int
hurtMult Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 70
yetButAnd :: Text
yetButAnd
| Bool
surprisinglyGoodDefense = ", but"
| Bool
surprisinglyBadDefense = ", yet"
| Bool
otherwise = " and"
projectileHitsWeakly :: Bool
projectileHitsWeakly = Actor -> Bool
bproj Actor
sb Bool -> Bool -> Bool
&& Int64
deadliness Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< 20
msgArmor :: Text
msgArmor = if Bool -> Bool
not Bool
projectileHitsWeakly
Bool -> Bool -> Bool
&& Int
hurtMult Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 90
Bool -> Bool -> Bool
&& ([(Int, (ItemId, ItemFull))] -> Bool
forall a. [a] -> Bool
null [(Int, (ItemId, ItemFull))]
condArmor Bool -> Bool -> Bool
|| Int64
deadliness Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< 100)
then ""
else Text
yetButAnd
Text -> Text -> Text
<+> [Part] -> Text
makePhrase ([Part
blockPhrase, Part
blockHowWell]
[Part] -> [Part] -> [Part]
forall a. [a] -> [a] -> [a]
++ [Part]
blockWithWhat)
ps :: (Point, Point)
ps = (Actor -> Point
bpos Actor
tb, Actor -> Point
bpos Actor
sb)
basicAnim :: Animation
basicAnim
| Int
hurtMult Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 70 = ScreenContent -> (Point, Point) -> Color -> Color -> Animation
twirlSplash ScreenContent
coscreen (Point, Point)
ps Color
Color.BrRed Color
Color.Red
| Int
hurtMult Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1 = ScreenContent -> (Point, Point) -> Color -> Color -> Animation
blockHit ScreenContent
coscreen (Point, Point)
ps Color
Color.BrRed Color
Color.Red
| Bool
otherwise = ScreenContent -> (Point, Point) -> Animation
blockMiss ScreenContent
coscreen (Point, Point)
ps
targetIsFoe :: Bool
targetIsFoe = Actor -> FactionId
bfid Actor
sb FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side
Bool -> Bool -> Bool
&& FactionId -> Faction -> FactionId -> Bool
isFoe (Actor -> FactionId
bfid Actor
tb) Faction
tfact FactionId
side
targetIsFriend :: Bool
targetIsFriend = FactionId -> Faction -> FactionId -> Bool
isFriend (Actor -> FactionId
bfid Actor
tb) Faction
tfact FactionId
side
msgClassMelee :: MsgClass
msgClassMelee = if Bool
targetIsFriend then MsgClass
MsgMeleeUs else MsgClass
MsgMelee
msgClassRanged :: MsgClass
msgClassRanged = if Bool
targetIsFriend then MsgClass
MsgRangedUs else MsgClass
MsgRanged
if | Bool
catch -> do
let msg :: Text
msg = [Part] -> Text
makeSentence
[Part -> Part -> Part
MU.SubjectVerbSg Part
spart "catch", Part
tpart, "skillfully"]
MsgClass -> Text -> m ()
forall (m :: * -> *). MonadClientUI m => MsgClass -> Text -> m ()
msgAdd MsgClass
MsgVeryRare Text
msg
LevelId -> Animation -> m ()
forall (m :: * -> *).
MonadClientUI m =>
LevelId -> Animation -> m ()
animate (Actor -> LevelId
blid Actor
tb) (Animation -> m ()) -> Animation -> m ()
forall a b. (a -> b) -> a -> b
$ ScreenContent -> (Point, Point) -> Color -> Color -> Animation
blockHit ScreenContent
coscreen (Point, Point)
ps Color
Color.BrGreen Color
Color.Green
| Bool -> Bool
not (Time -> ItemFull -> ItemQuant -> Bool
hasCharge Time
localTime ItemFull
itemFullWeapon ItemQuant
kitWeapon) -> do
let msg :: Text
msg = if Actor -> Bool
bproj Actor
sb
then [Part] -> Text
makePhrase
[Part -> Part
MU.Capitalize (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ Part -> Part -> Part
MU.SubjectVerbSg Part
spart "connect"]
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ", but it may be completely discharged."
else [Part] -> Text
makePhrase
[ Part -> Part
MU.Capitalize (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ Part -> Part -> Part
MU.SubjectVerbSg Part
spart "try"
, "to", Part
verb, Part
tpart, "with"
, Part
weaponName ]
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ", but it may be not readied yet."
MsgClass -> Text -> m ()
forall (m :: * -> *). MonadClientUI m => MsgClass -> Text -> m ()
msgAdd MsgClass
MsgVeryRare Text
msg
| Actor -> Bool
bproj Actor
sb Bool -> Bool -> Bool
&& Actor -> Bool
bproj Actor
tb -> do
MsgClass -> Text -> m ()
forall (m :: * -> *). MonadClientUI m => MsgClass -> Text -> m ()
msgAdd MsgClass
MsgVeryRare (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
[Part] -> Text
makeSentence [Part -> Part -> Part
MU.SubjectVerbSg Part
spart "intercept", Part
tpart]
LevelId -> Animation -> m ()
forall (m :: * -> *).
MonadClientUI m =>
LevelId -> Animation -> m ()
animate (Actor -> LevelId
blid Actor
tb) (Animation -> m ()) -> Animation -> m ()
forall a b. (a -> b) -> a -> b
$ ScreenContent -> (Point, Point) -> Color -> Color -> Animation
blockHit ScreenContent
coscreen (Point, Point)
ps Color
Color.BrBlue Color
Color.Blue
| ItemKind -> Dice
IK.idamage (ItemFull -> ItemKind
itemKind ItemFull
itemFullWeapon) Dice -> Dice -> Bool
forall a. Eq a => a -> a -> Bool
== 0 -> do
let adverb :: Part
adverb = if Actor -> Bool
bproj Actor
sb then "lightly" else "delicately"
msg :: Text
msg = [Part] -> Text
makeSentence ([Part] -> Text) -> [Part] -> Text
forall a b. (a -> b) -> a -> b
$
[Part -> Part -> Part
MU.SubjectVerbSg Part
spart Part
verb, Part
tpart, Part
adverb]
[Part] -> [Part] -> [Part]
forall a. [a] -> [a] -> [a]
++ if Actor -> Bool
bproj Actor
sb then [] else ["with", Part
weaponName]
MsgClass -> Text -> m ()
forall (m :: * -> *). MonadClientUI m => MsgClass -> Text -> m ()
msgAdd MsgClass
msgClassMelee Text
msg
LevelId -> Animation -> m ()
forall (m :: * -> *).
MonadClientUI m =>
LevelId -> Animation -> m ()
animate (Actor -> LevelId
blid Actor
tb) (Animation -> m ()) -> Animation -> m ()
forall a b. (a -> b) -> a -> b
$ ScreenContent -> Point -> Animation
subtleHit ScreenContent
coscreen (Actor -> Point
bpos Actor
sb)
| Actor -> Bool
bproj Actor
sb -> do
let msgRangedPowerful :: MsgClass
msgRangedPowerful | Bool
targetIsFoe = MsgClass
MsgRangedPowerfulWe
| Bool
targetIsFriend = MsgClass
MsgRangedPowerfulUs
| Bool
otherwise = MsgClass
msgClassRanged
(attackParts :: [Part]
attackParts, msgRanged :: MsgClass
msgRanged)
| Bool
projectileHitsWeakly =
( [Part -> Part -> Part
MU.SubjectVerbSg Part
spart "connect"]
, MsgClass
msgClassRanged )
| Int64
deadliness Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= 300 =
( [Part -> Part -> Part
MU.SubjectVerbSg Part
spart Part
verb, Part
tpart, "powerfully"]
, if Bool
targetIsFriend Bool -> Bool -> Bool
|| Int64
deadliness Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= 700
then MsgClass
msgRangedPowerful
else MsgClass
msgClassRanged )
| Bool
otherwise =
( [Part -> Part -> Part
MU.SubjectVerbSg Part
spart Part
verb, Part
tpart]
, MsgClass
msgClassRanged )
MsgClass -> Text -> m ()
forall (m :: * -> *). MonadClientUI m => MsgClass -> Text -> m ()
msgAdd MsgClass
msgRanged (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ [Part] -> Text
makePhrase [Part -> Part
MU.Capitalize (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ [Part] -> Part
MU.Phrase [Part]
attackParts]
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
msgArmor Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "."
LevelId -> Animation -> m ()
forall (m :: * -> *).
MonadClientUI m =>
LevelId -> Animation -> m ()
animate (Actor -> LevelId
blid Actor
tb) Animation
basicAnim
| Actor -> Bool
bproj Actor
tb -> do
let attackParts :: [Part]
attackParts =
[Part -> Part -> Part
MU.SubjectVerbSg Part
spart Part
verb, Part
tpart, "with", Part
weaponName]
MsgClass -> Text -> m ()
forall (m :: * -> *). MonadClientUI m => MsgClass -> Text -> m ()
msgAdd MsgClass
MsgMelee (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ [Part] -> Text
makeSentence [Part]
attackParts
LevelId -> Animation -> m ()
forall (m :: * -> *).
MonadClientUI m =>
LevelId -> Animation -> m ()
animate (Actor -> LevelId
blid Actor
tb) Animation
basicAnim
| Bool
otherwise -> do
let msgMeleeInteresting :: MsgClass
msgMeleeInteresting | Bool
targetIsFoe = MsgClass
MsgMeleeInterestingWe
| Bool
targetIsFriend = MsgClass
MsgMeleeInterestingUs
| Bool
otherwise = MsgClass
msgClassMelee
msgMeleePowerful :: MsgClass
msgMeleePowerful | Bool
targetIsFoe = MsgClass
MsgMeleePowerfulWe
| Bool
targetIsFriend = MsgClass
MsgMeleePowerfulUs
| Bool
otherwise = MsgClass
msgClassMelee
attackParts :: [Part]
attackParts =
[ Part -> Part -> Part
MU.SubjectVerbSg Part
spart Part
verb, Part
sleepy, Part
tpart, Part
strongly
, "with", Part
weaponName ]
(tmpInfluenceBlurb :: Text
tmpInfluenceBlurb, msgClassInfluence :: MsgClass
msgClassInfluence) =
if [(Int, (ItemId, ItemFull))] -> Bool
forall a. [a] -> Bool
null [(Int, (ItemId, ItemFull))]
condArmor Bool -> Bool -> Bool
|| Text -> Bool
T.null Text
msgArmor
then ("", MsgClass
msgClassMelee)
else
let (armor :: Int
armor, (_, itemFullArmor :: ItemFull
itemFullArmor)) =
((Int, (ItemId, ItemFull))
-> (Int, (ItemId, ItemFull)) -> Ordering)
-> [(Int, (ItemId, ItemFull))] -> (Int, (ItemId, ItemFull))
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy (((Int, (ItemId, ItemFull)) -> Int)
-> (Int, (ItemId, ItemFull))
-> (Int, (ItemId, ItemFull))
-> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
Ord.comparing (((Int, (ItemId, ItemFull)) -> Int)
-> (Int, (ItemId, ItemFull))
-> (Int, (ItemId, ItemFull))
-> Ordering)
-> ((Int, (ItemId, ItemFull)) -> Int)
-> (Int, (ItemId, ItemFull))
-> (Int, (ItemId, ItemFull))
-> Ordering
forall a b. (a -> b) -> a -> b
$ Int -> Int
forall a. Num a => a -> a
abs (Int -> Int)
-> ((Int, (ItemId, ItemFull)) -> Int)
-> (Int, (ItemId, ItemFull))
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, (ItemId, ItemFull)) -> Int
forall a b. (a, b) -> a
fst) [(Int, (ItemId, ItemFull))]
condArmor
(object1 :: Part
object1, object2 :: Part
object2) =
FactionId
-> EnumMap FactionId Faction
-> Time
-> ItemFull
-> ItemQuant
-> (Part, Part)
partItemShortest (Actor -> FactionId
bfid Actor
tb) EnumMap FactionId Faction
factionD Time
localTime
ItemFull
itemFullArmor (1, [])
name :: Text
name = [Part] -> Text
makePhrase [Part
object1, Part
object2]
msgText :: Text
msgText =
if Int
hurtMult Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 20 Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
surprisinglyGoodDefense
Bool -> Bool -> Bool
|| Bool
surprisinglyBadDefense
then (if Int
armor Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= -15
then ", due to being"
else Bool -> Text -> Text
forall a. HasCallStack => Bool -> a -> a
assert (Int
armor Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 15) ", regardless of being")
Text -> Text -> Text
<+> Text
name
else (if Int
armor Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 15
then ", thanks to being"
else Bool -> Text -> Text
forall a. HasCallStack => Bool -> a -> a
assert (Int
armor Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= -15) ", despite being")
Text -> Text -> Text
<+> Text
name
in (Text
msgText, MsgClass
msgMeleeInteresting)
msgClass :: MsgClass
msgClass = if Bool
targetIsFriend Bool -> Bool -> Bool
&& Int64
deadliness Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= 300
Bool -> Bool -> Bool
|| Int64
deadliness Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= 2000
then MsgClass
msgMeleePowerful
else MsgClass
msgClassInfluence
MsgClass -> Text -> m ()
forall (m :: * -> *). MonadClientUI m => MsgClass -> Text -> m ()
msgAdd MsgClass
msgClass (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ [Part] -> Text
makePhrase [Part -> Part
MU.Capitalize (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ [Part] -> Part
MU.Phrase [Part]
attackParts]
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
msgArmor Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
tmpInfluenceBlurb Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "."
LevelId -> Animation -> m ()
forall (m :: * -> *).
MonadClientUI m =>
LevelId -> Animation -> m ()
animate (Actor -> LevelId
blid Actor
tb) Animation
basicAnim