module Game.LambdaHack.Server.PeriodicServer
( spawnMonster, addAnyActor, dominateFidSfx
, advanceTime, managePerTurn, leadLevelSwitch
) 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 Game.LambdaHack.Common.Faction
import Game.LambdaHack.Common.Frequency
import Game.LambdaHack.Common.Item
import Game.LambdaHack.Common.ItemStrongest
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 (ItemKind)
import qualified Game.LambdaHack.Content.ItemKind as IK
import Game.LambdaHack.Content.ModeKind
import qualified Game.LambdaHack.Content.TileKind as TK
import Game.LambdaHack.Server.CommonServer
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
totalDepth <- getsState stotalDepth
Level{ldepth, lactorCoeff, lactorFreq} <- getLevel lid
lvlSpawned <- getsServer $ fromMaybe 0 . EM.lookup lid . snumSpawned
rc <- rndToAction
$ monsterGenChance ldepth totalDepth lvlSpawned lactorCoeff
when rc $ do
modifyServer $ \ser ->
ser {snumSpawned = EM.insert lid (lvlSpawned + 1) $ snumSpawned ser}
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, Nothing))
addAnyActor :: (MonadAtomic m, MonadServer m)
=> Freqs ItemKind -> LevelId -> Time -> Maybe Point
-> m (Maybe ActorId)
addAnyActor actorFreq lid time mpos = do
cops <- getsState scops
lvl <- getLevel lid
factionD <- getsState sfactionD
lvlSpawned <- getsServer $ fromMaybe 0 . EM.lookup lid . snumSpawned
m4 <- rollItem lvlSpawned lid actorFreq
case m4 of
Nothing -> return Nothing
Just (itemKnown, trunkFull, itemDisco, seed, _) -> do
let ik = itemKind itemDisco
freqNames = map fst $ IK.ifreq ik
f fact = fgroup (gplayer fact)
factNames = map f $ EM.elems factionD
fidName = case freqNames `intersect` factNames of
[] -> head factNames
fName : _ -> fName
g (_, fact) = fgroup (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
mobile = any (`elem` freqNames) ["civilian", "horror"]
pos <- case mpos of
Just pos -> return pos
Nothing -> do
fact <- getsState $ (EM.! fid) . sfactionD
rollPos <- getsState $ rollSpawnPos cops allPers mobile lid lvl fact
rndToAction rollPos
let container = CTrunk fid lid pos
trunkId <- registerItem trunkFull itemKnown seed
(itemK trunkFull) container False
addActorIid trunkId trunkFull False fid pos lid id "it" time
rollSpawnPos :: Kind.COps -> ES.EnumSet Point
-> Bool -> LevelId -> Level -> Faction -> State
-> Rnd Point
rollSpawnPos Kind.COps{cotile} visible
mobile lid Level{ltile, lxsize, lysize} fact s = do
let inhabitants = actorRegularList (isAtWar fact) lid s
as = actorList (const True) lid s
isLit = Tile.isLit cotile
distantSo df p _ =
all (\b -> df $ chessDist (bpos b) p) inhabitants
middlePos = Point (lxsize `div` 2) (lysize `div` 2)
distantMiddle d p _ = chessDist p middlePos < d
condList | mobile =
[ \_ t -> not (isLit t)
, distantSo (<= 10)
, distantSo (>= 5)
, distantSo (<= 20)
]
| otherwise =
[ distantMiddle 5
, distantMiddle 10
, distantMiddle 20
, distantMiddle 50
, distantMiddle 100
]
findPosTry (if mobile then 500 else 100) ltile
( \p t -> Tile.isWalkable cotile t
&& not (Tile.hasFeature cotile TK.NoActor t)
&& unoccupied as p)
(condList
++ [ \p _ -> not (p `ES.member` visible)
, distantSo (>= 3)
])
dominateFidSfx :: (MonadAtomic m, MonadServer m)
=> FactionId -> ActorId -> m Bool
dominateFidSfx fid target = do
tb <- getsState $ getActorBody target
activeItems <- activeItemsServer target
let actorMaxSk = sumSkills activeItems
canMove = EM.findWithDefault 0 Ability.AbMove actorMaxSk > 0
&& EM.findWithDefault 0 Ability.AbTrigger actorMaxSk > 0
&& EM.findWithDefault 0 Ability.AbAlter actorMaxSk > 0
if canMove && not (bproj tb)
then do
let execSfx = execSfxAtomic
$ SfxEffect (bfidImpressed tb) target IK.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
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 target tb
ais <- getsState $ getCarriedAssocs tb
calmMax <- sumOrganEqpServer IK.EqpSlotAddMaxCalm target
execUpdAtomic $ UpdLoseActor target tb ais
let bNew = tb { bfid = fid
, bfidImpressed = bfid tb
, bcalm = max 0 $ xM calmMax `div` 2 }
execUpdAtomic $ UpdSpotActor target bNew ais
let discoverSeed (iid, cstore) = do
seed <- getsServer $ (EM.! iid) . sitemSeedD
let c = CActor target cstore
execUpdAtomic $ UpdDiscoverSeed c iid seed
aic = getCarriedIidCStore tb
mapM_ discoverSeed aic
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, Nothing))
advanceTime :: (MonadAtomic m, MonadServer m) => ActorId -> m ()
advanceTime aid = do
b <- getsState $ getActorBody aid
activeItems <- activeItemsServer aid
let t = ticksPerMeter $ bspeed b activeItems
execUpdAtomic $ UpdAgeActor aid t
managePerTurn :: (MonadAtomic m, MonadServer m) => ActorId -> m ()
managePerTurn aid = do
b <- getsState $ getActorBody aid
unless (bproj b) $ do
activeItems <- activeItemsServer aid
fact <- getsState $ (EM.! bfid b) . sfactionD
dominated <-
if bcalm b == 0
&& bfidImpressed b /= bfid b
&& fleaderMode (gplayer fact) /= LeaderNull
then dominateFidSfx (bfidImpressed 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
leadLevelSwitch :: (MonadAtomic m, MonadServer m) => m ()
leadLevelSwitch = do
Kind.COps{cotile} <- 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 fact =
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) (gleader fact)
(Just (a, Nothing))
factionD <- getsState sfactionD
mapM_ flipFaction $ EM.elems factionD