module Game.LambdaHack.Client.AI.PickActorClient
( pickActorToMove
) where
import Control.Exception.Assert.Sugar
import Control.Monad
import qualified Data.EnumMap.Strict as EM
import Data.List
import Data.Maybe
import Data.Ord
import Game.LambdaHack.Client.AI.ConditionClient
import Game.LambdaHack.Client.AI.PickTargetClient
import Game.LambdaHack.Client.CommonClient
import Game.LambdaHack.Client.MonadClient
import Game.LambdaHack.Client.State
import Game.LambdaHack.Common.Actor
import Game.LambdaHack.Common.ActorState
import Game.LambdaHack.Common.Faction
import Game.LambdaHack.Common.Frequency
import qualified Game.LambdaHack.Common.Kind as Kind
import Game.LambdaHack.Common.Level
import Game.LambdaHack.Common.MonadStateRead
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.Vector
import Game.LambdaHack.Content.ModeKind
pickActorToMove :: MonadClient m
=> (ActorId -> (ActorId, Actor)
-> m (Maybe ((ActorId, Actor), (Target, PathEtc))))
-> ActorId
-> m (ActorId, Actor)
pickActorToMove refreshTarget oldAid = do
Kind.COps{cotile} <- getsState scops
oldBody <- getsState $ getActorBody oldAid
let side = bfid oldBody
arena = blid oldBody
fact <- getsState $ (EM.! side) . sfactionD
lvl <- getLevel arena
let leaderStuck = waitedLastTurn oldBody
t = lvl `at` bpos oldBody
mleader <- getsClient _sleader
ours <- getsState $ actorRegularAssocs (== side) arena
let explore = void $ refreshTarget oldAid (oldAid, oldBody)
pickOld = do
if mleader == Just oldAid then explore
else case ftactic $ gplayer fact of
TBlock -> return ()
TFollow ->
case mleader of
Nothing -> explore
Just leader -> do
onLevel <- getsState $ memActor leader arena
if not onLevel then explore
else do
tgtLeader <- do
mtgt <- getsClient $ (EM.lookup leader) . stargetD
case mtgt of
Nothing -> return $! TEnemy leader True
Just (tgtLeader, _) -> return tgtLeader
modifyClient $ \cli ->
cli { sbfsD = EM.delete oldAid (sbfsD cli)
, seps = seps cli + 773 }
mpath <- createPath oldAid tgtLeader
let tgtMPath = maybe (tgtLeader, Nothing)
(\(tgt, p) -> (tgt, Just p)) mpath
modifyClient $ \cli ->
cli {stargetD = EM.alter (const $ Just tgtMPath)
oldAid (stargetD cli)}
TExplore -> explore
TRoam -> explore
TPatrol -> explore
return (oldAid, oldBody)
case ours of
_ |
mleader /= Just oldAid
|| not leaderStuck && Tile.isStair cotile t
-> pickOld
[] -> assert `failure` (oldAid, oldBody)
[_] -> pickOld
(captain, captainBody) : (sergeant, sergeantBody) : _ -> do
oursTgt <- fmap catMaybes $ mapM (refreshTarget oldAid) ours
let actorWeak ((aid, body), _) = do
activeItems <- activeItemsClient aid
condMeleeBad <- condMeleeBadM aid
threatDistL <- threatDistList aid
fleeL <- fleeList False aid
let condThreatAdj =
not $ null $ takeWhile ((== 1) . fst) threatDistL
condFastThreatAdj =
any (\(_, (_, b)) ->
bspeed b activeItems > bspeed body activeItems)
$ takeWhile ((== 1) . fst) threatDistL
condCanFlee = not (null fleeL || condFastThreatAdj)
heavilyDistressed =
deltaSerious (bcalmDelta body)
return $! if condThreatAdj
then condMeleeBad && condCanFlee
else heavilyDistressed
actorHearning (_, (TEnemyPos{}, (_, (_, d)))) | d <= 2 =
return False
actorHearning ((_aid, b), _) = do
allFoes <- getsState $ actorRegularList (isAtWar fact) (blid b)
let closeFoes = filter ((<= 3) . chessDist (bpos b) . bpos) allFoes
mildlyDistressed = deltaMild (bcalmDelta b)
return $! mildlyDistressed
&& null closeFoes
actorMeleeing ((aid, _), _) = condAnyFoeAdjM aid
oursWeak <- filterM actorWeak oursTgt
oursStrong <- filterM (fmap not . actorWeak) oursTgt
oursMeleeing <- filterM actorMeleeing oursStrong
oursNotMeleeing <- filterM (fmap not . actorMeleeing) oursStrong
oursHearing <- filterM actorHearning oursNotMeleeing
oursNotHearing <- filterM (fmap not . actorHearning) oursNotMeleeing
let targetTEnemy (_, (TEnemy{}, _)) = True
targetTEnemy (_, (TEnemyPos{}, _)) = True
targetTEnemy _ = False
(oursTEnemy, oursOther) = partition targetTEnemy oursNotHearing
targetBlocked our@((_aid, _b), (_tgt, (path, _etc))) =
let next = case path of
[] -> assert `failure` our
[_goal] -> Nothing
_ : q : _ -> Just q
in any ((== next) . Just . bpos . snd) ours
(oursBlocked, oursPos) = partition targetBlocked oursOther
overheadOurs :: ((ActorId, Actor), (Target, PathEtc))
-> (Int, Int, Bool)
overheadOurs our@((aid, b), (_, (_, (goal, d)))) =
if targetTEnemy our then
( d + if targetBlocked our then 2 else 0
, 10 * (fromIntegral $ bhp b `div` (10 * oneM))
, aid /= oldAid )
else
let
minSpread = 7
maxSpread = 12 * 2
dcaptain p =
chessDistVector $ bpos captainBody `vectorToFrom` p
dsergeant p =
chessDistVector $ bpos sergeantBody `vectorToFrom` p
minDist | aid == captain = dsergeant (bpos b)
| aid == sergeant = dcaptain (bpos b)
| otherwise = dsergeant (bpos b)
`min` dcaptain (bpos b)
pDist p = dcaptain p + dsergeant p
sumDist = pDist (bpos b)
diffDist = sumDist pDist goal
minCoeff | minDist < minSpread =
(minDist minSpread) `div` 3
if aid == oldAid then 3 else 0
| otherwise = 0
explorationValue = diffDist * (sumDist `div` 4)
sumCoeff | sumDist > maxSpread = explorationValue
| otherwise = 0
in ( if d == 0 then d
else max 1 $ minCoeff + if d < 10
then 3 + d `div` 4
else 9 + d `div` 10
, sumCoeff
, aid /= oldAid )
sortOurs = sortBy $ comparing overheadOurs
goodGeneric ((aid, b), (_tgt, _pathEtc)) =
not (aid == oldAid && waitedLastTurn b)
goodTEnemy our@((_aid, b), (TEnemy{}, (_path, (goal, _d)))) =
not (adjacent (bpos b) goal)
&& goodGeneric our
goodTEnemy our = goodGeneric our
oursWeakGood = filter goodTEnemy oursWeak
oursTEnemyGood = filter goodTEnemy oursTEnemy
oursPosGood = filter goodGeneric oursPos
oursMeleeingGood = filter goodGeneric oursMeleeing
oursHearingGood = filter goodTEnemy oursHearing
oursBlockedGood = filter goodGeneric oursBlocked
candidates = [ sortOurs oursWeakGood
, sortOurs oursTEnemyGood
, sortOurs oursPosGood
, sortOurs oursMeleeingGood
, sortOurs oursHearingGood
, sortOurs oursBlockedGood
]
case filter (not . null) candidates of
l@(c : _) : _ -> do
let best = takeWhile ((== overheadOurs c) . overheadOurs) l
freq = uniformFreq "candidates for AI leader" best
((aid, b), _) <- rndToAction $ frequency freq
s <- getState
modifyClient $ updateLeader aid s
return (aid, b)
_ -> return (oldAid, oldBody)