-- | Handle atomic commands received by the client.
module Game.LambdaHack.Client.HandleAtomicM
  ( MonadClientSetup(..)
  , cmdAtomicSemCli
#ifdef EXPOSE_INTERNAL
    -- * Internal operations
  , updateInMeleeDueToActor, updateInMeleeDueToItem, updateInMeleeInDungeon
  , wipeBfsIfItemAffectsSkills, tileChangeAffectsBfs
  , createActor, destroyActor
  , addItemToDiscoBenefit, perception
  , discoverKind, discoverKindAndAspect, coverKind, coverAspectAndKind
  , discoverAspect, coverAspect
  , killExit
#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.Client.Bfs
import           Game.LambdaHack.Client.BfsM
import           Game.LambdaHack.Client.CommonM
import           Game.LambdaHack.Client.MonadClient
import           Game.LambdaHack.Client.Preferences
import           Game.LambdaHack.Client.State
import           Game.LambdaHack.Common.Actor
import           Game.LambdaHack.Common.ActorState
import           Game.LambdaHack.Common.ClientOptions
import           Game.LambdaHack.Common.Faction
import           Game.LambdaHack.Common.Item
import           Game.LambdaHack.Common.Kind
import           Game.LambdaHack.Common.Level
import           Game.LambdaHack.Common.MonadStateRead
import           Game.LambdaHack.Common.Perception
import           Game.LambdaHack.Common.State
import qualified Game.LambdaHack.Common.Tile as Tile
import           Game.LambdaHack.Common.Time
import           Game.LambdaHack.Common.Types
import qualified Game.LambdaHack.Content.CaveKind as CK
import           Game.LambdaHack.Content.FactionKind
import           Game.LambdaHack.Content.TileKind (TileKind)
import           Game.LambdaHack.Definition.Defs

-- | Client monad for saving a game.
class MonadClient m => MonadClientSetup m where
  saveClient    :: m ()

-- | Effect of atomic actions on client state. It is calculated
-- with the global state from after the command is executed
-- (except where the supplied @oldState@ is used).
cmdAtomicSemCli :: MonadClientSetup m => State -> UpdAtomic -> m ()
{-# INLINE cmdAtomicSemCli #-}
cmdAtomicSemCli :: forall (m :: * -> *).
MonadClientSetup m =>
State -> UpdAtomic -> m ()
cmdAtomicSemCli State
oldState UpdAtomic
cmd = case UpdAtomic
cmd of
  UpdRegisterItems [(ItemId, Item)]
ais -> ((ItemId, Item) -> m ()) -> [(ItemId, Item)] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
mapM_ (ItemId -> m ()
forall (m :: * -> *). MonadClient m => ItemId -> m ()
addItemToDiscoBenefit (ItemId -> m ())
-> ((ItemId, Item) -> ItemId) -> (ItemId, Item) -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ItemId, Item) -> ItemId
forall a b. (a, b) -> a
fst) [(ItemId, Item)]
ais
  UpdCreateActor ActorId
aid Actor
b [(ItemId, Item)]
ais -> ActorId -> Actor -> [(ItemId, Item)] -> m ()
forall (m :: * -> *).
MonadClient m =>
ActorId -> Actor -> [(ItemId, Item)] -> m ()
createActor ActorId
aid Actor
b [(ItemId, Item)]
ais
  UpdDestroyActor ActorId
aid Actor
b [(ItemId, Item)]
_ -> ActorId -> Actor -> Bool -> m ()
forall (m :: * -> *).
MonadClient m =>
ActorId -> Actor -> Bool -> m ()
destroyActor ActorId
aid Actor
b Bool
True
  UpdCreateItem Bool
_ ItemId
iid Item
_ ItemQuant
_ (CActor ActorId
aid CStore
store) -> do
    CStore -> ActorId -> m ()
forall (m :: * -> *). MonadClient m => CStore -> ActorId -> m ()
wipeBfsIfItemAffectsSkills CStore
store ActorId
aid
    ItemId -> m ()
forall (m :: * -> *). MonadClient m => ItemId -> m ()
addItemToDiscoBenefit ItemId
iid
    ActorId -> CStore -> m ()
forall (m :: * -> *). MonadClient m => ActorId -> CStore -> m ()
updateInMeleeDueToItem ActorId
aid CStore
store
  UpdCreateItem Bool
_ ItemId
iid Item
_ ItemQuant
_ Container
_ -> ItemId -> m ()
forall (m :: * -> *). MonadClient m => ItemId -> m ()
addItemToDiscoBenefit ItemId
iid
  UpdDestroyItem Bool
_ ItemId
_ Item
_ ItemQuant
_ (CActor ActorId
aid CStore
store) -> do
    CStore -> ActorId -> m ()
forall (m :: * -> *). MonadClient m => CStore -> ActorId -> m ()
wipeBfsIfItemAffectsSkills CStore
store ActorId
aid
    ActorId -> CStore -> m ()
forall (m :: * -> *). MonadClient m => ActorId -> CStore -> m ()
updateInMeleeDueToItem ActorId
aid CStore
store
  UpdDestroyItem{} -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdSpotActor ActorId
aid Actor
b -> do
    ais <- (State -> [(ItemId, Item)]) -> m [(ItemId, Item)]
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(ItemId, Item)]) -> m [(ItemId, Item)])
-> (State -> [(ItemId, Item)]) -> m [(ItemId, Item)]
forall a b. (a -> b) -> a -> b
$ Actor -> State -> [(ItemId, Item)]
getCarriedAssocsAndTrunk Actor
b
    createActor aid b ais
  UpdLoseActor ActorId
aid Actor
b -> ActorId -> Actor -> Bool -> m ()
forall (m :: * -> *).
MonadClient m =>
ActorId -> Actor -> Bool -> m ()
destroyActor ActorId
aid Actor
b Bool
False
  UpdSpotItem Bool
_ ItemId
iid ItemQuant
_ (CActor ActorId
aid CStore
store) -> do
    CStore -> ActorId -> m ()
forall (m :: * -> *). MonadClient m => CStore -> ActorId -> m ()
wipeBfsIfItemAffectsSkills CStore
store ActorId
aid
    ItemId -> m ()
