-- | Representation and computation of visiblity of atomic commands
-- by clients.
--
-- See
-- <https://github.com/LambdaHack/LambdaHack/wiki/Client-server-architecture>.
module Game.LambdaHack.Atomic.PosAtomicRead
  ( PosAtomic(..), posUpdAtomic, posSfxAtomic, iidUpdAtomic, iidSfxAtomic
  , breakUpdAtomic, lidOfPos, seenAtomicCli, seenAtomicSer
#ifdef EXPOSE_INTERNAL
    -- * Internal operations
  , pointsProjBody, posProjBody, singleAid, doubleAid
  , singleContainerStash, singleContainerActor
#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.CmdAtomic
import Game.LambdaHack.Common.Actor
import Game.LambdaHack.Common.ActorState
import Game.LambdaHack.Common.Faction
import Game.LambdaHack.Common.MonadStateRead
import Game.LambdaHack.Common.Perception
import Game.LambdaHack.Common.Point
import Game.LambdaHack.Common.State
import Game.LambdaHack.Common.Types
import Game.LambdaHack.Definition.Defs

-- All functions here that take an atomic action are executed
-- in the state just before the action is executed.

-- | The type representing visibility of atomic commands to factions,
-- based on the position of the command, etc. Note that the server
-- sees and smells all positions. Also note that hearing is not covered
-- because it gives very restricted information, so hearing doesn't equal
-- seeing (and we assume smelling actors get lots of data from smells).
data PosAtomic =
    PosSight LevelId [Point]    -- ^ whomever sees all the positions, notices
  | PosFidAndSight FactionId LevelId [Point]
                                -- ^ observers and the faction notice
  | PosSmell LevelId [Point]    -- ^ whomever smells all the positions, notices
  | PosSightLevels [(LevelId, Point)]
                                -- ^ whomever sees all the positions, notices
  | PosFid FactionId            -- ^ only the faction notices, server doesn't
  | PosFidAndSer FactionId      -- ^ faction and server notices
  | PosSer                      -- ^ only the server notices
  | PosAll                      -- ^ everybody notices
  | PosNone                     -- ^ never broadcasted, but sent manually
  deriving (Int -> PosAtomic -> ShowS
[PosAtomic] -> ShowS
PosAtomic -> String
(Int -> PosAtomic -> ShowS)
-> (PosAtomic -> String)
-> ([PosAtomic] -> ShowS)
-> Show PosAtomic
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PosAtomic] -> ShowS
$cshowList :: [PosAtomic] -> ShowS
show :: PosAtomic -> String
$cshow :: PosAtomic -> String
showsPrec :: Int -> PosAtomic -> ShowS
$cshowsPrec :: Int -> PosAtomic -> ShowS
Show, PosAtomic -> PosAtomic -> Bool
(PosAtomic -> PosAtomic -> Bool)
-> (PosAtomic -> PosAtomic -> Bool) -> Eq PosAtomic
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PosAtomic -> PosAtomic -> Bool
$c/= :: PosAtomic -> PosAtomic -> Bool
== :: PosAtomic -> PosAtomic -> Bool
$c== :: PosAtomic -> PosAtomic -> Bool
Eq)

-- | Produce the positions where the atomic update takes place or, more
-- generally, the conditions under which the update can be noticed by
-- a client.
--
-- The goal of this mechanics is to ensure that atomic commands involving
-- some positions visible by a client convey similar information as the client
-- would get by directly observing the changes
-- of the portion of server state limited to the visible positions.
-- Consequently, when the visible commands are later applied
-- to the client's state, the state stays consistent
-- --- in sync with the server state and correctly limited by visiblity.
-- There is some wiggle room both in what "in sync" and
-- "visible" means and how they propagate through time.
--
-- E.g., @UpdDisplaceActor@ in a black room between two enemy actors,
-- with only one actor carrying a 0-radius light would not be
-- distinguishable by looking at the state (or the screen) from @UpdMoveActor@
-- of the illuminated actor, hence such @UpdDisplaceActor@ should not be
-- observable, but @UpdMoveActor@ in similar cotext would be
-- (or the former should be perceived as the latter).
-- However, to simplify, we assign as strict visibility
-- requirements to @UpdMoveActor@ as to @UpdDisplaceActor@ and fall back
-- to @UpdSpotActor@ (which provides minimal information that does not
-- contradict state) if the visibility is lower.
posUpdAtomic :: MonadStateRead m => UpdAtomic -> m PosAtomic
posUpdAtomic :: UpdAtomic -> m PosAtomic
posUpdAtomic cmd :: UpdAtomic
cmd = case UpdAtomic
cmd of
  UpdRegisterItems{} -> PosAtomic -> m PosAtomic
forall (m :: * -> *) a. Monad m => a -> m a
return PosAtomic
PosNone
  UpdCreateActor _ body :: Actor
body _ -> PosAtomic -> m PosAtomic
forall (m :: * -> *) a. Monad m => a -> m a
return (PosAtomic -> m PosAtomic) -> PosAtomic -> m PosAtomic
forall a b. (a -> b) -> a -> b
$! Actor -> PosAtomic
posProjBody Actor
body
  UpdDestroyActor _ body :: Actor
body _ -> PosAtomic -> m PosAtomic
forall (m :: * -> *) a. Monad m => a -> m a
return (PosAtomic -> m PosAtomic) -> PosAtomic -> m PosAtomic
forall a b. (a -> b) -> a -> b
$! Actor -> PosAtomic
posProjBody Actor
body
  UpdCreateItem _ _ _ _ c :: Container
c -> Container -> m PosAtomic
forall (m :: * -> *). MonadStateRead m => Container -> m PosAtomic
singleContainerStash Container
c
  UpdDestroyItem _ _ _ _ c :: Container
c -> Container -> m PosAtomic
forall (m :: * -> *). MonadStateRead m => Container -> m PosAtomic
singleContainerStash Container
c
  UpdSpotActor _ body :: Actor
body -> PosAtomic -> m PosAtomic
forall (m :: * -> *) a. Monad m => a -> m a
return (PosAtomic -> m PosAtomic) -> PosAtomic -> m PosAtomic
forall a b. (a -> b) -> a -> b
$! Actor -> PosAtomic
posProjBody Actor
body
  UpdLoseActor _ body :: Actor
body -> PosAtomic -> m PosAtomic
forall (m :: * -> *) a. Monad m => a -> m a
return (PosAtomic -> m PosAtomic) -> PosAtomic -> m PosAtomic
forall a b. (a -> b) -> a -> b
$! Actor -> PosAtomic
posProjBody Actor
body
  UpdSpotItem _ _ _ c :: Container
c -> Container -> m PosAtomic
forall (m :: * -> *). MonadStateRead m => Container -> m PosAtomic
singleContainerStash Container
c
  UpdLoseItem _ _ _ c :: Container
c -> Container -> m PosAtomic
forall (m :: * -> *). MonadStateRead m => Container -> m PosAtomic
singleContainerStash Container
c
  UpdSpotItemBag _ c :: Container
c _ -> Container -> m PosAtomic
forall (m :: * -> *). MonadStateRead m => Container -> m PosAtomic
singleContainerStash Container
c
  UpdLoseItemBag _ c :: Container
c _ -> Container -> m PosAtomic
forall (m :: * -> *). MonadStateRead m => Container -> m PosAtomic
singleContainerStash Container
c
  UpdMoveActor aid :: ActorId
aid fromP :: Point
fromP toP :: Point
toP -> 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
    -- Non-projectile actors are never totally isolated from environment;
    -- they hear, feel air movement, etc.
    PosAtomic -> m PosAtomic
forall (m :: * -> *) a. Monad m => a -> m a
return (PosAtomic -> m PosAtomic) -> PosAtomic -> m PosAtomic
forall a b. (a -> b) -> a -> b
$! Actor -> [Point] -> PosAtomic
pointsProjBody Actor
b [Point
fromP, Point
toP]
  UpdWaitActor aid :: ActorId
aid _ _ -> ActorId -> m PosAtomic
forall (m :: * -> *). MonadStateRead m => ActorId -> m PosAtomic
singleAid ActorId
aid
  UpdDisplaceActor source :: ActorId
source target :: ActorId
target -> ActorId -> ActorId -> m PosAtomic
forall (m :: * -> *).
MonadStateRead m =>
ActorId -> ActorId -> m PosAtomic
doubleAid ActorId
source ActorId
target
  UpdMoveItem _ _ aid :: ActorId
aid cstore1 :: CStore
cstore1 cstore2 :: CStore
cstore2 -> do
    Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
    Maybe (LevelId, Point)
mlidPos1 <- Actor -> CStore -> m (Maybe (LevelId, Point))
forall (m :: * -> *).
MonadStateRead m =>
Actor -> CStore -> m (Maybe (LevelId, Point))
lidPosOfStash Actor
b CStore
cstore1
    Maybe (LevelId, Point)
