{-# LANGUAGE TupleSections #-}
-- | Sending atomic commands to clients and executing them on the server.
--
-- See
-- <https://github.com/LambdaHack/LambdaHack/wiki/Client-server-architecture>.
module Game.LambdaHack.Server.BroadcastAtomic
  ( handleAndBroadcast, sendPer, handleCmdAtomicServer
#ifdef EXPOSE_INTERNAL
    -- * Internal operations
  , cmdItemsFromIids, hearUpdAtomic, hearSfxAtomic, filterHear, atomicForget
  , atomicRemember
#endif
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import qualified Data.EnumMap.Strict as EM
import qualified Data.EnumSet as ES
import qualified NLP.Miniutter.English as MU

import           Game.LambdaHack.Atomic
import           Game.LambdaHack.Common.Actor
import           Game.LambdaHack.Common.ActorState
import           Game.LambdaHack.Common.Faction
import qualified Game.LambdaHack.Common.ItemAspect as IA
import           Game.LambdaHack.Common.Kind
import           Game.LambdaHack.Common.Level
import           Game.LambdaHack.Common.Misc
import           Game.LambdaHack.Common.MonadStateRead
import           Game.LambdaHack.Common.Perception
import           Game.LambdaHack.Common.Point
import           Game.LambdaHack.Common.State
import qualified Game.LambdaHack.Common.Tile as Tile
import           Game.LambdaHack.Common.Types
import qualified Game.LambdaHack.Content.ItemKind as IK
import           Game.LambdaHack.Content.TileKind (isUknownSpace)
import qualified Game.LambdaHack.Core.Dice as Dice
import qualified Game.LambdaHack.Definition.Ability as Ability
import           Game.LambdaHack.Definition.Defs
import           Game.LambdaHack.Server.MonadServer
import           Game.LambdaHack.Server.ProtocolM
import           Game.LambdaHack.Server.ServerOptions
import           Game.LambdaHack.Server.State

--storeUndo :: MonadServer m => CmdAtomic -> m ()
--storeUndo _atomic =
--  maybe skip (\a -> modifyServer $ \ser -> ser {sundo = a : sundo ser})
--    $ Nothing   -- undoCmdAtomic atomic

handleCmdAtomicServer :: MonadServerAtomic m
                      => UpdAtomic -> m (PosAtomic, [UpdAtomic], Bool)
handleCmdAtomicServer :: UpdAtomic -> m (PosAtomic, [UpdAtomic], Bool)
handleCmdAtomicServer UpdAtomic
cmd = do
  PosAtomic
ps <- UpdAtomic -> m PosAtomic
forall (m :: * -> *). MonadStateRead m => UpdAtomic -> m PosAtomic
posUpdAtomic UpdAtomic
cmd
  [UpdAtomic]
atomicBroken <- UpdAtomic -> m [UpdAtomic]
forall (m :: * -> *).
MonadStateRead m =>
UpdAtomic -> m [UpdAtomic]
breakUpdAtomic UpdAtomic
cmd
    -- needs to be done before the states are changed and may make no sense
  Bool
executedOnServer <- if PosAtomic -> Bool
seenAtomicSer PosAtomic
ps
                      then UpdAtomic -> m Bool
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m Bool
execUpdAtomicSer UpdAtomic
cmd
                      else Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
  (PosAtomic, [UpdAtomic], Bool) -> m (PosAtomic, [UpdAtomic], Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (PosAtomic
ps, [UpdAtomic]
atomicBroken, Bool
executedOnServer)

-- | Send an atomic action to all clients that can see it.
handleAndBroadcast :: (MonadServerAtomic m, MonadServerComm m)
                   => PosAtomic -> [UpdAtomic] -> CmdAtomic -> m ()
handleAndBroadcast :: PosAtomic -> [UpdAtomic] -> CmdAtomic -> m ()
handleAndBroadcast PosAtomic
ps [UpdAtomic]
atomicBroken CmdAtomic
atomic = do
  -- This is calculated in the server State before action (simulating
  -- current client State, because action has not been applied
  -- on the client yet).
  -- E.g., actor's position in @breakUpdAtomic@ is assumed to be pre-action.
  -- To get rid of breakUpdAtomic we'd need to send only Spot and Lose
  -- commands instead of Move and Displace (plus Sfx for Displace).
  -- So this only makes sense when we switch to sending state diffs.
  Bool
knowEvents <- (StateServer -> Bool) -> m Bool
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer ((StateServer -> Bool) -> m Bool)
-> (StateServer -> Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ ServerOptions -> Bool
sknowEvents (ServerOptions -> Bool)
-> (StateServer -> ServerOptions) -> StateServer -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateServer -> ServerOptions
soptions
  PerFid
sperFidOld <- (StateServer -> PerFid) -> m PerFid
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> PerFid
sperFid
  -- Send some actions to the clients, one faction at a time.
  let sendAtomic :: FactionId -> CmdAtomic -> m ()
sendAtomic FactionId
fid (UpdAtomic UpdAtomic
cmd) = do
        let iids :: [ItemId]
iids = UpdAtomic -> [ItemId]
iidUpdAtomic UpdAtomic
cmd
        State
s <- m State
forall (m :: * -> *). MonadStateRead m => m State
getState
        State
sClient <- (StateServer -> State) -> m State
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer ((StateServer -> State) -> m State)
-> (StateServer -> State) -> m State
forall a b. (a -> b) -> a -> b
$ (EnumMap FactionId State -> FactionId -> State
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
fid) (EnumMap FactionId State -> State)
-> (StateServer -> EnumMap FactionId State) -> StateServer -> State
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateServer -> EnumMap FactionId State
sclientStates
        (UpdAtomic -> m ()) -> [UpdAtomic] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
mapM_ (FactionId -> UpdAtomic -> m ()
forall (m :: * -> *).
(MonadServerAtomic m, MonadServerComm m) =>
FactionId -> UpdAtomic -> m ()
sendUpdateCheck FactionId
fid) ([UpdAtomic] -> m ()) -> [UpdAtomic] -> m ()
forall a b. (a -> b) -> a -> b
$ [ItemId] -> State -> State -> [UpdAtomic]
cmdItemsFromIids [ItemId]
iids State
sClient State
s
        FactionId -> UpdAtomic -> m ()
forall (m :: * -> *).
(MonadServerAtomic m, MonadServerComm m) =>
FactionId -> UpdAtomic -> m ()
sendUpdate FactionId
fid UpdAtomic
cmd
      sendAtomic FactionId
fid (SfxAtomic SfxAtomic
sfx) = do
        let iids :: [ItemId]
iids = SfxAtomic -> [ItemId]
iidSfxAtomic SfxAtomic
sfx
        State
s <- m State
forall (m :: * -> *). MonadStateRead m => m State
getState
        State
sClient <- (StateServer -> State) -> m State
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer ((StateServer -> State) -> m State)
-> (StateServer -> State) -> m State
forall a b. (a -> b) -> a -> b
$ (EnumMap FactionId State -> FactionId -> State
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
fid) (EnumMap FactionId State -> State)
-> (StateServer -> EnumMap FactionId State) -> StateServer -> State
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateServer -> EnumMap FactionId State
sclientStates
        (UpdAtomic -> m ()) -> [UpdAtomic] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
mapM_ (FactionId -> UpdAtomic -> m ()
forall (m :: * -> *).
(MonadServerAtomic m, MonadServerComm m) =>
FactionId -> UpdAtomic -> m ()
sendUpdateCheck FactionId
fid) ([UpdAtomic] -> m ()) -> [UpdAtomic] -> m ()
forall a b. (a -> b) -> a -> b
$ [ItemId] -> State -> State -> [UpdAtomic]
cmdItemsFromIids [ItemId]
iids State
sClient State
s
        FactionId -> SfxAtomic -> m ()
forall (m :: * -> *).
MonadServerComm m =>
FactionId -> SfxAtomic -> m ()
sendSfx FactionId
fid SfxAtomic
sfx
      breakSend :: FactionId -> PerLid -> m ()
breakSend FactionId
fid PerLid
perFid = case PosAtomic -> Maybe LevelId
lidOfPos PosAtomic
ps of
        Maybe LevelId
Nothing -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just LevelId
lidOriginal -> do
          [PosAtomic]
psBroken <- (UpdAtomic -> m PosAtomic) -> [UpdAtomic] -> m [PosAtomic]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM UpdAtomic -> m PosAtomic
forall (m :: * -> *). MonadStateRead m => UpdAtomic -> m PosAtomic
posUpdAtomic [UpdAtomic]
atomicBroken
          case [PosAtomic]
psBroken of
            PosAtomic
_ : [PosAtomic]
_ -> do
              let send2 :: (UpdAtomic, PosAtomic) -> m ()
send2 (UpdAtomic
cmd2, PosAtomic
ps2) =
                    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> FactionId -> PerLid -> PosAtomic -> Bool
seenAtomicCli Bool
knowEvents FactionId
fid PerLid
perFid PosAtomic
ps2) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
                      FactionId -> CmdAtomic -> m ()
forall (m :: * -> *).
(MonadServerAtomic m, MonadServerComm m) =>
FactionId -> CmdAtomic -> m ()
sendAtomic FactionId
fid (UpdAtomic -> CmdAtomic
UpdAtomic UpdAtomic
cmd2)
              ((UpdAtomic, PosAtomic) -> m ())
-> [(UpdAtomic, PosAtomic)] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
mapM_ (UpdAtomic, PosAtomic) -> m ()
send2 ([(UpdAtomic, PosAtomic)] -> m ())
-> [(UpdAtomic, PosAtomic)] -> m ()
forall a b. (a -> b) -> a -> b
$ [UpdAtomic] -> [PosAtomic] -> [(UpdAtomic, PosAtomic)]
forall a b. [a] -> [b] -> [(a, b)]
zip [UpdAtomic]
atomicBroken [PosAtomic]
psBroken
            [] -> do  -- hear only here; broken commands are never loud
              -- At most @minusM@ applied total over a single actor move,
              -- to avoid distress as if wounded (which is measured via deltas).
              -- So, if faction hits an enemy and it yells, hearnig yell will
              -- not decrease calm over the decrease from hearing strike.
              -- This may accumulate over time, though, to eventually wake up
              -- sleeping actors.
              let drainCalmOnce :: ActorId -> m ()
drainCalmOnce ActorId
aid = do
                    Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
                    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ResDelta -> Bool
deltaBenign (ResDelta -> Bool) -> ResDelta -> Bool
forall a b. (a -> b) -> a -> b
$ Actor -> ResDelta
bcalmDelta Actor
b) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
                      UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ ActorId -> Int64 -> UpdAtomic
UpdRefillCalm ActorId
aid Int64
minusM
                  leaderDistance :: Point -> m (Maybe Int)
leaderDistance Point
pos = do
                    Maybe ActorId
mleader <- (State -> Maybe ActorId) -> m (Maybe ActorId)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Maybe ActorId) -> m (Maybe ActorId))
-> (State -> Maybe ActorId) -> m (Maybe ActorId)
forall a b. (a -> b) -> a -> b
$ Faction -> Maybe ActorId
gleader (Faction -> Maybe ActorId)
-> (State -> Faction) -> State -> Maybe ActorId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
fid) (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
                    case Maybe ActorId
mleader of
                      Maybe ActorId
Nothing -> Maybe Int -> m (Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Int
forall a. Maybe a
Nothing
                      Just ActorId
leader -> 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
leader
                        -- Leader's hearing as relevant as of any other actor,
                        -- which prevents changing leader just to get hearing
                        -- intel. However, leader's position affects accuracy
                        -- of the distance to noise hints.
                        Maybe Int -> m (Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Int -> m (Maybe Int)) -> Maybe Int -> m (Maybe Int)
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
5 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Point -> Point -> Int
chessDist Point
pos (Actor -> Point
bpos Actor
b) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
10
              -- Projectiles never hear, for speed and simplicity,
              -- even though they sometimes see. There are flying cameras,
              -- but no microphones --- drones make too much noise themselves.
              [(ActorId, Actor)]
as <- (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)])
-> (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
forall a b. (a -> b) -> a -> b
$ FactionId -> LevelId -> State -> [(ActorId, Actor)]
fidActorRegularAssocs FactionId
fid LevelId
lidOriginal
              case CmdAtomic
atomic of
                UpdAtomic UpdAtomic
cmd -> do
                  (Bool
profound, Maybe Point
mpos) <- UpdAtomic -> m (Bool, Maybe Point)
forall (m :: * -> *).
MonadStateRead m =>
UpdAtomic -> m (Bool, Maybe Point)
hearUpdAtomic UpdAtomic
cmd
                  case Maybe Point
mpos of
                    Maybe Point
Nothing | Bool
profound ->
                      FactionId -> UpdAtomic -> m ()
forall (m :: * -> *).
(MonadServerAtomic m, MonadServerComm m) =>
FactionId -> UpdAtomic -> m ()
sendUpdate FactionId
fid (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ FactionId -> Maybe Int -> HearMsg -> UpdAtomic
UpdHearFid FactionId
fid Maybe Int
forall a. Maybe a
Nothing
                                     (HearMsg -> UpdAtomic) -> HearMsg -> UpdAtomic
forall a b. (a -> b) -> a -> b
$ UpdAtomic -> HearMsg
HearUpd UpdAtomic
cmd
                    Maybe Point
Nothing -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                    Just Point
pos -> do
                      [ActorId]
aids <- Point -> [(ActorId, Actor)] -> m [ActorId]
forall (m :: * -> *).
MonadStateRead m =>
Point -> [(ActorId, Actor)] -> m [ActorId]
filterHear Point
pos [(ActorId, Actor)]
as
                      if [ActorId] -> Bool
forall a. [a] -> Bool
null [ActorId]
aids Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
profound
                      then () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                      else do
                        Maybe Int
distance <- if [ActorId] -> Bool
forall a. [a] -> Bool
null [ActorId]
aids
                                    then Maybe Int -> m (Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Int
forall a. Maybe a
Nothing
                                    else Point -> m (Maybe Int)
leaderDistance Point
pos
                        FactionId -> UpdAtomic -> m ()
forall (m :: * -> *).
(MonadServerAtomic m, MonadServerComm m) =>
FactionId -> UpdAtomic -> m ()
sendUpdate FactionId
fid (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ FactionId -> Maybe Int -> HearMsg -> UpdAtomic
UpdHearFid FactionId
fid Maybe Int
distance (HearMsg -> UpdAtomic) -> HearMsg -> UpdAtomic
forall a b. (a -> b) -> a -> b
$ UpdAtomic -> HearMsg
HearUpd UpdAtomic
cmd
                        (ActorId -> m ()) -> [ActorId] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
mapM_ ActorId -> m ()
forall (m :: * -> *). MonadServerAtomic m => ActorId -> m ()
drainCalmOnce [ActorId]
aids
                SfxAtomic SfxAtomic
cmd -> do
                  Maybe (HearMsg, Bool, Point)
mhear <- SfxAtomic -> m (Maybe (HearMsg, Bool, Point))
forall (m :: * -> *).
MonadServer m =>
SfxAtomic -> m (Maybe (HearMsg, Bool, Point))
hearSfxAtomic SfxAtomic
cmd
                  case Maybe (HearMsg, Bool, Point)
mhear of
                    Maybe (HearMsg, Bool, Point)
Nothing -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                    Just (HearMsg
hearMsg, Bool
profound, Point
pos) -> do
                      [ActorId]
aids <- Point -> [(ActorId, Actor)] -> m [ActorId]
forall (m :: * -> *).
MonadStateRead m =>
Point -> [(ActorId, Actor)] -> m [ActorId]
filterHear Point
pos [(ActorId, Actor)]
as
                      if [ActorId] -> Bool
forall a. [a] -> Bool
null [ActorId]
aids Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
profound
                      then () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                      else do
                        Maybe Int
distance <- if [ActorId] -> Bool
forall a. [a] -> Bool
null [ActorId]
aids
                                    then Maybe Int -> m (Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Int
forall a. Maybe a
Nothing
                                    else Point -> m (Maybe Int)
leaderDistance Point
pos
                        FactionId -> UpdAtomic -> m ()
forall (m :: * -> *).
(MonadServerAtomic m, MonadServerComm m) =>
FactionId -> UpdAtomic -> m ()
sendUpdate FactionId
fid (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ FactionId -> Maybe Int -> HearMsg -> UpdAtomic
UpdHearFid FactionId
fid Maybe Int
distance HearMsg
hearMsg
                        (ActorId -> m ()) -> [ActorId] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
mapM_ ActorId -> m ()
forall (m :: * -> *). MonadServerAtomic m => ActorId -> m ()
drainCalmOnce [ActorId]
aids
      -- We assume players perceive perception change before the action,
      -- so the action is perceived in the new perception,
      -- even though the new perception depends on the action's outcome
      -- (e.g., new actor created).
      send :: FactionId -> m ()
send FactionId
fid = do
        let perFid :: PerLid
perFid = PerFid
sperFidOld PerFid -> FactionId -> PerLid
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
fid
        if Bool -> FactionId -> PerLid -> PosAtomic -> Bool
seenAtomicCli Bool
knowEvents FactionId
fid PerLid
perFid PosAtomic
ps
        then FactionId -> CmdAtomic -> m ()
forall (m :: * -> *).
(MonadServerAtomic m, MonadServerComm m) =>
FactionId -> CmdAtomic -> m ()
sendAtomic FactionId
fid CmdAtomic
atomic
        else FactionId -> PerLid -> m ()
breakSend FactionId
fid PerLid
perFid
  -- Factions that are eliminated by the command are processed as well,
  -- because they are not deleted from @sfactionD@.
  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
  (FactionId -> m ()) -> [FactionId] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
mapM_ FactionId -> m ()
send ([FactionId] -> m ()) -> [FactionId] -> m ()
forall a b. (a -> b) -> a -> b
$ EnumMap FactionId Faction -> [FactionId]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys EnumMap FactionId Faction
factionD

cmdItemsFromIids :: [ItemId] -> State -> State -> [UpdAtomic]
cmdItemsFromIids :: [ItemId] -> State -> State -> [UpdAtomic]
cmdItemsFromIids [ItemId]
iids State
sClient State
s =
  let iidsUnknown :: [ItemId]
iidsUnknown = (ItemId -> Bool) -> [ItemId] -> [ItemId]
forall a. (a -> Bool) -> [a] -> [a]
filter (\ItemId
iid -> ItemId -> EnumMap ItemId Item -> Bool
forall k a. Enum k => k -> EnumMap k a -> Bool
EM.notMember ItemId
iid (EnumMap ItemId Item -> Bool) -> EnumMap ItemId Item -> Bool
forall a b. (a -> b) -> a -> b
$ State -> EnumMap ItemId Item
sitemD State
sClient) [ItemId]
iids
      items :: [(ItemId, Item)]
items = (ItemId -> (ItemId, Item)) -> [ItemId] -> [(ItemId, Item)]
forall a b. (a -> b) -> [a] -> [b]
map (\ItemId
iid -> (ItemId
iid, State -> EnumMap ItemId Item
sitemD State
s EnumMap ItemId Item -> ItemId -> Item
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ItemId
iid)) [ItemId]
iidsUnknown
  in [[(ItemId, Item)] -> UpdAtomic
UpdRegisterItems [(ItemId, Item)]
items | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [(ItemId, Item)] -> Bool
forall a. [a] -> Bool
null [(ItemId, Item)]
items]

-- | Messages for some unseen atomic commands.
hearUpdAtomic :: MonadStateRead m
              => UpdAtomic -> m (Bool, Maybe Point)
hearUpdAtomic :: UpdAtomic -> m (Bool, Maybe Point)
hearUpdAtomic UpdAtomic
cmd = do
  COps{TileSpeedup
coTileSpeedup :: COps -> TileSpeedup
coTileSpeedup :: TileSpeedup
coTileSpeedup} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  case UpdAtomic
cmd of
    UpdDestroyActor ActorId
_ Actor
body [(ItemId, Item)]
_ | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Actor -> Bool
bproj Actor
body ->
      (Bool, Maybe Point) -> m (Bool, Maybe Point)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
True, Point -> Maybe Point
forall a. a -> Maybe a
Just (Point -> Maybe Point) -> Point -> Maybe Point
forall a b. (a -> b) -> a -> b
$ Actor -> Point
bpos Actor
body)
    UpdCreateItem Bool
True ItemId
iid Item
item ItemQuant
_ (CActor ActorId
aid CStore
cstore) -> do
      -- Kinetic damage implies the explosion is loud enough to cause noise.
      ItemKind
itemKind <- (State -> ItemKind) -> m ItemKind
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemKind) -> m ItemKind)
-> (State -> ItemKind) -> m ItemKind
forall a b. (a -> b) -> a -> b
$ Item -> State -> ItemKind
getItemKindServer Item
item
      DiscoveryAspect
discoAspect <- (State -> DiscoveryAspect) -> m DiscoveryAspect
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> DiscoveryAspect
sdiscoAspect
      let arItem :: AspectRecord
arItem = DiscoveryAspect
discoAspect DiscoveryAspect -> ItemId -> AspectRecord
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ItemId
iid
      if CStore
cstore CStore -> CStore -> Bool
forall a. Eq a => a -> a -> Bool
/= CStore
COrgan
         Bool -> Bool -> Bool
|| Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Blast AspectRecord
arItem
            Bool -> Bool -> Bool
&& Dice -> Int
Dice.supDice (ItemKind -> Dice
IK.idamage ItemKind
itemKind) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then do
        Actor
body <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
        (Bool, Maybe Point) -> m (Bool, Maybe Point)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
True, Point -> Maybe Point
forall a. a -> Maybe a
Just (Point -> Maybe Point) -> Point -> Maybe Point
forall a b. (a -> b) -> a -> b
$ Actor -> Point
bpos Actor
body)
      else (Bool, Maybe Point) -> m (Bool, Maybe Point)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
False, Maybe Point
forall a. Maybe a
Nothing)
    UpdTrajectory ActorId
aid (Just ([Vector]
l, Speed
_)) Maybe ([Vector], Speed)
Nothing | Bool -> Bool
not ([Vector] -> Bool
forall a. [a] -> Bool
null [Vector]
l) -> do
      -- Non-blast projectile hits a non-walkable tile.
      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
      DiscoveryAspect
discoAspect <- (State -> DiscoveryAspect) -> m DiscoveryAspect
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> DiscoveryAspect
sdiscoAspect
      let arTrunk :: AspectRecord
arTrunk = DiscoveryAspect
discoAspect DiscoveryAspect -> ItemId -> AspectRecord
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> ItemId
btrunk Actor
b
      (Bool, Maybe Point) -> m (Bool, Maybe Point)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Bool, Maybe Point) -> m (Bool, Maybe Point))