forall (m :: * -> *). MonadClient m => ItemId -> m ()
addItemToDiscoBenefit ItemId
iid
    ActorId -> CStore -> m ()
forall (m :: * -> *). MonadClient m => ActorId -> CStore -> m ()
updateInMeleeDueToItem ActorId
aid CStore
store
  UpdSpotItem Bool
_ ItemId
iid ItemQuant
_ Container
_ -> ItemId -> m ()
forall (m :: * -> *). MonadClient m => ItemId -> m ()
addItemToDiscoBenefit ItemId
iid
  UpdLoseItem Bool
_ ItemId
_ ItemQuant
_ (CActor ActorId
aid CStore
store) -> do
    CStore -> ActorId -> m ()
forall (m :: * -> *). MonadClient m => CStore -> ActorId -> m ()
wipeBfsIfItemAffectsSkills CStore
store ActorId
aid
    ActorId -> CStore -> m ()
forall (m :: * -> *). MonadClient m => ActorId -> CStore -> m ()
updateInMeleeDueToItem ActorId
aid CStore
store
  UpdLoseItem{} -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdSpotItemBag Bool
_ (CActor ActorId
aid CStore
store) ItemBag
bag -> do
    CStore -> ActorId -> m ()
forall (m :: * -> *). MonadClient m => CStore -> ActorId -> m ()
wipeBfsIfItemAffectsSkills CStore
store ActorId
aid
    (ItemId -> m ()) -> [ItemId] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
mapM_ ItemId -> m ()
forall (m :: * -> *). MonadClient m => ItemId -> m ()
addItemToDiscoBenefit ([ItemId] -> m ()) -> [ItemId] -> m ()
forall a b. (a -> b) -> a -> b
$ ItemBag -> [ItemId]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys ItemBag
bag
    ActorId -> CStore -> m ()
forall (m :: * -> *). MonadClient m => ActorId -> CStore -> m ()
updateInMeleeDueToItem ActorId
aid CStore
store
  UpdSpotItemBag Bool
_ Container
_ ItemBag
bag ->
    (ItemId -> m ()) -> [ItemId] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
mapM_ ItemId -> m ()
forall (m :: * -> *). MonadClient m => ItemId -> m ()
addItemToDiscoBenefit ([ItemId] -> m ()) -> [ItemId] -> m ()
forall a b. (a -> b) -> a -> b
$ ItemBag -> [ItemId]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys ItemBag
bag
  UpdLoseItemBag Bool
_ (CActor ActorId
aid CStore
store) ItemBag
_ -> do
    CStore -> ActorId -> m ()
forall (m :: * -> *). MonadClient m => CStore -> ActorId -> m ()
wipeBfsIfItemAffectsSkills CStore
store ActorId
aid
    ActorId -> CStore -> m ()
forall (m :: * -> *). MonadClient m => ActorId -> CStore -> m ()
updateInMeleeDueToItem ActorId
aid CStore
store
  UpdLoseItemBag{} -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdMoveActor ActorId
aid Point
_ Point
_ -> do
    ActorId -> m ()
forall (m :: * -> *). MonadClient m => ActorId -> m ()
invalidateBfsAid ActorId
aid
    -- other BFSes not invalidated, because distant actors may still move out
    -- of the way and close actors are considered when attempting to move
    -- and then BFS is invalidated, if needed.
    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
    updateInMeleeDueToActor b
  UpdWaitActor ActorId
aid Watchfulness
_fromW Watchfulness
toW -> do
    -- So that we can later ignore such actors when updating targets
    -- and not risk they being pushed/displaced and targets getting illegal.
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Watchfulness
toW Watchfulness -> Watchfulness -> Bool
forall a. Eq a => a -> a -> Bool
== Watchfulness
WSleep) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
      (StateClient -> StateClient) -> m ()
forall (m :: * -> *).
MonadClient m =>
(StateClient -> StateClient) -> m ()
modifyClient ((StateClient -> StateClient) -> m ())
-> (StateClient -> StateClient) -> m ()
forall a b. (a -> b) -> a -> b
$ ActorId
-> (Maybe Target -> Maybe Target) -> StateClient -> StateClient
updateTarget ActorId
aid (Maybe Target -> Maybe Target -> Maybe Target
forall a b. a -> b -> a
const Maybe Target
forall a. Maybe a
Nothing)
    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
    updateInMeleeDueToActor b  -- @bwatch@ checked in several places
  UpdDisplaceActor ActorId
source ActorId
target -> do
    ActorId -> m ()
forall (m :: * -> *). MonadClient m => ActorId -> m ()
invalidateBfsAid ActorId
source
    ActorId -> m ()
forall (m :: * -> *). MonadClient m => ActorId -> m ()
invalidateBfsAid ActorId
target
    -- other BFSes not invalidated, because distant actors may still move out
    -- of the way and close actors are considered when attempting to move
    -- and then BFS is invalidated, if needed.
    sb <- (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
source
    -- At least one of these is not a projectile and both move, so update.
    insertInMeleeM (blid sb)
  UpdMoveItem ItemId
_ Int
_ ActorId
aid CStore
s1 CStore
s2 -> do
    CStore -> ActorId -> m ()
forall (m :: * -> *). MonadClient m => CStore -> ActorId -> m ()
wipeBfsIfItemAffectsSkills CStore
s1 ActorId
aid
    CStore -> ActorId -> m ()
forall (m :: * -> *). MonadClient m => CStore -> ActorId -> m ()
wipeBfsIfItemAffectsSkills CStore
s2 ActorId
aid
    ActorId -> CStore -> m ()
forall (m :: * -> *). MonadClient m => ActorId -> CStore -> m ()
updateInMeleeDueToItem ActorId
aid CStore
s1
    ActorId -> CStore -> m ()
forall (m :: * -> *). MonadClient m => ActorId -> CStore -> m ()
updateInMeleeDueToItem ActorId
aid CStore
s2
  UpdRefillHP ActorId
_ Int64
0 -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdRefillHP ActorId
aid Int64
delta -> 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
    unless (bproj b
            || signum (bhp b)  -- new HP
               == signum (bhp b - delta)) $  -- old HP
      insertInMeleeM (blid b)  -- @bhp@ checked in several places
  UpdRefillCalm{} -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  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{} -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdLoseStashFaction{} -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdLeadFaction FactionId
fid Maybe ActorId
source Maybe ActorId
target -> do
    side <- (StateClient -> FactionId) -> m FactionId
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
    when (side == fid) $ do
      mleader <- getsClient sleader
      let !_A = Bool -> () -> ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Maybe ActorId
mleader Maybe ActorId -> Maybe ActorId -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe ActorId
source
                          -- somebody changed the leader for us
                        Bool -> Bool -> Bool
|| Maybe ActorId
mleader Maybe ActorId -> Maybe ActorId -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe ActorId
target
                          -- we changed the leader ourselves
                        Bool -> (String, (UpdAtomic, Maybe ActorId)) -> Bool
forall v. Show v => Bool -> v -> Bool
`blame` String
"unexpected leader"
                        String
-> (UpdAtomic, Maybe ActorId)
-> (String, (UpdAtomic, Maybe ActorId))
forall v. String -> v -> (String, v)
`swith` (UpdAtomic
cmd, Maybe ActorId
mleader)) ()
      modifyClient $ \StateClient
