-- | Handle atomic commands on the server, after they are executed
-- to change server 'State' and before they are sent to clients.
module Game.LambdaHack.Server.HandleAtomicM
  ( cmdAtomicSemSer
#ifdef EXPOSE_INTERNAL
    -- * Internal operations
  , validateFloor, validateFloorBag, levelOfStash
  , invalidateArenas, updateSclear, updateSlit
  , invalidateLucidLid, invalidateLucidAid
  , actorHasShine, itemAffectsShineRadius, itemAffectsPerRadius
  , addPerActor, addPerActorAny, deletePerActor, deletePerActorAny
  , invalidatePerActor, reconsiderPerActor, invalidatePerLid
#endif
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import qualified Data.EnumMap.Strict as EM
import qualified Data.EnumSet as ES

import           Game.LambdaHack.Atomic
import           Game.LambdaHack.Common.Actor
import           Game.LambdaHack.Common.ActorState
import           Game.LambdaHack.Common.Faction
import           Game.LambdaHack.Common.Item
import qualified Game.LambdaHack.Common.ItemAspect as IA
import           Game.LambdaHack.Common.Kind
import           Game.LambdaHack.Common.MonadStateRead
import           Game.LambdaHack.Common.Point
import qualified Game.LambdaHack.Common.PointArray as PointArray
import           Game.LambdaHack.Common.State
import qualified Game.LambdaHack.Common.Tile as Tile
import           Game.LambdaHack.Common.Types
import           Game.LambdaHack.Content.TileKind (TileKind)
import qualified Game.LambdaHack.Definition.Ability as Ability
import           Game.LambdaHack.Definition.Defs
import           Game.LambdaHack.Server.Fov
import           Game.LambdaHack.Server.MonadServer
import           Game.LambdaHack.Server.State

-- | Effect of atomic actions on server state is calculated
-- with the global state from after the command is executed
-- (except where the supplied @oldState@ is used).
cmdAtomicSemSer :: MonadServer m => State -> UpdAtomic -> m ()
cmdAtomicSemSer :: State -> UpdAtomic -> m ()
cmdAtomicSemSer State
oldState UpdAtomic
cmd = case UpdAtomic
cmd of
  UpdRegisterItems{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdCreateActor ActorId
aid Actor
b [(ItemId, Item)]
_ -> do
    ActorMaxSkills
actorMaxSkills <- (State -> ActorMaxSkills) -> m ActorMaxSkills
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> ActorMaxSkills
sactorMaxSkills
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ActorMaxSkills -> ActorId -> Bool
actorHasShine ActorMaxSkills
actorMaxSkills ActorId
aid) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ LevelId -> m ()
forall (m :: * -> *). MonadServer m => LevelId -> m ()
invalidateLucidLid (LevelId -> m ()) -> LevelId -> m ()
forall a b. (a -> b) -> a -> b
$ Actor -> LevelId
blid Actor
b
    ActorId -> Actor -> m ()
forall (m :: * -> *). MonadServer m => ActorId -> Actor -> m ()
addPerActor ActorId
aid Actor
b
  UpdDestroyActor ActorId
aid Actor
b [(ItemId, Item)]
_ -> do
    let actorMaxSkillsOld :: ActorMaxSkills
actorMaxSkillsOld = State -> ActorMaxSkills
sactorMaxSkills State
oldState
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ActorMaxSkills -> ActorId -> Bool
actorHasShine ActorMaxSkills
actorMaxSkillsOld ActorId
aid) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ LevelId -> m ()
forall (m :: * -> *). MonadServer m => LevelId -> m ()
invalidateLucidLid (LevelId -> m ()) -> LevelId -> m ()
forall a b. (a -> b) -> a -> b
$ Actor -> LevelId
blid Actor
b
    ActorMaxSkills -> ActorId -> Actor -> m ()
forall (m :: * -> *).
MonadServer m =>
ActorMaxSkills -> ActorId -> Actor -> m ()
deletePerActor ActorMaxSkills
actorMaxSkillsOld ActorId
aid 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
$ \StateServer
ser ->
      StateServer
ser { sactorTime :: ActorTime
sactorTime = (EnumMap LevelId (EnumMap ActorId Time)
 -> EnumMap LevelId (EnumMap ActorId Time))
-> FactionId -> ActorTime -> ActorTime
forall k a. Enum k => (a -> a) -> k -> EnumMap k a -> EnumMap k a
EM.adjust ((EnumMap ActorId Time -> EnumMap ActorId Time)
-> LevelId
-> EnumMap LevelId (EnumMap ActorId Time)
-> EnumMap LevelId (EnumMap ActorId Time)
forall k a. Enum k => (a -> a) -> k -> EnumMap k a -> EnumMap k a
EM.adjust (ActorId -> EnumMap ActorId Time -> EnumMap ActorId Time
forall k a. Enum k => k -> EnumMap k a -> EnumMap k a
EM.delete ActorId
aid) (Actor -> LevelId
blid Actor
b)) (Actor -> FactionId
bfid Actor
b)
                                   (StateServer -> ActorTime
sactorTime StateServer
ser)
          , strajTime :: ActorTime
strajTime = (EnumMap LevelId (EnumMap ActorId Time)
 -> EnumMap LevelId (EnumMap ActorId Time))
-> FactionId -> ActorTime -> ActorTime
forall k a. Enum k => (a -> a) -> k -> EnumMap k a -> EnumMap k a
EM.adjust ((EnumMap ActorId Time -> EnumMap ActorId Time)
-> LevelId
-> EnumMap LevelId (EnumMap ActorId Time)
-> EnumMap LevelId (EnumMap ActorId Time)
forall k a. Enum k => (a -> a) -> k -> EnumMap k a -> EnumMap k a
EM.adjust (ActorId -> EnumMap ActorId Time -> EnumMap ActorId Time
forall k a. Enum k => k -> EnumMap k a -> EnumMap k a
EM.delete ActorId
aid) (Actor -> LevelId
blid Actor
b)) (Actor -> FactionId
bfid Actor
b)
                                  (StateServer -> ActorTime
strajTime StateServer
ser)
          , strajPushedBy :: ActorPushedBy
strajPushedBy = ActorId -> ActorPushedBy -> ActorPushedBy
forall k a. Enum k => k -> EnumMap k a -> EnumMap k a
EM.delete ActorId
aid (StateServer -> ActorPushedBy
strajPushedBy StateServer
ser)
          , sactorAn :: ActorAnalytics
sactorAn = ActorId -> ActorAnalytics -> ActorAnalytics
forall k a. Enum k => k -> EnumMap k a -> EnumMap k a
EM.delete ActorId
aid (StateServer -> ActorAnalytics
sactorAn StateServer
ser)
          , sactorStasis :: EnumSet ActorId
sactorStasis = ActorId -> EnumSet ActorId -> EnumSet ActorId
forall k. Enum k => k -> EnumSet k -> EnumSet k
ES.delete ActorId
aid (StateServer -> EnumSet ActorId
sactorStasis StateServer
ser) }
  UpdCreateItem Bool
_ ItemId
iid Item
_ ItemQuant
_ (CFloor LevelId
lid Point
_) -> ItemId -> LevelId -> m ()
forall (m :: * -> *). MonadServer m => ItemId -> LevelId -> m ()
validateFloor ItemId
iid LevelId
lid
  UpdCreateItem Bool
_ ItemId
iid Item
_ ItemQuant
_ (CActor ActorId
aid CStore
CStash) -> do
    LevelId
