{-# LANGUAGE TupleSections #-}
-- | Server operations common to many modules.
module Game.LambdaHack.Server.CommonM
  ( revealItems, moveStores, generalMoveItem
  , deduceQuits, deduceKilled, electLeader, setFreshLeader
  , updatePer, recomputeCachePer, projectFail
  , addActorFromGroup, registerActor, discoverIfMinorEffects
  , pickWeaponServer, currentSkillsServer, allGroupItems
  , addCondition, removeConditionSingle, addSleep, removeSleepSingle
  , addKillToAnalytics
#ifdef EXPOSE_INTERNAL
    -- * Internal operations
  , containerMoveItem, quitF, keepArenaFact, anyActorsAlive, projectBla
  , addProjectile, addActorIid, getCacheLucid, getCacheTotal
#endif
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import qualified Data.EnumMap.Strict as EM
import qualified Data.Ord as Ord
import           Data.Ratio

import           Game.LambdaHack.Atomic
import           Game.LambdaHack.Client (ClientOptions (..))
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.Perception
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.ItemKind (ItemKind)
import qualified Game.LambdaHack.Content.ItemKind as IK
import           Game.LambdaHack.Content.ModeKind
import           Game.LambdaHack.Content.RuleKind
import           Game.LambdaHack.Common.Point
import           Game.LambdaHack.Core.Random
import qualified Game.LambdaHack.Definition.Ability as Ability
import           Game.LambdaHack.Definition.Defs
import           Game.LambdaHack.Server.Fov
import           Game.LambdaHack.Server.ItemM
import           Game.LambdaHack.Server.ItemRev
import           Game.LambdaHack.Server.MonadServer
import           Game.LambdaHack.Server.ServerOptions
import           Game.LambdaHack.Server.State

revealItems :: MonadServerAtomic m => FactionId -> m ()
revealItems :: FactionId -> m ()
revealItems fid :: FactionId
fid = do
  COps{ContentData ItemKind
coitem :: COps -> ContentData ItemKind
coitem :: ContentData ItemKind
coitem} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  ServerOptions{ClientOptions
sclientOptions :: ServerOptions -> ClientOptions
sclientOptions :: ClientOptions
sclientOptions} <- (StateServer -> ServerOptions) -> m ServerOptions
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> ServerOptions
soptions
  DiscoveryAspect
discoAspect <- (State -> DiscoveryAspect) -> m DiscoveryAspect
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> DiscoveryAspect
sdiscoAspect
  let discover :: ActorId -> CStore -> ItemId -> ItemQuant -> m ()
discover aid :: ActorId
aid store :: CStore
store iid :: ItemId
iid _ = do
        ContentId ItemKind
itemKindId <- (State -> ContentId ItemKind) -> m (ContentId ItemKind)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ContentId ItemKind) -> m (ContentId ItemKind))
-> (State -> ContentId ItemKind) -> m (ContentId ItemKind)
forall a b. (a -> b) -> a -> b
$ ItemId -> State -> ContentId ItemKind
getIidKindIdServer ItemId
iid
        let arItem :: AspectRecord
arItem = DiscoveryAspect
discoAspect DiscoveryAspect -> ItemId -> AspectRecord
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ItemId
iid
            c :: Container
c = ActorId -> CStore -> Container
CActor ActorId
aid CStore
store
            itemKind :: ItemKind
itemKind = ContentData ItemKind -> ContentId ItemKind -> ItemKind
forall a. ContentData a -> ContentId a -> a
okind ContentData ItemKind
coitem ContentId ItemKind
itemKindId
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ItemKind -> Bool
IA.isHumanTrinket ItemKind
itemKind) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$  -- a hack
          UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ Container
-> ItemId -> ContentId ItemKind -> AspectRecord -> UpdAtomic
UpdDiscover Container
c ItemId
iid ContentId ItemKind
itemKindId AspectRecord
arItem
      f :: (ActorId, Actor) -> m ()
f (aid :: ActorId
aid, b :: Actor
b) =
        -- CSha is IDed for each actor of each faction, which is fine,
        -- even though it may introduce a slight lag at gameover.
        m (m ()) -> m ()
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (m (m ()) -> m ()) -> m (m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ (State -> m ()) -> m (m ())
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> m ()) -> m (m ())) -> (State -> m ()) -> m (m ())
forall a b. (a -> b) -> a -> b
$ (CStore -> ItemId -> ItemQuant -> m ()) -> Actor -> State -> m ()
forall (m :: * -> *) a.
Monad m =>
(CStore -> ItemId -> ItemQuant -> m a) -> Actor -> State -> m ()
mapActorItems_ (ActorId -> CStore -> ItemId -> ItemQuant -> m ()
discover ActorId
aid) Actor
b
  -- Don't ID projectiles, their items are not really owned by the party.
  [(ActorId, Actor)]
aids <- (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
fid
  ((ActorId, Actor) -> m ()) -> [(ActorId, Actor)] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (ActorId, Actor) -> m ()
f [(ActorId, Actor)]
aids
  Dungeon
dungeon <- (State -> Dungeon) -> m Dungeon
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> Dungeon
sdungeon
  let minLid :: LevelId
minLid = (LevelId, Level) -> LevelId
forall a b. (a, b) -> a
fst ((LevelId, Level) -> LevelId) -> (LevelId, Level) -> LevelId
forall a b. (a -> b) -> a -> b
$ ((LevelId, Level) -> (LevelId, Level) -> Ordering)
-> [(LevelId, Level)] -> (LevelId, Level)
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
minimumBy (((LevelId, Level) -> AbsDepth)
-> (LevelId, Level) -> (LevelId, Level) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
Ord.comparing (Level -> AbsDepth
ldepth (Level -> AbsDepth)
-> ((LevelId, Level) -> Level) -> (LevelId, Level) -> AbsDepth
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LevelId, Level) -> Level
forall a b. (a, b) -> b
snd))
                   ([(LevelId, Level)] -> (LevelId, Level))
-> [(LevelId, Level)] -> (LevelId, Level)
forall a b. (a -> b) -> a -> b
$ Dungeon -> [(LevelId, Level)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs Dungeon
dungeon
      discoverSample :: ItemId -> m ()
discoverSample iid :: ItemId
iid = do
        ContentId ItemKind
itemKindId <- (State -> ContentId ItemKind) -> m (ContentId ItemKind)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ContentId ItemKind) -> m (ContentId ItemKind))
-> (State -> ContentId ItemKind) -> m (ContentId ItemKind)
forall a b. (a -> b) -> a -> b
$ ItemId -> State -> ContentId ItemKind
getIidKindIdServer ItemId
iid
        let arItem :: AspectRecord
arItem = DiscoveryAspect
discoAspect DiscoveryAspect -> ItemId -> AspectRecord
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ItemId
iid
            cdummy :: Container
cdummy = FactionId -> LevelId -> Point -> Container
CTrunk FactionId
fid LevelId
minLid Point
originPoint  -- only @fid@ matters here
            itemKind :: ItemKind
itemKind = ContentData ItemKind -> ContentId ItemKind -> ItemKind
forall a. ContentData a -> ContentId a -> a
okind ContentData ItemKind
coitem ContentId ItemKind
itemKindId
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ItemKind -> Bool
IA.isHumanTrinket ItemKind
itemKind) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$  -- a hack
          UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ Container
-> ItemId -> ContentId ItemKind -> AspectRecord -> UpdAtomic
UpdDiscover Container
cdummy ItemId
iid ContentId ItemKind
itemKindId AspectRecord
arItem
  GenerationAnalytics
generationAn <- (StateServer -> GenerationAnalytics) -> m GenerationAnalytics
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> GenerationAnalytics
sgenerationAn
  ItemId -> ContentId ItemKind
getKindId <- (State -> ItemId -> ContentId ItemKind)
-> m (ItemId -> ContentId ItemKind)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemId -> ContentId ItemKind)
 -> m (ItemId -> ContentId ItemKind))
-> (State -> ItemId -> ContentId ItemKind)
-> m (ItemId -> ContentId ItemKind)
forall a b. (a -> b) -> a -> b
$ (ItemId -> State -> ContentId ItemKind)
-> State -> ItemId -> ContentId ItemKind
forall a b c. (a -> b -> c) -> b -> a -> c
flip ItemId -> State -> ContentId ItemKind
getIidKindIdServer
  let kindsEqual :: ItemId -> ItemId -> Bool
kindsEqual iid :: ItemId
iid iid2 :: ItemId
iid2 = ItemId -> ContentId ItemKind
getKindId ItemId
iid ContentId ItemKind -> ContentId ItemKind -> Bool
forall a. Eq a => a -> a -> Bool
== ItemId -> ContentId ItemKind
getKindId ItemId
iid2 Bool -> Bool -> Bool
&& ItemId
iid ItemId -> ItemId -> Bool
forall a. Eq a => a -> a -> Bool
/= ItemId
iid2
      nonDupSample :: EnumMap ItemId Int -> ItemId -> Int -> Bool
nonDupSample em :: EnumMap ItemId Int
em iid :: ItemId
iid 0 = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (ItemId -> Bool) -> [ItemId] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (ItemId -> ItemId -> Bool
kindsEqual ItemId
iid) ([ItemId] -> Bool) -> [ItemId] -> Bool
forall a b. (a -> b) -> a -> b
$ EnumMap ItemId Int -> [ItemId]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys EnumMap ItemId Int
em
      nonDupSample _ _ _ = Bool
True
      nonDupGen :: GenerationAnalytics
nonDupGen = (EnumMap ItemId Int -> EnumMap ItemId Int)
-> GenerationAnalytics -> GenerationAnalytics
forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
EM.map (\em :: EnumMap ItemId Int
em -> (ItemId -> Int -> Bool) -> EnumMap ItemId Int -> EnumMap ItemId Int
forall k a.
Enum k =>
(k -> a -> Bool) -> EnumMap k a -> EnumMap k a
EM.filterWithKey (EnumMap ItemId Int -> ItemId -> Int -> Bool
nonDupSample EnumMap ItemId Int
em) EnumMap ItemId Int
em)
                         GenerationAnalytics
generationAn
  -- Remove samples that are supplanted by real items.
  -- If there are mutliple UI factions, the second run will be vacuus,
  -- but it's important to do that before the first try to identify things
  -- to prevent spam from identifying samples that are not needed.
  (StateServer -> StateServer) -> m ()
forall (m :: * -> *).
MonadServer m =>
(StateServer -> StateServer) -> m ()
modifyServer ((StateServer -> StateServer) -> m ())
-> (StateServer -> StateServer) -> m ()
forall a b. (a -> b) -> a -> b
$ \ser :: StateServer
ser -> StateServer
ser {sgenerationAn :: GenerationAnalytics
sgenerationAn = GenerationAnalytics
nonDupGen}
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ClientOptions -> Bool
sexposeActors ClientOptions
sclientOptions) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
    -- Few, if any, need ID, but we can't rule out unusual content.
    (ItemId -> m ()) -> [ItemId] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ItemId -> m ()
discoverSample ([ItemId] -> m ()) -> [ItemId] -> m ()
forall a b. (a -> b) -> a -> b
$ EnumMap ItemId Int -> [ItemId]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys (EnumMap ItemId Int -> [ItemId]) -> EnumMap ItemId Int -> [ItemId]
forall a b. (a -> b) -> a -> b
$ GenerationAnalytics
nonDupGen GenerationAnalytics -> SLore -> EnumMap ItemId Int
forall k a. Enum k => EnumMap k a -> k -> a
EM.! SLore
STrunk
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ClientOptions -> Bool
sexposeItems ClientOptions
sclientOptions) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
    (ItemId -> m ()) -> [ItemId] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ItemId -> m ()
discoverSample ([ItemId] -> m ()) -> [ItemId] -> m ()
forall a b. (a -> b) -> a -> b
$ EnumMap ItemId Int -> [ItemId]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys (EnumMap ItemId Int -> [ItemId]) -> EnumMap ItemId Int -> [ItemId]
forall a b. (a -> b) -> a -> b
$ GenerationAnalytics
nonDupGen GenerationAnalytics -> SLore -> EnumMap ItemId Int
forall k a. Enum k => EnumMap k a -> k -> a
EM.! SLore
SItem
  (ItemId -> m ()) -> [ItemId] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ItemId -> m ()
discoverSample ([ItemId] -> m ()) -> [ItemId] -> m ()
forall a b. (a -> b) -> a -> b
$ EnumMap ItemId Int -> [ItemId]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys (EnumMap ItemId Int -> [ItemId]) -> EnumMap ItemId Int -> [ItemId]
forall a b. (a -> b) -> a -> b
$ GenerationAnalytics
nonDupGen GenerationAnalytics -> SLore -> EnumMap ItemId Int
forall k a. Enum k => EnumMap k a -> k -> a
EM.! SLore
SEmbed
  (ItemId -> m ()) -> [ItemId] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ItemId -> m ()
discoverSample ([ItemId] -> m ()) -> [ItemId] -> m ()
forall a b. (a -> b) -> a -> b
$ EnumMap ItemId Int -> [ItemId]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys (EnumMap ItemId Int -> [ItemId]) -> EnumMap ItemId Int -> [ItemId]
forall a b. (a -> b) -> a -> b
$ GenerationAnalytics
nonDupGen GenerationAnalytics -> SLore -> EnumMap ItemId Int
forall k a. Enum k => EnumMap k a -> k -> a
EM.! SLore
SOrgan
  (ItemId -> m ()) -> [ItemId] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ItemId -> m ()