cli -> StateClient
cli {_sleader = target}
  UpdDiplFaction{} ->
    -- Depends on who is a foe as opposed to a neutral actor.
    m ()
forall (m :: * -> *). MonadClient m => m ()
updateInMeleeInDungeon
  UpdAutoFaction{} -> do
    -- Regaining control of faction cancels some --stopAfter*.
    -- This is really a UI client issue, but is in general client state
    -- to make it simpler to set this via commandline.
    (StateClient -> StateClient) -> m ()
forall (m :: * -> *).
MonadClient m =>
(StateClient -> StateClient) -> m ()
modifyClient ((StateClient -> StateClient) -> m ())
-> (StateClient -> StateClient) -> m ()
forall a b. (a -> b) -> a -> b
$ \StateClient
cli ->
      StateClient
cli {soptions = (soptions cli) { sstopAfterSeconds = Nothing
                                     , sstopAfterFrames = Nothing }}
    -- @condBFS@ depends on the setting we change here (e.g., smarkSuspect).
    m ()
forall (m :: * -> *). MonadClient m => m ()
invalidateBfsAll
  UpdRecordKill{} -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdDoctrineFaction{} -> do
    -- Clear all targets except the leader's.
    mleader <- (StateClient -> Maybe ActorId) -> m (Maybe ActorId)
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Maybe ActorId
sleader
    mtgt <- case mleader of
      Maybe ActorId
Nothing -> Maybe TgtAndPath -> m (Maybe TgtAndPath)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TgtAndPath
forall a. Maybe a
Nothing
      Just ActorId
leader -> (StateClient -> Maybe TgtAndPath) -> m (Maybe TgtAndPath)
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient ((StateClient -> Maybe TgtAndPath) -> m (Maybe TgtAndPath))
-> (StateClient -> Maybe TgtAndPath) -> m (Maybe TgtAndPath)
forall a b. (a -> b) -> a -> b
$ ActorId -> EnumMap ActorId TgtAndPath -> Maybe TgtAndPath
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup ActorId
leader (EnumMap ActorId TgtAndPath -> Maybe TgtAndPath)
-> (StateClient -> EnumMap ActorId TgtAndPath)
-> StateClient
-> Maybe TgtAndPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateClient -> EnumMap ActorId TgtAndPath
stargetD
    modifyClient $ \StateClient
cli ->
      let stargetD :: EnumMap ActorId TgtAndPath
stargetD | Just TgtAndPath
tgt <- Maybe TgtAndPath
mtgt
                   , Just ActorId
leader <- Maybe ActorId
mleader
                   = ActorId -> TgtAndPath -> EnumMap ActorId TgtAndPath
forall k a. Enum k => k -> a -> EnumMap k a
EM.singleton ActorId
leader TgtAndPath
tgt
                   | Bool
otherwise = EnumMap ActorId TgtAndPath
forall k a. EnumMap k a
EM.empty
      in StateClient
cli {stargetD}
  UpdAlterTile LevelId
lid Point
p ContentId TileKind
fromTile ContentId TileKind
toTile -> do
    LevelId -> [(Point, ContentId TileKind)] -> m ()
forall (m :: * -> *).
MonadClient m =>
LevelId -> [(Point, ContentId TileKind)] -> m ()
updateSalter LevelId
lid [(Point
p, ContentId TileKind
toTile)]
    cops <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
    let lvl = (EnumMap LevelId Level -> LevelId -> Level
forall k a. Enum k => EnumMap k a -> k -> a
EM.! LevelId
lid) (EnumMap LevelId Level -> Level)
-> (State -> EnumMap LevelId Level) -> State -> Level
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap LevelId Level
sdungeon (State -> Level) -> State -> Level
forall a b. (a -> b) -> a -> b
$ State
oldState
        t = Level
lvl Level -> Point -> ContentId TileKind
`at` Point
p
    let !_A = Bool -> () -> ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (ContentId TileKind
t ContentId TileKind -> ContentId TileKind -> Bool
forall a. Eq a => a -> a -> Bool
== ContentId TileKind
fromTile) ()
    when (tileChangeAffectsBfs cops fromTile toTile) $
      invalidateBfsLid 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 ActorId
aid Point
p ContentId TileKind
toTile -> do
    COps{cotile} <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
    b <- getsState $ getActorBody aid
    let lid = Actor -> LevelId
blid Actor
b
    updateSalter lid [(p, toTile)]
    cops <- getsState scops
    let lvl = (EnumMap LevelId Level -> LevelId -> Level
forall k a. Enum k => EnumMap k a -> k -> a
EM.! LevelId
lid) (EnumMap LevelId Level -> Level)
-> (State -> EnumMap LevelId Level) -> State -> Level
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap LevelId Level
sdungeon (State -> Level) -> State -> Level
forall a b. (a -> b) -> a -> b
$ State
oldState
        t = Level