-> (Bool, Maybe Point) -> m (Bool, Maybe Point)
forall a b. (a -> b) -> a -> b
$! ( Bool
False, if Bool -> Bool
not (Actor -> Bool
bproj Actor
b) Bool -> Bool -> Bool
|| Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Blast AspectRecord
arTrunk
                         then Maybe Point
forall a. Maybe a
Nothing
                         else Point -> Maybe Point
forall a. a -> Maybe a
Just (Point -> Maybe Point) -> Point -> Maybe Point
forall a b. (a -> b) -> a -> b
$ Actor -> Point
bpos Actor
b )
    UpdAlterTile LevelId
_ Point
p ContentId TileKind
_ ContentId TileKind
toTile ->
      (Bool, Maybe Point) -> m (Bool, Maybe Point)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ TileSpeedup -> ContentId TileKind -> Bool
Tile.isDoor TileSpeedup
coTileSpeedup ContentId TileKind
toTile, Point -> Maybe Point
forall a. a -> Maybe a
Just Point
p)
    UpdAlterExplorable{} -> (Bool, Maybe Point) -> m (Bool, Maybe Point)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
True, Maybe Point
forall a. Maybe a
Nothing)
    UpdAtomic
_ -> (Bool, Maybe Point) -> m (Bool, Maybe Point)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
False, Maybe Point
forall a. Maybe a
Nothing)