lid <- ActorId -> m LevelId
forall (m :: * -> *). MonadStateRead m => ActorId -> m LevelId
levelOfStash ActorId
aid
    ItemId -> LevelId -> m ()
forall (m :: * -> *). MonadServer m => ItemId -> LevelId -> m ()
validateFloor ItemId
iid LevelId
lid
  UpdCreateItem Bool
_ ItemId
iid Item
_ ItemQuant
_ (CActor ActorId
aid CStore
CGround) -> do
    LevelId
lid <- (State -> LevelId) -> m LevelId
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> LevelId) -> m LevelId)
-> (State -> LevelId) -> m LevelId
forall a b. (a -> b) -> a -> b
$ Actor -> LevelId
blid (Actor -> LevelId) -> (State -> Actor) -> State -> LevelId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ActorId -> State -> Actor
getActorBody ActorId
aid
    ItemId -> LevelId -> m ()
forall (m :: * -> *). MonadServer m => ItemId -> LevelId -> m ()
validateFloor ItemId
iid LevelId
lid
  UpdCreateItem Bool
_ ItemId
iid Item
_ ItemQuant
_ (CActor ActorId
aid CStore
_) -> do
    DiscoveryAspect
discoAspect <- (State -> DiscoveryAspect) -> m DiscoveryAspect
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> DiscoveryAspect
sdiscoAspect
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (DiscoveryAspect -> ItemId -> Bool
itemAffectsShineRadius DiscoveryAspect
discoAspect ItemId
iid) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
      ActorId -> m ()
forall (m :: * -> *). MonadServer m => ActorId -> m ()
invalidateLucidAid ActorId
aid
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (DiscoveryAspect -> ItemId -> Bool
itemAffectsPerRadius DiscoveryAspect
discoAspect ItemId
iid) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ ActorId -> m ()
forall (m :: * -> *). MonadServer m => ActorId -> m ()
reconsiderPerActor ActorId
aid
  UpdCreateItem{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdDestroyItem Bool
_ ItemId
iid Item
_ ItemQuant
_ (CFloor LevelId
lid Point
_) -> ItemId -> LevelId -> m ()
forall (m :: * -> *). MonadServer m => ItemId -> LevelId -> m ()
validateFloor ItemId
iid LevelId
lid
  UpdDestroyItem Bool
_ ItemId
iid Item
_ ItemQuant
_  (CActor ActorId
aid CStore
CStash) -> do
    LevelId
lid <- ActorId -> m LevelId
forall (m :: * -> *). MonadStateRead m => ActorId -> m LevelId
levelOfStash ActorId
aid
    ItemId -> LevelId -> m ()
forall (m :: * -> *). MonadServer m => ItemId -> LevelId -> m ()
validateFloor ItemId
iid LevelId
lid
  UpdDestroyItem Bool
_ ItemId
iid Item
_ ItemQuant
_ (CActor ActorId
aid CStore
CGround) -> do
    LevelId
lid <- (State -> LevelId) -> m LevelId
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> LevelId) -> m LevelId)
-> (State -> LevelId) -> m LevelId
forall a b. (a -> b) -> a -> b
$ Actor -> LevelId
blid (Actor -> LevelId) -> (State -> Actor) -> State -> LevelId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ActorId -> State -> Actor
getActorBody ActorId
aid
    ItemId -> LevelId -> m ()
forall (m :: * -> *). MonadServer m => ItemId -> LevelId -> m ()
validateFloor ItemId
iid LevelId
lid
  UpdDestroyItem Bool
_ ItemId
iid Item
_ ItemQuant
_ (CActor ActorId
aid CStore
_) -> do
    DiscoveryAspect
discoAspect <- (State -> DiscoveryAspect) -> m DiscoveryAspect
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> DiscoveryAspect
sdiscoAspect
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (DiscoveryAspect -> ItemId -> Bool
itemAffectsShineRadius DiscoveryAspect
discoAspect ItemId
iid) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
      ActorId -> m ()
forall (m :: * -> *). MonadServer m => ActorId -> m ()
invalidateLucidAid ActorId
aid
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (DiscoveryAspect -> ItemId -> Bool
itemAffectsPerRadius DiscoveryAspect
discoAspect ItemId
iid) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ ActorId -> m ()
forall (m :: * -> *). MonadServer m => ActorId -> m ()
reconsiderPerActor ActorId
aid
  UpdDestroyItem{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdSpotActor ActorId
aid Actor
b -> do
    -- On server, it does't affect aspects, but does affect lucid (Ascend).
    ActorMaxSkills
actorMaxSkills <- (State -> ActorMaxSkills) -> m ActorMaxSkills
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> ActorMaxSkills
sactorMaxSkills
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ActorMaxSkills -> ActorId -> Bool
actorHasShine ActorMaxSkills
actorMaxSkills ActorId
aid) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ LevelId -> m ()
forall (m :: * -> *). MonadServer m => LevelId -> m ()
invalidateLucidLid (LevelId -> m ()) -> LevelId -> m ()
forall a b. (a -> b) -> a -> b
$ Actor -> LevelId
blid Actor
b
    ActorId -> Actor -> m ()
forall (m :: * -> *). MonadServer m => ActorId -> Actor -> m ()
addPerActor ActorId
aid Actor
b
  UpdLoseActor ActorId
aid Actor
b -> do
    -- On server, it does't affect aspects, but does affect lucid (Ascend).
    let actorMaxSkillsOld :: ActorMaxSkills
actorMaxSkillsOld = State -> ActorMaxSkills
sactorMaxSkills State
oldState
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ActorMaxSkills -> ActorId -> Bool
actorHasShine ActorMaxSkills
actorMaxSkillsOld ActorId
aid) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ LevelId -> m ()
forall (m :: * -> *). MonadServer m => LevelId -> m ()
invalidateLucidLid (LevelId -> m ()) -> LevelId -> m ()
forall a b. (a -> b) -> a -> b
$ Actor -> LevelId
blid Actor
b
    ActorMaxSkills -> ActorId -> Actor -> m ()
forall (m :: * -> *).
MonadServer m =>
ActorMaxSkills -> ActorId -> Actor -> m ()
deletePerActor ActorMaxSkills
actorMaxSkillsOld ActorId
aid 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
$ \StateServer
ser ->
      StateServer
