{-# 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
  , 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           Game.LambdaHack.Atomic
import           Game.LambdaHack.Common.Actor
import           Game.LambdaHack.Common.ActorState
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.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           Game.LambdaHack.Common.Point
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 cmd :: 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
  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 ps :: PosAtomic
ps atomicBroken :: [UpdAtomic]
atomicBroken atomic :: 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 fid :: FactionId
fid (UpdAtomic cmd :: UpdAtomic
cmd) = FactionId -> UpdAtomic -> m ()
forall (m :: * -> *).
(MonadServerAtomic m, MonadServerComm m) =>
FactionId -> UpdAtomic -> m ()
sendUpdate FactionId
fid UpdAtomic
cmd
      sendAtomic fid :: FactionId
fid (SfxAtomic sfx :: SfxAtomic
sfx) = FactionId -> SfxAtomic -> m ()
forall (m :: * -> *).
MonadServerComm m =>
FactionId -> SfxAtomic -> m ()
sendSfx FactionId
fid SfxAtomic
sfx
      breakSend :: LevelId -> FactionId -> Perception -> m ()
breakSend lid :: LevelId
lid fid :: FactionId
fid perFidLid :: Perception
perFidLid = do
        let send2 :: (UpdAtomic, PosAtomic) -> m ()
send2 (cmd2 :: UpdAtomic
cmd2, ps2 :: PosAtomic
ps2) =
              Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> FactionId -> Perception -> PosAtomic -> Bool
seenAtomicCli Bool
knowEvents FactionId
fid Perception
perFidLid PosAtomic
ps2) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
                FactionId -> UpdAtomic -> m ()
forall (m :: * -> *).
(MonadServerAtomic m, MonadServerComm m) =>
FactionId -> UpdAtomic -> m ()
sendUpdate FactionId
fid UpdAtomic
cmd2
        [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
          _ : _ -> ((UpdAtomic, PosAtomic) -> m ())
-> [(UpdAtomic, PosAtomic)] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> 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 aid :: ActorId
aid = do
                  Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
                  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
            -- 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
lid
            case CmdAtomic
atomic of
              UpdAtomic cmd :: UpdAtomic
cmd -> do
                Maybe [ActorId]
maids <- [(ActorId, Actor)] -> UpdAtomic -> m (Maybe [ActorId])
forall (m :: * -> *).
MonadStateRead m =>
[(ActorId, Actor)] -> UpdAtomic -> m (Maybe [ActorId])
hearUpdAtomic [(ActorId, Actor)]
as UpdAtomic
cmd
                case Maybe [ActorId]
maids of
                  Nothing -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                  Just aids :: [ActorId]
aids -> do
                    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 -> HearMsg -> UpdAtomic
UpdHearFid FactionId
fid
                                   (HearMsg -> UpdAtomic) -> HearMsg -> UpdAtomic
forall a b. (a -> b) -> a -> b
$ Bool -> UpdAtomic -> HearMsg
HearUpd (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [ActorId] -> Bool
forall a. [a] -> Bool
null [ActorId]
aids) UpdAtomic
cmd
                    (ActorId -> m ()) -> [ActorId] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ActorId -> m ()
forall (m :: * -> *). MonadServerAtomic m => ActorId -> m ()
drainCalmOnce [ActorId]
aids
              SfxAtomic cmd :: SfxAtomic
cmd -> do
                Maybe (HearMsg, [ActorId])
mhear <- [(ActorId, Actor)] -> SfxAtomic -> m (Maybe (HearMsg, [ActorId]))
forall (m :: * -> *).
MonadServer m =>
[(ActorId, Actor)] -> SfxAtomic -> m (Maybe (HearMsg, [ActorId]))
hearSfxAtomic [(ActorId, Actor)]
as SfxAtomic
cmd
                case Maybe (HearMsg, [ActorId])
mhear of
                  Nothing -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                  Just (hearMsg :: HearMsg
hearMsg, aids :: [ActorId]
aids) -> do
                    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 -> HearMsg -> UpdAtomic
UpdHearFid FactionId
fid HearMsg
hearMsg
                    (ActorId -> m ()) -> [ActorId] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> 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).
      anySend :: LevelId -> FactionId -> Perception -> m ()
