module Game.LambdaHack.Server.PeriodicServer
( spawnMonster, addAnyActor, dominateFidSfx, advanceTime, leadLevelFlip
) where
import Control.Exception.Assert.Sugar
import Control.Monad
import qualified Data.EnumMap.Strict as EM
import qualified Data.EnumSet as ES
import Data.List
import Data.Maybe
import Game.LambdaHack.Atomic
import qualified Game.LambdaHack.Common.Ability as Ability
import Game.LambdaHack.Common.Actor
import Game.LambdaHack.Common.ActorState
import qualified Game.LambdaHack.Common.Effect as Effect
import Game.LambdaHack.Common.Faction
import qualified Game.LambdaHack.Common.Feature as F
import Game.LambdaHack.Common.Frequency
import Game.LambdaHack.Common.Item
import qualified Game.LambdaHack.Common.Kind as 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.Random
import Game.LambdaHack.Common.State
import qualified Game.LambdaHack.Common.Tile as Tile
import Game.LambdaHack.Common.Time
import Game.LambdaHack.Content.ItemKind
import Game.LambdaHack.Content.ModeKind
import Game.LambdaHack.Server.CommonServer
import Game.LambdaHack.Server.ItemRev
import Game.LambdaHack.Server.ItemServer
import Game.LambdaHack.Server.MonadServer
import Game.LambdaHack.Server.State
spawnMonster :: (MonadAtomic m, MonadServer m) => LevelId -> m ()
spawnMonster lid = do
f <- getsState $ \s fid -> isSpawnFact $ sfactionD s EM.! fid
spawns <- getsState $ actorRegularList f lid
totalDepth <- getsState stotalDepth
Level{ldepth, lactorFreq} <- getLevel lid
rc <- rndToAction $ monsterGenChance ldepth totalDepth (length spawns)
when rc $ do
time <- getsState $ getLocalTime lid
maid <- addAnyActor lactorFreq lid time Nothing
case maid of
Nothing -> return ()
Just aid -> do
b <- getsState $ getActorBody aid
mleader <- getsState $ gleader . (EM.! bfid b) . sfactionD
when (isNothing mleader) $
execUpdAtomic $ UpdLeadFaction (bfid b) Nothing (Just aid)
addAnyActor :: (MonadAtomic m, MonadServer m)
=> Freqs -> LevelId -> Time -> Maybe Point
-> m (Maybe ActorId)
addAnyActor actorFreq lid time mpos = do
cops <- getsState scops
flavour <- getsServer sflavour
discoRev <- getsServer sdiscoRev
totalDepth <- getsState stotalDepth
lvl@Level{ldepth} <- getLevel lid
factionD <- getsState sfactionD
m4 <- rndToAction
$ newItem cops flavour discoRev actorFreq lid ldepth totalDepth
case m4 of
Nothing -> return Nothing
Just (itemKnown, trunkFull, seed, k, _) -> do
let ik = maybe (assert `failure` trunkFull) itemKind $ itemDisco trunkFull
freqNames = map fst $ ifreq ik
f fact = playerFaction (gplayer fact)
factNames = map f $ EM.elems factionD
fidName = case freqNames `intersect` factNames of
[] -> head factNames
fName : _ -> fName
g (_, fact) = playerFaction (gplayer fact) == fidName
mfid = find g $ EM.assocs factionD
fid = fst $ fromMaybe (assert `failure` (factionD, fidName)) mfid
pers <- getsServer sper
let allPers = ES.unions $ map (totalVisible . (EM.! lid))
$ EM.elems $ EM.delete fid pers
pos <- case mpos of
Just pos -> return pos
Nothing -> do
rollPos <- getsState $ rollSpawnPos cops allPers lid lvl fid
rndToAction rollPos
let container = (CTrunk fid lid pos)
trunkId <- registerItem itemKnown seed k container False
addActorIid trunkId trunkFull fid pos lid id "it" time
rollSpawnPos :: Kind.COps -> ES.EnumSet Point
-> LevelId -> Level -> FactionId -> State
-> Rnd Point
rollSpawnPos Kind.COps{cotile} visible
lid Level{ltile, lxsize, lysize} fid s = do
let factionDist = max lxsize lysize 5
inhabitants = actorList (/= fid) lid s
as = actorList (const True) lid s
isLit = Tile.isLit cotile
distantAtLeast d p _ =
all (\b -> chessDist (bpos b) p > d) inhabitants
findPosTry 100 ltile
( \p t -> Tile.isWalkable cotile t
&& not (Tile.hasFeature cotile F.NoActor t)
&& unoccupied as p)
[ \_ t -> not (isLit t)
, distantAtLeast factionDist
, distantAtLeast $ factionDist `div` 2
, distantAtLeast $ factionDist `div` 4
, distantAtLeast $ factionDist `div` 6
, \p _ -> not $ p `ES.member` visible
, distantAtLeast 3
]
dominateFidSfx :: (MonadAtomic m, MonadServer m)
=> FactionId -> ActorId -> m Bool
dominateFidSfx fid target = do
actorSk <- actorSkillsServer target (Just target)
let canMove = EM.findWithDefault 0 Ability.AbMove actorSk > 0
if canMove
then do
tb <- getsState $ getActorBody target
let execSfx = execSfxAtomic
$ SfxEffect (boldfid tb) target Effect.Dominate
execSfx
dominateFid fid target
execSfx
return True
else
return False
dominateFid :: (MonadAtomic m, MonadServer m)
=> FactionId -> ActorId -> m ()
dominateFid fid target = do
Kind.COps{cotile} <- getsState scops
tb0 <- getsState $ getActorBody target
disco <- getsServer sdisco
trunk <- getsState $ getItemBody $ btrunk tb0
let ikind = disco EM.! jkindIx trunk
when (boldfid tb0 == bfid tb0) $ execUpdAtomic $ UpdRecordKill target ikind 1
electLeader (bfid tb0) (blid tb0) target
fact <- getsState $ (EM.! bfid tb0) . sfactionD
when (isNothing $ gleader fact) $ moveStores target CSha CInv
tb <- getsState $ getActorBody target
deduceKilled tb
ais <- getsState $ getCarriedAssocs tb
calmMax <- sumOrganEqpServer Effect.EqpSlotAddMaxCalm target
execUpdAtomic $ UpdLoseActor target tb ais
let bNew = tb { bfid = fid
, boldfid = bfid tb
, bcalm = max 0 $ xM calmMax `div` 2 }
execUpdAtomic $ UpdSpotActor target bNew ais
mleaderOld <- getsState $ gleader . (EM.! fid) . sfactionD
keepLeader <- case mleaderOld of
Nothing -> return False
Just leaderOld -> do
body <- getsState $ getActorBody leaderOld
lvl <- getLevel $ blid body
return $! Tile.isStair cotile $ lvl `at` bpos body
unless keepLeader $
execUpdAtomic $ UpdLeadFaction fid mleaderOld (Just target)
advanceTime :: (MonadAtomic m, MonadServer m) => ActorId -> m ()
advanceTime aid = do
b <- getsState $ getActorBody aid
activeItems <- activeItemsServer aid
fact <- getsState $ (EM.! bfid b) . sfactionD
let t = ticksPerMeter $ bspeed b activeItems
execUpdAtomic $ UpdAgeActor aid t
unless (bproj b) $ do
dominated <-
if bcalm b == 0
&& boldfid b /= bfid b
&& playerLeader (gplayer fact)
then dominateFidSfx (boldfid b) aid
else return False
unless dominated $ do
newCalmDelta <- getsState $ regenCalmDelta b activeItems
let clearMark = 0
unless (newCalmDelta <= 0) $
execUpdAtomic $ UpdRefillCalm aid newCalmDelta
unless (bcalmDelta b == ResDelta 0 0) $
execUpdAtomic $ UpdRefillCalm aid clearMark
unless (bhpDelta b == ResDelta 0 0) $
execUpdAtomic $ UpdRefillHP aid clearMark
leadLevelFlip :: (MonadAtomic m, MonadServer m) => m ()
leadLevelFlip = do
cops@Kind.COps{cotile} <- getsState scops
let canFlip fact =
playerAI (gplayer fact) || isAllMoveFact cops fact
flipFaction fact | not $ canFlip fact = return ()
flipFaction fact = do
case gleader fact of
Nothing -> return ()
Just leader -> do
body <- getsState $ getActorBody leader
lvl2 <- getLevel $ blid body
let leaderStuck = waitedLastTurn body
t = lvl2 `at` bpos body
unless (not leaderStuck && Tile.isStair cotile t) $ do
actorD <- getsState sactorD
let ourLvl (lid, lvl) =
( lid
, EM.size (lfloor lvl)
,
actorRegularAssocsLvl (== bfid body) lvl actorD )
ours <- getsState $ map ourLvl . EM.assocs . sdungeon
let freqList = [ (k, (lid, a))
| (lid, itemN, (a, _) : rest) <- ours
, not leaderStuck || lid /= blid body
, let len = 1 + (min 10 $ length rest)
k = 1000000 `div` (3 * itemN + len) ]
unless (null freqList) $ do
(lid, a) <- rndToAction $ frequency
$ toFreq "leadLevel" freqList
unless (lid == blid body) $
execUpdAtomic
$ UpdLeadFaction (bfid body) (Just leader) (Just a)
factionD <- getsState sfactionD
mapM_ flipFaction $ EM.elems factionD