module Game.LambdaHack.Server.EffectSem
(
itemEffect, effectSem
, createItems, addHero, spawnMonsters, electLeader, deduceKilled
) where
import Control.Monad
import qualified Data.Char as Char
import qualified Data.EnumMap.Strict as EM
import qualified Data.HashMap.Strict as HM
import Data.Key (mapWithKeyM_)
import Data.List
import Data.Maybe
import Data.Ratio ((%))
import Data.Text (Text)
import qualified NLP.Miniutter.English as MU
import Game.LambdaHack.Common.Action
import Game.LambdaHack.Common.Actor
import Game.LambdaHack.Common.ActorState
import Game.LambdaHack.Common.AtomicCmd
import qualified Game.LambdaHack.Common.Color as Color
import qualified Game.LambdaHack.Common.Effect as Effect
import Game.LambdaHack.Common.Faction
import Game.LambdaHack.Common.Item
import qualified Game.LambdaHack.Common.Kind as Kind
import Game.LambdaHack.Common.Level
import Game.LambdaHack.Common.Msg
import Game.LambdaHack.Common.Point
import Game.LambdaHack.Common.Random
import Game.LambdaHack.Common.State
import Game.LambdaHack.Common.Time
import Game.LambdaHack.Content.ActorKind
import Game.LambdaHack.Content.FactionKind
import Game.LambdaHack.Server.Action
import Game.LambdaHack.Server.Config
import Game.LambdaHack.Server.State
import Game.LambdaHack.Utils.Assert
import Game.LambdaHack.Utils.Frequency
itemEffect :: (MonadAtomic m, MonadServer m)
=> ActorId -> ActorId -> Maybe ItemId -> Item
-> m ()
itemEffect source target miid item = do
sb <- getsState $ getActorBody source
discoS <- getsServer sdisco
let ik = fromJust $ jkind discoS item
ef = jeffect item
b <- effectSem ef source target
let atomic iid = execCmdAtomic $ DiscoverA (blid sb) (bpos sb) iid ik
when b $ maybe skip atomic miid
effectSem :: (MonadAtomic m, MonadServer m)
=> Effect.Effect Int -> ActorId -> ActorId
-> m Bool
effectSem effect source target = case effect of
Effect.NoEffect -> effectNoEffect
Effect.Heal p -> effectHeal p target
Effect.Hurt nDm p -> effectWound nDm p source target
Effect.Mindprobe _ -> effectMindprobe target
Effect.Dominate | source /= target -> effectDominate source target
Effect.Dominate -> effectSem (Effect.Mindprobe undefined) source target
Effect.CallFriend p -> effectCallFriend p source target
Effect.Summon p -> effectSummon p target
Effect.CreateItem p -> effectCreateItem p target
Effect.ApplyPerfume -> effectApplyPerfume source target
Effect.Regeneration p -> effectSem (Effect.Heal p) source target
Effect.Searching p -> effectSearching p source
Effect.Ascend p -> effectAscend p target
Effect.Descend p -> effectDescend p target
Effect.Escape -> effectEscape target
effectNoEffect :: Monad m => m Bool
effectNoEffect = return False
effectHeal :: MonadAtomic m
=> Int -> ActorId -> m Bool
effectHeal power target = do
Kind.COps{coactor=Kind.Ops{okind}} <- getsState scops
tm <- getsState $ getActorBody target
let bhpMax = maxDice (ahp $ okind $ bkind tm)
if power > 0 && bhp tm >= bhpMax
then do
execSfxAtomic $ EffectD target Effect.NoEffect
return False
else do
let deltaHP = min power (bhpMax bhp tm)
execCmdAtomic $ HealActorA target deltaHP
execSfxAtomic $ EffectD target $ Effect.Heal deltaHP
return True
effectWound :: (MonadAtomic m, MonadServer m)
=> RollDice -> Int -> ActorId -> ActorId
-> m Bool
effectWound nDm power source target = do
n <- rndToAction $ rollDice nDm
let deltaHP = (n + power)
if deltaHP >= 0
then return False
else do
execCmdAtomic $ HealActorA target deltaHP
execSfxAtomic $ EffectD target $
if source == target
then Effect.Heal deltaHP
else Effect.Hurt nDm deltaHP
return True
effectMindprobe :: MonadAtomic m
=> ActorId -> m Bool
effectMindprobe target = do
tb <- getsState (getActorBody target)
let lid = blid tb
fact <- getsState $ (EM.! bfid tb) . sfactionD
lb <- getsState $ actorNotProjList (isAtWar fact) lid
let nEnemy = length lb
if nEnemy == 0 then do
execSfxAtomic $ EffectD target Effect.NoEffect
return False
else do
execSfxAtomic $ EffectD target $ Effect.Mindprobe nEnemy
return True
effectDominate :: (MonadAtomic m, MonadServer m)
=> ActorId -> ActorId -> m Bool
effectDominate source target = do
Kind.COps{coactor=Kind.Ops{okind}} <- getsState scops
sb <- getsState (getActorBody source)
tb <- getsState (getActorBody target)
if bfid tb == bfid sb then do
execSfxAtomic $ EffectD target Effect.NoEffect
return False
else do
electLeader (bfid tb) (blid tb) target
ais <- getsState $ getActorItem target
execCmdAtomic $ LoseActorA target tb ais
let bNew = tb {bfid = bfid sb}
execCmdAtomic $ CreateActorA target bNew ais
leaderOld <- getsState $ gleader . (EM.! bfid sb) . sfactionD
let speed = fromMaybe (aspeed $ okind $ bkind bNew) $ bspeed bNew
delta = speedScale (1%2) speed
when (delta > speedZero) $
execCmdAtomic $ HasteActorA target (speedNegate delta)
execCmdAtomic $ LeadFactionA (bfid sb) leaderOld (Just target)
deduceKilled tb
return True
electLeader :: MonadAtomic m => FactionId -> LevelId -> ActorId -> m ()
electLeader fid lid aidDead = do
mleader <- getsState $ gleader . (EM.! fid) . sfactionD
when (isNothing mleader || mleader == Just aidDead) $ do
actorD <- getsState sactorD
let ours (_, b) = bfid b == fid && not (bproj b)
party = filter ours $ EM.assocs actorD
onLevel <- getsState $ actorNotProjAssocs (== fid) lid
let mleaderNew = listToMaybe $ filter (/= aidDead)
$ map fst $ onLevel ++ party
execCmdAtomic $ LeadFactionA fid mleader mleaderNew
deduceKilled :: (MonadAtomic m, MonadServer m) => Actor -> m ()
deduceKilled body = do
let fid = bfid body
spawn <- getsState $ isSpawnFaction fid
summon <- getsState $ isSummonFaction fid
Config{configFirstDeathEnds} <- getsServer sconfig
mleader <- getsState $ gleader . (EM.! fid) . sfactionD
when (not spawn && not summon
&& (isNothing mleader || configFirstDeathEnds)) $
deduceQuits body $ Status Killed (fromEnum $ blid body) ""
effectCallFriend :: (MonadAtomic m, MonadServer m)
=> Int -> ActorId -> ActorId
-> m Bool
effectCallFriend power source target = do
Kind.COps{cotile} <- getsState scops
sm <- getsState (getActorBody source)
tm <- getsState (getActorBody target)
ps <- getsState $ nearbyFreePoints cotile (const True) (bpos tm) (blid tm)
summonFriends (bfid sm) (take power ps) (blid tm)
return True
summonFriends :: (MonadAtomic m, MonadServer m)
=> FactionId -> [Point] -> LevelId
-> m ()
summonFriends bfid ps lid = do
Kind.COps{ coactor=coactor@Kind.Ops{opick}
, cofact=Kind.Ops{okind} } <- getsState scops
time <- getsState $ getLocalTime lid
factionD <- getsState sfactionD
let fact = okind $ gkind $ factionD EM.! bfid
forM_ ps $ \ p -> do
mk <- rndToAction $ opick (fname fact) (const True)
if mk == heroKindId coactor
then addHero bfid p lid [] Nothing time
else addMonster mk bfid p lid time
addActor :: (MonadAtomic m, MonadServer m)
=> Kind.Id ActorKind -> FactionId -> Point -> LevelId -> Int
-> Maybe Char -> Maybe Text -> Maybe Color.Color -> Time
-> m ActorId
addActor mk bfid pos lid hp bsymbol bname bcolor time = do
let m = actorTemplate mk bsymbol bname bcolor Nothing hp Nothing pos lid time
bfid False
acounter <- getsServer sacounter
modifyServer $ \ser -> ser {sacounter = succ acounter}
execCmdAtomic $ CreateActorA acounter m []
return acounter
addHero :: (MonadAtomic m, MonadServer m)
=> FactionId -> Point -> LevelId -> [(Int, Text)] -> Maybe Int -> Time
-> m ActorId
addHero bfid ppos lid configHeroNames mNumber time = do
Kind.COps{coactor=coactor@Kind.Ops{okind}} <- getsState scops
Faction{gcolor, gconfig} <- getsState $ (EM.! bfid) . sfactionD
let kId = heroKindId coactor
hp <- rndToAction $ rollDice $ ahp $ okind kId
mhs <- mapM (\n -> getsState $ \s -> tryFindHeroK s bfid n) [0..9]
let freeHeroK = elemIndex Nothing mhs
n = fromMaybe (fromMaybe 100 freeHeroK) mNumber
symbol = if n < 1 || n > 9 then '@' else Char.intToDigit n
name | gcolor == Color.BrWhite =
fromMaybe ("Hero" <+> showT n) $ lookup n configHeroNames
| otherwise = gconfig <+> "Hero" <+> showT n
startHP = hp (hp `div` 5) * min 3 n
addActor
kId bfid ppos lid startHP (Just symbol) (Just name) (Just gcolor) time
effectSummon :: (MonadAtomic m, MonadServer m)
=> Int -> ActorId -> m Bool
effectSummon power target = do
Kind.COps{cotile} <- getsState scops
tm <- getsState (getActorBody target)
ps <- getsState $ nearbyFreePoints cotile (const True) (bpos tm) (blid tm)
time <- getsState $ getLocalTime (blid tm)
spawnMonsters (take power ps) (blid tm) (const True) time "summon"
return True
spawnMonsters :: (MonadAtomic m, MonadServer m)
=> [Point] -> LevelId -> ((FactionId, Faction) -> Bool)
-> Time -> Text
-> m ()
spawnMonsters ps lid filt time freqChoice = assert (not $ null ps) $ do
Kind.COps{ coactor=Kind.Ops{opick}
, cofact=Kind.Ops{okind} } <- getsState scops
factionD <- getsState sfactionD
let f (fid, fact) = let kind = okind (gkind fact)
g n = (n, (kind, fid))
in fmap g $ lookup freqChoice $ ffreq kind
case mapMaybe f $ filter filt $ EM.assocs factionD of
[] -> return ()
spawnList -> do
let freq = toFreq "spawnMonsters" spawnList
(spawnKind, bfid) <- rndToAction $ frequency freq
laid <- forM ps $ \ p -> do
mk <- rndToAction $ opick (fname spawnKind) (const True)
addMonster mk bfid p lid time
mleader <- getsState $ gleader . (EM.! bfid) . sfactionD
when (isNothing mleader) $
execCmdAtomic $ LeadFactionA bfid Nothing (Just $ head laid)
addMonster :: (MonadAtomic m, MonadServer m)
=> Kind.Id ActorKind -> FactionId -> Point -> LevelId -> Time
-> m ActorId
addMonster mk bfid ppos lid time = do
Kind.COps{coactor=Kind.Ops{okind}} <- getsState scops
hp <- rndToAction $ rollDice $ ahp $ okind mk
addActor mk bfid ppos lid hp Nothing Nothing Nothing time
effectCreateItem :: (MonadAtomic m, MonadServer m)
=> Int -> ActorId -> m Bool
effectCreateItem power target = do
tm <- getsState $ getActorBody target
void $ createItems power (bpos tm) (blid tm)
return True
createItems :: (MonadAtomic m, MonadServer m)
=> Int -> Point -> LevelId -> m ()
createItems n pos lid = do
Kind.COps{coitem} <- getsState scops
flavour <- getsServer sflavour
discoRev <- getsServer sdiscoRev
ldepth <- getsLevel lid ldepth
depth <- getsState sdepth
replicateM_ n $ do
(item, k, _) <- rndToAction $ newItem coitem flavour discoRev ldepth depth
itemRev <- getsServer sitemRev
case HM.lookup item itemRev of
Just iid ->
execCmdAtomic $ CreateItemA iid item k (CFloor lid pos)
Nothing -> do
icounter <- getsServer sicounter
modifyServer $ \ser ->
ser { sicounter = succ icounter
, sitemRev = HM.insert item icounter (sitemRev ser)}
execCmdAtomic $ CreateItemA icounter item k (CFloor lid pos)
effectApplyPerfume :: MonadAtomic m
=> ActorId -> ActorId -> m Bool
effectApplyPerfume source target =
if source == target
then do
execSfxAtomic $ EffectD target Effect.NoEffect
return False
else do
tm <- getsState $ getActorBody target
oldSmell <- getsLevel (blid tm) lsmell
let f p fromSm =
execCmdAtomic $ AlterSmellA (blid tm) p (Just fromSm) Nothing
mapWithKeyM_ f oldSmell
execSfxAtomic $ EffectD target Effect.ApplyPerfume
return True
effectSearching :: MonadAtomic m => Int -> ActorId -> m Bool
effectSearching power source = do
execSfxAtomic $ EffectD source $ Effect.Searching power
return True
effectAscend :: MonadAtomic m => Int -> ActorId -> m Bool
effectAscend power target = do
b <- effLvlGoUp target power
when b $ execSfxAtomic $ EffectD target $ Effect.Ascend power
return b
effLvlGoUp :: MonadAtomic m => ActorId -> Int -> m Bool
effLvlGoUp aid k = do
Kind.COps{coactor} <- getsState scops
bOld <- getsState $ getActorBody aid
let lidOld = blid bOld
posOld = bpos bOld
whereto <- getsState $ \s -> whereTo s lidOld k
case whereto of
Nothing ->
return False
Just (lidNew, posNew) -> do
inhabitants <- getsState $ posToActor posNew lidNew
case inhabitants of
Nothing -> return ()
Just aid2 -> do
switchLevels aid2 lidOld posOld
b2 <- getsState $ getActorBody aid2
let part2 = partActor coactor b2
verb = "be pushed to another level"
msg2 = makeSentence [MU.SubjectVerbSg part2 verb]
execSfxAtomic $ MsgFidD (bfid b2) msg2
switchLevels aid lidNew posNew
void $ getsState $ posToActor posOld lidOld
return True
switchLevels :: MonadAtomic m => ActorId -> LevelId -> Point -> m ()
switchLevels aid lidNew posNew = do
bOld <- getsState $ getActorBody aid
ais <- getsState $ getActorItem aid
let lidOld = blid bOld
side = bfid bOld
assert (lidNew /= lidOld `blame` (lidNew, "stairs looped" :: Text)) skip
timeOld <- getsState $ getLocalTime lidOld
timeLastVisited <- getsState $ getLocalTime lidNew
let delta = timeAdd (btime bOld) (timeNegate timeOld)
bNew = bOld { blid = lidNew
, btime = timeAdd timeLastVisited delta
, bpos = posNew
, boldpos = posNew}
mleader <- getsState $ gleader . (EM.! side) . sfactionD
execCmdAtomic $ LeadFactionA side mleader Nothing
execCmdAtomic $ LoseActorA aid bOld ais
execCmdAtomic $ CreateActorA aid bNew ais
execCmdAtomic $ LeadFactionA side Nothing (Just aid)
effectDescend :: MonadAtomic m => Int -> ActorId -> m Bool
effectDescend power target = do
b <- effLvlGoUp target (power)
when b $ execSfxAtomic $ EffectD target $ Effect.Descend power
return b
effectEscape :: (MonadAtomic m, MonadServer m) => ActorId -> m Bool
effectEscape aid = do
b <- getsState $ getActorBody aid
let fid = bfid b
spawn <- getsState $ isSpawnFaction fid
summon <- getsState $ isSummonFaction fid
if spawn || summon then return False
else do
deduceQuits b $ Status Escape (fromEnum $ blid b) ""
return True