lvl Level -> Point -> ContentId TileKind
`at` Point
p
    let !_A = Bool -> () -> ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (ContentId TileKind -> Maybe (ContentId TileKind)
forall a. a -> Maybe a
Just ContentId TileKind
t Maybe (ContentId TileKind) -> Maybe (ContentId TileKind) -> Bool
forall a. Eq a => a -> a -> Bool
== ContentData TileKind
-> ContentId TileKind -> Maybe (ContentId TileKind)
Tile.hideAs ContentData TileKind
cotile ContentId TileKind
toTile) ()
    -- The following check is needed even if we verity in content
    -- that searching doesn't change clarity and light of tiles,
    -- because it modifies skill needed to alter the tile and even
    -- walkability and changeability.
    when (tileChangeAffectsBfs cops t toTile) $
      invalidateBfsLid lid
  UpdHideTile{} -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdSpotTile LevelId
lid [(Point, ContentId TileKind)]
ts -> do
    LevelId -> [(Point, ContentId TileKind)] -> m ()
forall (m :: * -> *).
MonadClient m =>
LevelId -> [(Point, ContentId TileKind)] -> m ()
updateSalter LevelId
lid [(Point, ContentId TileKind)]
ts
    cops <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
    let lvl = (EnumMap LevelId Level -> LevelId -> Level
forall k a. Enum k => EnumMap k a -> k -> a
EM.! LevelId
lid) (EnumMap LevelId Level -> Level)
-> (State -> EnumMap LevelId Level) -> State -> Level
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap LevelId Level
sdungeon (State -> Level) -> State -> Level
forall a b. (a -> b) -> a -> b
$ State
oldState
        affects (Point
p, ContentId TileKind
toTile) =
          let fromTile :: ContentId TileKind
fromTile = Level
lvl Level -> Point -> ContentId TileKind
`at` Point
p
          in COps -> ContentId TileKind -> ContentId TileKind -> Bool
tileChangeAffectsBfs COps
cops ContentId TileKind
fromTile ContentId TileKind
toTile
        bs = ((Point, ContentId TileKind) -> Bool)
-> [(Point, ContentId TileKind)] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map (Point, ContentId TileKind) -> Bool
affects [(Point, ContentId TileKind)]
ts
    when (or bs) $ invalidateBfsLid lid
  UpdLoseTile LevelId
lid [(Point, ContentId TileKind)]
ts -> do
    LevelId -> [(Point, ContentId TileKind)] -> m ()
forall (m :: * -> *).
MonadClient m =>
LevelId -> [(Point, ContentId TileKind)] -> m ()
updateSalter LevelId
lid [(Point, ContentId TileKind)]
ts
    LevelId -> m ()
forall (m :: * -> *). MonadClient m => LevelId -> m ()
invalidateBfsLid LevelId
lid  -- from known to unknown tiles
  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 Container
_ ItemId
iid ContentId ItemKind
_ AspectRecord
_ -> do
    item <- (State -> Item) -> m Item
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Item) -> m Item) -> (State -> Item) -> m Item
forall a b. (a -> b) -> a -> b
$ ItemId -> State -> Item
getItemBody ItemId
iid
    case jkind item of
      IdentityObvious ContentId ItemKind
_ik -> ItemId -> m ()
forall (m :: * -> *). MonadClient m => ItemId -> m ()
discoverAspect ItemId
iid
      IdentityCovered ItemKindIx
ix ContentId ItemKind
_ik ->
        if ItemKindIx
ix ItemKindIx -> EnumMap ItemKindIx (ContentId ItemKind) -> Bool
forall k a. Enum k => k -> EnumMap k a -> Bool
`EM.notMember` State -> EnumMap ItemKindIx (ContentId ItemKind)
sdiscoKind State
oldState
        then ItemKindIx -> m ()
forall (m :: * -> *). MonadClient m => ItemKindIx -> m ()
discoverKindAndAspect ItemKindIx
ix
        else ItemId -> m ()
forall (m :: * -> *). MonadClient m => ItemId -> m ()
discoverAspect ItemId
iid
  UpdCover Container
_ ItemId
iid ContentId ItemKind
_ AspectRecord
_ -> do
    item <- (State -> Item) -> m Item
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Item) -> m Item) -> (State -> Item) -> m Item
forall a b. (a -> b) -> a -> b
$ ItemId -> State -> Item
getItemBody ItemId
iid
    newState <- getState
    case jkind item of
      IdentityObvious ContentId ItemKind
_ik -> ItemId -> m ()
forall (m :: * -> *). ItemId -> m ()
coverAspect ItemId
iid
      IdentityCovered ItemKindIx
ix ContentId ItemKind
_ik ->
        if ItemKindIx
ix ItemKindIx -> EnumMap ItemKindIx (ContentId ItemKind) -> Bool
forall k a. Enum k => k -> EnumMap k a -> Bool
`EM.member` State -> EnumMap ItemKindIx (ContentId ItemKind)
sdiscoKind State
newState
        then ItemKindIx -> m ()
forall (m :: * -> *). ItemKindIx -> m ()
coverAspectAndKind ItemKindIx
ix
        else ItemId -> m ()
forall (m :: * -> *). ItemId -> m ()
coverAspect ItemId
iid
  UpdDiscoverKind Container
_c ItemKindIx
ix ContentId ItemKind
_ik -> ItemKindIx -> m ()
forall (m :: * -> *). MonadClient m => ItemKindIx -> m ()
discoverKind ItemKindIx
ix
  UpdCoverKind Container
_c ItemKindIx
ix ContentId ItemKind
_ik -> ItemKindIx -> m ()
forall (m :: * -> *). ItemKindIx -> m ()
coverKind ItemKindIx
ix
  UpdDiscoverAspect Container
_c ItemId
iid AspectRecord
_arItem -> ItemId -> m ()
forall (m :: * -> *). MonadClient m => ItemId -> m ()
discoverAspect ItemId
iid
  UpdCoverAspect Container
_c ItemId
iid AspectRecord
_arItem -> ItemId -> m ()
forall (m :: * -> *). ItemId -> m ()
coverAspect ItemId
iid
  UpdDiscoverServer{} -> String -> m ()
forall a. (?callStack::CallStack) => String -> a
error String
"server command leaked to client"
  UpdCoverServer{} -> String -> m ()
forall a. (?callStack::CallStack) => String -> a
error String
"server command leaked to client"
  UpdPerception LevelId