anySend lid :: LevelId
lid fid :: FactionId
fid perFidLid :: Perception
perFidLid =
        if Bool -> FactionId -> Perception -> PosAtomic -> Bool
seenAtomicCli Bool
knowEvents FactionId
fid Perception
perFidLid PosAtomic
ps
        then FactionId -> CmdAtomic -> m ()
forall (m :: * -> *).
(MonadServerAtomic m, MonadServerComm m) =>
FactionId -> CmdAtomic -> m ()
sendAtomic FactionId
fid CmdAtomic
atomic
        else LevelId -> FactionId -> Perception -> m ()
breakSend LevelId
lid FactionId
fid Perception
perFidLid
      posLevel :: LevelId -> FactionId -> m ()
posLevel lid :: LevelId
lid fid :: FactionId
fid =
        LevelId -> FactionId -> Perception -> m ()
anySend LevelId
lid FactionId
fid (Perception -> m ()) -> Perception -> m ()
forall a b. (a -> b) -> a -> b
$ PerFid
sperFidOld PerFid -> FactionId -> PerLid
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
fid PerLid -> LevelId -> Perception
forall k a. Enum k => EnumMap k a -> k -> a
EM.! LevelId
lid
      send :: FactionId -> m ()
send fid :: FactionId
fid = case PosAtomic
ps of
        PosSight lid :: LevelId
lid _ -> LevelId -> FactionId -> m ()
posLevel LevelId
lid FactionId
fid
        PosFidAndSight _ lid :: LevelId
lid _ -> LevelId -> FactionId -> m ()
posLevel LevelId
lid FactionId
fid
        PosFidAndSer (Just lid :: LevelId
lid) _ -> LevelId -> FactionId -> m ()
posLevel LevelId
lid FactionId
fid
        PosSmell lid :: LevelId
lid _ -> LevelId -> FactionId -> m ()
posLevel LevelId
lid FactionId
fid
        PosFid fid2 :: FactionId
