module Game.LambdaHack.Client.ClientSem where
import Control.Monad
import Control.Monad.Writer.Strict (WriterT, 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.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 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.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.StrategyKind
import Game.LambdaHack.Utils.Assert
import Game.LambdaHack.Utils.Frequency
queryAI :: MonadClient m => ActorId -> m CmdSer
queryAI oldAid = do
Kind.COps{costrat=Kind.Ops{okind}} <- getsState scops
side <- getsClient sside
fact <- getsState $ \s -> sfactionD s EM.! side
let aiMember = fmap okind $ gAiMember fact
mleader <- getsClient _sleader
if
mleader /= Just oldAid
|| gAiLeader fact == gAiMember fact
|| Ability.Melee `notElem` maybe [] sabilities aiMember
then queryAIPick oldAid
else do
fper <- getsClient sfper
visFoes <- visibleFoes fper oldAid
oldBody <- getsState $ getActorBody oldAid
btarget <- getsClient $ getTarget oldAid
let arena = blid oldBody
ours <- getsState $ actorNotProjAssocs (== side) arena
Level{lxsize} <- getsState $ \s -> sdungeon s EM.! arena
if
length ours == 1
|| case btarget of Just TEnemy{} -> True; _ -> False
&& all (not . adjacent lxsize (bpos oldBody))
(map (bpos . snd) visFoes)
then queryAIPick oldAid
else do
foes <- getsState $ actorNotProjAssocs (isAtWar fact) arena
let f (aid, b) =
let distB = chessDist lxsize (bpos b)
foeDist = map (\(_, body) -> distB (bpos body)) foes
minDist | null foeDist = maxBound
| otherwise = minimum foeDist
maxChaseDist = 30
maxProximity = max 1 $ maxChaseDist minDist
in if aid == oldAid || minDist == 1
then Nothing
else Just (maxProximity, aid)
candidates = mapMaybe f ours
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 CmdSer
queryAIPick aid = do
side <- getsClient sside
body <- getsState $ getActorBody aid
assert (bfid body == side `blame` (aid, bfid body, side)) skip
Kind.COps{costrat=Kind.Ops{okind}} <- getsState scops
leader <- getsClient _sleader
fact <- getsState $ (EM.! bfid body) . sfactionD
let factionAI | Just aid /= leader = fromJust $ gAiMember fact
| otherwise = fromJust $ gAiLeader fact
factionAbilities = sabilities (okind factionAI)
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` (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 $ RunSer 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 -> assert (null (runSlideshow slides) `blame` slides) $ do
modifyClient (\st -> st {slastKey = Nothing})
return cmdS
Nothing -> do
mLast <- case reverse (runSlideshow slides) of
[] -> return Nothing
[sLast] -> return $ Just sLast
sls@(sLast : _) -> do
b <- getInitConfirms [km] $ toSlideshow $ reverse sls
return $! if b 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