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

-- | Send an atomic action to all clients that can see it.
handleAndBroadcast :: (MonadServerAtomic m, MonadServerComm m)
                   => PosAtomic -> [UpdAtomic] -> CmdAtomic -> m ()
handleAndBroadcast :: forall (m :: * -> *).
(MonadServerAtomic m, MonadServerComm m) =>
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.
  knowEvents <- (StateServer -> Bool) -> m Bool
forall a. (StateServer -> a) -> m a
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
  sperFidOld <- getsServer sperFid
  -- Send some actions to the clients, one faction at a time.
  let sendAtomic FactionId
fid (UpdAtomic UpdAtomic
cmd) = do
        let iids :: [ItemId]
iids = UpdAtomic -> [ItemId]
iidUpdAtomic UpdAtomic
cmd
        s <- m State
forall (m :: * -> *). MonadStateRead m => m State
getState
        sClient <- getsServer $ (EM.! fid) . sclientStates
        mapM_ (sendUpdateCheck fid) $ cmdItemsFromIids iids sClient s
        sendUpdate fid cmd
      sendAtomic FactionId
fid (SfxAtomic SfxAtomic
sfx) = do
        let iids :: [ItemId]
iids = SfxAtomic -> [ItemId]
iidSfxAtomic SfxAtomic
sfx
        s <- m State
forall (m :: * -> *). MonadStateRead m => m State
getState
        sClient <- getsServer $ (EM.! fid) . sclientStates
        mapM_ (sendUpdateCheck fid) $ cmdItemsFromIids iids sClient s
        sendSfx fid sfx
      breakSend FactionId
fid PerLid
perFid = case PosAtomic -> Maybe LevelId
lidOfPos PosAtomic
ps of
        Maybe LevelId
Nothing -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just LevelId
lidOriginal -> do
          psBroken <- (UpdAtomic -> m PosAtomic) -> [UpdAtomic] -> m [PosAtomic]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM UpdAtomic -> m PosAtomic
forall (m :: * -> *). MonadStateRead m => UpdAtomic -> m PosAtomic
posUpdAtomic [UpdAtomic]
atomicBroken
          case 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
                    b <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
                    when (deltaBenign $ bcalmDelta b) $
                      execUpdAtomic $ UpdRefillCalm aid minusM
                  leaderDistance :: Point -> m (Maybe Int)
leaderDistance Point
pos = do
                    mleader <- (State -> Maybe ActorId) -> m (Maybe ActorId)
forall a. (State -> a) -> m a
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 mleader of
                      Maybe ActorId
Nothing -> Maybe Int -> m (Maybe Int)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Int
forall a. Maybe a
Nothing
                      Just ActorId