ser { sactorTime :: ActorTime
sactorTime = (EnumMap LevelId (EnumMap ActorId Time)
 -> EnumMap LevelId (EnumMap ActorId Time))
-> FactionId -> ActorTime -> ActorTime
forall k a. Enum k => (a -> a) -> k -> EnumMap k a -> EnumMap k a
EM.adjust ((EnumMap ActorId Time -> EnumMap ActorId Time)
-> LevelId
-> EnumMap LevelId (EnumMap ActorId Time)
-> EnumMap LevelId (EnumMap ActorId Time)
forall k a. Enum k => (a -> a) -> k -> EnumMap k a -> EnumMap k a
EM.adjust (ActorId -> EnumMap ActorId Time -> EnumMap ActorId Time
forall k a. Enum k => k -> EnumMap k a -> EnumMap k a
EM.delete ActorId
aid) (Actor -> LevelId
blid Actor
b)) (Actor -> FactionId
bfid Actor
b)
                                   (StateServer -> ActorTime
sactorTime StateServer
ser)
          , strajTime :: ActorTime
strajTime = (EnumMap LevelId (EnumMap ActorId Time)
 -> EnumMap LevelId (EnumMap ActorId Time))
-> FactionId -> ActorTime -> ActorTime
forall k a. Enum k => (a -> a) -> k -> EnumMap k a -> EnumMap k a
EM.adjust ((EnumMap ActorId Time -> EnumMap ActorId Time)
-> LevelId
-> EnumMap LevelId (EnumMap ActorId Time)
-> EnumMap LevelId (EnumMap ActorId Time)
forall k a. Enum k => (a -> a) -> k -> EnumMap k a -> EnumMap k a
EM.adjust (ActorId -> EnumMap ActorId Time -> EnumMap ActorId Time
forall k a. Enum k => k -> EnumMap k a -> EnumMap k a
EM.delete ActorId
aid) (Actor -> LevelId
blid Actor
b)) (Actor -> FactionId
bfid Actor
b)
                                  (StateServer -> ActorTime
strajTime StateServer
ser)
          , strajPushedBy :: ActorPushedBy
strajPushedBy = ActorId -> ActorPushedBy -> ActorPushedBy
forall k a. Enum k => k -> EnumMap k a -> EnumMap k a
EM.delete ActorId
aid (StateServer -> ActorPushedBy
strajPushedBy StateServer
ser)
          , sactorAn :: ActorAnalytics
sactorAn = ActorId -> ActorAnalytics -> ActorAnalytics
forall k a. Enum k => k -> EnumMap k a -> EnumMap k a
EM.delete ActorId
aid (StateServer -> ActorAnalytics
sactorAn StateServer
ser)
          , sactorStasis :: EnumSet ActorId
sactorStasis = ActorId -> EnumSet ActorId -> EnumSet ActorId
forall k. Enum k => k -> EnumSet k -> EnumSet k
ES.delete ActorId
aid (StateServer -> EnumSet ActorId
sactorStasis StateServer
ser) }
  UpdSpotItem Bool
_ ItemId
iid ItemQuant
_ (CFloor LevelId
lid Point
_) -> ItemId -> LevelId -> m ()
forall (m :: * -> *). MonadServer m => ItemId -> LevelId -> m ()
validateFloor ItemId
iid LevelId
lid
  UpdSpotItem Bool
_ ItemId
iid ItemQuant
_  (CActor ActorId
aid CStore
CStash) -> do
    LevelId
lid <- ActorId -> m LevelId
forall (m :: * -> *). MonadStateRead m => ActorId -> m LevelId
levelOfStash ActorId
aid
    ItemId -> LevelId -> m ()
forall (m :: * -> *). MonadServer m => ItemId -> LevelId -> m ()
validateFloor ItemId
iid LevelId
lid
  UpdSpotItem Bool
_ ItemId
iid ItemQuant
_ (CActor ActorId
aid CStore
CGround) -> do
    LevelId
lid <- (State -> LevelId) -> m LevelId
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> LevelId) -> m LevelId)
-> (State -> LevelId) -> m LevelId
forall a b. (a -> b) -> a -> b
$ Actor -> LevelId
blid (Actor -> LevelId) -> (State -> Actor) -> State -> LevelId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ActorId -> State -> Actor
getActorBody ActorId
aid
    ItemId -> LevelId -> m ()
forall (m :: * -> *). MonadServer m => ItemId -> LevelId -> m ()
validateFloor ItemId
iid LevelId
lid
  UpdSpotItem Bool
_ ItemId
iid ItemQuant
_ (CActor ActorId
aid CStore
_) -> do
    DiscoveryAspect
discoAspect <- (State -> DiscoveryAspect) -> m DiscoveryAspect
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> DiscoveryAspect
sdiscoAspect
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (DiscoveryAspect -> ItemId -> Bool
itemAffectsShineRadius DiscoveryAspect
discoAspect ItemId
iid) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
      ActorId -> m ()
forall (m :: * -> *). MonadServer m => ActorId -> m ()
invalidateLucidAid ActorId
aid
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (DiscoveryAspect -> ItemId -> Bool
itemAffectsPerRadius DiscoveryAspect
discoAspect ItemId
iid) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ ActorId -> m ()
forall (m :: * -> *). MonadServer m => ActorId -> m ()
reconsiderPerActor ActorId
aid
  UpdSpotItem{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdLoseItem Bool
_ ItemId
iid ItemQuant
_ (CFloor LevelId
lid Point
_) -> ItemId -> LevelId -> m ()
forall (m :: * -> *). MonadServer m => ItemId -> LevelId -> m ()
validateFloor ItemId
iid LevelId
lid
  UpdLoseItem Bool
_ ItemId
iid ItemQuant
_ (CActor ActorId
aid CStore
CStash) -> do
    LevelId
lid <- ActorId -> m LevelId
forall (m :: * -> *). MonadStateRead m => ActorId -> m LevelId
levelOfStash ActorId
aid
    ItemId -> LevelId -> m ()
forall (m :: * -> *). MonadServer m => ItemId -> LevelId -> m ()
validateFloor ItemId
iid LevelId
lid
  UpdLoseItem Bool
_ ItemId
iid ItemQuant
_ (CActor ActorId
aid CStore
CGround) -> do
    LevelId
lid <- (State -> LevelId) -> m LevelId
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> LevelId) -> m LevelId)
-> (State -> LevelId) -> m LevelId
forall a b. (a -> b) -> a -> b
$ Actor -> LevelId
blid (Actor -> LevelId) -> (State -> Actor) -> State -> LevelId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ActorId -> State -> Actor
getActorBody ActorId
aid
    ItemId -> LevelId -> m ()
forall (m :: * -> *). MonadServer m => ItemId -> LevelId -> m ()
validateFloor ItemId
iid LevelId
lid
  UpdLoseItem Bool
_ ItemId
iid ItemQuant
_ (CActor ActorId
aid CStore
_) -> do
    DiscoveryAspect
discoAspect <- (State -> DiscoveryAspect) -> m DiscoveryAspect
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> DiscoveryAspect
sdiscoAspect
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (DiscoveryAspect -> ItemId -> Bool
itemAffectsShineRadius DiscoveryAspect
discoAspect ItemId
iid) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
      ActorId -> m ()
forall (m :: * -> *). MonadServer m => ActorId -> m ()
invalidateLucidAid ActorId
aid
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (DiscoveryAspect -> ItemId -> Bool
itemAffectsPerRadius DiscoveryAspect
discoAspect ItemId
iid) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ ActorId -> m ()
forall (m :: * -> *). MonadServer m => ActorId -> m ()
reconsiderPerActor ActorId
aid
  UpdLoseItem{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdSpotItemBag Bool
_ (CFloor LevelId
lid Point
_) ItemBag
bag  -> ItemBag -> LevelId -> m ()
forall (m :: * -> *). MonadServer m => ItemBag -> LevelId -> m ()
validateFloorBag ItemBag
bag LevelId
lid
  UpdSpotItemBag Bool
_ (CActor ActorId
aid CStore
CStash) ItemBag
bag -> do
    LevelId
lid <- ActorId -> m LevelId
forall (m :: * -> *). MonadStateRead m => ActorId -> m LevelId
levelOfStash ActorId
aid
    ItemBag -> LevelId -> m ()
forall (m :: * -> *). MonadServer m => ItemBag -> LevelId -> m ()
validateFloorBag ItemBag
bag LevelId
lid
  UpdSpotItemBag Bool
_ (CActor ActorId
aid CStore
CGround) ItemBag
bag -> do
    LevelId
lid <- (State -> LevelId) -> m LevelId
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> LevelId) -> m LevelId)
-> (State -> LevelId) -> m LevelId
forall a b. (a -> b) -> a -> b
$ Actor -> LevelId
blid (Actor -> LevelId) -> (State -> Actor) -> State -> LevelId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ActorId -> State -> Actor
getActorBody ActorId
aid
    ItemBag -> LevelId -> m ()