lid Perception
outPer Perception
inPer -> LevelId -> Perception -> Perception -> m ()
forall (m :: * -> *).
MonadClient m =>
LevelId -> Perception -> Perception -> m ()
perception LevelId
lid Perception
outPer Perception
inPer
  UpdRestart FactionId
side PerLid
sfper State
_ Challenge
scurChal ClientOptions
soptionsNew SMGen
srandom -> do
    COps{cocave} <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
    fact <- getsState $ (EM.! side) . sfactionD
    snxtChal <- getsClient snxtChal
    smarkSuspect <- getsClient smarkSuspect
    stabs <- getsClient stabs
    soptionsOld <- getsClient soptions
    let h Level
lvl = CaveKind -> Bool
CK.clabyrinth (ContentData CaveKind -> ContentId CaveKind -> CaveKind
forall a. ContentData a -> ContentId a -> a
okind ContentData CaveKind
cocave (ContentId CaveKind -> CaveKind) -> ContentId CaveKind -> CaveKind
forall a b. (a -> b) -> a -> b
$ Level -> ContentId CaveKind
lkind Level
lvl)
                Bool -> Bool -> Bool
&& Bool -> Bool
not (FactionKind -> Bool
fhasGender (FactionKind -> Bool) -> FactionKind -> Bool
forall a b. (a -> b) -> a -> b
$ Faction -> FactionKind
gkind Faction
fact)
          -- Not to burrow through a labyrinth instead of leaving it for
          -- the human player and to prevent AI losing time there instead
          -- of congregating at exits.
    sexplored <- getsState $ EM.keysSet . EM.filter h . sdungeon
    let cli = FactionId -> StateClient
emptyStateClient FactionId
side
    putClient cli { sexplored
                  -- , sundo = [UpdAtomic cmd]
                  , sfper
                  , srandom
                  , scurChal
                  , snxtChal
                  , smarkSuspect
                  , soptions =
                      soptionsNew {snoAnim =  -- persist @snoAnim@ between games
                        snoAnim soptionsOld `mplus` snoAnim soptionsNew}
                  , stabs }
    salter <- getsState createSalter
    modifyClient $ \StateClient
cli1 -> StateClient
cli1 {salter}
    updateInMeleeInDungeon
  UpdRestartServer{} -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdResume FactionId
_side PerLid
sfperNew -> do
#ifdef WITH_EXPENSIVE_ASSERTIONS
    sfperOld <- getsClient sfper
    let !_A = assert (sfperNew == sfperOld
                      `blame` (_side, sfperNew, sfperOld)) ()
#endif
    (StateClient -> StateClient) -> m ()
forall (m :: * -> *).
MonadClient m =>
(StateClient -> StateClient) -> m ()
modifyClient ((StateClient -> StateClient) -> m ())
-> (StateClient -> StateClient) -> m ()
forall a b. (a -> b) -> a -> b
$ \StateClient
cli -> StateClient
cli {sfper = sfperNew}  -- just in case
    salter <- (State -> AlterLid) -> m AlterLid
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> AlterLid
createSalter  -- because space saved by not storing it
    modifyClient $ \StateClient
cli -> StateClient
cli {salter}
  UpdResumeServer{} -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdKillExit FactionId
_fid -> m ()
forall (m :: * -> *). MonadClient m => m ()
killExit
  UpdAtomic
UpdWriteSave -> m ()
forall (m :: * -> *). MonadClientSetup m => m ()
saveClient
  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 ()

updateInMeleeDueToActor :: MonadClient m => Actor -> m ()
updateInMeleeDueToActor :: forall (m :: * -> *). MonadClient m => Actor -> m ()
updateInMeleeDueToActor Actor
b =
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Actor -> Bool
bproj Actor
b) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
    LevelId -> m ()
forall (m :: * -> *). MonadClient m => LevelId -> m ()
insertInMeleeM (Actor -> LevelId
blid Actor
b)

updateInMeleeDueToItem :: MonadClient m => ActorId -> CStore -> m ()
updateInMeleeDueToItem :: forall (m :: * -> *). MonadClient m => ActorId -> CStore -> m ()
updateInMeleeDueToItem ActorId
aid CStore
store =
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CStore
store CStore -> [CStore] -> Bool
forall a. Eq a => a -> [a] -> 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
$ 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
    updateInMeleeDueToActor b

updateInMeleeInDungeon :: MonadClient m => m ()
updateInMeleeInDungeon :: forall (m :: * -> *). MonadClient m => m ()
updateInMeleeInDungeon = do
  dungeon <- (State -> EnumMap LevelId Level) -> m (EnumMap LevelId Level)
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> EnumMap LevelId Level
sdungeon
  mapM_ insertInMeleeM $ EM.keys dungeon

-- For now, only checking the stores.
wipeBfsIfItemAffectsSkills :: MonadClient m => CStore -> ActorId -> m ()
wipeBfsIfItemAffectsSkills :: forall (m :: * -> *). MonadClient m => CStore -> ActorId -> m ()
wipeBfsIfItemAffectsSkills CStore
store ActorId
aid =
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CStore
store CStore -> [CStore] -> Bool
forall a. Eq a => a -> [a] -> 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
$
    ActorId -> m ()
forall (m :: * -> *). MonadClient m => ActorId -> m ()
invalidateBfsAid ActorId
aid

tileChangeAffectsBfs :: COps
                     -> ContentId TileKind -> ContentId TileKind
                     -> Bool
tileChangeAffectsBfs :: COps -> ContentId TileKind -> ContentId TileKind -> Bool
tileChangeAffectsBfs COps{TileSpeedup
coTileSpeedup :: TileSpeedup
coTileSpeedup :: COps -> TileSpeedup
coTileSpeedup} ContentId TileKind
fromTile ContentId TileKind
toTile =
  TileSpeedup -> ContentId TileKind -> Int
Tile.alterMinWalk TileSpeedup
coTileSpeedup ContentId TileKind
fromTile
  Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= TileSpeedup -> ContentId TileKind -> Int
Tile.alterMinWalk TileSpeedup
coTileSpeedup ContentId TileKind
toTile