discoverSample ([ItemId] -> m ()) -> [ItemId] -> m ()
forall a b. (a -> b) -> a -> b
$ EnumMap ItemId Int -> [ItemId]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys (EnumMap ItemId Int -> [ItemId]) -> EnumMap ItemId Int -> [ItemId]
forall a b. (a -> b) -> a -> b
$ GenerationAnalytics
nonDupGen GenerationAnalytics -> SLore -> EnumMap ItemId Int
forall k a. Enum k => EnumMap k a -> k -> a
EM.! SLore
SCondition
  (ItemId -> m ()) -> [ItemId] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ItemId -> m ()
discoverSample ([ItemId] -> m ()) -> [ItemId] -> m ()
forall a b. (a -> b) -> a -> b
$ EnumMap ItemId Int -> [ItemId]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys (EnumMap ItemId Int -> [ItemId]) -> EnumMap ItemId Int -> [ItemId]
forall a b. (a -> b) -> a -> b
$ GenerationAnalytics
nonDupGen GenerationAnalytics -> SLore -> EnumMap ItemId Int
forall k a. Enum k => EnumMap k a -> k -> a
EM.! SLore
SBlast

moveStores :: MonadServerAtomic m
           => Bool -> ActorId -> CStore -> CStore -> m ()
moveStores :: Bool -> ActorId -> CStore -> CStore -> m ()
moveStores verbose :: Bool
verbose aid :: ActorId
aid fromStore :: CStore
fromStore toStore :: CStore
toStore = 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
  let g :: ItemId -> ItemQuant -> m ()
g iid :: ItemId
iid (k :: Int
k, _) = do
        [UpdAtomic]
move <- Bool -> ItemId -> Int -> Container -> Container -> m [UpdAtomic]
forall (m :: * -> *).
MonadStateRead m =>
Bool -> ItemId -> Int -> Container -> Container -> m [UpdAtomic]
generalMoveItem Bool
verbose ItemId
iid Int
k (ActorId -> CStore -> Container
CActor ActorId
aid CStore
fromStore)
                                              (ActorId -> CStore -> Container
CActor ActorId
aid CStore
toStore)
        (UpdAtomic -> m ()) -> [UpdAtomic] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic [UpdAtomic]
move
  CStore -> (ItemId -> ItemQuant -> m ()) -> Actor -> m ()
forall (m :: * -> *) a.
MonadServer m =>
CStore -> (ItemId -> ItemQuant -> m a) -> Actor -> m ()
mapActorCStore_ CStore
fromStore ItemId -> ItemQuant -> m ()
g Actor
b

-- | Generate the atomic updates that jointly perform a given item move.
generalMoveItem :: MonadStateRead m
                => Bool -> ItemId -> Int -> Container -> Container
                -> m [UpdAtomic]
generalMoveItem :: Bool -> ItemId -> Int -> Container -> Container -> m [UpdAtomic]
generalMoveItem _ iid :: ItemId
iid k :: Int
k (CActor aid1 :: ActorId
aid1 cstore1 :: CStore
cstore1) (CActor aid2 :: ActorId
aid2 cstore2 :: CStore
cstore2)
  | ActorId
aid1 ActorId -> ActorId -> Bool
forall a. Eq a => a -> a -> Bool
== ActorId
aid2 Bool -> Bool -> Bool
&& CStore
cstore1 CStore -> CStore -> Bool
forall a. Eq a => a -> a -> Bool
/= CStore
CSha Bool -> Bool -> Bool
&& CStore
cstore2 CStore -> CStore -> Bool
forall a. Eq a => a -> a -> Bool
/= CStore
CSha
  = [UpdAtomic] -> m [UpdAtomic]
forall (m :: * -> *) a. Monad m => a -> m a
return [ItemId -> Int -> ActorId -> CStore -> CStore -> UpdAtomic
UpdMoveItem ItemId
iid Int
k ActorId
aid1 CStore
cstore1 CStore
cstore2]
generalMoveItem verbose :: Bool
verbose iid :: ItemId
iid k :: Int
k c1 :: Container
c1 c2 :: Container
c2 = Bool -> ItemId -> Int -> Container -> Container -> m [UpdAtomic]
forall (m :: * -> *).
MonadStateRead m =>
Bool -> ItemId -> Int -> Container -> Container -> m [UpdAtomic]
containerMoveItem Bool
verbose ItemId
iid Int
k Container
c1 Container
c2

containerMoveItem :: MonadStateRead m
                  => Bool -> ItemId -> Int -> Container -> Container
                  -> m [UpdAtomic]
containerMoveItem :: Bool -> ItemId -> Int -> Container -> Container -> m [UpdAtomic]
containerMoveItem verbose :: Bool
verbose iid :: ItemId
iid k :: Int
k c1 :: Container
c1 c2 :: Container
c2 = 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
c1
  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 [UpdAtomic]
forall a. HasCallStack => [Char] -> a
error ([Char] -> m [UpdAtomic]) -> [Char] -> m [UpdAtomic]
forall a b. (a -> b) -> a -> b
$ "" [Char] -> (ItemId, Int, Container, Container) -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` (ItemId
iid, Int
k, Container
c1, Container
c2)
    Just (_, it :: ItemTimer
it) -> do
      Item
item <- (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
iid
      [UpdAtomic] -> m [UpdAtomic]
forall (m :: * -> *) a. Monad m => a -> m a
return [ Bool -> ItemId -> Item -> ItemQuant -> Container -> UpdAtomic
UpdLoseItem Bool
verbose ItemId
iid Item
item (Int
k, Int -> ItemTimer -> ItemTimer
forall a. Int -> [a] -> [a]
take Int
k ItemTimer
it) Container
c1
             , Bool -> ItemId -> Item -> ItemQuant -> Container -> UpdAtomic
UpdSpotItem Bool
verbose ItemId
iid Item
item (Int
k, Int -> ItemTimer -> ItemTimer
forall a. Int -> [a] -> [a]
take Int
k ItemTimer
it) Container
c2 ]

quitF :: MonadServerAtomic m => Status -> FactionId -> m ()
quitF :: Status -> FactionId -> m ()
quitF status :: Status
status fid :: FactionId
fid = 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
  let oldSt :: Maybe Status
oldSt = Faction -> Maybe Status
gquit Faction
fact
  -- Note that it's the _old_ status that we check here.
  case Status -> Outcome
stOutcome (Status -> Outcome) -> Maybe Status -> Maybe Outcome
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Status
oldSt of
    Just Killed -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()    -- Do not overwrite in case
    Just Defeated -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()  -- many things happen in 1 turn.
    Just Conquer -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just Escape -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    _ -> do
      -- This runs regardless of the _new_ status.
      Maybe (FactionAnalytics, GenerationAnalytics)
manalytics <-
        if Player -> Bool
fhasUI (Player -> Bool) -> Player -> Bool
forall a b. (a -> b) -> a -> b
$ Faction -> Player
gplayer Faction
fact then do
          Bool
keepAutomated <- (StateServer -> Bool) -> m Bool
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer ((StateServer -> Bool) -> m Bool)
-> (StateServer -> Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ ServerOptions -> Bool
skeepAutomated (ServerOptions -> Bool)
-> (StateServer -> ServerOptions) -> StateServer -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateServer -> ServerOptions
soptions
          -- Try to remove AI control of the UI faction, to show endgame info.
          Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Faction -> Bool
isAIFact Faction
fact
                Bool -> Bool -> Bool
&& Player -> LeaderMode
fleaderMode (Faction -> Player
gplayer Faction
fact) LeaderMode -> LeaderMode -> Bool
forall a. Eq a => a -> a -> Bool
/= LeaderMode
LeaderNull
                Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
keepAutomated) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
            UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ FactionId -> Bool -> UpdAtomic
UpdAutoFaction FactionId
fid Bool
False
          ItemDict
itemD <- (State -> ItemDict) -> m ItemDict
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> ItemDict
sitemD
          Dungeon
dungeon <- (State -> Dungeon) -> m Dungeon
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> Dungeon
sdungeon
          let ais :: [(ItemId, Item)]
ais = ItemDict -> [(ItemId, Item)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs ItemDict
itemD
              minLid :: LevelId
minLid = (LevelId, Level) -> LevelId
forall a b. (a, b) -> a
fst ((LevelId, Level) -> LevelId) -> (LevelId, Level) -> LevelId
forall a b. (a -> b) -> a -> b
$ ((LevelId, Level) -> (LevelId, Level) -> Ordering)
-> [(LevelId, Level)] -> (LevelId, Level)
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
minimumBy (((LevelId, Level) -> AbsDepth)
-> (LevelId, Level) -> (LevelId, Level) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
Ord.comparing (Level -> AbsDepth
ldepth (Level -> AbsDepth)
-> ((LevelId, Level) -> Level) -> (LevelId, Level) -> AbsDepth
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LevelId, Level) -> Level
forall a b. (a, b) -> b
snd))
                           ([(LevelId, Level)] -> (LevelId, Level))
-> [(LevelId, Level)] -> (LevelId, Level)
forall a b. (a -> b) -> a -> b
$ Dungeon -> [(LevelId, Level)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs Dungeon
dungeon
          UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ Container -> ItemBag -> [(ItemId, Item)] -> UpdAtomic
UpdSpotItemBag (FactionId -> LevelId -> Point -> Container
CTrunk FactionId
fid LevelId
minLid Point
originPoint)
                                         ItemBag
forall k a. EnumMap k a
EM.empty [(ItemId, Item)]
ais
          FactionId -> m ()
forall (m :: * -> *). MonadServerAtomic m => FactionId -> m ()
revealItems FactionId
fid
          -- Likely, by this time UI faction is no longer AI-controlled,
          -- so the score will get registered.
          Status -> FactionId -> m ()
forall (m :: * -> *). MonadServer m => Status -> FactionId -> m ()
registerScore Status
status FactionId
fid
          FactionAnalytics
factionAn <- (StateServer -> FactionAnalytics) -> m FactionAnalytics
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> FactionAnalytics
sfactionAn
          GenerationAnalytics
generationAn <- (StateServer -> GenerationAnalytics) -> m GenerationAnalytics
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> GenerationAnalytics
sgenerationAn
          Maybe (FactionAnalytics, GenerationAnalytics)
-> m (Maybe (FactionAnalytics, GenerationAnalytics))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (FactionAnalytics, GenerationAnalytics)
 -> m (Maybe (FactionAnalytics, GenerationAnalytics)))
-> Maybe (FactionAnalytics, GenerationAnalytics)
-> m (Maybe (FactionAnalytics, GenerationAnalytics))
forall a b. (a -> b) -> a -> b
$ (FactionAnalytics, GenerationAnalytics)
-> Maybe (FactionAnalytics, GenerationAnalytics)
forall a. a -> Maybe a
Just (FactionAnalytics
factionAn, GenerationAnalytics
generationAn)
        else Maybe (FactionAnalytics, GenerationAnalytics)
-> m (Maybe (FactionAnalytics, GenerationAnalytics))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (FactionAnalytics, GenerationAnalytics)
forall a. Maybe a
Nothing
      UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ FactionId
-> Maybe Status
-> Maybe Status
-> Maybe (FactionAnalytics, GenerationAnalytics)
-> UpdAtomic
UpdQuitFaction FactionId
fid Maybe Status
oldSt (Status -> Maybe Status
forall a. a -> Maybe a
Just Status
status) Maybe (FactionAnalytics, GenerationAnalytics)
manalytics
      (StateServer -> StateServer) -> m ()
forall (m :: * -> *).
MonadServer m =>
(StateServer -> StateServer) -> m ()
modifyServer ((StateServer -> StateServer) -> m ())
-> (StateServer -> StateServer) -> m ()
forall a b. (a -> b) -> a -> b
$ \ser :: StateServer
ser -> StateServer
ser {sbreakLoop :: Bool
sbreakLoop = Bool
True}  -- check game over

-- Send any UpdQuitFaction actions that can be deduced from factions'
-- current state.
deduceQuits :: MonadServerAtomic m => FactionId -> Status -> m ()
deduceQuits :: FactionId -> Status -> m ()
deduceQuits fid0 :: FactionId
fid0 status :: Status
status@Status{Outcome
stOutcome :: Outcome
stOutcome :: Status -> Outcome
stOutcome}
  | Outcome
stOutcome Outcome -> [Outcome] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Outcome
Defeated, Outcome
Camping, Outcome
Restart, Outcome
Conquer] =
    [Char] -> m ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> m ()) -> [Char] -> m ()
forall a b. (a -> b) -> a -> b
$ "no quitting to deduce" [Char] -> (FactionId, Status) -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` (FactionId
fid0, Status
status)
deduceQuits fid0 :: FactionId
fid0 status :: Status
status = do
  Faction
fact0 <- (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
fid0) (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 factHasUI :: Faction -> Bool
factHasUI = Player -> Bool
fhasUI (Player -> Bool) -> (Faction -> Player) -> Faction -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Faction -> Player
gplayer
      quitFaction :: (Outcome, (FactionId, Faction)) -> m ()
quitFaction (stOutcome :: Outcome
stOutcome, (fid :: FactionId
fid, _)) = Status -> FactionId -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
Status -> FactionId -> m ()
quitF Status
status{Outcome
stOutcome :: Outcome
stOutcome :: Outcome
stOutcome} FactionId
fid
      mapQuitF :: [(Outcome, (FactionId, Faction))] -> m ()
mapQuitF outfids :: [(Outcome, (FactionId, Faction))]
outfids = do
        let (withUI :: [(Outcome, (FactionId, Faction))]
withUI, withoutUI :: [(Outcome, (FactionId, Faction))]
withoutUI) =
              ((Outcome, (FactionId, Faction)) -> Bool)
-> [(Outcome, (FactionId, Faction))]
-> ([(Outcome, (FactionId, Faction))],
    [(Outcome, (FactionId, Faction))])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (Faction -> Bool
factHasUI (Faction -> Bool)
-> ((Outcome, (FactionId, Faction)) -> Faction)
-> (Outcome, (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) -> Faction)
-> ((Outcome, (FactionId, Faction)) -> (FactionId, Faction))
-> (Outcome, (FactionId, Faction))
-> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Outcome, (FactionId, Faction)) -> (FactionId, Faction)
forall a b. (a, b) -> b
snd)
                        ((Status -> Outcome
stOutcome Status
status, (FactionId
fid0, Faction
fact0)) (Outcome, (FactionId, Faction))
-> [(Outcome, (FactionId, Faction))]
-> [(Outcome, (FactionId, Faction))]
forall a. a -> [a] -> [a]
: [(Outcome, (FactionId, Faction))]
outfids)
        ((Outcome, (FactionId, Faction)) -> m ())