fid2 -> Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (FactionId
fid FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
fid2) (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 CmdAtomic
atomic
        PosFidAndSer Nothing fid2 :: FactionId
fid2 ->
          Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (FactionId
fid FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
fid2) (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 CmdAtomic
atomic
        PosSer -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        PosAll -> FactionId -> CmdAtomic -> m ()
forall (m :: * -> *).
(MonadServerAtomic m, MonadServerComm m) =>
FactionId -> CmdAtomic -> m ()
sendAtomic FactionId
fid CmdAtomic
atomic
        PosNone -> [Char] -> m ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> m ()) -> [Char] -> m ()
forall a b. (a -> b) -> a -> b
$ "" [Char] -> (FactionId, CmdAtomic) -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` (FactionId
fid, CmdAtomic
atomic)
  -- Factions that are eliminated by the command are processed as well,
  -- because they are not deleted from @sfactionD@.
  FactionDict
factionD <- (State -> FactionDict) -> m FactionDict
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> FactionDict
sfactionD
  (FactionId -> m ()) -> [FactionId] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ FactionId -> m ()
send ([FactionId] -> m ()) -> [FactionId] -> m ()
forall a b. (a -> b) -> a -> b
$ FactionDict -> [FactionId]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys FactionDict
factionD

-- | Messages for some unseen atomic commands.
hearUpdAtomic :: MonadStateRead m
              => [(ActorId, Actor)] -> UpdAtomic
              -> m (Maybe [ActorId])
hearUpdAtomic :: [(ActorId, Actor)] -> UpdAtomic -> m (Maybe [ActorId])
hearUpdAtomic as :: [(ActorId, Actor)]
as cmd :: 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 _ body :: Actor
body _ | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Actor -> Bool
bproj Actor
body -> do
      [ActorId]
aids <- Point -> [(ActorId, Actor)] -> m [ActorId]
forall (m :: * -> *).
MonadStateRead m =>
Point -> [(ActorId, Actor)] -> m [ActorId]
filterHear (Actor -> Point
bpos Actor
body) [(ActorId, Actor)]
as
      Maybe [ActorId] -> m (Maybe [ActorId])
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [ActorId] -> m (Maybe [ActorId]))
-> Maybe [ActorId] -> m (Maybe [ActorId])
forall a b. (a -> b) -> a -> b
$ [ActorId] -> Maybe [ActorId]
forall a. a -> Maybe a
Just [ActorId]
aids  -- profound
    UpdCreateItem iid :: ItemId
iid item :: Item
item _ (CActor aid :: ActorId
aid cstore :: 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
> 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
        [ActorId]
aids <- Point -> [(ActorId, Actor)] -> m [ActorId]
forall (m :: * -> *).
MonadStateRead m =>
Point -> [(ActorId, Actor)] -> m [ActorId]
filterHear (Actor -> Point
bpos Actor
body) [(ActorId, Actor)]
as
        Maybe [ActorId] -> m (Maybe [ActorId])
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [ActorId] -> m (Maybe [ActorId]))
-> Maybe [ActorId] -> m (Maybe [ActorId])
forall a b. (a -> b) -> a -> b
$ [ActorId] -> Maybe [ActorId]
forall a. a -> Maybe a
Just [ActorId]
aids  -- profound
      else Maybe [ActorId] -> m (Maybe [ActorId])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [ActorId]
forall a. Maybe a
Nothing
    UpdTrajectory aid :: ActorId
aid (Just (l :: [Vector]
l, _)) Nothing | Bool -> Bool
not ([Vector] -> Bool
forall a. [a] -> Bool
null [Vector]
l) -> do
      -- Non-blast actor 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
      [ActorId]
aids <- Point -> [(ActorId, Actor)] -> m [ActorId]
forall (m :: * -> *).
MonadStateRead m =>
Point -> [(ActorId, Actor)] -> m [ActorId]
filterHear (Actor -> Point
bpos Actor
b) [(ActorId, Actor)]
as
      Maybe [ActorId] -> m (Maybe [ActorId])
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [ActorId] -> m (Maybe [ActorId]))
-> Maybe [ActorId] -> m (Maybe [ActorId])
forall a b. (a -> b) -> a -> b
$! if Actor -> Bool
bproj Actor
b Bool -> Bool -> Bool
&& Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Blast AspectRecord
arTrunk Bool -> Bool -> Bool
|| [ActorId] -> Bool
forall a. [a] -> Bool
null [ActorId]
aids
                then Maybe [ActorId]
forall a. Maybe a
Nothing
                else [ActorId] -> Maybe [ActorId]
forall a. a -> Maybe a
Just [ActorId]
aids
    UpdAlterTile _ p :: Point
p _ toTile :: ContentId TileKind
toTile -> do
      [ActorId]
aids <- Point -> [(ActorId, Actor)] -> m [ActorId]
forall (m :: * -> *).
MonadStateRead m =>
Point -> [(ActorId, Actor)] -> m [ActorId]
filterHear Point
p [(ActorId, Actor)]
as
      Maybe [ActorId] -> m (Maybe [ActorId])
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [ActorId] -> m (Maybe [ActorId]))
-> Maybe [ActorId] -> m (Maybe [ActorId])
forall a b. (a -> b) -> a -> b
$! if TileSpeedup -> ContentId TileKind -> Bool
Tile.isDoor TileSpeedup
coTileSpeedup ContentId TileKind
toTile Bool -> Bool -> Bool
&& [ActorId] -> Bool
forall a. [a] -> Bool
null [ActorId]
aids
                then Maybe [ActorId]
forall a. Maybe a
Nothing
                else [ActorId] -> Maybe [ActorId]
forall a. a -> Maybe a
Just [ActorId]
aids  -- profound
    UpdAlterExplorable{} -> Maybe [ActorId] -> m (Maybe [ActorId])
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [ActorId] -> m (Maybe [ActorId]))
-> Maybe [ActorId] -> m (Maybe [ActorId])
forall a b. (a -> b) -> a -> b
$ [ActorId] -> Maybe [ActorId]
forall a. a -> Maybe a
Just []  -- profound
    _ -> Maybe [ActorId] -> m (Maybe [ActorId])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [ActorId]
forall a. Maybe a
Nothing

-- | Messages for some unseen sfx.
hearSfxAtomic :: MonadServer m
              => [(ActorId, Actor)] -> SfxAtomic
              -> m (Maybe (HearMsg, [ActorId]))
hearSfxAtomic :: [(ActorId, Actor)] -> SfxAtomic -> m (Maybe (HearMsg, [ActorId]))
hearSfxAtomic as :: [(ActorId, Actor)]
as cmd :: SfxAtomic
cmd =
  case SfxAtomic
cmd of
    SfxStrike aid :: ActorId
aid _ iid :: 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
      [ActorId]
aids <- Point -> [(ActorId, Actor)] -> m [ActorId]
forall (m :: * -> *).
MonadStateRead m =>
Point -> [(ActorId, Actor)] -> m [ActorId]
filterHear (Actor -> Point
bpos Actor
b) [(ActorId, Actor)]
as
      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, [ActorId]) -> m (Maybe (HearMsg, [ActorId]))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (HearMsg, [ActorId]) -> m (Maybe (HearMsg, [ActorId])))
-> Maybe (HearMsg, [ActorId]) -> m (Maybe (HearMsg, [ActorId]))
forall a b. (a -> b) -> a -> b
$! if Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Blast AspectRecord
arItem Bool -> Bool -> Bool
|| [ActorId] -> Bool
forall a. [a] -> Bool
null [ActorId]
aids
                then Maybe (HearMsg, [ActorId])
forall a. Maybe a
Nothing
                else (HearMsg, [ActorId]) -> Maybe (HearMsg, [ActorId])
forall a. a -> Maybe a
Just (ContentId ItemKind -> HearMsg
HearStrike ContentId ItemKind
itemKindId, [ActorId]
aids)
    SfxEffect _ aid :: ActorId
aid (IK.Summon grp :: GroupName ItemKind
grp p :: Dice
p) _ -> do
      Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
      [ActorId]
aids <- Point -> [(ActorId, Actor)] -> m [ActorId]
forall (m :: * -> *).
MonadStateRead m =>
Point -> [(ActorId, Actor)] -> m [ActorId]
filterHear (Actor -> Point
bpos Actor
b) [(ActorId, Actor)]
as
      Maybe (HearMsg, [ActorId]) -> m (Maybe (HearMsg, [ActorId]))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (HearMsg, [ActorId]) -> m (Maybe (HearMsg, [ActorId])))
-> Maybe (HearMsg, [ActorId]) -> m (Maybe (HearMsg, [ActorId]))
forall a b. (a -> b) -> a -> b
$! if [ActorId] -> Bool
forall a. [a] -> Bool
null [ActorId]
aids
                then Maybe (HearMsg, [ActorId])
forall a. Maybe a
Nothing
                else (HearMsg, [ActorId]) -> Maybe (HearMsg, [ActorId])
forall a. a -> Maybe a
Just (Bool -> GroupName ItemKind -> Dice -> HearMsg
HearSummon (Actor -> Bool
bproj Actor
b) GroupName ItemKind
grp Dice
p, [ActorId]
aids)
    SfxTaunt voluntary :: Bool
voluntary aid :: ActorId
aid -> do
      Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
      [ActorId]
aids <- Point -> [(ActorId, Actor)] -> m [ActorId]
forall (m :: * -> *).
MonadStateRead m =>
Point -> [(ActorId, Actor)] -> m [ActorId]
filterHear (Actor -> Point
bpos Actor
b) [(ActorId, Actor)]
as
      (subject :: Text
subject, verb :: 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
      Maybe (HearMsg, [ActorId]) -> m (Maybe (HearMsg, [ActorId]))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (HearMsg, [ActorId]) -> m (Maybe (HearMsg, [ActorId])))
-> Maybe (HearMsg, [ActorId]) -> m (Maybe (HearMsg, [ActorId]))
forall a b. (a -> b) -> a -> b
$ (HearMsg, [ActorId]) -> Maybe (HearMsg, [ActorId])
forall a. a -> Maybe a
Just (Text -> HearMsg
HearTaunt (Text -> HearMsg) -> Text -> HearMsg
forall a b. (a -> b) -> a -> b
$ Text
subject Text -> Text -> Text
<+> Text
verb, [ActorId]
aids)  -- intentional
    _ -> Maybe (HearMsg, [ActorId]) -> m (Maybe (HearMsg, [ActorId]))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (HearMsg, [ActorId])
forall a. Maybe a
Nothing

filterHear :: MonadStateRead m => Point -> [(ActorId, Actor)] -> m [ActorId]
filterHear :: Point -> [(ActorId, Actor)] -> m [ActorId]
filterHear pos :: Point
pos as :: [(ActorId, Actor)]
as = do
  let actorHear :: (ActorId, Actor) -> m Bool
actorHear (aid :: ActorId
aid, body :: 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 ()
{-# INLINE sendPer #-}
sendPer :: FactionId
-> LevelId -> Perception -> Perception -> Perception -> m ()
sendPer fid :: FactionId
fid lid :: LevelId
lid outPer :: Perception
outPer inPer :: Perception
inPer perNew :: 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 -> Perception -> PosAtomic -> Bool
seenAtomicCli Bool
False FactionId
fid Perception
perNew
    [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]
remember
    -- Verify that we remember only currently seen things.
    let !_A :: ()
_A = Bool -> () -> ()
forall a. HasCallStack => 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 b.
(Foldable t, Monad m) =>
(a -> m b) -> 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 b.
(Foldable t, Monad m) =>
(a -> m b) -> 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 and smells 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 side :: FactionId
side lid :: LevelId
lid outPer :: Perception
outPer sClient :: 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 (aid :: ActorId
aid, b :: 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 -> [(ItemId, Item)] -> UpdAtomic
UpdLoseActor ActorId
aid Actor
b ([(ItemId, Item)] -> UpdAtomic) -> [(ItemId, Item)] -> UpdAtomic
forall a b. (a -> b) -> a -> b
$ Actor -> State -> [(ItemId, Item)]
getCarriedAssocsAndTrunk Actor
b State
sClient
          -- 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 (\p :: 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 (\p :: 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

atomicRemember :: LevelId -> Perception -> State -> State -> [UpdAtomic]
{-# INLINE atomicRemember #-}
atomicRemember :: LevelId -> Perception -> State -> State -> [UpdAtomic]
atomicRemember lid :: LevelId
lid inPer :: Perception
inPer sClient :: State
sClient s :: 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
      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 allow :: Point -> Bool
allow fc :: LevelId -> Point -> Container
fc bagEM :: EnumMap Point (EnumMap ItemId ItemQuant)
bagEM bagEMClient :: EnumMap Point (EnumMap ItemId ItemQuant)
bagEMClient =
        let f :: Point -> [UpdAtomic]
f p :: 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
              (Nothing, Nothing) -> []  -- most common, no items ever
              (Just bag :: EnumMap ItemId ItemQuant
bag, Nothing) ->  -- common, client unaware
                let ais :: [(ItemId, Item)]
ais = (ItemId -> (ItemId, Item)) -> [ItemId] -> [(ItemId, Item)]
forall a b. (a -> b) -> [a] -> [b]
map (\iid :: ItemId
iid -> (ItemId
iid, ItemId -> State -> Item
getItemBody ItemId
iid State
s))
                              (EnumMap ItemId ItemQuant -> [ItemId]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys EnumMap ItemId ItemQuant
bag)
                in [Container
-> EnumMap ItemId ItemQuant -> [(ItemId, Item)] -> UpdAtomic
UpdSpotItemBag (LevelId -> Point -> Container
fc LevelId
lid Point
p) EnumMap ItemId ItemQuant
bag [(ItemId, Item)]
ais | Point -> Bool
allow Point
p]
              (Nothing, Just bagClient :: 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.
               let aisClient :: [(ItemId, Item)]
aisClient = (ItemId -> (ItemId, Item)) -> [ItemId] -> [(ItemId, Item)]
forall a b. (a -> b) -> [a] -> [b]
map (\iid :: ItemId
iid -> (ItemId
iid, ItemId -> State -> Item
getItemBody ItemId
iid State
sClient))
                                    (EnumMap ItemId ItemQuant -> [ItemId]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys EnumMap ItemId ItemQuant
bagClient)
                in [Container
-> EnumMap ItemId ItemQuant -> [(ItemId, Item)] -> UpdAtomic
UpdLoseItemBag (LevelId -> Point -> Container
fc LevelId
lid Point
p) EnumMap ItemId ItemQuant
bagClient [(ItemId, Item)]
aisClient]
              (Just bag :: EnumMap ItemId ItemQuant
bag, Just bagClient :: 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
                  let aisClient :: [(ItemId, Item)]
aisClient = (ItemId -> (ItemId, Item)) -> [ItemId] -> [(ItemId, Item)]
forall a b. (a -> b) -> [a] -> [b]
map (\iid :: ItemId
iid -> (ItemId
iid, ItemId -> State -> Item
getItemBody ItemId
iid State
sClient))
                                      (EnumMap ItemId ItemQuant -> [ItemId]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys EnumMap ItemId ItemQuant
bagClient)
                      ais :: [(ItemId, Item)]
ais = (ItemId -> (ItemId, Item)) -> [ItemId] -> [(ItemId, Item)]
forall a b. (a -> b) -> [a] -> [b]
map (\iid :: ItemId
iid -> (ItemId
iid, ItemId -> State -> Item
getItemBody ItemId
iid State
s))
                                (EnumMap ItemId ItemQuant -> [ItemId]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys EnumMap ItemId ItemQuant
bag)
                  in [ Container
-> EnumMap ItemId ItemQuant -> [(ItemId, Item)] -> UpdAtomic
UpdLoseItemBag (LevelId -> Point -> Container
fc LevelId
lid Point
p) EnumMap ItemId ItemQuant
bagClient [(ItemId, Item)]
aisClient
                     , Container
-> EnumMap ItemId ItemQuant -> [(ItemId, Item)] -> UpdAtomic
UpdSpotItemBag (LevelId -> Point -> Container
fc LevelId
lid Point
p) EnumMap ItemId ItemQuant
bag [(ItemId, Item)]
ais ]
        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 p :: 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 p :: Point
p (loses1 :: [(Point, ContentId TileKind)]
loses1, spots1 :: [(Point, ContentId TileKind)]
spots1, entries1 :: [(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
                    Nothing -> [(Point, PlaceEntry)]
entries1
                    Just entry2 :: 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
                      Nothing -> (Point
p, PlaceEntry
entry2) (Point, PlaceEntry)
-> [(Point, PlaceEntry)] -> [(Point, PlaceEntry)]
forall a. a -> [a] -> [a]
: [(Point, PlaceEntry)]
entries1
                      Just entry3 :: PlaceEntry
entry3 -> Bool -> [(Point, PlaceEntry)] -> [(Point, PlaceEntry)]
forall a. HasCallStack => 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)
            (loses :: [(Point, ContentId TileKind)]
loses, spots :: [(Point, ContentId TileKind)]
spots, entries :: [(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 (\p :: 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 = if [(Point, Time)] -> Bool
forall a. [a] -> Bool
null [(Point, Time)]
inSm then [] else [LevelId -> [(Point, Time)] -> UpdAtomic
UpdLoseSmell LevelId
lid [(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 (\p :: 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 = if [(Point, Time)] -> Bool
forall a. [a] -> Bool
null [(Point, Time)]
inSm2 then [] else [LevelId -> [(Point, Time)] -> UpdAtomic
UpdSpotSmell LevelId
lid [(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 (\p :: 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 (aid :: ActorId
aid, b :: Actor
b) = let ais :: [(ItemId, Item)]
ais = Actor -> State -> [(ItemId, Item)]
getCarriedAssocsAndTrunk Actor
b State
s
                        in ActorId -> Actor -> [(ItemId, Item)] -> UpdAtomic
UpdSpotActor ActorId
aid Actor
b [(ItemId, Item)]
ais
      inActor :: [UpdAtomic]
inActor = ((ActorId, Actor) -> UpdAtomic)
-> [(ActorId, Actor)] -> [UpdAtomic]
forall a b. (a -> b) -> [a] -> [b]
map (ActorId, Actor) -> UpdAtomic
fActor [(ActorId, Actor)]
inAssocs
  in [UpdAtomic]
atomicTile [UpdAtomic] -> [UpdAtomic] -> [UpdAtomic]
forall a. [a] -> [a] -> [a]
++ [UpdAtomic]
inFloor [UpdAtomic] -> [UpdAtomic] -> [UpdAtomic]
forall a. [a] -> [a] -> [a]
++ [UpdAtomic]
inEmbed [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]
inActor