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

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

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

levelOfStash :: MonadStateRead m => ActorId -> m LevelId
levelOfStash :: forall (m :: * -> *). MonadStateRead m => ActorId -> m LevelId
levelOfStash ActorId
aid = do
  b <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
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
  mstash <- getsState $ \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 mstash of
    Just (LevelId
lid, Point
_) -> LevelId -> m LevelId
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return LevelId
lid
    Maybe (LevelId, Point)
Nothing -> [Char] -> m LevelId
forall a. HasCallStack => [Char] -> a
error ([Char] -> m LevelId) -> [Char] -> m LevelId
forall a b. (a -> b) -> a -> b
$ [Char]
"" [Char] -> (ActorId, Actor) -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` (ActorId
aid, Actor
b)

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

updateSclear :: MonadServer m
             => LevelId -> Point -> ContentId TileKind -> ContentId TileKind
             -> m Bool
updateSclear :: forall (m :: * -> *).
MonadServer m =>
LevelId
-> Point -> ContentId TileKind -> ContentId TileKind -> m Bool
updateSclear LevelId
lid Point
pos ContentId TileKind
fromTile ContentId TileKind
toTile = do
  COps{coTileSpeedup} <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  let fromClear = TileSpeedup -> ContentId TileKind -> Bool
Tile.isClear TileSpeedup
coTileSpeedup ContentId TileKind
fromTile
      toClear = TileSpeedup -> ContentId TileKind -> Bool
Tile.isClear TileSpeedup
coTileSpeedup ContentId TileKind
toTile
  if fromClear == toClear then return False else do
    let f FovClear{Array Bool
fovClear :: Array Bool
fovClear :: 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)]
    modifyServer $ \StateServer
ser ->
      StateServer
ser {sfovClearLid = EM.adjust f lid $ sfovClearLid ser}
    return True

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

invalidateLucidLid :: MonadServer m => LevelId -> m ()
invalidateLucidLid :: forall (m :: * -> *). MonadServer m => LevelId -> m ()
invalidateLucidLid LevelId
lid =
  (StateServer -> StateServer) -> m ()
forall (m :: * -> *).
MonadServer m =>
(StateServer -> StateServer) -> m ()
modifyServer ((StateServer -> StateServer) -> m ())
-> (StateServer -> StateServer) -> m ()
forall a b. (a -> b) -> a -> b
$ \StateServer
ser ->
    StateServer
ser { sfovLucidLid = EM.insert lid FovInvalid $ sfovLucidLid ser
        , sperValidFid = EM.map (EM.insert lid False) $ sperValidFid ser }

invalidateLucidAid :: MonadServer m => ActorId -> m ()
invalidateLucidAid :: forall (m :: * -> *). MonadServer m => ActorId -> m ()
invalidateLucidAid ActorId
aid = do
  lid <- (State -> LevelId) -> m LevelId
forall a. (State -> a) -> m a
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
  invalidateLucidLid lid

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

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

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

addPerActor :: MonadServer m => ActorId -> Actor -> m ()
addPerActor :: forall (m :: * -> *). MonadServer m => ActorId -> Actor -> m ()
addPerActor ActorId
aid Actor
b = do
  actorMaxSk <- (State -> Skills) -> m Skills
forall a. (State -> a) -> m a
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
  unless (Ability.getSk Ability.SkSight actorMaxSk <= 0
          && Ability.getSk Ability.SkNocto actorMaxSk <= 0
          && Ability.getSk Ability.SkSmell actorMaxSk <= 0) $
    addPerActorAny aid b

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

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

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

invalidatePerActor :: MonadServer m => ActorId -> m ()
invalidatePerActor :: forall (m :: * -> *). MonadServer m => ActorId -> m ()
invalidatePerActor ActorId
aid = do
  actorMaxSk <- (State -> Skills) -> m Skills
forall a. (State -> a) -> m a
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
  unless (Ability.getSk Ability.SkSight actorMaxSk <= 0
          && Ability.getSk Ability.SkNocto actorMaxSk <= 0
          && Ability.getSk Ability.SkSmell actorMaxSk <= 0) $ do
    b <- getsState $ getActorBody aid
    addPerActorAny aid b

reconsiderPerActor :: MonadServer m => ActorId -> m ()
reconsiderPerActor :: forall (m :: * -> *). MonadServer m => ActorId -> m ()
reconsiderPerActor ActorId
aid = do
  b <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
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
  actorMaxSk <- getsState $ getActorMaxSkills aid
  if Ability.getSk Ability.SkSight actorMaxSk <= 0
     && Ability.getSk Ability.SkNocto actorMaxSk <= 0
     && Ability.getSk Ability.SkSmell actorMaxSk <= 0
  then do
    perCacheFid <- getsServer sperCacheFid
    when (EM.member aid $ perActor ((perCacheFid EM.! bfid b) EM.! blid b)) $
      deletePerActorAny aid b
  else addPerActorAny aid b

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

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