mlidPos2 <- Actor -> CStore -> m (Maybe (LevelId, Point))
forall (m :: * -> *).
MonadStateRead m =>
Actor -> CStore -> m (Maybe (LevelId, Point))
lidPosOfStash Actor
b CStore
cstore2
    let mlidPos :: Maybe (LevelId, Point)
mlidPos = Maybe (LevelId, Point)
mlidPos1 Maybe (LevelId, Point)
-> Maybe (LevelId, Point) -> Maybe (LevelId, Point)
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Maybe (LevelId, Point)
mlidPos2
    PosAtomic -> m PosAtomic
forall (m :: * -> *) a. Monad m => a -> m a
return (PosAtomic -> m PosAtomic) -> PosAtomic -> m PosAtomic
forall a b. (a -> b) -> a -> b
$! PosAtomic
-> ((LevelId, Point) -> PosAtomic)
-> Maybe (LevelId, Point)
-> PosAtomic
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Actor -> PosAtomic
posProjBody Actor
b)
                    (\lidPos :: (LevelId, Point)
lidPos -> [(LevelId, Point)] -> PosAtomic
PosSightLevels [(LevelId, Point)
lidPos, (Actor -> LevelId
blid Actor
b, Actor -> Point
bpos Actor
b)])
                    Maybe (LevelId, Point)
mlidPos
  UpdRefillHP aid :: ActorId
aid _ -> ActorId -> m PosAtomic
forall (m :: * -> *). MonadStateRead m => ActorId -> m PosAtomic
singleAid ActorId
aid
  UpdRefillCalm aid :: ActorId
aid _ -> ActorId -> m PosAtomic
forall (m :: * -> *). MonadStateRead m => ActorId -> m PosAtomic
singleAid ActorId
aid
  UpdTrajectory aid :: ActorId
aid _ _ -> ActorId -> m PosAtomic
forall (m :: * -> *). MonadStateRead m => ActorId -> m PosAtomic
singleAid ActorId
aid
  UpdQuitFaction{} -> PosAtomic -> m PosAtomic
forall (m :: * -> *) a. Monad m => a -> m a
return PosAtomic
PosAll
  UpdSpotStashFaction _ fid :: FactionId
fid lid :: LevelId
lid pos :: Point
pos -> PosAtomic -> m PosAtomic
forall (m :: * -> *) a. Monad m => a -> m a
return (PosAtomic -> m PosAtomic) -> PosAtomic -> m PosAtomic
forall a b. (a -> b) -> a -> b
$! FactionId -> LevelId -> [Point] -> PosAtomic
PosFidAndSight FactionId
fid LevelId
lid [Point
pos]
  UpdLoseStashFaction _ fid :: FactionId
fid lid :: LevelId
lid pos :: Point
pos -> PosAtomic -> m PosAtomic
forall (m :: * -> *) a. Monad m => a -> m a
return (PosAtomic -> m PosAtomic) -> PosAtomic -> m PosAtomic
forall a b. (a -> b) -> a -> b
$! FactionId -> LevelId -> [Point] -> PosAtomic
PosFidAndSight FactionId
fid LevelId
lid [Point
pos]
  UpdLeadFaction fid :: FactionId
fid _ _ -> PosAtomic -> m PosAtomic
forall (m :: * -> *) a. Monad m => a -> m a
return (PosAtomic -> m PosAtomic) -> PosAtomic -> m PosAtomic
forall a b. (a -> b) -> a -> b
$! FactionId -> PosAtomic
PosFidAndSer FactionId
fid
  UpdDiplFaction{} -> PosAtomic -> m PosAtomic
forall (m :: * -> *) a. Monad m => a -> m a
return PosAtomic
PosAll
  UpdDoctrineFaction fid :: FactionId
fid _ _ -> PosAtomic -> m PosAtomic
forall (m :: * -> *) a. Monad m => a -> m a
return (PosAtomic -> m PosAtomic) -> PosAtomic -> m PosAtomic
forall a b. (a -> b) -> a -> b
$! FactionId -> PosAtomic
PosFidAndSer FactionId
fid
  UpdAutoFaction{} -> PosAtomic -> m PosAtomic
forall (m :: * -> *) a. Monad m => a -> m a
return PosAtomic
PosAll
  UpdRecordKill aid :: ActorId
aid _ _ -> ActorId -> m PosAtomic
forall (m :: * -> *). MonadStateRead m => ActorId -> m PosAtomic
singleAid ActorId
aid
  UpdAlterTile lid :: LevelId
lid p :: Point
p _ _ -> PosAtomic -> m PosAtomic
forall (m :: * -> *) a. Monad m => a -> m a
return (PosAtomic -> m PosAtomic) -> PosAtomic -> m PosAtomic
forall a b. (a -> b) -> a -> b
$! LevelId -> [Point] -> PosAtomic
PosSight LevelId
lid [Point
p]
  UpdAlterExplorable{} -> PosAtomic -> m PosAtomic
forall (m :: * -> *) a. Monad m => a -> m a
return PosAtomic
PosAll
    -- Can't have @PosSight@, because we'd end up with many accessible
    -- unknown tiles, but the game reporting 'all seen'.
  UpdAlterGold{} -> PosAtomic -> m PosAtomic
forall (m :: * -> *) a. Monad m => a -> m a
return PosAtomic
PosAll
  UpdSearchTile aid :: ActorId
aid p :: Point
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
    PosAtomic -> m PosAtomic
forall (m :: * -> *) a. Monad m => a -> m a
return (PosAtomic -> m PosAtomic) -> PosAtomic -> m PosAtomic
forall a b. (a -> b) -> a -> b
$! Actor -> [Point] -> PosAtomic
pointsProjBody Actor
b [Actor -> Point
bpos Actor
b, Point
p]
  UpdHideTile aid :: ActorId
aid p :: Point
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
    PosAtomic -> m PosAtomic
forall (m :: * -> *) a. Monad m => a -> m a
return (PosAtomic -> m PosAtomic) -> PosAtomic -> m PosAtomic
forall a b. (a -> b) -> a -> b
$! Actor -> [Point] -> PosAtomic
pointsProjBody Actor
b [Actor -> Point
bpos Actor
b, Point
p]
  UpdSpotTile lid :: LevelId
lid ts :: [(Point, ContentId TileKind)]
ts -> do
    let ps :: [Point]
ps = ((Point, ContentId TileKind) -> Point)
-> [(Point, ContentId TileKind)] -> [Point]
forall a b. (a -> b) -> [a] -> [b]
map (Point, ContentId TileKind) -> Point
forall a b. (a, b) -> a
fst [(Point, ContentId TileKind)]
ts
    PosAtomic -> m PosAtomic
forall (m :: * -> *) a. Monad m => a -> m a
return (PosAtomic -> m PosAtomic) -> PosAtomic -> m PosAtomic
forall a b. (a -> b) -> a -> b
$! LevelId -> [Point] -> PosAtomic
PosSight LevelId
lid [Point]
ps
  UpdLoseTile lid :: LevelId
lid ts :: [(Point, ContentId TileKind)]
ts -> do
    let ps :: [Point]
ps = ((Point, ContentId TileKind) -> Point)
-> [(Point, ContentId TileKind)] -> [Point]
forall a b. (a -> b) -> [a] -> [b]
map (Point, ContentId TileKind) -> Point
forall a b. (a, b) -> a
fst [(Point, ContentId TileKind)]
ts
    PosAtomic -> m PosAtomic
forall (m :: * -> *) a. Monad m => a -> m a
return (PosAtomic -> m PosAtomic) -> PosAtomic -> m PosAtomic
forall a b. (a -> b) -> a -> b
$! LevelId -> [Point] -> PosAtomic
PosSight LevelId
lid [Point]
ps
  UpdSpotEntry lid :: LevelId
lid ts :: [(Point, PlaceEntry)]
ts -> do
    let ps :: [Point]
ps = ((Point, PlaceEntry) -> Point) -> [(Point, PlaceEntry)] -> [Point]
forall a b. (a -> b) -> [a] -> [b]
map (Point, PlaceEntry) -> Point
forall a b. (a, b) -> a
fst [(Point, PlaceEntry)]
ts
    PosAtomic -> m PosAtomic
forall (m :: * -> *) a. Monad m => a -> m a
return (PosAtomic -> m PosAtomic) -> PosAtomic -> m PosAtomic
forall a b. (a -> b) -> a -> b
$! LevelId -> [Point] -> PosAtomic
PosSight LevelId
lid [Point]
ps
  UpdLoseEntry lid :: LevelId
lid ts :: [(Point, PlaceEntry)]
ts -> do
    let ps :: [Point]
