{-# LANGUAGE TupleSections #-}
module Game.LambdaHack.Server.BroadcastAtomic
( handleAndBroadcast, sendPer, handleCmdAtomicServer
#ifdef EXPOSE_INTERNAL
, 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
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)
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
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
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
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
[(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
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)
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
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
UpdCreateItem iid :: ItemId
iid item :: Item
item _ (CActor aid :: ActorId
aid cstore :: CStore
cstore) -> do
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
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
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
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 []
_ -> Maybe [ActorId] -> m (Maybe [ActorId])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [ActorId]
forall a. Maybe a
Nothing
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
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
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)
_ -> 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
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
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
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
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 =
let outFov :: EnumSet Point
outFov = Perception -> EnumSet Point
totalVisible Perception
outPer
fActor :: (ActorId, Actor) -> UpdAtomic
fActor (aid :: ActorId
aid, b :: Actor
b) =
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
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
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) -> []
(Just bag :: EnumMap ItemId ItemQuant
bag, Nothing) ->
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) ->
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) ->
if EnumMap ItemId ItemQuant
bag EnumMap ItemId ItemQuant -> EnumMap ItemId ItemQuant -> Bool
forall a. Eq a => a -> a -> Bool
== EnumMap ItemId ItemQuant
bagClient
then []
else
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)
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)
atomicTile :: [UpdAtomic]
atomicTile =
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
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
, 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]
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]
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]
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
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