-- | Messages for some unseen sfx.
hearSfxAtomic :: MonadServer m
              => SfxAtomic -> m (Maybe (HearMsg, Bool, Point))
hearSfxAtomic :: SfxAtomic -> m (Maybe (HearMsg, Bool, Point))
hearSfxAtomic SfxAtomic
cmd =
  case SfxAtomic
cmd of
    SfxStrike ActorId
aid ActorId
_ ItemId
iid -> do
      -- Only the attacker position considered, for simplicity.
      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
      DiscoveryAspect
discoAspect <- (State -> DiscoveryAspect) -> m DiscoveryAspect
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> DiscoveryAspect
sdiscoAspect
      let arItem :: AspectRecord
arItem = DiscoveryAspect
discoAspect DiscoveryAspect -> ItemId -> AspectRecord
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ItemId
iid
      ContentId ItemKind
itemKindId <- (State -> ContentId ItemKind) -> m (ContentId ItemKind)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ContentId ItemKind) -> m (ContentId ItemKind))
-> (State -> ContentId ItemKind) -> m (ContentId ItemKind)
forall a b. (a -> b) -> a -> b
$ ItemId -> State -> ContentId ItemKind
getIidKindIdServer ItemId
iid
      -- Loud explosions cause enough noise, so ignoring particle hit spam.
      Maybe (HearMsg, Bool, Point) -> m (Maybe (HearMsg, Bool, Point))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (HearMsg, Bool, Point) -> m (Maybe (HearMsg, Bool, Point)))