ps = ((Point, PlaceEntry) -> Point) -> [(Point, PlaceEntry)] -> [Point]
forall a b. (a -> b) -> [a] -> [b]
map (Point, PlaceEntry) -> Point
forall a b. (a, b) -> a
fst [(Point, PlaceEntry)]
ts
    PosAtomic -> m PosAtomic
forall (m :: * -> *) a. Monad m => a -> m a
return (PosAtomic -> m PosAtomic) -> PosAtomic -> m PosAtomic
forall a b. (a -> b) -> a -> b
$! LevelId -> [Point] -> PosAtomic
PosSight LevelId
lid [Point]
ps
  UpdAlterSmell lid :: LevelId
lid p :: Point
p _ _ -> PosAtomic -> m PosAtomic
forall (m :: * -> *) a. Monad m => a -> m a
return (PosAtomic -> m PosAtomic) -> PosAtomic -> m PosAtomic
forall a b. (a -> b) -> a -> b
$! LevelId -> [Point] -> PosAtomic
PosSmell LevelId
lid [Point
p]
  UpdSpotSmell lid :: LevelId
lid sms :: [(Point, Time)]
sms -> do
    let ps :: [Point]
ps = ((Point, Time) -> Point) -> [(Point, Time)] -> [Point]
forall a b. (a -> b) -> [a] -> [b]
map (Point, Time) -> Point
forall a b. (a, b) -> a
fst [(Point, Time)]
sms
    PosAtomic -> m PosAtomic
forall (m :: * -> *) a. Monad m => a -> m a
return (PosAtomic -> m PosAtomic) -> PosAtomic -> m PosAtomic
forall a b. (a -> b) -> a -> b
$! LevelId -> [Point] -> PosAtomic
PosSmell LevelId
lid [Point]
ps
  UpdLoseSmell lid :: LevelId
lid sms :: [(Point, Time)]
sms -> do
    let ps :: [Point]
ps = ((Point, Time) -> Point) -> [(Point, Time)] -> [Point]
forall a b. (a -> b) -> [a] -> [b]
map (Point, Time) -> Point
forall a b. (a, b) -> a
fst [(Point, Time)]
sms
    PosAtomic -> m PosAtomic
forall (m :: * -> *) a. Monad m => a -> m a
return (PosAtomic -> m PosAtomic) -> PosAtomic -> m PosAtomic
forall a b. (a -> b) -> a -> b
$! LevelId -> [Point] -> PosAtomic
PosSmell LevelId
lid [Point]
ps
  UpdTimeItem _ c :: Container
c _ _ -> Container -> m PosAtomic
forall (m :: * -> *). MonadStateRead m => Container -> m PosAtomic
singleContainerStash Container
c
  UpdAgeGame _ -> PosAtomic -> m PosAtomic
forall (m :: * -> *) a. Monad m => a -> m a
return PosAtomic
PosAll
  UpdUnAgeGame _ -> PosAtomic -> m PosAtomic
forall (m :: * -> *) a. Monad m => a -> m a
return PosAtomic
PosAll
  UpdDiscover c :: Container
c _ _ _ -> Container -> m PosAtomic
forall (m :: * -> *). MonadStateRead m => Container -> m PosAtomic
singleContainerActor Container
c
    -- This implies other factions applying items from their inventory,
    -- when we can't see the position of the stash, won't Id the item
    -- for us, even when notice item usage. Thrown items will Id, though,
    -- just as triggering items from the floor or embedded items.
  UpdCover c :: Container
c _ _ _ -> Container -> m PosAtomic
forall (m :: * -> *). MonadStateRead m => Container -> m PosAtomic
singleContainerActor Container
c
  UpdDiscoverKind c :: Container
c _ _ -> Container -> m PosAtomic
forall (m :: * -> *). MonadStateRead m => Container -> m PosAtomic
singleContainerActor Container
c
  UpdCoverKind c :: Container
c _ _ -> Container -> m PosAtomic
forall (m :: * -> *). MonadStateRead m => Container -> m PosAtomic
singleContainerActor Container
c
  UpdDiscoverAspect c :: Container
c _ _ -> Container -> m PosAtomic
forall (m :: * -> *). MonadStateRead m => Container -> m PosAtomic
singleContainerActor Container
c
  UpdCoverAspect c :: Container
c _ _ -> Container -> m PosAtomic
forall (m :: * -> *). MonadStateRead m => Container -> m PosAtomic
singleContainerActor Container
c
  UpdDiscoverServer{} -> PosAtomic -> m PosAtomic
forall (m :: * -> *) a. Monad m => a -> m a
return PosAtomic
PosSer
  UpdCoverServer{} -> PosAtomic -> m PosAtomic
forall (m :: * -> *) a. Monad m => a -> m a
return PosAtomic
PosSer
  UpdPerception{} -> PosAtomic -> m PosAtomic
forall (m :: * -> *) a. Monad m => a -> m a
return PosAtomic
PosNone
  UpdRestart fid :: FactionId
fid _ _ _ _ _ -> PosAtomic -> m PosAtomic
forall (m :: * -> *) a. Monad m => a -> m a
return (PosAtomic -> m PosAtomic) -> PosAtomic -> m PosAtomic
forall a b. (a -> b) -> a -> b
$! FactionId -> PosAtomic
PosFid FactionId
fid
  UpdRestartServer _ -> PosAtomic -> m PosAtomic
forall (m :: * -> *) a. Monad m => a -> m a
return PosAtomic
PosSer
  UpdResume _ _ -> PosAtomic -> m PosAtomic
forall (m :: * -> *) a. Monad m => a -> m a
return PosAtomic
PosNone
  UpdResumeServer _ -> PosAtomic -> m PosAtomic
forall (m :: * -> *) a. Monad m => a -> m a
return PosAtomic
PosSer
  UpdKillExit fid :: FactionId
fid -> PosAtomic -> m PosAtomic
forall (m :: * -> *) a. Monad m => a -> m a
return (PosAtomic -> m PosAtomic) -> PosAtomic -> m PosAtomic
forall a b. (a -> b) -> a -> b
$! FactionId -> PosAtomic
PosFid FactionId
fid
  UpdWriteSave -> PosAtomic -> m PosAtomic
forall (m :: * -> *) a. Monad m => a -> m a
return PosAtomic
PosAll
  UpdHearFid fid :: FactionId
fid _ _ -> PosAtomic -> m PosAtomic
forall (m :: * -> *) a. Monad m => a -> m a
return (PosAtomic -> m PosAtomic) -> PosAtomic -> m PosAtomic
forall a b. (a -> b) -> a -> b
$! FactionId -> PosAtomic
PosFid FactionId
fid

-- | Produce the positions where the atomic special effect takes place.
posSfxAtomic :: MonadStateRead m => SfxAtomic -> m PosAtomic
posSfxAtomic :: SfxAtomic -> m PosAtomic
posSfxAtomic cmd :: SfxAtomic
cmd = case SfxAtomic
cmd of
  SfxStrike _ target :: ActorId
target _ -> ActorId -> m PosAtomic
forall (m :: * -> *). MonadStateRead m => ActorId -> m PosAtomic
singleAid ActorId
target
  SfxRecoil _ target :: ActorId
target _ -> ActorId -> m PosAtomic
forall (m :: * -> *). MonadStateRead m => ActorId -> m PosAtomic
singleAid ActorId
target
  SfxSteal _ target :: ActorId
target _ -> ActorId -> m PosAtomic
forall (m :: * -> *). MonadStateRead m => ActorId -> m PosAtomic
singleAid ActorId
target
  SfxRelease _ target :: ActorId
target _ -> ActorId -> m PosAtomic
forall (m :: * -> *). MonadStateRead m => ActorId -> m PosAtomic
singleAid ActorId
target
  SfxProject aid :: ActorId
aid _ -> ActorId -> m PosAtomic
forall (m :: * -> *). MonadStateRead m => ActorId -> m PosAtomic
singleAid ActorId
aid
  SfxReceive aid :: ActorId
aid _ -> ActorId -> m PosAtomic
forall (m :: * -> *). MonadStateRead m => ActorId -> m PosAtomic
singleAid ActorId
aid
  SfxApply aid :: ActorId
aid _ -> ActorId -> m PosAtomic
forall (m :: * -> *). MonadStateRead m => ActorId -> m PosAtomic
singleAid ActorId
aid
  SfxCheck aid :: ActorId
aid _ -> ActorId -> m PosAtomic
forall (m :: * -> *). MonadStateRead m => ActorId -> m PosAtomic
singleAid ActorId
aid
  SfxTrigger aid :: ActorId
aid lid :: LevelId
lid p :: Point
p _ -> 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
    PosAtomic -> m PosAtomic
forall (m :: * -> *) a. Monad m => a -> m a
return (PosAtomic -> m PosAtomic) -> PosAtomic -> m PosAtomic
forall a b. (a -> b) -> a -> b
$! [(LevelId, Point)] -> PosAtomic
PosSightLevels [(LevelId
lid, Point
p), (Actor -> LevelId
blid Actor
body, Actor -> Point
bpos Actor
body)]
      -- @PosFidAndSightLevels@ would be better, but no big deal
  SfxShun aid :: ActorId