-> [(Outcome, (FactionId, Faction))] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Outcome, (FactionId, Faction)) -> m ()
quitFaction ([(Outcome, (FactionId, Faction))]
withoutUI [(Outcome, (FactionId, Faction))]
-> [(Outcome, (FactionId, Faction))]
-> [(Outcome, (FactionId, Faction))]
forall a. [a] -> [a] -> [a]
++ [(Outcome, (FactionId, Faction))]
withUI)
      inGameOutcome :: (FactionId, Faction) -> Bool
inGameOutcome (fid :: FactionId
fid, fact :: Faction
fact) = do
        let mout :: Maybe Outcome
mout | FactionId
fid FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
fid0 = Outcome -> Maybe Outcome
forall a. a -> Maybe a
Just (Outcome -> Maybe Outcome) -> Outcome -> Maybe Outcome
forall a b. (a -> b) -> a -> b
$ Status -> Outcome
stOutcome Status
status
                 | Bool
otherwise = Status -> Outcome
stOutcome (Status -> Outcome) -> Maybe Status -> Maybe Outcome
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Faction -> Maybe Status
gquit Faction
fact
        case Maybe Outcome
mout of
          Just Killed -> Bool
False
          Just Defeated -> Bool
False
          Just Restart -> Bool
False  -- effectively, commits suicide
          _ -> Bool
True
  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 assocsInGame :: [(FactionId, Faction)]
assocsInGame = ((FactionId, Faction) -> Bool)
-> [(FactionId, Faction)] -> [(FactionId, Faction)]
forall a. (a -> Bool) -> [a] -> [a]
filter (FactionId, Faction) -> Bool
inGameOutcome ([(FactionId, Faction)] -> [(FactionId, Faction)])
-> [(FactionId, Faction)] -> [(FactionId, Faction)]
forall a b. (a -> b) -> a -> b
$ EnumMap FactionId Faction -> [(FactionId, Faction)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs EnumMap FactionId Faction
factionD
      assocsKeepArena :: [(FactionId, Faction)]
assocsKeepArena = ((FactionId, Faction) -> Bool)
-> [(FactionId, Faction)] -> [(FactionId, Faction)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Faction -> Bool
keepArenaFact (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)]
assocsInGame
      assocsUI :: [(FactionId, Faction)]
assocsUI = ((FactionId, Faction) -> Bool)
-> [(FactionId, Faction)] -> [(FactionId, Faction)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Faction -> Bool
factHasUI (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)]
assocsInGame
      nonHorrorAIG :: [(FactionId, Faction)]
nonHorrorAIG = ((FactionId, Faction) -> Bool)
-> [(FactionId, Faction)] -> [(FactionId, Faction)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((FactionId, Faction) -> Bool) -> (FactionId, Faction) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Faction -> Bool
isHorrorFact (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)]
assocsInGame
      worldPeace :: Bool
worldPeace =
        ((FactionId, Faction) -> Bool) -> [(FactionId, Faction)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\(fid1 :: FactionId
fid1, _) -> ((FactionId, Faction) -> Bool) -> [(FactionId, Faction)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\(fid2 :: FactionId
fid2, fact2 :: Faction
fact2) -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ FactionId -> Faction -> FactionId -> Bool
isFoe FactionId
fid2 Faction
fact2 FactionId
fid1)
                           [(FactionId, Faction)]
nonHorrorAIG)
        [(FactionId, Faction)]
nonHorrorAIG
      othersInGame :: [(FactionId, Faction)]
othersInGame = ((FactionId, Faction) -> Bool)
-> [(FactionId, Faction)] -> [(FactionId, Faction)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
/= FactionId
fid0) (FactionId -> Bool)
-> ((FactionId, Faction) -> FactionId)
-> (FactionId, Faction)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FactionId, Faction) -> FactionId
forall a b. (a, b) -> a
fst) [(FactionId, Faction)]
assocsInGame
  if | [(FactionId, Faction)] -> Bool
forall a. [a] -> Bool
null [(FactionId, Faction)]
assocsUI ->
       -- Only non-UI players left in the game and they all win.
       [(Outcome, (FactionId, Faction))] -> m ()
mapQuitF ([(Outcome, (FactionId, Faction))] -> m ())
-> [(Outcome, (FactionId, Faction))] -> m ()
forall a b. (a -> b) -> a -> b
$ [Outcome]
-> [(FactionId, Faction)] -> [(Outcome, (FactionId, Faction))]
forall a b. [a] -> [b] -> [(a, b)]
zip (Outcome -> [Outcome]
forall a. a -> [a]
repeat Outcome
Conquer) [(FactionId, Faction)]
othersInGame
     | [(FactionId, Faction)] -> Bool
forall a. [a] -> Bool
null [(FactionId, Faction)]
assocsKeepArena ->
       -- Only leaderless and spawners remain (the latter may sometimes
       -- have no leader, just as the former), so they win,
       -- or we could get stuck in a state with no active arena
       -- and so no spawns.
       [(Outcome, (FactionId, Faction))] -> m ()
mapQuitF ([(Outcome, (FactionId, Faction))] -> m ())
-> [(Outcome, (FactionId, Faction))] -> m ()
forall a b. (a -> b) -> a -> b
$ [Outcome]
-> [(FactionId, Faction)] -> [(Outcome, (FactionId, Faction))]
forall a b. [a] -> [b] -> [(a, b)]
zip (Outcome -> [Outcome]
forall a. a -> [a]
repeat Outcome
Conquer) [(FactionId, Faction)]
othersInGame
     | Bool
worldPeace ->
       -- Nobody is at war any more, so all win (e.g., horrors, but never mind).
       [(Outcome, (FactionId, Faction))] -> m ()
mapQuitF ([(Outcome, (FactionId, Faction))] -> m ())
-> [(Outcome, (FactionId, Faction))] -> m ()
forall a b. (a -> b) -> a -> b
$ [Outcome]
-> [(FactionId, Faction)] -> [(Outcome, (FactionId, Faction))]
forall a b. [a] -> [b] -> [(a, b)]
zip (Outcome -> [Outcome]
forall a. a -> [a]
repeat Outcome
Conquer) [(FactionId, Faction)]
othersInGame
     | Status -> Outcome
stOutcome Status
status Outcome -> Outcome -> Bool
forall a. Eq a => a -> a -> Bool
== Outcome
Escape -> do
       -- Otherwise, in a game with many warring teams alive,
       -- only complete Victory matters, until enough of them die.
       let (victors :: [(FactionId, Faction)]
victors, losers :: [(FactionId, Faction)]
losers) =
             ((FactionId, Faction) -> Bool)
-> [(FactionId, Faction)]
-> ([(FactionId, Faction)], [(FactionId, Faction)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (\(fi :: FactionId
fi, _) -> FactionId -> Faction -> FactionId -> Bool
isFriend FactionId
fid0 Faction
fact0 FactionId
fi) [(FactionId, Faction)]
othersInGame
       [(Outcome, (FactionId, Faction))] -> m ()
mapQuitF ([(Outcome, (FactionId, Faction))] -> m ())
-> [(Outcome, (FactionId, Faction))] -> m ()
forall a b. (a -> b) -> a -> b
$ [Outcome]
-> [(FactionId, Faction)] -> [(Outcome, (FactionId, Faction))]
forall a b. [a] -> [b] -> [(a, b)]
zip (Outcome -> [Outcome]
forall a. a -> [a]
repeat Outcome
Escape) [(FactionId, Faction)]
victors [(Outcome, (FactionId, Faction))]
-> [(Outcome, (FactionId, Faction))]
-> [(Outcome, (FactionId, Faction))]
forall a. [a] -> [a] -> [a]
++ [Outcome]
-> [(FactionId, Faction)] -> [(Outcome, (FactionId, Faction))]
forall a b. [a] -> [b] -> [(a, b)]
zip (Outcome -> [Outcome]
forall a. a -> [a]
repeat Outcome
Defeated) [(FactionId, Faction)]
losers
     | Bool
otherwise -> Status -> FactionId -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
Status -> FactionId -> m ()
quitF Status
status FactionId
fid0

-- | Tell whether a faction that we know is still in game, keeps arena.
-- Keeping arena means, if the faction is still in game,
-- it always has a leader in the dungeon somewhere.
-- So, leaderless factions and spawner factions do not keep an arena,
-- even though the latter usually has a leader for most of the game.
keepArenaFact :: Faction -> Bool
keepArenaFact :: Faction -> Bool
keepArenaFact fact :: Faction
fact = Player -> LeaderMode
fleaderMode (Faction -> Player
gplayer Faction
fact) LeaderMode -> LeaderMode -> Bool
forall a. Eq a => a -> a -> Bool
/= LeaderMode
LeaderNull
                     Bool -> Bool -> Bool
&& Player -> Bool
fneverEmpty (Faction -> Player
gplayer Faction
fact)

-- We assume the actor in the second argument has HP <= 0 or is going to be
-- dominated right now. Even if the actor is to be dominated,
-- @bfid@ of the actor body is still the old faction.
deduceKilled :: MonadServerAtomic m => ActorId -> m ()
deduceKilled :: ActorId -> m ()
deduceKilled aid :: ActorId
aid = 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
  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
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Player -> Bool
fneverEmpty (Player -> Bool) -> Player -> Bool
forall a b. (a -> b) -> a -> b
$ Faction -> Player
gplayer Faction
fact) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Bool
actorsAlive <- FactionId -> ActorId -> m Bool
forall (m :: * -> *).
MonadServer m =>
FactionId -> ActorId -> m Bool
anyActorsAlive (Actor -> FactionId
bfid Actor
body) ActorId
aid
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
actorsAlive) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
      FactionId -> Status -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
FactionId -> Status -> m ()
deduceQuits (Actor -> FactionId
bfid Actor
body) (Status -> m ()) -> Status -> m ()
forall a b. (a -> b) -> a -> b
$ Outcome -> Int -> Maybe (GroupName ModeKind) -> Status
Status Outcome
Killed (LevelId -> Int
forall a. Enum a => a -> Int
fromEnum (LevelId -> Int) -> LevelId -> Int
forall a b. (a -> b) -> a -> b
$ Actor -> LevelId
blid Actor
body) Maybe (GroupName ModeKind)
forall a. Maybe a
Nothing

anyActorsAlive :: MonadServer m => FactionId -> ActorId -> m Bool
anyActorsAlive :: FactionId -> ActorId -> m Bool
anyActorsAlive fid :: FactionId
fid aid :: ActorId
aid = do
  [(ActorId, Actor)]