-> Maybe (HearMsg, Bool, Point) -> m (Maybe (HearMsg, Bool, Point))
forall a b. (a -> b) -> a -> b
$! if Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Blast AspectRecord
arItem
                then Maybe (HearMsg, Bool, Point)
forall a. Maybe a
Nothing
                else (HearMsg, Bool, Point) -> Maybe (HearMsg, Bool, Point)
forall a. a -> Maybe a
Just (ContentId ItemKind -> HearMsg
HearStrike ContentId ItemKind
itemKindId, Bool
False, Actor -> Point
bpos Actor
b)
    SfxEffect FactionId
_ ActorId
aid ItemId
_ (IK.Summon GroupName ItemKind
grp Dice
p) Int64
_ -> do
      Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
      Maybe (HearMsg, Bool, Point) -> m (Maybe (HearMsg, Bool, Point))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (HearMsg, Bool, Point) -> m (Maybe (HearMsg, Bool, Point)))
-> Maybe (HearMsg, Bool, Point) -> m (Maybe (HearMsg, Bool, Point))
forall a b. (a -> b) -> a -> b
$ (HearMsg, Bool, Point) -> Maybe (HearMsg, Bool, Point)
forall a. a -> Maybe a
Just (Bool -> GroupName ItemKind -> Dice -> HearMsg
HearSummon (Actor -> Bool
bproj Actor
b) GroupName ItemKind
grp Dice
p, Bool
False, Actor -> Point
bpos Actor
b)
    SfxEffect FactionId
_ ActorId
aid ItemId
_ (IK.VerbMsg Text
verb Text
ending) Int64
_ -> 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
      DiscoveryAspect
discoAspect <- (State -> DiscoveryAspect) -> m DiscoveryAspect
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> DiscoveryAspect
sdiscoAspect
      let arTrunk :: AspectRecord
arTrunk = DiscoveryAspect
discoAspect DiscoveryAspect -> ItemId -> AspectRecord
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> ItemId
btrunk Actor
b
          subject :: Part
subject = Part
"noises of someone that"
          phrase :: Text
phrase = [Part] -> Text
makePhrase [Part -> Part -> Part
MU.SubjectVerbSg Part
subject (Text -> Part
MU.Text Text
verb)]
                   Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ending
      Maybe (HearMsg, Bool, Point) -> m (Maybe (HearMsg, Bool, Point))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (HearMsg, Bool, Point) -> m (Maybe (HearMsg, Bool, Point)))
-> Maybe (HearMsg, Bool, Point) -> m (Maybe (HearMsg, Bool, Point))
forall a b. (a -> b) -> a -> b
$! if Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Unique AspectRecord
arTrunk
                then (HearMsg, Bool, Point) -> Maybe (HearMsg, Bool, Point)
forall a. a -> Maybe a
Just (Text -> HearMsg
HearTaunt Text
phrase, Bool
True, Actor -> Point
bpos Actor
b)
                else Maybe (HearMsg, Bool, Point)
forall a. Maybe a
Nothing
    SfxCollideTile ActorId
_ Point
p ->
      Maybe (HearMsg, Bool, Point) -> m (Maybe (HearMsg, Bool, Point))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (HearMsg, Bool, Point) -> m (Maybe (HearMsg, Bool, Point)))
-> Maybe (HearMsg, Bool, Point) -> m (Maybe (HearMsg, Bool, Point))
forall a b. (a -> b) -> a -> b
$ (HearMsg, Bool, Point) -> Maybe (HearMsg, Bool, Point)
forall a. a -> Maybe a
Just (HearMsg
HearCollideTile, Bool
False, Point
p)
    SfxTaunt Bool
voluntary ActorId
aid -> do
      Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
      (Text
subject, Text
verb) <- Bool
-> (Rnd (Text, Text) -> m (Text, Text))
-> ActorId
-> m (Text, Text)
forall (m :: * -> *).
MonadStateRead m =>
Bool
-> (Rnd (Text, Text) -> m (Text, Text))
-> ActorId
-> m (Text, Text)
displayTaunt Bool
voluntary Rnd (Text, Text) -> m (Text, Text)
forall (m :: * -> *) a. MonadServer m => Rnd a -> m a
rndToAction ActorId
aid
      DiscoveryAspect
discoAspect <- (State -> DiscoveryAspect) -> m DiscoveryAspect
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> DiscoveryAspect
sdiscoAspect
      let arTrunk :: AspectRecord
arTrunk = DiscoveryAspect
discoAspect DiscoveryAspect -> ItemId -> AspectRecord
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> ItemId
btrunk Actor
b
          unique :: Text
unique = if Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Unique AspectRecord
arTrunk then Text
"big" else Text
""
          phrase :: Text
phrase = Text
subject Text -> Text -> Text
<+> Text
unique Text -> Text -> Text
<+> Text
verb Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
      Maybe (HearMsg, Bool, Point) -> m (Maybe (HearMsg, Bool, Point))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (HearMsg, Bool, Point) -> m (Maybe (HearMsg, Bool, Point)))
-> Maybe (HearMsg, Bool, Point) -> m (Maybe (HearMsg, Bool, Point))
forall a b. (a -> b) -> a -> b
$ (HearMsg, Bool, Point) -> Maybe (HearMsg, Bool, Point)
forall a. a -> Maybe a
Just (Text -> HearMsg
HearTaunt Text
phrase, Bool
True, Actor -> Point
bpos Actor
b)  -- intentional
    SfxAtomic
_ -> Maybe (HearMsg, Bool, Point) -> m (Maybe (HearMsg, Bool, Point))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (HearMsg, Bool, Point)
forall a. Maybe a
Nothing

filterHear :: MonadStateRead m => Point -> [(ActorId, Actor)] -> m [ActorId]
filterHear :: Point -> [(ActorId, Actor)] -> m [ActorId]
filterHear Point
pos [(ActorId, Actor)]
as = do
  let actorHear :: (ActorId, Actor) -> m Bool
actorHear (ActorId
aid, Actor
body) = do
        -- Actors hear as if they were leaders, for speed and to prevent
        -- micromanagement by switching leader to hear more.
        -- This is analogous to actors seeing as if they were leaders.
        Skills
actorMaxSk <- (State -> Skills) -> m Skills
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Skills) -> m Skills) -> (State -> Skills) -> m Skills
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Skills
getActorMaxSkills ActorId
aid
        Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$! Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkHearing Skills
actorMaxSk
                  Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Point -> Point -> Int