createActor :: MonadClient m => ActorId -> Actor -> [(ItemId, Item)] -> m ()
createActor :: forall (m :: * -> *).
MonadClient m =>
ActorId -> Actor -> [(ItemId, Item)] -> m ()
createActor ActorId
aid Actor
b [(ItemId, Item)]
ais = do
  side <- (StateClient -> FactionId) -> m FactionId
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
  fact <- getsState $ (EM.! side) . sfactionD
  let affect3 tap :: TgtAndPath
tap@TgtAndPath{Maybe AndPath
Target
tapTgt :: Target
tapPath :: Maybe AndPath
tapPath :: TgtAndPath -> Maybe AndPath
tapTgt :: TgtAndPath -> Target
..} = case Target
tapTgt of
        TPoint (TEnemyPos ActorId
a) LevelId
_ Point
_ | ActorId
a ActorId -> ActorId -> Bool
forall a. Eq a => a -> a -> Bool
== ActorId
aid ->
          let tgt :: Target
tgt | FactionId -> Faction -> FactionId -> Bool
isFoe FactionId
side Faction
fact (Actor -> FactionId
bfid Actor
b) = ActorId -> Target
TEnemy ActorId
a  -- still a foe
                  | Bool
otherwise = TGoal -> LevelId -> Point -> Target
TPoint TGoal
TKnown (Actor -> LevelId
blid Actor
b) (Actor -> Point
bpos Actor
b)
          in Target -> Maybe AndPath -> TgtAndPath
TgtAndPath Target
tgt Maybe AndPath
forall a. Maybe a
Nothing
        Target
_ -> TgtAndPath
tap
  modifyClient $ \StateClient
cli -> StateClient
cli {stargetD = EM.map affect3 (stargetD cli)}
  mapM_ (addItemToDiscoBenefit . fst) ais
  unless (bproj b) $ invalidateBfsPathLid b
  updateInMeleeDueToActor b

destroyActor :: MonadClient m => ActorId -> Actor -> Bool -> m ()
destroyActor :: forall (m :: * -> *).
MonadClient m =>
ActorId -> Actor -> Bool -> m ()
destroyActor ActorId
aid Actor
b Bool
destroy = do
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
destroy (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$  -- if vanishes for a moment only, keep target
    (StateClient -> StateClient) -> m ()
forall (m :: * -> *).
MonadClient m =>
(StateClient -> StateClient) -> m ()
modifyClient ((StateClient -> StateClient) -> m ())
-> (StateClient -> StateClient) -> m ()
forall a b. (a -> b) -> a -> b
$ \StateClient
cli -> StateClient
cli {stargetD = EM.delete aid $ stargetD cli} -- gc
  -- Here, among others, (local) flee time of an actor changing level is reset.
  (StateClient -> StateClient) -> m ()
forall (m :: * -> *).
MonadClient m =>
(StateClient -> StateClient) -> m ()
modifyClient ((StateClient -> StateClient) -> m ())
-> (StateClient -> StateClient) -> m ()
forall a b. (a -> b) -> a -> b
$ \StateClient
cli -> StateClient
cli { sbfsD = EM.delete aid $ sbfsD cli
                             , sfleeD = EM.delete aid $ sfleeD cli }
  localTime <- (State -> Time) -> m Time
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Time) -> m Time) -> (State -> Time) -> m Time
forall a b. (a -> b) -> a -> b
$ LevelId -> State -> Time
getLocalTime (LevelId -> State -> Time) -> LevelId -> State -> Time
forall a b. (a -> b) -> a -> b
$ Actor -> LevelId
blid Actor
b
  fleeD <- getsClient sfleeD
  let recentlyFled ActorId
aid3 = Bool -> ((Point, Time) -> Bool) -> Maybe (Point, Time) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (\(Point
_, Time
time) -> Time -> Time -> Bool
timeRecent5 Time
localTime Time
time)
                                (ActorId
aid3 ActorId -> EnumMap ActorId (Point, Time) -> Maybe (Point, Time)
forall k a. Enum k => k -> EnumMap k a -> Maybe a
`EM.lookup` EnumMap ActorId (Point, Time)
fleeD)
      dummyTarget = TGoal -> LevelId -> Point -> Target
TPoint TGoal
TKnown (Actor -> LevelId
blid Actor
b) (Actor -> Point
bpos Actor
b)
      affect ActorId
aid3 Target
tgt = case Target
tgt of
        TEnemy ActorId
a | ActorId
a ActorId -> ActorId -> Bool
forall a. Eq a => a -> a -> Bool
== ActorId
aid ->
          if Bool
destroy Bool -> Bool -> Bool
|| ActorId -> Bool
recentlyFled ActorId
aid3
                          -- if fleeing, don't chase the enemy soon after;
                          -- unfortunately, the enemy also won't be recorded
                          -- in case he gets out of sight, in order to avoid
                          -- him when fleeing again, but all enemies should be
                          -- recorded in such a case, so not a big difference
          then
            -- If *really* nothing more interesting, the actor will
            -- go to last known location to perhaps find other foes.
            Target
dummyTarget
          else
            -- If enemy only hides (or we stepped behind obstacle) find him.
            TGoal -> LevelId -> Point -> Target
TPoint (ActorId -> TGoal
TEnemyPos ActorId
a) (Actor -> LevelId
blid Actor
b) (Actor -> Point
bpos Actor
b)
        TNonEnemy ActorId
a | ActorId
a ActorId -> ActorId -> Bool
forall a. Eq a => a -> a -> Bool
== ActorId
aid -> Target
dummyTarget
        Target
_ -> Target
tgt
      affect3 ActorId
aid3 TgtAndPath{Maybe AndPath
Target
tapPath :: TgtAndPath -> Maybe AndPath
tapTgt :: TgtAndPath -> Target
tapTgt :: Target
tapPath :: Maybe AndPath
..} =
        let newMPath :: Maybe AndPath
newMPath = case Maybe AndPath
tapPath of
              Just AndPath{Point
pathGoal :: Point
pathGoal :: AndPath -> Point
pathGoal} | Point
pathGoal Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
/= Actor -> Point
bpos Actor
b -> Maybe AndPath
forall a. Maybe a
Nothing
              Maybe AndPath
_ -> Maybe AndPath
tapPath  -- foe slow enough, so old path good
        in Target -> Maybe AndPath -> TgtAndPath
