module Game.LambdaHack.Server.HandleRequestM
( handleRequestAI, handleRequestUI, handleRequestTimed, switchLeader
, reqMoveGeneric, reqDisplaceGeneric, reqAlterFail
, reqGameDropAndExit, reqGameSaveAndExit
#ifdef EXPOSE_INTERNAL
, execFailure, checkWaiting, processWatchfulness, affectStash
, managePerRequest, handleRequestTimedCases, affectSmell
, reqMove, reqMelee, reqMeleeChecked, reqDisplace, reqAlter
, reqWait, reqWait10, reqYell, reqMoveItems, reqMoveItem, reqProject, reqApply
, reqGameRestart, reqGameSave, reqDoctrine, reqAutomate
#endif
) where
import Prelude ()
import Game.LambdaHack.Core.Prelude
import qualified Data.EnumMap.Strict as EM
import qualified Data.Text as T
import qualified Text.Show.Pretty as Show.Pretty
import Game.LambdaHack.Atomic
import Game.LambdaHack.Client
(ReqAI (..), ReqUI (..), RequestTimed (..))
import Game.LambdaHack.Common.Actor
import Game.LambdaHack.Common.ActorState
import Game.LambdaHack.Common.Analytics
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.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 Game.LambdaHack.Common.Vector
import qualified Game.LambdaHack.Content.ItemKind as IK
import Game.LambdaHack.Content.ModeKind
import qualified Game.LambdaHack.Content.TileKind as TK
import qualified Game.LambdaHack.Definition.Ability as Ability
import Game.LambdaHack.Definition.Defs
import Game.LambdaHack.Server.CommonM
import Game.LambdaHack.Server.HandleEffectM
import Game.LambdaHack.Server.ItemM
import Game.LambdaHack.Server.MonadServer
import Game.LambdaHack.Server.PeriodicM
import Game.LambdaHack.Server.ServerOptions
import Game.LambdaHack.Server.State
execFailure :: MonadServerAtomic m
=> ActorId -> RequestTimed -> ReqFailure -> m ()
execFailure :: ActorId -> RequestTimed -> ReqFailure -> m ()
execFailure aid :: ActorId
aid req :: RequestTimed
req failureSer :: ReqFailure
failureSer = 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
let fid :: FactionId
fid = Actor -> FactionId
bfid Actor
body
msg :: Text
msg = ReqFailure -> Text
showReqFailure ReqFailure
failureSer
impossible :: Bool
impossible = ReqFailure -> Bool
impossibleReqFailure ReqFailure
failureSer
debugShow :: Show a => a -> Text
debugShow :: a -> Text
debugShow = String -> Text
T.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
Show.Pretty.ppShow
possiblyAlarm :: Text -> m ()
possiblyAlarm = if Bool
impossible
then Text -> m ()
forall (m :: * -> *). MonadServer m => Text -> m ()
debugPossiblyPrintAndExit
else Text -> m ()
forall (m :: * -> *). MonadServer m => Text -> m ()
debugPossiblyPrint
Text -> m ()
possiblyAlarm (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
"Server: execFailure:" Text -> Text -> Text
<+> Text
msg Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\n"
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Actor -> Text
forall a. Show a => a -> Text
debugShow Actor
body Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RequestTimed -> Text
forall a. Show a => a -> Text
debugShow RequestTimed
req Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ReqFailure -> Text
forall a. Show a => a -> Text
debugShow ReqFailure
failureSer
SfxAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => SfxAtomic -> m ()
execSfxAtomic (SfxAtomic -> m ()) -> SfxAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ FactionId -> SfxMsg -> SfxAtomic
SfxMsgFid FactionId
fid (SfxMsg -> SfxAtomic) -> SfxMsg -> SfxAtomic
forall a b. (a -> b) -> a -> b
$ ReqFailure -> SfxMsg
SfxUnexpected ReqFailure
failureSer
handleRequestAI :: MonadServerAtomic m
=> ReqAI
-> m (Maybe RequestTimed)
handleRequestAI :: ReqAI -> m (Maybe RequestTimed)
handleRequestAI cmd :: ReqAI
cmd = case ReqAI
cmd of
ReqAITimed cmdT :: RequestTimed
cmdT -> Maybe RequestTimed -> m (Maybe RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe RequestTimed -> m (Maybe RequestTimed))
-> Maybe RequestTimed -> m (Maybe RequestTimed)
forall a b. (a -> b) -> a -> b
$ RequestTimed -> Maybe RequestTimed
forall a. a -> Maybe a
Just RequestTimed
cmdT
ReqAINop -> Maybe RequestTimed -> m (Maybe RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe RequestTimed
forall a. Maybe a
Nothing
handleRequestUI :: MonadServerAtomic m
=> FactionId -> ActorId -> ReqUI
-> m (Maybe RequestTimed)
handleRequestUI :: FactionId -> ActorId -> ReqUI -> m (Maybe RequestTimed)
handleRequestUI fid :: FactionId
fid aid :: ActorId
aid cmd :: ReqUI
cmd = case ReqUI
cmd of
ReqUITimed cmdT :: RequestTimed
cmdT -> Maybe RequestTimed -> m (Maybe RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe RequestTimed -> m (Maybe RequestTimed))
-> Maybe RequestTimed -> m (Maybe RequestTimed)
forall a b. (a -> b) -> a -> b
$ RequestTimed -> Maybe RequestTimed
forall a. a -> Maybe a
Just RequestTimed
cmdT
ReqUIGameRestart t :: GroupName ModeKind
t d :: Challenge
d -> ActorId -> GroupName ModeKind -> Challenge -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId -> GroupName ModeKind -> Challenge -> m ()
reqGameRestart ActorId
aid GroupName ModeKind
t Challenge
d m () -> m (Maybe RequestTimed) -> m (Maybe RequestTimed)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe RequestTimed -> m (Maybe RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe RequestTimed
forall a. Maybe a
Nothing
ReqUIGameDropAndExit -> ActorId -> m ()
forall (m :: * -> *). MonadServerAtomic m => ActorId -> m ()
reqGameDropAndExit ActorId
aid m () -> m (Maybe RequestTimed) -> m (Maybe RequestTimed)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe RequestTimed -> m (Maybe RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe RequestTimed
forall a. Maybe a
Nothing
ReqUIGameSaveAndExit -> ActorId -> m ()
forall (m :: * -> *). MonadServerAtomic m => ActorId -> m ()
reqGameSaveAndExit ActorId
aid m () -> m (Maybe RequestTimed) -> m (Maybe RequestTimed)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe RequestTimed -> m (Maybe RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe RequestTimed
forall a. Maybe a
Nothing
ReqUIGameSave -> m ()
forall (m :: * -> *). MonadServer m => m ()
reqGameSave m () -> m (Maybe RequestTimed) -> m (Maybe RequestTimed)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe RequestTimed -> m (Maybe RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe RequestTimed
forall a. Maybe a
Nothing
ReqUIDoctrine toT :: Doctrine
toT -> FactionId -> Doctrine -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
FactionId -> Doctrine -> m ()
reqDoctrine FactionId
fid Doctrine
toT m () -> m (Maybe RequestTimed) -> m (Maybe RequestTimed)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe RequestTimed -> m (Maybe RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe RequestTimed
forall a. Maybe a
Nothing
ReqUIAutomate -> FactionId -> m ()
forall (m :: * -> *). MonadServerAtomic m => FactionId -> m ()
reqAutomate FactionId
fid m () -> m (Maybe RequestTimed) -> m (Maybe RequestTimed)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe RequestTimed -> m (Maybe RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe RequestTimed
forall a. Maybe a
Nothing
ReqUINop -> Maybe RequestTimed -> m (Maybe RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe RequestTimed
forall a. Maybe a
Nothing
checkWaiting :: RequestTimed -> Maybe Bool
checkWaiting :: RequestTimed -> Maybe Bool
checkWaiting cmd :: RequestTimed
cmd = case RequestTimed
cmd of
ReqWait -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
ReqWait10 -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
_ -> Maybe Bool
forall a. Maybe a
Nothing
processWatchfulness :: MonadServerAtomic m => Maybe Bool -> ActorId -> m ()
processWatchfulness :: Maybe Bool -> ActorId -> m ()
processWatchfulness mwait :: Maybe Bool
mwait aid :: ActorId
aid = do
Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
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
let uneasy :: Bool
uneasy = ResDelta -> Bool
deltasSerious (Actor -> ResDelta
bcalmDelta Actor
b) Bool -> Bool -> Bool
|| Bool -> Bool
not (Actor -> Skills -> Bool
calmEnough Actor
b Skills
actorMaxSk)
case Actor -> Watchfulness
bwatch Actor
b of
WWatch ->
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Bool
mwait Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
if Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkWait Skills
actorMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 2 then do
Bool -> GroupName ItemKind -> ActorId -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
Bool -> GroupName ItemKind -> ActorId -> m ()
addCondition Bool
False GroupName ItemKind
IK.S_BRACED 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 Watchfulness
WWatch (Int -> Watchfulness
WWait 1)
else
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
WWatch (Int -> Watchfulness
WWait 0)
WWait 0 -> case Maybe Bool
mwait of
Just True -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
_ -> 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 (Int -> Watchfulness
WWait 0) Watchfulness
WWatch
WWait n :: Int
n -> case Maybe Bool
mwait of
Just True ->
if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 500 then
if Bool -> Bool
not Bool
uneasy
Bool -> Bool -> Bool
&& Skills -> Bool
canSleep Skills
actorMaxSk
then do
Int
nAll <- GroupName ItemKind -> ActorId -> m Int
forall (m :: * -> *).
MonadServerAtomic m =>
GroupName ItemKind -> ActorId -> m Int
removeConditionSingle GroupName ItemKind
IK.S_BRACED ActorId
aid
let !_A :: ()
_A = Bool -> () -> ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
nAll Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0) ()
ActorId -> m ()
forall (m :: * -> *). MonadServerAtomic m => ActorId -> m ()
addSleep ActorId
aid
else
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 (Int -> Watchfulness
WWait Int
n) (Int -> Watchfulness
WWait 1)
else
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 (Int -> Watchfulness
WWait Int
n) (Int -> Watchfulness
WWait (Int -> Watchfulness) -> Int -> Watchfulness
forall a b. (a -> b) -> a -> b
$ Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1)
_ -> do
Int
nAll <- GroupName ItemKind -> ActorId -> m Int
forall (m :: * -> *).
MonadServerAtomic m =>
GroupName ItemKind -> ActorId -> m Int
removeConditionSingle GroupName ItemKind
IK.S_BRACED ActorId
aid
let !_A :: ()
_A = Bool -> () -> ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
nAll Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 Bool -> Int -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` Int
nAll) ()
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 (Int -> Watchfulness
WWait Int
n) Watchfulness
WWatch
WSleep ->
if Maybe Bool
mwait Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
Bool -> Bool -> Bool
&& (Bool -> Bool
not (Maybe Bool -> Bool
forall a. Maybe a -> Bool
isJust Maybe Bool
mwait)
Bool -> Bool -> Bool
|| Bool
uneasy
Bool -> Bool -> Bool
|| Bool -> Bool
not (ResDelta -> Bool
deltaBenign (ResDelta -> Bool) -> ResDelta -> Bool
forall a b. (a -> b) -> a -> b
$ Actor -> ResDelta
bhpDelta Actor
b))
then 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
WSleep Watchfulness
WWake
else UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ ActorId -> Int64 -> UpdAtomic
UpdRefillHP ActorId
aid 10000
WWake -> Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Maybe Bool
mwait Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
ActorId -> m ()
forall (m :: * -> *). MonadServerAtomic m => ActorId -> m ()
removeSleepSingle ActorId
aid
affectStash :: MonadServerAtomic m => Actor -> m ()
affectStash :: Actor -> m ()
affectStash b :: Actor
b = do
let locateStash :: (FactionId, Faction) -> m ()
locateStash (fid :: FactionId
fid, fact :: Faction
fact) = case Faction -> Maybe (LevelId, Point)
gstash Faction
fact of
Just (lidS :: LevelId
lidS, posS :: Point
posS)
| LevelId
lidS LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> LevelId
blid Actor
b Bool -> Bool -> Bool
&& Point
posS Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> Point
bpos Actor
b Bool -> Bool -> Bool
&& FactionId
fid FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
/= Actor -> FactionId
bfid Actor
b ->
UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ Bool -> FactionId -> LevelId -> Point -> UpdAtomic
UpdLoseStashFaction Bool
True FactionId
fid LevelId
lidS Point
posS
_ -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
FactionDict
factionD <- (State -> FactionDict) -> m FactionDict
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> FactionDict
sfactionD
((FactionId, Faction) -> m ()) -> [(FactionId, Faction)] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
mapM_ (FactionId, Faction) -> m ()
locateStash ([(FactionId, Faction)] -> m ()) -> [(FactionId, Faction)] -> m ()
forall a b. (a -> b) -> a -> b
$ FactionDict -> [(FactionId, Faction)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs FactionDict
factionD
handleRequestTimed :: MonadServerAtomic m
=> FactionId -> ActorId -> RequestTimed -> m Bool
handleRequestTimed :: FactionId -> ActorId -> RequestTimed -> m Bool
handleRequestTimed fid :: FactionId
fid aid :: ActorId
aid cmd :: RequestTimed
cmd = do
let mwait :: Maybe Bool
mwait = RequestTimed -> Maybe Bool
checkWaiting RequestTimed
cmd
Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Maybe Bool
mwait Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ FactionId -> LevelId -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
FactionId -> LevelId -> m ()
overheadActorTime FactionId
fid (Actor -> LevelId
blid Actor
b)
ActorId -> Int -> Bool -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId -> Int -> Bool -> m ()
advanceTime ActorId
aid (if Maybe Bool
mwait Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False then 10 else 100) Bool
True
ActorId -> RequestTimed -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId -> RequestTimed -> m ()
handleRequestTimedCases ActorId
aid RequestTimed
cmd
ActorId -> m ()
forall (m :: * -> *). MonadServerAtomic m => ActorId -> m ()
managePerRequest ActorId
aid
Maybe Bool -> ActorId -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
Maybe Bool -> ActorId -> m ()
processWatchfulness Maybe Bool
mwait ActorId
aid
Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$! Maybe Bool -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Bool
mwait
managePerRequest :: MonadServerAtomic m => ActorId -> m ()
managePerRequest :: ActorId -> m ()
managePerRequest aid :: ActorId
aid = do
Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
Actor -> m ()
forall (m :: * -> *). MonadServerAtomic m => Actor -> m ()
affectStash Actor
b
let clearMark :: Int64
clearMark = 0
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Actor -> ResDelta
bcalmDelta Actor
b ResDelta -> ResDelta -> Bool
forall a. Eq a => a -> a -> Bool
== (Int64, Int64) -> (Int64, Int64) -> ResDelta
ResDelta (0, 0) (0, 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 -> Int64 -> UpdAtomic
UpdRefillCalm ActorId
aid Int64
clearMark
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Actor -> ResDelta
bhpDelta Actor
b ResDelta -> ResDelta -> Bool
forall a. Eq a => a -> a -> Bool
== (Int64, Int64) -> (Int64, Int64) -> ResDelta
ResDelta (0, 0) (0, 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 -> Int64 -> UpdAtomic
UpdRefillHP ActorId
aid Int64
clearMark
handleRequestTimedCases :: MonadServerAtomic m
=> ActorId -> RequestTimed -> m ()
handleRequestTimedCases :: ActorId -> RequestTimed -> m ()
handleRequestTimedCases aid :: ActorId
aid cmd :: RequestTimed
cmd = case RequestTimed
cmd of
ReqMove target :: Vector
target -> ActorId -> Vector -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId -> Vector -> m ()
reqMove ActorId
aid Vector
target
ReqMelee target :: ActorId
target iid :: ItemId
iid cstore :: CStore
cstore -> ActorId -> ActorId -> ItemId -> CStore -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId -> ActorId -> ItemId -> CStore -> m ()
reqMelee ActorId
aid ActorId
target ItemId
iid CStore
cstore
ReqDisplace target :: ActorId
target -> ActorId -> ActorId -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId -> ActorId -> m ()
reqDisplace ActorId
aid ActorId
target
ReqAlter tpos :: Point
tpos -> ActorId -> Point -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId -> Point -> m ()
reqAlter ActorId
aid Point
tpos
ReqWait -> ActorId -> m ()
forall (m :: * -> *). MonadServerAtomic m => ActorId -> m ()
reqWait ActorId
aid
ReqWait10 -> ActorId -> m ()
forall (m :: * -> *). MonadServerAtomic m => ActorId -> m ()
reqWait10 ActorId
aid
ReqYell -> ActorId -> m ()
forall (m :: * -> *). MonadServerAtomic m => ActorId -> m ()
reqYell ActorId
aid
ReqMoveItems l :: [(ItemId, Int, CStore, CStore)]
l -> ActorId -> [(ItemId, Int, CStore, CStore)] -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId -> [(ItemId, Int, CStore, CStore)] -> m ()
reqMoveItems ActorId
aid [(ItemId, Int, CStore, CStore)]
l
ReqProject p :: Point
p eps :: Int
eps iid :: ItemId
iid cstore :: CStore
cstore -> ActorId -> Point -> Int -> ItemId -> CStore -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId -> Point -> Int -> ItemId -> CStore -> m ()
reqProject ActorId
aid Point
p Int
eps ItemId
iid CStore
cstore
ReqApply iid :: ItemId
iid cstore :: CStore
cstore -> ActorId -> ItemId -> CStore -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId -> ItemId -> CStore -> m ()
reqApply ActorId
aid ItemId
iid CStore
cstore
switchLeader :: MonadServerAtomic m => FactionId -> ActorId -> m ()
{-# INLINE switchLeader #-}
switchLeader :: FactionId -> ActorId -> m ()
switchLeader fid :: FactionId
fid aidNew :: ActorId
aidNew = 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
$ (FactionDict -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
fid) (FactionDict -> Faction)
-> (State -> FactionDict) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> FactionDict
sfactionD
Actor
bPre <- (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
aidNew
let mleader :: Maybe ActorId
mleader = Faction -> Maybe ActorId
gleader Faction
fact
!_A1 :: ()
_A1 = Bool -> () -> ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (ActorId -> Maybe ActorId
forall a. a -> Maybe a
Just ActorId
aidNew Maybe ActorId -> Maybe ActorId -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe ActorId
mleader
Bool -> Bool -> Bool
&& Bool -> Bool
not (Actor -> Bool
bproj Actor
bPre)
Bool -> (ActorId, Actor, FactionId, Faction) -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` (ActorId
aidNew, Actor
bPre, FactionId
fid, Faction
fact)) ()
!_A2 :: ()
_A2 = Bool -> () -> ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Actor -> FactionId
bfid Actor
bPre FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
fid
Bool -> (String, (ActorId, Actor, FactionId, Faction)) -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` "client tries to move other faction actors"
String
-> (ActorId, Actor, FactionId, Faction)
-> (String, (ActorId, Actor, FactionId, Faction))
forall v. String -> v -> (String, v)
`swith` (ActorId
aidNew, Actor
bPre, FactionId
fid, Faction
fact)) ()
let (autoDun :: Bool
autoDun, _) = Faction -> (Bool, Bool)
autoDungeonLevel Faction
fact
LevelId
arena <- case Maybe ActorId
mleader of
Nothing -> LevelId -> m LevelId
forall (m :: * -> *) a. Monad m => a -> m a
return (LevelId -> m LevelId) -> LevelId -> m LevelId
forall a b. (a -> b) -> a -> b
$! Actor -> LevelId
blid Actor
bPre
Just leader :: ActorId
leader -> 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
leader
LevelId -> m LevelId
forall (m :: * -> *) a. Monad m => a -> m a
return (LevelId -> m LevelId) -> LevelId -> m LevelId
forall a b. (a -> b) -> a -> b
$! Actor -> LevelId
blid Actor
b
if | Actor -> LevelId
blid Actor
bPre LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
/= LevelId
arena Bool -> Bool -> Bool
&& Bool
autoDun ->
ActorId -> RequestTimed -> ReqFailure -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId -> RequestTimed -> ReqFailure -> m ()
execFailure ActorId
aidNew RequestTimed
ReqWait ReqFailure
NoChangeDunLeader
| Bool
otherwise -> do
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 (ActorId -> Maybe ActorId
forall a. a -> Maybe a
Just ActorId
aidNew)
case Maybe ActorId
mleader of
Just aidOld :: ActorId
aidOld | ActorId
aidOld ActorId -> ActorId -> Bool
forall a. Eq a => a -> a -> Bool
/= ActorId
aidNew -> ActorId -> ActorId -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId -> ActorId -> m ()
swapTime ActorId
aidOld ActorId
aidNew
_ -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
affectSmell :: MonadServerAtomic m => ActorId -> m ()
affectSmell :: ActorId -> m ()
affectSmell aid :: ActorId
aid = 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
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
lvl <- 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 aquatic :: Bool
aquatic = TileSpeedup -> ContentId TileKind -> Bool
Tile.isAquatic TileSpeedup
coTileSpeedup (ContentId TileKind -> Bool) -> ContentId TileKind -> Bool
forall a b. (a -> b) -> a -> b
$ Level
lvl Level -> Point -> ContentId TileKind
`at` Actor -> Point
bpos Actor
b
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Actor -> Bool
bproj Actor
b Bool -> Bool -> Bool
|| Bool
aquatic) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Skills
actorMaxSk <- (State -> Skills) -> m Skills
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Skills) -> m Skills) -> (State -> Skills) -> m Skills
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Skills
getActorMaxSkills ActorId
aid
let smellRadius :: Int
smellRadius = Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkSmell Skills
actorMaxSk
hasOdor :: Bool
hasOdor = Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkOdor Skills
actorMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
hasOdor Bool -> Bool -> Bool
|| Int
smellRadius Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
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 -> State -> Time) -> LevelId -> State -> Time
forall a b. (a -> b) -> a -> b
$ Actor -> LevelId
blid Actor
b
let oldS :: Time
oldS = Time -> Maybe Time -> Time
forall a. a -> Maybe a -> a
fromMaybe Time
timeZero (Maybe Time -> Time) -> Maybe Time -> Time
forall a b. (a -> b) -> a -> b
$ Point -> EnumMap Point Time -> Maybe Time
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup (Actor -> Point
bpos Actor
b) (EnumMap Point Time -> Maybe Time)
-> (Level -> EnumMap Point Time) -> Level -> Maybe Time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Level -> EnumMap Point Time
lsmell (Level -> Maybe Time) -> Level -> Maybe Time
forall a b. (a -> b) -> a -> b
$ Level
lvl
newTime :: Time
newTime = Time -> Delta Time -> Time
timeShift Time
localTime Delta Time
smellTimeout
newS :: Time
newS = if Int
smellRadius Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0
then Time
timeZero
else Time
newTime
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Time
oldS Time -> Time -> Bool
forall a. Eq a => a -> a -> Bool
/= Time
newS) (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
$ LevelId -> Point -> Time -> Time -> UpdAtomic
UpdAlterSmell (Actor -> LevelId
blid Actor
b) (Actor -> Point
bpos Actor
b) Time
oldS Time
newS
reqMove :: MonadServerAtomic m => ActorId -> Vector -> m ()
reqMove :: ActorId -> Vector -> m ()
reqMove = Bool -> Bool -> ActorId -> Vector -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
Bool -> Bool -> ActorId -> Vector -> m ()
reqMoveGeneric Bool
True Bool
True
reqMoveGeneric :: MonadServerAtomic m
=> Bool -> Bool -> ActorId -> Vector -> m ()
reqMoveGeneric :: Bool -> Bool -> ActorId -> Vector -> m ()
reqMoveGeneric voluntary :: Bool
voluntary mayAttack :: Bool
mayAttack source :: ActorId
source dir :: Vector
dir = do
COps{TileSpeedup
coTileSpeedup :: TileSpeedup
coTileSpeedup :: COps -> TileSpeedup
coTileSpeedup} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
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
let abInSkill :: Skill -> Bool
abInSkill sk :: Skill
sk = Maybe ([Vector], Speed) -> Bool
forall a. Maybe a -> Bool
isJust (Actor -> Maybe ([Vector], Speed)
btrajectory Actor
sb)
Bool -> Bool -> Bool
|| Skill -> Skills -> Int
Ability.getSk Skill
sk Skills
actorSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0
lid :: LevelId
lid = Actor -> LevelId
blid Actor
sb
Level
lvl <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel LevelId
lid
let spos :: Point
spos = Actor -> Point
bpos Actor
sb
tpos :: Point
tpos = Point
spos Point -> Vector -> Point
`shift` Vector
dir
Actor -> Bool
collides <- (State -> Actor -> Bool) -> m (Actor -> Bool)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor -> Bool) -> m (Actor -> Bool))
-> (State -> Actor -> Bool) -> m (Actor -> Bool)
forall a b. (a -> b) -> a -> b
$ \s :: State
s tb :: Actor
tb ->
let sitemKind :: ItemKind
sitemKind = ItemId -> State -> ItemKind
getIidKindServer (Actor -> ItemId
btrunk Actor
sb) State
s
titemKind :: ItemKind
titemKind = ItemId -> State -> ItemKind
getIidKindServer (Actor -> ItemId
btrunk Actor
tb) State
s
sar :: AspectRecord
sar = State -> DiscoveryAspect
sdiscoAspect State
s DiscoveryAspect -> ItemId -> AspectRecord
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> ItemId
btrunk Actor
sb
tar :: AspectRecord
tar = State -> DiscoveryAspect
sdiscoAspect State
s DiscoveryAspect -> ItemId -> AspectRecord
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> ItemId
btrunk Actor
tb
bursting :: AspectRecord -> Bool
bursting arItem :: AspectRecord
arItem =
Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Fragile AspectRecord
arItem
Bool -> Bool -> Bool
&& Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Lobable AspectRecord
arItem
sbursting :: Bool
sbursting = AspectRecord -> Bool
bursting AspectRecord
sar
tbursting :: Bool
tbursting = AspectRecord -> Bool
bursting AspectRecord
tar
sdamaging :: Bool
sdamaging = ItemKind -> Bool
IK.isDamagingKind ItemKind
sitemKind
tdamaging :: Bool
tdamaging = ItemKind -> Bool
IK.isDamagingKind ItemKind
titemKind
sameBlast :: Bool
sameBlast = Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Blast AspectRecord
sar
Bool -> Bool -> Bool
&& ItemId -> State -> ContentId ItemKind
getIidKindIdServer (Actor -> ItemId
btrunk Actor
sb) State
s
ContentId ItemKind -> ContentId ItemKind -> Bool
forall a. Eq a => a -> a -> Bool
== ItemId -> State -> ContentId ItemKind
getIidKindIdServer (Actor -> ItemId
btrunk Actor
tb) State
s
in Bool -> Bool
not Bool
sameBlast
Bool -> Bool -> Bool
&& (Bool
sbursting Bool -> Bool -> Bool
&& (Bool
tdamaging Bool -> Bool -> Bool
|| Bool
tbursting)
Bool -> Bool -> Bool
|| (Bool
tbursting Bool -> Bool -> Bool
&& (Bool
sdamaging Bool -> Bool -> Bool
|| Bool
sbursting)))
[(ActorId, Actor)]
tgt <- (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
$ Point -> LevelId -> State -> [(ActorId, Actor)]
posToAidAssocs Point
tpos LevelId
lid
case [(ActorId, Actor)]
tgt of
(target :: ActorId
target, tb :: Actor
tb) : _ | Bool
mayAttack Bool -> Bool -> Bool
&& (Bool -> Bool
not (Actor -> Bool
bproj Actor
sb)
Bool -> Bool -> Bool
|| Bool -> Bool
not (Actor -> Bool
bproj Actor
tb)
Bool -> Bool -> Bool
|| Actor -> Bool
collides Actor
tb) -> do
Maybe (ItemId, CStore)
mweapon <- ActorId -> m (Maybe (ItemId, CStore))
forall (m :: * -> *).
MonadServer m =>
ActorId -> m (Maybe (ItemId, CStore))
pickWeaponServer ActorId
source
case Maybe (ItemId, CStore)
mweapon of
Just (wp :: ItemId
wp, cstore :: CStore
cstore) | Skill -> Bool
abInSkill Skill
Ability.SkMelee ->
Bool -> ActorId -> ActorId -> ItemId -> CStore -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
Bool -> ActorId -> ActorId -> ItemId -> CStore -> m ()
reqMeleeChecked Bool
voluntary ActorId
source ActorId
target ItemId
wp CStore
cstore
_ -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Actor -> Bool
bproj Actor
sb) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Actor
b2 <- (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
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Actor -> Bool
actorDying Actor
b2) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> ActorId -> Vector -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
Bool -> Bool -> ActorId -> Vector -> m ()
reqMoveGeneric Bool
voluntary Bool
False ActorId
source Vector
dir
_ ->
if TileSpeedup -> ContentId TileKind -> Bool
Tile.isWalkable TileSpeedup
coTileSpeedup (ContentId TileKind -> Bool) -> ContentId TileKind -> Bool
forall a b. (a -> b) -> a -> b
$ Level
lvl Level -> Point -> ContentId TileKind
`at` Point
tpos then
if Skill -> Bool
abInSkill Skill
Ability.SkMove then do
UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ ActorId -> Point -> Point -> UpdAtomic
UpdMoveActor ActorId
source Point
spos Point
tpos
ActorId -> m ()
forall (m :: * -> *). MonadServerAtomic m => ActorId -> m ()
affectSmell ActorId
source
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Actor -> Bool
bproj Actor
sb) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
m (Maybe ReqFailure) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (Maybe ReqFailure) -> m ()) -> m (Maybe ReqFailure) -> m ()
forall a b. (a -> b) -> a -> b
$ Bool
-> EffToUse -> Bool -> ActorId -> Point -> m (Maybe ReqFailure)
forall (m :: * -> *).
MonadServerAtomic m =>
Bool
-> EffToUse -> Bool -> ActorId -> Point -> m (Maybe ReqFailure)
reqAlterFail Bool
True EffToUse
EffBare Bool
voluntary ActorId
source Point
tpos
else ActorId -> RequestTimed -> ReqFailure -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId -> RequestTimed -> ReqFailure -> m ()
execFailure ActorId
source (Vector -> RequestTimed
ReqMove Vector
dir) ReqFailure
MoveUnskilled
else do
Maybe ReqFailure
mfail <- Bool
-> EffToUse -> Bool -> ActorId -> Point -> m (Maybe ReqFailure)
forall (m :: * -> *).
MonadServerAtomic m =>
Bool
-> EffToUse -> Bool -> ActorId -> Point -> m (Maybe ReqFailure)
reqAlterFail Bool
True EffToUse
EffBare Bool
voluntary ActorId
source Point
tpos
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
voluntary (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
let req :: RequestTimed
req = Vector -> RequestTimed
ReqMove Vector
dir
m () -> (ReqFailure -> m ()) -> Maybe ReqFailure -> m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (ActorId -> RequestTimed -> ReqFailure -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId -> RequestTimed -> ReqFailure -> m ()
execFailure ActorId
source RequestTimed
req) Maybe ReqFailure
mfail
reqMelee :: MonadServerAtomic m
=> ActorId -> ActorId -> ItemId -> CStore -> m ()
reqMelee :: ActorId -> ActorId -> ItemId -> CStore -> m ()
reqMelee source :: ActorId
source target :: ActorId
target iid :: ItemId
iid cstore :: CStore
cstore = do
Skills
actorSk <- ActorId -> m Skills
forall (m :: * -> *). MonadServer m => ActorId -> m Skills
currentSkillsServer ActorId
source
if Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkMelee Skills
actorSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 then
Bool -> ActorId -> ActorId -> ItemId -> CStore -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
Bool -> ActorId -> ActorId -> ItemId -> CStore -> m ()
reqMeleeChecked Bool
True ActorId
source ActorId
target ItemId
iid CStore
cstore
else ActorId -> RequestTimed -> ReqFailure -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId -> RequestTimed -> ReqFailure -> m ()
execFailure ActorId
source (ActorId -> ItemId -> CStore -> RequestTimed
ReqMelee ActorId
target ItemId
iid CStore
cstore) ReqFailure
MeleeUnskilled
reqMeleeChecked :: forall m. MonadServerAtomic m
=> Bool -> ActorId -> ActorId -> ItemId -> CStore -> m ()
reqMeleeChecked :: Bool -> ActorId -> ActorId -> ItemId -> CStore -> m ()
reqMeleeChecked voluntary :: Bool
voluntary source :: ActorId
source target :: ActorId
target iid :: ItemId
iid cstore :: CStore
cstore = do
Actor
sb <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
source
Actor
tb <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
target
DiscoveryAspect
discoAspect <- (State -> DiscoveryAspect) -> m DiscoveryAspect
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> DiscoveryAspect
sdiscoAspect
let req :: RequestTimed
req = ActorId -> ItemId -> CStore -> RequestTimed
ReqMelee ActorId
target ItemId
iid CStore
cstore
arWeapon :: AspectRecord
arWeapon = DiscoveryAspect
discoAspect DiscoveryAspect -> ItemId -> AspectRecord
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ItemId
iid
meleeableEnough :: Bool
meleeableEnough = Actor -> Bool
bproj Actor
sb Bool -> Bool -> Bool
|| Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Meleeable AspectRecord
arWeapon
if ActorId
source ActorId -> ActorId -> Bool
forall a. Eq a => a -> a -> Bool
== ActorId
target then ActorId -> RequestTimed -> ReqFailure -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId -> RequestTimed -> ReqFailure -> m ()
execFailure ActorId
source RequestTimed
req ReqFailure
MeleeSelf
else if Bool -> Bool
not (Actor -> Actor -> Bool
checkAdjacent Actor
sb Actor
tb) then ActorId -> RequestTimed -> ReqFailure -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId -> RequestTimed -> ReqFailure -> m ()
execFailure ActorId
source RequestTimed
req ReqFailure
MeleeDistant
else if Bool -> Bool
not Bool
meleeableEnough then ActorId -> RequestTimed -> ReqFailure -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId -> RequestTimed -> ReqFailure -> m ()
execFailure ActorId
source RequestTimed
req ReqFailure
MeleeNotWeapon
else do
ActorId
killer <- if | Bool
voluntary -> Bool -> m ActorId -> m ActorId
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Bool -> Bool
not (Actor -> Bool
bproj Actor
sb)) (m ActorId -> m ActorId) -> m ActorId -> m ActorId
forall a b. (a -> b) -> a -> b
$ ActorId -> m ActorId
forall (m :: * -> *) a. Monad m => a -> m a
return ActorId
source
| Actor -> Bool
bproj Actor
sb -> (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
source ActorId
source
(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
| Bool
otherwise -> ActorId -> m ActorId
forall (m :: * -> *) a. Monad m => a -> m a
return ActorId
source
Skills
actorSk <- ActorId -> m Skills
forall (m :: * -> *). MonadServer m => ActorId -> m Skills
currentSkillsServer ActorId
source
let arTrunk :: AspectRecord
arTrunk = DiscoveryAspect
discoAspect DiscoveryAspect -> ItemId -> AspectRecord
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> ItemId
btrunk Actor
tb
sfid :: FactionId
sfid = Actor -> FactionId
bfid Actor
sb
tfid :: FactionId
tfid = Actor -> FactionId
bfid Actor
tb
haltTrajectory :: KillHow -> ActorId -> Actor -> m ()
haltTrajectory :: KillHow -> ActorId -> Actor -> m ()
haltTrajectory killHow :: KillHow
killHow aid :: ActorId
aid b :: Actor
b = case Actor -> Maybe ([Vector], Speed)
btrajectory Actor
b of
btra :: Maybe ([Vector], Speed)
btra@(Just (l :: [Vector]
l, speed :: Speed
speed)) | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Vector] -> Bool
forall a. [a] -> Bool
null [Vector]
l -> do
UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ ActorId
-> Maybe ([Vector], Speed) -> Maybe ([Vector], Speed) -> UpdAtomic
UpdTrajectory ActorId
aid Maybe ([Vector], Speed)
btra (Maybe ([Vector], Speed) -> UpdAtomic)
-> Maybe ([Vector], Speed) -> UpdAtomic
forall a b. (a -> b) -> a -> b
$ ([Vector], Speed) -> Maybe ([Vector], Speed)
forall a. a -> Maybe a
Just ([], Speed
speed)
let arTrunkAid :: AspectRecord
arTrunkAid = DiscoveryAspect
discoAspect DiscoveryAspect -> ItemId -> AspectRecord
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> ItemId
btrunk Actor
b
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Actor -> Bool
bproj Actor
b Bool -> Bool -> Bool
&& Bool -> Bool
not (Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Blast AspectRecord
arTrunkAid)) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
ActorId -> KillHow -> FactionId -> ItemId -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId -> KillHow -> FactionId -> ItemId -> m ()
addKillToAnalytics ActorId
killer KillHow
killHow (Actor -> FactionId
bfid Actor
b) (Actor -> ItemId
btrunk Actor
b)
_ -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
if Actor -> Bool
bproj Actor
tb
Bool -> Bool -> Bool
&& EnumMap ItemId ItemQuant -> Int
forall k a. EnumMap k a -> Int
EM.size (Actor -> EnumMap ItemId ItemQuant
beqp Actor
tb) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1
Bool -> Bool -> Bool
&& Bool -> Bool
not (Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Blast AspectRecord
arTrunk)
Bool -> Bool -> Bool
&& Actor -> Bool
actorWaits Actor
sb
Bool -> Bool -> Bool
&& Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkMoveItem Skills
actorSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0
then do
SfxAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => SfxAtomic -> m ()
execSfxAtomic (SfxAtomic -> m ()) -> SfxAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ ActorId -> ActorId -> ItemId -> SfxAtomic
SfxSteal ActorId
source ActorId
target ItemId
iid
case EnumMap ItemId ItemQuant -> [(ItemId, ItemQuant)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs (EnumMap ItemId ItemQuant -> [(ItemId, ItemQuant)])
-> EnumMap ItemId ItemQuant -> [(ItemId, ItemQuant)]
forall a b. (a -> b) -> a -> b
$ Actor -> EnumMap ItemId ItemQuant
beqp Actor
tb of
[(iid2 :: ItemId
iid2, (k :: Int
k, _))] -> do
[UpdAtomic]
upds <- Bool -> ItemId -> Int -> Container -> Container -> m [UpdAtomic]
forall (m :: * -> *).
MonadStateRead m =>
Bool -> ItemId -> Int -> Container -> Container -> m [UpdAtomic]
generalMoveItem Bool
True ItemId
iid2 Int
k (ActorId -> CStore -> Container
CActor ActorId
target CStore
CEqp)
(ActorId -> CStore -> Container
CActor ActorId
source CStore
CStash)
(UpdAtomic -> m ()) -> [UpdAtomic] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
mapM_ UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic [UpdAtomic]
upds
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
iid2
Container -> ItemId -> ContentId ItemKind -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
Container -> ItemId -> ContentId ItemKind -> m ()
discoverIfMinorEffects (ActorId -> CStore -> Container
CActor ActorId
source CStore
CStash)
ItemId
iid2 (ItemFull -> ContentId ItemKind
itemKindId ItemFull
itemFull)
err :: [(ItemId, ItemQuant)]
err -> String -> m ()
forall a. (?callStack::CallStack) => String -> a
error (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ "" String -> [(ItemId, ItemQuant)] -> String
forall v. Show v => String -> v -> String
`showFailure` [(ItemId, ItemQuant)]
err
KillHow -> ActorId -> Actor -> m ()
haltTrajectory KillHow
KillCatch ActorId
target Actor
tb
else do
if Actor -> Bool
bproj Actor
sb Bool -> Bool -> Bool
&& Actor -> Bool
bproj Actor
tb then do
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Actor -> Int64
bhp Actor
tb Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
oneM) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ ActorId -> Int64 -> UpdAtomic
UpdRefillHP ActorId
target Int64
minusM
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Actor -> Int64
bhp Actor
tb Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int64
oneM) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
let killHow :: KillHow
killHow | Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Blast AspectRecord
arWeapon = KillHow
KillKineticBlast
| Bool
otherwise = KillHow
KillKineticRanged
KillHow -> ActorId -> Actor -> m ()
haltTrajectory KillHow
killHow ActorId
target Actor
tb
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Blast AspectRecord
arWeapon
Bool -> Bool -> Bool
&& Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Blast AspectRecord
arTrunk) (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 -> ActorId -> ItemId -> SfxAtomic
SfxStrike ActorId
source ActorId
target ItemId
iid
else do
let mayDestroyTarget :: Bool
mayDestroyTarget = Bool -> Bool
not (Actor -> Bool
bproj Actor
tb) Bool -> Bool -> Bool
|| Actor -> Int64
bhp Actor
tb Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int64
oneM
effApplyFlagsTarget :: EffApplyFlags
effApplyFlagsTarget = $WEffApplyFlags :: EffToUse
-> Bool -> Bool -> Bool -> ActivationFlag -> Bool -> EffApplyFlags
EffApplyFlags
{ effToUse :: EffToUse
effToUse = EffToUse
EffBare
, effVoluntary :: Bool
effVoluntary = Bool
voluntary
, effUseAllCopies :: Bool
effUseAllCopies = Bool
False
, effKineticPerformed :: Bool
effKineticPerformed = Bool
False
, effActivation :: ActivationFlag
effActivation = if Actor -> Bool
bproj Actor
sb
then ActivationFlag
Ability.ActivationUnderRanged
else ActivationFlag
Ability.ActivationUnderMelee
, effMayDestroy :: Bool
effMayDestroy = Bool
mayDestroyTarget
}
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Actor -> Bool
bproj Actor
tb) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
EffApplyFlags -> ActorId -> ActorId -> Actor -> Flag -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
EffApplyFlags -> ActorId -> ActorId -> Actor -> Flag -> m ()
autoApply EffApplyFlags
effApplyFlagsTarget ActorId
killer ActorId
target Actor
tb
(Flag -> m ()) -> Flag -> m ()
forall a b. (a -> b) -> a -> b
$ if Actor -> Bool
bproj Actor
sb then Flag
Ability.UnderRanged else Flag
Ability.UnderMelee
Actor
sb2 <- (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
Skills
targetMaxSk <- (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
target
if | Actor -> Bool
bproj Actor
sb2
Bool -> Bool -> Bool
&& Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkDeflectRanged Skills
targetMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 -> do
ActorId -> m ()
forall (m :: * -> *). MonadServerAtomic m => ActorId -> m ()
cutCalm ActorId
target
SfxAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => SfxAtomic -> m ()
execSfxAtomic (SfxAtomic -> m ()) -> SfxAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ ActorId -> ActorId -> ItemId -> SfxAtomic
SfxRecoil ActorId
source ActorId
target ItemId
iid
| Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkDeflectMelee Skills
targetMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 -> do
ActorId -> m ()
forall (m :: * -> *). MonadServerAtomic m => ActorId -> m ()
cutCalm ActorId
target
SfxAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => SfxAtomic -> m ()
execSfxAtomic (SfxAtomic -> m ()) -> SfxAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ ActorId -> ActorId -> ItemId -> SfxAtomic
SfxRecoil ActorId
source ActorId
target ItemId
iid
| Bool
otherwise -> do
SfxAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => SfxAtomic -> m ()
execSfxAtomic (SfxAtomic -> m ()) -> SfxAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ ActorId -> ActorId -> ItemId -> SfxAtomic
SfxStrike ActorId
source ActorId
target ItemId
iid
let c :: Container
c = ActorId -> CStore -> Container
CActor ActorId
source CStore
cstore
mayDestroySource :: Bool
mayDestroySource = Bool -> Bool
not (Actor -> Bool
bproj Actor
sb2) Bool -> Bool -> Bool
|| Actor -> Int64
bhp Actor
sb2 Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int64
oneM
let effApplyFlagsSource :: EffApplyFlags
effApplyFlagsSource = $WEffApplyFlags :: EffToUse
-> Bool -> Bool -> Bool -> ActivationFlag -> Bool -> EffApplyFlags
EffApplyFlags
{ effToUse :: EffToUse
effToUse = EffToUse
EffBare
, effVoluntary :: Bool
effVoluntary = Bool
voluntary
, effUseAllCopies :: Bool
effUseAllCopies = Bool
False
, effKineticPerformed :: Bool
effKineticPerformed = Bool
False
, effActivation :: ActivationFlag
effActivation = ActivationFlag
Ability.ActivationMeleeable
, effMayDestroy :: Bool
effMayDestroy = Bool
mayDestroySource
}
m UseResult -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m UseResult -> m ()) -> m UseResult -> m ()
forall a b. (a -> b) -> a -> b
$ EffApplyFlags
-> ActorId
-> ActorId
-> ActorId
-> ItemId
-> Container
-> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
EffApplyFlags
-> ActorId
-> ActorId
-> ActorId
-> ItemId
-> Container
-> m UseResult
kineticEffectAndDestroy EffApplyFlags
effApplyFlagsSource ActorId
killer
ActorId
source ActorId
target ItemId
iid Container
c
Actor
sb2 <- (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
case Actor -> Maybe ([Vector], Speed)
btrajectory Actor
sb2 of
Just{} | Bool -> Bool
not Bool
voluntary -> do
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Actor -> Int64
bhp Actor
sb2 Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
oneM) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ ActorId -> Int64 -> UpdAtomic
UpdRefillHP ActorId
source Int64
minusM
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Actor -> Bool
bproj Actor
sb2) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
SfxAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => SfxAtomic -> m ()
execSfxAtomic (SfxAtomic -> m ()) -> SfxAtomic -> m ()
forall a b. (a -> b) -> a -> b
$
FactionId -> SfxMsg -> SfxAtomic
SfxMsgFid (Actor -> FactionId
bfid Actor
sb2) (SfxMsg -> SfxAtomic) -> SfxMsg -> SfxAtomic
forall a b. (a -> b) -> a -> b
$ ActorId -> ActorId -> SfxMsg
SfxCollideActor ActorId
source ActorId
target
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Actor -> Bool
bproj Actor
tb) (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
$
FactionId -> SfxMsg -> SfxAtomic
SfxMsgFid (Actor -> FactionId
bfid Actor
tb) (SfxMsg -> SfxAtomic) -> SfxMsg -> SfxAtomic
forall a b. (a -> b) -> a -> b
$ ActorId -> ActorId -> SfxMsg
SfxCollideActor ActorId
source ActorId
target
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Actor -> Bool
bproj Actor
sb2) Bool -> Bool -> Bool
|| Actor -> Int64
bhp Actor
sb2 Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int64
oneM) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
KillHow -> ActorId -> Actor -> m ()
haltTrajectory KillHow
KillActorLaunch ActorId
source Actor
sb2
_ -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Faction
sfact <- (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
$ (FactionDict -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
sfid) (FactionDict -> Faction)
-> (State -> FactionDict) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> FactionDict
sfactionD
let friendlyFire :: Bool
friendlyFire = Actor -> Bool
bproj Actor
sb2 Bool -> Bool -> Bool
|| Actor -> Bool
bproj Actor
tb Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
voluntary
fromDipl :: Diplomacy
fromDipl = Diplomacy -> FactionId -> EnumMap FactionId Diplomacy -> Diplomacy
forall k a. Enum k => a -> k -> EnumMap k a -> a
EM.findWithDefault Diplomacy
Unknown FactionId
tfid (Faction -> EnumMap FactionId Diplomacy
gdipl Faction
sfact)
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool
friendlyFire
Bool -> Bool -> Bool
|| FactionId -> Faction -> FactionId -> Bool
isFoe FactionId
sfid Faction
sfact FactionId
tfid
Bool -> Bool -> Bool
|| FactionId -> Faction -> FactionId -> Bool
isFriend FactionId
sfid Faction
sfact FactionId
tfid) (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 -> FactionId -> Diplomacy -> Diplomacy -> UpdAtomic
UpdDiplFaction FactionId
sfid FactionId
tfid Diplomacy
fromDipl Diplomacy
War
autoApply :: MonadServerAtomic m
=> EffApplyFlags -> ActorId -> ActorId -> Actor -> Ability.Flag
-> m ()
autoApply :: EffApplyFlags -> ActorId -> ActorId -> Actor -> Flag -> m ()
autoApply effApplyFlags :: EffApplyFlags
effApplyFlags killer :: ActorId
killer target :: ActorId
target tb :: Actor
tb flag :: Flag
flag = do
let autoApplyIid :: Container -> ItemId -> m ()
autoApplyIid c :: Container
c iid :: ItemId
iid = 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
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Flag -> AspectRecord -> Bool
IA.checkFlag Flag
flag AspectRecord
arItem) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
m UseResult -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m UseResult -> m ()) -> m UseResult -> m ()
forall a b. (a -> b) -> a -> b
$ EffApplyFlags
-> ActorId
-> ActorId
-> ActorId
-> ItemId
-> Container
-> ItemFull
-> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
EffApplyFlags
-> ActorId
-> ActorId
-> ActorId
-> ItemId
-> Container
-> ItemFull
-> m UseResult
effectAndDestroyAndAddKill EffApplyFlags
effApplyFlags ActorId
killer ActorId
target ActorId
target
ItemId
iid Container
c ItemFull
itemFull
(ItemId -> m ()) -> [ItemId] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
mapM_ (Container -> ItemId -> m ()
autoApplyIid (Container -> ItemId -> m ()) -> Container -> ItemId -> m ()
forall a b. (a -> b) -> a -> b
$ ActorId -> CStore -> Container
CActor ActorId
target CStore
CEqp) ([ItemId] -> m ()) -> [ItemId] -> m ()
forall a b. (a -> b) -> a -> b
$ EnumMap ItemId ItemQuant -> [ItemId]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys (EnumMap ItemId ItemQuant -> [ItemId])
-> EnumMap ItemId ItemQuant -> [ItemId]
forall a b. (a -> b) -> a -> b
$ Actor -> EnumMap ItemId ItemQuant
beqp Actor
tb
(ItemId -> m ()) -> [ItemId] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
mapM_ (Container -> ItemId -> m ()
autoApplyIid (Container -> ItemId -> m ()) -> Container -> ItemId -> m ()
forall a b. (a -> b) -> a -> b
$ ActorId -> CStore -> Container
CActor ActorId
target CStore
COrgan) ([ItemId] -> m ()) -> [ItemId] -> m ()
forall a b. (a -> b) -> a -> b
$ EnumMap ItemId ItemQuant -> [ItemId]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys (EnumMap ItemId ItemQuant -> [ItemId])
-> EnumMap ItemId ItemQuant -> [ItemId]
forall a b. (a -> b) -> a -> b
$ Actor -> EnumMap ItemId ItemQuant
borgan Actor
tb
reqDisplace :: MonadServerAtomic m => ActorId -> ActorId -> m ()
reqDisplace :: ActorId -> ActorId -> m ()
reqDisplace = Bool -> ActorId -> ActorId -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
Bool -> ActorId -> ActorId -> m ()
reqDisplaceGeneric Bool
True
reqDisplaceGeneric :: MonadServerAtomic m => Bool -> ActorId -> ActorId -> m ()
reqDisplaceGeneric :: Bool -> ActorId -> ActorId -> m ()
reqDisplaceGeneric voluntary :: Bool
voluntary source :: ActorId
source target :: ActorId
target = do
COps{TileSpeedup
coTileSpeedup :: TileSpeedup
coTileSpeedup :: COps -> TileSpeedup
coTileSpeedup} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
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
let abInSkill :: Skill -> Bool
abInSkill sk :: Skill
sk = Maybe ([Vector], Speed) -> Bool
forall a. Maybe a -> Bool
isJust (Actor -> Maybe ([Vector], Speed)
btrajectory Actor
sb)
Bool -> Bool -> Bool
|| Skill -> Skills -> Int
Ability.getSk Skill
sk Skills
actorSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0
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
Faction
tfact <- (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
$ (FactionDict -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
tb) (FactionDict -> Faction)
-> (State -> FactionDict) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> FactionDict
sfactionD
let spos :: Point
spos = Actor -> Point
bpos Actor
sb
tpos :: Point
tpos = Actor -> Point
bpos Actor
tb
atWar :: Bool
atWar = FactionId -> Faction -> FactionId -> Bool
isFoe (Actor -> FactionId
bfid Actor
tb) Faction
tfact (Actor -> FactionId
bfid Actor
sb)
req :: RequestTimed
req = ActorId -> RequestTimed
ReqDisplace ActorId
target
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
target
Bool
dEnemy <- (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 -> ActorId -> Skills -> State -> Bool
dispEnemy ActorId
source ActorId
target Skills
actorMaxSk
if | Bool -> Bool
not (Skill -> Bool
abInSkill Skill
Ability.SkDisplace) ->
ActorId -> RequestTimed -> ReqFailure -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId -> RequestTimed -> ReqFailure -> m ()
execFailure ActorId
source RequestTimed
req ReqFailure
DisplaceUnskilled
| Bool -> Bool
not (Actor -> Actor -> Bool
checkAdjacent Actor
sb Actor
tb) -> ActorId -> RequestTimed -> ReqFailure -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId -> RequestTimed -> ReqFailure -> m ()
execFailure ActorId
source RequestTimed
req ReqFailure
DisplaceDistant
| Bool
atWar Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
dEnemy -> do
Maybe (ItemId, CStore)
mweapon <- ActorId -> m (Maybe (ItemId, CStore))
forall (m :: * -> *).
MonadServer m =>
ActorId -> m (Maybe (ItemId, CStore))
pickWeaponServer ActorId
source
case Maybe (ItemId, CStore)
mweapon of
Just (wp :: ItemId
wp, cstore :: CStore
cstore) | Skill -> Bool
abInSkill Skill
Ability.SkMelee ->
Bool -> ActorId -> ActorId -> ItemId -> CStore -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
Bool -> ActorId -> ActorId -> ItemId -> CStore -> m ()
reqMeleeChecked Bool
voluntary ActorId
source ActorId
target ItemId
wp CStore
cstore
_ -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise -> do
let lid :: LevelId
lid = Actor -> LevelId
blid Actor
sb
Level
lvl <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel LevelId
lid
if TileSpeedup -> ContentId TileKind -> Bool
Tile.isWalkable TileSpeedup
coTileSpeedup (ContentId TileKind -> Bool) -> ContentId TileKind -> Bool
forall a b. (a -> b) -> a -> b
$ Level
lvl Level -> Point -> ContentId TileKind
`at` Point
tpos then
case Point -> Level -> [ActorId]
posToAidsLvl Point
tpos Level
lvl of
[] -> String -> m ()
forall a. (?callStack::CallStack) => String -> a
error (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ "" String -> (ActorId, Actor, ActorId, Actor) -> String
forall v. Show v => String -> v -> String
`showFailure` (ActorId
source, Actor
sb, ActorId
target, Actor
tb)
[_] -> do
UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ ActorId -> ActorId -> UpdAtomic
UpdDisplaceActor ActorId
source ActorId
target
ActorId -> m ()
forall (m :: * -> *). MonadServerAtomic m => ActorId -> m ()
affectSmell ActorId
source
ActorId -> m ()
forall (m :: * -> *). MonadServerAtomic m => ActorId -> m ()
affectSmell ActorId
target
m (Maybe ReqFailure) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (Maybe ReqFailure) -> m ()) -> m (Maybe ReqFailure) -> m ()
forall a b. (a -> b) -> a -> b
$ Bool
-> EffToUse -> Bool -> ActorId -> Point -> m (Maybe ReqFailure)
forall (m :: * -> *).
MonadServerAtomic m =>
Bool
-> EffToUse -> Bool -> ActorId -> Point -> m (Maybe ReqFailure)
reqAlterFail Bool
True EffToUse
EffBare Bool
False ActorId
source Point
tpos
m (Maybe ReqFailure) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (Maybe ReqFailure) -> m ()) -> m (Maybe ReqFailure) -> m ()
forall a b. (a -> b) -> a -> b
$ Bool
-> EffToUse -> Bool -> ActorId -> Point -> m (Maybe ReqFailure)
forall (m :: * -> *).
MonadServerAtomic m =>
Bool
-> EffToUse -> Bool -> ActorId -> Point -> m (Maybe ReqFailure)
reqAlterFail Bool
True EffToUse
EffBare Bool
False ActorId
target Point
spos
_ -> ActorId -> RequestTimed -> ReqFailure -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId -> RequestTimed -> ReqFailure -> m ()
execFailure ActorId
source RequestTimed
req ReqFailure
DisplaceMultiple
else
ActorId -> RequestTimed -> ReqFailure -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId -> RequestTimed -> ReqFailure -> m ()
execFailure ActorId
source RequestTimed
req ReqFailure
DisplaceAccess
reqAlter :: MonadServerAtomic m => ActorId -> Point -> m ()
reqAlter :: ActorId -> Point -> m ()
reqAlter source :: ActorId
source tpos :: Point
tpos = do
COps{TileSpeedup
coTileSpeedup :: TileSpeedup
coTileSpeedup :: COps -> TileSpeedup
coTileSpeedup} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
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
Level
lvl <- 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
sb
let effToUse :: EffToUse
effToUse = if TileSpeedup -> ContentId TileKind -> Bool
Tile.isWalkable TileSpeedup
coTileSpeedup (Level
lvl Level -> Point -> ContentId TileKind
`at` Point
tpos)
then EffToUse
EffOnCombine
else EffToUse
EffBareAndOnCombine
Maybe ReqFailure
mfail <- Bool
-> EffToUse -> Bool -> ActorId -> Point -> m (Maybe ReqFailure)
forall (m :: * -> *).
MonadServerAtomic m =>
Bool
-> EffToUse -> Bool -> ActorId -> Point -> m (Maybe ReqFailure)
reqAlterFail Bool
False EffToUse
effToUse Bool
True ActorId
source Point
tpos
let req :: RequestTimed
req = Point -> RequestTimed
ReqAlter Point
tpos
m () -> (ReqFailure -> m ()) -> Maybe ReqFailure -> m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (ActorId -> RequestTimed -> ReqFailure -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId -> RequestTimed -> ReqFailure -> m ()
execFailure ActorId
source RequestTimed
req) Maybe ReqFailure
mfail
reqAlterFail :: forall m. MonadServerAtomic m
=> Bool -> EffToUse -> Bool -> ActorId -> Point
-> m (Maybe ReqFailure)
reqAlterFail :: Bool
-> EffToUse -> Bool -> ActorId -> Point -> m (Maybe ReqFailure)
reqAlterFail bumping :: Bool
bumping effToUse :: EffToUse
effToUse voluntary :: Bool
voluntary source :: ActorId
source tpos :: Point
tpos = do
cops :: COps
cops@COps{ContentData TileKind
cotile :: COps -> ContentData TileKind
cotile :: ContentData TileKind
cotile, TileSpeedup
coTileSpeedup :: TileSpeedup
coTileSpeedup :: COps -> TileSpeedup
coTileSpeedup} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
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
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
source
let calmE :: Bool
calmE = Actor -> Skills -> Bool
calmEnough Actor
sb Skills
actorMaxSk
lid :: LevelId
lid = Actor -> LevelId
blid Actor
sb
State
sClient <- (StateServer -> State) -> m State
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer ((StateServer -> State) -> m State)
-> (StateServer -> State) -> m State
forall a b. (a -> b) -> a -> b
$ (EnumMap FactionId State -> FactionId -> State
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
sb) (EnumMap FactionId State -> State)
-> (StateServer -> EnumMap FactionId State) -> StateServer -> State
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateServer -> EnumMap FactionId State
sclientStates
ItemId -> ItemFull
itemToF <- (State -> ItemId -> ItemFull) -> m (ItemId -> ItemFull)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemId -> ItemFull) -> m (ItemId -> ItemFull))
-> (State -> ItemId -> ItemFull) -> m (ItemId -> ItemFull)
forall a b. (a -> b) -> a -> b
$ (ItemId -> State -> ItemFull) -> State -> ItemId -> ItemFull
forall a b c. (a -> b -> c) -> b -> a -> c
flip ItemId -> State -> ItemFull
itemToFull
Skills
actorSk <- ActorId -> m Skills
forall (m :: * -> *). MonadServer m => ActorId -> m Skills
currentSkillsServer ActorId
source
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
EnumMap ItemId ItemQuant
embeds <- (State -> EnumMap ItemId ItemQuant) -> m (EnumMap ItemId ItemQuant)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> EnumMap ItemId ItemQuant)
-> m (EnumMap ItemId ItemQuant))
-> (State -> EnumMap ItemId ItemQuant)
-> m (EnumMap ItemId ItemQuant)
forall a b. (a -> b) -> a -> b
$ LevelId -> Point -> State -> EnumMap ItemId ItemQuant
getEmbedBag LevelId
lid Point
tpos
Level
lvl <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel LevelId
lid
ItemId -> ItemKind
getKind <- (State -> ItemId -> ItemKind) -> m (ItemId -> ItemKind)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemId -> ItemKind) -> m (ItemId -> ItemKind))
-> (State -> ItemId -> ItemKind) -> m (ItemId -> ItemKind)
forall a b. (a -> b) -> a -> b
$ (ItemId -> State -> ItemKind) -> State -> ItemId -> ItemKind
forall a b c. (a -> b -> c) -> b -> a -> c
flip ItemId -> State -> ItemKind
getIidKindServer
let serverTile :: ContentId TileKind
serverTile = Level
lvl Level -> Point -> ContentId TileKind
`at` Point
tpos
lvlClient :: Level
lvlClient = (EnumMap LevelId Level -> LevelId -> Level
forall k a. Enum k => EnumMap k a -> k -> a
EM.! LevelId
lid) (EnumMap LevelId Level -> Level)
-> (State -> EnumMap LevelId Level) -> State -> Level
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap LevelId Level
sdungeon (State -> Level) -> State -> Level
forall a b. (a -> b) -> a -> b
$ State
sClient
clientTile :: ContentId TileKind
clientTile = Level
lvlClient Level -> Point -> ContentId TileKind
`at` Point
tpos
hiddenTile :: Maybe (ContentId TileKind)
hiddenTile = ContentData TileKind
-> ContentId TileKind -> Maybe (ContentId TileKind)
Tile.hideAs ContentData TileKind
cotile ContentId TileKind
serverTile
alterSkill :: Int
alterSkill = Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkAlter Skills
actorSk
tileMinSkill :: Int
tileMinSkill = TileSpeedup -> ContentId TileKind -> Int
Tile.alterMinSkill TileSpeedup
coTileSpeedup ContentId TileKind
serverTile
revealEmbeds :: m ()
revealEmbeds = Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (EnumMap ItemId ItemQuant -> Bool
forall k a. EnumMap k a -> Bool
EM.null EnumMap ItemId ItemQuant
embeds) (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
$ Bool -> Container -> EnumMap ItemId ItemQuant -> UpdAtomic
UpdSpotItemBag Bool
True (LevelId -> Point -> Container
CEmbed LevelId
lid Point
tpos) EnumMap ItemId ItemQuant
embeds
embedKindList :: [(ItemKind, (ItemId, ItemQuant))]
embedKindList =
((ItemId, ItemQuant) -> (ItemKind, (ItemId, ItemQuant)))
-> [(ItemId, ItemQuant)] -> [(ItemKind, (ItemId, ItemQuant))]
forall a b. (a -> b) -> [a] -> [b]
map (\(iid :: ItemId
iid, kit :: ItemQuant
kit) -> (ItemId -> ItemKind
getKind ItemId
iid, (ItemId
iid, ItemQuant
kit))) (EnumMap ItemId ItemQuant -> [(ItemId, ItemQuant)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs EnumMap ItemId ItemQuant
embeds)
sbItemKind :: ItemKind
sbItemKind = ItemId -> ItemKind
getKind (ItemId -> ItemKind) -> ItemId -> ItemKind
forall a b. (a -> b) -> a -> b
$ Actor -> ItemId
btrunk Actor
sb
projNoDamage :: Bool
projNoDamage = Actor -> Bool
bproj Actor
sb Bool -> Bool -> Bool
&& Bool -> Bool
not (ItemKind -> Bool
IK.isDamagingKind ItemKind
sbItemKind)
tryApplyEmbed :: (ItemId, ItemQuant) -> m UseResult
tryApplyEmbed (iid :: ItemId
iid, kit :: ItemQuant
kit) = do
let itemFull :: ItemFull
itemFull = ItemId -> ItemFull
itemToF ItemId
iid
legal :: Either ReqFailure Bool
legal = Time
-> Int
-> Bool
-> Maybe CStore
-> ItemFull
-> ItemQuant
-> Either ReqFailure Bool
permittedApply Time
localTime Int
forall a. Bounded a => a
maxBound Bool
calmE Maybe CStore
forall a. Maybe a
Nothing ItemFull
itemFull ItemQuant
kit
case Either ReqFailure Bool
legal of
Left ApplyNoEffects -> UseResult -> m UseResult
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseDud
Left reqFail :: ReqFailure
reqFail -> do
SfxAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => SfxAtomic -> m ()
execSfxAtomic (SfxAtomic -> m ()) -> SfxAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ FactionId -> SfxMsg -> SfxAtomic
SfxMsgFid (Actor -> FactionId
bfid Actor
sb)
(SfxMsg -> SfxAtomic) -> SfxMsg -> SfxAtomic
forall a b. (a -> b) -> a -> b
$ ItemId -> LevelId -> ReqFailure -> SfxMsg
SfxExpectedEmbed ItemId
iid LevelId
lid ReqFailure
reqFail
UseResult -> m UseResult
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseDud
_ -> EffToUse
-> Bool -> ActorId -> LevelId -> Point -> ItemId -> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
EffToUse
-> Bool -> ActorId -> LevelId -> Point -> ItemId -> m UseResult
itemEffectEmbedded EffToUse
effToUse Bool
voluntary ActorId
source LevelId
lid Point
tpos ItemId
iid
underFeet :: Bool
underFeet = Point
tpos Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> Point
bpos Actor
sb
blockedByItem :: Bool
blockedByItem = Point -> EnumMap Point (EnumMap ItemId ItemQuant) -> Bool
forall k a. Enum k => k -> EnumMap k a -> Bool
EM.member Point
tpos (Level -> EnumMap Point (EnumMap ItemId ItemQuant)
lfloor Level
lvl)
if Point -> Point -> Int
chessDist Point
tpos (Actor -> Point
bpos Actor
sb) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1
then 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
AlterDistant
else if ContentId TileKind -> Maybe (ContentId TileKind)
forall a. a -> Maybe a
Just ContentId TileKind
clientTile Maybe (ContentId TileKind) -> Maybe (ContentId TileKind) -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe (ContentId TileKind)
hiddenTile then
if Actor -> Bool
bproj Actor
sb Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
underFeet Bool -> Bool -> Bool
&& Int
alterSkill Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 1
then 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
AlterUnskilled
else do
UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ ActorId -> Point -> ContentId TileKind -> UpdAtomic
UpdSearchTile ActorId
source Point
tpos ContentId TileKind
serverTile
m ()
revealEmbeds
case Point -> EnumMap Point PlaceEntry -> Maybe PlaceEntry
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup Point
tpos (EnumMap Point PlaceEntry -> Maybe PlaceEntry)
-> EnumMap Point PlaceEntry -> Maybe PlaceEntry
forall a b. (a -> b) -> a -> b
$ Level -> EnumMap Point PlaceEntry
lentry Level
lvl of
Nothing -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just entry :: PlaceEntry
entry -> UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ LevelId -> [(Point, PlaceEntry)] -> UpdAtomic
UpdSpotEntry LevelId
lid [(Point
tpos, PlaceEntry
entry)]
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (TileSpeedup -> ContentId TileKind -> Bool
Tile.isModifiable TileSpeedup
coTileSpeedup ContentId TileKind
serverTile Bool -> Bool -> Bool
|| Bool
projNoDamage) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
((ItemId, ItemQuant) -> m ()) -> [(ItemId, ItemQuant)] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
mapM_ (m UseResult -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m UseResult -> m ())
-> ((ItemId, ItemQuant) -> m UseResult)
-> (ItemId, ItemQuant)
-> m ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ItemId, ItemQuant) -> m UseResult
tryApplyEmbed)
(COps
-> ContentId TileKind
-> [(ItemKind, (ItemId, ItemQuant))]
-> [(ItemId, ItemQuant)]
sortEmbeds COps
cops ContentId TileKind
serverTile [(ItemKind, (ItemId, ItemQuant))]
embedKindList)
Maybe ReqFailure -> m (Maybe ReqFailure)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ReqFailure
forall a. Maybe a
Nothing
else
if Bool -> Bool
not (Actor -> Bool
bproj Actor
sb Bool -> Bool -> Bool
|| Bool
underFeet)
Bool -> Bool -> Bool
&& Int
alterSkill Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
tileMinSkill
then 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
AlterUnskilled
else do
EnumMap ItemId ItemQuant
groundBag <- (State -> EnumMap ItemId ItemQuant) -> m (EnumMap ItemId ItemQuant)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> EnumMap ItemId ItemQuant)
-> m (EnumMap ItemId ItemQuant))
-> (State -> EnumMap ItemId ItemQuant)
-> m (EnumMap ItemId ItemQuant)
forall a b. (a -> b) -> a -> b
$ Actor -> CStore -> State -> EnumMap ItemId ItemQuant
getBodyStoreBag Actor
sb CStore
CGround
EnumMap ItemId ItemQuant
eqpBag <- (State -> EnumMap ItemId ItemQuant) -> m (EnumMap ItemId ItemQuant)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> EnumMap ItemId ItemQuant)
-> m (EnumMap ItemId ItemQuant))
-> (State -> EnumMap ItemId ItemQuant)
-> m (EnumMap ItemId ItemQuant)
forall a b. (a -> b) -> a -> b
$ Actor -> CStore -> State -> EnumMap ItemId ItemQuant
getBodyStoreBag Actor
sb CStore
CEqp
[(ItemId, ItemFullKit)]
kitAssG <- (State -> [(ItemId, ItemFullKit)]) -> m [(ItemId, ItemFullKit)]
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(ItemId, ItemFullKit)]) -> m [(ItemId, ItemFullKit)])
-> (State -> [(ItemId, ItemFullKit)]) -> m [(ItemId, ItemFullKit)]
forall a b. (a -> b) -> a -> b
$ ActorId -> [CStore] -> State -> [(ItemId, ItemFullKit)]
kitAssocs ActorId
source [CStore
CGround]
[(ItemId, ItemFullKit)]
kitAssE <- (State -> [(ItemId, ItemFullKit)]) -> m [(ItemId, ItemFullKit)]
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(ItemId, ItemFullKit)]) -> m [(ItemId, ItemFullKit)])
-> (State -> [(ItemId, ItemFullKit)]) -> m [(ItemId, ItemFullKit)]
forall a b. (a -> b) -> a -> b
$ ActorId -> [CStore] -> State -> [(ItemId, ItemFullKit)]
kitAssocs ActorId
source [CStore
CEqp]
let kitAss :: [((CStore, Bool), (ItemId, ItemFullKit))]
kitAss = [(ItemId, ItemFullKit)]
-> [(ItemId, ItemFullKit)]
-> [((CStore, Bool), (ItemId, ItemFullKit))]
listToolsToConsume [(ItemId, ItemFullKit)]
kitAssG [(ItemId, ItemFullKit)]
kitAssE
announceTileChange :: m ()
announceTileChange =
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool
underFeet Bool -> Bool -> Bool
|| EnumMap ItemId ItemQuant -> Bool
forall k a. EnumMap k a -> Bool
EM.null EnumMap ItemId ItemQuant
embeds) (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 -> LevelId -> Point -> ContentId TileKind -> SfxAtomic
SfxTrigger ActorId
source LevelId
lid Point
tpos ContentId TileKind
serverTile
changeTo :: GroupName TileKind -> m ()
changeTo tgroup :: GroupName TileKind
tgroup = do
let nightCond :: TileKind -> Bool
nightCond kt :: TileKind
kt = Bool -> Bool
not (Feature -> TileKind -> Bool
Tile.kindHasFeature Feature
TK.Walkable TileKind
kt
Bool -> Bool -> Bool
&& Feature -> TileKind -> Bool
Tile.kindHasFeature Feature
TK.Clear TileKind
kt)
Bool -> Bool -> Bool
|| (if Level -> Bool
lnight Level
lvl then Bool -> Bool
forall a. a -> a
id else Bool -> Bool
not)
(Feature -> TileKind -> Bool
Tile.kindHasFeature Feature
TK.Dark TileKind
kt)
Maybe (ContentId TileKind)
mtoTile <- Rnd (Maybe (ContentId TileKind)) -> m (Maybe (ContentId TileKind))
forall (m :: * -> *) a. MonadServer m => Rnd a -> m a
rndToAction (Rnd (Maybe (ContentId TileKind))
-> m (Maybe (ContentId TileKind)))
-> Rnd (Maybe (ContentId TileKind))
-> m (Maybe (ContentId TileKind))
forall a b. (a -> b) -> a -> b
$ ContentData TileKind
-> GroupName TileKind
-> (TileKind -> Bool)
-> Rnd (Maybe (ContentId TileKind))
forall a.
Show a =>
ContentData a
-> GroupName a -> (a -> Bool) -> Rnd (Maybe (ContentId a))
opick ContentData TileKind
cotile GroupName TileKind
tgroup TileKind -> Bool
nightCond
ContentId TileKind
toTile <- m (ContentId TileKind)
-> (ContentId TileKind -> m (ContentId TileKind))
-> Maybe (ContentId TileKind)
-> m (ContentId TileKind)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Rnd (ContentId TileKind) -> m (ContentId TileKind)
forall (m :: * -> *) a. MonadServer m => Rnd a -> m a
rndToAction
(Rnd (ContentId TileKind) -> m (ContentId TileKind))
-> Rnd (ContentId TileKind) -> m (ContentId TileKind)
forall a b. (a -> b) -> a -> b
$ ContentId TileKind
-> Maybe (ContentId TileKind) -> ContentId TileKind
forall a. a -> Maybe a -> a
fromMaybe (String -> ContentId TileKind
forall a. (?callStack::CallStack) => String -> a
error (String -> ContentId TileKind) -> String -> ContentId TileKind
forall a b. (a -> b) -> a -> b
$ "" String -> GroupName TileKind -> String
forall v. Show v => String -> v -> String
`showFailure` GroupName TileKind
tgroup)
(Maybe (ContentId TileKind) -> ContentId TileKind)
-> Rnd (Maybe (ContentId TileKind)) -> Rnd (ContentId TileKind)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ContentData TileKind
-> GroupName TileKind
-> (TileKind -> Bool)
-> Rnd (Maybe (ContentId TileKind))
forall a.
Show a =>
ContentData a
-> GroupName a -> (a -> Bool) -> Rnd (Maybe (ContentId a))
opick ContentData TileKind
cotile GroupName TileKind
tgroup (Bool -> TileKind -> Bool
forall a b. a -> b -> a
const Bool
True))
ContentId TileKind -> m (ContentId TileKind)
forall (m :: * -> *) a. Monad m => a -> m a
return
Maybe (ContentId TileKind)
mtoTile
EnumMap ItemId ItemQuant
embeds2 <- (State -> EnumMap ItemId ItemQuant) -> m (EnumMap ItemId ItemQuant)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> EnumMap ItemId ItemQuant)
-> m (EnumMap ItemId ItemQuant))
-> (State -> EnumMap ItemId ItemQuant)
-> m (EnumMap ItemId ItemQuant)
forall a b. (a -> b) -> a -> b
$ LevelId -> Point -> State -> EnumMap ItemId ItemQuant
getEmbedBag LevelId
lid Point
tpos
let newHasEmbeds :: Bool
newHasEmbeds = TileSpeedup -> ContentId TileKind -> Bool
Tile.isEmbed TileSpeedup
coTileSpeedup ContentId TileKind
toTile
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ContentId TileKind
serverTile ContentId TileKind -> ContentId TileKind -> Bool
forall a. Eq a => a -> a -> Bool
/= ContentId TileKind
toTile
Bool -> Bool -> Bool
|| EnumMap ItemId ItemQuant -> Bool
forall k a. EnumMap k a -> Bool
EM.null EnumMap ItemId ItemQuant
embeds2 Bool -> Bool -> Bool
&& Bool
newHasEmbeds) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ContentId TileKind
serverTile ContentId TileKind -> ContentId TileKind -> Bool
forall a. Eq a => a -> a -> Bool
/= ContentId TileKind
toTile) (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
$ LevelId
-> Point -> ContentId TileKind -> ContentId TileKind -> UpdAtomic
UpdAlterTile LevelId
lid Point
tpos ContentId TileKind
serverTile ContentId TileKind
toTile
case Maybe (ContentId TileKind)
hiddenTile of
Just tHidden :: ContentId TileKind
tHidden ->
UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ LevelId
-> Point -> ContentId TileKind -> ContentId TileKind -> UpdAtomic
UpdAlterTile LevelId
lid Point
tpos ContentId TileKind
tHidden ContentId TileKind
toTile
Nothing -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
case (TileSpeedup -> ContentId TileKind -> Bool
Tile.isExplorable TileSpeedup
coTileSpeedup ContentId TileKind
serverTile,
TileSpeedup -> ContentId TileKind -> Bool
Tile.isExplorable TileSpeedup
coTileSpeedup ContentId TileKind
toTile) of
(False, True) -> UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ LevelId -> Int -> UpdAtomic
UpdAlterExplorable LevelId
lid 1
(True, False) -> UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ LevelId -> Int -> UpdAtomic
UpdAlterExplorable LevelId
lid (-1)
_ -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (EnumMap ItemId ItemQuant -> Bool
forall k a. EnumMap k a -> Bool
EM.null EnumMap ItemId ItemQuant
embeds2) (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
$ Bool -> Container -> EnumMap ItemId ItemQuant -> UpdAtomic
UpdLoseItemBag Bool
True (LevelId -> Point -> Container
CEmbed LevelId
lid Point
tpos) EnumMap ItemId ItemQuant
embeds2
LevelId -> Point -> ContentId TileKind -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
LevelId -> Point -> ContentId TileKind -> m ()
embedItemOnPos LevelId
lid Point
tpos ContentId TileKind
toTile
tryChangeWith :: ( [(Int, GroupName IK.ItemKind)]
, GroupName TK.TileKind )
-> m Bool
tryChangeWith :: ([(Int, GroupName ItemKind)], GroupName TileKind) -> m Bool
tryChangeWith (tools0 :: [(Int, GroupName ItemKind)]
tools0, tgroup :: GroupName TileKind
tgroup) = do
let grps0 :: [(Bool, Int, GroupName ItemKind)]
grps0 = ((Int, GroupName ItemKind) -> (Bool, Int, GroupName ItemKind))
-> [(Int, GroupName ItemKind)] -> [(Bool, Int, GroupName ItemKind)]
forall a b. (a -> b) -> [a] -> [b]
map (\(x :: Int
x, y :: GroupName ItemKind
y) -> (Bool
False, Int
x, GroupName ItemKind
y)) [(Int, GroupName ItemKind)]
tools0
(bagsToLose :: EnumMap CStore (EnumMap ItemId ItemQuant)
bagsToLose, iidsToApply :: [(CStore, (ItemId, ItemFull))]
iidsToApply, grps :: [(Bool, Int, GroupName ItemKind)]
grps) =
((EnumMap CStore (EnumMap ItemId ItemQuant),
[(CStore, (ItemId, ItemFull))], [(Bool, Int, GroupName ItemKind)])
-> ((CStore, Bool), (ItemId, ItemFullKit))
-> (EnumMap CStore (EnumMap ItemId ItemQuant),
[(CStore, (ItemId, ItemFull))], [(Bool, Int, GroupName ItemKind)]))
-> (EnumMap CStore (EnumMap ItemId ItemQuant),
[(CStore, (ItemId, ItemFull))], [(Bool, Int, GroupName ItemKind)])
-> [((CStore, Bool), (ItemId, ItemFullKit))]
-> (EnumMap CStore (EnumMap ItemId ItemQuant),
[(CStore, (ItemId, ItemFull))], [(Bool, Int, GroupName ItemKind)])
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (EnumMap CStore (EnumMap ItemId ItemQuant),
[(CStore, (ItemId, ItemFull))], [(Bool, Int, GroupName ItemKind)])
-> ((CStore, Bool), (ItemId, ItemFullKit))
-> (EnumMap CStore (EnumMap ItemId ItemQuant),
[(CStore, (ItemId, ItemFull))], [(Bool, Int, GroupName ItemKind)])
subtractIidfromGrps (EnumMap CStore (EnumMap ItemId ItemQuant)
forall k a. EnumMap k a
EM.empty, [], [(Bool, Int, GroupName ItemKind)]
grps0) [((CStore, Bool), (ItemId, ItemFullKit))]
kitAss
if [(Bool, Int, GroupName ItemKind)] -> Bool
forall a. [a] -> Bool
null [(Bool, Int, GroupName ItemKind)]
grps then do
m ()
announceTileChange
ActorId
-> EnumMap CStore (EnumMap ItemId ItemQuant)
-> [(CStore, (ItemId, ItemFull))]
-> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId
-> EnumMap CStore (EnumMap ItemId ItemQuant)
-> [(CStore, (ItemId, ItemFull))]
-> m ()
consumeItems ActorId
source EnumMap CStore (EnumMap ItemId ItemQuant)
bagsToLose [(CStore, (ItemId, ItemFull))]
iidsToApply
GroupName TileKind -> m ()
changeTo GroupName TileKind
tgroup
Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
else Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
feats :: [Feature]
feats = TileKind -> [Feature]
TK.tfeature (TileKind -> [Feature]) -> TileKind -> [Feature]
forall a b. (a -> b) -> a -> b
$ ContentData TileKind -> ContentId TileKind -> TileKind
forall a. ContentData a -> ContentId a -> a
okind ContentData TileKind
cotile ContentId TileKind
serverTile
tileActions :: [TileAction]
tileActions =
(Feature -> Maybe TileAction) -> [Feature] -> [TileAction]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Bool
-> Bool
-> [(ItemKind, (ItemId, ItemQuant))]
-> Feature
-> Maybe TileAction
Tile.parseTileAction
(Actor -> Bool
bproj Actor
sb)
(Bool
underFeet Bool -> Bool -> Bool
|| Bool
blockedByItem)
[(ItemKind, (ItemId, ItemQuant))]
embedKindList)
[Feature]
feats
groupWithFromAction :: TileAction -> Maybe [(Int, GroupName ItemKind)]
groupWithFromAction action :: TileAction
action = case TileAction
action of
Tile.WithAction grps :: [(Int, GroupName ItemKind)]
grps _ | Bool -> Bool
not Bool
bumping -> [(Int, GroupName ItemKind)] -> Maybe [(Int, GroupName ItemKind)]
forall a. a -> Maybe a
Just [(Int, GroupName ItemKind)]
grps
_ -> Maybe [(Int, GroupName ItemKind)]
forall a. Maybe a
Nothing
groupsToAlterWith :: [[(Int, GroupName ItemKind)]]
groupsToAlterWith = (TileAction -> Maybe [(Int, GroupName ItemKind)])
-> [TileAction] -> [[(Int, GroupName ItemKind)]]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe TileAction -> Maybe [(Int, GroupName ItemKind)]
groupWithFromAction [TileAction]
tileActions
processTileActions :: Maybe UseResult -> [Tile.TileAction] -> m Bool
processTileActions :: Maybe UseResult -> [TileAction] -> m Bool
processTileActions museResult :: Maybe UseResult
museResult [] =
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
$! Bool -> (UseResult -> Bool) -> Maybe UseResult -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (UseResult -> UseResult -> Bool
forall a. Eq a => a -> a -> Bool
/= UseResult
UseDud) Maybe UseResult
museResult
processTileActions museResult :: Maybe UseResult
museResult (ta :: TileAction
ta : rest :: [TileAction]
rest) = case TileAction
ta of
Tile.EmbedAction (iid :: ItemId
iid, kit :: ItemQuant
kit) ->
if | Actor -> Bool
bproj Actor
sb Bool -> Bool -> Bool
&& Int
tileMinSkill Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 ->
Maybe UseResult -> [TileAction] -> m Bool
processTileActions Maybe UseResult
museResult [TileAction]
rest
| Bool
projNoDamage ->
Maybe UseResult -> [TileAction] -> m Bool
processTileActions (UseResult -> Maybe UseResult
forall a. a -> Maybe a
Just UseResult
UseDud) [TileAction]
rest
| Bool
otherwise -> do
UseResult
triggered <- (ItemId, ItemQuant) -> m UseResult
tryApplyEmbed (ItemId
iid, ItemQuant
kit)
let useResult :: UseResult
useResult = UseResult -> Maybe UseResult -> UseResult
forall a. a -> Maybe a -> a
fromMaybe UseResult
UseDud Maybe UseResult
museResult
Maybe UseResult -> [TileAction] -> m Bool
processTileActions (UseResult -> Maybe UseResult
forall a. a -> Maybe a
Just (UseResult -> Maybe UseResult) -> UseResult -> Maybe UseResult
forall a b. (a -> b) -> a -> b
$ UseResult -> UseResult -> UseResult
forall a. Ord a => a -> a -> a
max UseResult
useResult UseResult
triggered) [TileAction]
rest
Tile.ToAction tgroup :: GroupName TileKind
tgroup -> Bool -> m Bool -> m Bool
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Bool -> Bool
not (Actor -> Bool
bproj Actor
sb)) (m Bool -> m Bool) -> m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$
if Bool -> (UseResult -> Bool) -> Maybe UseResult -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (UseResult -> UseResult -> Bool
forall a. Eq a => a -> a -> Bool
== UseResult
UseUp) Maybe UseResult
museResult
then do
m ()
announceTileChange
GroupName TileKind -> m ()
changeTo GroupName TileKind
tgroup
Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
else Maybe UseResult -> [TileAction] -> m Bool
processTileActions Maybe UseResult
museResult [TileAction]
rest
Tile.WithAction grps :: [(Int, GroupName ItemKind)]
grps tgroup :: GroupName TileKind
tgroup -> do
EnumMap ItemId ItemQuant
groundBag2 <- (State -> EnumMap ItemId ItemQuant) -> m (EnumMap ItemId ItemQuant)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> EnumMap ItemId ItemQuant)
-> m (EnumMap ItemId ItemQuant))
-> (State -> EnumMap ItemId ItemQuant)
-> m (EnumMap ItemId ItemQuant)
forall a b. (a -> b) -> a -> b
$ Actor -> CStore -> State -> EnumMap ItemId ItemQuant
getBodyStoreBag Actor
sb CStore
CGround
EnumMap ItemId ItemQuant
eqpBag2 <- (State -> EnumMap ItemId ItemQuant) -> m (EnumMap ItemId ItemQuant)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> EnumMap ItemId ItemQuant)
-> m (EnumMap ItemId ItemQuant))
-> (State -> EnumMap ItemId ItemQuant)
-> m (EnumMap ItemId ItemQuant)
forall a b. (a -> b) -> a -> b
$ Actor -> CStore -> State -> EnumMap ItemId ItemQuant
getBodyStoreBag Actor
sb CStore
CEqp
if (Bool -> Bool
not Bool
bumping Bool -> Bool -> Bool
|| [(Int, GroupName ItemKind)] -> Bool
forall a. [a] -> Bool
null [(Int, GroupName ItemKind)]
grps)
Bool -> Bool -> Bool
&& (Actor -> Bool
bproj Actor
sb Bool -> Bool -> Bool
|| Bool
voluntary Bool -> Bool -> Bool
|| [(Int, GroupName ItemKind)] -> Bool
forall a. [a] -> Bool
null [(Int, GroupName ItemKind)]
grps)
Bool -> Bool -> Bool
&& (Bool -> (UseResult -> Bool) -> Maybe UseResult -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (UseResult -> UseResult -> Bool
forall a. Eq a => a -> a -> Bool
== UseResult
UseUp) Maybe UseResult
museResult
Bool -> Bool -> Bool
|| EffToUse
effToUse EffToUse -> EffToUse -> Bool
forall a. Eq a => a -> a -> Bool
== EffToUse
EffOnCombine)
Bool -> Bool -> Bool
&& let f :: (a, b) -> (a, b) -> Bool
f (k1 :: a
k1, _) (k2 :: a
k2, _) = a
k1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
k2
in (ItemQuant -> ItemQuant -> Bool)
-> EnumMap ItemId ItemQuant -> EnumMap ItemId ItemQuant -> Bool
forall a b k.
(a -> b -> Bool) -> EnumMap k a -> EnumMap k b -> Bool
EM.isSubmapOfBy ItemQuant -> ItemQuant -> Bool
forall a b b. Ord a => (a, b) -> (a, b) -> Bool
f EnumMap ItemId ItemQuant
groundBag EnumMap ItemId ItemQuant
groundBag2
Bool -> Bool -> Bool
&& (ItemQuant -> ItemQuant -> Bool)
-> EnumMap ItemId ItemQuant -> EnumMap ItemId ItemQuant -> Bool
forall a b k.
(a -> b -> Bool) -> EnumMap k a -> EnumMap k b -> Bool
EM.isSubmapOfBy ItemQuant -> ItemQuant -> Bool
forall a b b. Ord a => (a, b) -> (a, b) -> Bool
f EnumMap ItemId ItemQuant
eqpBag EnumMap ItemId ItemQuant
eqpBag2
then do
Bool
altered <- ([(Int, GroupName ItemKind)], GroupName TileKind) -> m Bool
tryChangeWith ([(Int, GroupName ItemKind)]
grps, GroupName TileKind
tgroup)
if Bool
altered
then Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
else Maybe UseResult -> [TileAction] -> m Bool
processTileActions Maybe UseResult
museResult [TileAction]
rest
else Maybe UseResult -> [TileAction] -> m Bool
processTileActions Maybe UseResult
museResult [TileAction]
rest
if [TileAction] -> Bool
forall a. [a] -> Bool
null [TileAction]
tileActions then
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
$! if Bool
blockedByItem
Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
underFeet
Bool -> Bool -> Bool
&& TileSpeedup -> ContentId TileKind -> Bool
Tile.isModifiable TileSpeedup
coTileSpeedup ContentId TileKind
serverTile
then ReqFailure -> Maybe ReqFailure
forall a. a -> Maybe a
Just ReqFailure
AlterBlockItem
else ReqFailure -> Maybe ReqFailure
forall a. a -> Maybe a
Just ReqFailure
AlterNothing
else
if Bool
underFeet Bool -> Bool -> Bool
|| Bool -> Bool
not (Point -> Level -> Bool
occupiedBigLvl Point
tpos Level
lvl)
Bool -> Bool -> Bool
&& Bool -> Bool
not (Point -> Level -> Bool
occupiedProjLvl Point
tpos Level
lvl) then do
m ()
revealEmbeds
Bool
tileTriggered <- Maybe UseResult -> [TileAction] -> m Bool
processTileActions Maybe UseResult
forall a. Maybe a
Nothing [TileAction]
tileActions
let potentiallyMissing :: [[(Int, GroupName ItemKind)]]
potentiallyMissing = ([(Int, GroupName ItemKind)] -> Bool)
-> [[(Int, GroupName ItemKind)]] -> [[(Int, GroupName ItemKind)]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ([(Int, GroupName ItemKind)] -> Bool)
-> [(Int, GroupName ItemKind)]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Int, GroupName ItemKind)] -> Bool
forall a. [a] -> Bool
null) [[(Int, GroupName ItemKind)]]
groupsToAlterWith
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
tileTriggered Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
underFeet Bool -> Bool -> Bool
&& Bool
voluntary
Bool -> Bool -> Bool
&& Bool -> Bool
not ([[(Int, GroupName ItemKind)]] -> Bool
forall a. [a] -> Bool
null [[(Int, GroupName ItemKind)]]
potentiallyMissing)) (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
$ FactionId -> SfxMsg -> SfxAtomic
SfxMsgFid (Actor -> FactionId
bfid Actor
sb)
(SfxMsg -> SfxAtomic) -> SfxMsg -> SfxAtomic
forall a b. (a -> b) -> a -> b
$ [[(Int, GroupName ItemKind)]] -> SfxMsg
SfxNoItemsForTile [[(Int, GroupName ItemKind)]]
potentiallyMissing
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
AlterBlockActor
reqWait :: MonadServerAtomic m => ActorId -> m ()
{-# INLINE reqWait #-}
reqWait :: ActorId -> m ()
reqWait source :: ActorId
source = do
Skills
actorSk <- ActorId -> m Skills
forall (m :: * -> *). MonadServer m => ActorId -> m Skills
currentSkillsServer ActorId
source
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkWait Skills
actorSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
ActorId -> RequestTimed -> ReqFailure -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId -> RequestTimed -> ReqFailure -> m ()
execFailure ActorId
source RequestTimed
ReqWait ReqFailure
WaitUnskilled
reqWait10 :: MonadServerAtomic m => ActorId -> m ()
{-# INLINE reqWait10 #-}
reqWait10 :: ActorId -> m ()
reqWait10 source :: ActorId
source = do
Skills
actorSk <- ActorId -> m Skills
forall (m :: * -> *). MonadServer m => ActorId -> m Skills
currentSkillsServer ActorId
source
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkWait Skills
actorSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 4) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
ActorId -> RequestTimed -> ReqFailure -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId -> RequestTimed -> ReqFailure -> m ()
execFailure ActorId
source RequestTimed
ReqWait10 ReqFailure
WaitUnskilled
reqYell :: MonadServerAtomic m => ActorId -> m ()
reqYell :: ActorId -> m ()
reqYell aid :: ActorId
aid = do
Skills
actorSk <- ActorId -> m Skills
forall (m :: * -> *). MonadServer m => ActorId -> m Skills
currentSkillsServer ActorId
aid
if | Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkWait Skills
actorSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 ->
SfxAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => SfxAtomic -> m ()
execSfxAtomic (SfxAtomic -> m ()) -> SfxAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ Bool -> ActorId -> SfxAtomic
SfxTaunt Bool
True ActorId
aid
| Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkMove Skills
actorSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0
Bool -> Bool -> Bool
|| Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkDisplace Skills
actorSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0
Bool -> Bool -> Bool
|| Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkMelee Skills
actorSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 ->
SfxAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => SfxAtomic -> m ()
execSfxAtomic (SfxAtomic -> m ()) -> SfxAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ Bool -> ActorId -> SfxAtomic
SfxTaunt Bool
False ActorId
aid
| Bool
otherwise -> 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
case Actor -> Watchfulness
bwatch Actor
b of
WWait _ -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
_ -> 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) (Int -> Watchfulness
WWait 0)
reqMoveItems :: MonadServerAtomic m
=> ActorId -> [(ItemId, Int, CStore, CStore)] -> m ()
reqMoveItems :: ActorId -> [(ItemId, Int, CStore, CStore)] -> m ()
reqMoveItems source :: ActorId
source l :: [(ItemId, Int, CStore, CStore)]
l = do
Skills
actorSk <- ActorId -> m Skills
forall (m :: * -> *). MonadServer m => ActorId -> m Skills
currentSkillsServer ActorId
source
if Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkMoveItem Skills
actorSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 then 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
source
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
source
let calmE :: Bool
calmE = Actor -> Skills -> Bool
calmEnough Actor
b Skills
actorMaxSk
case [(ItemId, Int, CStore, CStore)]
l of
[] -> ActorId -> RequestTimed -> ReqFailure -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId -> RequestTimed -> ReqFailure -> m ()
execFailure ActorId
source ([(ItemId, Int, CStore, CStore)] -> RequestTimed
ReqMoveItems [(ItemId, Int, CStore, CStore)]
l) ReqFailure
ItemNothing
iid :: (ItemId, Int, CStore, CStore)
iid : rest :: [(ItemId, Int, CStore, CStore)]
rest -> do
Bool -> ActorId -> Bool -> (ItemId, Int, CStore, CStore) -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
Bool -> ActorId -> Bool -> (ItemId, Int, CStore, CStore) -> m ()
reqMoveItem Bool
False ActorId
source Bool
calmE (ItemId, Int, CStore, CStore)
iid
((ItemId, Int, CStore, CStore) -> m ())
-> [(ItemId, Int, CStore, CStore)] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
mapM_ (Bool -> ActorId -> Bool -> (ItemId, Int, CStore, CStore) -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
Bool -> ActorId -> Bool -> (ItemId, Int, CStore, CStore) -> m ()
reqMoveItem Bool
True ActorId
source Bool
calmE) [(ItemId, Int, CStore, CStore)]
rest
else ActorId -> RequestTimed -> ReqFailure -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId -> RequestTimed -> ReqFailure -> m ()
execFailure ActorId
source ([(ItemId, Int, CStore, CStore)] -> RequestTimed
ReqMoveItems [(ItemId, Int, CStore, CStore)]
l) ReqFailure
MoveItemUnskilled
reqMoveItem :: MonadServerAtomic m
=> Bool -> ActorId -> Bool -> (ItemId, Int, CStore, CStore) -> m ()
reqMoveItem :: Bool -> ActorId -> Bool -> (ItemId, Int, CStore, CStore) -> m ()
reqMoveItem absentPermitted :: Bool
absentPermitted aid :: ActorId
aid calmE :: Bool
calmE (iid :: ItemId
iid, kOld :: Int
kOld, fromCStore :: CStore
fromCStore, toCStore :: CStore
toCStore) = 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 fromC :: Container
fromC = ActorId -> CStore -> Container
CActor ActorId
aid CStore
fromCStore
req :: RequestTimed
req = [(ItemId, Int, CStore, CStore)] -> RequestTimed
ReqMoveItems [(ItemId
iid, Int
kOld, CStore
fromCStore, CStore
toCStore)]
Container
toC <- case CStore
toCStore of
CGround -> Bool -> ActorId -> Actor -> m Container
forall (m :: * -> *).
MonadStateRead m =>
Bool -> ActorId -> Actor -> m Container
pickDroppable Bool
False ActorId
aid Actor
b
_ -> Container -> m Container
forall (m :: * -> *) a. Monad m => a -> m a
return (Container -> m Container) -> Container -> m Container
forall a b. (a -> b) -> a -> b
$! ActorId -> CStore -> Container
CActor ActorId
aid CStore
toCStore
EnumMap ItemId ItemQuant
bagFrom <- (State -> EnumMap ItemId ItemQuant) -> m (EnumMap ItemId ItemQuant)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> EnumMap ItemId ItemQuant)
-> m (EnumMap ItemId ItemQuant))
-> (State -> EnumMap ItemId ItemQuant)
-> m (EnumMap ItemId ItemQuant)
forall a b. (a -> b) -> a -> b
$ Container -> State -> EnumMap ItemId ItemQuant
getContainerBag (ActorId -> CStore -> Container
CActor ActorId
aid CStore
fromCStore)
EnumMap ItemId ItemQuant
bagBefore <- (State -> EnumMap ItemId ItemQuant) -> m (EnumMap ItemId ItemQuant)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> EnumMap ItemId ItemQuant)
-> m (EnumMap ItemId ItemQuant))
-> (State -> EnumMap ItemId ItemQuant)
-> m (EnumMap ItemId ItemQuant)
forall a b. (a -> b) -> a -> b
$ Container -> State -> EnumMap ItemId ItemQuant
getContainerBag Container
toC
let k :: Int
k = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
kOld (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ ItemQuant -> Int
forall a b. (a, b) -> a
fst (ItemQuant -> Int) -> ItemQuant -> Int
forall a b. (a -> b) -> a -> b
$ ItemQuant -> ItemId -> EnumMap ItemId ItemQuant -> ItemQuant
forall k a. Enum k => a -> k -> EnumMap k a -> a
EM.findWithDefault (0, []) ItemId
iid EnumMap ItemId ItemQuant
bagFrom
let !_A :: Bool
_A = if Bool
absentPermitted then Bool
True else Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
kOld
if
| Bool
absentPermitted Bool -> Bool -> Bool
&& Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 1 Bool -> Bool -> Bool
|| CStore
fromCStore CStore -> CStore -> Bool
forall a. Eq a => a -> a -> Bool
== CStore
toCStore -> ActorId -> RequestTimed -> ReqFailure -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId -> RequestTimed -> ReqFailure -> m ()
execFailure ActorId
aid RequestTimed
req ReqFailure
ItemNothing
| CStore
fromCStore CStore -> CStore -> Bool
forall a. Eq a => a -> a -> Bool
== CStore
CEqp Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
calmE ->
ActorId -> RequestTimed -> ReqFailure -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId -> RequestTimed -> ReqFailure -> m ()
execFailure ActorId
aid RequestTimed
req ReqFailure
ItemNotCalm
| CStore
toCStore CStore -> CStore -> Bool
forall a. Eq a => a -> a -> Bool
== CStore
CEqp Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
calmE ->
ActorId -> RequestTimed -> ReqFailure -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId -> RequestTimed -> ReqFailure -> m ()
execFailure ActorId
aid RequestTimed
req ReqFailure
ItemNotCalm
| CStore
toCStore CStore -> CStore -> Bool
forall a. Eq a => a -> a -> Bool
== CStore
CEqp Bool -> Bool -> Bool
&& Actor -> Int -> Bool
eqpOverfull Actor
b Int
k ->
ActorId -> RequestTimed -> ReqFailure -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId -> RequestTimed -> ReqFailure -> m ()
execFailure ActorId
aid RequestTimed
req ReqFailure
EqpOverfull
| Bool
otherwise -> do
[UpdAtomic]
upds <- Bool -> ItemId -> Int -> Container -> Container -> m [UpdAtomic]
forall (m :: * -> *).
MonadStateRead m =>
Bool -> ItemId -> Int -> Container -> Container -> m [UpdAtomic]
generalMoveItem Bool
True ItemId
iid Int
k Container
fromC Container
toC
(UpdAtomic -> m ()) -> [UpdAtomic] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
mapM_ UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic [UpdAtomic]
upds
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
Container -> ItemId -> ContentId ItemKind -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
Container -> ItemId -> ContentId ItemKind -> m ()
discoverIfMinorEffects Container
toC ItemId
iid (ItemFull -> ContentId ItemKind
itemKindId ItemFull
itemFull)
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CStore
toCStore CStore -> [CStore] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CStore
CEqp, CStore
COrgan]
Bool -> Bool -> Bool
&& CStore
fromCStore CStore -> [CStore] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [CStore
CEqp, CStore
COrgan]
Bool -> Bool -> Bool
|| CStore
fromCStore CStore -> CStore -> Bool
forall a. Eq a => a -> a -> Bool
== CStore
CStash) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
let beforeIt :: [ItemTimer]
beforeIt = case ItemId
iid ItemId -> EnumMap ItemId ItemQuant -> Maybe ItemQuant
forall k a. Enum k => k -> EnumMap k a -> Maybe a
`EM.lookup` EnumMap ItemId ItemQuant
bagBefore of
Nothing -> []
Just (_, it2 :: [ItemTimer]
it2) -> [ItemTimer]
it2
Int -> ItemId -> ItemFull -> [ItemTimer] -> Container -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
Int -> ItemId -> ItemFull -> [ItemTimer] -> Container -> m ()
randomResetTimeout Int
k ItemId
iid ItemFull
itemFull [ItemTimer]
beforeIt Container
toC
reqProject :: MonadServerAtomic m
=> ActorId
-> Point
-> Int
-> ItemId
-> CStore
-> m ()
reqProject :: ActorId -> Point -> Int -> ItemId -> CStore -> m ()
reqProject source :: ActorId
source tpxy :: Point
tpxy eps :: Int
eps iid :: ItemId
iid cstore :: CStore
cstore = do
let req :: RequestTimed
req = Point -> Int -> ItemId -> CStore -> RequestTimed
ReqProject Point
tpxy Int
eps ItemId
iid CStore
cstore
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
source
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
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
$ (FactionDict -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
b) (FactionDict -> Faction)
-> (State -> FactionDict) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> FactionDict
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
source
let calmE :: Bool
calmE = Actor -> Skills -> Bool
calmEnough Actor
b Skills
actorMaxSk
if | Challenge -> Bool
ckeeper Challenge
curChalSer Bool -> Bool -> Bool
&& Player -> Bool
fhasUI (Faction -> Player
gplayer Faction
fact) ->
ActorId -> RequestTimed -> ReqFailure -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId -> RequestTimed -> ReqFailure -> m ()
execFailure ActorId
source RequestTimed
req ReqFailure
ProjectFinderKeeper
| CStore
cstore CStore -> CStore -> Bool
forall a. Eq a => a -> a -> Bool
== CStore
CEqp Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
calmE -> ActorId -> RequestTimed -> ReqFailure -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId -> RequestTimed -> ReqFailure -> m ()
execFailure ActorId
source RequestTimed
req ReqFailure
ItemNotCalm
| Bool
otherwise -> do
Maybe ReqFailure
mfail <-
ActorId
-> ActorId
-> Point
-> Point
-> Int
-> Bool
-> ItemId
-> CStore
-> Bool
-> m (Maybe ReqFailure)
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId
-> ActorId
-> Point
-> Point
-> Int
-> Bool
-> ItemId
-> CStore
-> Bool
-> m (Maybe ReqFailure)
projectFail ActorId
source ActorId
source (Actor -> Point
bpos Actor
b) Point
tpxy Int
eps Bool
False ItemId
iid CStore
cstore Bool
False
m () -> (ReqFailure -> m ()) -> Maybe ReqFailure -> m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (ActorId -> RequestTimed -> ReqFailure -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId -> RequestTimed -> ReqFailure -> m ()
execFailure ActorId
source RequestTimed
req) Maybe ReqFailure
mfail
reqApply :: MonadServerAtomic m
=> ActorId
-> ItemId
-> CStore
-> m ()
reqApply :: ActorId -> ItemId -> CStore -> m ()
reqApply aid :: ActorId
aid iid :: ItemId
iid cstore :: CStore
cstore = do
let req :: RequestTimed
req = ItemId -> CStore -> RequestTimed
ReqApply ItemId
iid CStore
cstore
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
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
let calmE :: Bool
calmE = Actor -> Skills -> Bool
calmEnough Actor
b Skills
actorMaxSk
if CStore
cstore CStore -> CStore -> Bool
forall a. Eq a => a -> a -> Bool
== CStore
CEqp Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
calmE then ActorId -> RequestTimed -> ReqFailure -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId -> RequestTimed -> ReqFailure -> m ()
execFailure ActorId
aid RequestTimed
req ReqFailure
ItemNotCalm
else do
EnumMap ItemId ItemQuant
bag <- (State -> EnumMap ItemId ItemQuant) -> m (EnumMap ItemId ItemQuant)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> EnumMap ItemId ItemQuant)
-> m (EnumMap ItemId ItemQuant))
-> (State -> EnumMap ItemId ItemQuant)
-> m (EnumMap ItemId ItemQuant)
forall a b. (a -> b) -> a -> b
$ Actor -> CStore -> State -> EnumMap ItemId ItemQuant
getBodyStoreBag Actor
b CStore
cstore
case ItemId -> EnumMap ItemId ItemQuant -> Maybe ItemQuant
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup ItemId
iid EnumMap ItemId ItemQuant
bag of
Nothing -> ActorId -> RequestTimed -> ReqFailure -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId -> RequestTimed -> ReqFailure -> m ()
execFailure ActorId
aid RequestTimed
req ReqFailure
ApplyOutOfReach
Just kit :: 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
aid
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 (Actor -> LevelId
blid Actor
b)
let skill :: Int
skill = Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkApply Skills
actorSk
legal :: Either ReqFailure Bool
legal = Time
-> Int
-> Bool
-> Maybe CStore
-> ItemFull
-> ItemQuant
-> Either ReqFailure Bool
permittedApply Time
localTime Int
skill Bool
calmE (CStore -> Maybe CStore
forall a. a -> Maybe a
Just CStore
cstore)
ItemFull
itemFull ItemQuant
kit
case Either ReqFailure Bool
legal of
Left reqFail :: ReqFailure
reqFail -> ActorId -> RequestTimed -> ReqFailure -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId -> RequestTimed -> ReqFailure -> m ()
execFailure ActorId
aid RequestTimed
req ReqFailure
reqFail
Right _ -> ActorId -> ItemId -> CStore -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId -> ItemId -> CStore -> m ()
applyItem ActorId
aid ItemId
iid CStore
cstore
reqGameRestart :: MonadServerAtomic m
=> ActorId -> GroupName ModeKind -> Challenge
-> m ()
reqGameRestart :: ActorId -> GroupName ModeKind -> Challenge -> m ()
reqGameRestart aid :: ActorId
aid groupName :: GroupName ModeKind
groupName scurChalSer :: Challenge
scurChalSer = do
Bool
noConfirmsGame <- m Bool
forall (m :: * -> *). MonadStateRead m => m Bool
isNoConfirmsGame
FactionDict
factionD <- (State -> FactionDict) -> m FactionDict
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> FactionDict
sfactionD
let fidsUI :: [FactionId]
fidsUI = ((FactionId, Faction) -> FactionId)
-> [(FactionId, Faction)] -> [FactionId]
forall a b. (a -> b) -> [a] -> [b]
map (FactionId, Faction) -> FactionId
forall a b. (a, b) -> a
fst ([(FactionId, Faction)] -> [FactionId])
-> [(FactionId, Faction)] -> [FactionId]
forall a b. (a -> b) -> a -> b
$ ((FactionId, Faction) -> Bool)
-> [(FactionId, Faction)] -> [(FactionId, Faction)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(_, fact :: Faction
fact) -> Player -> Bool
fhasUI (Faction -> Player
gplayer Faction
fact))
(FactionDict -> [(FactionId, Faction)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs FactionDict
factionD)
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
noConfirmsGame (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ (FactionId -> m ()) -> [FactionId] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
mapM_ FactionId -> m ()
forall (m :: * -> *). MonadServerAtomic m => FactionId -> m ()
revealItems [FactionId]
fidsUI
Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
Maybe Status
oldSt <- (State -> Maybe Status) -> m (Maybe Status)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Maybe Status) -> m (Maybe Status))
-> (State -> Maybe Status) -> m (Maybe Status)
forall a b. (a -> b) -> a -> b
$ Faction -> Maybe Status
gquit (Faction -> Maybe Status)
-> (State -> Faction) -> State -> Maybe Status
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FactionDict -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
b) (FactionDict -> Faction)
-> (State -> FactionDict) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> FactionDict
sfactionD
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
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
(Actor -> FactionId
bfid Actor
b)
Maybe Status
oldSt
(Status -> Maybe Status
forall a. a -> Maybe a
Just (Status -> Maybe Status) -> Status -> Maybe Status
forall a b. (a -> b) -> a -> b
$ Outcome -> Int -> Maybe (GroupName ModeKind) -> Status
Status Outcome
Restart (LevelId -> Int
forall a. Enum a => a -> Int
fromEnum (LevelId -> Int) -> LevelId -> Int
forall a b. (a -> b) -> a -> b
$ Actor -> LevelId
blid Actor
b) (GroupName ModeKind -> Maybe (GroupName ModeKind)
forall a. a -> Maybe a
Just GroupName ModeKind
groupName))
((FactionAnalytics, GenerationAnalytics)
-> Maybe (FactionAnalytics, GenerationAnalytics)
forall a. a -> Maybe a
Just (FactionAnalytics
factionAn, 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
$ \ser :: StateServer
ser -> StateServer
ser { sbreakASAP :: Bool
sbreakASAP = Bool
True
, soptionsNxt :: ServerOptions
soptionsNxt = (StateServer -> ServerOptions
soptionsNxt StateServer
ser) {Challenge
scurChalSer :: Challenge
scurChalSer :: Challenge
scurChalSer} }
reqGameDropAndExit :: MonadServerAtomic m => ActorId -> m ()
reqGameDropAndExit :: ActorId -> m ()
reqGameDropAndExit aid :: ActorId
aid = do
m ()
forall (m :: * -> *). MonadServer m => m ()
verifyAssertExplored
Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
Maybe Status
oldSt <- (State -> Maybe Status) -> m (Maybe Status)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Maybe Status) -> m (Maybe Status))
-> (State -> Maybe Status) -> m (Maybe Status)
forall a b. (a -> b) -> a -> b
$ Faction -> Maybe Status
gquit (Faction -> Maybe Status)
-> (State -> Faction) -> State -> Maybe Status
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FactionDict -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
b) (FactionDict -> Faction)
-> (State -> FactionDict) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> FactionDict
sfactionD
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
(Actor -> FactionId
bfid Actor
b)
Maybe Status
oldSt
(Status -> Maybe Status
forall a. a -> Maybe a
Just (Status -> Maybe Status) -> Status -> Maybe Status
forall a b. (a -> b) -> a -> b
$ Outcome -> Int -> Maybe (GroupName ModeKind) -> Status
Status Outcome
Camping (LevelId -> Int
forall a. Enum a => a -> Int
fromEnum (LevelId -> Int) -> LevelId -> Int
forall a b. (a -> b) -> a -> b
$ Actor -> LevelId
blid Actor
b) Maybe (GroupName ModeKind)
forall a. Maybe a
Nothing)
Maybe (FactionAnalytics, GenerationAnalytics)
forall a. Maybe a
Nothing
(StateServer -> StateServer) -> m ()
forall (m :: * -> *).
MonadServer m =>
(StateServer -> StateServer) -> m ()
modifyServer ((StateServer -> StateServer) -> m ())
-> (StateServer -> StateServer) -> m ()
forall a b. (a -> b) -> a -> b
$ \ser :: StateServer
ser -> StateServer
ser { sbreakASAP :: Bool
sbreakASAP = Bool
True
, sbreakLoop :: Bool
sbreakLoop = Bool
True }
verifyAssertExplored :: MonadServer m => m ()
verifyAssertExplored :: m ()
verifyAssertExplored = do
Maybe Int
assertExplored <- (StateServer -> Maybe Int) -> m (Maybe Int)
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer ((StateServer -> Maybe Int) -> m (Maybe Int))
-> (StateServer -> Maybe Int) -> m (Maybe Int)
forall a b. (a -> b) -> a -> b
$ ServerOptions -> Maybe Int
sassertExplored (ServerOptions -> Maybe Int)
-> (StateServer -> ServerOptions) -> StateServer -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateServer -> ServerOptions
soptions
case Maybe Int
assertExplored of
Nothing -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just lvlN :: Int
lvlN -> do
EnumMap LevelId Int
snumSpawned <- (StateServer -> EnumMap LevelId Int) -> m (EnumMap LevelId Int)
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> EnumMap LevelId Int
snumSpawned
let !_A :: ()
_A = Bool -> () -> ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int -> LevelId
forall a. Enum a => Int -> a
toEnum Int
lvlN LevelId -> EnumMap LevelId Int -> Bool
forall k a. Enum k => k -> EnumMap k a -> Bool
`EM.member` EnumMap LevelId Int
snumSpawned
Bool -> Bool -> Bool
|| Int -> LevelId
forall a. Enum a => Int -> a
toEnum (- Int
lvlN) LevelId -> EnumMap LevelId Int -> Bool
forall k a. Enum k => k -> EnumMap k a -> Bool
`EM.member` EnumMap LevelId Int
snumSpawned
Bool -> (String, Int) -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` "by game end, exploration haven't reached the expected level depth, indicating stuck AI (or just very busy initial levels)"
String -> Int -> (String, Int)
forall v. String -> v -> (String, v)
`swith` Int
lvlN) ()
() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
reqGameSaveAndExit :: MonadServerAtomic m => ActorId -> m ()
reqGameSaveAndExit :: ActorId -> m ()
reqGameSaveAndExit aid :: ActorId
aid = do
m ()
forall (m :: * -> *). MonadServer m => m ()
verifyAssertExplored
Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
Maybe Status
oldSt <- (State -> Maybe Status) -> m (Maybe Status)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Maybe Status) -> m (Maybe Status))
-> (State -> Maybe Status) -> m (Maybe Status)
forall a b. (a -> b) -> a -> b
$ Faction -> Maybe Status
gquit (Faction -> Maybe Status)
-> (State -> Faction) -> State -> Maybe Status
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FactionDict -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
b) (FactionDict -> Faction)
-> (State -> FactionDict) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> FactionDict
sfactionD
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
(Actor -> FactionId
bfid Actor
b)
Maybe Status
oldSt
(Status -> Maybe Status
forall a. a -> Maybe a
Just (Status -> Maybe Status) -> Status -> Maybe Status
forall a b. (a -> b) -> a -> b
$ Outcome -> Int -> Maybe (GroupName ModeKind) -> Status
Status Outcome
Camping (LevelId -> Int
forall a. Enum a => a -> Int
fromEnum (LevelId -> Int) -> LevelId -> Int
forall a b. (a -> b) -> a -> b
$ Actor -> LevelId
blid Actor
b) Maybe (GroupName ModeKind)
forall a. Maybe a
Nothing)
Maybe (FactionAnalytics, GenerationAnalytics)
forall a. Maybe a
Nothing
(StateServer -> StateServer) -> m ()
forall (m :: * -> *).
MonadServer m =>
(StateServer -> StateServer) -> m ()
modifyServer ((StateServer -> StateServer) -> m ())
-> (StateServer -> StateServer) -> m ()
forall a b. (a -> b) -> a -> b
$ \ser :: StateServer
ser -> StateServer
ser { sbreakASAP :: Bool
sbreakASAP = Bool
True
, swriteSave :: Bool
swriteSave = Bool
True }
reqGameSave :: MonadServer m => m ()
reqGameSave :: m ()
reqGameSave =
(StateServer -> StateServer) -> m ()
forall (m :: * -> *).
MonadServer m =>
(StateServer -> StateServer) -> m ()
modifyServer ((StateServer -> StateServer) -> m ())
-> (StateServer -> StateServer) -> m ()
forall a b. (a -> b) -> a -> b
$ \ser :: StateServer
ser -> StateServer
ser { sbreakASAP :: Bool
sbreakASAP = Bool
True
, swriteSave :: Bool
swriteSave = Bool
True }
reqDoctrine :: MonadServerAtomic m => FactionId -> Ability.Doctrine -> m ()
reqDoctrine :: FactionId -> Doctrine -> m ()
reqDoctrine fid :: FactionId
fid toT :: Doctrine
toT = do
Doctrine
fromT <- (State -> Doctrine) -> m Doctrine
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Doctrine) -> m Doctrine)
-> (State -> Doctrine) -> m Doctrine
forall a b. (a -> b) -> a -> b
$ Player -> Doctrine
fdoctrine (Player -> Doctrine) -> (State -> Player) -> State -> Doctrine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Faction -> Player
gplayer (Faction -> Player) -> (State -> Faction) -> State -> Player
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FactionDict -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
fid) (FactionDict -> Faction)
-> (State -> FactionDict) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> FactionDict
sfactionD
UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ FactionId -> Doctrine -> Doctrine -> UpdAtomic
UpdDoctrineFaction FactionId
fid Doctrine
toT Doctrine
fromT
reqAutomate :: MonadServerAtomic m => FactionId -> m ()
reqAutomate :: FactionId -> m ()
reqAutomate fid :: 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
UpdAutoFaction FactionId
fid Bool
True