module Game.LambdaHack.Client.ClientSem where
import Control.Monad
import Control.Monad.Writer.Strict (runWriterT)
import qualified Data.EnumMap.Strict as EM
import qualified Data.Map.Strict as M
import Data.Maybe
import qualified Data.Text as T
import Game.LambdaHack.Client.Action
import Game.LambdaHack.Client.Binding
import Game.LambdaHack.Client.Draw
import Game.LambdaHack.Client.HumanCmd
import Game.LambdaHack.Client.HumanLocal
import Game.LambdaHack.Client.HumanSem
import Game.LambdaHack.Client.RunAction
import Game.LambdaHack.Client.State
import Game.LambdaHack.Client.Strategy
import Game.LambdaHack.Client.StrategyAction
import qualified Game.LambdaHack.Common.Ability as Ability
import Game.LambdaHack.Common.Action
import Game.LambdaHack.Common.Actor
import Game.LambdaHack.Common.ActorState
import Game.LambdaHack.Common.Faction
import Game.LambdaHack.Common.Item
import qualified Game.LambdaHack.Common.Key as K
import qualified Game.LambdaHack.Common.Kind as Kind
import Game.LambdaHack.Common.Level
import Game.LambdaHack.Common.Msg
import Game.LambdaHack.Common.Perception
import Game.LambdaHack.Common.Point
import Game.LambdaHack.Common.Random
import Game.LambdaHack.Common.ServerCmd
import Game.LambdaHack.Common.State
import Game.LambdaHack.Common.Vector
import Game.LambdaHack.Content.FactionKind
import Game.LambdaHack.Content.RuleKind
import Control.Exception.Assert.Sugar
import Game.LambdaHack.Utils.Frequency
queryAI :: MonadClient m => ActorId -> m CmdSerTakeTime
queryAI oldAid = do
Kind.COps{cofaction=Kind.Ops{okind}, corule} <- getsState scops
side <- getsClient sside
fact <- getsState $ \s -> sfactionD s EM.! side
let abilityLeader = fAbilityLeader $ okind $ gkind fact
abilityOther = fAbilityOther $ okind $ gkind fact
mleader <- getsClient _sleader
if
mleader /= Just oldAid
|| abilityLeader == abilityOther
|| Ability.Melee `notElem` abilityOther
then queryAIPick oldAid
else do
fper <- getsClient sfper
oldBody <- getsState $ getActorBody oldAid
oldAis <- getsState $ getActorItem oldAid
btarget <- getsClient $ getTarget oldAid
let arena = blid oldBody
foes <- getsState $ actorNotProjList (isAtWar fact) arena
ours <- getsState $ actorNotProjAssocs (== side) arena
time <- getsState $ getLocalTime arena
Level{lxsize, lysize} <- getsState $ \s -> sdungeon s EM.! arena
actorD <- getsState sactorD
let oldPos = bpos oldBody
per = fper EM.! arena
posOnLevel b | blid b /= arena = Nothing
| otherwise = Just $ bpos b
mfoePos foe = maybe Nothing posOnLevel
$ EM.lookup foe actorD
canSee foe = maybe False (actorSeesPos per oldAid) $ mfoePos foe
isAmmo i = jsymbol i `elem` ritemProject (Kind.stdRuleset corule)
hasAmmo = any (isAmmo . snd) oldAis
isAdjacent = foesAdjacent lxsize lysize oldPos foes
if
length ours == 1
|| case btarget of
Just (TEnemy foe _) ->
canSee foe && hasAmmo && not isAdjacent
_ -> False
|| bpos oldBody == boldpos oldBody
&& not (waitedLastTurn oldBody time)
then queryAIPick oldAid
else do
let countMinFoeDist (aid, b) =
let distB = chessDist lxsize (bpos b)
foeDist = map (distB . bpos) foes
minFoeDist | null foeDist = maxBound
| otherwise = minimum foeDist
in ((aid, b), minFoeDist)
oursMinFoeDist = map countMinFoeDist ours
inMelee (_, minFoeDist) = minFoeDist == 1
oursMeleePos = map (bpos . snd . fst)
$ filter inMelee oursMinFoeDist
let f ((aid, b), minFoeDist) =
let distB = chessDist lxsize (bpos b)
meleeDist = map distB oursMeleePos
minMeleeDist | null meleeDist = maxBound
| otherwise = minimum meleeDist
proximityMelee = max 0 $ 10 minMeleeDist
proximityFoe = max 0 $ 20 minFoeDist
distToLeader = distB oldPos
proximityLeader = max 0 $ 10 distToLeader
in if minFoeDist == 1
|| bhp b <= 0
|| aid == oldAid && waitedLastTurn b time
then
Nothing
else
Just ( 1
+ proximityMelee * 9
+ proximityFoe * 6
+ proximityLeader * 3
, aid )
candidates = mapMaybe f oursMinFoeDist
freq | null candidates = toFreq "old leader" [(1, oldAid)]
| otherwise = toFreq "candidates for AI leader" candidates
aid <- rndToAction $ frequency freq
s <- getState
modifyClient $ updateLeader aid s
queryAIPick aid
queryAIPick :: MonadClient m => ActorId -> m CmdSerTakeTime
queryAIPick aid = do
Kind.COps{cofaction=Kind.Ops{okind}} <- getsState scops
side <- getsClient sside
body <- getsState $ getActorBody aid
assert (bfid body == side `blame` "AI tries to move enemy actor"
`twith` (aid, bfid body, side)) skip
mleader <- getsClient _sleader
fact <- getsState $ (EM.! bfid body) . sfactionD
let factionAbilities
| Just aid == mleader = fAbilityLeader $ okind $ gkind fact
| otherwise = fAbilityOther $ okind $ gkind fact
unless (bproj body) $ do
stratTarget <- targetStrategy aid factionAbilities
btarget <- rndToAction $ frequency $ bestVariant stratTarget
let _debug = T.unpack
$ "\nHandleAI abilities:" <+> showT factionAbilities
<> ", symbol:" <+> showT (bsymbol body)
<> ", aid:" <+> showT aid
<> ", pos:" <+> showT (bpos body)
<> "\nHandleAI starget:" <+> showT stratTarget
<> "\nHandleAI target:" <+> showT btarget
modifyClient $ updateTarget aid (const btarget)
stratAction <- actionStrategy aid factionAbilities
action <- rndToAction $ frequency $ bestVariant stratAction
let _debug = T.unpack
$ "HandleAI saction:" <+> showT stratAction
<> "\nHandleAI action:" <+> showT action
return action
queryUI :: (MonadClientAbort m, MonadClientUI m) => ActorId -> m CmdSer
queryUI aid = do
leader <- getLeaderUI
assert (leader == aid `blame` "player moves not his leader"
`twith` (leader, aid)) skip
let inputHumanCmd msg = do
stopRunning
humanCommand msg
tryWith inputHumanCmd $ do
srunning <- getsClient srunning
maybe abort (continueRun leader) srunning
continueRun :: MonadClientAbort m => ActorId -> (Vector, Int) -> m CmdSer
continueRun leader dd = do
(dir, distNew) <- continueRunDir leader dd
modifyClient $ \cli -> cli {srunning = Just (dir, distNew)}
return $ TakeTimeSer $ MoveSer leader dir
humanCommand :: forall m. (MonadClientAbort m, MonadClientUI m)
=> Msg
-> m CmdSer
humanCommand msgRunAbort = do
let loop :: Overlay -> m CmdSer
loop overlay = do
km <- getKeyOverlayCommand overlay
recordHistory
(mcmdS, slides) <- runWriterT $ tryWithSlide (return Nothing) $ do
Binding{kcmd} <- askBinding
case M.lookup km kcmd of
Just (_, _, cmd) -> do
lastKey <- getsClient slastKey
modifyClient (\st -> st {slastKey = Just km})
cmdHumanSem $ if Just km == lastKey
then Clear
else cmd
Nothing -> let msgKey = "unknown command <" <> K.showKM km <> ">"
in abortWith msgKey
case mcmdS of
Just cmdS -> do
assert (null (runSlideshow slides)
`blame` "some slides generated for server command"
`twith` slides) skip
modifyClient (\st -> st {slastKey = Nothing})
return cmdS
Nothing -> do
mLast <- case reverse (runSlideshow slides) of
[] -> return Nothing
[sLast] -> return $ Just sLast
sls@(sLast : _) -> do
go <- getInitConfirms ColorFull [km] $ toSlideshow $ reverse sls
return $! if go then Just sLast else Nothing
case mLast of
Nothing -> do
modifyClient (\st -> st {slastKey = Nothing})
sli <- promptToSlideshow ""
loop $! head $! runSlideshow sli
Just sLast ->
loop sLast
sli <- promptToSlideshow msgRunAbort
let overlayInitial = head $ runSlideshow sli
loop overlayInitial