TgtAndPath (ActorId -> Target -> Target
affect ActorId
aid3 Target
tapTgt) Maybe AndPath
newMPath
  modifyClient $ \StateClient
cli -> StateClient
cli {stargetD = EM.mapWithKey affect3 (stargetD cli)}
  unless (bproj b) $ invalidateBfsPathLid b
  updateInMeleeDueToActor b

addItemToDiscoBenefit :: MonadClient m => ItemId -> m ()
addItemToDiscoBenefit :: forall (m :: * -> *). MonadClient m => ItemId -> m ()
addItemToDiscoBenefit ItemId
iid = do
  cops <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  discoBenefit <- getsClient sdiscoBenefit
  case EM.lookup iid discoBenefit of
    Just{} -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      -- already there, with real or provisional aspect record,
      -- but we haven't learned anything new about the item
    Maybe Benefit
Nothing -> do
      side <- (StateClient -> FactionId) -> m FactionId
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
      factionD <- getsState sfactionD
      itemFull <- getsState $ itemToFull iid
      let benefit = COps
-> FactionId -> EnumMap FactionId Faction -> ItemFull -> Benefit
totalUsefulness COps
cops FactionId
side EnumMap FactionId Faction
factionD ItemFull
itemFull
      modifyClient $ \StateClient
cli ->
        StateClient
cli {sdiscoBenefit = EM.insert iid benefit (sdiscoBenefit cli)}

perception :: MonadClient m => LevelId -> Perception -> Perception -> m ()
perception :: forall (m :: * -> *).
MonadClient m =>
LevelId -> Perception -> Perception -> m ()
perception LevelId
lid Perception
outPer Perception
inPer = do
  -- Clients can't compute FOV on their own, because they don't know
  -- if unknown tiles are clear or not. Server would need to send
  -- info about properties of unknown tiles, which complicates
  -- and makes heavier the most bulky data set in the game: tile maps.
  -- Note we assume, but do not check that @outPer@ is contained
  -- in current perception and @inPer@ has no common part with it.
  -- It would make the already very costly operation even more expensive.
{-
  perOld <- getPerFid lid
  -- Check if new perception is already set in @cmdAtomicFilterCli@
  -- or if we are doing undo/redo, which does not involve filtering.
  -- The data structure is strict, so the cheap check can't be any simpler.
  let interAlready per =
        Just $ totalVisible per `ES.intersection` totalVisible perOld
      unset = maybe False ES.null (interAlready inPer)
              || maybe False (not . ES.null) (interAlready outPer)
  when unset $ do
-}
    let adj :: Maybe Perception -> Maybe Perception
adj Maybe Perception
Nothing = String -> Maybe Perception
forall a. (?callStack::CallStack) => String -> a
error (String -> Maybe Perception) -> String -> Maybe Perception
forall a b. (a -> b) -> a -> b
$ String
"no perception to alter" String -> LevelId -> String
forall v. Show v => String -> v -> String
`showFailure` LevelId
lid
        adj (Just Perception
per) = Perception -> Maybe Perception
forall a. a -> Maybe a
Just (Perception -> Maybe Perception) -> Perception -> Maybe Perception
forall a b. (a -> b) -> a -> b
$ Perception -> Perception -> Perception
addPer (Perception -> Perception -> Perception
diffPer Perception
per Perception
outPer) Perception
inPer
        f :: PerLid -> PerLid
f = (Maybe Perception -> Maybe Perception)
-> LevelId -> PerLid -> PerLid
forall k a.
Enum k =>
(Maybe a -> Maybe a) -> k -> EnumMap k a -> EnumMap k a
EM.alter Maybe Perception -> Maybe Perception
adj LevelId
lid
    (StateClient -> StateClient) -> m ()
forall (m :: * -> *).
MonadClient m =>
(StateClient -> StateClient) -> m ()
modifyClient ((StateClient -> StateClient) -> m ())
-> (StateClient -> StateClient) -> m ()
forall a b. (a -> b) -> a -> b
$ \StateClient
cli -> StateClient
cli {sfper = f (sfper cli)}

discoverKind :: MonadClient m => ItemKindIx -> m ()
discoverKind :: forall (m :: * -> *). MonadClient m => ItemKindIx -> m ()
discoverKind = ItemKindIx -> m ()
forall (m :: * -> *). MonadClient m => ItemKindIx -> m ()
discoverKindAndAspect

discoverKindAndAspect :: MonadClient m => ItemKindIx -> m ()
discoverKindAndAspect :: forall (m :: * -> *). MonadClient m => ItemKindIx -> m ()
discoverKindAndAspect ItemKindIx
ix = do
  cops <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  -- Wipe out BFS, because the player could potentially learn that his items
  -- affect his actors' skills relevant to BFS.
  invalidateBfsAll
  side <- getsClient sside
  factionD <- getsState sfactionD
  itemToF <- getsState $ flip itemToFull
  let benefit ItemId
iid = COps
-> FactionId -> EnumMap FactionId Faction -> ItemFull -> Benefit
totalUsefulness COps
cops FactionId
side EnumMap FactionId Faction
factionD (ItemId -> ItemFull
itemToF ItemId
iid)
  itemIxMap <- getsState $ (EM.! ix) . sitemIxMap
  -- Possibly overwrite earlier, provisional benefits.
  forM_ (ES.elems itemIxMap) $ \ItemId
iid -> (StateClient -> StateClient) -> m ()
forall (m :: * -> *).
MonadClient m =>
(StateClient -> StateClient) -> m ()
modifyClient ((StateClient -> StateClient) -> m ())
-> (StateClient -> StateClient) -> m ()
forall a b. (a -> b) -> a -> b
$ \StateClient
cli ->
    StateClient
cli {sdiscoBenefit = EM.insert iid (benefit iid) (sdiscoBenefit cli)}

coverKind :: ItemKindIx -> m ()
coverKind :: forall (m :: * -> *). ItemKindIx -> m ()
coverKind = ItemKindIx -> m ()
forall (m :: * -> *). ItemKindIx -> m ()
coverAspectAndKind

coverAspectAndKind :: ItemKindIx -> m ()
coverAspectAndKind :: forall (m :: * -> *). ItemKindIx -> m ()
coverAspectAndKind ItemKindIx
_ix = m ()
forall a. (?callStack::CallStack) => a
undefined

