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 oldState :: State
oldState cmd :: UpdAtomic
cmd = case UpdAtomic
cmd of
UpdRegisterItems{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
UpdCreateActor aid :: ActorId
aid b :: 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
UpdDestroyActor aid :: ActorId
aid b :: 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
$ \ser :: 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 _ iid :: ItemId
iid _ _ (CFloor lid :: LevelId
lid _) -> ItemId -> LevelId -> m ()
forall (m :: * -> *). MonadServer m => ItemId -> LevelId -> m ()
validateFloor ItemId
iid LevelId
lid
UpdCreateItem _ iid :: ItemId
iid _ _ (CActor aid :: ActorId
aid 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 _ iid :: ItemId
iid _ _ (CActor aid :: ActorId
aid 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 _ iid :: ItemId
iid _ _ (CActor aid :: ActorId
aid _) -> 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 _ iid :: ItemId
iid _ _ (CFloor lid :: LevelId
lid _) -> ItemId -> LevelId -> m ()
forall (m :: * -> *). MonadServer m => ItemId -> LevelId -> m ()
validateFloor ItemId
iid LevelId
lid
UpdDestroyItem _ iid :: ItemId
iid _ _ (CActor aid :: ActorId
aid 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 _ iid :: ItemId
iid _ _ (CActor aid :: ActorId
aid 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 _ iid :: ItemId
iid _ _ (CActor aid :: ActorId
aid _) -> 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 aid :: ActorId
aid b :: 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 aid :: ActorId
aid b :: 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
$ \ser :: 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 _ iid :: ItemId
iid _ (CFloor lid :: LevelId
lid _) -> ItemId -> LevelId -> m ()
forall (m :: * -> *). MonadServer m => ItemId -> LevelId -> m ()
validateFloor ItemId
iid LevelId
lid
UpdSpotItem _ iid :: ItemId
iid _ (CActor aid :: ActorId
aid 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 _ iid :: ItemId
iid _ (CActor aid :: ActorId
aid 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 _ iid :: ItemId
iid _ (CActor aid :: ActorId
aid _) -> 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 _ iid :: ItemId
iid _ (CFloor lid :: LevelId
lid _) -> ItemId -> LevelId -> m ()
forall (m :: * -> *). MonadServer m => ItemId -> LevelId -> m ()
validateFloor ItemId
iid LevelId
lid
UpdLoseItem _ iid :: ItemId
iid _ (CActor aid :: ActorId
aid 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 _ iid :: ItemId
iid _ (CActor aid :: ActorId
aid 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 _ iid :: ItemId
iid _ (CActor aid :: ActorId
aid _) -> 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 _ (CFloor lid :: LevelId
lid _) bag :: ItemBag
bag -> ItemBag -> LevelId -> m ()
forall (m :: * -> *). MonadServer m => ItemBag -> LevelId -> m ()
validateFloorBag ItemBag
bag LevelId
lid
UpdSpotItemBag _ (CActor aid :: ActorId
aid CStash) bag :: 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 _ (CActor aid :: ActorId
aid CGround) bag :: 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 _ (CActor aid :: ActorId
aid _) bag :: 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 _ (CFloor lid :: LevelId
lid _) bag :: ItemBag
bag -> ItemBag -> LevelId -> m ()
forall (m :: * -> *). MonadServer m => ItemBag -> LevelId -> m ()
validateFloorBag ItemBag
bag LevelId
lid
UpdLoseItemBag _ (CActor aid :: ActorId
aid CStash) bag :: 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 _ (CActor aid :: ActorId
aid CGround) bag :: 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 _ (CActor aid :: ActorId
aid _) bag :: 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 aid :: ActorId
aid _ _ -> 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 aid1 :: ActorId
aid1 aid2 :: 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 iid :: ItemId
iid _k :: Int
_k aid :: ActorId
aid s1 :: CStore
s1 s2 :: 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 aid :: 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
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 _ fid :: FactionId
fid lid :: LevelId
lid _ -> FactionId -> LevelId -> m ()
forall (m :: * -> *). MonadServer m => FactionId -> LevelId -> m ()
invalidatePerFidLid FactionId
fid LevelId
lid
UpdLoseStashFaction _ fid :: FactionId
fid lid :: LevelId
lid _ -> 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 lid :: LevelId
lid pos :: Point
pos fromTile :: ContentId TileKind
fromTile toTile :: 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 ()
validateFloor :: MonadServer m => ItemId -> LevelId -> m ()
validateFloor :: ItemId -> LevelId -> m ()
validateFloor iid :: ItemId
iid lid :: 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 bag :: ItemBag
bag lid :: 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 aid :: ActorId
aid = do
Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
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
$ \s :: 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 (lid :: LevelId
lid, _) -> LevelId -> m LevelId
forall (m :: * -> *) a. Monad m => a -> m a
return LevelId
lid
Nothing -> [Char] -> m LevelId
forall a. HasCallStack => [Char] -> a
error ([Char] -> m LevelId) -> [Char] -> m LevelId
forall a b. (a -> b) -> a -> b
$ "" [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
$ \ser :: 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 lid :: LevelId
lid pos :: Point
pos fromTile :: ContentId TileKind
fromTile toTile :: 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
$ \ser :: 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 lid :: LevelId
lid pos :: Point
pos fromTile :: ContentId TileKind
fromTile toTile :: 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 set :: 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
$ \ser :: 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 lid :: 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
$ \ser :: StateServer
ser ->
StateServer
ser { sfovLucidLid :: FovLucidLid
sfovLucidLid = LevelId -> FovValid FovLucid -> FovLucidLid -> FovLucidLid
forall k a. Enum k => k -> a -> EnumMap k a -> EnumMap k a
EM.insert LevelId
lid 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 aid :: 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
actorMaxSkills aid :: 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 actorMaxSk :: Skills
actorMaxSk -> Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkShine Skills
actorMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0
Nothing -> [Char] -> Bool
forall a. HasCallStack => [Char] -> a
error ([Char] -> Bool) -> [Char] -> Bool
forall a b. (a -> b) -> a -> b
$ "" [Char] -> ActorId -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` ActorId
aid
itemAffectsShineRadius :: DiscoveryAspect -> ItemId -> Bool
itemAffectsShineRadius :: DiscoveryAspect -> ItemId -> Bool
itemAffectsShineRadius discoAspect :: DiscoveryAspect
discoAspect iid :: 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 arItem :: AspectRecord
arItem -> Skill -> AspectRecord -> Int
IA.getSkill Skill
Ability.SkShine AspectRecord
arItem Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= 0
Nothing -> [Char] -> Bool
forall a. HasCallStack => [Char] -> a
error ([Char] -> Bool) -> [Char] -> Bool
forall a b. (a -> b) -> a -> b
$ "" [Char] -> ItemId -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` ItemId
iid
itemAffectsPerRadius :: DiscoveryAspect -> ItemId -> Bool
itemAffectsPerRadius :: DiscoveryAspect -> ItemId -> Bool
itemAffectsPerRadius discoAspect :: DiscoveryAspect
discoAspect iid :: 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 arItem :: AspectRecord
arItem -> Skill -> AspectRecord -> Int
IA.getSkill Skill
Ability.SkSight AspectRecord
arItem Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= 0
Bool -> Bool -> Bool
|| Skill -> AspectRecord -> Int
IA.getSkill Skill
Ability.SkSmell AspectRecord
arItem Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= 0
Bool -> Bool -> Bool
|| Skill -> AspectRecord -> Int
IA.getSkill Skill
Ability.SkNocto AspectRecord
arItem Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= 0
Nothing -> [Char] -> Bool
forall a. HasCallStack => [Char] -> a
error ([Char] -> Bool) -> [Char] -> Bool
forall a b. (a -> b) -> a -> b
$ "" [Char] -> ItemId -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` ItemId
iid
addPerActor :: MonadServer m => ActorId -> Actor -> m ()
addPerActor :: ActorId -> Actor -> m ()
addPerActor aid :: ActorId
aid b :: 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
<= 0
Bool -> Bool -> Bool
&& Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkNocto Skills
actorMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0
Bool -> Bool -> Bool
&& Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkSmell Skills
actorMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 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 aid :: ActorId
aid b :: 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} = $WPerceptionCache :: 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
$ \ser :: 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 actorMaxSkillsOld :: ActorMaxSkills
actorMaxSkillsOld aid :: ActorId
aid b :: 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
<= 0
Bool -> Bool -> Bool
&& Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkNocto Skills
actorMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0
Bool -> Bool -> Bool
&& Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkSmell Skills
actorMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 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 aid :: ActorId
aid b :: 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} = $WPerceptionCache :: 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
$ \ser :: 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 aid :: 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
<= 0
Bool -> Bool -> Bool
&& Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkNocto Skills
actorMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0
Bool -> Bool -> Bool
&& Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkSmell Skills
actorMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 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 aid :: ActorId
aid = do
Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
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
<= 0
Bool -> Bool -> Bool
&& Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkNocto Skills
actorMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0
Bool -> Bool -> Bool
&& Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkSmell Skills
actorMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 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 lid :: 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 = $WPerceptionCache :: 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
$ \ser :: 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 fid :: FactionId
fid valid :: 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 _ valid :: 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 fid :: FactionId
fid lid :: 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
$ \ser :: 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}