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

import Prelude ()

import Game.LambdaHack.Core.Prelude

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

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

-- | Effect of atomic actions on server state is calculated
-- with the global state from after the command is executed
-- (except where the supplied @oldState@ is used).
cmdAtomicSemSer :: MonadServer m => State -> UpdAtomic -> m ()
cmdAtomicSemSer :: State -> UpdAtomic -> m ()
cmdAtomicSemSer 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
    -- On server, it does't affect aspects, but does affect lucid (Ascend).
    ActorMaxSkills
actorMaxSkills <- (State -> ActorMaxSkills) -> m ActorMaxSkills
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> ActorMaxSkills
sactorMaxSkills
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ActorMaxSkills -> ActorId -> Bool
actorHasShine ActorMaxSkills
actorMaxSkills ActorId
aid) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ LevelId -> m ()
forall (m :: * -> *). MonadServer m => LevelId -> m ()
invalidateLucidLid (LevelId -> m ()) -> LevelId -> m ()
forall a b. (a -> b) -> a -> b
$ Actor -> LevelId
blid Actor
b
    ActorId -> Actor -> m ()
forall (m :: * -> *). MonadServer m => ActorId -> Actor -> m ()
addPerActor ActorId
aid Actor
b
  UpdLoseActor aid :: ActorId
aid b :: Actor
b -> do
    -- On server, it does't affect aspects, but does affect lucid (Ascend).
    let actorMaxSkillsOld :: ActorMaxSkills
actorMaxSkillsOld = State -> ActorMaxSkills
sactorMaxSkills State
oldState
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ActorMaxSkills -> ActorId -> Bool
actorHasShine ActorMaxSkills
actorMaxSkillsOld ActorId
aid) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ LevelId -> m ()
forall (m :: * -> *). MonadServer m => LevelId -> m ()
invalidateLucidLid (LevelId -> m ()) -> LevelId -> m ()
forall a b. (a -> b) -> a -> b
$ Actor -> LevelId
blid Actor
b
    ActorMaxSkills -> ActorId -> Actor -> m ()
forall (m :: * -> *).
MonadServer m =>
ActorMaxSkills -> ActorId -> Actor -> m ()
deletePerActor ActorMaxSkills
actorMaxSkillsOld ActorId
aid Actor
b
    (StateServer -> StateServer) -> m ()
forall (m :: * -> *).
MonadServer m =>
(StateServer -> StateServer) -> m ()
modifyServer ((StateServer -> StateServer) -> m ())
-> (StateServer -> StateServer) -> m ()
forall a b. (a -> b) -> a -> b
$ \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  -- the same lid as aid2
    ActorId -> m ()
forall (m :: * -> *). MonadServer m => ActorId -> m ()
invalidatePerActor ActorId
aid1
    ActorId -> m ()
forall (m :: * -> *). MonadServer m => ActorId -> m ()
invalidatePerActor ActorId
aid2
  UpdMoveItem 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}