module Game.LambdaHack.Server.PeriodicServer
( spawnMonster, addAnyActor, dominateFidSfx
, advanceTime, swapTime, managePerTurn, leadLevelSwitch, udpateCalm
) where
import Control.Exception.Assert.Sugar
import Control.Monad
import qualified Data.EnumMap.Strict as EM
import qualified Data.EnumSet as ES
import Data.Int (Int64)
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) ["mobile", "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
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 =
[ distantSo (<= 10)
, distantSo (<= 15)
, 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
++ [ distantSo (> 5)
, distantSo (> 2)
, \p _ -> not (p `ES.member` visible)
])
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
item <- getsState $ getItemBody iid
Level{ldepth} <- getLevel $ jlid item
let c = CActor target cstore
execUpdAtomic $ UpdDiscoverSeed c iid seed ldepth
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
localTime <- getsState $ getLocalTime (blid b)
let halfActorTurn = timeDeltaDiv (ticksPerMeter $ bspeed b activeItems) 2
t | bhp b <= 0 =
let delta = Delta $ if bproj b then timeZero else timeTurn
localPlusDelta = localTime `timeShift` delta
in localPlusDelta `timeDeltaToFrom` btime b
| otherwise = halfActorTurn
execUpdAtomic $ UpdAgeActor aid t
swapTime :: (MonadAtomic m, MonadServer 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)
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) $ execUpdAtomic $ UpdAgeActor source sdelta
when (tdelta /= Delta timeZero) $ execUpdAtomic $ UpdAgeActor target tdelta
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) $
udpateCalm aid newCalmDelta
unless (bcalmDelta b == ResDelta 0 0) $
execUpdAtomic $ UpdRefillCalm aid clearMark
unless (bhpDelta b == ResDelta 0 0) $
execUpdAtomic $ UpdRefillHP aid clearMark
udpateCalm :: (MonadAtomic m, MonadServer m) => ActorId -> Int64 -> m ()
udpateCalm target deltaCalm = do
tb <- getsState $ getActorBody target
activeItems <- activeItemsServer target
let calmMax64 = xM $ sumSlotNoFilter IK.EqpSlotAddMaxCalm activeItems
execUpdAtomic $ UpdRefillCalm target deltaCalm
when (bcalm tb < calmMax64
&& bcalm tb + deltaCalm >= calmMax64
&& bfidImpressed tb /= bfidOriginal tb) $
execUpdAtomic $
UpdFidImpressedActor target (bfidImpressed tb) (bfidOriginal tb)
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