aid lid :: LevelId
lid p :: Point
p _ -> 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
    PosAtomic -> m PosAtomic
forall (m :: * -> *) a. Monad m => a -> m a
return (PosAtomic -> m PosAtomic) -> PosAtomic -> m PosAtomic
forall a b. (a -> b) -> a -> b
$! [(LevelId, Point)] -> PosAtomic
PosSightLevels [(LevelId
lid, Point
p), (Actor -> LevelId
blid Actor
body, Actor -> Point
bpos Actor
body)]
  SfxEffect _ aid :: ActorId
aid _ _ _ -> ActorId -> m PosAtomic
forall (m :: * -> *). MonadStateRead m => ActorId -> m PosAtomic
singleAid ActorId
aid  -- sometimes we don't see source, OK
  SfxItemApplied _ c :: Container
c -> Container -> m PosAtomic
forall (m :: * -> *). MonadStateRead m => Container -> m PosAtomic
singleContainerActor Container
c
  SfxMsgFid fid :: FactionId
fid _ -> PosAtomic -> m PosAtomic
forall (m :: * -> *) a. Monad m => a -> m a
return (PosAtomic -> m PosAtomic) -> PosAtomic -> m PosAtomic
forall a b. (a -> b) -> a -> b
$! FactionId -> PosAtomic
PosFid FactionId
fid
  SfxRestart -> PosAtomic -> m PosAtomic
forall (m :: * -> *) a. Monad m => a -> m a
return PosAtomic
PosAll
  SfxCollideTile aid :: ActorId
aid _ -> ActorId -> m PosAtomic
forall (m :: * -> *). MonadStateRead m => ActorId -> m PosAtomic
singleAid ActorId
aid
  SfxTaunt _ aid :: ActorId
aid -> ActorId -> m PosAtomic
forall (m :: * -> *). MonadStateRead m => ActorId -> m PosAtomic
singleAid ActorId
aid

-- | All items introduced by the atomic command, to be used in it.
iidUpdAtomic :: UpdAtomic -> [ItemId]
iidUpdAtomic :: UpdAtomic -> [ItemId]
iidUpdAtomic cmd :: UpdAtomic
cmd = case UpdAtomic
cmd of
  UpdRegisterItems{} -> []
  UpdCreateActor{} -> []  -- iids and items needed even on server
  UpdDestroyActor{} -> []
  UpdCreateItem{} -> []
  UpdDestroyItem{} -> []
  UpdSpotActor _ body :: Actor
body -> Actor -> [ItemId]
getCarriedIidsAndTrunk Actor
body
  UpdLoseActor{} -> []  -- already seen, so items known
  UpdSpotItem _ iid :: ItemId
iid _ _ -> [ItemId
iid]
  UpdLoseItem{} -> []
  UpdSpotItemBag _ _ bag :: ItemBag
bag -> ItemBag -> [ItemId]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys ItemBag
bag
  UpdLoseItemBag{} -> []
  UpdMoveActor{} -> []
  UpdWaitActor{} -> []
  UpdDisplaceActor{} -> []
  UpdMoveItem{} -> []
  UpdRefillHP{} -> []
  UpdRefillCalm{} -> []
  UpdTrajectory{} -> []
  UpdQuitFaction{} -> []
  UpdSpotStashFaction{} -> []
  UpdLoseStashFaction{} -> []
  UpdLeadFaction{} -> []
  UpdDiplFaction{} -> []
  UpdDoctrineFaction{} -> []
  UpdAutoFaction{} -> []
  UpdRecordKill{} -> []
  UpdAlterTile{} -> []
  UpdAlterExplorable{} -> []
  UpdAlterGold{} -> []
  UpdSearchTile{} -> []
  UpdHideTile{} -> []
  UpdSpotTile{} -> []
  UpdLoseTile{} -> []
  UpdSpotEntry{} -> []
  UpdLoseEntry{} -> []
  UpdAlterSmell{} -> []
  UpdSpotSmell{} -> []
  UpdLoseSmell{} -> []
  UpdTimeItem iid :: ItemId
iid _ _ _ -> [ItemId
iid]
  UpdAgeGame{} -> []
  UpdUnAgeGame{} -> []
  UpdDiscover _ iid :: ItemId
iid _ _ -> [ItemId
iid]
  UpdCover _ iid :: ItemId
iid _ _ -> [ItemId
iid]
  UpdDiscoverKind{} -> []
  UpdCoverKind{} -> []
  UpdDiscoverAspect _ iid :: ItemId
iid _ -> [ItemId
iid]
  UpdCoverAspect _ iid :: ItemId
iid _ -> [ItemId
iid]
  UpdDiscoverServer{} -> []  -- never sent to clients
  UpdCoverServer{} -> []
  UpdPerception{} -> []
  UpdRestart{} -> []
  UpdRestartServer{} -> []
  UpdResume{} -> []
  UpdResumeServer{} -> []
  UpdKillExit{} -> []
  UpdWriteSave -> []
  UpdHearFid{} -> []

-- | All items introduced by the atomic special effect, to be used in it.
iidSfxAtomic :: SfxAtomic -> [ItemId]
iidSfxAtomic :: SfxAtomic -> [ItemId]
iidSfxAtomic cmd :: SfxAtomic
cmd = case SfxAtomic
cmd of
  SfxStrike _ _ iid :: ItemId
iid -> [ItemId
iid]
  SfxRecoil _ _ iid :: ItemId
iid -> [ItemId
iid]
  SfxSteal _ _ iid :: ItemId
iid -> [ItemId
iid]
  SfxRelease _ _ iid :: ItemId
iid -> [ItemId
iid]
  SfxProject _ iid :: ItemId
iid -> [ItemId
iid]
  SfxReceive _ iid :: ItemId
iid -> [ItemId
iid]
  SfxApply _ iid :: ItemId
iid -> [ItemId
iid]
  SfxCheck _ iid :: ItemId
iid -> [ItemId
iid]
  SfxTrigger{} -> []
  SfxShun{} -> []
  SfxEffect{} -> []
  SfxItemApplied iid :: ItemId
iid _ -> [ItemId
iid]
  SfxMsgFid{} -> []
  SfxRestart{} -> []
  SfxCollideTile{} -> []
  SfxTaunt{} -> []

pointsProjBody :: Actor -> [Point] -> PosAtomic
pointsProjBody :: Actor -> [Point] -> PosAtomic
pointsProjBody body :: Actor
body ps :: [Point]
ps =
  if Actor -> Bool
bproj Actor
body
  then LevelId -> [Point] -> PosAtomic
PosSight (Actor -> LevelId
blid Actor
body) [Point]
ps
  else FactionId -> LevelId -> [Point] -> PosAtomic
PosFidAndSight (Actor -> FactionId
bfid Actor
body) (Actor -> LevelId
blid Actor
body) [Point]
ps

posProjBody :: Actor -> PosAtomic
posProjBody :: Actor -> PosAtomic
posProjBody body :: Actor
body = Actor -> [Point] -> PosAtomic
pointsProjBody Actor
body [Actor -> Point
bpos Actor
body]

singleAid :: MonadStateRead m => ActorId -> m PosAtomic
singleAid :: ActorId -> m PosAtomic
singleAid aid :: ActorId
aid = 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
  PosAtomic -> m PosAtomic
forall (m :: * -> *) a. Monad m => a -> m a
return (PosAtomic -> m PosAtomic) -> PosAtomic -> m PosAtomic
forall a b. (a -> b) -> a -> b
$! Actor -> PosAtomic
posProjBody Actor
body

doubleAid :: MonadStateRead m => ActorId -> ActorId -> m PosAtomic
doubleAid :: ActorId -> ActorId -> m PosAtomic
doubleAid source :: ActorId
source target :: ActorId
target = do
  Actor
sb <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
source
  Actor
tb <- (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
target
  -- No @PosFidAndSight@ instead of @PosSight@, because both positions
  -- need to be seen to have the enemy actor in client's state.
  PosAtomic -> m PosAtomic
forall (m :: * -> *) a. Monad m => a -> m a
return (PosAtomic -> m PosAtomic) -> PosAtomic -> m PosAtomic
forall a b. (a -> b) -> a -> b
$! Bool -> PosAtomic -> PosAtomic
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Actor -> LevelId
blid Actor
sb LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> LevelId
blid Actor
tb) (PosAtomic -> PosAtomic) -> PosAtomic -> PosAtomic
forall a b. (a -> b) -> a -> b
$ LevelId -> [Point] -> PosAtomic
PosSight (Actor -> LevelId
blid Actor
sb) [Actor -> Point
bpos Actor
sb, Actor -> Point
bpos Actor
tb]