chessDist Point
pos (Actor -> Point
bpos Actor
body)
  ((ActorId, Actor) -> ActorId) -> [(ActorId, Actor)] -> [ActorId]
forall a b. (a -> b) -> [a] -> [b]
map (ActorId, Actor) -> ActorId
forall a b. (a, b) -> a
fst ([(ActorId, Actor)] -> [ActorId])
-> m [(ActorId, Actor)] -> m [ActorId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((ActorId, Actor) -> m Bool)
-> [(ActorId, Actor)] -> m [(ActorId, Actor)]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (ActorId, Actor) -> m Bool
actorHear [(ActorId, Actor)]
as

sendPer :: (MonadServerAtomic m, MonadServerComm m)
        => FactionId -> LevelId -> Perception -> Perception -> Perception
        -> m ()
sendPer :: FactionId
-> LevelId -> Perception -> Perception -> Perception -> m ()
sendPer FactionId
fid LevelId
lid Perception
outPer Perception
inPer Perception
perNew = do
  Bool
knowEvents <- (StateServer -> Bool) -> m Bool
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer ((StateServer -> Bool) -> m Bool)
-> (StateServer -> Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ ServerOptions -> Bool
sknowEvents (ServerOptions -> Bool)
-> (StateServer -> ServerOptions) -> StateServer -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateServer -> ServerOptions
soptions
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
knowEvents (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do  -- inconsistencies would quickly manifest
    FactionId -> UpdAtomic -> m ()
forall (m :: * -> *).
MonadServerComm m =>
FactionId -> UpdAtomic -> m ()
sendUpdNoState FactionId
fid (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ LevelId -> Perception -> Perception -> UpdAtomic
UpdPerception LevelId
lid Perception
outPer Perception
inPer
    State
sClient <- (StateServer -> State) -> m State
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer ((StateServer -> State) -> m State)
-> (StateServer -> State) -> m State
forall a b. (a -> b) -> a -> b
$ (EnumMap FactionId State -> FactionId -> State
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
fid) (EnumMap FactionId State -> State)
-> (StateServer -> EnumMap FactionId State) -> StateServer -> State
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateServer -> EnumMap FactionId State
sclientStates
    let forget :: [UpdAtomic]
forget = FactionId -> LevelId -> Perception -> State -> [UpdAtomic]
atomicForget FactionId
fid LevelId
lid Perception
outPer State
sClient
    [UpdAtomic]
remember <- (State -> [UpdAtomic]) -> m [UpdAtomic]
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [UpdAtomic]) -> m [UpdAtomic])
-> (State -> [UpdAtomic]) -> m [UpdAtomic]
forall a b. (a -> b) -> a -> b
$ LevelId -> Perception -> State -> State -> [UpdAtomic]
atomicRemember LevelId
lid Perception
inPer State
sClient
    let seenNew :: PosAtomic -> Bool
seenNew = Bool -> FactionId -> PerLid -> PosAtomic -> Bool
seenAtomicCli Bool
False FactionId
fid (LevelId -> Perception -> PerLid
forall k a. Enum k => k -> a -> EnumMap k a
EM.singleton LevelId
lid Perception
perNew)
        onLevel :: UpdAtomic -> Bool
onLevel UpdRegisterItems{} = Bool
True
        onLevel UpdLoseStashFaction{} = Bool
True
        onLevel UpdAtomic
_ = Bool
False
    [PosAtomic]
psRem <- (UpdAtomic -> m PosAtomic) -> [UpdAtomic] -> m [PosAtomic]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM UpdAtomic -> m PosAtomic
forall (m :: * -> *). MonadStateRead m => UpdAtomic -> m PosAtomic
posUpdAtomic ([UpdAtomic] -> m [PosAtomic]) -> [UpdAtomic] -> m [PosAtomic]
forall a b. (a -> b) -> a -> b
$ (UpdAtomic -> Bool) -> [UpdAtomic] -> [UpdAtomic]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (UpdAtomic -> Bool) -> UpdAtomic -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UpdAtomic -> Bool
onLevel) [UpdAtomic]
remember
    -- Verify that we remember the currently seen things.
    let !_A :: ()
_A = Bool -> () -> ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert ((PosAtomic -> Bool) -> [PosAtomic] -> Bool
forall a. Show a => (a -> Bool) -> [a] -> Bool
allB PosAtomic -> Bool
seenNew [PosAtomic]
psRem) ()
    (UpdAtomic -> m ()) -> [UpdAtomic] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
mapM_ (FactionId -> UpdAtomic -> m ()
forall (m :: * -> *).
(MonadServerAtomic m, MonadServerComm m) =>
FactionId -> UpdAtomic -> m ()
sendUpdateCheck FactionId
fid) [UpdAtomic]
forget
    (UpdAtomic -> m ()) -> [UpdAtomic] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
mapM_ (FactionId -> UpdAtomic -> m ()
forall (m :: * -> *).
(MonadServerAtomic m, MonadServerComm m) =>
FactionId -> UpdAtomic -> m ()
sendUpdate FactionId
fid) [UpdAtomic]
remember

-- Remembered items, map tiles, smells and stashes are not wiped out
-- when they get out of FOV. Clients remember them. Only actors are forgotten.
atomicForget :: FactionId -> LevelId -> Perception -> State
             -> [UpdAtomic]
atomicForget :: FactionId -> LevelId -> Perception -> State -> [UpdAtomic]
atomicForget FactionId
side LevelId
lid Perception
outPer State
sClient =
  -- Wipe out actors that just became invisible due to changed FOV.
  let outFov :: EnumSet Point
outFov = Perception -> EnumSet Point
totalVisible Perception
outPer
      fActor :: (ActorId, Actor) -> UpdAtomic
fActor (ActorId
aid, Actor
b) =
        -- We forget only currently invisible actors. Actors can be outside
        -- perception, but still visible, if they belong to our faction,
        -- e.g., if they teleport to outside of current perception
        -- or if they have disabled senses.
        ActorId -> Actor -> UpdAtomic
UpdLoseActor ActorId
aid Actor
b
          -- this command always succeeds, the actor can be always removed,
          -- because the actor is taken from the state
      outPrioBig :: [(ActorId, Actor)]
outPrioBig = (Point -> Maybe (ActorId, Actor)) -> [Point] -> [(ActorId, Actor)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\Point
p -> Point -> LevelId -> State -> Maybe (ActorId, Actor)
posToBigAssoc Point
p LevelId
lid State
sClient)
                   ([Point] -> [(ActorId, Actor)]) -> [Point] -> [(ActorId, Actor)]
forall a b. (a -> b) -> a -> b
$ EnumSet Point -> [Point]
forall k. Enum k => EnumSet k -> [k]
ES.elems EnumSet Point
outFov
      outPrioProj :: [(ActorId, Actor)]
outPrioProj = (Point -> [(ActorId, Actor)]) -> [Point] -> [(ActorId, Actor)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Point
p -> Point -> LevelId -> State -> [(ActorId, Actor)]
posToProjAssocs Point
p LevelId
lid State
sClient)
                    ([Point] -> [(ActorId, Actor)]) -> [Point] -> [(ActorId, Actor)]
forall a b. (a -> b) -> a -> b
$ EnumSet Point -> [Point]
forall k. Enum k => EnumSet k -> [k]
ES.elems EnumSet Point
outFov
  in ((ActorId, Actor) -> UpdAtomic)
-> [(ActorId, Actor)] -> [UpdAtomic]
forall a b. (a -> b) -> [a] -> [b]
map (ActorId, Actor) -> UpdAtomic
fActor ([(ActorId, Actor)] -> [UpdAtomic])
-> [(ActorId, Actor)] -> [UpdAtomic]
forall a b. (a -> b) -> a -> b
$ ((ActorId, Actor) -> Bool)
-> [(ActorId, Actor)] -> [(ActorId, Actor)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
/= FactionId
side) (FactionId -> Bool)
-> ((ActorId, Actor) -> FactionId) -> (ActorId, Actor) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Actor -> FactionId
bfid (Actor -> FactionId)
-> ((ActorId, Actor) -> Actor) -> (ActorId, Actor) -> FactionId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ActorId, Actor) -> Actor
forall a b. (a, b) -> b
snd) [(ActorId, Actor)]
outPrioBig [(ActorId, Actor)] -> [(ActorId, Actor)] -> [(ActorId, Actor)]
forall a. [a] -> [a] -> [a]
++ [(ActorId, Actor)]
outPrioProj

