-- | 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
  , 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.Item
import qualified Game.LambdaHack.Common.ItemAspect as IA
import           Game.LambdaHack.Common.Kind
import           Game.LambdaHack.Common.MonadStateRead
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           Game.LambdaHack.Common.Point
import qualified Game.LambdaHack.Common.PointArray as PointArray
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
  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 _) -> 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 -> [CStore] -> 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
  UpdCreateItem iid :: ItemId
iid _ _ (CActor aid :: ActorId
aid store :: CStore
store) -> 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 -> [CStore] -> Bool
itemAffectsShineRadius DiscoveryAspect
discoAspect ItemId
iid [CStore
store]) (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 (CStore
store CStore -> [CStore] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CStore
CEqp, CStore
COrgan]) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
      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 iid :: ItemId
iid _ _ (CFloor 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 -> [CStore] -> 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
  UpdDestroyItem iid :: ItemId
iid _ _ (CActor aid :: ActorId
aid store :: CStore
store) -> 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 -> [CStore] -> Bool
itemAffectsShineRadius DiscoveryAspect
discoAspect ItemId
iid [CStore
store]) (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 (CStore
store CStore -> [CStore] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CStore
CEqp, CStore
COrgan]) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
      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
  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 _) -> 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 -> [CStore] -> 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
  UpdSpotItem _ iid :: ItemId
iid _ _ (CActor aid :: ActorId
aid store :: CStore
store) -> 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 -> [CStore] -> Bool
itemAffectsShineRadius DiscoveryAspect
discoAspect ItemId
iid [CStore
store]) (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 (CStore
store CStore -> [CStore] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CStore
CEqp, CStore
COrgan]) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
      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 _ iid :: ItemId
iid _ _ (CFloor 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 -> [CStore] -> 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
  UpdLoseItem _ iid :: ItemId
iid _ _ (CActor aid :: ActorId
aid store :: CStore
store) -> 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 -> [CStore] -> Bool
itemAffectsShineRadius DiscoveryAspect
discoAspect ItemId
iid [CStore
store]) (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 (CStore
store CStore -> [CStore] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CStore
CEqp, CStore
COrgan]) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
      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
  UpdSpotItemBag (CFloor lid :: LevelId
lid _) bag :: ItemBag
bag _ais :: [(ItemId, Item)]
_ais -> 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 (\iid :: ItemId
iid -> DiscoveryAspect -> ItemId -> [CStore] -> Bool
itemAffectsShineRadius DiscoveryAspect
discoAspect ItemId
iid []) [ItemId]
iids) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
      LevelId -> m ()
forall (m :: * -> *). MonadServer m => LevelId -> m ()
invalidateLucidLid LevelId
lid
  UpdSpotItemBag (CActor aid :: ActorId
aid store :: CStore
store) bag :: ItemBag
bag _ais :: [(ItemId, Item)]
_ais -> 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 (\iid :: ItemId
iid -> DiscoveryAspect -> ItemId -> [CStore] -> Bool
itemAffectsShineRadius DiscoveryAspect
discoAspect ItemId
iid [CStore
store]) [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 (CStore
store CStore -> [CStore] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CStore
CEqp, CStore
COrgan]) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
      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 (CFloor lid :: LevelId
lid _) bag :: ItemBag
bag _ais :: [(ItemId, Item)]
_ais -> 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 (\iid :: ItemId
iid -> DiscoveryAspect -> ItemId -> [CStore] -> Bool
itemAffectsShineRadius DiscoveryAspect
discoAspect ItemId
iid []) [ItemId]
iids) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
      LevelId -> m ()
forall (m :: * -> *). MonadServer m => LevelId -> m ()
invalidateLucidLid LevelId
lid
  UpdLoseItemBag (CActor aid :: ActorId
aid store :: CStore
store) bag :: ItemBag
bag _ais :: [(ItemId, Item)]
_ais -> 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 (\iid :: ItemId
iid -> DiscoveryAspect -> ItemId -> [CStore] -> Bool
itemAffectsShineRadius DiscoveryAspect
discoAspect ItemId
iid [CStore
store]) [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 (CStore
store CStore -> [CStore] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CStore
CEqp, CStore
COrgan]) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
      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
  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
  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
    DiscoveryAspect
discoAspect <- (State -> DiscoveryAspect) -> m DiscoveryAspect
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> DiscoveryAspect
sdiscoAspect
    let itemAffectsPer :: Bool
itemAffectsPer = DiscoveryAspect -> ItemId -> Bool
itemAffectsPerRadius DiscoveryAspect
discoAspect ItemId
iid
        invalidatePer :: m ()
invalidatePer = Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
itemAffectsPer (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ ActorId -> m ()
forall (m :: * -> *). MonadServer m => ActorId -> m ()
reconsiderPerActor ActorId
aid
        itemAffectsShine :: Bool
itemAffectsShine = DiscoveryAspect -> ItemId -> [CStore] -> Bool
itemAffectsShineRadius DiscoveryAspect
discoAspect ItemId
iid [CStore
s1, CStore
s2]
        invalidateLucid :: m ()
invalidateLucid = Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
itemAffectsShine (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ ActorId -> m ()
forall (m :: * -> *). MonadServer m => ActorId -> m ()
invalidateLucidAid ActorId
aid
    case CStore
s1 of
      CEqp -> case CStore
s2 of
        COrgan -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        _ -> do
          m ()
invalidateLucid
          m ()
invalidatePer
      COrgan -> case CStore
s2 of
        CEqp -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        _ -> do
          m ()
invalidateLucid
          m ()
invalidatePer
      _ -> do
        m ()
invalidateLucid  -- from itemAffects, s2 provides light or s1 is CGround
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CStore
s2 CStore -> [CStore] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CStore
CEqp, CStore
COrgan]) m ()
invalidatePer
  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
  UpdLeadFaction{} -> m ()
forall (m :: * -> *). MonadServer m => m ()
invalidateArenas
  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
  _ -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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 -> [CStore] -> Bool
itemAffectsShineRadius :: DiscoveryAspect -> ItemId -> [CStore] -> Bool
itemAffectsShineRadius discoAspect :: DiscoveryAspect
discoAspect iid :: ItemId
iid stores :: [CStore]
stores =
  ([CStore] -> Bool
forall a. [a] -> Bool
null [CStore]
stores Bool -> Bool -> Bool
|| Bool -> Bool
not ([CStore] -> Bool
forall a. [a] -> Bool
null ([CStore] -> Bool) -> [CStore] -> Bool
forall a b. (a -> b) -> a -> b
$ [CStore] -> [CStore] -> [CStore]
forall a. Eq a => [a] -> [a] -> [a]
intersect [CStore]
stores [CStore
CEqp, CStore
COrgan, CStore
CGround]))
  Bool -> Bool -> Bool
&& 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 }