singleContainerStash :: MonadStateRead m => Container -> m PosAtomic
singleContainerStash :: Container -> m PosAtomic
singleContainerStash (CFloor lid :: LevelId
lid p :: Point
p) = PosAtomic -> m PosAtomic
forall (m :: * -> *) a. Monad m => a -> m a
return (PosAtomic -> m PosAtomic) -> PosAtomic -> m PosAtomic
forall a b. (a -> b) -> a -> b
$! LevelId -> [Point] -> PosAtomic
PosSight LevelId
lid [Point
p]
singleContainerStash (CEmbed lid :: LevelId
lid p :: Point
p) = PosAtomic -> m PosAtomic
forall (m :: * -> *) a. Monad m => a -> m a
return (PosAtomic -> m PosAtomic) -> PosAtomic -> m PosAtomic
forall a b. (a -> b) -> a -> b
$! LevelId -> [Point] -> PosAtomic
PosSight LevelId
lid [Point
p]
singleContainerStash (CActor aid :: ActorId
aid cstore :: CStore
cstore) = do
  Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
  Maybe (LevelId, Point)
mlidPos <- Actor -> CStore -> m (Maybe (LevelId, Point))
forall (m :: * -> *).
MonadStateRead m =>
Actor -> CStore -> m (Maybe (LevelId, Point))
lidPosOfStash Actor
b CStore
cstore
  PosAtomic -> m PosAtomic
forall (m :: * -> *) a. Monad m => a -> m a
return (PosAtomic -> m PosAtomic) -> PosAtomic -> m PosAtomic
forall a b. (a -> b) -> a -> b
$! PosAtomic
-> ((LevelId, Point) -> PosAtomic)
-> Maybe (LevelId, Point)
-> PosAtomic
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Actor -> PosAtomic
posProjBody Actor
b)
                  (\lidPos :: (LevelId, Point)
lidPos -> [(LevelId, Point)] -> PosAtomic
PosSightLevels [(LevelId, Point)
lidPos, (Actor -> LevelId
blid Actor
b, Actor -> Point
bpos Actor
b)])
                    -- the actor's position is needed so that a message
                    -- about the actor is not sent to a client that doesn't
                    -- know the actor; actor's faction is ignored, because
                    -- for these operations actor doesn't vanish
                  Maybe (LevelId, Point)
mlidPos
singleContainerStash (CTrunk fid :: FactionId
fid lid :: LevelId
lid p :: Point
p) = PosAtomic -> m PosAtomic
forall (m :: * -> *) a. Monad m => a -> m a
return (PosAtomic -> m PosAtomic) -> PosAtomic -> m PosAtomic
forall a b. (a -> b) -> a -> b
$! FactionId -> LevelId -> [Point] -> PosAtomic
PosFidAndSight FactionId
fid LevelId
lid [Point
p]

singleContainerActor :: MonadStateRead m => Container -> m PosAtomic
singleContainerActor :: Container -> m PosAtomic
singleContainerActor (CFloor lid :: LevelId
lid p :: Point
p) = PosAtomic -> m PosAtomic
forall (m :: * -> *) a. Monad m => a -> m a
return (PosAtomic -> m PosAtomic) -> PosAtomic -> m PosAtomic
forall a b. (a -> b) -> a -> b
$! LevelId -> [Point] -> PosAtomic
PosSight LevelId
lid [Point
p]
singleContainerActor (CEmbed lid :: LevelId
lid p :: Point
p) = PosAtomic -> m PosAtomic
forall (m :: * -> *) a. Monad m => a -> m a
return (PosAtomic -> m PosAtomic) -> PosAtomic -> m PosAtomic
forall a b. (a -> b) -> a -> b
$! LevelId -> [Point] -> PosAtomic
PosSight LevelId
lid [Point
p]
singleContainerActor (CActor 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
  PosAtomic -> m PosAtomic
forall (m :: * -> *) a. Monad m => a -> m a
return (PosAtomic -> m PosAtomic) -> PosAtomic -> m PosAtomic
forall a b. (a -> b) -> a -> b
$! Actor -> PosAtomic
posProjBody Actor
b
    -- stash position is ignored, because for these operations, nothing
    -- is added to that position; the store name is only used for flavour text
singleContainerActor (CTrunk fid :: FactionId
fid lid :: LevelId
lid p :: Point
p) = PosAtomic -> m PosAtomic
forall (m :: * -> *) a. Monad m => a -> m a
return (PosAtomic -> m PosAtomic) -> PosAtomic -> m PosAtomic
forall a b. (a -> b) -> a -> b
$! FactionId -> LevelId -> [Point] -> PosAtomic
PosFidAndSight FactionId
fid LevelId
lid [Point
p]

lidPosOfStash :: MonadStateRead m
              => Actor -> CStore -> m (Maybe (LevelId, Point))
lidPosOfStash :: Actor -> CStore -> m (Maybe (LevelId, Point))
lidPosOfStash b :: Actor
b cstore :: CStore
cstore =
  case CStore
cstore of
    CStash -> do
      Maybe (LevelId, Point)
mstash <- (State -> Maybe (LevelId, Point)) -> m (Maybe (LevelId, Point))
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Maybe (LevelId, Point)) -> m (Maybe (LevelId, Point)))
-> (State -> Maybe (LevelId, Point)) -> m (Maybe (LevelId, Point))
forall a b. (a -> b) -> a -> b
$ \s :: State
s -> Faction -> Maybe (LevelId, Point)
gstash (Faction -> Maybe (LevelId, Point))
-> Faction -> Maybe (LevelId, Point)
forall a b. (a -> b) -> a -> b
$ State -> FactionDict
sfactionD State
s FactionDict -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
b
      case Maybe (LevelId, Point)
mstash of
        Just{} -> Maybe (LevelId, Point) -> m (Maybe (LevelId, Point))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (LevelId, Point)
mstash
        Nothing -> String -> m (Maybe (LevelId, Point))
forall a. (?callStack::CallStack) => String -> a
error (String -> m (Maybe (LevelId, Point)))
-> String -> m (Maybe (LevelId, Point))
forall a b. (a -> b) -> a -> b
$ "manipulating void stash" String -> Actor -> String
forall v. Show v => String -> v -> String
`showFailure` Actor
b
    _ -> Maybe (LevelId, Point) -> m (Maybe (LevelId, Point))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (LevelId, Point)
forall a. Maybe a
Nothing

-- | Decompose an atomic action that is outside a client's visiblity.
-- The decomposed actions give less information that the original command,
-- but some of them may fall within the visibility range of the client.
-- The original action may give more information than even the total sum
-- of all actions it's broken into. E.g., @UpdMoveActor@
-- informs about the continued existence of the actor between
-- moves vs popping out of existence and then back in.
--
-- This is computed in server's @State@ from before performing the command.
breakUpdAtomic :: MonadStateRead m => UpdAtomic -> m [UpdAtomic]
breakUpdAtomic :: UpdAtomic -> m [UpdAtomic]
breakUpdAtomic cmd :: UpdAtomic
cmd = case UpdAtomic
cmd of
  UpdCreateItem verbose :: Bool
verbose iid :: ItemId
iid item :: Item
item kit :: ItemQuant
kit (CActor aid :: ActorId
aid CStash) -> do
    Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
    Maybe (LevelId, Point)
mstash <- (State -> Maybe (LevelId, Point)) -> m (Maybe (LevelId, Point))
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Maybe (LevelId, Point)) -> m (Maybe (LevelId, Point)))
-> (State -> Maybe (LevelId, Point)) -> m (Maybe (LevelId, Point))
forall a b. (a -> b) -> a -> b
$ \s :: State
s -> Faction -> Maybe (LevelId, Point)
gstash (Faction -> Maybe (LevelId, Point))
-> Faction -> Maybe (LevelId, Point)
forall a b. (a -> b) -> a -> b
$ State -> FactionDict
sfactionD State
s FactionDict -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
b
    case Maybe (LevelId, Point)
mstash of
      Just (lid :: LevelId
lid, pos :: Point
pos) ->
        [UpdAtomic] -> m [UpdAtomic]
forall (m :: * -> *) a. Monad m => a -> m a
return [Bool -> ItemId -> Item -> ItemQuant -> Container -> UpdAtomic
UpdCreateItem Bool
verbose ItemId
iid Item
item ItemQuant
kit (LevelId -> Point -> Container
CFloor LevelId
lid Point
pos)]
      Nothing -> String -> m [UpdAtomic]
forall a. (?callStack::CallStack) => String -> a
error (String -> m [UpdAtomic]) -> String -> m [UpdAtomic]
forall a b. (a -> b) -> a -> b
$ "manipulating void stash" String -> (ActorId, Actor, Item) -> String
forall v. Show v => String -> v -> String
`showFailure` (ActorId
aid, Actor
b, Item
item)
  UpdDestroyItem verbose :: Bool