-- The second argument are the points newly in FOV.
atomicRemember :: LevelId -> Perception -> State -> State -> [UpdAtomic]
{-# INLINE atomicRemember #-}
atomicRemember :: LevelId -> Perception -> State -> State -> [UpdAtomic]
atomicRemember LevelId
lid Perception
inPer State
sClient State
s =
  let COps{ContentData TileKind
cotile :: COps -> ContentData TileKind
cotile :: ContentData TileKind
cotile, TileSpeedup
coTileSpeedup :: TileSpeedup
coTileSpeedup :: COps -> TileSpeedup
coTileSpeedup} = State -> COps
scops State
s
      locateStash :: ((FactionId, Faction), (FactionId, Faction)) -> [UpdAtomic]
locateStash ((FactionId
fidClient, Faction
factClient), (FactionId
fid, Faction
fact)) =
        Bool -> [UpdAtomic] -> [UpdAtomic]
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (FactionId
fidClient FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
fid)
        ([UpdAtomic] -> [UpdAtomic]) -> [UpdAtomic] -> [UpdAtomic]
forall a b. (a -> b) -> a -> b
$ case (Faction -> Maybe (LevelId, Point)
gstash Faction
factClient, Faction -> Maybe (LevelId, Point)
gstash Faction
fact) of
            (Just (LevelId
lidStash, Point
pos), Maybe (LevelId, Point)
Nothing)
              | LevelId
lidStash LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== LevelId
lid Bool -> Bool -> Bool
&& Point
pos Point -> EnumSet Point -> Bool
forall k. Enum k => k -> EnumSet k -> Bool
`ES.member` Perception -> EnumSet Point
totalVisible Perception
inPer ->
                [Bool -> FactionId -> LevelId -> Point -> UpdAtomic
UpdLoseStashFaction Bool
False FactionId
fid LevelId
lid Point
pos]
            (Maybe (LevelId, Point)
Nothing, Just (LevelId
lidStash, Point
pos))
              | LevelId
lidStash LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== LevelId
lid Bool -> Bool -> Bool
&& Point
pos Point -> EnumSet Point -> Bool
forall k. Enum k => k -> EnumSet k -> Bool
`ES.member` Perception -> EnumSet Point
totalVisible Perception
inPer ->
                [Bool -> FactionId -> LevelId -> Point -> UpdAtomic
UpdSpotStashFaction Bool
True FactionId
fid LevelId
lid Point
pos]
            (Just (LevelId
lidStash1, Point
pos1), Just (LevelId
lidStash2, Point
pos2))
              | Faction -> Maybe (LevelId, Point)
gstash Faction
factClient Maybe (LevelId, Point) -> Maybe (LevelId, Point) -> Bool
forall a. Eq a => a -> a -> Bool
/= Faction -> Maybe (LevelId, Point)
gstash Faction
fact ->
                if | LevelId
lidStash2 LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== LevelId
lid Bool -> Bool -> Bool
&& Point
pos2 Point -> EnumSet Point -> Bool
forall k. Enum k => k -> EnumSet k -> Bool
`ES.member` Perception -> EnumSet Point
totalVisible Perception
inPer ->
                     [ Bool -> FactionId -> LevelId -> Point -> UpdAtomic
UpdLoseStashFaction Bool
False FactionId
fid LevelId
lidStash1 Point
pos1
                     , Bool -> FactionId -> LevelId -> Point -> UpdAtomic
UpdSpotStashFaction Bool
True FactionId
fid LevelId
lid Point
pos2 ]
                   | LevelId
lidStash1 LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== LevelId
lid Bool -> Bool -> Bool
&& Point
pos1 Point -> EnumSet Point -> Bool
forall k. Enum k => k -> EnumSet k -> Bool
`ES.member` Perception -> EnumSet Point
totalVisible Perception
inPer ->
                     [Bool -> FactionId -> LevelId -> Point -> UpdAtomic
UpdLoseStashFaction Bool
False FactionId
fid LevelId
lid Point
pos1]
                   | Bool
otherwise -> []
            (Maybe (LevelId, Point), Maybe (LevelId, Point))
_ -> []
      atomicStash :: [UpdAtomic]
atomicStash = (((FactionId, Faction), (FactionId, Faction)) -> [UpdAtomic])
-> [((FactionId, Faction), (FactionId, Faction))] -> [UpdAtomic]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((FactionId, Faction), (FactionId, Faction)) -> [UpdAtomic]
locateStash ([((FactionId, Faction), (FactionId, Faction))] -> [UpdAtomic])
-> [((FactionId, Faction), (FactionId, Faction))] -> [UpdAtomic]
forall a b. (a -> b) -> a -> b
$ [(FactionId, Faction)]
-> [(FactionId, Faction)]
-> [((FactionId, Faction), (FactionId, Faction))]
forall a b. [a] -> [b] -> [(a, b)]
zip (EnumMap FactionId Faction -> [(FactionId, Faction)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs (EnumMap FactionId Faction -> [(FactionId, Faction)])
-> EnumMap FactionId Faction -> [(FactionId, Faction)]
forall a b. (a -> b) -> a -> b
$ State -> EnumMap FactionId Faction
sfactionD State
sClient)
                                                (EnumMap FactionId Faction -> [(FactionId, Faction)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs (EnumMap FactionId Faction -> [(FactionId, Faction)])
-> EnumMap FactionId Faction -> [(FactionId, Faction)]
forall a b. (a -> b) -> a -> b
$ State -> EnumMap FactionId Faction
sfactionD State
s)
      inFov :: [Point]
inFov = EnumSet Point -> [Point]
forall k. Enum k => EnumSet k -> [k]
ES.elems (EnumSet Point -> [Point]) -> EnumSet Point -> [Point]
forall a b. (a -> b) -> a -> b
$ Perception -> EnumSet Point
totalVisible Perception
inPer
      lvl :: Level
lvl = State -> Dungeon
sdungeon State
s Dungeon -> LevelId -> Level
forall k a. Enum k => EnumMap k a -> k -> a
EM.! LevelId
lid
      -- Wipe out remembered items on tiles that now came into view
      -- and spot items on these tiles. Optimized away, when items match.
      lvlClient :: Level
lvlClient = State -> Dungeon
sdungeon State
sClient Dungeon -> LevelId -> Level
forall k a. Enum k => EnumMap k a -> k -> a
EM.! LevelId
lid
      inContainer :: (Point -> Bool)
-> (LevelId -> Point -> Container)
-> EnumMap Point (EnumMap ItemId ItemQuant)
-> EnumMap Point (EnumMap ItemId ItemQuant)
-> [UpdAtomic]
inContainer Point -> Bool
allow LevelId -> Point -> Container
fc EnumMap Point (EnumMap ItemId ItemQuant)
bagEM EnumMap Point (EnumMap ItemId ItemQuant)
bagEMClient =
        let f :: Point -> [UpdAtomic]
f Point
p = case (Point
-> EnumMap Point (EnumMap ItemId ItemQuant)
-> Maybe (EnumMap ItemId ItemQuant)
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup Point
p EnumMap Point (EnumMap ItemId ItemQuant)
bagEM, Point
-> EnumMap Point (EnumMap ItemId ItemQuant)
-> Maybe (EnumMap ItemId ItemQuant)
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup Point
p EnumMap Point (EnumMap ItemId ItemQuant)
bagEMClient) of
              (Maybe (EnumMap ItemId ItemQuant)
Nothing, Maybe (EnumMap ItemId ItemQuant)
Nothing) -> []  -- most common, no items ever
              (Just EnumMap ItemId ItemQuant
bag, Maybe (EnumMap ItemId ItemQuant)
Nothing) ->  -- common, client unaware
                [ItemId] -> State -> State -> [UpdAtomic]
cmdItemsFromIids (EnumMap ItemId ItemQuant -> [ItemId]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys EnumMap ItemId ItemQuant
bag) State
sClient State
s
                [UpdAtomic] -> [UpdAtomic] -> [UpdAtomic]
forall a. [a] -> [a] -> [a]
++ [Bool -> Container -> EnumMap ItemId ItemQuant -> UpdAtomic
UpdSpotItemBag Bool
True (LevelId -> Point -> Container
fc LevelId
lid Point
p) EnumMap ItemId ItemQuant
bag | Point -> Bool
allow Point
p]
              (Maybe (EnumMap ItemId ItemQuant)
Nothing, Just EnumMap ItemId ItemQuant
bagClient) ->  -- uncommon, all items vanished
                -- We don't check @allow@, because client sees items there,
                -- so we assume he's aware of the tile enough to notice.
                [Bool -> Container -> EnumMap ItemId ItemQuant -> UpdAtomic
UpdLoseItemBag Bool
True (LevelId -> Point -> Container
fc LevelId
lid Point
p) EnumMap ItemId ItemQuant
bagClient]
              (Just EnumMap ItemId ItemQuant
bag, Just EnumMap ItemId ItemQuant
bagClient) ->
                -- We don't check @allow@, because client sees items there,
                -- so we assume he's aware of the tile enough to see new items.
                if EnumMap ItemId ItemQuant
bag EnumMap ItemId ItemQuant -> EnumMap ItemId ItemQuant -> Bool
forall a. Eq a => a -> a -> Bool
== EnumMap ItemId ItemQuant
bagClient
                then []  -- common, nothing has changed, so optimized
                else -- uncommon, surprise; because it's rare, we send
                     -- whole bags and don't optimize by sending only delta
                     [ItemId] -> State -> State -> [UpdAtomic]
cmdItemsFromIids (EnumMap ItemId ItemQuant -> [ItemId]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys EnumMap ItemId ItemQuant
bag) State
sClient State
s
                     [UpdAtomic] -> [UpdAtomic] -> [UpdAtomic]
forall a. [a] -> [a] -> [a]
++ [ Bool -> Container -> EnumMap ItemId ItemQuant -> UpdAtomic
UpdLoseItemBag Bool
True (LevelId -> Point -> Container
fc LevelId
lid Point
p) EnumMap ItemId ItemQuant
bagClient
                        , Bool -> Container -> EnumMap ItemId ItemQuant -> UpdAtomic
UpdSpotItemBag Bool
True (LevelId -> Point -> Container
fc LevelId
lid Point
p) EnumMap ItemId ItemQuant
bag ]
        in (Point -> [UpdAtomic]) -> [Point] -> [UpdAtomic]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Point -> [UpdAtomic]
f [Point]
inFov
      inFloor :: [UpdAtomic]
inFloor = (Point -> Bool)
-> (LevelId -> Point -> Container)
-> EnumMap Point (EnumMap ItemId ItemQuant)
-> EnumMap Point (EnumMap ItemId ItemQuant)
-> [UpdAtomic]
inContainer (Bool -> Point -> Bool
forall a b. a -> b -> a
const Bool
True) LevelId -> Point -> Container
CFloor (Level -> EnumMap Point (EnumMap ItemId ItemQuant)
lfloor Level
lvl) (Level -> EnumMap Point (EnumMap ItemId ItemQuant)
lfloor Level
lvlClient)
      -- Check that client may be shown embedded items, assuming he's not seeing
      -- any at this position so far. If he's not shown now, the items will be
      -- revealed via searching the tile later on.
      -- This check is essential to prevent embedded items from leaking
      -- tile identity.
      allowEmbed :: Point -> Bool
allowEmbed Point
p = Bool -> Bool
not (TileSpeedup -> ContentId TileKind -> Bool
Tile.isHideAs TileSpeedup
coTileSpeedup (ContentId TileKind -> Bool) -> ContentId TileKind -> Bool
forall a b. (a -> b) -> a -> b
$ Level
lvl Level -> Point -> ContentId TileKind
`at` Point
p)
                     Bool -> Bool -> Bool
|| Level
lvl Level -> Point -> ContentId TileKind
`at` Point
p ContentId TileKind -> ContentId TileKind -> Bool
forall a. Eq a => a -> a -> Bool
== Level
lvlClient Level -> Point -> ContentId TileKind
`at` Point
p
      inEmbed :: [UpdAtomic]
inEmbed = (Point -> Bool)
-> (LevelId -> Point -> Container)
-> EnumMap Point (EnumMap ItemId ItemQuant)
-> EnumMap Point (EnumMap ItemId ItemQuant)
-> [UpdAtomic]
inContainer Point -> Bool
allowEmbed LevelId -> Point -> Container
CEmbed (Level -> EnumMap Point (EnumMap ItemId ItemQuant)
lembed Level
lvl) (Level -> EnumMap Point (EnumMap ItemId ItemQuant)
lembed Level
lvlClient)
      -- Spot tiles.
      atomicTile :: [UpdAtomic]
atomicTile =
        -- We ignore the server resending us hidden versions of the tiles
        -- (or resending us the same data we already got).
        -- If the tiles are changed to other variants of the hidden tile,
        -- we can still verify by searching.
        let f :: Point
-> ([(Point, ContentId TileKind)], [(Point, ContentId TileKind)],
    [(Point, PlaceEntry)])
-> ([(Point, ContentId TileKind)], [(Point, ContentId TileKind)],
    [(Point, PlaceEntry)])
f Point
p ([(Point, ContentId TileKind)]
loses1, [(Point, ContentId TileKind)]
spots1, [(Point, PlaceEntry)]
entries1) =
              let t :: ContentId TileKind
t = Level
lvl Level -> Point -> ContentId TileKind
`at` Point
p
                  tHidden :: ContentId TileKind
tHidden = ContentId TileKind
-> Maybe (ContentId TileKind) -> ContentId TileKind
forall a. a -> Maybe a -> a
fromMaybe ContentId TileKind
t (Maybe (ContentId TileKind) -> ContentId TileKind)
-> Maybe (ContentId TileKind) -> ContentId TileKind
forall a b. (a -> b) -> a -> b
$ ContentData TileKind
-> ContentId TileKind -> Maybe (ContentId TileKind)
Tile.hideAs ContentData TileKind
cotile ContentId TileKind
t
                  tClient :: ContentId TileKind
tClient = Level
lvlClient Level -> Point -> ContentId TileKind
`at` Point
p
                  entries2 :: [(Point, PlaceEntry)]
entries2 = case Point -> EnumMap Point PlaceEntry -> Maybe PlaceEntry
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup Point
p (EnumMap Point PlaceEntry -> Maybe PlaceEntry)
-> EnumMap Point PlaceEntry -> Maybe PlaceEntry
forall a b. (a -> b) -> a -> b
$ Level -> EnumMap Point PlaceEntry
lentry Level
lvl of
                    Maybe PlaceEntry
Nothing -> [(Point, PlaceEntry)]
entries1
                    Just PlaceEntry
entry2 -> case Point -> EnumMap Point PlaceEntry -> Maybe PlaceEntry
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup Point
p (EnumMap Point PlaceEntry -> Maybe PlaceEntry)
-> EnumMap Point PlaceEntry -> Maybe PlaceEntry
forall a b. (a -> b) -> a -> b
$ Level -> EnumMap Point PlaceEntry
lentry Level
lvlClient of
                      Maybe PlaceEntry
Nothing -> (Point
p, PlaceEntry
entry2) (Point, PlaceEntry)
-> [(Point, PlaceEntry)] -> [(Point, PlaceEntry)]
forall a. a -> [a] -> [a]
: [(Point, PlaceEntry)]
entries1
                      Just PlaceEntry
entry3 -> Bool -> [(Point, PlaceEntry)] -> [(Point, PlaceEntry)]
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (PlaceEntry
entry3 PlaceEntry -> PlaceEntry -> Bool
forall a. Eq a => a -> a -> Bool
== PlaceEntry
entry2) [(Point, PlaceEntry)]
entries1
                        -- avoid resending entries if client previously saw
                        -- another not hidden tile at that position
              in if ContentId TileKind
tClient ContentId TileKind -> [ContentId TileKind] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ContentId TileKind
t, ContentId TileKind
tHidden]
                 then ([(Point, ContentId TileKind)]
loses1, [(Point, ContentId TileKind)]
spots1, [(Point, PlaceEntry)]
entries1)
                 else ( if ContentId TileKind -> Bool
isUknownSpace ContentId TileKind
tClient
                        then [(Point, ContentId TileKind)]
loses1
                        else (Point
p, ContentId TileKind
tClient) (Point, ContentId TileKind)
-> [(Point, ContentId TileKind)] -> [(Point, ContentId TileKind)]
forall a. a -> [a] -> [a]
: [(Point, ContentId TileKind)]
loses1
                      , (Point
p, ContentId TileKind
tHidden) (Point, ContentId TileKind)
-> [(Point, ContentId TileKind)] -> [(Point, ContentId TileKind)]
forall a. a -> [a] -> [a]
: [(Point, ContentId TileKind)]
spots1  -- send the hidden version
                      , if ContentId TileKind
tHidden ContentId TileKind -> ContentId TileKind -> Bool
forall a. Eq a => a -> a -> Bool
== ContentId TileKind
t then [(Point, PlaceEntry)]
entries2 else [(Point, PlaceEntry)]
entries1)
            ([(Point, ContentId TileKind)]
loses, [(Point, ContentId TileKind)]
spots, [(Point, PlaceEntry)]
entries) = (Point
 -> ([(Point, ContentId TileKind)], [(Point, ContentId TileKind)],
     [(Point, PlaceEntry)])
 -> ([(Point, ContentId TileKind)], [(Point, ContentId TileKind)],
     [(Point, PlaceEntry)]))
-> ([(Point, ContentId TileKind)], [(Point, ContentId TileKind)],
    [(Point, PlaceEntry)])
-> [Point]
-> ([(Point, ContentId TileKind)], [(Point, ContentId TileKind)],
    [(Point, PlaceEntry)])
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Point
-> ([(Point, ContentId TileKind)], [(Point, ContentId TileKind)],
    [(Point, PlaceEntry)])
-> ([(Point, ContentId TileKind)], [(Point, ContentId TileKind)],
    [(Point, PlaceEntry)])
f ([], [], []) [Point]
inFov
        in [LevelId -> [(Point, ContentId TileKind)] -> UpdAtomic
UpdLoseTile LevelId
lid [(Point, ContentId TileKind)]
loses | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [(Point, ContentId TileKind)] -> Bool
forall a. [a] -> Bool
null [(Point, ContentId TileKind)]
loses]
           [UpdAtomic] -> [UpdAtomic] -> [UpdAtomic]
forall a. [a] -> [a] -> [a]
++ [LevelId -> [(Point, ContentId TileKind)] -> UpdAtomic
UpdSpotTile LevelId
lid [(Point, ContentId TileKind)]
spots | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [(Point, ContentId TileKind)] -> Bool
forall a. [a] -> Bool
null [(Point, ContentId TileKind)]
spots]
           [UpdAtomic] -> [UpdAtomic] -> [UpdAtomic]
forall a. [a] -> [a] -> [a]
++ [LevelId -> [(Point, PlaceEntry)] -> UpdAtomic
UpdSpotEntry LevelId
lid [(Point, PlaceEntry)]
entries | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [(Point, PlaceEntry)] -> Bool
forall a. [a] -> Bool
null [(Point, PlaceEntry)]
entries]
      -- Wipe out remembered smell on tiles that now came into smell Fov.
      -- Smell radius is small, so we can just wipe and send all.
      -- TODO: only send smell younger than ltime (states get out of sync)
      -- or remove older smell elsewhere in the code each turn (expensive).
      -- For now clients act as if this was the case, not peeking into old.
      inSmellFov :: [Point]
inSmellFov = EnumSet Point -> [Point]
forall k. Enum k => EnumSet k -> [k]
ES.elems (EnumSet Point -> [Point]) -> EnumSet Point -> [Point]
forall a b. (a -> b) -> a -> b
$ Perception -> EnumSet Point
totalSmelled Perception
inPer
      inSm :: [(Point, Time)]
inSm = (Point -> Maybe (Point, Time)) -> [Point] -> [(Point, Time)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\Point
p -> (Point
p,) (Time -> (Point, Time)) -> Maybe Time -> Maybe (Point, Time)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Point -> EnumMap Point Time -> Maybe Time
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup Point
p (Level -> EnumMap Point Time
lsmell Level
lvlClient)) [Point]
inSmellFov
      inSmell :: [UpdAtomic]
inSmell = [LevelId -> [(Point, Time)] -> UpdAtomic
UpdLoseSmell LevelId
lid [(Point, Time)]
inSm | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [(Point, Time)] -> Bool
forall a. [a] -> Bool
null [(Point, Time)]
inSm]
      -- Spot smells.
      inSm2 :: [(Point, Time)]
inSm2 = (Point -> Maybe (Point, Time)) -> [Point] -> [(Point, Time)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\Point
p -> (Point
p,) (Time -> (Point, Time)) -> Maybe Time -> Maybe (Point, Time)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Point -> EnumMap Point Time -> Maybe Time
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup Point
p (Level -> EnumMap Point Time
lsmell Level
lvl)) [Point]
inSmellFov
      atomicSmell :: [UpdAtomic]
atomicSmell = [LevelId -> [(Point, Time)] -> UpdAtomic
UpdSpotSmell LevelId
lid [(Point, Time)]
inSm2 | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [(Point, Time)] -> Bool
forall a. [a] -> Bool
null [(Point, Time)]
inSm2]
      -- Actors come last to report the environment they land on.
      inAssocs :: [(ActorId, Actor)]
inAssocs = (Point -> [(ActorId, Actor)]) -> [Point] -> [(ActorId, Actor)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Point
p -> Point -> LevelId -> State -> [(ActorId, Actor)]
posToAidAssocs Point
p LevelId
lid State
s) [Point]
inFov
      -- Here, the actor may be already visible, e.g., when teleporting,
      -- so the exception is caught in @sendUpdate@ above.
      fActor :: (ActorId, Actor) -> [UpdAtomic]
fActor (ActorId
aid, Actor
b) = [ItemId] -> State -> State -> [UpdAtomic]
cmdItemsFromIids (Actor -> [ItemId]
getCarriedIidsAndTrunk Actor
b) State
sClient State
s
                        [UpdAtomic] -> [UpdAtomic] -> [UpdAtomic]
forall a. [a] -> [a] -> [a]
++ [ActorId -> Actor -> UpdAtomic
UpdSpotActor ActorId
aid Actor
b]
      inActor :: [UpdAtomic]
inActor = ((ActorId, Actor) -> [UpdAtomic])
-> [(ActorId, Actor)] -> [UpdAtomic]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (ActorId, Actor) -> [UpdAtomic]
fActor [(ActorId, Actor)]
inAssocs
  in [UpdAtomic]
atomicStash [UpdAtomic] -> [UpdAtomic] -> [UpdAtomic]
forall a. [a] -> [a] -> [a]
++ [UpdAtomic]
inActor [UpdAtomic] -> [UpdAtomic] -> [UpdAtomic]
forall a. [a] -> [a] -> [a]
++ [UpdAtomic]
inSmell [UpdAtomic] -> [UpdAtomic] -> [UpdAtomic]
forall a. [a] -> [a] -> [a]
++ [UpdAtomic]
atomicSmell [UpdAtomic] -> [UpdAtomic] -> [UpdAtomic]
forall a. [a] -> [a] -> [a]
++ [UpdAtomic]
inFloor
     [UpdAtomic] -> [UpdAtomic] -> [UpdAtomic]
forall a. [a] -> [a] -> [a]
++ [UpdAtomic]
atomicTile [UpdAtomic] -> [UpdAtomic] -> [UpdAtomic]
forall a. [a] -> [a] -> [a]
++ [UpdAtomic]
inEmbed