discoverAspect :: MonadClient m => ItemId -> m ()
discoverAspect :: forall (m :: * -> *). MonadClient m => ItemId -> m ()
discoverAspect ItemId
iid = do
  cops <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  -- Wipe out BFS, because the player could potentially learn that his items
  -- affect his actors' skills relevant to BFS.
  invalidateBfsAll
  side <- getsClient sside
  factionD <- getsState sfactionD
  itemFull <- getsState $ itemToFull iid
  let benefit = COps
-> FactionId -> EnumMap FactionId Faction -> ItemFull -> Benefit
totalUsefulness COps
cops FactionId
side EnumMap FactionId Faction
factionD ItemFull
itemFull
  -- Possibly overwrite earlier, provisional benefits.
  modifyClient $ \StateClient
cli ->
    StateClient
cli {sdiscoBenefit = EM.insert iid benefit (sdiscoBenefit cli)}

coverAspect :: ItemId -> m ()
coverAspect :: forall (m :: * -> *). ItemId -> m ()
coverAspect ItemId
_iid = m ()
forall a. (?callStack::CallStack) => a
undefined

killExit :: MonadClient m => m ()
killExit :: forall (m :: * -> *). MonadClient m => m ()
killExit = do
  side <- (StateClient -> FactionId) -> m FactionId
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
  debugPossiblyPrint $ "Client" <+> tshow side <+> "quitting."
  modifyClient $ \StateClient
cli -> StateClient
cli {squit = True}
  -- Verify that the not saved caches are equal to future reconstructed.
  -- Otherwise, save/restore would change game state.
  sactorMaxSkills2 <- getsState sactorMaxSkills
  salter <- getsClient salter
  sbfsD <- getsClient sbfsD
  alter <- getsState createSalter
  actorMaxSkills <- getsState maxSkillsInDungeon
  let f ActorId
aid = do
        (canMove, alterSkill) <- ActorId -> m (Bool, Word8)
forall (m :: * -> *).
MonadClientRead m =>
ActorId -> m (Bool, Word8)
condBFS ActorId
aid
        bfsArr <- createBfs canMove alterSkill aid
        let bfsPath = EnumMap k a
forall k a. EnumMap k a
EM.empty
        return (aid, BfsAndPath bfsArr bfsPath)
  actorD <- getsState sactorD
  lbfsD <- mapM f $ EM.keys actorD
  -- Some freshly generated bfses are not used for comparison, but at least
  -- we check they don't violate internal assertions themselves. Hence the bang.
  let bfsD = [(ActorId, BfsAndPath)] -> EnumMap ActorId BfsAndPath
forall k a. Enum k => [(k, a)] -> EnumMap k a
EM.fromDistinctAscList [(ActorId, BfsAndPath)]
lbfsD
      g BfsAndPath
BfsInvalid !BfsAndPath
_ = Bool
True
      g BfsAndPath
_ BfsAndPath
BfsInvalid = Bool
False
      g (BfsAndPath Array BfsDistance
bfsArr1 EnumMap Point AndPath
_) (BfsAndPath Array BfsDistance
bfsArr2 EnumMap Point AndPath
_) = Array BfsDistance
bfsArr1 Array BfsDistance -> Array BfsDistance -> Bool
forall a. Eq a => a -> a -> Bool
== Array BfsDistance
bfsArr2
      subBfs = (BfsAndPath -> BfsAndPath -> Bool)
-> EnumMap k BfsAndPath -> EnumMap k BfsAndPath -> Bool
forall a b k.
(a -> b -> Bool) -> EnumMap k a -> EnumMap k b -> Bool
EM.isSubmapOfBy BfsAndPath -> BfsAndPath -> Bool
g
  let !_A1 = Bool -> () -> ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (AlterLid
salter AlterLid -> AlterLid -> Bool
forall a. Eq a => a -> a -> Bool
== AlterLid
alter
                     Bool -> (String, (FactionId, AlterLid, AlterLid)) -> Bool
forall v. Show v => Bool -> v -> Bool
`blame` String
"wrong accumulated salter on side"
                     String
-> (FactionId, AlterLid, AlterLid)
-> (String, (FactionId, AlterLid, AlterLid))
forall v. String -> v -> (String, v)
`swith` (FactionId
side, AlterLid
salter, AlterLid
alter)) ()
      !_A2 = Bool -> () -> ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (ActorMaxSkills
sactorMaxSkills2 ActorMaxSkills -> ActorMaxSkills -> Bool
forall a. Eq a => a -> a -> Bool
== ActorMaxSkills
actorMaxSkills
                     Bool
-> (String, (FactionId, ActorMaxSkills, ActorMaxSkills)) -> Bool
forall v. Show v => Bool -> v -> Bool
`blame` String
"wrong accumulated sactorMaxSkills on side"
                     String
-> (FactionId, ActorMaxSkills, ActorMaxSkills)
-> (String, (FactionId, ActorMaxSkills, ActorMaxSkills))
forall v. String -> v -> (String, v)
`swith` (FactionId
side, ActorMaxSkills
sactorMaxSkills2, ActorMaxSkills
actorMaxSkills)) ()
      !_A3 = Bool -> () -> ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (EnumMap ActorId BfsAndPath
sbfsD EnumMap ActorId BfsAndPath -> EnumMap ActorId BfsAndPath -> Bool
forall {k}. EnumMap k BfsAndPath -> EnumMap k BfsAndPath -> Bool
`subBfs` EnumMap ActorId BfsAndPath
bfsD
                     Bool
-> (String,
    (FactionId, EnumMap ActorId BfsAndPath,
     EnumMap ActorId BfsAndPath))
-> Bool
forall v. Show v => Bool -> v -> Bool
`blame` String
"wrong accumulated sbfsD on side"
                     String
-> (FactionId, EnumMap ActorId BfsAndPath,
    EnumMap ActorId BfsAndPath)
-> (String,
    (FactionId, EnumMap ActorId BfsAndPath,
     EnumMap ActorId BfsAndPath))
forall v. String -> v -> (String, v)
`swith` (FactionId
side, EnumMap ActorId BfsAndPath
sbfsD, EnumMap ActorId BfsAndPath
bfsD)) ()
  return ()