verbose iid :: ItemId
iid item :: Item
item kit :: ItemQuant
kit (CActor aid :: ActorId
aid CStash) -> do
    Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
    Maybe (LevelId, Point)
mstash <- (State -> Maybe (LevelId, Point)) -> m (Maybe (LevelId, Point))
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Maybe (LevelId, Point)) -> m (Maybe (LevelId, Point)))
-> (State -> Maybe (LevelId, Point)) -> m (Maybe (LevelId, Point))
forall a b. (a -> b) -> a -> b
$ \s :: State
s -> Faction -> Maybe (LevelId, Point)
gstash (Faction -> Maybe (LevelId, Point))
-> Faction -> Maybe (LevelId, Point)
forall a b. (a -> b) -> a -> b
$ State -> FactionDict
sfactionD State
s FactionDict -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
b
    case Maybe (LevelId, Point)
mstash of
      Just (lid :: LevelId
lid, pos :: Point
pos) ->
        [UpdAtomic] -> m [UpdAtomic]
forall (m :: * -> *) a. Monad m => a -> m a
return [Bool -> ItemId -> Item -> ItemQuant -> Container -> UpdAtomic
UpdDestroyItem Bool
verbose ItemId
iid Item
item ItemQuant
kit (LevelId -> Point -> Container
CFloor LevelId
lid Point
pos)]
      Nothing -> String -> m [UpdAtomic]
forall a. (?callStack::CallStack) => String -> a
error (String -> m [UpdAtomic]) -> String -> m [UpdAtomic]
forall a b. (a -> b) -> a -> b
$ "manipulating void stash" String -> (ActorId, Actor, Item) -> String
forall v. Show v => String -> v -> String
`showFailure` (ActorId
aid, Actor
b, Item
item)
  UpdSpotItem verbose :: Bool
verbose iid :: ItemId
iid kit :: ItemQuant
kit (CActor aid :: ActorId
aid CStash) -> do
    Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
    Maybe (LevelId, Point)
mstash <- (State -> Maybe (LevelId, Point)) -> m (Maybe (LevelId, Point))
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Maybe (LevelId, Point)) -> m (Maybe (LevelId, Point)))
-> (State -> Maybe (LevelId, Point)) -> m (Maybe (LevelId, Point))
forall a b. (a -> b) -> a -> b
$ \s :: State
s -> Faction -> Maybe (LevelId, Point)
gstash (Faction -> Maybe (LevelId, Point))
-> Faction -> Maybe (LevelId, Point)
forall a b. (a -> b) -> a -> b
$ State -> FactionDict
sfactionD State
s FactionDict -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
b
    case Maybe (LevelId, Point)
mstash of
      Just (lid :: LevelId
lid, pos :: Point
pos) -> [UpdAtomic] -> m [UpdAtomic]
forall (m :: * -> *) a. Monad m => a -> m a
return [Bool -> ItemId -> ItemQuant -> Container -> UpdAtomic
UpdSpotItem Bool
verbose ItemId
iid ItemQuant
kit (LevelId -> Point -> Container
CFloor LevelId
lid Point
pos)]
      Nothing -> String -> m [UpdAtomic]
forall a. (?callStack::CallStack) => String -> a
error (String -> m [UpdAtomic]) -> String -> m [UpdAtomic]
forall a b. (a -> b) -> a -> b
$ "manipulating void stash" String -> (ActorId, Actor, ItemId) -> String
forall v. Show v => String -> v -> String
`showFailure` (ActorId
aid, Actor
b, ItemId
iid)
  UpdLoseItem verbose :: Bool
verbose iid :: ItemId
iid kit :: ItemQuant
kit (CActor aid :: ActorId
aid CStash) -> do
    Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
    Maybe (LevelId, Point)
mstash <- (State -> Maybe (LevelId, Point)) -> m (Maybe (LevelId, Point))
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Maybe (LevelId, Point)) -> m (Maybe (LevelId, Point)))
-> (State -> Maybe (LevelId, Point)) -> m (Maybe (LevelId, Point))
forall a b. (a -> b) -> a -> b
$ \s :: State
s -> Faction -> Maybe (LevelId, Point)
gstash (Faction -> Maybe (LevelId, Point))
-> Faction -> Maybe (LevelId, Point)
forall a b. (a -> b) -> a -> b
$ State -> FactionDict
sfactionD State
s FactionDict -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
b
    case Maybe (LevelId, Point)
mstash of
      Just (lid :: LevelId
lid, pos :: Point
pos) -> [UpdAtomic] -> m [UpdAtomic]
forall (m :: * -> *) a. Monad m => a -> m a
return [Bool -> ItemId -> ItemQuant -> Container -> UpdAtomic
UpdLoseItem Bool
verbose ItemId
iid ItemQuant
kit (LevelId -> Point -> Container
CFloor LevelId
lid Point
pos)]
      Nothing -> String -> m [UpdAtomic]
forall a. (?callStack::CallStack) => String -> a
error (String -> m [UpdAtomic]) -> String -> m [UpdAtomic]
forall a b. (a -> b) -> a -> b
$ "manipulating void stash" String -> (ActorId, Actor, ItemId) -> String
forall v. Show v => String -> v -> String
`showFailure` (ActorId
aid, Actor
b, ItemId
iid)
  UpdSpotItemBag verbose :: Bool
verbose (CActor aid :: ActorId
aid CStash) bag :: ItemBag
bag -> do
    Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
    Maybe (LevelId, Point)
mstash <- (State -> Maybe (LevelId, Point)) -> m (Maybe (LevelId, Point))
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Maybe (LevelId, Point)) -> m (Maybe (LevelId, Point)))
-> (State -> Maybe (LevelId, Point)) -> m (Maybe (LevelId, Point))
forall a b. (a -> b) -> a -> b
$ \s :: State
s -> Faction -> Maybe (LevelId, Point)
gstash (Faction -> Maybe (LevelId, Point))
-> Faction -> Maybe (LevelId, Point)
forall a b. (a -> b) -> a -> b
$ State -> FactionDict
sfactionD State
s FactionDict -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
b
    case Maybe (LevelId, Point)
mstash of
      Just (lid :: LevelId
lid, pos :: Point
pos) -> [UpdAtomic] -> m [UpdAtomic]
forall (m :: * -> *) a. Monad m => a -> m a
return [Bool -> Container -> ItemBag -> UpdAtomic
UpdSpotItemBag Bool
verbose (LevelId -> Point -> Container
CFloor LevelId
lid Point
pos) ItemBag
bag]
      Nothing -> String -> m [UpdAtomic]
forall a. (?callStack::CallStack) => String -> a
error (String -> m [UpdAtomic]) -> String -> m [UpdAtomic]
forall a b. (a -> b) -> a -> b
$ "manipulating void stash" String -> (ActorId, Actor, ItemBag) -> String
forall v. Show v => String -> v -> String
`showFailure` (ActorId
aid, Actor
b, ItemBag
bag)
  UpdLoseItemBag verbose :: Bool
verbose (CActor aid :: ActorId
aid CStash) bag :: ItemBag
bag -> do
    Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
    Maybe (LevelId, Point)
mstash <- (State -> Maybe (LevelId, Point)) -> m (Maybe (LevelId, Point))
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Maybe (LevelId, Point)) -> m (Maybe (LevelId, Point)))
-> (State -> Maybe (LevelId, Point)) -> m (Maybe (LevelId, Point))
forall a b. (a -> b) -> a -> b
$ \s :: State
s -> Faction -> Maybe (LevelId, Point)
gstash (Faction -> Maybe (LevelId, Point))
-> Faction -> Maybe (LevelId, Point)
forall a b. (a -> b) -> a -> b
$ State -> FactionDict
sfactionD State
s FactionDict -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
b
    case Maybe (LevelId, Point)
mstash of
      Just (lid :: LevelId
lid, pos :: Point
pos) -> [UpdAtomic] -> m [UpdAtomic]
forall (m :: * -> *) a. Monad m => a -> m a
return [Bool -> Container -> ItemBag -> UpdAtomic
UpdLoseItemBag Bool
verbose (LevelId -> Point -> Container
CFloor LevelId
lid Point
pos) ItemBag
bag]
      Nothing -> String -> m [UpdAtomic]
forall a. (?callStack::CallStack) => String -> a
error (String -> m [UpdAtomic]) -> String -> m [UpdAtomic]
forall a b. (a -> b) -> a -> b
$ "manipulating void stash" String -> (ActorId, Actor, ItemBag) -> String
forall v. Show v => String -> v -> String
`showFailure` (ActorId
aid, Actor
b, ItemBag
bag)
  UpdMoveItem iid :: ItemId
iid k :: Int
k aid :: ActorId
aid CStash store2 :: CStore
store2 -> 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
    ItemBag
