{-# LANGUAGE TupleSections #-}
module Game.LambdaHack.Server.CommonM
( revealAll, generalMoveItem, deduceQuits
, writeSaveAll, verifyCaches, deduceKilled, electLeader, setFreshLeader
, updatePer, projectFail, addActorFromGroup, registerActor
, discoverIfMinorEffects, pickWeaponServer, currentSkillsServer, allGroupItems
, addCondition, removeConditionSingle, addSleep, removeSleepSingle
, addKillToAnalytics
#ifdef EXPOSE_INTERNAL
, revealItems, revealPerceptionLid, containerMoveItem, quitF, keepArenaFact
, anyActorsAlive, updatePerFromNew, recomputeCachePer
, projectBla, addProjectile, addNonProjectile, addActorIid
, getCacheLucid, getCacheTotal
#endif
) where
import Prelude ()
import Game.LambdaHack.Core.Prelude
import qualified Data.EnumMap.Strict as EM
import qualified Data.EnumSet as ES
import qualified Data.IntMap.Strict as IM
import Data.Ratio
import Game.LambdaHack.Atomic
import Game.LambdaHack.Common.Actor
import Game.LambdaHack.Common.ActorState
import Game.LambdaHack.Common.Analytics
import Game.LambdaHack.Common.Area
import Game.LambdaHack.Common.ClientOptions
import Game.LambdaHack.Common.Faction
import Game.LambdaHack.Common.Item
import qualified Game.LambdaHack.Common.ItemAspect as IA
import Game.LambdaHack.Common.Kind
import Game.LambdaHack.Common.Level
import Game.LambdaHack.Common.Misc
import Game.LambdaHack.Common.MonadStateRead
import Game.LambdaHack.Common.Perception
import Game.LambdaHack.Common.Point
import Game.LambdaHack.Common.ReqFailure
import Game.LambdaHack.Common.State
import qualified Game.LambdaHack.Common.Tile as Tile
import Game.LambdaHack.Common.Time
import Game.LambdaHack.Common.Types
import qualified Game.LambdaHack.Content.CaveKind as CK
import Game.LambdaHack.Content.FactionKind
import Game.LambdaHack.Content.ItemKind (ItemKind)
import qualified Game.LambdaHack.Content.ItemKind as IK
import Game.LambdaHack.Core.Random
import qualified Game.LambdaHack.Definition.Ability as Ability
import Game.LambdaHack.Definition.Defs
import qualified Game.LambdaHack.Definition.DefsInternal as DefsInternal
import Game.LambdaHack.Server.Fov
import Game.LambdaHack.Server.ItemM
import Game.LambdaHack.Server.ItemRev
import Game.LambdaHack.Server.MonadServer
import Game.LambdaHack.Server.ServerOptions
import Game.LambdaHack.Server.State
revealItems :: MonadServerAtomic m => FactionId -> m ()
revealItems :: FactionId -> m ()
revealItems FactionId
fid = do
COps{ContentData ItemKind
coitem :: COps -> ContentData ItemKind
coitem :: ContentData ItemKind
coitem} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
ServerOptions{ClientOptions
sclientOptions :: ServerOptions -> ClientOptions
sclientOptions :: ClientOptions
sclientOptions} <- (StateServer -> ServerOptions) -> m ServerOptions
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> ServerOptions
soptions
DiscoveryAspect
discoAspect <- (State -> DiscoveryAspect) -> m DiscoveryAspect
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> DiscoveryAspect
sdiscoAspect
let keptSecret :: ItemKind -> AspectRecord -> Bool
keptSecret ItemKind
kind AspectRecord
ar = ItemKind -> Bool
IA.isHumanTrinket ItemKind
kind
Bool -> Bool -> Bool
|| Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.MetaGame AspectRecord
ar
discover :: ActorId -> CStore -> ItemId -> ItemQuant -> m ()
discover ActorId
aid CStore
store ItemId
iid ItemQuant
_ = do
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
let arItem :: AspectRecord
arItem = DiscoveryAspect
discoAspect DiscoveryAspect -> ItemId -> AspectRecord
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ItemId
iid
c :: Container
c = ActorId -> CStore -> Container
CActor ActorId
aid CStore
store
itemKind :: ItemKind
itemKind = ContentData ItemKind -> ContentId ItemKind -> ItemKind
forall a. ContentData a -> ContentId a -> a
okind ContentData ItemKind
coitem ContentId ItemKind
itemKindId
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ItemKind -> AspectRecord -> Bool
keptSecret ItemKind
itemKind AspectRecord
arItem) (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
$ Container
-> ItemId -> ContentId ItemKind -> AspectRecord -> UpdAtomic
UpdDiscover Container
c ItemId
iid ContentId ItemKind
itemKindId AspectRecord
arItem
f :: (ActorId, Actor) -> m ()
f (ActorId
aid, Actor
b) =
m (m ()) -> m ()
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (m (m ()) -> m ()) -> m (m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ (State -> m ()) -> m (m ())
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> m ()) -> m (m ())) -> (State -> m ()) -> m (m ())
forall a b. (a -> b) -> a -> b
$ (CStore -> ItemId -> ItemQuant -> m ()) -> Actor -> State -> m ()
forall (m :: * -> *).
Monad m =>
(CStore -> ItemId -> ItemQuant -> m ()) -> Actor -> State -> m ()
mapActorItems_ (ActorId -> CStore -> ItemId -> ItemQuant -> m ()
discover ActorId
aid) Actor
b
[(ActorId, Actor)]
aids <- (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 -> State -> [(ActorId, Actor)]
fidActorNotProjGlobalAssocs FactionId
fid
((ActorId, Actor) -> m ()) -> [(ActorId, Actor)] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
mapM_ (ActorId, Actor) -> m ()
f [(ActorId, Actor)]
aids
Dungeon
dungeon <- (State -> Dungeon) -> m Dungeon
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> Dungeon
sdungeon
let minLid :: LevelId
minLid = (LevelId, Level) -> LevelId
forall a b. (a, b) -> a
fst ((LevelId, Level) -> LevelId) -> (LevelId, Level) -> LevelId
forall a b. (a -> b) -> a -> b
$ ((LevelId, Level) -> (LevelId, Level) -> Ordering)
-> [(LevelId, Level)] -> (LevelId, Level)
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
minimumBy (((LevelId, Level) -> AbsDepth)
-> (LevelId, Level) -> (LevelId, Level) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Level -> AbsDepth
ldepth (Level -> AbsDepth)
-> ((LevelId, Level) -> Level) -> (LevelId, Level) -> AbsDepth
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LevelId, Level) -> Level
forall a b. (a, b) -> b
snd))
([(LevelId, Level)] -> (LevelId, Level))
-> [(LevelId, Level)] -> (LevelId, Level)
forall a b. (a -> b) -> a -> b
$ Dungeon -> [(LevelId, Level)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs Dungeon
dungeon
discoverSample :: ItemId -> m ()
discoverSample ItemId
iid = do
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
let arItem :: AspectRecord
arItem = DiscoveryAspect
discoAspect DiscoveryAspect -> ItemId -> AspectRecord
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ItemId
iid
cdummy :: Container
cdummy = FactionId -> LevelId -> Point -> Container
CTrunk FactionId
fid LevelId
minLid Point
originPoint
itemKind :: ItemKind
itemKind = ContentData ItemKind -> ContentId ItemKind -> ItemKind
forall a. ContentData a -> ContentId a -> a
okind ContentData ItemKind
coitem ContentId ItemKind
itemKindId
UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ if ItemKind -> AspectRecord -> Bool
keptSecret ItemKind
itemKind AspectRecord
arItem
then Bool -> ItemId -> ItemQuant -> Container -> UpdAtomic
UpdSpotItem Bool
False ItemId
iid ItemQuant
quantSingle Container
cdummy
else Container
-> ItemId -> ContentId ItemKind -> AspectRecord -> UpdAtomic
UpdDiscover Container
cdummy ItemId
iid ContentId ItemKind
itemKindId AspectRecord
arItem
GenerationAnalytics
generationAn <- (StateServer -> GenerationAnalytics) -> m GenerationAnalytics
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> GenerationAnalytics
sgenerationAn
ItemId -> ContentId ItemKind
getKindId <- (State -> ItemId -> ContentId ItemKind)
-> m (ItemId -> ContentId ItemKind)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemId -> ContentId ItemKind)
-> m (ItemId -> ContentId ItemKind))
-> (State -> ItemId -> ContentId ItemKind)
-> m (ItemId -> ContentId ItemKind)
forall a b. (a -> b) -> a -> b
$ (ItemId -> State -> ContentId ItemKind)
-> State -> ItemId -> ContentId ItemKind
forall a b c. (a -> b -> c) -> b -> a -> c
flip ItemId -> State -> ContentId ItemKind
getIidKindIdServer
let kindsEqual :: ItemId -> ItemId -> Bool
kindsEqual ItemId
iid ItemId
iid2 = ItemId -> ContentId ItemKind
getKindId ItemId
iid ContentId ItemKind -> ContentId ItemKind -> Bool
forall a. Eq a => a -> a -> Bool
== ItemId -> ContentId ItemKind
getKindId ItemId
iid2 Bool -> Bool -> Bool
&& ItemId
iid ItemId -> ItemId -> Bool
forall a. Eq a => a -> a -> Bool
/= ItemId
iid2
nonDupSample :: EnumMap ItemId Int -> ItemId -> Int -> Bool
nonDupSample EnumMap ItemId Int
em ItemId
iid Int
0 = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (ItemId -> Bool) -> [ItemId] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (ItemId -> ItemId -> Bool
kindsEqual ItemId
iid) ([ItemId] -> Bool) -> [ItemId] -> Bool
forall a b. (a -> b) -> a -> b
$ EnumMap ItemId Int -> [ItemId]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys EnumMap ItemId Int
em
nonDupSample EnumMap ItemId Int
_ ItemId
_ Int
_ = Bool
True
nonDupGen :: GenerationAnalytics
nonDupGen = (EnumMap ItemId Int -> EnumMap ItemId Int)
-> GenerationAnalytics -> GenerationAnalytics
forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
EM.map (\EnumMap ItemId Int
em -> (ItemId -> Int -> Bool) -> EnumMap ItemId Int -> EnumMap ItemId Int
forall k a.
Enum k =>
(k -> a -> Bool) -> EnumMap k a -> EnumMap k a
EM.filterWithKey (EnumMap ItemId Int -> ItemId -> Int -> Bool
nonDupSample EnumMap ItemId Int
em) EnumMap ItemId Int
em)
GenerationAnalytics
generationAn
(StateServer -> StateServer) -> m ()
forall (m :: * -> *).
MonadServer m =>
(StateServer -> StateServer) -> m ()
modifyServer ((StateServer -> StateServer) -> m ())
-> (StateServer -> StateServer) -> m ()
forall a b. (a -> b) -> a -> b
$ \StateServer
ser -> StateServer
ser {sgenerationAn :: GenerationAnalytics
sgenerationAn = GenerationAnalytics
nonDupGen}
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ClientOptions -> Bool
sexposeActors ClientOptions
sclientOptions) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
(ItemId -> m ()) -> [ItemId] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
mapM_ ItemId -> m ()
discoverSample ([ItemId] -> m ()) -> [ItemId] -> m ()
forall a b. (a -> b) -> a -> b
$ EnumMap ItemId Int -> [ItemId]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys (EnumMap ItemId Int -> [ItemId]) -> EnumMap ItemId Int -> [ItemId]
forall a b. (a -> b) -> a -> b
$ GenerationAnalytics
nonDupGen GenerationAnalytics -> SLore -> EnumMap ItemId Int
forall k a. Enum k => EnumMap k a -> k -> a
EM.! SLore
STrunk
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ClientOptions -> Bool
sexposeItems ClientOptions
sclientOptions) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
(ItemId -> m ()) -> [ItemId] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
mapM_ ItemId -> m ()
discoverSample ([ItemId] -> m ()) -> [ItemId] -> m ()
forall a b. (a -> b) -> a -> b
$ EnumMap ItemId Int -> [ItemId]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys (EnumMap ItemId Int -> [ItemId]) -> EnumMap ItemId Int -> [ItemId]
forall a b. (a -> b) -> a -> b
$ GenerationAnalytics
nonDupGen GenerationAnalytics -> SLore -> EnumMap ItemId Int
forall k a. Enum k => EnumMap k a -> k -> a
EM.! SLore
SItem
(ItemId -> m ()) -> [ItemId] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
mapM_ ItemId -> m ()
discoverSample ([ItemId] -> m ()) -> [ItemId] -> m ()
forall a b. (a -> b) -> a -> b
$ EnumMap ItemId Int -> [ItemId]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys (EnumMap ItemId Int -> [ItemId]) -> EnumMap ItemId Int -> [ItemId]
forall a b. (a -> b) -> a -> b
$ GenerationAnalytics
nonDupGen GenerationAnalytics -> SLore -> EnumMap ItemId Int
forall k a. Enum k => EnumMap k a -> k -> a
EM.! SLore
SEmbed
(ItemId -> m ()) -> [ItemId] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
mapM_ ItemId -> m ()
discoverSample ([ItemId] -> m ()) -> [ItemId] -> m ()
forall a b. (a -> b) -> a -> b
$ EnumMap ItemId Int -> [ItemId]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys (EnumMap ItemId Int -> [ItemId]) -> EnumMap ItemId Int -> [ItemId]
forall a b. (a -> b) -> a -> b
$ GenerationAnalytics
nonDupGen GenerationAnalytics -> SLore -> EnumMap ItemId Int
forall k a. Enum k => EnumMap k a -> k -> a
EM.! SLore
SOrgan
(ItemId -> m ()) -> [ItemId] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
mapM_ ItemId -> m ()
discoverSample ([ItemId] -> m ()) -> [ItemId] -> m ()
forall a b. (a -> b) -> a -> b
$ EnumMap ItemId Int -> [ItemId]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys (EnumMap ItemId Int -> [ItemId]) -> EnumMap ItemId Int -> [ItemId]
forall a b. (a -> b) -> a -> b
$ GenerationAnalytics
nonDupGen GenerationAnalytics -> SLore -> EnumMap ItemId Int
forall k a. Enum k => EnumMap k a -> k -> a
EM.! SLore
SCondition
(ItemId -> m ()) -> [ItemId] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
mapM_ ItemId -> m ()
discoverSample ([ItemId] -> m ()) -> [ItemId] -> m ()
forall a b. (a -> b) -> a -> b
$ EnumMap ItemId Int -> [ItemId]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys (EnumMap ItemId Int -> [ItemId]) -> EnumMap ItemId Int -> [ItemId]
forall a b. (a -> b) -> a -> b
$ GenerationAnalytics
nonDupGen GenerationAnalytics -> SLore -> EnumMap ItemId Int
forall k a. Enum k => EnumMap k a -> k -> a
EM.! SLore
SBlast
revealAll :: MonadServerAtomic m => FactionId -> m ()
revealAll :: FactionId -> m ()
revealAll FactionId
fid = do
FactionId -> m ()
forall (m :: * -> *). MonadServerAtomic m => FactionId -> m ()
revealItems FactionId
fid
UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ FactionId -> Bool -> UpdAtomic
UpdMuteMessages FactionId
fid Bool
True
Dungeon
dungeon <- (State -> Dungeon) -> m Dungeon
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> Dungeon
sdungeon
((LevelId, Level) -> m ()) -> [(LevelId, Level)] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
mapM_ (FactionId -> (LevelId, Level) -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
FactionId -> (LevelId, Level) -> m ()
revealPerceptionLid FactionId
fid) ([(LevelId, Level)] -> m ()) -> [(LevelId, Level)] -> m ()
forall a b. (a -> b) -> a -> b
$ Dungeon -> [(LevelId, Level)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs Dungeon
dungeon
UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ FactionId -> Bool -> UpdAtomic
UpdMuteMessages FactionId
fid Bool
False
revealPerceptionLid :: MonadServerAtomic m
=> FactionId -> (LevelId, Level) -> m ()
revealPerceptionLid :: FactionId -> (LevelId, Level) -> m ()
revealPerceptionLid FactionId
fid (LevelId
lid, Level
lvl) = do
let (Int
x0, Int
y0, Int
x1, Int
y1) = Area -> (Int, Int, Int, Int)
fromArea (Area -> (Int, Int, Int, Int)) -> Area -> (Int, Int, Int, Int)
forall a b. (a -> b) -> a -> b
$ Level -> Area
larea Level
lvl
fullSet :: EnumSet Point
fullSet = [Point] -> EnumSet Point
forall k. Enum k => [k] -> EnumSet k
ES.fromDistinctAscList [ Int -> Int -> Point
Point Int
x Int
y
| Int
y <- [Int
y0 .. Int
y1]
, Int
x <- [Int
x0 .. Int
x1] ]
perNew :: Perception
perNew = Perception :: PerVisible -> PerSmelled -> Perception
Perception
{ psight :: PerVisible
psight = EnumSet Point -> PerVisible
PerVisible EnumSet Point
fullSet
, psmell :: PerSmelled
psmell = EnumSet Point -> PerSmelled
PerSmelled EnumSet Point
forall k. EnumSet k
ES.empty
}
FactionId -> LevelId -> Perception -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
FactionId -> LevelId -> Perception -> m ()
updatePerFromNew FactionId
fid LevelId
lid Perception
perNew
generalMoveItem :: MonadStateRead m
=> Bool -> ItemId -> Int -> Container -> Container
-> m [UpdAtomic]
generalMoveItem :: Bool -> ItemId -> Int -> Container -> Container -> m [UpdAtomic]
generalMoveItem Bool
_ ItemId
iid Int
k (CActor ActorId
aid1 CStore
cstore1) c2 :: Container
c2@(CActor ActorId
aid2 CStore
cstore2)
| ActorId
aid1 ActorId -> ActorId -> Bool
forall a. Eq a => a -> a -> Bool
== ActorId
aid2 = do
[UpdAtomic]
moveStash <- Container -> m [UpdAtomic]
forall (m :: * -> *).
MonadStateRead m =>
Container -> m [UpdAtomic]
moveStashIfNeeded Container
c2
[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
$! [UpdAtomic]
moveStash [UpdAtomic] -> [UpdAtomic] -> [UpdAtomic]
forall a. [a] -> [a] -> [a]
++ [ItemId -> Int -> ActorId -> CStore -> CStore -> UpdAtomic
UpdMoveItem ItemId
iid Int
k ActorId
aid1 CStore
cstore1 CStore
cstore2]
generalMoveItem Bool
verbose ItemId
iid Int
k Container
c1 Container
c2 = Bool -> ItemId -> Int -> Container -> Container -> m [UpdAtomic]
forall (m :: * -> *).
MonadStateRead m =>
Bool -> ItemId -> Int -> Container -> Container -> m [UpdAtomic]
containerMoveItem Bool
verbose ItemId
iid Int
k Container
c1 Container
c2
containerMoveItem :: MonadStateRead m
=> Bool -> ItemId -> Int -> Container -> Container
-> m [UpdAtomic]
containerMoveItem :: Bool -> ItemId -> Int -> Container -> Container -> m [UpdAtomic]
containerMoveItem Bool
verbose ItemId
iid Int
k Container
c1 Container
c2 = do
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
$ Container -> State -> ItemBag
getContainerBag Container
c1
case ItemId
iid ItemId -> ItemBag -> Maybe ItemQuant
forall k a. Enum k => k -> EnumMap k a -> Maybe a
`EM.lookup` ItemBag
bag of
Maybe ItemQuant
Nothing -> [Char] -> m [UpdAtomic]
forall a. HasCallStack => [Char] -> a
error ([Char] -> m [UpdAtomic]) -> [Char] -> m [UpdAtomic]
forall a b. (a -> b) -> a -> b
$ [Char]
"" [Char] -> (ItemId, Int, Container, Container) -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` (ItemId
iid, Int
k, Container
c1, Container
c2)
Just (Int
_, ItemTimers
it) -> do
[UpdAtomic]
moveStash <- Container -> m [UpdAtomic]
forall (m :: * -> *).
MonadStateRead m =>
Container -> m [UpdAtomic]
moveStashIfNeeded Container
c2
[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
$ [Bool -> ItemId -> ItemQuant -> Container -> UpdAtomic
UpdLoseItem Bool
verbose ItemId
iid (Int
k, Int -> ItemTimers -> ItemTimers
forall a. Int -> [a] -> [a]
take Int
k ItemTimers
it) Container
c1]
[UpdAtomic] -> [UpdAtomic] -> [UpdAtomic]
forall a. [a] -> [a] -> [a]
++ [UpdAtomic]
moveStash
[UpdAtomic] -> [UpdAtomic] -> [UpdAtomic]
forall a. [a] -> [a] -> [a]
++ [Bool -> ItemId -> ItemQuant -> Container -> UpdAtomic
UpdSpotItem Bool
verbose ItemId
iid (Int
k, Int -> ItemTimers -> ItemTimers
forall a. Int -> [a] -> [a]
take Int
k ItemTimers
it) Container
c2]
quitF :: MonadServerAtomic m => Status -> FactionId -> m ()
quitF :: Status -> FactionId -> m ()
quitF Status
status FactionId
fid = do
Faction
fact <- (State -> Faction) -> m Faction
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
fid) (EnumMap FactionId Faction -> Faction)
-> (State -> EnumMap FactionId Faction) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap FactionId Faction
sfactionD
let oldSt :: Maybe Status
oldSt = Faction -> Maybe Status
gquit Faction
fact
case Status -> Outcome
stOutcome (Status -> Outcome) -> Maybe Status -> Maybe Outcome
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Status
oldSt of
Just Outcome
Killed -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just Outcome
Defeated -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just Outcome
Conquer -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just Outcome
Escape -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Maybe Outcome
_ -> do
let !_A :: ()
_A = Bool -> () -> ()
forall a. HasCallStack => Bool -> a -> a
assert (Status -> Outcome
stOutcome Status
status Outcome -> [Outcome] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Outcome
Camping, Outcome
Restart]
Bool -> ([Char], (Maybe Outcome, Status, FactionId)) -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` [Char]
"Camping and Restart are handled separately"
[Char]
-> (Maybe Outcome, Status, FactionId)
-> ([Char], (Maybe Outcome, Status, FactionId))
forall v. [Char] -> v -> ([Char], v)
`swith` (Status -> Outcome
stOutcome (Status -> Outcome) -> Maybe Status -> Maybe Outcome
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Status
oldSt, Status
status, FactionId
fid)) ()
Maybe (FactionAnalytics, GenerationAnalytics)
manalytics <-
if FactionKind -> Bool
fhasUI (FactionKind -> Bool) -> FactionKind -> Bool
forall a b. (a -> b) -> a -> b
$ Faction -> FactionKind
gkind Faction
fact then do
Bool
keepAutomated <- (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
skeepAutomated (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 ()
when (Faction -> Bool
gunderAI Faction
fact Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
keepAutomated) (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
$ FactionId -> Bool -> UpdAtomic
UpdAutoFaction FactionId
fid Bool
False
FactionId -> m ()
forall (m :: * -> *). MonadServerAtomic m => FactionId -> m ()
revealAll FactionId
fid
Status -> FactionId -> m ()
forall (m :: * -> *). MonadServer m => Status -> FactionId -> m ()
registerScore Status
status FactionId
fid
FactionAnalytics
factionAn <- (StateServer -> FactionAnalytics) -> m FactionAnalytics
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> FactionAnalytics
sfactionAn
GenerationAnalytics
generationAn <- (StateServer -> GenerationAnalytics) -> m GenerationAnalytics
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> GenerationAnalytics
sgenerationAn
Maybe (FactionAnalytics, GenerationAnalytics)
-> m (Maybe (FactionAnalytics, GenerationAnalytics))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (FactionAnalytics, GenerationAnalytics)
-> m (Maybe (FactionAnalytics, GenerationAnalytics)))
-> Maybe (FactionAnalytics, GenerationAnalytics)
-> m (Maybe (FactionAnalytics, GenerationAnalytics))
forall a b. (a -> b) -> a -> b
$ (FactionAnalytics, GenerationAnalytics)
-> Maybe (FactionAnalytics, GenerationAnalytics)
forall a. a -> Maybe a
Just (FactionAnalytics
factionAn, GenerationAnalytics
generationAn)
else Maybe (FactionAnalytics, GenerationAnalytics)
-> m (Maybe (FactionAnalytics, GenerationAnalytics))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (FactionAnalytics, GenerationAnalytics)
forall a. Maybe a
Nothing
UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ FactionId
-> Maybe Status
-> Maybe Status
-> Maybe (FactionAnalytics, GenerationAnalytics)
-> UpdAtomic
UpdQuitFaction FactionId
fid Maybe Status
oldSt (Status -> Maybe Status
forall a. a -> Maybe a
Just Status
status) Maybe (FactionAnalytics, GenerationAnalytics)
manalytics
(StateServer -> StateServer) -> m ()
forall (m :: * -> *).
MonadServer m =>
(StateServer -> StateServer) -> m ()
modifyServer ((StateServer -> StateServer) -> m ())
-> (StateServer -> StateServer) -> m ()
forall a b. (a -> b) -> a -> b
$ \StateServer
ser -> StateServer
ser {sbreakLoop :: Bool
sbreakLoop = Bool
True}
deduceQuits :: MonadServerAtomic m => FactionId -> Status -> m ()
deduceQuits :: FactionId -> Status -> m ()
deduceQuits FactionId
fid0 status :: Status
status@Status{Outcome
stOutcome :: Outcome
stOutcome :: Status -> Outcome
stOutcome}
| Outcome
stOutcome Outcome -> [Outcome] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Outcome
Defeated, Outcome
Camping, Outcome
Restart, Outcome
Conquer] =
[Char] -> m ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> m ()) -> [Char] -> m ()
forall a b. (a -> b) -> a -> b
$ [Char]
"no quitting to deduce" [Char] -> (FactionId, Status) -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` (FactionId
fid0, Status
status)
deduceQuits FactionId
fid0 Status
status = do
Faction
fact0 <- (State -> Faction) -> m Faction
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
fid0) (EnumMap FactionId Faction -> Faction)
-> (State -> EnumMap FactionId Faction) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap FactionId Faction
sfactionD
let factHasUI :: Faction -> Bool
factHasUI = FactionKind -> Bool
fhasUI (FactionKind -> Bool)
-> (Faction -> FactionKind) -> Faction -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Faction -> FactionKind
gkind
quitFaction :: (Outcome, (FactionId, Faction)) -> m ()
quitFaction (Outcome
stOutcome, (FactionId
fid, Faction
_)) = Status -> FactionId -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
Status -> FactionId -> m ()
quitF Status
status{Outcome
stOutcome :: Outcome
stOutcome :: Outcome
stOutcome} FactionId
fid
mapQuitF :: [(Outcome, (FactionId, Faction))] -> m ()
mapQuitF [(Outcome, (FactionId, Faction))]
outfids = do
let ([(Outcome, (FactionId, Faction))]
withUI, [(Outcome, (FactionId, Faction))]
withoutUI) =
((Outcome, (FactionId, Faction)) -> Bool)
-> [(Outcome, (FactionId, Faction))]
-> ([(Outcome, (FactionId, Faction))],
[(Outcome, (FactionId, Faction))])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (Faction -> Bool
factHasUI (Faction -> Bool)
-> ((Outcome, (FactionId, Faction)) -> Faction)
-> (Outcome, (FactionId, Faction))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FactionId, Faction) -> Faction
forall a b. (a, b) -> b
snd ((FactionId, Faction) -> Faction)
-> ((Outcome, (FactionId, Faction)) -> (FactionId, Faction))
-> (Outcome, (FactionId, Faction))
-> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Outcome, (FactionId, Faction)) -> (FactionId, Faction)
forall a b. (a, b) -> b
snd)
((Status -> Outcome
stOutcome Status
status, (FactionId
fid0, Faction
fact0)) (Outcome, (FactionId, Faction))
-> [(Outcome, (FactionId, Faction))]
-> [(Outcome, (FactionId, Faction))]
forall a. a -> [a] -> [a]
: [(Outcome, (FactionId, Faction))]
outfids)
((Outcome, (FactionId, Faction)) -> m ())
-> [(Outcome, (FactionId, Faction))] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
mapM_ (Outcome, (FactionId, Faction)) -> m ()
quitFaction ([(Outcome, (FactionId, Faction))]
withoutUI [(Outcome, (FactionId, Faction))]
-> [(Outcome, (FactionId, Faction))]
-> [(Outcome, (FactionId, Faction))]
forall a. [a] -> [a] -> [a]
++ [(Outcome, (FactionId, Faction))]
withUI)
inGameOutcome :: (FactionId, Faction) -> Bool
inGameOutcome (FactionId
fid, Faction
fact) = do
let mout :: Maybe Outcome
mout | FactionId
fid FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
fid0 = Outcome -> Maybe Outcome
forall a. a -> Maybe a
Just (Outcome -> Maybe Outcome) -> Outcome -> Maybe Outcome
forall a b. (a -> b) -> a -> b
$ Status -> Outcome
stOutcome Status
status
| Bool
otherwise = Status -> Outcome
stOutcome (Status -> Outcome) -> Maybe Status -> Maybe Outcome
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Faction -> Maybe Status
gquit Faction
fact
case Maybe Outcome
mout of
Just Outcome
Killed -> Bool
False
Just Outcome
Defeated -> Bool
False
Just Outcome
Restart -> Bool
False
Maybe Outcome
_ -> Bool
True
EnumMap FactionId Faction
factionD <- (State -> EnumMap FactionId Faction)
-> m (EnumMap FactionId Faction)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> EnumMap FactionId Faction
sfactionD
let assocsInGame :: [(FactionId, Faction)]
assocsInGame = ((FactionId, Faction) -> Bool)
-> [(FactionId, Faction)] -> [(FactionId, Faction)]
forall a. (a -> Bool) -> [a] -> [a]
filter (FactionId, Faction) -> Bool
inGameOutcome ([(FactionId, Faction)] -> [(FactionId, Faction)])
-> [(FactionId, Faction)] -> [(FactionId, Faction)]
forall a b. (a -> b) -> a -> b
$ EnumMap FactionId Faction -> [(FactionId, Faction)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs EnumMap FactionId Faction
factionD
assocsKeepArena :: [(FactionId, Faction)]
assocsKeepArena = ((FactionId, Faction) -> Bool)
-> [(FactionId, Faction)] -> [(FactionId, Faction)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Faction -> Bool
keepArenaFact (Faction -> Bool)
-> ((FactionId, Faction) -> Faction)
-> (FactionId, Faction)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FactionId, Faction) -> Faction
forall a b. (a, b) -> b
snd) [(FactionId, Faction)]
assocsInGame
assocsUI :: [(FactionId, Faction)]
assocsUI = ((FactionId, Faction) -> Bool)
-> [(FactionId, Faction)] -> [(FactionId, Faction)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Faction -> Bool
factHasUI (Faction -> Bool)
-> ((FactionId, Faction) -> Faction)
-> (FactionId, Faction)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FactionId, Faction) -> Faction
forall a b. (a, b) -> b
snd) [(FactionId, Faction)]
assocsInGame
nonHorrorAIG :: [(FactionId, Faction)]
nonHorrorAIG = ((FactionId, Faction) -> Bool)
-> [(FactionId, Faction)] -> [(FactionId, Faction)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((FactionId, Faction) -> Bool) -> (FactionId, Faction) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Faction -> Bool
isHorrorFact (Faction -> Bool)
-> ((FactionId, Faction) -> Faction)
-> (FactionId, Faction)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FactionId, Faction) -> Faction
forall a b. (a, b) -> b
snd) [(FactionId, Faction)]
assocsInGame
worldPeace :: Bool
worldPeace =
((FactionId, Faction) -> Bool) -> [(FactionId, Faction)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\(FactionId
fid1, Faction
_) -> ((FactionId, Faction) -> Bool) -> [(FactionId, Faction)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\(FactionId
fid2, Faction
fact2) -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ FactionId -> Faction -> FactionId -> Bool
isFoe FactionId
fid2 Faction
fact2 FactionId
fid1)
[(FactionId, Faction)]
nonHorrorAIG)
[(FactionId, Faction)]
nonHorrorAIG
othersInGame :: [(FactionId, Faction)]
othersInGame = ((FactionId, Faction) -> Bool)
-> [(FactionId, Faction)] -> [(FactionId, Faction)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
/= FactionId
fid0) (FactionId -> Bool)
-> ((FactionId, Faction) -> FactionId)
-> (FactionId, Faction)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FactionId, Faction) -> FactionId
forall a b. (a, b) -> a
fst) [(FactionId, Faction)]
assocsInGame
if | [(FactionId, Faction)] -> Bool
forall a. [a] -> Bool
null [(FactionId, Faction)]
assocsUI ->
[(Outcome, (FactionId, Faction))] -> m ()
mapQuitF ([(Outcome, (FactionId, Faction))] -> m ())
-> [(Outcome, (FactionId, Faction))] -> m ()
forall a b. (a -> b) -> a -> b
$ [Outcome]
-> [(FactionId, Faction)] -> [(Outcome, (FactionId, Faction))]
forall a b. [a] -> [b] -> [(a, b)]
zip (Outcome -> [Outcome]
forall a. a -> [a]
repeat Outcome
Conquer) [(FactionId, Faction)]
othersInGame
| [(FactionId, Faction)] -> Bool
forall a. [a] -> Bool
null [(FactionId, Faction)]
assocsKeepArena ->
[(Outcome, (FactionId, Faction))] -> m ()
mapQuitF ([(Outcome, (FactionId, Faction))] -> m ())
-> [(Outcome, (FactionId, Faction))] -> m ()
forall a b. (a -> b) -> a -> b
$ [Outcome]
-> [(FactionId, Faction)] -> [(Outcome, (FactionId, Faction))]
forall a b. [a] -> [b] -> [(a, b)]
zip (Outcome -> [Outcome]
forall a. a -> [a]
repeat Outcome
Conquer) [(FactionId, Faction)]
othersInGame
| Bool
worldPeace ->
[(Outcome, (FactionId, Faction))] -> m ()
mapQuitF ([(Outcome, (FactionId, Faction))] -> m ())
-> [(Outcome, (FactionId, Faction))] -> m ()
forall a b. (a -> b) -> a -> b
$ [Outcome]
-> [(FactionId, Faction)] -> [(Outcome, (FactionId, Faction))]
forall a b. [a] -> [b] -> [(a, b)]
zip (Outcome -> [Outcome]
forall a. a -> [a]
repeat Outcome
Conquer) [(FactionId, Faction)]
othersInGame
| Status -> Outcome
stOutcome Status
status Outcome -> Outcome -> Bool
forall a. Eq a => a -> a -> Bool
== Outcome
Escape -> do
let ([(FactionId, Faction)]
victors, [(FactionId, Faction)]
losers) =
((FactionId, Faction) -> Bool)
-> [(FactionId, Faction)]
-> ([(FactionId, Faction)], [(FactionId, Faction)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (\(FactionId
fi, Faction
_) -> FactionId -> Faction -> FactionId -> Bool
isFriend FactionId
fid0 Faction
fact0 FactionId
fi) [(FactionId, Faction)]
othersInGame
[(Outcome, (FactionId, Faction))] -> m ()
mapQuitF ([(Outcome, (FactionId, Faction))] -> m ())
-> [(Outcome, (FactionId, Faction))] -> m ()
forall a b. (a -> b) -> a -> b
$ [Outcome]
-> [(FactionId, Faction)] -> [(Outcome, (FactionId, Faction))]
forall a b. [a] -> [b] -> [(a, b)]
zip (Outcome -> [Outcome]
forall a. a -> [a]
repeat Outcome
Escape) [(FactionId, Faction)]
victors [(Outcome, (FactionId, Faction))]
-> [(Outcome, (FactionId, Faction))]
-> [(Outcome, (FactionId, Faction))]
forall a. [a] -> [a] -> [a]
++ [Outcome]
-> [(FactionId, Faction)] -> [(Outcome, (FactionId, Faction))]
forall a b. [a] -> [b] -> [(a, b)]
zip (Outcome -> [Outcome]
forall a. a -> [a]
repeat Outcome
Defeated) [(FactionId, Faction)]
losers
| Bool
otherwise -> Status -> FactionId -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
Status -> FactionId -> m ()
quitF Status
status FactionId
fid0
writeSaveAll :: MonadServerAtomic m => Bool -> Bool -> m ()
writeSaveAll :: Bool -> Bool -> m ()
writeSaveAll Bool
uiRequested Bool
evenForNoConfirmGames = do
Bool
bench <- (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
$ ClientOptions -> Bool
sbenchmark (ClientOptions -> Bool)
-> (StateServer -> ClientOptions) -> StateServer -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServerOptions -> ClientOptions
sclientOptions (ServerOptions -> ClientOptions)
-> (StateServer -> ServerOptions) -> StateServer -> ClientOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateServer -> ServerOptions
soptions
Bool
noConfirmsGame <- m Bool
forall (m :: * -> *). MonadStateRead m => m Bool
isNoConfirmsGame
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
uiRequested
Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
bench Bool -> Bool -> Bool
&& (Bool -> Bool
not Bool
noConfirmsGame Bool -> Bool -> Bool
|| Bool
evenForNoConfirmGames)) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic UpdAtomic
UpdWriteSave
m ()
forall (m :: * -> *). MonadServer m => m ()
saveServer
#ifdef WITH_EXPENSIVE_ASSERTIONS
m ()
forall (m :: * -> *). MonadServer m => m ()
verifyCaches
#endif
verifyCaches :: MonadServer m => m ()
verifyCaches :: m ()
verifyCaches = do
PerCacheFid
sperCacheFid <- (StateServer -> PerCacheFid) -> m PerCacheFid
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> PerCacheFid
sperCacheFid
PerValidFid
sperValidFid <- (StateServer -> PerValidFid) -> m PerValidFid
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> PerValidFid
sperValidFid
ActorMaxSkills
sactorMaxSkills2 <- (State -> ActorMaxSkills) -> m ActorMaxSkills
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> ActorMaxSkills
sactorMaxSkills
FovLucidLid
sfovLucidLid <- (StateServer -> FovLucidLid) -> m FovLucidLid
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> FovLucidLid
sfovLucidLid
FovClearLid
sfovClearLid <- (StateServer -> FovClearLid) -> m FovClearLid
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> FovClearLid
sfovClearLid
FovLitLid
sfovLitLid <- (StateServer -> FovLitLid) -> m FovLitLid
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> FovLitLid
sfovLitLid
PerFid
sperFid <- (StateServer -> PerFid) -> m PerFid
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> PerFid
sperFid
ActorMaxSkills
actorMaxSkills <- (State -> ActorMaxSkills) -> m ActorMaxSkills
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> ActorMaxSkills
maxSkillsInDungeon
( FovLitLid
fovLitLid, FovClearLid
fovClearLid, FovLucidLid
fovLucidLid
,PerValidFid
perValidFid, PerCacheFid
perCacheFid, PerFid
perFid ) <- (State
-> (FovLitLid, FovClearLid, FovLucidLid, PerValidFid, PerCacheFid,
PerFid))
-> m (FovLitLid, FovClearLid, FovLucidLid, PerValidFid,
PerCacheFid, PerFid)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State
-> (FovLitLid, FovClearLid, FovLucidLid, PerValidFid, PerCacheFid,
PerFid)
perFidInDungeon
RNGs
rngs <- (StateServer -> RNGs) -> m RNGs
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> RNGs
srngs
EnumMap FactionId Faction
factionD <- (State -> EnumMap FactionId Faction)
-> m (EnumMap FactionId Faction)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> EnumMap FactionId Faction
sfactionD
let gameOverUI :: Faction -> Bool
gameOverUI Faction
fact = FactionKind -> Bool
fhasUI (Faction -> FactionKind
gkind Faction
fact)
Bool -> Bool -> Bool
&& Bool -> (Status -> Bool) -> Maybe Status -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False ((Outcome -> Outcome -> Bool
forall a. Eq a => a -> a -> Bool
/= Outcome
Camping) (Outcome -> Bool) -> (Status -> Outcome) -> Status -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Status -> Outcome
stOutcome) (Faction -> Maybe Status
gquit Faction
fact)
isGameOverUI :: Bool
isGameOverUI = (Faction -> Bool) -> [Faction] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Faction -> Bool
gameOverUI ([Faction] -> Bool) -> [Faction] -> Bool
forall a b. (a -> b) -> a -> b
$ EnumMap FactionId Faction -> [Faction]
forall k a. EnumMap k a -> [a]
EM.elems EnumMap FactionId Faction
factionD
!_A7 :: ()
_A7 = Bool -> () -> ()
forall a. HasCallStack => Bool -> a -> a
assert (FovLitLid
sfovLitLid FovLitLid -> FovLitLid -> Bool
forall a. Eq a => a -> a -> Bool
== FovLitLid
fovLitLid
Bool -> ([Char], (FovLitLid, FovLitLid, RNGs)) -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` [Char]
"wrong accumulated sfovLitLid"
[Char]
-> (FovLitLid, FovLitLid, RNGs)
-> ([Char], (FovLitLid, FovLitLid, RNGs))
forall v. [Char] -> v -> ([Char], v)
`swith` (FovLitLid
sfovLitLid, FovLitLid
fovLitLid, RNGs
rngs)) ()
!_A6 :: ()
_A6 = Bool -> () -> ()
forall a. HasCallStack => Bool -> a -> a
assert (FovClearLid
sfovClearLid FovClearLid -> FovClearLid -> Bool
forall a. Eq a => a -> a -> Bool
== FovClearLid
fovClearLid
Bool -> ([Char], (FovClearLid, FovClearLid, RNGs)) -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` [Char]
"wrong accumulated sfovClearLid"
[Char]
-> (FovClearLid, FovClearLid, RNGs)
-> ([Char], (FovClearLid, FovClearLid, RNGs))
forall v. [Char] -> v -> ([Char], v)
`swith` (FovClearLid
sfovClearLid, FovClearLid
fovClearLid, RNGs
rngs)) ()
!_A5 :: ()
_A5 = Bool -> () -> ()
forall a. HasCallStack => Bool -> a -> a
assert (ActorMaxSkills
sactorMaxSkills2 ActorMaxSkills -> ActorMaxSkills -> Bool
forall a. Eq a => a -> a -> Bool
== ActorMaxSkills
actorMaxSkills
Bool -> ([Char], (ActorMaxSkills, ActorMaxSkills, RNGs)) -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` [Char]
"wrong accumulated sactorMaxSkills"
[Char]
-> (ActorMaxSkills, ActorMaxSkills, RNGs)
-> ([Char], (ActorMaxSkills, ActorMaxSkills, RNGs))
forall v. [Char] -> v -> ([Char], v)
`swith` (ActorMaxSkills
sactorMaxSkills2, ActorMaxSkills
actorMaxSkills, RNGs
rngs)) ()
!_A4 :: ()
_A4 = Bool -> () -> ()
forall a. HasCallStack => Bool -> a -> a
assert (FovLucidLid
sfovLucidLid FovLucidLid -> FovLucidLid -> Bool
forall a. Eq a => a -> a -> Bool
== FovLucidLid
fovLucidLid
Bool -> ([Char], (FovLucidLid, FovLucidLid, RNGs)) -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` [Char]
"wrong accumulated sfovLucidLid"
[Char]
-> (FovLucidLid, FovLucidLid, RNGs)
-> ([Char], (FovLucidLid, FovLucidLid, RNGs))
forall v. [Char] -> v -> ([Char], v)
`swith` (FovLucidLid
sfovLucidLid, FovLucidLid
fovLucidLid, RNGs
rngs)) ()
!_A3 :: ()
_A3 = Bool -> () -> ()
forall a. HasCallStack => Bool -> a -> a
assert (PerValidFid
sperValidFid PerValidFid -> PerValidFid -> Bool
forall a. Eq a => a -> a -> Bool
== PerValidFid
perValidFid
Bool -> ([Char], (PerValidFid, PerValidFid, RNGs)) -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` [Char]
"wrong accumulated sperValidFid"
[Char]
-> (PerValidFid, PerValidFid, RNGs)
-> ([Char], (PerValidFid, PerValidFid, RNGs))
forall v. [Char] -> v -> ([Char], v)
`swith` (PerValidFid
sperValidFid, PerValidFid
perValidFid, RNGs
rngs)) ()
!_A2 :: ()
_A2 = Bool -> () -> ()
forall a. HasCallStack => Bool -> a -> a
assert (PerCacheFid
sperCacheFid PerCacheFid -> PerCacheFid -> Bool
forall a. Eq a => a -> a -> Bool
== PerCacheFid
perCacheFid
Bool -> ([Char], (PerCacheFid, PerCacheFid, RNGs)) -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` [Char]
"wrong accumulated sperCacheFid"
[Char]
-> (PerCacheFid, PerCacheFid, RNGs)
-> ([Char], (PerCacheFid, PerCacheFid, RNGs))
forall v. [Char] -> v -> ([Char], v)
`swith` (PerCacheFid
sperCacheFid, PerCacheFid
perCacheFid, RNGs
rngs)) ()
!_A1 :: ()
_A1 = Bool -> () -> ()
forall a. HasCallStack => Bool -> a -> a
assert (Bool
isGameOverUI Bool -> Bool -> Bool
|| PerFid
sperFid PerFid -> PerFid -> Bool
forall a. Eq a => a -> a -> Bool
== PerFid
perFid
Bool -> ([Char], (PerFid, PerFid, RNGs)) -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` [Char]
"wrong accumulated perception"
[Char]
-> (PerFid, PerFid, RNGs) -> ([Char], (PerFid, PerFid, RNGs))
forall v. [Char] -> v -> ([Char], v)
`swith` (PerFid
sperFid, PerFid
perFid, RNGs
rngs)) ()
() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
keepArenaFact :: Faction -> Bool
keepArenaFact :: Faction -> Bool
keepArenaFact Faction
fact = FactionKind -> Bool
fhasPointman (Faction -> FactionKind
gkind Faction
fact) Bool -> Bool -> Bool
&& FactionKind -> Bool
fneverEmpty (Faction -> FactionKind
gkind Faction
fact)
deduceKilled :: MonadServerAtomic m => ActorId -> m ()
deduceKilled :: ActorId -> m ()
deduceKilled 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
Faction
fact <- (State -> Faction) -> m Faction
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
body) (EnumMap FactionId Faction -> Faction)
-> (State -> EnumMap FactionId Faction) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap FactionId Faction
sfactionD
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (FactionKind -> Bool
fneverEmpty (FactionKind -> Bool) -> FactionKind -> Bool
forall a b. (a -> b) -> a -> b
$ Faction -> FactionKind
gkind Faction
fact) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Bool
actorsAlive <- FactionId -> ActorId -> m Bool
forall (m :: * -> *).
MonadServer m =>
FactionId -> ActorId -> m Bool
anyActorsAlive (Actor -> FactionId
bfid Actor
body) ActorId
aid
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
actorsAlive (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
FactionId -> Status -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
FactionId -> Status -> m ()
deduceQuits (Actor -> FactionId
bfid Actor
body) (Status -> m ()) -> Status -> m ()
forall a b. (a -> b) -> a -> b
$ Outcome -> Int -> Maybe (GroupName ModeKind) -> Status
Status Outcome
Killed (LevelId -> Int
forall a. Enum a => a -> Int
fromEnum (LevelId -> Int) -> LevelId -> Int
forall a b. (a -> b) -> a -> b
$ Actor -> LevelId
blid Actor
body) Maybe (GroupName ModeKind)
forall a. Maybe a
Nothing
anyActorsAlive :: MonadServer m => FactionId -> ActorId -> m Bool
anyActorsAlive :: FactionId -> ActorId -> m Bool
anyActorsAlive FactionId
fid ActorId
aid = do
[(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 -> State -> [(ActorId, Actor)]
fidActorNotProjGlobalAssocs FactionId
fid
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
$! ((ActorId, Actor) -> Bool) -> [(ActorId, Actor)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\(ActorId
aid2, Actor
b2) -> ActorId
aid2 ActorId -> ActorId -> Bool
forall a. Eq a => a -> a -> Bool
/= ActorId
aid Bool -> Bool -> Bool
&& Actor -> Int64
bhp Actor
b2 Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
0) [(ActorId, Actor)]
as
electLeader :: MonadServerAtomic m => FactionId -> LevelId -> ActorId -> m ()
electLeader :: FactionId -> LevelId -> ActorId -> m ()
electLeader FactionId
fid LevelId
lid ActorId
aidToReplace = do
Maybe ActorId
mleader <- (State -> Maybe ActorId) -> m (Maybe ActorId)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Maybe ActorId) -> m (Maybe ActorId))
-> (State -> Maybe ActorId) -> m (Maybe ActorId)
forall a b. (a -> b) -> a -> b
$ Faction -> Maybe ActorId
gleader (Faction -> Maybe ActorId)
-> (State -> Faction) -> State -> Maybe ActorId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
fid) (EnumMap FactionId Faction -> Faction)
-> (State -> EnumMap FactionId Faction) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap FactionId Faction
sfactionD
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe ActorId
mleader Maybe ActorId -> Maybe ActorId -> Bool
forall a. Eq a => a -> a -> Bool
== ActorId -> Maybe ActorId
forall a. a -> Maybe a
Just ActorId
aidToReplace) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
[(ActorId, Actor)]
allOurs <- (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 -> State -> [(ActorId, Actor)]
fidActorNotProjGlobalAssocs FactionId
fid
let
([(ActorId, Actor)]
positive, [(ActorId, Actor)]
negative) = ((ActorId, Actor) -> Bool)
-> [(ActorId, Actor)] -> ([(ActorId, Actor)], [(ActorId, Actor)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (\(ActorId
_, Actor
b) -> Actor -> Int64
bhp Actor
b Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
0) [(ActorId, Actor)]
allOurs
([(ActorId, Actor)]
awake, [(ActorId, Actor)]
sleeping) = ((ActorId, Actor) -> Bool)
-> [(ActorId, Actor)] -> ([(ActorId, Actor)], [(ActorId, Actor)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (\(ActorId
_, Actor
b) -> Actor -> Watchfulness
bwatch Actor
b Watchfulness -> Watchfulness -> Bool
forall a. Eq a => a -> a -> Bool
/= Watchfulness
WSleep) [(ActorId, Actor)]
positive
[(ActorId, Actor)]
onThisLevel <- (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
let candidates :: [(ActorId, Actor)]
candidates = ((ActorId, Actor) -> Bool)
-> [(ActorId, Actor)] -> [(ActorId, Actor)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(ActorId
_, Actor
b) -> Actor -> Watchfulness
bwatch Actor
b Watchfulness -> Watchfulness -> Bool
forall a. Eq a => a -> a -> Bool
/= Watchfulness
WSleep) [(ActorId, Actor)]
onThisLevel
[(ActorId, Actor)] -> [(ActorId, Actor)] -> [(ActorId, Actor)]
forall a. [a] -> [a] -> [a]
++ [(ActorId, Actor)]
awake [(ActorId, Actor)] -> [(ActorId, Actor)] -> [(ActorId, Actor)]
forall a. [a] -> [a] -> [a]
++ [(ActorId, Actor)]
sleeping [(ActorId, Actor)] -> [(ActorId, Actor)] -> [(ActorId, Actor)]
forall a. [a] -> [a] -> [a]
++ [(ActorId, Actor)]
negative
mleaderNew :: Maybe ActorId
mleaderNew = (ActorId -> Bool) -> [ActorId] -> Maybe ActorId
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (ActorId -> ActorId -> Bool
forall a. Eq a => a -> a -> Bool
/= ActorId
aidToReplace) ([ActorId] -> Maybe ActorId) -> [ActorId] -> Maybe ActorId
forall a b. (a -> b) -> a -> b
$ ((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)]
candidates
UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ FactionId -> Maybe ActorId -> Maybe ActorId -> UpdAtomic
UpdLeadFaction FactionId
fid Maybe ActorId
mleader Maybe ActorId
mleaderNew
setFreshLeader :: MonadServerAtomic m => FactionId -> ActorId -> m ()
setFreshLeader :: FactionId -> ActorId -> m ()
setFreshLeader FactionId
fid ActorId
aid = do
Faction
fact <- (State -> Faction) -> m Faction
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
fid) (EnumMap FactionId Faction -> Faction)
-> (State -> EnumMap FactionId Faction) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap FactionId Faction
sfactionD
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (FactionKind -> Bool
fhasPointman (Faction -> FactionKind
gkind Faction
fact)) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ 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
let !_A :: ()
_A = Bool -> () -> ()
forall a. HasCallStack => Bool -> a -> a
assert (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Actor -> Bool
bproj Actor
b) ()
Bool
valid <- (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
$ (EnumMap LevelId Bool -> LevelId -> Bool
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> LevelId
blid Actor
b) (EnumMap LevelId Bool -> Bool)
-> (StateServer -> EnumMap LevelId Bool) -> StateServer -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PerValidFid -> FactionId -> EnumMap LevelId Bool
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
fid) (PerValidFid -> EnumMap LevelId Bool)
-> (StateServer -> PerValidFid)
-> StateServer
-> EnumMap LevelId Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateServer -> PerValidFid
sperValidFid
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
valid (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ FactionId -> LevelId -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
FactionId -> LevelId -> m ()
updatePer FactionId
fid (Actor -> LevelId
blid Actor
b)
UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ FactionId -> Maybe ActorId -> Maybe ActorId -> UpdAtomic
UpdLeadFaction FactionId
fid (Faction -> Maybe ActorId
gleader Faction
fact) (ActorId -> Maybe ActorId
forall a. a -> Maybe a
Just ActorId
aid)
updatePer :: MonadServerAtomic m => FactionId -> LevelId -> m ()
updatePer :: FactionId -> LevelId -> m ()
updatePer FactionId
fid LevelId
lid = do
Perception
perNew <- FactionId -> LevelId -> m Perception
forall (m :: * -> *).
MonadServer m =>
FactionId -> LevelId -> m Perception
recomputeCachePer FactionId
fid LevelId
lid
FactionId -> LevelId -> Perception -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
FactionId -> LevelId -> Perception -> m ()
updatePerFromNew FactionId
fid LevelId
lid Perception
perNew
updatePerFromNew :: MonadServerAtomic m
=> FactionId -> LevelId -> Perception -> m ()
updatePerFromNew :: FactionId -> LevelId -> Perception -> m ()
updatePerFromNew FactionId
fid LevelId
lid Perception
perNew = do
(StateServer -> StateServer) -> m ()
forall (m :: * -> *).
MonadServer m =>
(StateServer -> StateServer) -> m ()
modifyServer ((StateServer -> StateServer) -> m ())
-> (StateServer -> StateServer) -> m ()
forall a b. (a -> b) -> a -> b
$ \StateServer
ser ->
StateServer
ser {sperValidFid :: PerValidFid
sperValidFid = (EnumMap LevelId Bool -> EnumMap LevelId Bool)
-> FactionId -> PerValidFid -> PerValidFid
forall k a. Enum k => (a -> a) -> k -> EnumMap k a -> EnumMap k a
EM.adjust (LevelId -> Bool -> EnumMap LevelId Bool -> EnumMap LevelId Bool
forall k a. Enum k => k -> a -> EnumMap k a -> EnumMap k a
EM.insert LevelId
lid Bool
True) FactionId
fid (PerValidFid -> PerValidFid) -> PerValidFid -> PerValidFid
forall a b. (a -> b) -> a -> b
$ StateServer -> PerValidFid
sperValidFid StateServer
ser}
PerFid
sperFidOld <- (StateServer -> PerFid) -> m PerFid
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> PerFid
sperFid
let perOld :: Perception
perOld = 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
inPer :: Perception
inPer = Perception -> Perception -> Perception
diffPer Perception
perNew Perception
perOld
outPer :: Perception
outPer = Perception -> Perception -> Perception
diffPer Perception
perOld Perception
perNew
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Perception -> Bool
nullPer Perception
outPer Bool -> Bool -> Bool
&& Perception -> Bool
nullPer Perception
inPer) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
let fper :: PerFid -> PerFid
fper = (PerLid -> PerLid) -> FactionId -> PerFid -> PerFid
forall k a. Enum k => (a -> a) -> k -> EnumMap k a -> EnumMap k a
EM.adjust (LevelId -> Perception -> PerLid -> PerLid
forall k a. Enum k => k -> a -> EnumMap k a -> EnumMap k a
EM.insert LevelId
lid Perception
perNew) FactionId
fid
(StateServer -> StateServer) -> m ()
forall (m :: * -> *).
MonadServer m =>
(StateServer -> StateServer) -> m ()
modifyServer ((StateServer -> StateServer) -> m ())
-> (StateServer -> StateServer) -> m ()
forall a b. (a -> b) -> a -> b
$ \StateServer
ser -> StateServer
ser {sperFid :: PerFid
sperFid = PerFid -> PerFid
fper (PerFid -> PerFid) -> PerFid -> PerFid
forall a b. (a -> b) -> a -> b
$ StateServer -> PerFid
sperFid StateServer
ser}
FactionId
-> LevelId -> Perception -> Perception -> Perception -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
FactionId
-> LevelId -> Perception -> Perception -> Perception -> m ()
execSendPer FactionId
fid LevelId
lid Perception
outPer Perception
inPer Perception
perNew
recomputeCachePer :: MonadServer m => FactionId -> LevelId -> m Perception
recomputeCachePer :: FactionId -> LevelId -> m Perception
recomputeCachePer FactionId
fid LevelId
lid = do
CacheBeforeLucid
total <- FactionId -> LevelId -> m CacheBeforeLucid
forall (m :: * -> *).
MonadServer m =>
FactionId -> LevelId -> m CacheBeforeLucid
getCacheTotal FactionId
fid LevelId
lid
FovLucid
fovLucid <- LevelId -> m FovLucid
forall (m :: * -> *). MonadServer m => LevelId -> m FovLucid
getCacheLucid LevelId
lid
(State -> Perception) -> m Perception
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Perception) -> m Perception)
-> (State -> Perception) -> m Perception
forall a b. (a -> b) -> a -> b
$ FactionId
-> LevelId -> FovLucid -> CacheBeforeLucid -> State -> Perception
perceptionFromPTotal FactionId
fid LevelId
lid FovLucid
fovLucid CacheBeforeLucid
total
projectFail :: MonadServerAtomic m
=> ActorId
-> ActorId
-> Point
-> Point
-> Int
-> Bool
-> ItemId
-> CStore
-> Bool
-> m (Maybe ReqFailure)
projectFail :: ActorId
-> ActorId
-> Point
-> Point
-> Int
-> Bool
-> ItemId
-> CStore
-> Bool
-> m (Maybe ReqFailure)
projectFail ActorId
propeller ActorId
origin Point
oxy Point
tpxy Int
eps Bool
center ItemId
iid CStore
cstore Bool
blast = 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
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
origin
let lid :: LevelId
lid = Actor -> LevelId
blid Actor
body
Level
lvl <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel LevelId
lid
case Int -> Point -> Point -> Maybe [Point]
bresenhamsLineAlgorithm Int
eps Point
oxy Point
tpxy of
Maybe [Point]
Nothing -> Maybe ReqFailure -> m (Maybe ReqFailure)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ReqFailure -> m (Maybe ReqFailure))
-> Maybe ReqFailure -> m (Maybe ReqFailure)
forall a b. (a -> b) -> a -> b
$ ReqFailure -> Maybe ReqFailure
forall a. a -> Maybe a
Just ReqFailure
ProjectAimOnself
Just [] -> [Char] -> m (Maybe ReqFailure)
forall a. HasCallStack => [Char] -> a
error ([Char] -> m (Maybe ReqFailure)) -> [Char] -> m (Maybe ReqFailure)
forall a b. (a -> b) -> a -> b
$ [Char]
"projecting from the edge of level"
[Char] -> (Point, Point) -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` (Point
oxy, Point
tpxy)
Just (Point
pos : [Point]
restUnlimited) -> do
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
body CStore
cstore
case ItemId -> ItemBag -> Maybe ItemQuant
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup ItemId
iid ItemBag
bag of
Maybe ItemQuant
Nothing -> Maybe ReqFailure -> m (Maybe ReqFailure)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ReqFailure -> m (Maybe ReqFailure))
-> Maybe ReqFailure -> m (Maybe ReqFailure)
forall a b. (a -> b) -> a -> b
$ ReqFailure -> Maybe ReqFailure
forall a. a -> Maybe a
Just ReqFailure
ProjectOutOfReach
Just ItemQuant
_kit -> do
ItemFull
itemFull <- (State -> ItemFull) -> m ItemFull
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemFull) -> m ItemFull)
-> (State -> ItemFull) -> m ItemFull
forall a b. (a -> b) -> a -> b
$ ItemId -> State -> ItemFull
itemToFull ItemId
iid
Skills
actorSk <- ActorId -> m Skills
forall (m :: * -> *). MonadServer m => ActorId -> m Skills
currentSkillsServer ActorId
origin
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
origin
let skill :: Int
skill = Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkProject Skills
actorSk
forced :: Bool
forced = Bool
blast Bool -> Bool -> Bool
|| Actor -> Bool
bproj Actor
body
calmE :: Bool
calmE = Actor -> Skills -> Bool
calmEnough Actor
body Skills
actorMaxSk
legal :: Either ReqFailure Bool
legal = Bool -> Int -> Bool -> ItemFull -> Either ReqFailure Bool
permittedProject Bool
forced Int
skill Bool
calmE ItemFull
itemFull
arItem :: AspectRecord
arItem = ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFull
case Either ReqFailure Bool
legal of
Left ReqFailure
reqFail -> Maybe ReqFailure -> m (Maybe ReqFailure)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ReqFailure -> m (Maybe ReqFailure))
-> Maybe ReqFailure -> m (Maybe ReqFailure)
forall a b. (a -> b) -> a -> b
$ ReqFailure -> Maybe ReqFailure
forall a. a -> Maybe a
Just ReqFailure
reqFail
Right Bool
_ -> do
let lobable :: Bool
lobable = Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Lobable AspectRecord
arItem
rest :: [Point]
rest = if Bool
lobable
then Int -> [Point] -> [Point]
forall a. Int -> [a] -> [a]
take (Point -> Point -> Int
chessDist Point
oxy Point
tpxy Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [Point]
restUnlimited
else [Point]
restUnlimited
t :: ContentId TileKind
t = Level
lvl Level -> Point -> ContentId TileKind
`at` Point
pos
if | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ TileSpeedup -> ContentId TileKind -> Bool
Tile.isWalkable TileSpeedup
coTileSpeedup ContentId TileKind
t ->
Maybe ReqFailure -> m (Maybe ReqFailure)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ReqFailure -> m (Maybe ReqFailure))
-> Maybe ReqFailure -> m (Maybe ReqFailure)
forall a b. (a -> b) -> a -> b
$ ReqFailure -> Maybe ReqFailure
forall a. a -> Maybe a
Just ReqFailure
ProjectBlockTerrain
| Point -> Level -> Bool
occupiedBigLvl Point
pos Level
lvl ->
if Bool
blast then do
ActorId
-> ActorId -> Point -> [Point] -> ItemId -> CStore -> Bool -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId
-> ActorId -> Point -> [Point] -> ItemId -> CStore -> Bool -> m ()
projectBla ActorId
propeller ActorId
origin Point
oxy (Point
posPoint -> [Point] -> [Point]
forall a. a -> [a] -> [a]
:[Point]
rest)
ItemId
iid CStore
cstore Bool
blast
Maybe ReqFailure -> m (Maybe ReqFailure)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ReqFailure
forall a. Maybe a
Nothing
else Maybe ReqFailure -> m (Maybe ReqFailure)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ReqFailure -> m (Maybe ReqFailure))
-> Maybe ReqFailure -> m (Maybe ReqFailure)
forall a b. (a -> b) -> a -> b
$ ReqFailure -> Maybe ReqFailure
forall a. a -> Maybe a
Just ReqFailure
ProjectBlockActor
| Bool
otherwise -> do
if Bool
blast Bool -> Bool -> Bool
&& Bool
center then
ActorId
-> ActorId -> Point -> [Point] -> ItemId -> CStore -> Bool -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId
-> ActorId -> Point -> [Point] -> ItemId -> CStore -> Bool -> m ()
projectBla ActorId
propeller ActorId
origin Point
oxy (Point
posPoint -> [Point] -> [Point]
forall a. a -> [a] -> [a]
:[Point]
rest)
ItemId
iid CStore
cstore Bool
blast
else
ActorId
-> ActorId -> Point -> [Point] -> ItemId -> CStore -> Bool -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId
-> ActorId -> Point -> [Point] -> ItemId -> CStore -> Bool -> m ()
projectBla ActorId
propeller ActorId
origin Point
pos [Point]
rest
ItemId
iid CStore
cstore Bool
blast
Maybe ReqFailure -> m (Maybe ReqFailure)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ReqFailure
forall a. Maybe a
Nothing
projectBla :: MonadServerAtomic m
=> ActorId
-> ActorId
-> Point
-> [Point]
-> ItemId
-> CStore
-> Bool
-> m ()
projectBla :: ActorId
-> ActorId -> Point -> [Point] -> ItemId -> CStore -> Bool -> m ()
projectBla ActorId
propeller ActorId
origin Point
pos [Point]
rest ItemId
iid CStore
cstore Bool
blast = 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
origin
let lid :: LevelId
lid = Actor -> LevelId
blid Actor
body
Time
localTime <- (State -> Time) -> m Time
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Time) -> m Time) -> (State -> Time) -> m Time
forall a b. (a -> b) -> a -> b
$ LevelId -> State -> Time
getLocalTime LevelId
lid
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
blast (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ SfxAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => SfxAtomic -> m ()
execSfxAtomic (SfxAtomic -> m ()) -> SfxAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ ActorId -> ItemId -> SfxAtomic
SfxProject ActorId
origin ItemId
iid
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
body CStore
cstore
ItemFull{ItemKind
itemKind :: ItemFull -> ItemKind
itemKind :: ItemKind
itemKind} <- (State -> ItemFull) -> m ItemFull
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemFull) -> m ItemFull)
-> (State -> ItemFull) -> m ItemFull
forall a b. (a -> b) -> a -> b
$ ItemId -> State -> ItemFull
itemToFull ItemId
iid
case ItemId
iid ItemId -> ItemBag -> Maybe ItemQuant
forall k a. Enum k => k -> EnumMap k a -> Maybe a
`EM.lookup` ItemBag
bag of
Maybe ItemQuant
Nothing -> [Char] -> m ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> m ()) -> [Char] -> m ()
forall a b. (a -> b) -> a -> b
$ [Char]
"" [Char] -> (ActorId, Point, [Point], ItemId, CStore) -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` (ActorId
origin, Point
pos, [Point]
rest, ItemId
iid, CStore
cstore)
Just kit :: ItemQuant
kit@(Int
_, ItemTimers
it) -> do
let delay :: Time
delay =
if ItemKind -> Int
IK.iweight ItemKind
itemKind Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
then Time
timeTurn
else Time
timeZero
btime :: Time
btime = Time -> Time -> Time
absoluteTimeAdd Time
delay Time
localTime
ActorId
-> Point
-> [Point]
-> ItemId
-> ItemQuant
-> LevelId
-> FactionId
-> Time
-> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId
-> Point
-> [Point]
-> ItemId
-> ItemQuant
-> LevelId
-> FactionId
-> Time
-> m ()
addProjectile ActorId
propeller Point
pos [Point]
rest ItemId
iid ItemQuant
kit LevelId
lid (Actor -> FactionId
bfid Actor
body) Time
btime
let c :: Container
c = ActorId -> CStore -> Container
CActor ActorId
origin CStore
cstore
UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ Bool -> ItemId -> ItemQuant -> Container -> UpdAtomic
UpdLoseItem Bool
False ItemId
iid (Int
1, Int -> ItemTimers -> ItemTimers
forall a. Int -> [a] -> [a]
take Int
1 ItemTimers
it) Container
c
addActorFromGroup :: MonadServerAtomic m
=> GroupName ItemKind -> FactionId -> Point -> LevelId -> Time
-> m (Maybe ActorId)
addActorFromGroup :: GroupName ItemKind
-> FactionId -> Point -> LevelId -> Time -> m (Maybe ActorId)
addActorFromGroup GroupName ItemKind
actorGroup FactionId
fid Point
pos LevelId
lid Time
time = do
Level{AbsDepth
ldepth :: AbsDepth
ldepth :: Level -> AbsDepth
ldepth} <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel LevelId
lid
Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
freq <- Int
-> AbsDepth
-> Freqs ItemKind
-> m (Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind))
forall (m :: * -> *).
MonadServerAtomic m =>
Int
-> AbsDepth
-> Freqs ItemKind
-> m (Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind))
prepareItemKind Int
0 AbsDepth
ldepth [(GroupName ItemKind
actorGroup, Int
1)]
NewItem
m2 <- Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
-> AbsDepth -> m NewItem
forall (m :: * -> *).
MonadServerAtomic m =>
Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
-> AbsDepth -> m NewItem
rollItemAspect Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
freq AbsDepth
ldepth
case NewItem
m2 of
NewItem
NoNewItem -> Maybe ActorId -> m (Maybe ActorId)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ActorId
forall a. Maybe a
Nothing
NewItem GroupName ItemKind
_ ItemKnown
itemKnown ItemFull
itemFull ItemQuant
itemQuant -> do
let itemFullKit :: (ItemFull, ItemQuant)
itemFullKit = (ItemFull
itemFull, ItemQuant
itemQuant)
ActorId -> Maybe ActorId
forall a. a -> Maybe a
Just (ActorId -> Maybe ActorId) -> m ActorId -> m (Maybe ActorId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool
-> ItemKnown
-> (ItemFull, ItemQuant)
-> FactionId
-> Point
-> LevelId
-> Time
-> m ActorId
forall (m :: * -> *).
MonadServerAtomic m =>
Bool
-> ItemKnown
-> (ItemFull, ItemQuant)
-> FactionId
-> Point
-> LevelId
-> Time
-> m ActorId
registerActor Bool
False ItemKnown
itemKnown (ItemFull, ItemQuant)
itemFullKit FactionId
fid Point
pos LevelId
lid Time
time
registerActor :: MonadServerAtomic m
=> Bool -> ItemKnown -> ItemFullKit
-> FactionId -> Point -> LevelId -> Time
-> m ActorId
registerActor :: Bool
-> ItemKnown
-> (ItemFull, ItemQuant)
-> FactionId
-> Point
-> LevelId
-> Time
-> m ActorId
registerActor Bool
summoned (ItemKnown ItemIdentity
kindIx AspectRecord
ar Maybe FactionId
_) (ItemFull
itemFullRaw, ItemQuant
kit)
FactionId
bfid Point
pos LevelId
lid Time
time = do
COps{ContentData CaveKind
cocave :: COps -> ContentData CaveKind
cocave :: ContentData CaveKind
cocave} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
let container :: Container
container = FactionId -> LevelId -> Point -> Container
CTrunk FactionId
bfid LevelId
lid Point
pos
jfid :: Maybe FactionId
jfid = FactionId -> Maybe FactionId
forall a. a -> Maybe a
Just FactionId
bfid
itemKnown :: ItemKnown
itemKnown = ItemIdentity -> AspectRecord -> Maybe FactionId -> ItemKnown
ItemKnown ItemIdentity
kindIx AspectRecord
ar Maybe FactionId
jfid
itemFull :: ItemFull
itemFull = ItemFull
itemFullRaw {itemBase :: Item
itemBase = (ItemFull -> Item
itemBase ItemFull
itemFullRaw) {Maybe FactionId
jfid :: Maybe FactionId
jfid :: Maybe FactionId
jfid}}
ItemId
trunkId <- Bool -> (ItemFull, ItemQuant) -> ItemKnown -> Container -> m ItemId
forall (m :: * -> *).
MonadServerAtomic m =>
Bool -> (ItemFull, ItemQuant) -> ItemKnown -> Container -> m ItemId
registerItem Bool
False (ItemFull
itemFull, ItemQuant
kit) ItemKnown
itemKnown Container
container
ActorId
aid <- Bool
-> ItemId
-> (ItemFull, ItemQuant)
-> FactionId
-> Point
-> LevelId
-> Time
-> m ActorId
forall (m :: * -> *).
MonadServerAtomic m =>
Bool
-> ItemId
-> (ItemFull, ItemQuant)
-> FactionId
-> Point
-> LevelId
-> Time
-> m ActorId
addNonProjectile Bool
summoned ItemId
trunkId (ItemFull
itemFull, ItemQuant
kit) FactionId
bfid Point
pos LevelId
lid Time
time
Faction
fact <- (State -> Faction) -> m Faction
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
bfid) (EnumMap FactionId Faction -> Faction)
-> (State -> EnumMap FactionId Faction) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap FactionId Faction
sfactionD
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
condAnyFoeAdj <- (State -> Bool) -> m Bool
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Bool) -> m Bool) -> (State -> Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Bool
anyFoeAdj ActorId
aid
Level{ContentId CaveKind
lkind :: Level -> ContentId CaveKind
lkind :: ContentId CaveKind
lkind} <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel LevelId
lid
let cinitSleep :: InitSleep
cinitSleep = CaveKind -> InitSleep
CK.cinitSleep (CaveKind -> InitSleep) -> CaveKind -> InitSleep
forall a b. (a -> b) -> a -> b
$ ContentData CaveKind -> ContentId CaveKind -> CaveKind
forall a. ContentData a -> ContentId a -> a
okind ContentData CaveKind
cocave ContentId CaveKind
lkind
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (InitSleep
cinitSleep InitSleep -> InitSleep -> Bool
forall a. Eq a => a -> a -> Bool
/= InitSleep
CK.InitSleepBanned
Bool -> Bool -> Bool
&& Skills -> Bool
canSleep Skills
actorMaxSk
Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
condAnyFoeAdj
Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
summoned
Bool -> Bool -> Bool
&& Bool -> Bool
not (FactionKind -> Bool
fhasGender (Faction -> FactionKind
gkind Faction
fact))) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
let sleepOdds :: Ratio Integer
sleepOdds = if Skills -> Bool
prefersSleep Skills
actorMaxSk then Integer
19Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
%Integer
20 else Integer
2Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
%Integer
3
Bool
sleeps <- Rnd Bool -> m Bool
forall (m :: * -> *) a. MonadServer m => Rnd a -> m a
rndToAction (Rnd Bool -> m Bool) -> Rnd Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Ratio Integer -> Rnd Bool
chance Ratio Integer
sleepOdds
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (InitSleep
cinitSleep InitSleep -> InitSleep -> Bool
forall a. Eq a => a -> a -> Bool
== InitSleep
CK.InitSleepAlways Bool -> Bool -> Bool
|| Bool
sleeps) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ ActorId -> m ()
forall (m :: * -> *). MonadServerAtomic m => ActorId -> m ()
addSleep ActorId
aid
ActorId -> m ActorId
forall (m :: * -> *) a. Monad m => a -> m a
return ActorId
aid
addProjectile :: MonadServerAtomic m
=> ActorId -> Point -> [Point] -> ItemId -> ItemQuant -> LevelId
-> FactionId -> Time
-> m ()
addProjectile :: ActorId
-> Point
-> [Point]
-> ItemId
-> ItemQuant
-> LevelId
-> FactionId
-> Time
-> m ()
addProjectile ActorId
propeller Point
pos [Point]
rest ItemId
iid (Int
_, ItemTimers
it) LevelId
lid FactionId
fid Time
time = do
ItemFull
itemFull <- (State -> ItemFull) -> m ItemFull
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemFull) -> m ItemFull)
-> (State -> ItemFull) -> m ItemFull
forall a b. (a -> b) -> a -> b
$ ItemId -> State -> ItemFull
itemToFull ItemId
iid
let arItem :: AspectRecord
arItem = ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFull
IK.ThrowMod{Int
throwHP :: ThrowMod -> Int
throwHP :: Int
IK.throwHP} = AspectRecord -> ThrowMod
IA.aToThrow AspectRecord
arItem
([Vector]
trajectory, (Speed
speed, Int
_)) =
AspectRecord -> ItemKind -> [Point] -> ([Vector], (Speed, Int))
IA.itemTrajectory AspectRecord
arItem (ItemFull -> ItemKind
itemKind ItemFull
itemFull) (Point
pos Point -> [Point] -> [Point]
forall a. a -> [a] -> [a]
: [Point]
rest)
tweakBody :: Actor -> Actor
tweakBody Actor
b = Actor
b { bhp :: Int64
bhp = Int -> Int64
xM Int
throwHP
, btrajectory :: Maybe ([Vector], Speed)
btrajectory = ([Vector], Speed) -> Maybe ([Vector], Speed)
forall a. a -> Maybe a
Just ([Vector]
trajectory, Speed
speed)
, beqp :: ItemBag
beqp = ItemId -> ItemQuant -> ItemBag
forall k a. Enum k => k -> a -> EnumMap k a
EM.singleton ItemId
iid (Int
1, Int -> ItemTimers -> ItemTimers
forall a. Int -> [a] -> [a]
take Int
1 ItemTimers
it) }
ActorId
aid <- ItemId
-> ItemFull
-> Bool
-> FactionId
-> Point
-> LevelId
-> (Actor -> Actor)
-> m ActorId
forall (m :: * -> *).
MonadServerAtomic m =>
ItemId
-> ItemFull
-> Bool
-> FactionId
-> Point
-> LevelId
-> (Actor -> Actor)
-> m ActorId
addActorIid ItemId
iid ItemFull
itemFull Bool
True FactionId
fid Point
pos LevelId
lid Actor -> Actor
tweakBody
Actor
bp <- (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
propeller
ActorId
originator <- if Actor -> Bool
bproj Actor
bp
then (StateServer -> ActorId) -> m ActorId
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer ((StateServer -> ActorId) -> m ActorId)
-> (StateServer -> ActorId) -> m ActorId
forall a b. (a -> b) -> a -> b
$ ActorId -> ActorId -> EnumMap ActorId ActorId -> ActorId
forall k a. Enum k => a -> k -> EnumMap k a -> a
EM.findWithDefault ActorId
propeller ActorId
propeller
(EnumMap ActorId ActorId -> ActorId)
-> (StateServer -> EnumMap ActorId ActorId)
-> StateServer
-> ActorId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateServer -> EnumMap ActorId ActorId
strajPushedBy
else ActorId -> m ActorId
forall (m :: * -> *) a. Monad m => a -> m a
return ActorId
propeller
(StateServer -> StateServer) -> m ()
forall (m :: * -> *).
MonadServer m =>
(StateServer -> StateServer) -> m ()
modifyServer ((StateServer -> StateServer) -> m ())
-> (StateServer -> StateServer) -> m ()
forall a b. (a -> b) -> a -> b
$ \StateServer
ser ->
StateServer
ser { strajTime :: ActorTime
strajTime = FactionId -> LevelId -> ActorId -> Time -> ActorTime -> ActorTime
updateActorTime FactionId
fid LevelId
lid ActorId
aid Time
time (ActorTime -> ActorTime) -> ActorTime -> ActorTime
forall a b. (a -> b) -> a -> b
$ StateServer -> ActorTime
strajTime StateServer
ser
, strajPushedBy :: EnumMap ActorId ActorId
strajPushedBy = ActorId
-> ActorId -> EnumMap ActorId ActorId -> EnumMap ActorId ActorId
forall k a. Enum k => k -> a -> EnumMap k a -> EnumMap k a
EM.insert ActorId
aid ActorId
originator (EnumMap ActorId ActorId -> EnumMap ActorId ActorId)
-> EnumMap ActorId ActorId -> EnumMap ActorId ActorId
forall a b. (a -> b) -> a -> b
$ StateServer -> EnumMap ActorId ActorId
strajPushedBy StateServer
ser }
addNonProjectile :: MonadServerAtomic m
=> Bool -> ItemId -> ItemFullKit -> FactionId -> Point
-> LevelId -> Time
-> m ActorId
addNonProjectile :: Bool
-> ItemId
-> (ItemFull, ItemQuant)
-> FactionId
-> Point
-> LevelId
-> Time
-> m ActorId
addNonProjectile Bool
summoned ItemId
trunkId (ItemFull
itemFull, ItemQuant
kit) FactionId
fid Point
pos LevelId
lid Time
time = do
let tweakBody :: Actor -> Actor
tweakBody Actor
b = Actor
b { borgan :: ItemBag
borgan = ItemId -> ItemQuant -> ItemBag
forall k a. Enum k => k -> a -> EnumMap k a
EM.singleton ItemId
trunkId ItemQuant
kit
, bcalm :: Int64
bcalm = if Bool
summoned
then Int -> Int64
xM Int
5
else Actor -> Int64
bcalm Actor
b }
ActorId
aid <- ItemId
-> ItemFull
-> Bool
-> FactionId
-> Point
-> LevelId
-> (Actor -> Actor)
-> m ActorId
forall (m :: * -> *).
MonadServerAtomic m =>
ItemId
-> ItemFull
-> Bool
-> FactionId
-> Point
-> LevelId
-> (Actor -> Actor)
-> m ActorId
addActorIid ItemId
trunkId ItemFull
itemFull Bool
False FactionId
fid Point
pos LevelId
lid Actor -> Actor
tweakBody
(StateServer -> StateServer) -> m ()
forall (m :: * -> *).
MonadServer m =>
(StateServer -> StateServer) -> m ()
modifyServer ((StateServer -> StateServer) -> m ())
-> (StateServer -> StateServer) -> m ()
forall a b. (a -> b) -> a -> b
$ \StateServer
ser ->
StateServer
ser {sactorTime :: ActorTime
sactorTime = FactionId -> LevelId -> ActorId -> Time -> ActorTime -> ActorTime
updateActorTime FactionId
fid LevelId
lid ActorId
aid Time
time (ActorTime -> ActorTime) -> ActorTime -> ActorTime
forall a b. (a -> b) -> a -> b
$ StateServer -> ActorTime
sactorTime StateServer
ser}
ActorId -> m ActorId
forall (m :: * -> *) a. Monad m => a -> m a
return ActorId
aid
addActorIid :: MonadServerAtomic m
=> ItemId -> ItemFull -> Bool -> FactionId -> Point -> LevelId
-> (Actor -> Actor)
-> m ActorId
addActorIid :: ItemId
-> ItemFull
-> Bool
-> FactionId
-> Point
-> LevelId
-> (Actor -> Actor)
-> m ActorId
addActorIid ItemId
trunkId ItemFull{Item
itemBase :: Item
itemBase :: ItemFull -> Item
itemBase, ItemKind
itemKind :: ItemKind
itemKind :: ItemFull -> ItemKind
itemKind, itemDisco :: ItemFull -> ItemDisco
itemDisco=ItemDiscoFull AspectRecord
arItem}
Bool
bproj FactionId
fid Point
pos LevelId
lid Actor -> Actor
tweakBody = do
COps{ContentData ItemKind
coitem :: ContentData ItemKind
coitem :: COps -> ContentData ItemKind
coitem} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
let trunkMaxHP :: Int
trunkMaxHP = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
2 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Skill -> AspectRecord -> Int
IA.getSkill Skill
Ability.SkMaxHP AspectRecord
arItem
hp :: Int64
hp = Int -> Int64
xM Int
trunkMaxHP Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`div` Int64
2
calm :: Int64
calm = Int -> Int64
xM (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Skill -> AspectRecord -> Int
IA.getSkill Skill
Ability.SkMaxCalm AspectRecord
arItem Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
10)
EnumMap FactionId Faction
factionD <- (State -> EnumMap FactionId Faction)
-> m (EnumMap FactionId Faction)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> EnumMap FactionId Faction
sfactionD
Challenge
curChalSer <- (StateServer -> Challenge) -> m Challenge
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer ((StateServer -> Challenge) -> m Challenge)
-> (StateServer -> Challenge) -> m Challenge
forall a b. (a -> b) -> a -> b
$ ServerOptions -> Challenge
scurChalSer (ServerOptions -> Challenge)
-> (StateServer -> ServerOptions) -> StateServer -> Challenge
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateServer -> ServerOptions
soptions
let fact :: Faction
fact = EnumMap FactionId Faction
factionD EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
fid
teamContinuityOurs :: TeamContinuity
teamContinuityOurs = FactionKind -> TeamContinuity
fteam (Faction -> FactionKind
gkind Faction
fact)
Maybe (Int, TeamContinuity)
bnumberTeam <-
if Bool
bproj then Maybe (Int, TeamContinuity) -> m (Maybe (Int, TeamContinuity))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Int, TeamContinuity)
forall a. Maybe a
Nothing else do
EnumMap TeamContinuity Int
stcounter <- (StateServer -> EnumMap TeamContinuity Int)
-> m (EnumMap TeamContinuity Int)
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> EnumMap TeamContinuity Int
stcounter
let number :: Int
number = Int -> TeamContinuity -> EnumMap TeamContinuity Int -> Int
forall k a. Enum k => a -> k -> EnumMap k a -> a
EM.findWithDefault Int
0 TeamContinuity
teamContinuityOurs EnumMap TeamContinuity Int
stcounter
(StateServer -> StateServer) -> m ()
forall (m :: * -> *).
MonadServer m =>
(StateServer -> StateServer) -> m ()
modifyServer ((StateServer -> StateServer) -> m ())
-> (StateServer -> StateServer) -> m ()
forall a b. (a -> b) -> a -> b
$ \StateServer
ser -> StateServer
ser {stcounter :: EnumMap TeamContinuity Int
stcounter =
TeamContinuity
-> Int -> EnumMap TeamContinuity Int -> EnumMap TeamContinuity Int
forall k a. Enum k => k -> a -> EnumMap k a -> EnumMap k a
EM.insert TeamContinuity
teamContinuityOurs (Int -> Int
forall a. Enum a => a -> a
succ Int
number) EnumMap TeamContinuity Int
stcounter}
Maybe (Int, TeamContinuity) -> m (Maybe (Int, TeamContinuity))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Int, TeamContinuity) -> m (Maybe (Int, TeamContinuity)))
-> Maybe (Int, TeamContinuity) -> m (Maybe (Int, TeamContinuity))
forall a b. (a -> b) -> a -> b
$ (Int, TeamContinuity) -> Maybe (Int, TeamContinuity)
forall a. a -> Maybe a
Just (Int
number, TeamContinuity
teamContinuityOurs)
let bnumber :: Maybe Int
bnumber = (Int, TeamContinuity) -> Int
forall a b. (a, b) -> a
fst ((Int, TeamContinuity) -> Int)
-> Maybe (Int, TeamContinuity) -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Int, TeamContinuity)
bnumberTeam
let diffBonusCoeff :: Int
diffBonusCoeff = Int -> Int
difficultyCoeff (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Challenge -> Int
cdiff Challenge
curChalSer
boostFact :: Bool
boostFact = Bool -> Bool
not Bool
bproj
Bool -> Bool -> Bool
&& if Int
diffBonusCoeff Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
then ((FactionId, Faction) -> Bool) -> [(FactionId, Faction)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (FactionKind -> Bool
fhasUI (FactionKind -> Bool)
-> ((FactionId, Faction) -> FactionKind)
-> (FactionId, Faction)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Faction -> FactionKind
gkind (Faction -> FactionKind)
-> ((FactionId, Faction) -> Faction)
-> (FactionId, Faction)
-> FactionKind
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FactionId, Faction) -> Faction
forall a b. (a, b) -> b
snd)
(((FactionId, Faction) -> Bool)
-> [(FactionId, Faction)] -> [(FactionId, Faction)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(FactionId
fi, Faction
fa) -> FactionId -> Faction -> FactionId -> Bool
isFriend FactionId
fi Faction
fa FactionId
fid)
(EnumMap FactionId Faction -> [(FactionId, Faction)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs EnumMap FactionId Faction
factionD))
else ((FactionId, Faction) -> Bool) -> [(FactionId, Faction)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (FactionKind -> Bool
fhasUI (FactionKind -> Bool)
-> ((FactionId, Faction) -> FactionKind)
-> (FactionId, Faction)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Faction -> FactionKind
gkind (Faction -> FactionKind)
-> ((FactionId, Faction) -> Faction)
-> (FactionId, Faction)
-> FactionKind
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FactionId, Faction) -> Faction
forall a b. (a, b) -> b
snd)
(((FactionId, Faction) -> Bool)
-> [(FactionId, Faction)] -> [(FactionId, Faction)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(FactionId
fi, Faction
fa) -> FactionId -> Faction -> FactionId -> Bool
isFoe FactionId
fi Faction
fa FactionId
fid)
(EnumMap FactionId Faction -> [(FactionId, Faction)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs EnumMap FactionId Faction
factionD))
finalHP :: Int64
finalHP | Bool
boostFact = Int64 -> Int64 -> Int64
forall a. Ord a => a -> a -> a
min (Int -> Int64
xM Int
899)
(Int64
hp Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
2 Int64 -> Int -> Int64
forall a b. (Num a, Integral b) => a -> b -> a
^ Int -> Int
forall a. Num a => a -> a
abs Int
diffBonusCoeff)
| Bool
otherwise = Int64
hp
maxHP :: Int64
maxHP = Int64 -> Int64 -> Int64
forall a. Ord a => a -> a -> a
min (Int64
finalHP Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int -> Int64
xM Int
100) (Int64
2 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
finalHP)
bonusHP :: Int
bonusHP = Int64 -> Int
forall a. Enum a => a -> Int
fromEnum (Int64
maxHP Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`div` Int64
oneM) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
trunkMaxHP
healthOrgans :: [(Maybe Int, (GroupName ItemKind, CStore))]
healthOrgans = [(Int -> Maybe Int
forall a. a -> Maybe a
Just Int
bonusHP, (GroupName ItemKind
IK.S_BONUS_HP, CStore
COrgan)) | Int
bonusHP Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0]
b :: Actor
b = ItemId
-> Maybe Int
-> Int64
-> Int64
-> Point
-> LevelId
-> FactionId
-> Bool
-> Actor
actorTemplate ItemId
trunkId Maybe Int
bnumber Int64
finalHP Int64
calm Point
pos LevelId
lid FactionId
fid Bool
bproj
withTrunk :: Actor
withTrunk =
Actor
b { bweapon :: Int
bweapon = if Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Meleeable AspectRecord
arItem then Int
1 else Int
0
, bweapBenign :: Int
bweapBenign =
if Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Meleeable AspectRecord
arItem
Bool -> Bool -> Bool
&& Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Benign AspectRecord
arItem then Int
1 else Int
0 }
bodyTweaked :: Actor
bodyTweaked = Actor -> Actor
tweakBody Actor
withTrunk
ActorId
aid <- (StateServer -> ActorId) -> m ActorId
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> ActorId
sacounter
(StateServer -> StateServer) -> m ()
forall (m :: * -> *).
MonadServer m =>
(StateServer -> StateServer) -> m ()
modifyServer ((StateServer -> StateServer) -> m ())
-> (StateServer -> StateServer) -> m ()
forall a b. (a -> b) -> a -> b
$ \StateServer
ser -> StateServer
ser {sacounter :: ActorId
sacounter = ActorId -> ActorId
forall a. Enum a => a -> a
succ ActorId
aid}
UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ ActorId -> Actor -> [(ItemId, Item)] -> UpdAtomic
UpdCreateActor ActorId
aid Actor
bodyTweaked [(ItemId
trunkId, Item
itemBase)]
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
bproj (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
GearOfTeams
steamGearCur <- (StateServer -> GearOfTeams) -> m GearOfTeams
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> GearOfTeams
steamGearCur
let gearList :: [(GroupName ItemKind, ContentId ItemKind)]
gearList = case Maybe (Int, TeamContinuity)
bnumberTeam of
Maybe (Int, TeamContinuity)
Nothing -> []
Just (Int
number, TeamContinuity
teamContinuity) ->
case TeamContinuity
teamContinuity TeamContinuity
-> GearOfTeams
-> Maybe (IntMap [(GroupName ItemKind, ContentId ItemKind)])
forall k a. Enum k => k -> EnumMap k a -> Maybe a
`EM.lookup` GearOfTeams
steamGearCur of
Maybe (IntMap [(GroupName ItemKind, ContentId ItemKind)])
Nothing -> []
Just IntMap [(GroupName ItemKind, ContentId ItemKind)]
im -> [(GroupName ItemKind, ContentId ItemKind)]
-> Int
-> IntMap [(GroupName ItemKind, ContentId ItemKind)]
-> [(GroupName ItemKind, ContentId ItemKind)]
forall a. a -> Int -> IntMap a -> a
IM.findWithDefault [] Int
number IntMap [(GroupName ItemKind, ContentId ItemKind)]
im
[(Maybe Int, (GroupName ItemKind, CStore))]
-> ((Maybe Int, (GroupName ItemKind, CStore)) -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t a -> (a -> m ()) -> m ()
forM_ ([(Maybe Int, (GroupName ItemKind, CStore))]
healthOrgans [(Maybe Int, (GroupName ItemKind, CStore))]
-> [(Maybe Int, (GroupName ItemKind, CStore))]
-> [(Maybe Int, (GroupName ItemKind, CStore))]
forall a. [a] -> [a] -> [a]
++ ((GroupName ItemKind, CStore)
-> (Maybe Int, (GroupName ItemKind, CStore)))
-> [(GroupName ItemKind, CStore)]
-> [(Maybe Int, (GroupName ItemKind, CStore))]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe Int
forall a. Maybe a
Nothing,) (ItemKind -> [(GroupName ItemKind, CStore)]
IK.ikit ItemKind
itemKind))
(((Maybe Int, (GroupName ItemKind, CStore)) -> m ()) -> m ())
-> ((Maybe Int, (GroupName ItemKind, CStore)) -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \(Maybe Int
mk, (GroupName ItemKind
ikGrp, CStore
cstore)) -> do
if GroupName ItemKind
ikGrp GroupName ItemKind -> GroupName ItemKind -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> GroupName ItemKind
forall c. Text -> GroupName c
DefsInternal.GroupName Text
"backstory"
Bool -> Bool -> Bool
&& Maybe (Int, TeamContinuity) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (Int, TeamContinuity)
bnumberTeam
Bool -> Bool -> Bool
&& ((Int, TeamContinuity) -> TeamContinuity
forall a b. (a, b) -> b
snd ((Int, TeamContinuity) -> TeamContinuity)
-> Maybe (Int, TeamContinuity) -> Maybe TeamContinuity
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Int, TeamContinuity)
bnumberTeam) Maybe TeamContinuity -> Maybe TeamContinuity -> Bool
forall a. Eq a => a -> a -> Bool
/= TeamContinuity -> Maybe TeamContinuity
forall a. a -> Maybe a
Just TeamContinuity
teamExplorer
then () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
else do
let container :: Container
container = ActorId -> CStore -> Container
CActor ActorId
aid CStore
cstore
Level{AbsDepth
ldepth :: AbsDepth
ldepth :: Level -> AbsDepth
ldepth} <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel LevelId
lid
Maybe (ItemId, (ItemFull, ItemQuant))
mIidEtc <- case GroupName ItemKind
-> [(GroupName ItemKind, ContentId ItemKind)]
-> Maybe (ContentId ItemKind)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup GroupName ItemKind
ikGrp [(GroupName ItemKind, ContentId ItemKind)]
gearList of
Maybe (ContentId ItemKind)
Nothing -> do
let itemFreq :: Freqs ItemKind
itemFreq = [(GroupName ItemKind
ikGrp, Int
1)]
Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
freq <- Int
-> AbsDepth
-> Freqs ItemKind
-> m (Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind))
forall (m :: * -> *).
MonadServerAtomic m =>
Int
-> AbsDepth
-> Freqs ItemKind
-> m (Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind))
prepareItemKind Int
0 AbsDepth
ldepth Freqs ItemKind
itemFreq
Maybe (ItemId, (ItemFull, ItemQuant))
mIidEtc <- Bool
-> AbsDepth
-> Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
-> Container
-> Maybe Int
-> m (Maybe (ItemId, (ItemFull, ItemQuant)))
forall (m :: * -> *).
MonadServerAtomic m =>
Bool
-> AbsDepth
-> Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
-> Container
-> Maybe Int
-> m (Maybe (ItemId, (ItemFull, ItemQuant)))
rollAndRegisterItem Bool
False AbsDepth
ldepth Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
freq Container
container Maybe Int
mk
case (Maybe (Int, TeamContinuity)
bnumberTeam, Maybe (ItemId, (ItemFull, ItemQuant))
mIidEtc) of
(Just (Int
number, TeamContinuity
teamContinuity), Just (ItemId
_, (ItemFull
itemFull2, ItemQuant
_))) -> do
let arItem2 :: AspectRecord
arItem2 = ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFull2
inMetaGame :: Bool
inMetaGame = Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.MetaGame AspectRecord
arItem2
itemKindId2 :: ContentId ItemKind
itemKindId2 = ItemFull -> ContentId ItemKind
itemKindId ItemFull
itemFull2
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
inMetaGame (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
let altInner :: Maybe [(GroupName ItemKind, ContentId ItemKind)]
-> Maybe [(GroupName ItemKind, ContentId ItemKind)]
altInner Maybe [(GroupName ItemKind, ContentId ItemKind)]
ml = [(GroupName ItemKind, ContentId ItemKind)]
-> Maybe [(GroupName ItemKind, ContentId ItemKind)]
forall a. a -> Maybe a
Just ([(GroupName ItemKind, ContentId ItemKind)]
-> Maybe [(GroupName ItemKind, ContentId ItemKind)])
-> [(GroupName ItemKind, ContentId ItemKind)]
-> Maybe [(GroupName ItemKind, ContentId ItemKind)]
forall a b. (a -> b) -> a -> b
$ (GroupName ItemKind
ikGrp, ContentId ItemKind
itemKindId2) (GroupName ItemKind, ContentId ItemKind)
-> [(GroupName ItemKind, ContentId ItemKind)]
-> [(GroupName ItemKind, ContentId ItemKind)]
forall a. a -> [a] -> [a]
: [(GroupName ItemKind, ContentId ItemKind)]
-> Maybe [(GroupName ItemKind, ContentId ItemKind)]
-> [(GroupName ItemKind, ContentId ItemKind)]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [(GroupName ItemKind, ContentId ItemKind)]
ml
alt :: Maybe (IntMap [(GroupName ItemKind, ContentId ItemKind)])
-> Maybe (IntMap [(GroupName ItemKind, ContentId ItemKind)])
alt Maybe (IntMap [(GroupName ItemKind, ContentId ItemKind)])
mim =
IntMap [(GroupName ItemKind, ContentId ItemKind)]
-> Maybe (IntMap [(GroupName ItemKind, ContentId ItemKind)])
forall a. a -> Maybe a
Just (IntMap [(GroupName ItemKind, ContentId ItemKind)]
-> Maybe (IntMap [(GroupName ItemKind, ContentId ItemKind)]))
-> IntMap [(GroupName ItemKind, ContentId ItemKind)]
-> Maybe (IntMap [(GroupName ItemKind, ContentId ItemKind)])
forall a b. (a -> b) -> a -> b
$ (Maybe [(GroupName ItemKind, ContentId ItemKind)]
-> Maybe [(GroupName ItemKind, ContentId ItemKind)])
-> Int
-> IntMap [(GroupName ItemKind, ContentId ItemKind)]
-> IntMap [(GroupName ItemKind, ContentId ItemKind)]
forall a. (Maybe a -> Maybe a) -> Int -> IntMap a -> IntMap a
IM.alter Maybe [(GroupName ItemKind, ContentId ItemKind)]
-> Maybe [(GroupName ItemKind, ContentId ItemKind)]
altInner Int
number (IntMap [(GroupName ItemKind, ContentId ItemKind)]
-> IntMap [(GroupName ItemKind, ContentId ItemKind)])
-> IntMap [(GroupName ItemKind, ContentId ItemKind)]
-> IntMap [(GroupName ItemKind, ContentId ItemKind)]
forall a b. (a -> b) -> a -> b
$ IntMap [(GroupName ItemKind, ContentId ItemKind)]
-> Maybe (IntMap [(GroupName ItemKind, ContentId ItemKind)])
-> IntMap [(GroupName ItemKind, ContentId ItemKind)]
forall a. a -> Maybe a -> a
fromMaybe IntMap [(GroupName ItemKind, ContentId ItemKind)]
forall a. IntMap a
IM.empty Maybe (IntMap [(GroupName ItemKind, ContentId ItemKind)])
mim
(StateServer -> StateServer) -> m ()
forall (m :: * -> *).
MonadServer m =>
(StateServer -> StateServer) -> m ()
modifyServer ((StateServer -> StateServer) -> m ())
-> (StateServer -> StateServer) -> m ()
forall a b. (a -> b) -> a -> b
$ \StateServer
ser ->
StateServer
ser {steamGear :: GearOfTeams
steamGear = (Maybe (IntMap [(GroupName ItemKind, ContentId ItemKind)])
-> Maybe (IntMap [(GroupName ItemKind, ContentId ItemKind)]))
-> TeamContinuity -> GearOfTeams -> GearOfTeams
forall k a.
Enum k =>
(Maybe a -> Maybe a) -> k -> EnumMap k a -> EnumMap k a
EM.alter Maybe (IntMap [(GroupName ItemKind, ContentId ItemKind)])
-> Maybe (IntMap [(GroupName ItemKind, ContentId ItemKind)])
alt TeamContinuity
teamContinuity (GearOfTeams -> GearOfTeams) -> GearOfTeams -> GearOfTeams
forall a b. (a -> b) -> a -> b
$ StateServer -> GearOfTeams
steamGear StateServer
ser}
(Maybe (Int, TeamContinuity),
Maybe (ItemId, (ItemFull, ItemQuant)))
_ -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Maybe (ItemId, (ItemFull, ItemQuant))
-> m (Maybe (ItemId, (ItemFull, ItemQuant)))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (ItemId, (ItemFull, ItemQuant))
mIidEtc
Just ContentId ItemKind
itemKindId2 -> do
let gearListNew :: [(GroupName ItemKind, ContentId ItemKind)]
gearListNew = (GroupName ItemKind, ContentId ItemKind)
-> [(GroupName ItemKind, ContentId ItemKind)]
-> [(GroupName ItemKind, ContentId ItemKind)]
forall a. Eq a => a -> [a] -> [a]
delete (GroupName ItemKind
ikGrp, ContentId ItemKind
itemKindId2) [(GroupName ItemKind, ContentId ItemKind)]
gearList
(Int
number, TeamContinuity
teamContinuity) = Maybe (Int, TeamContinuity) -> (Int, TeamContinuity)
forall a. HasCallStack => Maybe a -> a
fromJust Maybe (Int, TeamContinuity)
bnumberTeam
alt :: Maybe (IntMap [(GroupName ItemKind, ContentId ItemKind)])
-> Maybe (IntMap [(GroupName ItemKind, ContentId ItemKind)])
alt Maybe (IntMap [(GroupName ItemKind, ContentId ItemKind)])
mim =
IntMap [(GroupName ItemKind, ContentId ItemKind)]
-> Maybe (IntMap [(GroupName ItemKind, ContentId ItemKind)])
forall a. a -> Maybe a
Just (IntMap [(GroupName ItemKind, ContentId ItemKind)]
-> Maybe (IntMap [(GroupName ItemKind, ContentId ItemKind)]))
-> IntMap [(GroupName ItemKind, ContentId ItemKind)]
-> Maybe (IntMap [(GroupName ItemKind, ContentId ItemKind)])
forall a b. (a -> b) -> a -> b
$ Int
-> [(GroupName ItemKind, ContentId ItemKind)]
-> IntMap [(GroupName ItemKind, ContentId ItemKind)]
-> IntMap [(GroupName ItemKind, ContentId ItemKind)]
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
number [(GroupName ItemKind, ContentId ItemKind)]
gearListNew (IntMap [(GroupName ItemKind, ContentId ItemKind)]
-> IntMap [(GroupName ItemKind, ContentId ItemKind)])
-> IntMap [(GroupName ItemKind, ContentId ItemKind)]
-> IntMap [(GroupName ItemKind, ContentId ItemKind)]
forall a b. (a -> b) -> a -> b
$ IntMap [(GroupName ItemKind, ContentId ItemKind)]
-> Maybe (IntMap [(GroupName ItemKind, ContentId ItemKind)])
-> IntMap [(GroupName ItemKind, ContentId ItemKind)]
forall a. a -> Maybe a -> a
fromMaybe IntMap [(GroupName ItemKind, ContentId ItemKind)]
forall a. IntMap a
IM.empty Maybe (IntMap [(GroupName ItemKind, ContentId ItemKind)])
mim
(StateServer -> StateServer) -> m ()
forall (m :: * -> *).
MonadServer m =>
(StateServer -> StateServer) -> m ()
modifyServer ((StateServer -> StateServer) -> m ())
-> (StateServer -> StateServer) -> m ()
forall a b. (a -> b) -> a -> b
$ \StateServer
ser ->
StateServer
ser {steamGearCur :: GearOfTeams
steamGearCur = (Maybe (IntMap [(GroupName ItemKind, ContentId ItemKind)])
-> Maybe (IntMap [(GroupName ItemKind, ContentId ItemKind)]))
-> TeamContinuity -> GearOfTeams -> GearOfTeams
forall k a.
Enum k =>
(Maybe a -> Maybe a) -> k -> EnumMap k a -> EnumMap k a
EM.alter Maybe (IntMap [(GroupName ItemKind, ContentId ItemKind)])
-> Maybe (IntMap [(GroupName ItemKind, ContentId ItemKind)])
alt TeamContinuity
teamContinuity GearOfTeams
steamGearCur}
let itemKind2 :: ItemKind
itemKind2 = ContentData ItemKind -> ContentId ItemKind -> ItemKind
forall a. ContentData a -> ContentId a -> a
okind ContentData ItemKind
coitem ContentId ItemKind
itemKindId2
freq :: Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
freq = (GroupName ItemKind, ContentId ItemKind, ItemKind)
-> Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GroupName ItemKind
ikGrp, ContentId ItemKind
itemKindId2, ItemKind
itemKind2)
Bool
-> AbsDepth
-> Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
-> Container
-> Maybe Int
-> m (Maybe (ItemId, (ItemFull, ItemQuant)))
forall (m :: * -> *).
MonadServerAtomic m =>
Bool
-> AbsDepth
-> Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
-> Container
-> Maybe Int
-> m (Maybe (ItemId, (ItemFull, ItemQuant)))
rollAndRegisterItem Bool
False AbsDepth
ldepth Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
freq Container
container Maybe Int
mk
case Maybe (ItemId, (ItemFull, ItemQuant))
mIidEtc of
Maybe (ItemId, (ItemFull, ItemQuant))
Nothing -> [Char] -> m ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> m ()) -> [Char] -> m ()
forall a b. (a -> b) -> a -> b
$ [Char]
"" [Char]
-> (LevelId, GroupName ItemKind, Container, Maybe Int) -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` (LevelId
lid, GroupName ItemKind
ikGrp, Container
container, Maybe Int
mk)
Just (ItemId
iid, (ItemFull
itemFull2, ItemQuant
_)) ->
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CStore
cstore CStore -> CStore -> Bool
forall a. Eq a => a -> a -> Bool
/= CStore
CGround) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
Container -> ItemId -> ContentId ItemKind -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
Container -> ItemId -> ContentId ItemKind -> m ()
discoverIfMinorEffects Container
container ItemId
iid (ItemFull -> ContentId ItemKind
itemKindId ItemFull
itemFull2)
ActorId -> m ActorId
forall (m :: * -> *) a. Monad m => a -> m a
return ActorId
aid
addActorIid ItemId
_ ItemFull
_ Bool
_ FactionId
_ Point
_ LevelId
_ Actor -> Actor
_ = [Char] -> m ActorId
forall a. HasCallStack => [Char] -> a
error [Char]
"addActorIid: server ignorant about an item"
discoverIfMinorEffects :: MonadServerAtomic m
=> Container -> ItemId -> ContentId ItemKind -> m ()
discoverIfMinorEffects :: Container -> ItemId -> ContentId ItemKind -> m ()
discoverIfMinorEffects Container
c ItemId
iid ContentId ItemKind
itemKindId = do
COps{ContentData ItemKind
coitem :: ContentData ItemKind
coitem :: COps -> ContentData ItemKind
coitem} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
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
itemKind :: ItemKind
itemKind = ContentData ItemKind -> ContentId ItemKind -> ItemKind
forall a. ContentData a -> ContentId a -> a
okind ContentData ItemKind
coitem ContentId ItemKind
itemKindId
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (AspectRecord -> ItemKind -> Bool
IA.onlyMinorEffects AspectRecord
arItem ItemKind
itemKind
Bool -> Bool -> Bool
&& Bool -> Bool
not (ItemKind -> Bool
IA.isHumanTrinket ItemKind
itemKind)) (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
$ Container
-> ItemId -> ContentId ItemKind -> AspectRecord -> UpdAtomic
UpdDiscover Container
c ItemId
iid ContentId ItemKind
itemKindId AspectRecord
arItem
pickWeaponServer :: MonadServer m
=> ActorId -> ActorId -> m (Maybe (ItemId, CStore))
pickWeaponServer :: ActorId -> ActorId -> m (Maybe (ItemId, CStore))
pickWeaponServer ActorId
source ActorId
target = do
[(ItemId, (ItemFull, ItemQuant))]
eqpAssocs <- (State -> [(ItemId, (ItemFull, ItemQuant))])
-> m [(ItemId, (ItemFull, ItemQuant))]
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(ItemId, (ItemFull, ItemQuant))])
-> m [(ItemId, (ItemFull, ItemQuant))])
-> (State -> [(ItemId, (ItemFull, ItemQuant))])
-> m [(ItemId, (ItemFull, ItemQuant))]
forall a b. (a -> b) -> a -> b
$ ActorId -> [CStore] -> State -> [(ItemId, (ItemFull, ItemQuant))]
kitAssocs ActorId
source [CStore
CEqp]
[(ItemId, (ItemFull, ItemQuant))]
bodyAssocs <- (State -> [(ItemId, (ItemFull, ItemQuant))])
-> m [(ItemId, (ItemFull, ItemQuant))]
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(ItemId, (ItemFull, ItemQuant))])
-> m [(ItemId, (ItemFull, ItemQuant))])
-> (State -> [(ItemId, (ItemFull, ItemQuant))])
-> m [(ItemId, (ItemFull, ItemQuant))]
forall a b. (a -> b) -> a -> b
$ ActorId -> [CStore] -> State -> [(ItemId, (ItemFull, ItemQuant))]
kitAssocs ActorId
source [CStore
COrgan]
Skills
actorSk <- ActorId -> m Skills
forall (m :: * -> *). MonadServer m => ActorId -> m Skills
currentSkillsServer ActorId
source
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
let kitAssRaw :: [(ItemId, (ItemFull, ItemQuant))]
kitAssRaw = [(ItemId, (ItemFull, ItemQuant))]
eqpAssocs [(ItemId, (ItemFull, ItemQuant))]
-> [(ItemId, (ItemFull, ItemQuant))]
-> [(ItemId, (ItemFull, ItemQuant))]
forall a. [a] -> [a] -> [a]
++ [(ItemId, (ItemFull, ItemQuant))]
bodyAssocs
forced :: Bool
forced = Actor -> Bool
bproj Actor
sb
kitAss :: [(ItemId, (ItemFull, ItemQuant))]
kitAss | Bool
forced = [(ItemId, (ItemFull, ItemQuant))]
kitAssRaw
| Bool
otherwise =
((ItemId, (ItemFull, ItemQuant)) -> Bool)
-> [(ItemId, (ItemFull, ItemQuant))]
-> [(ItemId, (ItemFull, ItemQuant))]
forall a. (a -> Bool) -> [a] -> [a]
filter (Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Meleeable
(AspectRecord -> Bool)
-> ((ItemId, (ItemFull, ItemQuant)) -> AspectRecord)
-> (ItemId, (ItemFull, ItemQuant))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ItemFull -> AspectRecord
aspectRecordFull (ItemFull -> AspectRecord)
-> ((ItemId, (ItemFull, ItemQuant)) -> ItemFull)
-> (ItemId, (ItemFull, ItemQuant))
-> AspectRecord
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ItemFull, ItemQuant) -> ItemFull
forall a b. (a, b) -> a
fst ((ItemFull, ItemQuant) -> ItemFull)
-> ((ItemId, (ItemFull, ItemQuant)) -> (ItemFull, ItemQuant))
-> (ItemId, (ItemFull, ItemQuant))
-> ItemFull
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ItemId, (ItemFull, ItemQuant)) -> (ItemFull, ItemQuant)
forall a b. (a, b) -> b
snd) [(ItemId, (ItemFull, ItemQuant))]
kitAssRaw
benign :: ItemFull -> Bool
benign ItemFull
itemFull = let arItem :: AspectRecord
arItem = ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFull
in Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Benign AspectRecord
arItem
[(Double, Bool, Int, Int, ItemId, (ItemFull, ItemQuant))]
strongest <- Bool
-> Maybe DiscoveryBenefit
-> [(ItemId, (ItemFull, ItemQuant))]
-> Skills
-> ActorId
-> m [(Double, Bool, Int, Int, ItemId, (ItemFull, ItemQuant))]
forall (m :: * -> *).
MonadStateRead m =>
Bool
-> Maybe DiscoveryBenefit
-> [(ItemId, (ItemFull, ItemQuant))]
-> Skills
-> ActorId
-> m [(Double, Bool, Int, Int, ItemId, (ItemFull, ItemQuant))]
pickWeaponM Bool
False Maybe DiscoveryBenefit
forall a. Maybe a
Nothing [(ItemId, (ItemFull, ItemQuant))]
kitAss Skills
actorSk ActorId
source
case [(Double, Bool, Int, Int, ItemId, (ItemFull, ItemQuant))]
strongest of
[] -> Maybe (ItemId, CStore) -> m (Maybe (ItemId, CStore))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (ItemId, CStore)
forall a. Maybe a
Nothing
(Double
_, Bool
_, Int
_, Int
_, ItemId
_, (ItemFull
itemFull, ItemQuant
_)) : [(Double, Bool, Int, Int, ItemId, (ItemFull, ItemQuant))]
_ | Bool -> Bool
not Bool
forced
Bool -> Bool -> Bool
&& ItemFull -> Bool
benign ItemFull
itemFull Bool -> Bool -> Bool
&& Actor -> Bool
bproj Actor
tb ->
Maybe (ItemId, CStore) -> m (Maybe (ItemId, CStore))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (ItemId, CStore)
forall a. Maybe a
Nothing
iis :: [(Double, Bool, Int, Int, ItemId, (ItemFull, ItemQuant))]
iis@((Double
value1, Bool
hasEffect1, Int
timeout1, Int
_, ItemId
_, (ItemFull, ItemQuant)
_) : [(Double, Bool, Int, Int, ItemId, (ItemFull, ItemQuant))]
_) -> do
let minIis :: [(Double, Bool, Int, Int, ItemId, (ItemFull, ItemQuant))]
minIis = ((Double, Bool, Int, Int, ItemId, (ItemFull, ItemQuant)) -> Bool)
-> [(Double, Bool, Int, Int, ItemId, (ItemFull, ItemQuant))]
-> [(Double, Bool, Int, Int, ItemId, (ItemFull, ItemQuant))]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (\(Double
value, Bool
hasEffect, Int
timeout, Int
_, ItemId
_, (ItemFull, ItemQuant)
_) ->
Double
value Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
value1
Bool -> Bool -> Bool
&& Bool
hasEffect Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
hasEffect1
Bool -> Bool -> Bool
&& Int
timeout Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
timeout1)
[(Double, Bool, Int, Int, ItemId, (ItemFull, ItemQuant))]
iis
(Double
_, Bool
_, Int
_, Int
_, ItemId
iid, (ItemFull, ItemQuant)
_) <- Rnd (Double, Bool, Int, Int, ItemId, (ItemFull, ItemQuant))
-> m (Double, Bool, Int, Int, ItemId, (ItemFull, ItemQuant))
forall (m :: * -> *) a. MonadServer m => Rnd a -> m a
rndToAction (Rnd (Double, Bool, Int, Int, ItemId, (ItemFull, ItemQuant))
-> m (Double, Bool, Int, Int, ItemId, (ItemFull, ItemQuant)))
-> Rnd (Double, Bool, Int, Int, ItemId, (ItemFull, ItemQuant))
-> m (Double, Bool, Int, Int, ItemId, (ItemFull, ItemQuant))
forall a b. (a -> b) -> a -> b
$ [(Double, Bool, Int, Int, ItemId, (ItemFull, ItemQuant))]
-> Rnd (Double, Bool, Int, Int, ItemId, (ItemFull, ItemQuant))
forall a. [a] -> Rnd a
oneOf [(Double, Bool, Int, Int, ItemId, (ItemFull, ItemQuant))]
minIis
let cstore :: CStore
cstore = if Maybe (ItemFull, ItemQuant) -> Bool
forall a. Maybe a -> Bool
isJust (ItemId
-> [(ItemId, (ItemFull, ItemQuant))] -> Maybe (ItemFull, ItemQuant)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ItemId
iid [(ItemId, (ItemFull, ItemQuant))]
bodyAssocs) then CStore
COrgan else CStore
CEqp
Maybe (ItemId, CStore) -> m (Maybe (ItemId, CStore))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (ItemId, CStore) -> m (Maybe (ItemId, CStore)))
-> Maybe (ItemId, CStore) -> m (Maybe (ItemId, CStore))
forall a b. (a -> b) -> a -> b
$ (ItemId, CStore) -> Maybe (ItemId, CStore)
forall a. a -> Maybe a
Just (ItemId
iid, CStore
cstore)
currentSkillsServer :: MonadServer m => ActorId -> m Ability.Skills
currentSkillsServer :: ActorId -> m Skills
currentSkillsServer 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
Maybe ActorId
mleader <- (State -> Maybe ActorId) -> m (Maybe ActorId)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Maybe ActorId) -> m (Maybe ActorId))
-> (State -> Maybe ActorId) -> m (Maybe ActorId)
forall a b. (a -> b) -> a -> b
$ Faction -> Maybe ActorId
gleader (Faction -> Maybe ActorId)
-> (State -> Faction) -> State -> Maybe ActorId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
body) (EnumMap FactionId Faction -> Faction)
-> (State -> EnumMap FactionId Faction) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap FactionId Faction
sfactionD
(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
$ Maybe ActorId -> ActorId -> State -> Skills
actorCurrentSkills Maybe ActorId
mleader ActorId
aid
getCacheLucid :: MonadServer m => LevelId -> m FovLucid
getCacheLucid :: LevelId -> m FovLucid
getCacheLucid LevelId
lid = do
FovClearLid
fovClearLid <- (StateServer -> FovClearLid) -> m FovClearLid
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> FovClearLid
sfovClearLid
FovLitLid
fovLitLid <- (StateServer -> FovLitLid) -> m FovLitLid
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> FovLitLid
sfovLitLid
FovLucidLid
fovLucidLid <- (StateServer -> FovLucidLid) -> m FovLucidLid
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> FovLucidLid
sfovLucidLid
let getNewLucid :: m FovLucid
getNewLucid = (State -> FovLucid) -> m FovLucid
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> FovLucid) -> m FovLucid)
-> (State -> FovLucid) -> m FovLucid
forall a b. (a -> b) -> a -> b
$ \State
s ->
FovClearLid -> FovLitLid -> State -> LevelId -> Level -> FovLucid
lucidFromLevel FovClearLid
fovClearLid FovLitLid
fovLitLid State
s LevelId
lid (State -> Dungeon
sdungeon State
s Dungeon -> LevelId -> Level
forall k a. Enum k => EnumMap k a -> k -> a
EM.! LevelId
lid)
case LevelId -> FovLucidLid -> Maybe (FovValid FovLucid)
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup LevelId
lid FovLucidLid
fovLucidLid of
Just (FovValid FovLucid
fovLucid) -> FovLucid -> m FovLucid
forall (m :: * -> *) a. Monad m => a -> m a
return FovLucid
fovLucid
Maybe (FovValid FovLucid)
_ -> do
FovLucid
newLucid <- m FovLucid
getNewLucid
(StateServer -> StateServer) -> m ()
forall (m :: * -> *).
MonadServer m =>
(StateServer -> StateServer) -> m ()
modifyServer ((StateServer -> StateServer) -> m ())
-> (StateServer -> StateServer) -> m ()
forall a b. (a -> b) -> a -> b
$ \StateServer
ser ->
StateServer
ser {sfovLucidLid :: FovLucidLid
sfovLucidLid = LevelId -> FovValid FovLucid -> FovLucidLid -> FovLucidLid
forall k a. Enum k => k -> a -> EnumMap k a -> EnumMap k a
EM.insert LevelId
lid (FovLucid -> FovValid FovLucid
forall a. a -> FovValid a
FovValid FovLucid
newLucid)
(FovLucidLid -> FovLucidLid) -> FovLucidLid -> FovLucidLid
forall a b. (a -> b) -> a -> b
$ StateServer -> FovLucidLid
sfovLucidLid StateServer
ser}
FovLucid -> m FovLucid
forall (m :: * -> *) a. Monad m => a -> m a
return FovLucid
newLucid
getCacheTotal :: MonadServer m => FactionId -> LevelId -> m CacheBeforeLucid
getCacheTotal :: FactionId -> LevelId -> m CacheBeforeLucid
getCacheTotal FactionId
fid LevelId
lid = do
PerCacheFid
sperCacheFidOld <- (StateServer -> PerCacheFid) -> m PerCacheFid
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> PerCacheFid
sperCacheFid
let perCacheOld :: PerceptionCache
perCacheOld = PerCacheFid
sperCacheFidOld PerCacheFid -> FactionId -> PerCacheLid
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
fid PerCacheLid -> LevelId -> PerceptionCache
forall k a. Enum k => EnumMap k a -> k -> a
EM.! LevelId
lid
case PerceptionCache -> FovValid CacheBeforeLucid
ptotal PerceptionCache
perCacheOld of
FovValid CacheBeforeLucid
total -> CacheBeforeLucid -> m CacheBeforeLucid
forall (m :: * -> *) a. Monad m => a -> m a
return CacheBeforeLucid
total
FovValid CacheBeforeLucid
FovInvalid -> do
ActorMaxSkills
actorMaxSkills <- (State -> ActorMaxSkills) -> m ActorMaxSkills
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> ActorMaxSkills
sactorMaxSkills
FovClearLid
fovClearLid <- (StateServer -> FovClearLid) -> m FovClearLid
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> FovClearLid
sfovClearLid
ActorId -> Actor
getActorB <- (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
$ (ActorId -> State -> Actor) -> State -> ActorId -> Actor
forall a b c. (a -> b -> c) -> b -> a -> c
flip ActorId -> State -> Actor
getActorBody
let perActorNew :: PerActor
perActorNew =
PerActor
-> (ActorId -> Actor) -> ActorMaxSkills -> FovClear -> PerActor
perActorFromLevel (PerceptionCache -> PerActor
perActor PerceptionCache
perCacheOld) ActorId -> Actor
getActorB
ActorMaxSkills
actorMaxSkills (FovClearLid
fovClearLid FovClearLid -> LevelId -> FovClear
forall k a. Enum k => EnumMap k a -> k -> a
EM.! LevelId
lid)
total :: CacheBeforeLucid
total = PerActor -> CacheBeforeLucid
totalFromPerActor PerActor
perActorNew
perCache :: PerceptionCache
perCache = PerceptionCache :: FovValid CacheBeforeLucid -> PerActor -> PerceptionCache
PerceptionCache { ptotal :: FovValid CacheBeforeLucid
ptotal = CacheBeforeLucid -> FovValid CacheBeforeLucid
forall a. a -> FovValid a
FovValid CacheBeforeLucid
total
, perActor :: PerActor
perActor = PerActor
perActorNew }
fperCache :: PerCacheFid -> PerCacheFid
fperCache = (PerCacheLid -> PerCacheLid)
-> FactionId -> PerCacheFid -> PerCacheFid
forall k a. Enum k => (a -> a) -> k -> EnumMap k a -> EnumMap k a
EM.adjust (LevelId -> PerceptionCache -> PerCacheLid -> PerCacheLid
forall k a. Enum k => k -> a -> EnumMap k a -> EnumMap k a
EM.insert LevelId
lid PerceptionCache
perCache) FactionId
fid
(StateServer -> StateServer) -> m ()
forall (m :: * -> *).
MonadServer m =>
(StateServer -> StateServer) -> m ()
modifyServer ((StateServer -> StateServer) -> m ())
-> (StateServer -> StateServer) -> m ()
forall a b. (a -> b) -> a -> b
$ \StateServer
ser -> StateServer
ser {sperCacheFid :: PerCacheFid
sperCacheFid = PerCacheFid -> PerCacheFid
fperCache (PerCacheFid -> PerCacheFid) -> PerCacheFid -> PerCacheFid
forall a b. (a -> b) -> a -> b
$ StateServer -> PerCacheFid
sperCacheFid StateServer
ser}
CacheBeforeLucid -> m CacheBeforeLucid
forall (m :: * -> *) a. Monad m => a -> m a
return CacheBeforeLucid
total
allGroupItems :: MonadServerAtomic m
=> CStore -> GroupName ItemKind -> ActorId
-> m [(ItemId, ItemQuant)]
allGroupItems :: CStore -> GroupName ItemKind -> ActorId -> m [(ItemId, ItemQuant)]
allGroupItems CStore
store GroupName ItemKind
grp ActorId
target = do
COps{ContentData ItemKind
coitem :: ContentData ItemKind
coitem :: COps -> ContentData ItemKind
coitem} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
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
target
[(ItemId, ItemQuant)]
assocsCStore <- (State -> [(ItemId, ItemQuant)]) -> m [(ItemId, ItemQuant)]
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(ItemId, ItemQuant)]) -> m [(ItemId, ItemQuant)])
-> (State -> [(ItemId, ItemQuant)]) -> m [(ItemId, ItemQuant)]
forall a b. (a -> b) -> a -> b
$ ItemBag -> [(ItemId, ItemQuant)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs (ItemBag -> [(ItemId, ItemQuant)])
-> (State -> ItemBag) -> State -> [(ItemId, ItemQuant)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Actor -> CStore -> State -> ItemBag
getBodyStoreBag Actor
b CStore
store
ItemId -> ContentId ItemKind
getKindId <- (State -> ItemId -> ContentId ItemKind)
-> m (ItemId -> ContentId ItemKind)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemId -> ContentId ItemKind)
-> m (ItemId -> ContentId ItemKind))
-> (State -> ItemId -> ContentId ItemKind)
-> m (ItemId -> ContentId ItemKind)
forall a b. (a -> b) -> a -> b
$ (ItemId -> State -> ContentId ItemKind)
-> State -> ItemId -> ContentId ItemKind
forall a b c. (a -> b -> c) -> b -> a -> c
flip ItemId -> State -> ContentId ItemKind
getIidKindIdServer
let assocsKindId :: [(ContentId ItemKind, (ItemId, ItemQuant))]
assocsKindId = ((ItemId, ItemQuant) -> (ContentId ItemKind, (ItemId, ItemQuant)))
-> [(ItemId, ItemQuant)]
-> [(ContentId ItemKind, (ItemId, ItemQuant))]
forall a b. (a -> b) -> [a] -> [b]
map (\as :: (ItemId, ItemQuant)
as@(ItemId
iid, ItemQuant
_) -> (ItemId -> ContentId ItemKind
getKindId ItemId
iid, (ItemId, ItemQuant)
as)) [(ItemId, ItemQuant)]
assocsCStore
hasGroup :: (ContentId ItemKind, (ItemId, ItemQuant)) -> Bool
hasGroup (ContentId ItemKind
itemKindId, (ItemId, ItemQuant)
_) =
Bool -> (Int -> Bool) -> Maybe Int -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (Maybe Int -> Bool) -> Maybe Int -> Bool
forall a b. (a -> b) -> a -> b
$ GroupName ItemKind -> Freqs ItemKind -> Maybe Int
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup GroupName ItemKind
grp (Freqs ItemKind -> Maybe Int) -> Freqs ItemKind -> Maybe Int
forall a b. (a -> b) -> a -> b
$ ItemKind -> Freqs ItemKind
IK.ifreq (ItemKind -> Freqs ItemKind) -> ItemKind -> Freqs ItemKind
forall a b. (a -> b) -> a -> b
$ ContentData ItemKind -> ContentId ItemKind -> ItemKind
forall a. ContentData a -> ContentId a -> a
okind ContentData ItemKind
coitem ContentId ItemKind
itemKindId
[(ItemId, ItemQuant)] -> m [(ItemId, ItemQuant)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(ItemId, ItemQuant)] -> m [(ItemId, ItemQuant)])
-> [(ItemId, ItemQuant)] -> m [(ItemId, ItemQuant)]
forall a b. (a -> b) -> a -> b
$! ((ContentId ItemKind, (ItemId, ItemQuant)) -> (ItemId, ItemQuant))
-> [(ContentId ItemKind, (ItemId, ItemQuant))]
-> [(ItemId, ItemQuant)]
forall a b. (a -> b) -> [a] -> [b]
map (ContentId ItemKind, (ItemId, ItemQuant)) -> (ItemId, ItemQuant)
forall a b. (a, b) -> b
snd ([(ContentId ItemKind, (ItemId, ItemQuant))]
-> [(ItemId, ItemQuant)])
-> [(ContentId ItemKind, (ItemId, ItemQuant))]
-> [(ItemId, ItemQuant)]
forall a b. (a -> b) -> a -> b
$ ((ContentId ItemKind, (ItemId, ItemQuant))
-> (ContentId ItemKind, (ItemId, ItemQuant)) -> Ordering)
-> [(ContentId ItemKind, (ItemId, ItemQuant))]
-> [(ContentId ItemKind, (ItemId, ItemQuant))]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((ContentId ItemKind, (ItemId, ItemQuant)) -> ContentId ItemKind)
-> (ContentId ItemKind, (ItemId, ItemQuant))
-> (ContentId ItemKind, (ItemId, ItemQuant))
-> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (ContentId ItemKind, (ItemId, ItemQuant)) -> ContentId ItemKind
forall a b. (a, b) -> a
fst) ([(ContentId ItemKind, (ItemId, ItemQuant))]
-> [(ContentId ItemKind, (ItemId, ItemQuant))])
-> [(ContentId ItemKind, (ItemId, ItemQuant))]
-> [(ContentId ItemKind, (ItemId, ItemQuant))]
forall a b. (a -> b) -> a -> b
$ ((ContentId ItemKind, (ItemId, ItemQuant)) -> Bool)
-> [(ContentId ItemKind, (ItemId, ItemQuant))]
-> [(ContentId ItemKind, (ItemId, ItemQuant))]
forall a. (a -> Bool) -> [a] -> [a]
filter (ContentId ItemKind, (ItemId, ItemQuant)) -> Bool
hasGroup [(ContentId ItemKind, (ItemId, ItemQuant))]
assocsKindId
addCondition :: MonadServerAtomic m
=> Bool -> GroupName ItemKind -> ActorId -> m ()
addCondition :: Bool -> GroupName ItemKind -> ActorId -> m ()
addCondition Bool
verbose GroupName ItemKind
name 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
Level{AbsDepth
ldepth :: AbsDepth
ldepth :: Level -> AbsDepth
ldepth} <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel (LevelId -> m Level) -> LevelId -> m Level
forall a b. (a -> b) -> a -> b
$ Actor -> LevelId
blid Actor
b
let c :: Container
c = ActorId -> CStore -> Container
CActor ActorId
aid CStore
COrgan
Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
freq <- Int
-> AbsDepth
-> Freqs ItemKind
-> m (Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind))
forall (m :: * -> *).
MonadServerAtomic m =>
Int
-> AbsDepth
-> Freqs ItemKind
-> m (Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind))
prepareItemKind Int
0 AbsDepth
ldepth [(GroupName ItemKind
name, Int
1)]
Maybe (ItemId, (ItemFull, ItemQuant))
mresult <- Bool
-> AbsDepth
-> Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
-> Container
-> Maybe Int
-> m (Maybe (ItemId, (ItemFull, ItemQuant)))
forall (m :: * -> *).
MonadServerAtomic m =>
Bool
-> AbsDepth
-> Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
-> Container
-> Maybe Int
-> m (Maybe (ItemId, (ItemFull, ItemQuant)))
rollAndRegisterItem Bool
verbose AbsDepth
ldepth Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
freq Container
c Maybe Int
forall a. Maybe a
Nothing
Bool -> m () -> m ()
forall a. HasCallStack => Bool -> a -> a
assert (Maybe (ItemId, (ItemFull, ItemQuant)) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (ItemId, (ItemFull, ItemQuant))
mresult) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
removeConditionSingle :: MonadServerAtomic m
=> GroupName ItemKind -> ActorId -> m Int
removeConditionSingle :: GroupName ItemKind -> ActorId -> m Int
removeConditionSingle GroupName ItemKind
name ActorId
aid = do
let c :: Container
c = ActorId -> CStore -> Container
CActor ActorId
aid CStore
COrgan
[(ItemId, ItemQuant)]
is <- CStore -> GroupName ItemKind -> ActorId -> m [(ItemId, ItemQuant)]
forall (m :: * -> *).
MonadServerAtomic m =>
CStore -> GroupName ItemKind -> ActorId -> m [(ItemId, ItemQuant)]
allGroupItems CStore
COrgan GroupName ItemKind
name ActorId
aid
case [(ItemId, ItemQuant)]
is of
[(ItemId
iid, (Int
nAll, ItemTimers
itemTimer))] -> do
UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ Bool -> ItemId -> ItemQuant -> Container -> UpdAtomic
UpdLoseItem Bool
False ItemId
iid (Int
1, ItemTimers
itemTimer) Container
c
Int -> m Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> m Int) -> Int -> m Int
forall a b. (a -> b) -> a -> b
$ Int
nAll Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
[(ItemId, ItemQuant)]
_ -> [Char] -> m Int
forall a. HasCallStack => [Char] -> a
error ([Char] -> m Int) -> [Char] -> m Int
forall a b. (a -> b) -> a -> b
$ [Char]
"missing or multiple item" [Char] -> (GroupName ItemKind, [(ItemId, ItemQuant)]) -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` (GroupName ItemKind
name, [(ItemId, ItemQuant)]
is)
addSleep :: MonadServerAtomic m => ActorId -> m ()
addSleep :: ActorId -> m ()
addSleep 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 -> GroupName ItemKind -> ActorId -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
Bool -> GroupName ItemKind -> ActorId -> m ()
addCondition Bool
True GroupName ItemKind
IK.S_ASLEEP ActorId
aid
UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ ActorId -> Watchfulness -> Watchfulness -> UpdAtomic
UpdWaitActor ActorId
aid (Actor -> Watchfulness
bwatch Actor
b) Watchfulness
WSleep
removeSleepSingle :: MonadServerAtomic m => ActorId -> m ()
removeSleepSingle :: ActorId -> m ()
removeSleepSingle ActorId
aid = do
Int
nAll <- GroupName ItemKind -> ActorId -> m Int
forall (m :: * -> *).
MonadServerAtomic m =>
GroupName ItemKind -> ActorId -> m Int
removeConditionSingle GroupName ItemKind
IK.S_ASLEEP ActorId
aid
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
nAll Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (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 -> Watchfulness -> Watchfulness -> UpdAtomic
UpdWaitActor ActorId
aid Watchfulness
WWake Watchfulness
WWatch
addKillToAnalytics :: MonadServerAtomic m
=> ActorId -> KillHow -> FactionId -> ItemId -> m ()
addKillToAnalytics :: ActorId -> KillHow -> FactionId -> ItemId -> m ()
addKillToAnalytics ActorId
aid KillHow
killHow FactionId
fid ItemId
iid = do
ActorDict
actorD <- (State -> ActorDict) -> m ActorDict
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> ActorDict
sactorD
case ActorId -> ActorDict -> Maybe Actor
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup ActorId
aid ActorDict
actorD of
Just Actor
b ->
(StateServer -> StateServer) -> m ()
forall (m :: * -> *).
MonadServer m =>
(StateServer -> StateServer) -> m ()
modifyServer ((StateServer -> StateServer) -> m ())
-> (StateServer -> StateServer) -> m ()
forall a b. (a -> b) -> a -> b
$ \StateServer
ser ->
StateServer
ser { sfactionAn :: FactionAnalytics
sfactionAn = FactionId
-> KillHow
-> FactionId
-> ItemId
-> FactionAnalytics
-> FactionAnalytics
addFactionKill (Actor -> FactionId
bfid Actor
b) KillHow
killHow FactionId
fid ItemId
iid
(FactionAnalytics -> FactionAnalytics)
-> FactionAnalytics -> FactionAnalytics
forall a b. (a -> b) -> a -> b
$ StateServer -> FactionAnalytics
sfactionAn StateServer
ser
, sactorAn :: ActorAnalytics
sactorAn = ActorId
-> KillHow
-> FactionId
-> ItemId
-> ActorAnalytics
-> ActorAnalytics
addActorKill ActorId
aid KillHow
killHow FactionId
fid ItemId
iid
(ActorAnalytics -> ActorAnalytics)
-> ActorAnalytics -> ActorAnalytics
forall a b. (a -> b) -> a -> b
$ StateServer -> ActorAnalytics
sactorAn StateServer
ser }
Maybe Actor
Nothing -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()