forall (m :: * -> *). MonadServer m => ItemBag -> LevelId -> m ()
validateFloorBag ItemBag
bag LevelId
lid
  UpdSpotItemBag Bool
_ (CActor ActorId
aid CStore
_) ItemBag
bag -> do
    DiscoveryAspect
discoAspect <- (State -> DiscoveryAspect) -> m DiscoveryAspect
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> DiscoveryAspect
sdiscoAspect
    let iids :: [ItemId]
iids = ItemBag -> [ItemId]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys ItemBag
bag
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((ItemId -> Bool) -> [ItemId] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (DiscoveryAspect -> ItemId -> Bool
itemAffectsShineRadius DiscoveryAspect
discoAspect) [ItemId]
iids) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
      ActorId -> m ()
forall (m :: * -> *). MonadServer m => ActorId -> m ()
invalidateLucidAid ActorId
aid
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((ItemId -> Bool) -> [ItemId] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (DiscoveryAspect -> ItemId -> Bool
itemAffectsPerRadius DiscoveryAspect
discoAspect) [ItemId]
iids) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
      ActorId -> m ()
forall (m :: * -> *). MonadServer m => ActorId -> m ()
reconsiderPerActor ActorId
aid
  UpdSpotItemBag{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdLoseItemBag Bool
_ (CFloor LevelId
lid Point
_) ItemBag
bag -> ItemBag -> LevelId -> m ()
forall (m :: * -> *). MonadServer m => ItemBag -> LevelId -> m ()
validateFloorBag ItemBag
bag LevelId
lid
  UpdLoseItemBag Bool
_ (CActor ActorId
aid CStore
CStash) ItemBag
bag -> do
    LevelId
lid <- ActorId -> m LevelId
forall (m :: * -> *). MonadStateRead m => ActorId -> m LevelId
levelOfStash ActorId
aid
    ItemBag -> LevelId -> m ()
forall (m :: * -> *). MonadServer m => ItemBag -> LevelId -> m ()
validateFloorBag ItemBag
bag LevelId
lid
  UpdLoseItemBag Bool
_ (CActor ActorId
aid CStore
CGround) ItemBag
bag -> do
    LevelId
lid <- ActorId -> m LevelId
forall (m :: * -> *). MonadStateRead m => ActorId -> m LevelId
levelOfStash ActorId
aid
    ItemBag -> LevelId -> m ()
forall (m :: * -> *). MonadServer m => ItemBag -> LevelId -> m ()
validateFloorBag ItemBag
bag LevelId
lid
  UpdLoseItemBag Bool
_ (CActor ActorId
aid CStore
_) ItemBag
bag -> do
    DiscoveryAspect
discoAspect <- (State -> DiscoveryAspect) -> m DiscoveryAspect
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> DiscoveryAspect
sdiscoAspect
    let iids :: [ItemId]
iids = ItemBag -> [ItemId]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys ItemBag
bag
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((ItemId -> Bool) -> [ItemId] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (DiscoveryAspect -> ItemId -> Bool
itemAffectsShineRadius DiscoveryAspect
discoAspect) [ItemId]
iids) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
      ActorId -> m ()
forall (m :: * -> *). MonadServer m => ActorId -> m ()
invalidateLucidAid ActorId
aid
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((ItemId -> Bool) -> [ItemId] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (DiscoveryAspect -> ItemId -> Bool
itemAffectsPerRadius DiscoveryAspect
discoAspect) [ItemId]
iids) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
      ActorId -> m ()
forall (m :: * -> *). MonadServer m => ActorId -> m ()
reconsiderPerActor ActorId
aid
  UpdLoseItemBag{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdMoveActor ActorId
aid Point
_ Point
_ -> do
    ActorMaxSkills
actorMaxSkills <- (State -> ActorMaxSkills) -> m ActorMaxSkills
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> ActorMaxSkills
sactorMaxSkills
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ActorMaxSkills -> ActorId -> Bool
actorHasShine ActorMaxSkills
actorMaxSkills ActorId
aid) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ ActorId -> m ()
forall (m :: * -> *). MonadServer m => ActorId -> m ()
invalidateLucidAid ActorId
aid
    ActorId -> m ()
forall (m :: * -> *). MonadServer m => ActorId -> m ()
invalidatePerActor ActorId
aid
  UpdWaitActor{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdDisplaceActor ActorId
aid1 ActorId
aid2 -> do
    ActorMaxSkills
actorMaxSkills <- (State -> ActorMaxSkills) -> m ActorMaxSkills
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> ActorMaxSkills
sactorMaxSkills
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ActorMaxSkills -> ActorId -> Bool
actorHasShine ActorMaxSkills
actorMaxSkills ActorId
aid1
          Bool -> Bool -> Bool
|| ActorMaxSkills -> ActorId -> Bool
actorHasShine ActorMaxSkills
actorMaxSkills ActorId
aid2) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
      ActorId -> m ()
forall (m :: * -> *). MonadServer m => ActorId -> m ()
invalidateLucidAid ActorId
aid1  -- the same lid as aid2
    ActorId -> m ()
forall (m :: * -> *). MonadServer m => ActorId -> m ()
invalidatePerActor ActorId
aid1
    ActorId -> m ()
forall (m :: * -> *). MonadServer m => ActorId -> m ()
invalidatePerActor ActorId
aid2
  UpdMoveItem ItemId
iid Int
_k ActorId
aid CStore
s1 CStore
s2 -> do
    let dummyVerbose :: Bool
dummyVerbose = Bool
False
        dummyKit :: ItemQuant
dummyKit = ItemQuant
quantSingle
    State -> UpdAtomic -> m ()
forall (m :: * -> *). MonadServer m => State -> UpdAtomic -> m ()
cmdAtomicSemSer State
oldState (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$
      Bool -> ItemId -> ItemQuant -> Container -> UpdAtomic
UpdLoseItem Bool
dummyVerbose ItemId
iid ItemQuant
dummyKit (ActorId -> CStore -> Container
CActor ActorId
aid CStore
s1)
    State -> UpdAtomic -> m ()
forall (m :: * -> *). MonadServer m => State -> UpdAtomic -> m ()
cmdAtomicSemSer State
oldState (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$
      Bool -> ItemId -> ItemQuant -> Container -> UpdAtomic
UpdSpotItem Bool
dummyVerbose ItemId
iid ItemQuant
dummyKit (ActorId -> CStore -> Container
CActor ActorId
aid CStore
s2)
  UpdRefillHP{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdRefillCalm ActorId
aid Int64
_ -> do
    Skills
actorMaxSk <- (State -> Skills) -> m Skills
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Skills) -> m Skills) -> (State -> Skills) -> m Skills
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Skills
getActorMaxSkills ActorId
aid
    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
    let sight :: Int
sight = Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkSight Skills
actorMaxSk
        oldBody :: Actor
oldBody = ActorId -> State -> Actor
getActorBody ActorId
aid State
oldState
        radiusOld :: Int
radiusOld = Int -> Int64 -> Int
boundSightByCalm Int
sight (Actor -> Int64
bcalm Actor
oldBody)
        radiusNew :: Int
radiusNew = Int -> Int64 -> Int
boundSightByCalm Int
sight (Actor -> Int64
bcalm Actor
body)
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
radiusOld Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
radiusNew) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ ActorId -> m ()
forall (m :: * -> *). MonadServer m => ActorId -> m ()
invalidatePerActor ActorId
aid
  UpdTrajectory{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdQuitFaction{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdSpotStashFaction Bool
_ FactionId
fid LevelId
lid Point
_ -> FactionId -> LevelId -> m ()
forall (m :: * -> *). MonadServer m => FactionId -> LevelId -> m ()
invalidatePerFidLid FactionId
fid LevelId
lid
  UpdLoseStashFaction Bool
_ FactionId
fid LevelId
lid Point
_ -> FactionId -> LevelId -> m ()
forall (m :: * -> *). MonadServer m => FactionId -> LevelId -> m ()
invalidatePerFidLid FactionId
fid LevelId
lid
  UpdLeadFaction{} -> m ()
forall (m :: * -> *). MonadServer m => m ()
invalidateArenas
  UpdDiplFaction{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdDoctrineFaction{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdAutoFaction{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdRecordKill{} -> m ()
forall (m :: * -> *). MonadServer m => m ()
invalidateArenas
  UpdAlterTile LevelId
lid Point
pos ContentId TileKind
fromTile ContentId TileKind
toTile -> do
    Bool
clearChanged <- LevelId
-> Point -> ContentId TileKind -> ContentId TileKind -> m Bool
forall (m :: * -> *).
MonadServer m =>
LevelId
-> Point -> ContentId TileKind -> ContentId TileKind -> m Bool
updateSclear LevelId
lid Point
pos ContentId TileKind
fromTile ContentId TileKind
toTile
    Bool
litChanged <- LevelId
-> Point -> ContentId TileKind -> ContentId TileKind -> m Bool
forall (m :: * -> *).
MonadServer m =>
LevelId
-> Point -> ContentId TileKind -> ContentId TileKind -> m Bool
updateSlit LevelId
lid Point
pos ContentId TileKind
fromTile ContentId TileKind
toTile
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
clearChanged Bool -> Bool -> Bool
|| Bool
litChanged) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ LevelId -> m ()
forall (m :: * -> *). MonadServer m => LevelId -> m ()
invalidateLucidLid LevelId
lid
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
clearChanged (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ LevelId -> m ()
forall (m :: * -> *). MonadServer m => LevelId -> m ()
invalidatePerLid LevelId
lid
  UpdAlterExplorable{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdAlterGold{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdSearchTile{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdHideTile{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdSpotTile{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdLoseTile{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdSpotEntry{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdLoseEntry{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdAlterSmell{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdSpotSmell{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdLoseSmell{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdTimeItem{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdAgeGame{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdUnAgeGame{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdDiscover{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdCover{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdDiscoverKind{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdCoverKind{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdDiscoverAspect{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdCoverAspect{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdDiscoverServer{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdCoverServer{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdPerception{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdRestart{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdRestartServer{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdResume{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdResumeServer{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdKillExit{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdWriteSave{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdHearFid{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdMuteMessages{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

validateFloor :: MonadServer m => ItemId -> LevelId -> m ()
validateFloor :: ItemId -> LevelId -> m ()
validateFloor ItemId
iid LevelId
lid = do
  DiscoveryAspect
discoAspect <- (State -> DiscoveryAspect) -> m DiscoveryAspect
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> DiscoveryAspect
sdiscoAspect
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (DiscoveryAspect -> ItemId -> Bool
itemAffectsShineRadius DiscoveryAspect
discoAspect ItemId
iid) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ LevelId -> m ()
forall (m :: * -> *). MonadServer m => LevelId -> m ()
invalidateLucidLid LevelId
lid

validateFloorBag :: MonadServer m => ItemBag -> LevelId -> m ()
validateFloorBag :: ItemBag -> LevelId -> m ()
validateFloorBag ItemBag
bag LevelId
lid = do
  DiscoveryAspect
discoAspect <- (State -> DiscoveryAspect) -> m DiscoveryAspect
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> DiscoveryAspect
sdiscoAspect
  let iids :: [ItemId]
iids = ItemBag -> [ItemId]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys ItemBag
bag
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((ItemId -> Bool) -> [ItemId] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (DiscoveryAspect -> ItemId -> Bool
itemAffectsShineRadius DiscoveryAspect
discoAspect) [ItemId]
iids) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
    LevelId -> m ()
forall (m :: * -> *). MonadServer m => LevelId -> m ()
invalidateLucidLid LevelId
lid

levelOfStash :: MonadStateRead m => ActorId -> m LevelId
levelOfStash :: ActorId -> m LevelId
levelOfStash 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
  Maybe (LevelId, Point)
mstash <- (State -> Maybe (LevelId, Point)) -> m (Maybe (LevelId, Point))
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Maybe (LevelId, Point)) -> m (Maybe (LevelId, Point)))
-> (State -> Maybe (LevelId, Point)) -> m (Maybe (LevelId, Point))
forall a b. (a -> b) -> a -> b
$ \State
s -> Faction -> Maybe (LevelId, Point)
gstash (Faction -> Maybe (LevelId, Point))
-> Faction -> Maybe (LevelId, Point)
forall a b. (a -> b) -> a -> b
$ State -> FactionDict
sfactionD State
s FactionDict -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
b
  case Maybe (LevelId, Point)
mstash of
    Just (LevelId
lid, Point
_) -> LevelId -> m LevelId
forall (m :: * -> *) a. Monad m => a -> m a
return LevelId
lid
    Maybe (LevelId, Point)
Nothing -> [Char] -> m LevelId
forall a. HasCallStack => [Char] -> a
error ([Char] -> m LevelId) -> [Char] -> m LevelId
forall a b. (a -> b) -> a -> b
$ [Char]
"" [Char] -> (ActorId, Actor) -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` (ActorId
aid, Actor
b)

invalidateArenas :: MonadServer m => m ()
invalidateArenas :: m ()
invalidateArenas = (StateServer -> StateServer) -> m ()
forall (m :: * -> *).
MonadServer m =>
(StateServer -> StateServer) -> m ()
modifyServer ((StateServer -> StateServer) -> m ())
-> (StateServer -> StateServer) -> m ()
forall a b. (a -> b) -> a -> b
$ \StateServer
ser -> StateServer
ser {svalidArenas :: Bool
svalidArenas = Bool
False}

updateSclear :: MonadServer m
             => LevelId -> Point -> ContentId TileKind -> ContentId TileKind
             -> m Bool
updateSclear :: LevelId
-> Point -> ContentId TileKind -> ContentId TileKind -> m Bool
updateSclear LevelId
lid Point
pos ContentId TileKind
fromTile ContentId TileKind
toTile = do
  COps{TileSpeedup
coTileSpeedup :: COps -> TileSpeedup
coTileSpeedup :: TileSpeedup
coTileSpeedup} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  let fromClear :: Bool
fromClear = TileSpeedup -> ContentId TileKind -> Bool
Tile.isClear TileSpeedup
coTileSpeedup ContentId TileKind
fromTile
      toClear :: Bool
toClear = TileSpeedup -> ContentId TileKind -> Bool
Tile.isClear TileSpeedup
coTileSpeedup ContentId TileKind
toTile
  if Bool
fromClear Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
toClear then Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False else do
    let f :: FovClear -> FovClear
f FovClear{Array Bool
fovClear :: FovClear -> Array Bool
fovClear :: Array Bool
fovClear} =
          Array Bool -> FovClear
FovClear (Array Bool -> FovClear) -> Array Bool -> FovClear
forall a b. (a -> b) -> a -> b
$ Array Bool
fovClear Array Bool -> [(Point, Bool)] -> Array Bool
forall c. UnboxRepClass c => Array c -> [(Point, c)] -> Array c
PointArray.// [(Point
pos, Bool
toClear)]
    (StateServer -> StateServer) -> m ()
forall (m :: * -> *).
MonadServer m =>
(StateServer -> StateServer) -> m ()
modifyServer ((StateServer -> StateServer) -> m ())
-> (StateServer -> StateServer) -> m ()
forall a b. (a -> b) -> a -> b
$ \StateServer
ser ->
      StateServer
ser {sfovClearLid :: FovClearLid
sfovClearLid = (FovClear -> FovClear) -> LevelId -> FovClearLid -> FovClearLid
forall k a. Enum k => (a -> a) -> k -> EnumMap k a -> EnumMap k a
EM.adjust FovClear -> FovClear
f LevelId
lid (FovClearLid -> FovClearLid) -> FovClearLid -> FovClearLid
forall a b. (a -> b) -> a -> b
$ StateServer -> FovClearLid
sfovClearLid StateServer
ser}
    Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True

updateSlit :: MonadServer m
           => LevelId -> Point -> ContentId TileKind -> ContentId TileKind
           -> m Bool
updateSlit :: LevelId
-> Point -> ContentId TileKind -> ContentId TileKind -> m Bool
updateSlit LevelId
lid Point
pos ContentId TileKind
fromTile ContentId TileKind
toTile = do
  COps{TileSpeedup
coTileSpeedup :: TileSpeedup
coTileSpeedup :: COps -> TileSpeedup
coTileSpeedup} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  let fromLit :: Bool
fromLit = TileSpeedup -> ContentId TileKind -> Bool
Tile.isLit TileSpeedup
coTileSpeedup ContentId TileKind
fromTile
      toLit :: Bool
toLit = TileSpeedup -> ContentId TileKind -> Bool
Tile.isLit TileSpeedup
coTileSpeedup ContentId TileKind
toTile
  if Bool
fromLit Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
toLit then Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False else do
    let f :: FovLit -> FovLit
f (FovLit EnumSet Point
set) =
          EnumSet Point -> FovLit
FovLit (EnumSet Point -> FovLit) -> EnumSet Point -> FovLit
forall a b. (a -> b) -> a -> b
$ if Bool
toLit then Point -> EnumSet Point -> EnumSet Point
forall k. Enum k => k -> EnumSet k -> EnumSet k
ES.insert Point
pos EnumSet Point
set else Point -> EnumSet Point -> EnumSet Point
forall k. Enum k => k -> EnumSet k -> EnumSet k
ES.delete Point
pos EnumSet Point
set
    (StateServer -> StateServer) -> m ()
forall (m :: * -> *).
MonadServer m =>
(StateServer -> StateServer) -> m ()
modifyServer ((StateServer -> StateServer) -> m ())
-> (StateServer -> StateServer) -> m ()
forall a b. (a -> b) -> a -> b
$ \StateServer
ser -> StateServer
ser {sfovLitLid :: FovLitLid
sfovLitLid = (FovLit -> FovLit) -> LevelId -> FovLitLid -> FovLitLid
forall k a. Enum k => (a -> a) -> k -> EnumMap k a -> EnumMap k a
EM.adjust FovLit -> FovLit
f LevelId
lid (FovLitLid -> FovLitLid) -> FovLitLid -> FovLitLid
forall a b. (a -> b) -> a -> b
$ StateServer -> FovLitLid
sfovLitLid StateServer
ser}
    Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True

invalidateLucidLid :: MonadServer m => LevelId -> m ()
invalidateLucidLid :: LevelId -> m ()
invalidateLucidLid LevelId
lid =
  (StateServer -> StateServer) -> m ()
forall (m :: * -> *).
MonadServer m =>
(StateServer -> StateServer) -> m ()
modifyServer ((StateServer -> StateServer) -> m ())
-> (StateServer -> StateServer) -> m ()
forall a b. (a -> b) -> a -> b
$ \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 FovValid FovLucid
forall a. FovValid a
FovInvalid (FovLucidLid -> FovLucidLid) -> FovLucidLid -> FovLucidLid
forall a b. (a -> b) -> a -> b
$ StateServer -> FovLucidLid
sfovLucidLid StateServer
ser
        , sperValidFid :: PerValidFid
sperValidFid = (EnumMap LevelId Bool -> EnumMap LevelId Bool)
-> PerValidFid -> PerValidFid
forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
EM.map (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
False) (PerValidFid -> PerValidFid) -> PerValidFid -> PerValidFid
forall a b. (a -> b) -> a -> b
$ StateServer -> PerValidFid
sperValidFid StateServer
ser }

invalidateLucidAid :: MonadServer m => ActorId -> m ()
invalidateLucidAid :: ActorId -> m ()
invalidateLucidAid ActorId
aid = do
  LevelId
lid <- (State -> LevelId) -> m LevelId
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> LevelId) -> m LevelId)
-> (State -> LevelId) -> m LevelId
forall a b. (a -> b) -> a -> b
$ Actor -> LevelId
blid (Actor -> LevelId) -> (State -> Actor) -> State -> LevelId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ActorId -> State -> Actor
getActorBody ActorId
aid
  LevelId -> m ()
forall (m :: * -> *). MonadServer m => LevelId -> m ()
invalidateLucidLid LevelId
lid

actorHasShine :: ActorMaxSkills -> ActorId -> Bool
actorHasShine :: ActorMaxSkills -> ActorId -> Bool
actorHasShine ActorMaxSkills
actorMaxSkills ActorId
aid = case ActorId -> ActorMaxSkills -> Maybe Skills
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup ActorId
aid ActorMaxSkills
actorMaxSkills of
  Just Skills
actorMaxSk -> Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkShine Skills
actorMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
  Maybe Skills
Nothing -> [Char] -> Bool
forall a. HasCallStack => [Char] -> a
error ([Char] -> Bool) -> [Char] -> Bool
forall a b. (a -> b) -> a -> b
$ [Char]
"" [Char] -> ActorId -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` ActorId
aid

itemAffectsShineRadius :: DiscoveryAspect -> ItemId -> Bool
itemAffectsShineRadius :: DiscoveryAspect -> ItemId -> Bool
itemAffectsShineRadius DiscoveryAspect
discoAspect ItemId
iid = case ItemId -> DiscoveryAspect -> Maybe AspectRecord
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup ItemId
iid DiscoveryAspect
discoAspect of
  Just AspectRecord
arItem -> Skill -> AspectRecord -> Int
IA.getSkill Skill
Ability.SkShine AspectRecord
arItem Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0
  Maybe AspectRecord
Nothing -> [Char] -> Bool
forall a. HasCallStack => [Char] -> a
error ([Char] -> Bool) -> [Char] -> Bool
forall a b. (a -> b) -> a -> b
$ [Char]
"" [Char] -> ItemId -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` ItemId
iid

itemAffectsPerRadius :: DiscoveryAspect -> ItemId -> Bool
itemAffectsPerRadius :: DiscoveryAspect -> ItemId -> Bool
itemAffectsPerRadius DiscoveryAspect
discoAspect ItemId
iid =
  case ItemId -> DiscoveryAspect -> Maybe AspectRecord
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup ItemId
iid DiscoveryAspect
discoAspect of
    Just AspectRecord
arItem -> Skill -> AspectRecord -> Int
IA.getSkill Skill
Ability.SkSight AspectRecord
arItem Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0
               Bool -> Bool -> Bool
|| Skill -> AspectRecord -> Int
IA.getSkill Skill
Ability.SkSmell AspectRecord
arItem Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0
               Bool -> Bool -> Bool
|| Skill -> AspectRecord -> Int
IA.getSkill Skill
Ability.SkNocto AspectRecord
arItem Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0
    Maybe AspectRecord
Nothing -> [Char] -> Bool
forall a. HasCallStack => [Char] -> a
error ([Char] -> Bool) -> [Char] -> Bool
forall a b. (a -> b) -> a -> b
$ [Char]
"" [Char] -> ItemId -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` ItemId
iid

addPerActor :: MonadServer m => ActorId -> Actor -> m ()
addPerActor :: ActorId -> Actor -> m ()
addPerActor ActorId
aid Actor
b = do
  Skills
actorMaxSk <- (State -> Skills) -> m Skills
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Skills) -> m Skills) -> (State -> Skills) -> m Skills
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Skills
getActorMaxSkills ActorId
aid
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkSight Skills
actorMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
          Bool -> Bool -> Bool
&& Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkNocto Skills
actorMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
          Bool -> Bool -> Bool
&& Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkSmell Skills
actorMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
    ActorId -> Actor -> m ()
forall (m :: * -> *). MonadServer m => ActorId -> Actor -> m ()
addPerActorAny ActorId
aid Actor
b

addPerActorAny :: MonadServer m => ActorId -> Actor -> m ()
addPerActorAny :: ActorId -> Actor -> m ()
addPerActorAny ActorId
aid Actor
b = do
  let fid :: FactionId
fid = Actor -> FactionId
bfid Actor
b
      lid :: LevelId
lid = Actor -> LevelId
blid Actor
b
      f :: PerceptionCache -> PerceptionCache
f PerceptionCache{PerActor
perActor :: PerceptionCache -> PerActor
perActor :: PerActor
perActor} = PerceptionCache :: FovValid CacheBeforeLucid -> PerActor -> PerceptionCache
PerceptionCache
        { ptotal :: FovValid CacheBeforeLucid
ptotal = FovValid CacheBeforeLucid
forall a. FovValid a
FovInvalid
        , perActor :: PerActor
perActor = ActorId -> FovValid CacheBeforeLucid -> PerActor -> PerActor
forall k a. Enum k => k -> a -> EnumMap k a -> EnumMap k a
EM.insert ActorId
aid FovValid CacheBeforeLucid
forall a. FovValid a
FovInvalid PerActor
perActor }
  (StateServer -> StateServer) -> m ()
forall (m :: * -> *).
MonadServer m =>
(StateServer -> StateServer) -> m ()
modifyServer ((StateServer -> StateServer) -> m ())
-> (StateServer -> StateServer) -> m ()
forall a b. (a -> b) -> a -> b
$ \StateServer
ser ->
    StateServer
ser { sperCacheFid :: PerCacheFid
sperCacheFid = (EnumMap LevelId PerceptionCache
 -> EnumMap LevelId PerceptionCache)
-> FactionId -> PerCacheFid -> PerCacheFid
forall k a. Enum k => (a -> a) -> k -> EnumMap k a -> EnumMap k a
EM.adjust ((PerceptionCache -> PerceptionCache)
-> LevelId
-> EnumMap LevelId PerceptionCache
-> EnumMap LevelId PerceptionCache
forall k a. Enum k => (a -> a) -> k -> EnumMap k a -> EnumMap k a
EM.adjust PerceptionCache -> PerceptionCache
f LevelId
lid) FactionId
fid (PerCacheFid -> PerCacheFid) -> PerCacheFid -> PerCacheFid
forall a b. (a -> b) -> a -> b
$ StateServer -> PerCacheFid
sperCacheFid StateServer
ser
        , sperValidFid :: PerValidFid
sperValidFid = (EnumMap LevelId Bool -> EnumMap LevelId Bool)
-> FactionId -> PerValidFid -> PerValidFid
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
False) FactionId
fid
                         (PerValidFid -> PerValidFid) -> PerValidFid -> PerValidFid
forall a b. (a -> b) -> a -> b
$ StateServer -> PerValidFid
sperValidFid StateServer
ser }

deletePerActor :: MonadServer m => ActorMaxSkills -> ActorId -> Actor -> m ()
deletePerActor :: ActorMaxSkills -> ActorId -> Actor -> m ()
deletePerActor ActorMaxSkills
actorMaxSkillsOld ActorId
aid Actor
b = do
  let actorMaxSk :: Skills
actorMaxSk = ActorMaxSkills
actorMaxSkillsOld ActorMaxSkills -> ActorId -> Skills
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ActorId
aid
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkSight Skills
actorMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
          Bool -> Bool -> Bool
&& Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkNocto Skills
actorMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
          Bool -> Bool -> Bool
&& Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkSmell Skills
actorMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
    ActorId -> Actor -> m ()
forall (m :: * -> *). MonadServer m => ActorId -> Actor -> m ()
deletePerActorAny ActorId
aid Actor
b

deletePerActorAny :: MonadServer m => ActorId -> Actor -> m ()
deletePerActorAny :: ActorId -> Actor -> m ()
deletePerActorAny ActorId
aid Actor
b = do
  let fid :: FactionId
fid = Actor -> FactionId
bfid Actor
b
      lid :: LevelId
lid = Actor -> LevelId
blid Actor
b
      f :: PerceptionCache -> PerceptionCache
f PerceptionCache{PerActor
perActor :: PerActor
perActor :: PerceptionCache -> PerActor
perActor} = PerceptionCache :: FovValid CacheBeforeLucid -> PerActor -> PerceptionCache
PerceptionCache
        { ptotal :: FovValid CacheBeforeLucid
ptotal = FovValid CacheBeforeLucid
forall a. FovValid a
FovInvalid
        , perActor :: PerActor
perActor = ActorId -> PerActor -> PerActor
forall k a. Enum k => k -> EnumMap k a -> EnumMap k a
EM.delete ActorId
aid PerActor
perActor }
  (StateServer -> StateServer) -> m ()
forall (m :: * -> *).
MonadServer m =>
(StateServer -> StateServer) -> m ()
modifyServer ((StateServer -> StateServer) -> m ())
-> (StateServer -> StateServer) -> m ()
forall a b. (a -> b) -> a -> b
$ \StateServer
ser ->
    StateServer
ser { sperCacheFid :: PerCacheFid
sperCacheFid = (EnumMap LevelId PerceptionCache
 -> EnumMap LevelId PerceptionCache)
-> FactionId -> PerCacheFid -> PerCacheFid
forall k a. Enum k => (a -> a) -> k -> EnumMap k a -> EnumMap k a
EM.adjust ((PerceptionCache -> PerceptionCache)
-> LevelId
-> EnumMap LevelId PerceptionCache
-> EnumMap LevelId PerceptionCache
forall k a. Enum k => (a -> a) -> k -> EnumMap k a -> EnumMap k a
EM.adjust PerceptionCache -> PerceptionCache
f LevelId
lid) FactionId
fid (PerCacheFid -> PerCacheFid) -> PerCacheFid -> PerCacheFid
forall a b. (a -> b) -> a -> b
$ StateServer -> PerCacheFid
sperCacheFid StateServer
ser
        , sperValidFid :: PerValidFid
sperValidFid = (EnumMap LevelId Bool -> EnumMap LevelId Bool)
-> FactionId -> PerValidFid -> PerValidFid
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
False) FactionId
fid
                         (PerValidFid -> PerValidFid) -> PerValidFid -> PerValidFid
forall a b. (a -> b) -> a -> b
$ StateServer -> PerValidFid
sperValidFid StateServer
ser }

invalidatePerActor :: MonadServer m => ActorId -> m ()
invalidatePerActor :: ActorId -> m ()
invalidatePerActor ActorId
aid = do
  Skills
actorMaxSk <- (State -> Skills) -> m Skills
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Skills) -> m Skills) -> (State -> Skills) -> m Skills
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Skills
getActorMaxSkills ActorId
aid
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkSight Skills
actorMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
          Bool -> Bool -> Bool
&& Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkNocto Skills
actorMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
          Bool -> Bool -> Bool
&& Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkSmell Skills
actorMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ 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
    ActorId -> Actor -> m ()
forall (m :: * -> *). MonadServer m => ActorId -> Actor -> m ()
addPerActorAny ActorId
aid Actor
b

reconsiderPerActor :: MonadServer m => ActorId -> m ()
reconsiderPerActor :: ActorId -> m ()
reconsiderPerActor ActorId
aid = do
  Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
  Skills
actorMaxSk <- (State -> Skills) -> m Skills
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Skills) -> m Skills) -> (State -> Skills) -> m Skills
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Skills
getActorMaxSkills ActorId
aid
  if Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkSight Skills
actorMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
     Bool -> Bool -> Bool
&& Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkNocto Skills
actorMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
     Bool -> Bool -> Bool
&& Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkSmell Skills
actorMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
  then do
    PerCacheFid
perCacheFid <- (StateServer -> PerCacheFid) -> m PerCacheFid
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> PerCacheFid
sperCacheFid
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ActorId -> PerActor -> Bool
forall k a. Enum k => k -> EnumMap k a -> Bool
EM.member ActorId
aid (PerActor -> Bool) -> PerActor -> Bool
forall a b. (a -> b) -> a -> b
$ PerceptionCache -> PerActor
perActor ((PerCacheFid
perCacheFid PerCacheFid -> FactionId -> EnumMap LevelId PerceptionCache
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
b) EnumMap LevelId PerceptionCache -> LevelId -> PerceptionCache
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> LevelId
blid Actor
b)) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
      ActorId -> Actor -> m ()
forall (m :: * -> *). MonadServer m => ActorId -> Actor -> m ()
deletePerActorAny ActorId
aid Actor
b
  else ActorId -> Actor -> m ()
forall (m :: * -> *). MonadServer m => ActorId -> Actor -> m ()
addPerActorAny ActorId
aid Actor
b

invalidatePerLid :: MonadServer m => LevelId -> m ()
invalidatePerLid :: LevelId -> m ()
invalidatePerLid LevelId
lid = do
  let f :: PerceptionCache -> PerceptionCache
f pc :: PerceptionCache
pc@PerceptionCache{PerActor
perActor :: PerActor
perActor :: PerceptionCache -> PerActor
perActor}
        | PerActor -> Bool
forall k a. EnumMap k a -> Bool
EM.null PerActor
perActor = PerceptionCache
pc
        | Bool
otherwise = PerceptionCache :: FovValid CacheBeforeLucid -> PerActor -> PerceptionCache
PerceptionCache
          { ptotal :: FovValid CacheBeforeLucid
ptotal = FovValid CacheBeforeLucid
forall a. FovValid a
FovInvalid
          , perActor :: PerActor
perActor = (FovValid CacheBeforeLucid -> FovValid CacheBeforeLucid)
-> PerActor -> PerActor
forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
EM.map (FovValid CacheBeforeLucid
-> FovValid CacheBeforeLucid -> FovValid CacheBeforeLucid
forall a b. a -> b -> a
const FovValid CacheBeforeLucid
forall a. FovValid a
FovInvalid) PerActor
perActor }
  (StateServer -> StateServer) -> m ()
forall (m :: * -> *).
MonadServer m =>
(StateServer -> StateServer) -> m ()
modifyServer ((StateServer -> StateServer) -> m ())
-> (StateServer -> StateServer) -> m ()
forall a b. (a -> b) -> a -> b
$ \StateServer
ser ->
    let perCacheFidNew :: PerCacheFid
perCacheFidNew = (EnumMap LevelId PerceptionCache
 -> EnumMap LevelId PerceptionCache)
-> PerCacheFid -> PerCacheFid
forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
EM.map ((PerceptionCache -> PerceptionCache)
-> LevelId
-> EnumMap LevelId PerceptionCache
-> EnumMap LevelId PerceptionCache
forall k a. Enum k => (a -> a) -> k -> EnumMap k a -> EnumMap k a
EM.adjust PerceptionCache -> PerceptionCache
f LevelId
lid) (PerCacheFid -> PerCacheFid) -> PerCacheFid -> PerCacheFid
forall a b. (a -> b) -> a -> b
$ StateServer -> PerCacheFid
sperCacheFid StateServer
ser
        g :: FactionId -> EnumMap LevelId Bool -> EnumMap LevelId Bool
g FactionId
fid EnumMap LevelId Bool
valid |
          PerceptionCache -> FovValid CacheBeforeLucid
ptotal ((PerCacheFid
perCacheFidNew PerCacheFid -> FactionId -> EnumMap LevelId PerceptionCache
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
fid) EnumMap LevelId PerceptionCache -> LevelId -> PerceptionCache
forall k a. Enum k => EnumMap k a -> k -> a
EM.! LevelId
lid) FovValid CacheBeforeLucid -> FovValid CacheBeforeLucid -> Bool
forall a. Eq a => a -> a -> Bool
== FovValid CacheBeforeLucid
forall a. FovValid a
FovInvalid =
          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
False EnumMap LevelId Bool
valid
        g FactionId
_ EnumMap LevelId Bool
valid = EnumMap LevelId Bool
valid
    in StateServer
ser { sperCacheFid :: PerCacheFid
sperCacheFid = PerCacheFid
perCacheFidNew
           , sperValidFid :: PerValidFid
sperValidFid = (FactionId -> EnumMap LevelId Bool -> EnumMap LevelId Bool)
-> PerValidFid -> PerValidFid
forall k a b. Enum k => (k -> a -> b) -> EnumMap k a -> EnumMap k b
EM.mapWithKey FactionId -> EnumMap LevelId Bool -> EnumMap LevelId Bool
g (PerValidFid -> PerValidFid) -> PerValidFid -> PerValidFid
forall a b. (a -> b) -> a -> b
$ StateServer -> PerValidFid
sperValidFid StateServer
ser }

invalidatePerFidLid :: MonadServer m => FactionId -> LevelId -> m ()
invalidatePerFidLid :: FactionId -> LevelId -> m ()
invalidatePerFidLid FactionId
fid LevelId
lid = do
  let adj :: EnumMap LevelId Bool -> EnumMap LevelId Bool
adj = 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
False
  (StateServer -> StateServer) -> m ()
forall (m :: * -> *).
MonadServer m =>
(StateServer -> StateServer) -> m ()
modifyServer ((StateServer -> StateServer) -> m ())
-> (StateServer -> StateServer) -> m ()
forall a b. (a -> b) -> a -> b
$ \StateServer
ser ->
    StateServer
ser {sperValidFid :: PerValidFid
sperValidFid = (EnumMap LevelId Bool -> EnumMap LevelId Bool)
-> FactionId -> PerValidFid -> PerValidFid
forall k a. Enum k => (a -> a) -> k -> EnumMap k a -> EnumMap k a
EM.adjust EnumMap LevelId Bool -> EnumMap LevelId Bool
adj FactionId
fid (PerValidFid -> PerValidFid) -> PerValidFid -> PerValidFid
forall a b. (a -> b) -> a -> b
$ StateServer -> PerValidFid
sperValidFid StateServer
ser}