bag <- (State -> ItemBag) -> m ItemBag
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemBag) -> m ItemBag)
-> (State -> ItemBag) -> m ItemBag
forall a b. (a -> b) -> a -> b
$ Actor -> CStore -> State -> ItemBag
getBodyStoreBag Actor
b CStore
CStash
    let (k1 :: Int
k1, it1 :: ItemTimers
it1) = ItemBag
bag ItemBag -> ItemId -> ItemQuant
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ItemId
iid
        kit :: ItemQuant
kit = Bool -> ItemQuant -> ItemQuant
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
k1) (Int
k, Int -> ItemTimers -> ItemTimers
forall a. Int -> [a] -> [a]
take Int
k ItemTimers
it1)
    Maybe (LevelId, Point)
mstash <- (State -> Maybe (LevelId, Point)) -> m (Maybe (LevelId, Point))
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Maybe (LevelId, Point)) -> m (Maybe (LevelId, Point)))
-> (State -> Maybe (LevelId, Point)) -> m (Maybe (LevelId, Point))
forall a b. (a -> b) -> a -> b
$ \s :: State
s -> Faction -> Maybe (LevelId, Point)
gstash (Faction -> Maybe (LevelId, Point))
-> Faction -> Maybe (LevelId, Point)
forall a b. (a -> b) -> a -> b
$ State -> FactionDict
sfactionD State
s FactionDict -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
b
    case Maybe (LevelId, Point)
mstash of
      Just (lid :: LevelId
lid, pos :: Point
pos) -> [UpdAtomic] -> m [UpdAtomic]
forall (m :: * -> *) a. Monad m => a -> m a
return [ Bool -> ItemId -> ItemQuant -> Container -> UpdAtomic
UpdLoseItem Bool
True ItemId
iid ItemQuant
kit (LevelId -> Point -> Container
CFloor LevelId
lid Point
pos)
                                , Bool -> ItemId -> ItemQuant -> Container -> UpdAtomic
UpdSpotItem Bool
True ItemId
iid ItemQuant
kit (ActorId -> CStore -> Container
CActor ActorId
aid CStore
store2) ]
      Nothing -> String -> m [UpdAtomic]
forall a. (?callStack::CallStack) => String -> a
error (String -> m [UpdAtomic]) -> String -> m [UpdAtomic]
forall a b. (a -> b) -> a -> b
$ "manipulating void stash" String -> (ActorId, Actor, ItemId) -> String
forall v. Show v => String -> v -> String
`showFailure` (ActorId
aid, Actor
b, ItemId
iid)
  UpdMoveItem iid :: ItemId
iid k :: Int
k aid :: ActorId
aid store1 :: CStore
store1 CStash -> 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
    ItemBag
bag <- (State -> ItemBag) -> m ItemBag
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemBag) -> m ItemBag)
-> (State -> ItemBag) -> m ItemBag
forall a b. (a -> b) -> a -> b
$ Actor -> CStore -> State -> ItemBag
getBodyStoreBag Actor
b CStore
store1
    let (k1 :: Int
k1, it1 :: ItemTimers
it1) = ItemBag
bag ItemBag -> ItemId -> ItemQuant
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ItemId
iid
        kit :: ItemQuant
kit = Bool -> ItemQuant -> ItemQuant
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
k1) (Int
k, Int -> ItemTimers -> ItemTimers
forall a. Int -> [a] -> [a]
take Int
k ItemTimers
it1)
    Maybe (LevelId, Point)
mstash <- (State -> Maybe (LevelId, Point)) -> m (Maybe (LevelId, Point))
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Maybe (LevelId, Point)) -> m (Maybe (LevelId, Point)))
-> (State -> Maybe (LevelId, Point)) -> m (Maybe (LevelId, Point))
forall a b. (a -> b) -> a -> b
$ \s :: State
s -> Faction -> Maybe (LevelId, Point)
gstash (Faction -> Maybe (LevelId, Point))
-> Faction -> Maybe (LevelId, Point)
forall a b. (a -> b) -> a -> b
$ State -> FactionDict
sfactionD State
s FactionDict -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
b
    case Maybe (LevelId, Point)
mstash of
      Just (lid :: LevelId
lid, pos :: Point
pos) -> [UpdAtomic] -> m [UpdAtomic]
forall (m :: * -> *) a. Monad m => a -> m a
return [ Bool -> ItemId -> ItemQuant -> Container -> UpdAtomic
UpdLoseItem Bool
True ItemId
iid ItemQuant
kit (ActorId -> CStore -> Container
CActor ActorId
aid CStore
store1)
                                , Bool -> ItemId -> ItemQuant -> Container -> UpdAtomic
UpdSpotItem Bool
True ItemId
iid ItemQuant
kit (LevelId -> Point -> Container
CFloor LevelId
lid Point
pos) ]
      Nothing -> String -> m [UpdAtomic]
forall a. (?callStack::CallStack) => String -> a
error (String -> m [UpdAtomic]) -> String -> m [UpdAtomic]
forall a b. (a -> b) -> a -> b
$ "manipulating void stash" String -> (ActorId, Actor, ItemId) -> String
forall v. Show v => String -> v -> String
`showFailure` (ActorId
aid, Actor
b, ItemId
iid)
  UpdMoveActor aid :: ActorId
aid fromP :: Point
fromP toP :: Point
toP -> do
    -- We assume other factions don't see leaders and we know the actor's
    -- faction always sees the atomic command and no other commands
    -- may be inserted between the two below, so the leader doesn't
    -- need to be updated, even when aid is the leader.
    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
    [UpdAtomic] -> m [UpdAtomic]
forall (m :: * -> *) a. Monad m => a -> m a
return [ ActorId -> Actor -> UpdAtomic
UpdLoseActor ActorId
aid Actor
b
           , ActorId -> Actor -> UpdAtomic
UpdSpotActor ActorId
aid Actor
b {bpos :: Point
bpos = Point
toP, boldpos :: Maybe Point
boldpos = Point -> Maybe Point
forall a. a -> Maybe a
Just Point
fromP} ]
  UpdDisplaceActor source :: ActorId
source target :: ActorId
target -> do
    Actor
sb <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
source
    Actor
tb <- (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
target
    -- The order ensures the invariant that no two big actors occupy the same
    -- position is maintained. The actions about leadership are required
    -- to keep faction data (identify of the leader) consistent with actor
    -- data (the actor that is the leader exists). Here, for speed
    -- and simplicity we violate the property that in a faction
    -- that has leaders, if any eligible actor is alive,
    -- the leader is set, because for a moment there may be no leader,
    -- even though other actors of the faction may exist.
    Maybe ActorId
msleader <- (State -> Maybe ActorId) -> m (Maybe ActorId)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Maybe ActorId) -> m (Maybe ActorId))
-> (State -> Maybe ActorId) -> m (Maybe ActorId)
forall a b. (a -> b) -> a -> b
$ Faction -> Maybe ActorId
gleader (Faction -> Maybe ActorId)
-> (State -> Faction) -> State -> Maybe ActorId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FactionDict -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
sb) (FactionDict -> Faction)
-> (State -> FactionDict) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> FactionDict
sfactionD
    Maybe ActorId
mtleader <- (State -> Maybe ActorId) -> m (Maybe ActorId)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Maybe ActorId) -> m (Maybe ActorId))
-> (State -> Maybe ActorId) -> m (Maybe ActorId)
forall a b. (a -> b) -> a -> b
$ Faction -> Maybe ActorId
gleader (Faction -> Maybe ActorId)
-> (State -> Faction) -> State -> Maybe ActorId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FactionDict -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
tb) (FactionDict -> Faction)
-> (State -> FactionDict) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> FactionDict
sfactionD
    [UpdAtomic] -> m [UpdAtomic]
forall (m :: * -> *) a. Monad m => a -> m a
return ([UpdAtomic] -> m [UpdAtomic]) -> [UpdAtomic] -> m [UpdAtomic]
forall a b. (a -> b) -> a -> b
$ [ FactionId -> Maybe ActorId -> Maybe ActorId -> UpdAtomic
UpdLeadFaction (Actor -> FactionId
bfid Actor
sb) Maybe ActorId
msleader Maybe ActorId
forall a. Maybe a
Nothing
             | ActorId -> Maybe ActorId
forall a. a -> Maybe a
Just ActorId
source Maybe ActorId -> Maybe ActorId -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe ActorId
msleader ]
             [UpdAtomic] -> [UpdAtomic] -> [UpdAtomic]
forall a. [a] -> [a] -> [a]
++ [ FactionId -> Maybe ActorId -> Maybe ActorId -> UpdAtomic
UpdLeadFaction (Actor -> FactionId
bfid Actor
tb) Maybe ActorId
mtleader Maybe ActorId
forall a. Maybe a
Nothing
                | ActorId -> Maybe ActorId
forall a. a -> Maybe a
Just ActorId
target Maybe ActorId -> Maybe ActorId -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe ActorId
mtleader ]
             [UpdAtomic] -> [UpdAtomic] -> [UpdAtomic]