leader -> do
                        b <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
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.
                        return $ Just $ max 0 $ min 5 $ flip (-) 1 $ floor
                               $ sqrt $ intToDouble $ chessDist pos (bpos b)
              -- 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.
              as <- (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
forall a. (State -> a) -> m a
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 atomic of
                UpdAtomic UpdAtomic
cmd -> do
                  (profound, mpos) <- UpdAtomic -> m (Bool, Maybe Point)
forall (m :: * -> *).
MonadStateRead m =>
UpdAtomic -> m (Bool, Maybe Point)
hearUpdAtomic UpdAtomic
cmd
                  case 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 a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                    Just Point
pos -> do
                      aids <- Point -> [(ActorId, Actor)] -> m [ActorId]
forall (m :: * -> *).
MonadStateRead m =>
Point -> [(ActorId, Actor)] -> m [ActorId]
filterHear Point
pos [(ActorId, Actor)]
as
                      if null aids && not profound
                      then return ()
                      else do
                        distance <- if null aids
                                    then return Nothing
                                    else leaderDistance pos
                        sendUpdate fid $ UpdHearFid fid distance $ HearUpd cmd
                        mapM_ drainCalmOnce aids
                SfxAtomic SfxAtomic
cmd -> do
                  mhear <- SfxAtomic -> m (Maybe (HearMsg, Bool, Point))
forall (m :: * -> *).
MonadServer m =>
SfxAtomic -> m (Maybe (HearMsg, Bool, Point))
hearSfxAtomic SfxAtomic
cmd
                  case mhear of
                    Maybe (HearMsg, Bool, Point)
Nothing -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                    Just (HearMsg
hearMsg, Bool
profound, Point
pos) -> do
                      aids <- Point -> [(ActorId, Actor)] -> m [ActorId]
forall (m :: * -> *).
MonadStateRead m =>
Point -> [(ActorId, Actor)] -> m [ActorId]
filterHear Point
pos [(ActorId, Actor)]
as
                      if null aids && not profound
                      then return ()
                      else do
                        distance <- if null aids
                                    then return Nothing
                                    else leaderDistance pos
                        sendUpdate fid $ UpdHearFid fid distance hearMsg
                        mapM_ drainCalmOnce 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
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@.
  factionD <- getsState sfactionD
  mapM_ send $ EM.keys 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 :: forall (m :: * -> *).
MonadStateRead m =>
UpdAtomic -> m (Bool, Maybe Point)
hearUpdAtomic UpdAtomic
cmd = do
  COps{coTileSpeedup} <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  case 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 a. a -> m a
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 <- (State -> ItemKind) -> m ItemKind
forall a. (State -> a) -> m a
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
      discoAspect <- getsState sdiscoAspect
      let arItem = DiscoveryAspect
discoAspect DiscoveryAspect -> ItemId -> AspectRecord
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ItemId
iid
      if cstore /= COrgan
         || IA.checkFlag Ability.Blast arItem
            && Dice.supDice (IK.idamage itemKind) > 0 then do
        body <- getsState $ getActorBody aid
        return (True, Just $ bpos body)
      else return (False, 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.
      b <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
      discoAspect <- getsState sdiscoAspect
      let arTrunk = DiscoveryAspect
discoAspect DiscoveryAspect -> ItemId -> AspectRecord
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> ItemId
btrunk Actor
b
      return ( False, if not (bproj b) || IA.checkFlag Ability.Blast arTrunk
                      then Nothing
                      else Just $ bpos b )
    UpdAlterTile LevelId
_ Point
p ContentId TileKind
_ ContentId TileKind
toTile ->
      (Bool, Maybe Point) -> m (Bool, Maybe Point)
forall a. a -> m a
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 a. a -> m a
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 a. a -> m a
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 :: forall (m :: * -> *).
MonadServer m =>
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.
      b <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
      discoAspect <- getsState sdiscoAspect
      let arItem = DiscoveryAspect
discoAspect DiscoveryAspect -> ItemId -> AspectRecord
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ItemId
iid
      itemKindId <- getsState $ getIidKindIdServer iid
      -- Loud explosions cause enough noise, so ignoring particle hit spam.
      return $! if IA.checkFlag Ability.Blast arItem
                then Nothing
                else Just (HearStrike itemKindId, False, bpos b)
    SfxEffect FactionId
_ ActorId
aid ItemId
_ (IK.Summon GroupName ItemKind
grp Dice
p) Int64
_ -> do
      b <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
      return $ Just (HearSummon (bproj b) grp p, False, bpos b)
    SfxEffect FactionId
_ ActorId
aid ItemId
_ (IK.VerbMsg Text
verb Text
ending) Int64
_ -> do
      b <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
      discoAspect <- getsState sdiscoAspect
      let arTrunk = DiscoveryAspect
discoAspect DiscoveryAspect -> ItemId -> AspectRecord
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> ItemId
btrunk Actor
b
          subject = Part
"noises of someone that"
          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
      return $! if IA.checkFlag Ability.Unique arTrunk
                then Just (HearTaunt phrase, True, bpos b)
                else Nothing
    SfxCollideTile ActorId
_ Point
p ->
      Maybe (HearMsg, Bool, Point) -> m (Maybe (HearMsg, Bool, Point))
forall a. a -> m a
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
      b <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
      (subject, verb) <- displayTaunt voluntary rndToAction aid
      discoAspect <- getsState sdiscoAspect
      let arTrunk = DiscoveryAspect
discoAspect DiscoveryAspect -> ItemId -> AspectRecord
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> ItemId
btrunk Actor
b
          unique = if Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Unique AspectRecord
arTrunk then Text
"big" else 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
"."
      return $ Just (HearTaunt phrase, True, bpos b)  -- intentional
    SfxAtomic
_ -> Maybe (HearMsg, Bool, Point) -> m (Maybe (HearMsg, Bool, Point))
forall a. a -> m a
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 :: forall (m :: * -> *).
MonadStateRead m =>
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.
        actorMaxSk <- (State -> Skills) -> m Skills
forall a. (State -> a) -> m a
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
        return $! Ability.getSk Ability.SkHearing actorMaxSk
                  >= chessDist pos (bpos 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 :: forall (m :: * -> *).
(MonadServerAtomic m, MonadServerComm m) =>
FactionId
-> LevelId -> Perception -> Perception -> Perception -> m ()
sendPer FactionId
fid LevelId
lid Perception
outPer Perception
inPer Perception
perNew = do
  knowEvents <- (StateServer -> Bool) -> m Bool
forall a. (StateServer -> a) -> m a
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
  unless knowEvents $ do  -- inconsistencies would quickly manifest
    sendUpdNoState fid $ UpdPerception lid outPer inPer
    sClient <- getsServer $ (EM.! fid) . sclientStates
    let forget = FactionId -> LevelId -> Perception -> State -> [UpdAtomic]
atomicForget FactionId
fid LevelId
lid Perception
outPer State
sClient
    remember <- getsState $ atomicRemember lid inPer sClient
    let 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 UpdRegisterItems{} = Bool
True
        onLevel UpdLoseStashFaction{} = Bool
True
        onLevel UpdAtomic
_ = Bool
False
    psRem <- mapM posUpdAtomic $ filter (not . onLevel) remember
    -- Verify that we remember the currently seen things.
    let !_A = Bool -> () -> ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert ((PosAtomic -> Bool) -> [PosAtomic] -> Bool
forall v. Show v => (v -> Bool) -> [v] -> Bool
allB PosAtomic -> Bool
seenNew [PosAtomic]
psRem) ()
    mapM_ (sendUpdateCheck fid) forget
    mapM_ (sendUpdate fid) 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 :: ContentData TileKind
cotile :: COps -> ContentData TileKind
cotile, TileSpeedup
coTileSpeedup :: COps -> TileSpeedup
coTileSpeedup :: 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 a. Eq a => a -> [a] -> 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 a b. (a -> b -> b) -> b -> [a] -> b
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