module Game.LambdaHack.Server.HandleAtomicM
( cmdAtomicSemSer
#ifdef EXPOSE_INTERNAL
, 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
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
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
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
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}