-- | 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 :: 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 (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdSpotActor ActorId
aid Actor
b -> do
    [(ItemId, Item)]
ais <- (State -> [(ItemId, Item)]) -> m [(ItemId, Item)]
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
    ActorId -> Actor -> [(ItemId, Item)] -> m ()
forall (m :: * -> *).
MonadClient m =>
ActorId -> Actor -> [(ItemId, Item)] -> m ()
createActor ActorId
aid Actor
b [(ItemId, Item)]
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 (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 (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.
    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
    Actor -> m ()
forall (m :: * -> *). MonadClient m => Actor -> m ()
updateInMeleeDueToActor Actor
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)
    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
    Actor -> m ()
forall (m :: * -> *). MonadClient m => Actor -> m ()
updateInMeleeDueToActor Actor
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.
    Actor
sb <- (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
source
    -- At least one of these is not a projectile and both move, so update.
    LevelId -> m ()
forall (m :: * -> *). MonadClient m => LevelId -> m ()
insertInMeleeM (Actor -> LevelId
blid Actor
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 (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdRefillHP ActorId
aid Int64
delta -> 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
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Actor -> Bool
bproj Actor
b
            Bool -> Bool -> Bool
|| Int64 -> Int64
forall a. Num a => a -> a
signum (Actor -> Int64
bhp Actor
b)  -- new HP
               Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64 -> Int64
forall a. Num a => a -> a
signum (Actor -> Int64
bhp Actor
b Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
delta)) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$  -- old HP
      LevelId -> m ()
forall (m :: * -> *). MonadClient m => LevelId -> m ()
insertInMeleeM (Actor -> LevelId
blid Actor
b)  -- @bhp@ checked in several places
  UpdRefillCalm{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdTrajectory{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdQuitFaction{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdSpotStashFaction{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdLoseStashFaction{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdLeadFaction FactionId
fid Maybe ActorId
source Maybe ActorId
target -> do
    FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (FactionId
side FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
fid) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
      Maybe ActorId
mleader <- (StateClient -> Maybe ActorId) -> m (Maybe ActorId)
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Maybe ActorId
sleader
      let !_A :: ()
_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 a. Show a => Bool -> a -> 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)) ()
      (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 {_sleader :: Maybe ActorId
_sleader = Maybe ActorId
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 :: ClientOptions
soptions = (StateClient -> ClientOptions
soptions StateClient
cli) { sstopAfterSeconds :: Maybe Int
sstopAfterSeconds = Maybe Int
forall a. Maybe a
Nothing
                                     , sstopAfterFrames :: Maybe Int
sstopAfterFrames = Maybe Int
forall a. Maybe a
Nothing }}
    -- @condBFS@ depends on the setting we change here (e.g., smarkSuspect).
    m ()
forall (m :: * -> *). MonadClient m => m ()
invalidateBfsAll
  UpdRecordKill{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdDoctrineFaction{} -> do
    -- Clear all targets except the leader's.
    Maybe ActorId
mleader <- (StateClient -> Maybe ActorId) -> m (Maybe ActorId)
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Maybe ActorId
sleader
    Maybe TgtAndPath
mtgt <- case Maybe ActorId
mleader of
      Maybe ActorId
Nothing -> Maybe TgtAndPath -> m (Maybe TgtAndPath)
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 (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
    (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 ->
      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 {EnumMap ActorId TgtAndPath
stargetD :: EnumMap ActorId TgtAndPath
stargetD :: EnumMap ActorId TgtAndPath
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
cops <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
    let lvl :: Level
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 :: ContentId TileKind
t = Level
lvl Level -> Point -> ContentId TileKind
`at` Point
p
    let !_A :: ()
_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) ()
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (COps -> ContentId TileKind -> ContentId TileKind -> Bool
tileChangeAffectsBfs COps
cops ContentId TileKind
fromTile ContentId TileKind
toTile) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
      LevelId -> m ()
forall (m :: * -> *). MonadClient m => LevelId -> m ()
invalidateBfsLid LevelId
lid
  UpdAlterExplorable{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdAlterGold{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdSearchTile ActorId
aid Point
p ContentId TileKind
toTile -> do
    COps{ContentData TileKind
cotile :: COps -> ContentData TileKind
cotile :: ContentData TileKind
cotile} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
    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
    let lid :: LevelId
lid = Actor -> LevelId
blid Actor
b
    LevelId -> [(Point, ContentId TileKind)] -> m ()
forall (m :: * -> *).
MonadClient m =>
LevelId -> [(Point, ContentId TileKind)] -> m ()
updateSalter LevelId
lid [(Point
p, ContentId TileKind
toTile)]
    COps
cops <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
    let lvl :: Level
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 :: ContentId TileKind
t = Level
lvl Level -> Point -> ContentId TileKind
`at` Point
p
    let !_A :: ()
_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.
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (COps -> ContentId TileKind -> ContentId TileKind -> Bool
tileChangeAffectsBfs COps
cops ContentId TileKind
t ContentId TileKind
toTile) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
      LevelId -> m ()
forall (m :: * -> *). MonadClient m => LevelId -> m ()
invalidateBfsLid LevelId
lid
  UpdHideTile{} -> () -> m ()
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
cops <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
    let lvl :: Level
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, ContentId TileKind) -> Bool
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 :: [Bool]
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
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or [Bool]
bs) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ LevelId -> m ()
forall (m :: * -> *). MonadClient m => LevelId -> m ()
invalidateBfsLid LevelId
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 (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdLoseEntry{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdAlterSmell{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdSpotSmell{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdLoseSmell{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdTimeItem{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdAgeGame{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdUnAgeGame{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdDiscover Container
_ ItemId
iid ContentId ItemKind
_ AspectRecord
_ -> do
    Item
item <- (State -> Item) -> m Item
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 Item -> ItemIdentity
jkind Item
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
item <- (State -> Item) -> m Item
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
    State
newState <- m State
forall (m :: * -> *). MonadStateRead m => m State
getState
    case Item -> ItemIdentity
jkind Item
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{ContentData CaveKind
cocave :: COps -> ContentData CaveKind
cocave :: ContentData CaveKind
cocave} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
    Faction
fact <- (State -> Faction) -> m Faction
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
side) (EnumMap FactionId Faction -> Faction)
-> (State -> EnumMap FactionId Faction) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap FactionId Faction
sfactionD
    Challenge
snxtChal <- (StateClient -> Challenge) -> m Challenge
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Challenge
snxtChal
    Int
smarkSuspect <- (StateClient -> Int) -> m Int
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Int
smarkSuspect
    (PrimArray Int, PrimArray Int)
stabs <- (StateClient -> (PrimArray Int, PrimArray Int))
-> m (PrimArray Int, PrimArray Int)
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> (PrimArray Int, PrimArray Int)
stabs
    ClientOptions
soptionsOld <- (StateClient -> ClientOptions) -> m ClientOptions
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> ClientOptions
soptions
    let h :: Level -> Bool
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.
    EnumSet LevelId
sexplored <- (State -> EnumSet LevelId) -> m (EnumSet LevelId)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> EnumSet LevelId) -> m (EnumSet LevelId))
-> (State -> EnumSet LevelId) -> m (EnumSet LevelId)
forall a b. (a -> b) -> a -> b
$ EnumMap LevelId Level -> EnumSet LevelId
forall k a. Enum k => EnumMap k a -> EnumSet k
EM.keysSet (EnumMap LevelId Level -> EnumSet LevelId)
-> (State -> EnumMap LevelId Level) -> State -> EnumSet LevelId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Level -> Bool) -> EnumMap LevelId Level -> EnumMap LevelId Level
forall a k. (a -> Bool) -> EnumMap k a -> EnumMap k a
EM.filter Level -> Bool
h (EnumMap LevelId Level -> EnumMap LevelId Level)
-> (State -> EnumMap LevelId Level)
-> State
-> EnumMap LevelId Level
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap LevelId Level
sdungeon
    let cli :: StateClient
cli = FactionId -> StateClient
emptyStateClient FactionId
side
    StateClient -> m ()
forall (m :: * -> *). MonadClient m => StateClient -> m ()
putClient StateClient
cli { EnumSet LevelId
sexplored :: EnumSet LevelId
sexplored :: EnumSet LevelId
sexplored
                  -- , sundo = [UpdAtomic cmd]
                  , PerLid
sfper :: PerLid
sfper :: PerLid
sfper
                  , SMGen
srandom :: SMGen
srandom :: SMGen
srandom
                  , Challenge
scurChal :: Challenge
scurChal :: Challenge
scurChal
                  , Challenge
snxtChal :: Challenge
snxtChal :: Challenge
snxtChal
                  , Int
smarkSuspect :: Int
smarkSuspect :: Int
smarkSuspect
                  , soptions :: ClientOptions
soptions =
                      ClientOptions
soptionsNew {snoAnim :: Maybe Bool
snoAnim =  -- persist @snoAnim@ between games
                        ClientOptions -> Maybe Bool
snoAnim ClientOptions
soptionsOld Maybe Bool -> Maybe Bool -> Maybe Bool
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` ClientOptions -> Maybe Bool
snoAnim ClientOptions
soptionsNew}
                  , (PrimArray Int, PrimArray Int)
stabs :: (PrimArray Int, PrimArray Int)
stabs :: (PrimArray Int, PrimArray Int)
stabs }
    AlterLid
salter <- (State -> AlterLid) -> m AlterLid
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> AlterLid
createSalter
    (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
cli1 -> StateClient
cli1 {AlterLid
salter :: AlterLid
salter :: AlterLid
salter}
    m ()
forall (m :: * -> *). MonadClient m => m ()
updateInMeleeInDungeon
  UpdRestartServer{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdResume FactionId
_side PerLid
sfperNew -> do
#ifdef WITH_EXPENSIVE_ASSERTIONS
    PerLid
sfperOld <- (StateClient -> PerLid) -> m PerLid
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> PerLid
sfper
    let !_A :: ()
_A = Bool -> () -> ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (PerLid
sfperNew PerLid -> PerLid -> Bool
forall a. Eq a => a -> a -> Bool
== PerLid
sfperOld
                      Bool -> (FactionId, PerLid, PerLid) -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` (FactionId
_side, PerLid
sfperNew, PerLid
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 :: PerLid
sfper = PerLid
sfperNew}  -- just in case
    AlterLid
salter <- (State -> AlterLid) -> m AlterLid
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> AlterLid
createSalter  -- because space saved by not storing it
    (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 {AlterLid
salter :: AlterLid
salter :: AlterLid
salter}
  UpdResumeServer{} -> () -> m ()
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 (m :: * -> *) a. Monad m => a -> m a
return ()
  UpdMuteMessages{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

updateInMeleeDueToActor :: MonadClient m => Actor -> m ()
updateInMeleeDueToActor :: 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 :: 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 (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
    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
    Actor -> m ()
forall (m :: * -> *). MonadClient m => Actor -> m ()
updateInMeleeDueToActor Actor
b

updateInMeleeInDungeon :: MonadClient m => m ()
updateInMeleeInDungeon :: m ()
updateInMeleeInDungeon = do
  EnumMap LevelId Level
dungeon <- (State -> EnumMap LevelId Level) -> m (EnumMap LevelId Level)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> EnumMap LevelId Level
sdungeon
  (LevelId -> m ()) -> [LevelId] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
mapM_ LevelId -> m ()
forall (m :: * -> *). MonadClient m => LevelId -> m ()
insertInMeleeM ([LevelId] -> m ()) -> [LevelId] -> m ()
forall a b. (a -> b) -> a -> b
$ EnumMap LevelId Level -> [LevelId]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys EnumMap LevelId Level
dungeon

-- For now, only checking the stores.
wipeBfsIfItemAffectsSkills :: MonadClient m => CStore -> ActorId -> m ()
wipeBfsIfItemAffectsSkills :: 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 (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 :: COps -> TileSpeedup
coTileSpeedup :: 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 :: ActorId -> Actor -> [(ItemId, Item)] -> m ()
createActor ActorId
aid Actor
b [(ItemId, Item)]
ais = do
  FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
  Faction
fact <- (State -> Faction) -> m Faction
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
side) (EnumMap FactionId Faction -> Faction)
-> (State -> EnumMap FactionId Faction) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap FactionId Faction
sfactionD
  let affect3 :: TgtAndPath -> TgtAndPath
affect3 tap :: TgtAndPath
tap@TgtAndPath{Maybe AndPath
Target
tapPath :: TgtAndPath -> Maybe AndPath
tapTgt :: TgtAndPath -> Target
tapPath :: Maybe AndPath
tapTgt :: 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
  (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 :: EnumMap ActorId TgtAndPath
stargetD = (TgtAndPath -> TgtAndPath)
-> EnumMap ActorId TgtAndPath -> EnumMap ActorId TgtAndPath
forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
EM.map TgtAndPath -> TgtAndPath
affect3 (StateClient -> EnumMap ActorId TgtAndPath
stargetD StateClient
cli)}
  ((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
  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
$ Actor -> m ()
forall (m :: * -> *). MonadClient m => Actor -> m ()
invalidateBfsPathLid Actor
b
  Actor -> m ()
forall (m :: * -> *). MonadClient m => Actor -> m ()
updateInMeleeDueToActor Actor
b

destroyActor :: MonadClient m => ActorId -> Actor -> Bool -> m ()
destroyActor :: 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 :: EnumMap ActorId TgtAndPath
stargetD = ActorId -> EnumMap ActorId TgtAndPath -> EnumMap ActorId TgtAndPath
forall k a. Enum k => k -> EnumMap k a -> EnumMap k a
EM.delete ActorId
aid (EnumMap ActorId TgtAndPath -> EnumMap ActorId TgtAndPath)
-> EnumMap ActorId TgtAndPath -> EnumMap ActorId TgtAndPath
forall a b. (a -> b) -> a -> b
$ StateClient -> EnumMap ActorId TgtAndPath
stargetD StateClient
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 :: EnumMap ActorId BfsAndPath
sbfsD = ActorId -> EnumMap ActorId BfsAndPath -> EnumMap ActorId BfsAndPath
forall k a. Enum k => k -> EnumMap k a -> EnumMap k a
EM.delete ActorId
aid (EnumMap ActorId BfsAndPath -> EnumMap ActorId BfsAndPath)
-> EnumMap ActorId BfsAndPath -> EnumMap ActorId BfsAndPath
forall a b. (a -> b) -> a -> b
$ StateClient -> EnumMap ActorId BfsAndPath
sbfsD StateClient
cli
                             , sfleeD :: EnumMap ActorId (Point, Time)
sfleeD = ActorId
-> EnumMap ActorId (Point, Time) -> EnumMap ActorId (Point, Time)
forall k a. Enum k => k -> EnumMap k a -> EnumMap k a
EM.delete ActorId
aid (EnumMap ActorId (Point, Time) -> EnumMap ActorId (Point, Time))
-> EnumMap ActorId (Point, Time) -> EnumMap ActorId (Point, Time)
forall a b. (a -> b) -> a -> b
$ StateClient -> EnumMap ActorId (Point, Time)
sfleeD StateClient
cli }
  Time
localTime <- (State -> Time) -> m Time
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
  EnumMap ActorId (Point, Time)
fleeD <- (StateClient -> EnumMap ActorId (Point, Time))
-> m (EnumMap ActorId (Point, Time))
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> EnumMap ActorId (Point, Time)
sfleeD
  let recentlyFled :: ActorId -> Bool
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 :: Target
dummyTarget = TGoal -> LevelId -> Point -> Target
TPoint TGoal
TKnown (Actor -> LevelId
blid Actor
b) (Actor -> Point
bpos Actor
b)
      affect :: ActorId -> Target -> Target
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 -> TgtAndPath -> TgtAndPath
affect3 ActorId
aid3 TgtAndPath{Maybe AndPath
Target
tapPath :: Maybe AndPath
tapTgt :: Target
tapPath :: TgtAndPath -> Maybe AndPath
tapTgt :: TgtAndPath -> Target
..} =
        let newMPath :: Maybe AndPath
newMPath = case Maybe AndPath
tapPath of
              Just AndPath{Point
pathGoal :: AndPath -> Point
pathGoal :: 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
  (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 :: EnumMap ActorId TgtAndPath
stargetD = (ActorId -> TgtAndPath -> TgtAndPath)
-> EnumMap ActorId TgtAndPath -> EnumMap ActorId TgtAndPath
forall k a b. Enum k => (k -> a -> b) -> EnumMap k a -> EnumMap k b
EM.mapWithKey ActorId -> TgtAndPath -> TgtAndPath
affect3 (StateClient -> EnumMap ActorId TgtAndPath
stargetD StateClient
cli)}
  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
$ Actor -> m ()
forall (m :: * -> *). MonadClient m => Actor -> m ()
invalidateBfsPathLid Actor
b
  Actor -> m ()
forall (m :: * -> *). MonadClient m => Actor -> m ()
updateInMeleeDueToActor Actor
b

addItemToDiscoBenefit :: MonadClient m => ItemId -> m ()
addItemToDiscoBenefit :: ItemId -> m ()
addItemToDiscoBenefit ItemId
iid = do
  COps
cops <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  DiscoveryBenefit
discoBenefit <- (StateClient -> DiscoveryBenefit) -> m DiscoveryBenefit
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> DiscoveryBenefit
sdiscoBenefit
  case ItemId -> DiscoveryBenefit -> Maybe Benefit
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup ItemId
iid DiscoveryBenefit
discoBenefit of
    Just{} -> () -> m ()
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
      FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
      EnumMap FactionId Faction
factionD <- (State -> EnumMap FactionId Faction)
-> m (EnumMap FactionId Faction)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> EnumMap FactionId Faction
sfactionD
      ItemFull
itemFull <- (State -> ItemFull) -> m ItemFull
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemFull) -> m ItemFull)
-> (State -> ItemFull) -> m ItemFull
forall a b. (a -> b) -> a -> b
$ ItemId -> State -> ItemFull
itemToFull ItemId
iid
      let benefit :: Benefit
benefit = COps
-> FactionId -> EnumMap FactionId Faction -> ItemFull -> Benefit
totalUsefulness COps
cops FactionId
side EnumMap FactionId Faction
factionD ItemFull
itemFull
      (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 :: DiscoveryBenefit
sdiscoBenefit = ItemId -> Benefit -> DiscoveryBenefit -> DiscoveryBenefit
forall k a. Enum k => k -> a -> EnumMap k a -> EnumMap k a
EM.insert ItemId
iid Benefit
benefit (StateClient -> DiscoveryBenefit
sdiscoBenefit StateClient
cli)}

perception :: MonadClient m => LevelId -> Perception -> Perception -> m ()
perception :: 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 :: PerLid
sfper = PerLid -> PerLid
f (StateClient -> PerLid
sfper StateClient
cli)}

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

discoverKindAndAspect :: MonadClient m => ItemKindIx -> m ()
discoverKindAndAspect :: ItemKindIx -> m ()
discoverKindAndAspect ItemKindIx
ix = do
  COps
cops <- (State -> COps) -> m COps
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.
  m ()
forall (m :: * -> *). MonadClient m => m ()
invalidateBfsAll
  FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
  EnumMap FactionId Faction
factionD <- (State -> EnumMap FactionId Faction)
-> m (EnumMap FactionId Faction)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> EnumMap FactionId Faction
sfactionD
  ItemId -> ItemFull
itemToF <- (State -> ItemId -> ItemFull) -> m (ItemId -> ItemFull)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemId -> ItemFull) -> m (ItemId -> ItemFull))
-> (State -> ItemId -> ItemFull) -> m (ItemId -> ItemFull)
forall a b. (a -> b) -> a -> b
$ (ItemId -> State -> ItemFull) -> State -> ItemId -> ItemFull
forall a b c. (a -> b -> c) -> b -> a -> c
flip ItemId -> State -> ItemFull
itemToFull
  let benefit :: ItemId -> Benefit
benefit ItemId
iid = COps
-> FactionId -> EnumMap FactionId Faction -> ItemFull -> Benefit
totalUsefulness COps
cops FactionId
side EnumMap FactionId Faction
factionD (ItemId -> ItemFull
itemToF ItemId
iid)
  EnumSet ItemId
itemIxMap <- (State -> EnumSet ItemId) -> m (EnumSet ItemId)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> EnumSet ItemId) -> m (EnumSet ItemId))
-> (State -> EnumSet ItemId) -> m (EnumSet ItemId)
forall a b. (a -> b) -> a -> b
$ (EnumMap ItemKindIx (EnumSet ItemId) -> ItemKindIx -> EnumSet ItemId
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ItemKindIx
ix) (EnumMap ItemKindIx (EnumSet ItemId) -> EnumSet ItemId)
-> (State -> EnumMap ItemKindIx (EnumSet ItemId))
-> State
-> EnumSet ItemId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap ItemKindIx (EnumSet ItemId)
sitemIxMap
  -- Possibly overwrite earlier, provisional benefits.
  [ItemId] -> (ItemId -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t a -> (a -> m ()) -> m ()
forM_ (EnumSet ItemId -> [ItemId]
forall k. Enum k => EnumSet k -> [k]
ES.elems EnumSet ItemId
itemIxMap) ((ItemId -> m ()) -> m ()) -> (ItemId -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \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 :: DiscoveryBenefit
sdiscoBenefit = ItemId -> Benefit -> DiscoveryBenefit -> DiscoveryBenefit
forall k a. Enum k => k -> a -> EnumMap k a -> EnumMap k a
EM.insert ItemId
iid (ItemId -> Benefit
benefit ItemId
iid) (StateClient -> DiscoveryBenefit
sdiscoBenefit StateClient
cli)}

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

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

discoverAspect :: MonadClient m => ItemId -> m ()
discoverAspect :: ItemId -> m ()
discoverAspect ItemId
iid = do
  COps
cops <- (State -> COps) -> m COps
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.
  m ()
forall (m :: * -> *). MonadClient m => m ()
invalidateBfsAll
  FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
  EnumMap FactionId Faction
factionD <- (State -> EnumMap FactionId Faction)
-> m (EnumMap FactionId Faction)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> EnumMap FactionId Faction
sfactionD
  ItemFull
itemFull <- (State -> ItemFull) -> m ItemFull
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemFull) -> m ItemFull)
-> (State -> ItemFull) -> m ItemFull
forall a b. (a -> b) -> a -> b
$ ItemId -> State -> ItemFull
itemToFull ItemId
iid
  let benefit :: Benefit
benefit = COps
-> FactionId -> EnumMap FactionId Faction -> ItemFull -> Benefit
totalUsefulness COps
cops FactionId
side EnumMap FactionId Faction
factionD ItemFull
itemFull
  -- Possibly overwrite earlier, provisional benefits.
  (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 :: DiscoveryBenefit
sdiscoBenefit = ItemId -> Benefit -> DiscoveryBenefit -> DiscoveryBenefit
forall k a. Enum k => k -> a -> EnumMap k a -> EnumMap k a
EM.insert ItemId
iid Benefit
benefit (StateClient -> DiscoveryBenefit
sdiscoBenefit StateClient
cli)}

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

killExit :: MonadClient m => m ()
killExit :: m ()
killExit = do
  FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
  Text -> m ()
forall (m :: * -> *). MonadClient m => Text -> m ()
debugPossiblyPrint (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Client" Text -> Text -> Text
<+> FactionId -> Text
forall a. Show a => a -> Text
tshow FactionId
side Text -> Text -> Text
<+> Text
"quitting."
  (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 {squit :: Bool
squit = Bool
True}
  -- Verify that the not saved caches are equal to future reconstructed.
  -- Otherwise, save/restore would change game state.
  ActorMaxSkills
sactorMaxSkills2 <- (State -> ActorMaxSkills) -> m ActorMaxSkills
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> ActorMaxSkills
sactorMaxSkills
  AlterLid
salter <- (StateClient -> AlterLid) -> m AlterLid
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> AlterLid
salter
  EnumMap ActorId BfsAndPath
sbfsD <- (StateClient -> EnumMap ActorId BfsAndPath)
-> m (EnumMap ActorId BfsAndPath)
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> EnumMap ActorId BfsAndPath
sbfsD
  AlterLid
alter <- (State -> AlterLid) -> m AlterLid
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> AlterLid
createSalter
  ActorMaxSkills
actorMaxSkills <- (State -> ActorMaxSkills) -> m ActorMaxSkills
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> ActorMaxSkills
maxSkillsInDungeon
  let f :: ActorId -> m (ActorId, BfsAndPath)
f ActorId
aid = do
        (Bool
canMove, Word8
alterSkill) <- ActorId -> m (Bool, Word8)
forall (m :: * -> *).
MonadClientRead m =>
ActorId -> m (Bool, Word8)
condBFS ActorId
aid
        Array BfsDistance
bfsArr <- Bool -> Word8 -> ActorId -> m (Array BfsDistance)
forall (m :: * -> *).
MonadClientRead m =>
Bool -> Word8 -> ActorId -> m (Array BfsDistance)
createBfs Bool
canMove Word8
alterSkill ActorId
aid
        let bfsPath :: EnumMap k a
bfsPath = EnumMap k a
forall k a. EnumMap k a
EM.empty
        (ActorId, BfsAndPath) -> m (ActorId, BfsAndPath)
forall (m :: * -> *) a. Monad m => a -> m a
return (ActorId
aid, Array BfsDistance -> EnumMap Point AndPath -> BfsAndPath
BfsAndPath Array BfsDistance
bfsArr EnumMap Point AndPath
forall k a. EnumMap k a
bfsPath)
  ActorDict
actorD <- (State -> ActorDict) -> m ActorDict
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> ActorDict
sactorD
  [(ActorId, BfsAndPath)]
lbfsD <- (ActorId -> m (ActorId, BfsAndPath))
-> [ActorId] -> m [(ActorId, BfsAndPath)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ActorId -> m (ActorId, BfsAndPath)
forall (m :: * -> *).
MonadClientRead m =>
ActorId -> m (ActorId, BfsAndPath)
f ([ActorId] -> m [(ActorId, BfsAndPath)])
-> [ActorId] -> m [(ActorId, BfsAndPath)]
forall a b. (a -> b) -> a -> b
$ ActorDict -> [ActorId]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys ActorDict
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 :: EnumMap ActorId BfsAndPath
bfsD = [(ActorId, BfsAndPath)] -> EnumMap ActorId BfsAndPath
forall k a. Enum k => [(k, a)] -> EnumMap k a
EM.fromDistinctAscList [(ActorId, BfsAndPath)]
lbfsD
      g :: BfsAndPath -> BfsAndPath -> Bool
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 :: EnumMap k BfsAndPath -> EnumMap k BfsAndPath -> Bool
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 :: ()
_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 a. Show a => Bool -> a -> 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 :: ()
_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 a. Show a => Bool -> a -> 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 :: ()
_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 a. Show a => Bool -> a -> 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)) ()
  () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()