as <- (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
fid
  -- We test HP here, in case more than one actor goes to 0 HP in the same turn.
  Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$! ((ActorId, Actor) -> Bool) -> [(ActorId, Actor)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\(aid2 :: ActorId
aid2, b2 :: Actor
b2) -> ActorId
aid2 ActorId -> ActorId -> Bool
forall a. Eq a => a -> a -> Bool
/= ActorId
aid Bool -> Bool -> Bool
&& Actor -> Int64
bhp Actor
b2 Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> 0) [(ActorId, Actor)]
as

electLeader :: MonadServerAtomic m => FactionId -> LevelId -> ActorId -> m ()
electLeader :: FactionId -> LevelId -> ActorId -> m ()
electLeader fid :: FactionId
fid lid :: LevelId
lid aidToReplace :: ActorId
aidToReplace = do
  Maybe ActorId
mleader <- (State -> Maybe ActorId) -> m (Maybe ActorId)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Maybe ActorId) -> m (Maybe ActorId))
-> (State -> Maybe ActorId) -> m (Maybe ActorId)
forall a b. (a -> b) -> a -> b
$ Faction -> Maybe ActorId
gleader (Faction -> Maybe ActorId)
-> (State -> Faction) -> State -> Maybe ActorId
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
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (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
aidToReplace) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    [(ActorId, Actor)]
allOurs <- (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)])
-> (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
forall a b. (a -> b) -> a -> b
$ FactionId -> State -> [(ActorId, Actor)]
fidActorNotProjGlobalAssocs FactionId
fid  -- not only on level
    let -- Prefer actors on this level and with positive HP and not sleeping.
        -- Exclude @aidToReplace@, even if not dead (e.g., if being dominated).
        (positive :: [(ActorId, Actor)]
positive, negative :: [(ActorId, Actor)]
negative) = ((ActorId, Actor) -> Bool)
-> [(ActorId, Actor)] -> ([(ActorId, Actor)], [(ActorId, Actor)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (\(_, b :: Actor
b) -> Actor -> Int64
bhp Actor
b Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> 0) [(ActorId, Actor)]
allOurs
        (awake :: [(ActorId, Actor)]
awake, sleeping :: [(ActorId, Actor)]
sleeping) = ((ActorId, Actor) -> Bool)
-> [(ActorId, Actor)] -> ([(ActorId, Actor)], [(ActorId, Actor)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (\(_, b :: Actor
b) -> Actor -> Watchfulness
bwatch Actor
b Watchfulness -> Watchfulness -> Bool
forall a. Eq a => a -> a -> Bool
/= Watchfulness
WSleep) [(ActorId, Actor)]
positive
    [(ActorId, Actor)]
onThisLevel <- (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)])
-> (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
forall a b. (a -> b) -> a -> b
$ FactionId -> LevelId -> State -> [(ActorId, Actor)]
fidActorRegularAssocs FactionId
fid LevelId
lid
    let candidates :: [(ActorId, Actor)]
candidates = ((ActorId, Actor) -> Bool)
-> [(ActorId, Actor)] -> [(ActorId, Actor)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(_, b :: Actor
b) -> Actor -> Watchfulness
bwatch Actor
b Watchfulness -> Watchfulness -> Bool
forall a. Eq a => a -> a -> Bool
/= Watchfulness
WSleep) [(ActorId, Actor)]
onThisLevel
                     [(ActorId, Actor)] -> [(ActorId, Actor)] -> [(ActorId, Actor)]
forall a. [a] -> [a] -> [a]
++ [(ActorId, Actor)]
awake [(ActorId, Actor)] -> [(ActorId, Actor)] -> [(ActorId, Actor)]
forall a. [a] -> [a] -> [a]
++ [(ActorId, Actor)]
sleeping [(ActorId, Actor)] -> [(ActorId, Actor)] -> [(ActorId, Actor)]
forall a. [a] -> [a] -> [a]
++ [(ActorId, Actor)]
negative
        mleaderNew :: Maybe ActorId
mleaderNew =
          [ActorId] -> Maybe ActorId
forall a. [a] -> Maybe a
listToMaybe ([ActorId] -> Maybe ActorId) -> [ActorId] -> Maybe ActorId
forall a b. (a -> b) -> a -> b
$ (ActorId -> Bool) -> [ActorId] -> [ActorId]
forall a. (a -> Bool) -> [a] -> [a]
filter (ActorId -> ActorId -> Bool
forall a. Eq a => a -> a -> Bool
/= ActorId
aidToReplace) ([ActorId] -> [ActorId]) -> [ActorId] -> [ActorId]
forall a b. (a -> b) -> a -> b
$ ((ActorId, Actor) -> ActorId) -> [(ActorId, Actor)] -> [ActorId]
forall a b. (a -> b) -> [a] -> [b]
map (ActorId, Actor) -> ActorId
forall a b. (a, b) -> a
fst ([(ActorId, Actor)] -> [ActorId])
-> [(ActorId, Actor)] -> [ActorId]
forall a b. (a -> b) -> a -> b
$ [(ActorId, Actor)]
candidates
    UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ FactionId -> Maybe ActorId -> Maybe ActorId -> UpdAtomic
UpdLeadFaction FactionId
fid Maybe ActorId
mleader Maybe ActorId
mleaderNew

setFreshLeader :: MonadServerAtomic m => FactionId -> ActorId -> m ()
setFreshLeader :: FactionId -> ActorId -> m ()
setFreshLeader fid :: FactionId
fid aid :: ActorId
aid = 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
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Player -> LeaderMode
fleaderMode (Faction -> Player
gplayer Faction
fact) LeaderMode -> LeaderMode -> Bool
forall a. Eq a => a -> a -> Bool
== LeaderMode
LeaderNull) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    -- First update and send Perception so that the new leader
    -- may report his environment.
    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
    let !_A :: ()
_A = Bool -> () -> ()
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
b) ()
    Bool
valid <- (StateServer -> Bool) -> m Bool
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer ((StateServer -> Bool) -> m Bool)
-> (StateServer -> Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ (EnumMap LevelId Bool -> LevelId -> Bool
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> LevelId
blid Actor
b) (EnumMap LevelId Bool -> Bool)
-> (StateServer -> EnumMap LevelId Bool) -> StateServer -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EnumMap FactionId (EnumMap LevelId Bool)
-> FactionId -> EnumMap LevelId Bool
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
fid) (EnumMap FactionId (EnumMap LevelId Bool) -> EnumMap LevelId Bool)
-> (StateServer -> EnumMap FactionId (EnumMap LevelId Bool))
-> StateServer
-> EnumMap LevelId Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateServer -> EnumMap FactionId (EnumMap LevelId Bool)
sperValidFid
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
valid (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ FactionId -> LevelId -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
FactionId -> LevelId -> m ()
updatePer FactionId
fid (Actor -> LevelId
blid Actor
b)
    UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ FactionId -> Maybe ActorId -> Maybe ActorId -> UpdAtomic
UpdLeadFaction FactionId
fid (Faction -> Maybe ActorId
gleader Faction
fact) (ActorId -> Maybe ActorId
forall a. a -> Maybe a
Just ActorId
aid)

updatePer :: MonadServerAtomic m => FactionId -> LevelId -> m ()
{-# INLINE updatePer #-}
updatePer :: FactionId -> LevelId -> m ()
updatePer fid :: FactionId
fid lid :: LevelId
lid = do
  (StateServer -> StateServer) -> m ()
forall (m :: * -> *).
MonadServer m =>
(StateServer -> StateServer) -> m ()
modifyServer ((StateServer -> StateServer) -> m ())
-> (StateServer -> StateServer) -> m ()
forall a b. (a -> b) -> a -> b
$ \ser :: StateServer
ser ->
    StateServer
ser {sperValidFid :: EnumMap FactionId (EnumMap LevelId Bool)
sperValidFid = (EnumMap LevelId Bool -> EnumMap LevelId Bool)
-> FactionId
-> EnumMap FactionId (EnumMap LevelId Bool)
-> EnumMap FactionId (EnumMap LevelId Bool)
forall k a. Enum k => (a -> a) -> k -> EnumMap k a -> EnumMap k a
EM.adjust (LevelId -> Bool -> EnumMap LevelId Bool -> EnumMap LevelId Bool
forall k a. Enum k => k -> a -> EnumMap k a -> EnumMap k a
EM.insert LevelId
lid Bool
True) FactionId
fid (EnumMap FactionId (EnumMap LevelId Bool)
 -> EnumMap FactionId (EnumMap LevelId Bool))
-> EnumMap FactionId (EnumMap LevelId Bool)
-> EnumMap FactionId (EnumMap LevelId Bool)
forall a b. (a -> b) -> a -> b
$ StateServer -> EnumMap FactionId (EnumMap LevelId Bool)
sperValidFid StateServer
ser}
  PerFid
sperFidOld <- (StateServer -> PerFid) -> m PerFid
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> PerFid
sperFid
  let perOld :: Perception
perOld = PerFid
sperFidOld PerFid -> FactionId -> PerLid
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
fid PerLid -> LevelId -> Perception
forall k a. Enum k => EnumMap k a -> k -> a
EM.! LevelId
lid
  -- Performed in the State after action, e.g., with a new actor.
  Perception
perNew <- FactionId -> LevelId -> m Perception
forall (m :: * -> *).
MonadServer m =>
FactionId -> LevelId -> m Perception
recomputeCachePer FactionId
fid LevelId
lid
  let inPer :: Perception
inPer = Perception -> Perception -> Perception
diffPer Perception
perNew Perception
perOld
      outPer :: Perception
outPer = Perception -> Perception -> Perception
diffPer Perception
perOld Perception
perNew
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Perception -> Bool
nullPer Perception
outPer Bool -> Bool -> Bool
&& Perception -> Bool
nullPer Perception
inPer) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
    FactionId
-> LevelId -> Perception -> Perception -> Perception -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
FactionId
-> LevelId -> Perception -> Perception -> Perception -> m ()
execSendPer FactionId
fid LevelId
lid Perception
outPer Perception
inPer Perception
perNew

recomputeCachePer :: MonadServer m => FactionId -> LevelId -> m Perception
recomputeCachePer :: FactionId -> LevelId -> m Perception
recomputeCachePer fid :: FactionId
fid lid :: LevelId
lid = do
  CacheBeforeLucid
total <- FactionId -> LevelId -> m CacheBeforeLucid
forall (m :: * -> *).
MonadServer m =>
FactionId -> LevelId -> m CacheBeforeLucid
getCacheTotal FactionId
fid LevelId
lid
  FovLucid
fovLucid <- LevelId -> m FovLucid
forall (m :: * -> *). MonadServer m => LevelId -> m FovLucid
getCacheLucid LevelId
lid
  let perNew :: Perception
perNew = FovLucid -> CacheBeforeLucid -> Perception
perceptionFromPTotal FovLucid
fovLucid CacheBeforeLucid
total
      fper :: PerFid -> PerFid
fper = (PerLid -> PerLid) -> FactionId -> PerFid -> PerFid
forall k a. Enum k => (a -> a) -> k -> EnumMap k a -> EnumMap k a
EM.adjust (LevelId -> Perception -> PerLid -> PerLid
forall k a. Enum k => k -> a -> EnumMap k a -> EnumMap k a
EM.insert LevelId
lid Perception
perNew) FactionId
fid
  (StateServer -> StateServer) -> m ()
forall (m :: * -> *).
MonadServer m =>
(StateServer -> StateServer) -> m ()
modifyServer ((StateServer -> StateServer) -> m ())
-> (StateServer -> StateServer) -> m ()
forall a b. (a -> b) -> a -> b
$ \ser :: StateServer
ser -> StateServer
ser {sperFid :: PerFid
sperFid = PerFid -> PerFid
fper (PerFid -> PerFid) -> PerFid -> PerFid
forall a b. (a -> b) -> a -> b
$ StateServer -> PerFid
sperFid StateServer
ser}
  Perception -> m Perception
forall (m :: * -> *) a. Monad m => a -> m a
return Perception
perNew

-- The missile item is removed from the store only if the projection
-- went into effect (no failure occured).
projectFail :: MonadServerAtomic m
            => ActorId    -- ^ actor causing the projection
            -> ActorId    -- ^ actor projecting the item (is on current lvl)
            -> Point      -- ^ target position of the projectile
            -> Int        -- ^ digital line parameter
            -> Bool       -- ^ whether to start at the source position
            -> ItemId     -- ^ the item to be projected
            -> CStore     -- ^ whether the items comes from floor or inventory
            -> Bool       -- ^ whether the item is a blast
            -> m (Maybe ReqFailure)
projectFail :: ActorId
-> ActorId
-> Point
-> Int
-> Bool
-> ItemId
-> CStore
-> Bool
-> m (Maybe ReqFailure)
projectFail propeller :: ActorId
propeller source :: ActorId
source tpxy :: Point
tpxy eps :: Int
eps center :: Bool
center iid :: ItemId
iid cstore :: CStore
cstore blast :: Bool
blast = do
  COps{corule :: COps -> RuleContent
corule=RuleContent{Int
rXmax :: RuleContent -> Int
rXmax :: Int
rXmax, Int
rYmax :: RuleContent -> Int
rYmax :: Int
rYmax}, TileSpeedup
coTileSpeedup :: COps -> TileSpeedup
coTileSpeedup :: TileSpeedup
coTileSpeedup} <- (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
  let lid :: LevelId
lid = Actor -> LevelId
blid Actor
sb
      spos :: Point
spos = Actor -> Point
bpos Actor
sb
  Level
lvl <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel LevelId
lid
  case Int -> Int -> Int -> Point -> Point -> Maybe [Point]
bla Int
rXmax Int
rYmax Int
eps Point
spos Point
tpxy of
    Nothing -> Maybe ReqFailure -> m (Maybe ReqFailure)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ReqFailure -> m (Maybe ReqFailure))
-> Maybe ReqFailure -> m (Maybe ReqFailure)
forall a b. (a -> b) -> a -> b
$ ReqFailure -> Maybe ReqFailure
forall a. a -> Maybe a
Just ReqFailure
ProjectAimOnself
    Just [] -> [Char] -> m (Maybe ReqFailure)
forall a. HasCallStack => [Char] -> a
error ([Char] -> m (Maybe ReqFailure)) -> [Char] -> m (Maybe ReqFailure)
forall a b. (a -> b) -> a -> b
$ "projecting from the edge of level"
                       [Char] -> (Point, Point) -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` (Point
spos, Point
tpxy)
    Just (pos :: Point
pos : restUnlimited :: [Point]
restUnlimited) -> 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
$ Actor -> CStore -> State -> ItemBag
getBodyStoreBag Actor
sb CStore
cstore
      case ItemId -> ItemBag -> Maybe ItemQuant
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup ItemId
iid ItemBag
bag of
        Nothing -> Maybe ReqFailure -> m (Maybe ReqFailure)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ReqFailure -> m (Maybe ReqFailure))
-> Maybe ReqFailure -> m (Maybe ReqFailure)
forall a b. (a -> b) -> a -> b
$ ReqFailure -> Maybe ReqFailure
forall a. a -> Maybe a
Just ReqFailure
ProjectOutOfReach
        Just _kit :: ItemQuant
_kit -> 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
          Skills
actorSk <- ActorId -> m Skills
forall (m :: * -> *). MonadServer m => ActorId -> m Skills
currentSkillsServer ActorId
source
          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
source
          let skill :: Int
skill = Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkProject Skills
actorSk
              forced :: Bool
forced = Bool
blast Bool -> Bool -> Bool
|| Actor -> Bool
bproj Actor
sb
              calmE :: Bool
calmE = Actor -> Skills -> Bool
calmEnough Actor
sb Skills
actorMaxSk
              legal :: Either ReqFailure Bool
legal = Bool -> Int -> Bool -> ItemFull -> Either ReqFailure Bool
permittedProject Bool
forced Int
skill Bool
calmE ItemFull
itemFull
              arItem :: AspectRecord
arItem = ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFull
          case Either ReqFailure Bool
legal of
            Left reqFail :: ReqFailure
reqFail -> Maybe ReqFailure -> m (Maybe ReqFailure)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ReqFailure -> m (Maybe ReqFailure))
-> Maybe ReqFailure -> m (Maybe ReqFailure)
forall a b. (a -> b) -> a -> b
$ ReqFailure -> Maybe ReqFailure
forall a. a -> Maybe a
Just ReqFailure
reqFail
            Right _ -> do
              let lobable :: Bool
lobable = Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Lobable AspectRecord
arItem
                  rest :: [Point]
rest = if Bool
lobable
                         then Int -> [Point] -> [Point]
forall a. Int -> [a] -> [a]
take (Point -> Point -> Int
chessDist Point
spos Point
tpxy Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) [Point]
restUnlimited
                         else [Point]
restUnlimited
                  t :: ContentId TileKind
t = Level
lvl Level -> Point -> ContentId TileKind
`at` Point
pos
              if | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ TileSpeedup -> ContentId TileKind -> Bool
Tile.isWalkable TileSpeedup
coTileSpeedup ContentId TileKind
t ->
                   Maybe ReqFailure -> m (Maybe ReqFailure)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ReqFailure -> m (Maybe ReqFailure))
-> Maybe ReqFailure -> m (Maybe ReqFailure)
forall a b. (a -> b) -> a -> b
$ ReqFailure -> Maybe ReqFailure
forall a. a -> Maybe a
Just ReqFailure
ProjectBlockTerrain
                 | Point -> Level -> Bool
occupiedBigLvl Point
pos Level
lvl ->
                   if Bool
blast Bool -> Bool -> Bool
&& Actor -> Bool
bproj Actor
sb then do
                      -- Hit the blocking actor.
                      ActorId
-> ActorId -> Point -> [Point] -> ItemId -> CStore -> Bool -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId
-> ActorId -> Point -> [Point] -> ItemId -> CStore -> Bool -> m ()
projectBla ActorId
propeller ActorId
source Point
spos (Point
posPoint -> [Point] -> [Point]
forall a. a -> [a] -> [a]
:[Point]
rest)
                                 ItemId
iid CStore
cstore Bool
blast
                      Maybe ReqFailure -> m (Maybe ReqFailure)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ReqFailure
forall a. Maybe a
Nothing
                   else Maybe ReqFailure -> m (Maybe ReqFailure)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ReqFailure -> m (Maybe ReqFailure))
-> Maybe ReqFailure -> m (Maybe ReqFailure)
forall a b. (a -> b) -> a -> b
$ ReqFailure -> Maybe ReqFailure
forall a. a -> Maybe a
Just ReqFailure
ProjectBlockActor
                 | Bool
otherwise -> do
                   -- Make the explosion less regular and weaker at edges.
                   if Bool
blast Bool -> Bool -> Bool
&& Actor -> Bool
bproj Actor
sb Bool -> Bool -> Bool
&& Bool
center then
                     -- Start in the center, not around.
                     ActorId
-> ActorId -> Point -> [Point] -> ItemId -> CStore -> Bool -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId
-> ActorId -> Point -> [Point] -> ItemId -> CStore -> Bool -> m ()
projectBla ActorId
propeller ActorId
source Point
spos (Point
posPoint -> [Point] -> [Point]
forall a. a -> [a] -> [a]
:[Point]
rest)
                                ItemId
iid CStore
cstore Bool
blast
                   else
                     ActorId
-> ActorId -> Point -> [Point] -> ItemId -> CStore -> Bool -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId
-> ActorId -> Point -> [Point] -> ItemId -> CStore -> Bool -> m ()
projectBla ActorId
propeller ActorId
source Point
pos [Point]
rest ItemId
iid CStore
cstore Bool
blast
                   Maybe ReqFailure -> m (Maybe ReqFailure)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ReqFailure
forall a. Maybe a
Nothing

projectBla :: MonadServerAtomic m
           => ActorId    -- ^ actor causing the projection
           -> ActorId    -- ^ actor projecting the item (is on current lvl)
           -> Point      -- ^ starting point of the projectile
           -> [Point]    -- ^ rest of the trajectory of the projectile
           -> ItemId     -- ^ the item to be projected
           -> CStore     -- ^ whether the items comes from floor or inventory
           -> Bool       -- ^ whether the item is a blast
           -> m ()
projectBla :: ActorId
-> ActorId -> Point -> [Point] -> ItemId -> CStore -> Bool -> m ()
projectBla propeller :: ActorId
propeller source :: ActorId
source pos :: Point
pos rest :: [Point]
rest iid :: ItemId
iid cstore :: CStore
cstore blast :: Bool
blast = do
  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
  let lid :: LevelId
lid = Actor -> LevelId
blid Actor
sb
  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
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
blast (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ SfxAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => SfxAtomic -> m ()
execSfxAtomic (SfxAtomic -> m ()) -> SfxAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ ActorId -> ItemId -> CStore -> SfxAtomic
SfxProject ActorId
source ItemId
iid CStore
cstore
  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{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 ItemId
iid
  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, Point, [Point], ItemId, CStore) -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` (ActorId
source, Point
pos, [Point]
rest, ItemId
iid, CStore
cstore)
    Just kit :: ItemQuant
kit@(_, it :: ItemTimer
it) -> do
      let delay :: Time
delay =
            if ItemKind -> Int
IK.iweight ItemKind
itemKind Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0
            then Time
timeTurn  -- big delay at start, e.g., to easily read hologram
            else Time
timeZero  -- avoid running into own projectiles
          btime :: Time
btime = Time -> Time -> Time
absoluteTimeAdd Time
delay Time
localTime
      ActorId
-> Point
-> [Point]
-> ItemId
-> ItemQuant
-> LevelId
-> FactionId
-> Time
-> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId
-> Point
-> [Point]
-> ItemId
-> ItemQuant
-> LevelId
-> FactionId
-> Time
-> m ()
addProjectile ActorId
propeller Point
pos [Point]
rest ItemId
iid ItemQuant
kit LevelId
lid (Actor -> FactionId
bfid Actor
sb) Time
btime
      let c :: Container
c = ActorId -> CStore -> Container
CActor ActorId
source CStore
cstore
      UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ Bool -> ItemId -> Item -> ItemQuant -> Container -> UpdAtomic
UpdLoseItem Bool
False ItemId
iid Item
itemBase (1, Int -> ItemTimer -> ItemTimer
forall a. Int -> [a] -> [a]
take 1 ItemTimer
it) Container
c

addActorFromGroup :: MonadServerAtomic m
                  => GroupName ItemKind -> FactionId -> Point -> LevelId -> Time
                  -> m (Maybe ActorId)
addActorFromGroup :: GroupName ItemKind
-> FactionId -> Point -> LevelId -> Time -> m (Maybe ActorId)
addActorFromGroup actorGroup :: GroupName ItemKind
actorGroup bfid :: FactionId
bfid pos :: Point
pos lid :: LevelId
lid time :: Time
time = do
  -- We bootstrap the actor by first creating the trunk of the actor's body
  -- that contains the fixed properties of all actors of that kind.
  Frequency (ContentId ItemKind, ItemKind)
freq <- Int
-> LevelId
-> Freqs ItemKind
-> m (Frequency (ContentId ItemKind, ItemKind))
forall (m :: * -> *).
MonadServerAtomic m =>
Int
-> LevelId
-> Freqs ItemKind
-> m (Frequency (ContentId ItemKind, ItemKind))
prepareItemKind 0 LevelId
lid [(GroupName ItemKind
actorGroup, 1)]
  Maybe (ItemKnown, ItemFullKit)
m2 <- Frequency (ContentId ItemKind, ItemKind)
-> LevelId -> m (Maybe (ItemKnown, ItemFullKit))
forall (m :: * -> *).
MonadServerAtomic m =>
Frequency (ContentId ItemKind, ItemKind)
-> LevelId -> m (Maybe (ItemKnown, ItemFullKit))
rollItemAspect Frequency (ContentId ItemKind, ItemKind)
freq LevelId
lid
  case Maybe (ItemKnown, ItemFullKit)
m2 of
    Nothing -> Maybe ActorId -> m (Maybe ActorId)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ActorId
forall a. Maybe a
Nothing
    Just (itemKnown :: ItemKnown
itemKnown, itemFullKit :: ItemFullKit
itemFullKit) ->
      ActorId -> Maybe ActorId
forall a. a -> Maybe a
Just (ActorId -> Maybe ActorId) -> m ActorId -> m (Maybe ActorId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool
-> ItemKnown
-> ItemFullKit
-> FactionId
-> Point
-> LevelId
-> Time
-> m ActorId
forall (m :: * -> *).
MonadServerAtomic m =>
Bool
-> ItemKnown
-> ItemFullKit
-> FactionId
-> Point
-> LevelId
-> Time
-> m ActorId
registerActor Bool
False ItemKnown
itemKnown ItemFullKit
itemFullKit FactionId
bfid Point
pos LevelId
lid Time
time

registerActor :: MonadServerAtomic m
              => Bool -> ItemKnown -> ItemFullKit
              -> FactionId -> Point -> LevelId -> Time
              -> m ActorId
registerActor :: Bool
-> ItemKnown
-> ItemFullKit
-> FactionId
-> Point
-> LevelId
-> Time
-> m ActorId
registerActor summoned :: Bool
summoned (ItemKnown kindIx :: ItemIdentity
kindIx ar :: AspectRecord
ar _) (itemFullRaw :: ItemFull
itemFullRaw, kit :: ItemQuant
kit)
              bfid :: FactionId
bfid pos :: Point
pos lid :: LevelId
lid time :: Time
time = do
  let container :: Container
container = FactionId -> LevelId -> Point -> Container
CTrunk FactionId
bfid LevelId
lid Point
pos
      jfid :: Maybe FactionId
jfid = FactionId -> Maybe FactionId
forall a. a -> Maybe a
Just FactionId
bfid
      itemKnown :: ItemKnown
itemKnown = ItemIdentity -> AspectRecord -> Maybe FactionId -> ItemKnown
ItemKnown ItemIdentity
kindIx AspectRecord
ar Maybe FactionId
jfid
      itemFull :: ItemFull
itemFull = ItemFull
itemFullRaw {itemBase :: Item
itemBase = (ItemFull -> Item
itemBase ItemFull
itemFullRaw) {Maybe FactionId
jfid :: Maybe FactionId
jfid :: Maybe FactionId
jfid}}
  ItemId
trunkId <- ItemFullKit -> ItemKnown -> Container -> Bool -> m ItemId
forall (m :: * -> *).
MonadServerAtomic m =>
ItemFullKit -> ItemKnown -> Container -> Bool -> m ItemId
registerItem (ItemFull
itemFull, ItemQuant
kit) ItemKnown
itemKnown Container
container Bool
False
  ActorId
aid <- Bool
-> ItemId
-> ItemFullKit
-> FactionId
-> Point
-> LevelId
-> Time
-> m ActorId
forall (m :: * -> *).
MonadServerAtomic m =>
Bool
-> ItemId
-> ItemFullKit
-> FactionId
-> Point
-> LevelId
-> Time
-> m ActorId
addNonProjectile Bool
summoned ItemId
trunkId (ItemFull
itemFull, ItemQuant
kit) FactionId
bfid Point
pos LevelId
lid Time
time
  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
bfid) (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
  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
condAnyFoeAdj <- (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 -> State -> Bool
anyFoeAdj ActorId
aid
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Skills -> Bool
canSleep Skills
actorMaxSk Bool -> Bool -> Bool
&&
        Bool -> Bool
not Bool
condAnyFoeAdj
        Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
summoned
        Bool -> Bool -> Bool
&& Bool -> Bool
not (Player -> Bool
fhasGender (Faction -> Player
gplayer Faction
fact))) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do  -- heroes never start asleep
    let sleepOdds :: Ratio Integer
sleepOdds = if Skills -> Bool
prefersSleep Skills
actorMaxSk then 9Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
%10 else 1Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
%2
    Bool
sleeps <- Rnd Bool -> m Bool
forall (m :: * -> *) a. MonadServer m => Rnd a -> m a
rndToAction (Rnd Bool -> m Bool) -> Rnd Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Ratio Integer -> Rnd Bool
chance Ratio Integer
sleepOdds
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
sleeps (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ ActorId -> m ()
forall (m :: * -> *). MonadServerAtomic m => ActorId -> m ()
addSleep ActorId
aid
  ActorId -> m ActorId
forall (m :: * -> *) a. Monad m => a -> m a
return ActorId
aid

addProjectile :: MonadServerAtomic m
              => ActorId -> Point -> [Point] -> ItemId -> ItemQuant -> LevelId
              -> FactionId -> Time
              -> m ()
addProjectile :: ActorId
-> Point
-> [Point]
-> ItemId
-> ItemQuant
-> LevelId
-> FactionId
-> Time
-> m ()
addProjectile propeller :: ActorId
propeller pos :: Point
pos rest :: [Point]
rest iid :: ItemId
iid (_, it :: ItemTimer
it) lid :: LevelId
lid fid :: FactionId
fid time :: Time
time = 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 arItem :: AspectRecord
arItem = ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFull
      IK.ThrowMod{Int
throwHP :: ThrowMod -> Int
throwHP :: Int
IK.throwHP} = AspectRecord -> ThrowMod
IA.aToThrow AspectRecord
arItem
      (trajectory :: [Vector]
trajectory, (speed :: Speed
speed, _)) =
        AspectRecord -> ItemKind -> [Point] -> ([Vector], (Speed, Int))
IA.itemTrajectory AspectRecord
arItem (ItemFull -> ItemKind
itemKind ItemFull
itemFull) (Point
pos Point -> [Point] -> [Point]
forall a. a -> [a] -> [a]
: [Point]
rest)
      -- Trunk is added to equipment, not to organs, because it's the
      -- projected item, so it's carried, not grown.
      tweakBody :: Actor -> Actor
tweakBody b :: Actor
b = Actor
b { bhp :: Int64
bhp = Int -> Int64
xM Int
throwHP
                      , btrajectory :: Maybe ([Vector], Speed)
btrajectory = ([Vector], Speed) -> Maybe ([Vector], Speed)
forall a. a -> Maybe a
Just ([Vector]
trajectory, Speed
speed)
                      , beqp :: ItemBag
beqp = ItemId -> ItemQuant -> ItemBag
forall k a. Enum k => k -> a -> EnumMap k a
EM.singleton ItemId
iid (1, Int -> ItemTimer -> ItemTimer
forall a. Int -> [a] -> [a]
take 1 ItemTimer
it) }
  ActorId
aid <- ItemId
-> ItemFull
-> Bool
-> FactionId
-> Point
-> LevelId
-> (Actor -> Actor)
-> m ActorId
forall (m :: * -> *).
MonadServerAtomic m =>
ItemId
-> ItemFull
-> Bool
-> FactionId
-> Point
-> LevelId
-> (Actor -> Actor)
-> m ActorId
addActorIid ItemId
iid ItemFull
itemFull Bool
True FactionId
fid Point
pos LevelId
lid Actor -> Actor
tweakBody
  Actor
bp <- (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
propeller
  -- If propeller is a projectile, it may produce other projectiles, e.g.,
  -- by exploding, so it's not voluntary, so others are to blame.
  -- However, we can't easily see whether a pushed non-projectile actor
  -- produced a projectile due to colliding or voluntarily, so we assign
  -- blame to him.
  ActorId
originator <- if Actor -> Bool
bproj Actor
bp
                then (StateServer -> ActorId) -> m ActorId
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer ((StateServer -> ActorId) -> m ActorId)
-> (StateServer -> ActorId) -> m ActorId
forall a b. (a -> b) -> a -> b
$ ActorId -> ActorId -> EnumMap ActorId ActorId -> ActorId
forall k a. Enum k => a -> k -> EnumMap k a -> a
EM.findWithDefault ActorId
propeller ActorId
propeller
                                  (EnumMap ActorId ActorId -> ActorId)
-> (StateServer -> EnumMap ActorId ActorId)
-> StateServer
-> ActorId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateServer -> EnumMap ActorId ActorId
strajPushedBy
                else ActorId -> m ActorId
forall (m :: * -> *) a. Monad m => a -> m a
return ActorId
propeller
  (StateServer -> StateServer) -> m ()
forall (m :: * -> *).
MonadServer m =>
(StateServer -> StateServer) -> m ()
modifyServer ((StateServer -> StateServer) -> m ())
-> (StateServer -> StateServer) -> m ()
forall a b. (a -> b) -> a -> b
$ \ser :: StateServer
ser ->
    StateServer
ser { strajTime :: ActorTime
strajTime = FactionId -> LevelId -> ActorId -> Time -> ActorTime -> ActorTime
updateActorTime FactionId
fid LevelId
lid ActorId
aid Time
time (ActorTime -> ActorTime) -> ActorTime -> ActorTime
forall a b. (a -> b) -> a -> b
$ StateServer -> ActorTime
strajTime StateServer
ser
        , strajPushedBy :: EnumMap ActorId ActorId
strajPushedBy = ActorId
-> ActorId -> EnumMap ActorId ActorId -> EnumMap ActorId ActorId
forall k a. Enum k => k -> a -> EnumMap k a -> EnumMap k a
EM.insert ActorId
aid ActorId
originator (EnumMap ActorId ActorId -> EnumMap ActorId ActorId)
-> EnumMap ActorId ActorId -> EnumMap ActorId ActorId
forall a b. (a -> b) -> a -> b
$ StateServer -> EnumMap ActorId ActorId
strajPushedBy StateServer
ser }

addNonProjectile :: MonadServerAtomic m
                 => Bool -> ItemId -> ItemFullKit -> FactionId -> Point
                 -> LevelId -> Time
                 -> m ActorId
addNonProjectile :: Bool
-> ItemId
-> ItemFullKit
-> FactionId
-> Point
-> LevelId
-> Time
-> m ActorId
addNonProjectile summoned :: Bool
summoned trunkId :: ItemId
trunkId (itemFull :: ItemFull
itemFull, kit :: ItemQuant
kit) fid :: FactionId
fid pos :: Point
pos lid :: LevelId
lid time :: Time
time = do
  let tweakBody :: Actor -> Actor
tweakBody b :: Actor
b = Actor
b { borgan :: ItemBag
borgan = ItemId -> ItemQuant -> ItemBag
forall k a. Enum k => k -> a -> EnumMap k a
EM.singleton ItemId
trunkId ItemQuant
kit
                      , bcalm :: Int64
bcalm = if Bool
summoned
                                then Int -> Int64
xM 5  -- a tiny buffer before domination
                                else Actor -> Int64
bcalm Actor
b }
  ActorId
aid <- ItemId
-> ItemFull
-> Bool
-> FactionId
-> Point
-> LevelId
-> (Actor -> Actor)
-> m ActorId
forall (m :: * -> *).
MonadServerAtomic m =>
ItemId
-> ItemFull
-> Bool
-> FactionId
-> Point
-> LevelId
-> (Actor -> Actor)
-> m ActorId
addActorIid ItemId
trunkId ItemFull
itemFull Bool
False FactionId
fid Point
pos LevelId
lid Actor -> Actor
tweakBody
  -- We assume actor is never born pushed.
  (StateServer -> StateServer) -> m ()
forall (m :: * -> *).
MonadServer m =>
(StateServer -> StateServer) -> m ()
modifyServer ((StateServer -> StateServer) -> m ())
-> (StateServer -> StateServer) -> m ()
forall a b. (a -> b) -> a -> b
$ \ser :: StateServer
ser ->
    StateServer
ser {sactorTime :: ActorTime
sactorTime = FactionId -> LevelId -> ActorId -> Time -> ActorTime -> ActorTime
updateActorTime FactionId
fid LevelId
lid ActorId
aid Time
time (ActorTime -> ActorTime) -> ActorTime -> ActorTime
forall a b. (a -> b) -> a -> b
$ StateServer -> ActorTime
sactorTime StateServer
ser}
  ActorId -> m ActorId
forall (m :: * -> *) a. Monad m => a -> m a
return ActorId
aid

addActorIid :: MonadServerAtomic m
            => ItemId -> ItemFull -> Bool -> FactionId -> Point -> LevelId
            -> (Actor -> Actor)
            -> m ActorId
addActorIid :: ItemId
-> ItemFull
-> Bool
-> FactionId
-> Point
-> LevelId
-> (Actor -> Actor)
-> m ActorId
addActorIid trunkId :: ItemId
trunkId ItemFull{Item
itemBase :: Item
itemBase :: ItemFull -> Item
itemBase, ItemKind
itemKind :: ItemKind
itemKind :: ItemFull -> ItemKind
itemKind, itemDisco :: ItemFull -> ItemDisco
itemDisco=ItemDiscoFull arItem :: AspectRecord
arItem}
            bproj :: Bool
bproj fid :: FactionId
fid pos :: Point
pos lid :: LevelId
lid tweakBody :: Actor -> Actor
tweakBody = do
  -- Initial HP and Calm is based only on trunk and ignores organs.
  let trunkMaxHP :: Int
trunkMaxHP = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max 2 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Skill -> AspectRecord -> Int
IA.getSkill Skill
Ability.SkMaxHP AspectRecord
arItem
      hp :: Int64
hp = Int -> Int64
xM Int
trunkMaxHP Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`div` 2
      -- Hard to auto-id items that refill Calm, but reduced sight at game
      -- start is more confusing and frustrating:
      calm :: Int64
calm = Int -> Int64
xM (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max 0 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Skill -> AspectRecord -> Int
IA.getSkill Skill
Ability.SkMaxCalm AspectRecord
arItem)
  -- Create actor.
  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
  Challenge
curChalSer <- (StateServer -> Challenge) -> m Challenge
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer ((StateServer -> Challenge) -> m Challenge)
-> (StateServer -> Challenge) -> m Challenge
forall a b. (a -> b) -> a -> b
$ ServerOptions -> Challenge
scurChalSer (ServerOptions -> Challenge)
-> (StateServer -> ServerOptions) -> StateServer -> Challenge
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateServer -> ServerOptions
soptions
  -- If difficulty is below standard, HP is added to the UI factions,
  -- otherwise HP is added to their enemies.
  -- If no UI factions, their role is taken by the escapees (for testing).
  let diffBonusCoeff :: Int
diffBonusCoeff = Int -> Int
difficultyCoeff (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Challenge -> Int
cdiff Challenge
curChalSer
      boostFact :: Bool
boostFact = Bool -> Bool
not Bool
bproj
                  Bool -> Bool -> Bool
&& if Int
diffBonusCoeff Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0
                     then ((FactionId, Faction) -> Bool) -> [(FactionId, Faction)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Player -> Bool
fhasUI (Player -> Bool)
-> ((FactionId, Faction) -> Player) -> (FactionId, Faction) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Faction -> Player
gplayer (Faction -> Player)
-> ((FactionId, Faction) -> Faction)
-> (FactionId, Faction)
-> Player
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)] -> [(FactionId, Faction)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(fi :: FactionId
fi, fa :: Faction
fa) -> FactionId -> Faction -> FactionId -> Bool
isFriend FactionId
fi Faction
fa FactionId
fid)
                                      (EnumMap FactionId Faction -> [(FactionId, Faction)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs EnumMap FactionId Faction
factionD))
                     else ((FactionId, Faction) -> Bool) -> [(FactionId, Faction)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Player -> Bool
fhasUI (Player -> Bool)
-> ((FactionId, Faction) -> Player) -> (FactionId, Faction) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Faction -> Player
gplayer  (Faction -> Player)
-> ((FactionId, Faction) -> Faction)
-> (FactionId, Faction)
-> Player
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)] -> [(FactionId, Faction)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(fi :: FactionId
fi, fa :: Faction
fa) -> FactionId -> Faction -> FactionId -> Bool
isFoe FactionId
fi Faction
fa FactionId
fid)
                                      (EnumMap FactionId Faction -> [(FactionId, Faction)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs EnumMap FactionId Faction
factionD))
      finalHP :: Int64
finalHP | Bool
boostFact = Int64 -> Int64 -> Int64
forall a. Ord a => a -> a -> a
min (Int -> Int64
xM 899)  -- no more than UI can stand
                                (Int64
hp Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* 2 Int64 -> Int -> Int64
forall a b. (Num a, Integral b) => a -> b -> a
^ Int -> Int
forall a. Num a => a -> a
abs Int
diffBonusCoeff)
              | Bool
otherwise = Int64
hp
      maxHP :: Int64
maxHP = Int64 -> Int64 -> Int64
forall a. Ord a => a -> a -> a
min (Int64
finalHP Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int -> Int64
xM 100) (2 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
finalHP)
        -- prevent too high max HP resulting in panic when low HP/max HP ratio
      bonusHP :: Int
bonusHP = Int64 -> Int
forall a. Enum a => a -> Int
fromEnum (Int64
maxHP Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`div` Int64
oneM) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
trunkMaxHP
      healthOrgans :: [(Maybe Int, (GroupName ItemKind, CStore))]
healthOrgans = [ (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
bonusHP, ("bonus HP", CStore
COrgan))
                     | Int
bonusHP Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= 0 Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
bproj ]
      b :: Actor
b = ItemId
-> Int64 -> Int64 -> Point -> LevelId -> FactionId -> Bool -> Actor
actorTemplate ItemId
trunkId Int64
finalHP Int64
calm Point
pos LevelId
lid FactionId
fid Bool
bproj
      withTrunk :: Actor
withTrunk =
        Actor
b {bweapon :: Int
bweapon = if Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Meleeable AspectRecord
arItem then 1 else 0}
      bodyTweaked :: Actor
bodyTweaked = Actor -> Actor
tweakBody Actor
withTrunk
  ActorId
aid <- (StateServer -> ActorId) -> m ActorId
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> ActorId
sacounter
  (StateServer -> StateServer) -> m ()
forall (m :: * -> *).
MonadServer m =>
(StateServer -> StateServer) -> m ()
modifyServer ((StateServer -> StateServer) -> m ())
-> (StateServer -> StateServer) -> m ()
forall a b. (a -> b) -> a -> b
$ \ser :: StateServer
ser -> StateServer
ser {sacounter :: ActorId
sacounter = ActorId -> ActorId
forall a. Enum a => a -> a
succ ActorId
aid}
  UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ ActorId -> Actor -> [(ItemId, Item)] -> UpdAtomic
UpdCreateActor ActorId
aid Actor
bodyTweaked [(ItemId
trunkId, Item
itemBase)]
  -- Create, register and insert all initial actor items, including
  -- the bonus health organs from difficulty setting.
  [(Maybe Int, (GroupName ItemKind, CStore))]
-> ((Maybe Int, (GroupName ItemKind, CStore)) -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([(Maybe Int, (GroupName ItemKind, CStore))]
healthOrgans [(Maybe Int, (GroupName ItemKind, CStore))]
-> [(Maybe Int, (GroupName ItemKind, CStore))]
-> [(Maybe Int, (GroupName ItemKind, CStore))]
forall a. [a] -> [a] -> [a]
++ ((GroupName ItemKind, CStore)
 -> (Maybe Int, (GroupName ItemKind, CStore)))
-> [(GroupName ItemKind, CStore)]
-> [(Maybe Int, (GroupName ItemKind, CStore))]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe Int
forall a. Maybe a
Nothing,) (ItemKind -> [(GroupName ItemKind, CStore)]
IK.ikit ItemKind
itemKind))
        (((Maybe Int, (GroupName ItemKind, CStore)) -> m ()) -> m ())
-> ((Maybe Int, (GroupName ItemKind, CStore)) -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \(mk :: Maybe Int
mk, (ikText :: GroupName ItemKind
ikText, cstore :: CStore
cstore)) -> do
    let container :: Container
container = ActorId -> CStore -> Container
CActor ActorId
aid CStore
cstore
        itemFreq :: Freqs ItemKind
itemFreq = [(GroupName ItemKind
ikText, 1)]
    Maybe (ItemId, ItemFullKit)
mIidEtc <- LevelId
-> Freqs ItemKind
-> Container
-> Bool
-> Maybe Int
-> m (Maybe (ItemId, ItemFullKit))
forall (m :: * -> *).
MonadServerAtomic m =>
LevelId
-> Freqs ItemKind
-> Container
-> Bool
-> Maybe Int
-> m (Maybe (ItemId, ItemFullKit))
rollAndRegisterItem LevelId
lid Freqs ItemKind
itemFreq Container
container Bool
False Maybe Int
mk
    case Maybe (ItemId, ItemFullKit)
mIidEtc of
      Nothing -> [Char] -> m ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> m ()) -> [Char] -> m ()
forall a b. (a -> b) -> a -> b
$ "" [Char] -> (LevelId, Freqs ItemKind, Container, Maybe Int) -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` (LevelId
lid, Freqs ItemKind
itemFreq, Container
container, Maybe Int
mk)
      Just (iid :: ItemId
iid, (itemFull2 :: ItemFull
itemFull2, _)) ->
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CStore
cstore CStore -> CStore -> Bool
forall a. Eq a => a -> a -> Bool
/= CStore
CGround) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
          -- The items are created in inventory, so won't be picked up,
          -- so we have to discover them now, if eligible.
          Container -> ItemId -> ContentId ItemKind -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
Container -> ItemId -> ContentId ItemKind -> m ()
discoverIfMinorEffects Container
container ItemId
iid (ItemFull -> ContentId ItemKind
itemKindId ItemFull
itemFull2)
  ActorId -> m ActorId
forall (m :: * -> *) a. Monad m => a -> m a
return ActorId
aid
addActorIid _ _ _ _ _ _ _ = [Char] -> m ActorId
forall a. HasCallStack => [Char] -> a
error "addActorIid: server ignorant about an item"

discoverIfMinorEffects :: MonadServerAtomic m
                       => Container -> ItemId -> ContentId ItemKind -> m ()
discoverIfMinorEffects :: Container -> ItemId -> ContentId ItemKind -> m ()
discoverIfMinorEffects c :: Container
c iid :: ItemId
iid itemKindId :: ContentId ItemKind
itemKindId = 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
  DiscoveryAspect
discoAspect <- (State -> DiscoveryAspect) -> m DiscoveryAspect
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> DiscoveryAspect
sdiscoAspect
  let arItem :: AspectRecord
arItem = DiscoveryAspect
discoAspect DiscoveryAspect -> ItemId -> AspectRecord
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ItemId
iid
      itemKind :: ItemKind
itemKind = ContentData ItemKind -> ContentId ItemKind -> ItemKind
forall a. ContentData a -> ContentId a -> a
okind ContentData ItemKind
coitem ContentId ItemKind
itemKindId
   -- Otherwise, discover by use when item's effects get activated later on.
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (AspectRecord -> ItemKind -> Bool
IA.onlyMinorEffects AspectRecord
arItem ItemKind
itemKind
        Bool -> Bool -> Bool
&& Bool -> Bool
not (ItemKind -> Bool
IA.isHumanTrinket ItemKind
itemKind)) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
    UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ Container
-> ItemId -> ContentId ItemKind -> AspectRecord -> UpdAtomic
UpdDiscover Container
c ItemId
iid ContentId ItemKind
itemKindId AspectRecord
arItem

pickWeaponServer :: MonadServer m => ActorId -> m (Maybe (ItemId, CStore))
pickWeaponServer :: ActorId -> m (Maybe (ItemId, CStore))
pickWeaponServer source :: ActorId
source = do
  [(ItemId, ItemFullKit)]
eqpAssocs <- (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
source [CStore
CEqp]
  [(ItemId, ItemFullKit)]
bodyAssocs <- (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
source [CStore
COrgan]
  Skills
actorSk <- ActorId -> m Skills
forall (m :: * -> *). MonadServer m => ActorId -> m Skills
currentSkillsServer ActorId
source
  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
  let kitAssRaw :: [(ItemId, ItemFullKit)]
kitAssRaw = [(ItemId, ItemFullKit)]
eqpAssocs [(ItemId, ItemFullKit)]
-> [(ItemId, ItemFullKit)] -> [(ItemId, ItemFullKit)]
forall a. [a] -> [a] -> [a]
++ [(ItemId, ItemFullKit)]
bodyAssocs
      forced :: Bool
forced = Actor -> Bool
bproj Actor
sb
      kitAss :: [(ItemId, ItemFullKit)]
kitAss | Bool
forced = [(ItemId, ItemFullKit)]
kitAssRaw  -- for projectiles, anything is weapon
             | Bool
otherwise =
                 ((ItemId, ItemFullKit) -> Bool)
-> [(ItemId, ItemFullKit)] -> [(ItemId, ItemFullKit)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Meleeable
                         (AspectRecord -> Bool)
-> ((ItemId, ItemFullKit) -> AspectRecord)
-> (ItemId, ItemFullKit)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ItemFull -> AspectRecord
aspectRecordFull (ItemFull -> AspectRecord)
-> ((ItemId, ItemFullKit) -> ItemFull)
-> (ItemId, ItemFullKit)
-> AspectRecord
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ItemFullKit -> ItemFull
forall a b. (a, b) -> a
fst (ItemFullKit -> ItemFull)
-> ((ItemId, ItemFullKit) -> ItemFullKit)
-> (ItemId, ItemFullKit)
-> ItemFull
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ItemId, ItemFullKit) -> ItemFullKit
forall a b. (a, b) -> b
snd) [(ItemId, ItemFullKit)]
kitAssRaw
  -- Server ignores item effects or it would leak item discovery info.
  -- In particular, it even uses weapons that would heal opponent,
  -- and not only in case of projectiles.
  [(Double, (Int, (ItemId, ItemFullKit)))]
strongest <- Bool
-> Maybe DiscoveryBenefit
-> [(ItemId, ItemFullKit)]
-> Skills
-> ActorId
-> m [(Double, (Int, (ItemId, ItemFullKit)))]
forall (m :: * -> *).
MonadStateRead m =>
Bool
-> Maybe DiscoveryBenefit
-> [(ItemId, ItemFullKit)]
-> Skills
-> ActorId
-> m [(Double, (Int, (ItemId, ItemFullKit)))]
pickWeaponM Bool
False Maybe DiscoveryBenefit
forall a. Maybe a
Nothing [(ItemId, ItemFullKit)]
kitAss Skills
actorSk ActorId
source
  case [(Double, (Int, (ItemId, ItemFullKit)))]
strongest of
    [] -> Maybe (ItemId, CStore) -> m (Maybe (ItemId, CStore))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (ItemId, CStore)
forall a. Maybe a
Nothing
    iis :: [(Double, (Int, (ItemId, ItemFullKit)))]
iis@((maxS :: Double
maxS, _) : _) -> do
      let maxIis :: [(Int, (ItemId, ItemFullKit))]
maxIis = ((Double, (Int, (ItemId, ItemFullKit)))
 -> (Int, (ItemId, ItemFullKit)))
-> [(Double, (Int, (ItemId, ItemFullKit)))]
-> [(Int, (ItemId, ItemFullKit))]
forall a b. (a -> b) -> [a] -> [b]
map (Double, (Int, (ItemId, ItemFullKit)))
-> (Int, (ItemId, ItemFullKit))
forall a b. (a, b) -> b
snd ([(Double, (Int, (ItemId, ItemFullKit)))]
 -> [(Int, (ItemId, ItemFullKit))])
-> [(Double, (Int, (ItemId, ItemFullKit)))]
-> [(Int, (ItemId, ItemFullKit))]
forall a b. (a -> b) -> a -> b
$ ((Double, (Int, (ItemId, ItemFullKit))) -> Bool)
-> [(Double, (Int, (ItemId, ItemFullKit)))]
-> [(Double, (Int, (ItemId, ItemFullKit)))]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile ((Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
maxS) (Double -> Bool)
-> ((Double, (Int, (ItemId, ItemFullKit))) -> Double)
-> (Double, (Int, (ItemId, ItemFullKit)))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double, (Int, (ItemId, ItemFullKit))) -> Double
forall a b. (a, b) -> a
fst) [(Double, (Int, (ItemId, ItemFullKit)))]
iis
      (_, (iid :: ItemId
iid, _)) <- Rnd (Int, (ItemId, ItemFullKit)) -> m (Int, (ItemId, ItemFullKit))
forall (m :: * -> *) a. MonadServer m => Rnd a -> m a
rndToAction (Rnd (Int, (ItemId, ItemFullKit))
 -> m (Int, (ItemId, ItemFullKit)))
-> Rnd (Int, (ItemId, ItemFullKit))
-> m (Int, (ItemId, ItemFullKit))
forall a b. (a -> b) -> a -> b
$ [(Int, (ItemId, ItemFullKit))] -> Rnd (Int, (ItemId, ItemFullKit))
forall a. [a] -> Rnd a
oneOf [(Int, (ItemId, ItemFullKit))]
maxIis
      let cstore :: CStore
cstore = if Maybe ItemFullKit -> Bool
forall a. Maybe a -> Bool
isJust (ItemId -> [(ItemId, ItemFullKit)] -> Maybe ItemFullKit
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ItemId
iid [(ItemId, ItemFullKit)]
bodyAssocs) then CStore
COrgan else CStore
CEqp
      Maybe (ItemId, CStore) -> m (Maybe (ItemId, CStore))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (ItemId, CStore) -> m (Maybe (ItemId, CStore)))
-> Maybe (ItemId, CStore) -> m (Maybe (ItemId, CStore))
forall a b. (a -> b) -> a -> b
$ (ItemId, CStore) -> Maybe (ItemId, CStore)
forall a. a -> Maybe a
Just (ItemId
iid, CStore
cstore)

-- @MonadStateRead@ would be enough, but the logic is sound only on server.
currentSkillsServer :: MonadServer m => ActorId -> m Ability.Skills
currentSkillsServer :: ActorId -> m Skills
currentSkillsServer aid :: ActorId
aid  = 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
  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
  let mleader :: Maybe ActorId
mleader = Faction -> Maybe ActorId
gleader Faction
fact
  (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
$ Maybe ActorId -> ActorId -> State -> Skills
actorCurrentSkills Maybe ActorId
mleader ActorId
aid

getCacheLucid :: MonadServer m => LevelId -> m FovLucid
getCacheLucid :: LevelId -> m FovLucid
getCacheLucid lid :: LevelId
lid = do
  FovClearLid
fovClearLid <- (StateServer -> FovClearLid) -> m FovClearLid
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> FovClearLid
sfovClearLid
  FovLitLid
fovLitLid <- (StateServer -> FovLitLid) -> m FovLitLid
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> FovLitLid
sfovLitLid
  FovLucidLid
fovLucidLid <- (StateServer -> FovLucidLid) -> m FovLucidLid
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> FovLucidLid
sfovLucidLid
  let getNewLucid :: m FovLucid
getNewLucid = (State -> FovLucid) -> m FovLucid
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> FovLucid) -> m FovLucid)
-> (State -> FovLucid) -> m FovLucid
forall a b. (a -> b) -> a -> b
$ \s :: State
s ->
        FovClearLid -> FovLitLid -> State -> LevelId -> Level -> FovLucid
lucidFromLevel FovClearLid
fovClearLid FovLitLid
fovLitLid State
s LevelId
lid (State -> Dungeon
sdungeon State
s Dungeon -> LevelId -> Level
forall k a. Enum k => EnumMap k a -> k -> a
EM.! LevelId
lid)
  case LevelId -> FovLucidLid -> Maybe (FovValid FovLucid)
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup LevelId
lid FovLucidLid
fovLucidLid of
    Just (FovValid fovLucid :: FovLucid
fovLucid) -> FovLucid -> m FovLucid
forall (m :: * -> *) a. Monad m => a -> m a
return FovLucid
fovLucid
    _ -> do
      FovLucid
newLucid <- m FovLucid
getNewLucid
      (StateServer -> StateServer) -> m ()
forall (m :: * -> *).
MonadServer m =>
(StateServer -> StateServer) -> m ()
modifyServer ((StateServer -> StateServer) -> m ())
-> (StateServer -> StateServer) -> m ()
forall a b. (a -> b) -> a -> b
$ \ser :: StateServer
ser ->
        StateServer
ser {sfovLucidLid :: FovLucidLid
sfovLucidLid = LevelId -> FovValid FovLucid -> FovLucidLid -> FovLucidLid
forall k a. Enum k => k -> a -> EnumMap k a -> EnumMap k a
EM.insert LevelId
lid (FovLucid -> FovValid FovLucid
forall a. a -> FovValid a
FovValid FovLucid
newLucid)
                            (FovLucidLid -> FovLucidLid) -> FovLucidLid -> FovLucidLid
forall a b. (a -> b) -> a -> b
$ StateServer -> FovLucidLid
sfovLucidLid StateServer
ser}
      FovLucid -> m FovLucid
forall (m :: * -> *) a. Monad m => a -> m a
return FovLucid
newLucid

getCacheTotal :: MonadServer m => FactionId -> LevelId -> m CacheBeforeLucid
getCacheTotal :: FactionId -> LevelId -> m CacheBeforeLucid
getCacheTotal fid :: FactionId
fid lid :: LevelId
lid = do
  PerCacheFid
sperCacheFidOld <- (StateServer -> PerCacheFid) -> m PerCacheFid
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> PerCacheFid
sperCacheFid
  let perCacheOld :: PerceptionCache
perCacheOld = PerCacheFid
sperCacheFidOld PerCacheFid -> FactionId -> PerCacheLid
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
fid PerCacheLid -> LevelId -> PerceptionCache
forall k a. Enum k => EnumMap k a -> k -> a
EM.! LevelId
lid
  case PerceptionCache -> FovValid CacheBeforeLucid
ptotal PerceptionCache
perCacheOld of
    FovValid total :: CacheBeforeLucid
total -> CacheBeforeLucid -> m CacheBeforeLucid
forall (m :: * -> *) a. Monad m => a -> m a
return CacheBeforeLucid
total
    FovInvalid -> do
      ActorMaxSkills
actorMaxSkills <- (State -> ActorMaxSkills) -> m ActorMaxSkills
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> ActorMaxSkills
sactorMaxSkills
      FovClearLid
fovClearLid <- (StateServer -> FovClearLid) -> m FovClearLid
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> FovClearLid
sfovClearLid
      ActorId -> Actor
getActorB <- (State -> ActorId -> Actor) -> m (ActorId -> Actor)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ActorId -> Actor) -> m (ActorId -> Actor))
-> (State -> ActorId -> Actor) -> m (ActorId -> Actor)
forall a b. (a -> b) -> a -> b
$ (ActorId -> State -> Actor) -> State -> ActorId -> Actor
forall a b c. (a -> b -> c) -> b -> a -> c
flip ActorId -> State -> Actor
getActorBody
      let perActorNew :: PerActor
perActorNew =
            PerActor
-> (ActorId -> Actor) -> ActorMaxSkills -> FovClear -> PerActor
perActorFromLevel (PerceptionCache -> PerActor
perActor PerceptionCache
perCacheOld) ActorId -> Actor
getActorB
                              ActorMaxSkills
actorMaxSkills (FovClearLid
fovClearLid FovClearLid -> LevelId -> FovClear
forall k a. Enum k => EnumMap k a -> k -> a
EM.! LevelId
lid)
          -- We don't check if any actor changed, because almost surely one is.
          -- Exception: when an actor is destroyed, but then union differs, too.
          total :: CacheBeforeLucid
total = PerActor -> CacheBeforeLucid
totalFromPerActor PerActor
perActorNew
          perCache :: PerceptionCache
perCache = $WPerceptionCache :: FovValid CacheBeforeLucid -> PerActor -> PerceptionCache
PerceptionCache { ptotal :: FovValid CacheBeforeLucid
ptotal = CacheBeforeLucid -> FovValid CacheBeforeLucid
forall a. a -> FovValid a
FovValid CacheBeforeLucid
total
                                     , perActor :: PerActor
perActor = PerActor
perActorNew }
          fperCache :: PerCacheFid -> PerCacheFid
fperCache = (PerCacheLid -> PerCacheLid)
-> FactionId -> PerCacheFid -> PerCacheFid
forall k a. Enum k => (a -> a) -> k -> EnumMap k a -> EnumMap k a
EM.adjust (LevelId -> PerceptionCache -> PerCacheLid -> PerCacheLid
forall k a. Enum k => k -> a -> EnumMap k a -> EnumMap k a
EM.insert LevelId
lid PerceptionCache
perCache) FactionId
fid
      (StateServer -> StateServer) -> m ()
forall (m :: * -> *).
MonadServer m =>
(StateServer -> StateServer) -> m ()
modifyServer ((StateServer -> StateServer) -> m ())
-> (StateServer -> StateServer) -> m ()
forall a b. (a -> b) -> a -> b
$ \ser :: StateServer
ser -> StateServer
ser {sperCacheFid :: PerCacheFid
sperCacheFid = PerCacheFid -> PerCacheFid
fperCache (PerCacheFid -> PerCacheFid) -> PerCacheFid -> PerCacheFid
forall a b. (a -> b) -> a -> b
$ StateServer -> PerCacheFid
sperCacheFid StateServer
ser}
      CacheBeforeLucid -> m CacheBeforeLucid
forall (m :: * -> *) a. Monad m => a -> m a
return CacheBeforeLucid
total

allGroupItems :: MonadServerAtomic m
              => CStore -> GroupName ItemKind -> ActorId
              -> m [(ItemId, ItemQuant)]
allGroupItems :: CStore -> GroupName ItemKind -> ActorId -> m [(ItemId, ItemQuant)]
allGroupItems store :: CStore
store grp :: GroupName ItemKind
grp target :: ActorId
target = 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
target
  ItemId -> ItemKind
getKind <- (State -> ItemId -> ItemKind) -> m (ItemId -> ItemKind)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemId -> ItemKind) -> m (ItemId -> ItemKind))
-> (State -> ItemId -> ItemKind) -> m (ItemId -> ItemKind)
forall a b. (a -> b) -> a -> b
$ (ItemId -> State -> ItemKind) -> State -> ItemId -> ItemKind
forall a b c. (a -> b -> c) -> b -> a -> c
flip ItemId -> State -> ItemKind
getIidKindServer
  let hasGroup :: (ItemId, ItemQuant) -> Bool
hasGroup (iid :: ItemId
iid, _) =
        Bool -> (Int -> Bool) -> Maybe Int -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0) (Maybe Int -> Bool) -> Maybe Int -> Bool
forall a b. (a -> b) -> a -> b
$ GroupName ItemKind -> Freqs ItemKind -> Maybe Int
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup GroupName ItemKind
grp (Freqs ItemKind -> Maybe Int) -> Freqs ItemKind -> Maybe Int
forall a b. (a -> b) -> a -> b
$ ItemKind -> Freqs ItemKind
IK.ifreq (ItemKind -> Freqs ItemKind) -> ItemKind -> Freqs ItemKind
forall a b. (a -> b) -> a -> b
$ ItemId -> ItemKind
getKind ItemId
iid
  [(ItemId, ItemQuant)]
assocsCStore <- (State -> [(ItemId, ItemQuant)]) -> m [(ItemId, ItemQuant)]
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(ItemId, ItemQuant)]) -> m [(ItemId, ItemQuant)])
-> (State -> [(ItemId, ItemQuant)]) -> m [(ItemId, ItemQuant)]
forall a b. (a -> b) -> a -> b
$ ItemBag -> [(ItemId, ItemQuant)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs (ItemBag -> [(ItemId, ItemQuant)])
-> (State -> ItemBag) -> State -> [(ItemId, ItemQuant)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Actor -> CStore -> State -> ItemBag
getBodyStoreBag Actor
b CStore
store
  [(ItemId, ItemQuant)] -> m [(ItemId, ItemQuant)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(ItemId, ItemQuant)] -> m [(ItemId, ItemQuant)])
-> [(ItemId, ItemQuant)] -> m [(ItemId, ItemQuant)]
forall a b. (a -> b) -> a -> b
$! ((ItemId, ItemQuant) -> Bool)
-> [(ItemId, ItemQuant)] -> [(ItemId, ItemQuant)]
forall a. (a -> Bool) -> [a] -> [a]
filter (ItemId, ItemQuant) -> Bool
hasGroup [(ItemId, ItemQuant)]
assocsCStore

addCondition :: MonadServerAtomic m => GroupName ItemKind -> ActorId -> m ()
addCondition :: GroupName ItemKind -> ActorId -> m ()
addCondition name :: GroupName ItemKind
name aid :: ActorId
aid = do
  Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
  let c :: Container
c = ActorId -> CStore -> Container
CActor ActorId
aid CStore
COrgan
  Maybe (ItemId, ItemFullKit)
mresult <- LevelId
-> Freqs ItemKind
-> Container
-> Bool
-> Maybe Int
-> m (Maybe (ItemId, ItemFullKit))
forall (m :: * -> *).
MonadServerAtomic m =>
LevelId
-> Freqs ItemKind
-> Container
-> Bool
-> Maybe Int
-> m (Maybe (ItemId, ItemFullKit))
rollAndRegisterItem (Actor -> LevelId
blid Actor
b) [(GroupName ItemKind
name, 1)] Container
c Bool
False Maybe Int
forall a. Maybe a
Nothing
  Bool -> m () -> m ()
forall a. HasCallStack => Bool -> a -> a
assert (Maybe (ItemId, ItemFullKit) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (ItemId, ItemFullKit)
mresult) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

removeConditionSingle :: MonadServerAtomic m
                      => GroupName ItemKind -> ActorId -> m Int
removeConditionSingle :: GroupName ItemKind -> ActorId -> m Int
removeConditionSingle name :: GroupName ItemKind
name aid :: ActorId
aid = do
  let c :: Container
c = ActorId -> CStore -> Container
CActor ActorId
aid CStore
COrgan
  [(ItemId, ItemQuant)]
is <- CStore -> GroupName ItemKind -> ActorId -> m [(ItemId, ItemQuant)]
forall (m :: * -> *).
MonadServerAtomic m =>
CStore -> GroupName ItemKind -> ActorId -> m [(ItemId, ItemQuant)]
allGroupItems CStore
COrgan GroupName ItemKind
name ActorId
aid
  case [(ItemId, ItemQuant)]
is of
    [(iid :: ItemId
iid, (nAll :: Int
nAll, itemTimer :: ItemTimer
itemTimer))] -> do
      Item
itemBase <- (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
iid
      UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ Bool -> ItemId -> Item -> ItemQuant -> Container -> UpdAtomic
UpdLoseItem Bool
False ItemId
iid Item
itemBase (1, ItemTimer
itemTimer) Container
c
      Int -> m Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> m Int) -> Int -> m Int
forall a b. (a -> b) -> a -> b
$ Int
nAll Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1
    _ -> [Char] -> m Int
forall a. HasCallStack => [Char] -> a
error ([Char] -> m Int) -> [Char] -> m Int
forall a b. (a -> b) -> a -> b
$ "missing or multiple item" [Char] -> (GroupName ItemKind, [(ItemId, ItemQuant)]) -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` (GroupName ItemKind
name, [(ItemId, ItemQuant)]
is)

addSleep :: MonadServerAtomic m => ActorId -> m ()
addSleep :: ActorId -> m ()
addSleep aid :: ActorId
aid = do
  Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
  GroupName ItemKind -> ActorId -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
GroupName ItemKind -> ActorId -> m ()
addCondition "asleep" ActorId
aid
  UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ ActorId -> Watchfulness -> Watchfulness -> UpdAtomic
UpdWaitActor ActorId
aid (Actor -> Watchfulness
bwatch Actor
b) Watchfulness
WSleep

removeSleepSingle :: MonadServerAtomic m => ActorId -> m ()
removeSleepSingle :: ActorId -> m ()
removeSleepSingle aid :: ActorId
aid = do
  Int
nAll <- GroupName ItemKind -> ActorId -> m Int
forall (m :: * -> *).
MonadServerAtomic m =>
GroupName ItemKind -> ActorId -> m Int
removeConditionSingle "asleep" ActorId
aid
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
nAll Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
    UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ ActorId -> Watchfulness -> Watchfulness -> UpdAtomic
UpdWaitActor ActorId
aid Watchfulness
WWake Watchfulness
WWatch

addKillToAnalytics :: MonadServerAtomic m
                   => ActorId -> KillHow -> FactionId -> ItemId -> m ()
addKillToAnalytics :: ActorId -> KillHow -> FactionId -> ItemId -> m ()
addKillToAnalytics aid :: ActorId
aid killHow :: KillHow
killHow fid :: FactionId
fid iid :: ItemId
iid = do
  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
aid ActorDict
actorD of
    Just b :: Actor
b ->
      (StateServer -> StateServer) -> m ()
forall (m :: * -> *).
MonadServer m =>
(StateServer -> StateServer) -> m ()
modifyServer ((StateServer -> StateServer) -> m ())
-> (StateServer -> StateServer) -> m ()
forall a b. (a -> b) -> a -> b
$ \ser :: StateServer
ser ->
        StateServer
ser { sfactionAn :: FactionAnalytics
sfactionAn = FactionId
-> KillHow
-> FactionId
-> ItemId
-> FactionAnalytics
-> FactionAnalytics
addFactionKill (Actor -> FactionId
bfid Actor
b) KillHow
killHow FactionId
fid ItemId
iid
                           (FactionAnalytics -> FactionAnalytics)
-> FactionAnalytics -> FactionAnalytics
forall a b. (a -> b) -> a -> b
$ StateServer -> FactionAnalytics
sfactionAn StateServer
ser
            , sactorAn :: ActorAnalytics
sactorAn = ActorId
-> KillHow
-> FactionId
-> ItemId
-> ActorAnalytics
-> ActorAnalytics
addActorKill ActorId
aid KillHow
killHow FactionId
fid ItemId
iid
                         (ActorAnalytics -> ActorAnalytics)
-> ActorAnalytics -> ActorAnalytics
forall a b. (a -> b) -> a -> b
$ StateServer -> ActorAnalytics
sactorAn StateServer
ser }
    Nothing -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()  -- killer dead, too late to assign blame