module Game.LambdaHack.Server.PeriodicM
( spawnMonster, addAnyActor
, advanceTime, advanceTimeTraj, overheadActorTime, swapTime
, updateCalm, leadLevelSwitch
#ifdef EXPOSE_INTERNAL
, rollSpawnPos
#endif
) where
import Prelude ()
import Game.LambdaHack.Core.Prelude
import qualified Data.EnumMap.Strict as EM
import qualified Data.EnumSet as ES
import Data.Int (Int64)
import Data.Ord
import Game.LambdaHack.Atomic
import Game.LambdaHack.Common.Actor
import Game.LambdaHack.Common.ActorState
import Game.LambdaHack.Common.Area
import Game.LambdaHack.Common.Faction
import Game.LambdaHack.Common.Item
import Game.LambdaHack.Common.Kind
import Game.LambdaHack.Common.Level
import Game.LambdaHack.Common.Misc
import Game.LambdaHack.Common.MonadStateRead
import Game.LambdaHack.Common.Perception
import Game.LambdaHack.Common.Point
import Game.LambdaHack.Common.State
import qualified Game.LambdaHack.Common.Tile as Tile
import Game.LambdaHack.Common.Time
import Game.LambdaHack.Common.Types
import qualified Game.LambdaHack.Content.CaveKind as CK
import Game.LambdaHack.Content.ItemKind (ItemKind)
import qualified Game.LambdaHack.Content.ItemKind as IK
import Game.LambdaHack.Content.ModeKind
import Game.LambdaHack.Core.Frequency
import Game.LambdaHack.Core.Random
import qualified Game.LambdaHack.Definition.Ability as Ability
import Game.LambdaHack.Definition.Defs
import Game.LambdaHack.Server.CommonM
import Game.LambdaHack.Server.ItemM
import Game.LambdaHack.Server.MonadServer
import Game.LambdaHack.Server.State
spawnMonster :: MonadServerAtomic m => m ()
spawnMonster = do
COps{cocave} <- getsState scops
arenas <- getsServer sarenas
arena <- rndToAction $ oneOf arenas
Level{lkind, ldepth, lbig} <- getLevel arena
let ck = okind cocave lkind
if | CK.cactorCoeff ck == 0 || null (CK.cactorFreq ck) -> return ()
| EM.size lbig >= 300 ->
debugPossiblyPrint "Server: spawnMonster: too many big actors on level"
| otherwise -> do
totalDepth <- getsState stotalDepth
lvlSpawned <- getsServer $ fromMaybe 0 . EM.lookup arena . snumSpawned
rc <- rndToAction
$ monsterGenChance ldepth totalDepth lvlSpawned (CK.cactorCoeff ck)
when rc $ do
modifyServer $ \ser ->
ser {snumSpawned = EM.insert arena (lvlSpawned + 1)
$ snumSpawned ser}
localTime <- getsState $ getLocalTime arena
maid <- addAnyActor False lvlSpawned (CK.cactorFreq ck) arena
localTime Nothing
case maid of
Nothing -> return ()
Just aid -> do
b <- getsState $ getActorBody aid
mleader <- getsState $ gleader . (EM.! bfid b) . sfactionD
when (isNothing mleader) $ setFreshLeader (bfid b) aid
addAnyActor :: MonadServerAtomic m
=> Bool -> Int -> Freqs ItemKind -> LevelId -> Time -> Maybe Point
-> m (Maybe ActorId)
addAnyActor summoned lvlSpawned actorFreq lid time mpos = do
cops <- getsState scops
lvl <- getLevel lid
factionD <- getsState sfactionD
freq <- prepareItemKind lvlSpawned lid actorFreq
m2 <- rollItemAspect freq lid
case m2 of
Nothing -> do
debugPossiblyPrint "Server: addAnyActor: trunk failed to roll"
return Nothing
Just (itemKnownRaw, (itemFullRaw, kit)) -> do
(fid, _) <- rndToAction $ oneOf $
possibleActorFactions (itemKind itemFullRaw) factionD
pers <- getsServer sperFid
let allPers = ES.unions $ map (totalVisible . (EM.! lid))
$ EM.elems $ EM.delete fid pers
freqNames = map fst $ IK.ifreq $ itemKind itemFullRaw
mobile = "mobile" `elem` freqNames
aquatic = "aquatic" `elem` freqNames
mrolledPos <- case mpos of
Just{} -> return mpos
Nothing -> do
rollPos <-
getsState $ rollSpawnPos cops allPers mobile aquatic lid lvl fid
rndToAction rollPos
case mrolledPos of
Just pos ->
Just <$> registerActor summoned itemKnownRaw (itemFullRaw, kit)
fid pos lid time
Nothing -> do
debugPossiblyPrint
"Server: addAnyActor: failed to find any free position"
return Nothing
rollSpawnPos :: COps -> ES.EnumSet Point
-> Bool -> Bool -> LevelId -> Level -> FactionId -> State
-> Rnd (Maybe Point)
rollSpawnPos COps{coTileSpeedup} visible
mobile aquatic lid lvl@Level{larea} fid s = do
let inhabitants = foeRegularList fid lid s
nearInh !df !p = all (\ !b -> df $ chessDist (bpos b) p) inhabitants
distantMiddle !d !p = chessDist p (middlePoint larea) < d
condList | mobile =
[ nearInh (<= 50)
, nearInh (<= 100)
]
| otherwise =
[ distantMiddle 8
, distantMiddle 16
, distantMiddle 24
, distantMiddle 26
, distantMiddle 28
, distantMiddle 30
]
findPosTry2 (if mobile then 500 else 50) lvl
( \p !t -> Tile.isWalkable coTileSpeedup t
&& not (Tile.isNoActor coTileSpeedup t)
&& not (occupiedBigLvl p lvl)
&& not (occupiedProjLvl p lvl) )
(map (\f p _ -> f p) condList)
(\ !p t -> nearInh (> 4) p
&& not (p `ES.member` visible)
&& (not aquatic || Tile.isAquatic coTileSpeedup t))
[ \ !p _ -> nearInh (> 3) p
&& not (p `ES.member` visible)
, \ !p _ -> nearInh (> 2) p
&& not (p `ES.member` visible)
, \ !p _ -> not (p `ES.member` visible)
]
advanceTime :: MonadServerAtomic m => ActorId -> Int -> Bool -> m ()
advanceTime aid percent breakStasis = do
b <- getsState $ getActorBody aid
actorMaxSk <- getsState $ getActorMaxSkills aid
let t = timeDeltaPercent (ticksPerMeter $ gearSpeed actorMaxSk) percent
modifyServer $ \ser ->
ser {sactorTime = ageActor (bfid b) (blid b) aid t $ sactorTime ser}
when breakStasis $
modifyServer $ \ser ->
ser {sactorStasis = ES.delete aid (sactorStasis ser)}
advanceTimeTraj :: MonadServerAtomic m => ActorId -> m ()
advanceTimeTraj aid = do
b <- getsState $ getActorBody aid
let speedTraj = case btrajectory b of
Nothing -> error $ "" `showFailure` b
Just (_, speed) -> speed
t = ticksPerMeter speedTraj
modifyServer $ \ser ->
ser {strajTime = ageActor (bfid b) (blid b) aid t $ strajTime ser}
overheadActorTime :: MonadServerAtomic m => FactionId -> LevelId -> m ()
overheadActorTime fid lid = do
actorTimeFid <- getsServer $ (EM.! fid) . sactorTime
let actorTimeLid = actorTimeFid EM.! lid
getActorB <- getsState $ flip getActorBody
mleader <- getsState $ gleader . (EM.! fid) . sfactionD
let f !aid !time =
let body = getActorB aid
in if bhp body > 0
&& Just aid /= mleader
then timeShift time (Delta timeClip)
else time
actorTimeLid2 = EM.mapWithKey f actorTimeLid
actorTimeFid2 = EM.insert lid actorTimeLid2 actorTimeFid
modifyServer $ \ser ->
ser {sactorTime = EM.insert fid actorTimeFid2 $ sactorTime ser}
swapTime :: MonadServerAtomic m => ActorId -> ActorId -> m ()
swapTime source target = do
sb <- getsState $ getActorBody source
tb <- getsState $ getActorBody target
slvl <- getsState $ getLocalTime (blid sb)
tlvl <- getsState $ getLocalTime (blid tb)
btime_sb <-
getsServer $ (EM.! source) . (EM.! blid sb) . (EM.! bfid sb) . sactorTime
btime_tb <-
getsServer $ (EM.! target) . (EM.! blid tb) . (EM.! bfid tb) . sactorTime
let lvlDelta = slvl `timeDeltaToFrom` tlvl
bDelta = btime_sb `timeDeltaToFrom` btime_tb
sdelta = timeDeltaSubtract lvlDelta bDelta
tdelta = timeDeltaReverse sdelta
let !_A = let sbodyDelta = btime_sb `timeDeltaToFrom` slvl
tbodyDelta = btime_tb `timeDeltaToFrom` tlvl
sgoal = slvl `timeShift` tbodyDelta
tgoal = tlvl `timeShift` sbodyDelta
sdelta' = sgoal `timeDeltaToFrom` btime_sb
tdelta' = tgoal `timeDeltaToFrom` btime_tb
in assert (sdelta == sdelta' && tdelta == tdelta'
`blame` ( slvl, tlvl, btime_sb, btime_tb
, sdelta, sdelta', tdelta, tdelta' )) ()
when (sdelta /= Delta timeZero) $ modifyServer $ \ser ->
ser {sactorTime = ageActor (bfid sb) (blid sb) source sdelta $ sactorTime ser}
when (tdelta /= Delta timeZero) $ modifyServer $ \ser ->
ser {sactorTime = ageActor (bfid tb) (blid tb) target tdelta $ sactorTime ser}
updateCalm :: MonadServerAtomic m => ActorId -> Int64 -> m ()
updateCalm target deltaCalm = do
tb <- getsState $ getActorBody target
actorMaxSk <- getsState $ getActorMaxSkills target
let calmMax64 = xM $ Ability.getSk Ability.SkMaxCalm actorMaxSk
execUpdAtomic $ UpdRefillCalm target deltaCalm
when (bcalm tb < calmMax64
&& bcalm tb + deltaCalm >= calmMax64) $
return ()
leadLevelSwitch :: MonadServerAtomic m => m ()
leadLevelSwitch = do
COps{cocave} <- getsState scops
let canSwitch fact = fst (autoDungeonLevel fact)
|| case fleaderMode (gplayer fact) of
LeaderNull -> False
LeaderAI _ -> True
LeaderUI _ -> False
flipFaction (_, fact) | not $ canSwitch fact = return ()
flipFaction (fid, fact) =
case gleader fact of
Nothing -> return ()
Just leader -> do
body <- getsState $ getActorBody leader
let !_A = assert (fid == bfid body) ()
s <- getsServer $ (EM.! fid) . sclientStates
let leaderStuck = actorWaits body
oursRaw =
[ ((lid, lvl), (allSeen, as))
| (lid, lvl) <- EM.assocs $ sdungeon s
, lid /= blid body || not leaderStuck
, let asRaw =
fidActorRegularAssocs fid lid s
isAlert (_, b) = case bwatch b of
WWatch -> True
WWait n -> n == 0
WSleep -> False
WWake -> True
(alert, relaxed) = partition isAlert asRaw
as = alert ++ relaxed
, not (null as)
, let allSeen =
lexpl lvl <= lseen lvl
|| CK.cactorCoeff (okind cocave $ lkind lvl) > 150
&& not (fhasGender $ gplayer fact)
]
(oursSeen, oursNotSeen) = partition (fst . snd) oursRaw
f ((lid, _), _) = abs $ fromEnum lid
ours = oursSeen ++ take 2 (sortBy (comparing f) oursNotSeen)
let freqList = [ (k, (lid, aid))
| ((lid, lvl), (_, (aid, _) : _)) <- ours
, let len = min 20 (EM.size $ lbig lvl)
k = 1000000 `div` (1 + len) ]
unless (null freqList) $ do
(lid, a) <- rndToAction $ frequency
$ toFreq "leadLevel" freqList
unless (lid == blid body) $
setFreshLeader fid a
factionD <- getsState sfactionD
mapM_ flipFaction $ EM.assocs factionD