forall a. [a] -> [a] -> [a]
++ [ ActorId -> Actor -> UpdAtomic
UpdLoseActor ActorId
source Actor
sb
                , ActorId -> Actor -> UpdAtomic
UpdLoseActor ActorId
target Actor
tb
                , ActorId -> Actor -> UpdAtomic
UpdSpotActor ActorId
source Actor
sb { bpos :: Point
bpos = Actor -> Point
bpos Actor
tb
                                         , boldpos :: Maybe Point
boldpos = 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
sb }
                , ActorId -> Actor -> UpdAtomic
UpdSpotActor ActorId
target Actor
tb { bpos :: Point
bpos = Actor -> Point
bpos Actor
sb
                                         , boldpos :: Maybe Point
boldpos = 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
tb } ]
             [UpdAtomic] -> [UpdAtomic] -> [UpdAtomic]
forall a. [a] -> [a] -> [a]
++ [ FactionId -> Maybe ActorId -> Maybe ActorId -> UpdAtomic
UpdLeadFaction (Actor -> FactionId
bfid Actor
sb) Maybe ActorId
forall a. Maybe a
Nothing Maybe ActorId
msleader
                | ActorId -> Maybe ActorId
forall a. a -> Maybe a
Just ActorId
source Maybe ActorId -> Maybe ActorId -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe ActorId
msleader ]
             [UpdAtomic] -> [UpdAtomic] -> [UpdAtomic]
forall a. [a] -> [a] -> [a]
++ [ FactionId -> Maybe ActorId -> Maybe ActorId -> UpdAtomic
UpdLeadFaction (Actor -> FactionId
bfid Actor
tb) Maybe ActorId
forall a. Maybe a
Nothing Maybe ActorId
mtleader
                | ActorId -> Maybe ActorId
forall a. a -> Maybe a
Just ActorId
target Maybe ActorId -> Maybe ActorId -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe ActorId
mtleader ]
  UpdTimeItem iid :: ItemId
iid (CActor aid :: ActorId
aid CStash) fromIt :: ItemTimers
fromIt toIt :: ItemTimers
toIt -> do
    Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
    Maybe (LevelId, Point)
mstash <- (State -> Maybe (LevelId, Point)) -> m (Maybe (LevelId, Point))
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Maybe (LevelId, Point)) -> m (Maybe (LevelId, Point)))
-> (State -> Maybe (LevelId, Point)) -> m (Maybe (LevelId, Point))
forall a b. (a -> b) -> a -> b
$ \s :: State
s -> Faction -> Maybe (LevelId, Point)
gstash (Faction -> Maybe (LevelId, Point))
-> Faction -> Maybe (LevelId, Point)
forall a b. (a -> b) -> a -> b
$ State -> FactionDict
sfactionD State
s FactionDict -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
b
    case Maybe (LevelId, Point)
mstash of
      Just (lid :: LevelId
lid, pos :: Point
pos) -> [UpdAtomic] -> m [UpdAtomic]
forall (m :: * -> *) a. Monad m => a -> m a
return [ItemId -> Container -> ItemTimers -> ItemTimers -> UpdAtomic
UpdTimeItem ItemId
iid (LevelId -> Point -> Container
CFloor LevelId
lid Point
pos) ItemTimers
fromIt ItemTimers
toIt]
      Nothing -> String -> m [UpdAtomic]
forall a. (?callStack::CallStack) => String -> a
error (String -> m [UpdAtomic]) -> String -> m [UpdAtomic]
forall a b. (a -> b) -> a -> b
$ "manipulating void stash" String -> (ActorId, Actor, ItemId) -> String
forall v. Show v => String -> v -> String
`showFailure` (ActorId
aid, Actor
b, ItemId
iid)
  _ -> [UpdAtomic] -> m [UpdAtomic]
forall (m :: * -> *) a. Monad m => a -> m a
return []

-- | What is the main map level the @PosAtomic@ refers to, if any.
lidOfPos :: PosAtomic -> Maybe LevelId
lidOfPos :: PosAtomic -> Maybe LevelId
lidOfPos posAtomic :: PosAtomic
posAtomic =
  case PosAtomic
posAtomic of
    PosSight lid :: LevelId
lid _ -> LevelId -> Maybe LevelId
forall a. a -> Maybe a
Just LevelId
lid
    PosFidAndSight _ lid :: LevelId
lid _ -> LevelId -> Maybe LevelId
forall a. a -> Maybe a
Just LevelId
lid
    PosSmell lid :: LevelId
lid _ -> LevelId -> Maybe LevelId
forall a. a -> Maybe a
Just LevelId
lid
    PosSightLevels [] -> Maybe LevelId
forall a. Maybe a
Nothing
    PosSightLevels ((lid :: LevelId
lid, _) : _) -> LevelId -> Maybe LevelId
forall a. a -> Maybe a
Just LevelId
lid
    PosFid{} -> Maybe LevelId
forall a. Maybe a
Nothing
    PosFidAndSer{} -> Maybe LevelId
forall a. Maybe a
Nothing
    PosSer -> Maybe LevelId
forall a. Maybe a
Nothing
    PosAll -> Maybe LevelId
forall a. Maybe a
Nothing
    PosNone -> Maybe LevelId
forall a. Maybe a
Nothing

-- | Given the client, its perception and an atomic command, determine
-- if the client notices the command.
seenAtomicCli :: Bool -> FactionId -> PerLid -> PosAtomic -> Bool
seenAtomicCli :: Bool -> FactionId -> PerLid -> PosAtomic -> Bool
seenAtomicCli knowEvents :: Bool
knowEvents fid :: FactionId
fid perLid :: PerLid
perLid posAtomic :: PosAtomic
posAtomic =
  let per :: LevelId -> Perception
per = (PerLid
perLid PerLid -> LevelId -> Perception
forall k a. Enum k => EnumMap k a -> k -> a
EM.!)
  in case PosAtomic
posAtomic of
    PosSight lid :: LevelId
lid ps :: [Point]
ps -> (Point -> Bool) -> [Point] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Point -> EnumSet Point -> Bool
forall k. Enum k => k -> EnumSet k -> Bool
`ES.member` Perception -> EnumSet Point
totalVisible (LevelId -> Perception
per LevelId
lid)) [Point]
ps Bool -> Bool -> Bool
|| Bool
knowEvents
    PosFidAndSight fid2 :: FactionId
fid2 lid :: LevelId
lid ps :: [Point]
ps ->
      FactionId
fid FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
fid2 Bool -> Bool -> Bool
|| (Point -> Bool) -> [Point] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Point -> EnumSet Point -> Bool
forall k. Enum k => k -> EnumSet k -> Bool
`ES.member` Perception -> EnumSet Point
totalVisible (LevelId -> Perception
per LevelId
lid)) [Point]
ps Bool -> Bool -> Bool
|| Bool
knowEvents
    PosSmell lid :: LevelId
lid ps :: [Point]
ps -> (Point -> Bool) -> [Point] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Point -> EnumSet Point -> Bool
forall k. Enum k => k -> EnumSet k -> Bool
`ES.member` Perception -> EnumSet Point
totalSmelled (LevelId -> Perception
per LevelId
lid)) [Point]
ps Bool -> Bool -> Bool
|| Bool
knowEvents
    PosSightLevels l :: [(LevelId, Point)]
l ->
      let visible :: (LevelId, Point) -> Bool
visible (lid :: LevelId
lid, pos :: Point
pos) = Point
pos Point -> EnumSet Point -> Bool
forall k. Enum k => k -> EnumSet k -> Bool
`ES.member` Perception -> EnumSet Point
totalVisible (LevelId -> Perception
per LevelId
lid)
      in ((LevelId, Point) -> Bool) -> [(LevelId, Point)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (LevelId, Point) -> Bool
visible [(LevelId, Point)]
l Bool -> Bool -> Bool
|| Bool
knowEvents
    PosFid fid2 :: FactionId
fid2 -> FactionId
fid FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
fid2
    PosFidAndSer fid2 :: FactionId
fid2 -> FactionId
fid FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
fid2
    PosSer -> Bool
False
    PosAll -> Bool
True
    PosNone -> Bool
False

-- | Determine whether the server would see a command that has
-- the given visibilty conditions.
seenAtomicSer :: PosAtomic -> Bool
seenAtomicSer :: PosAtomic -> Bool
seenAtomicSer posAtomic :: PosAtomic
posAtomic =
  case PosAtomic
posAtomic of
    PosFid _ -> Bool
False
    PosNone -> String -> Bool
forall a. (?callStack::CallStack) => String -> a
error (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ "no position possible" String -> PosAtomic -> String
forall v. Show v => String -> v -> String
`showFailure` PosAtomic
posAtomic
    _ -> Bool
True