-- | Ways for the client to use AI to produce server requests, based on
-- the client's view of the game state.
module Game.LambdaHack.Client.AI
  ( queryAI
#ifdef EXPOSE_INTERNAL
    -- * Internal operations
  , pickActorAndAction
#endif
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import qualified Data.EnumMap.Strict as EM

import Game.LambdaHack.Client.AI.PickActionM
import Game.LambdaHack.Client.AI.PickActorM
import Game.LambdaHack.Client.MonadClient
import Game.LambdaHack.Client.Request
import Game.LambdaHack.Client.State
import Game.LambdaHack.Common.Actor
import Game.LambdaHack.Common.ActorState
import Game.LambdaHack.Common.Faction
import Game.LambdaHack.Common.MonadStateRead
import Game.LambdaHack.Common.Point
import Game.LambdaHack.Common.State
import Game.LambdaHack.Common.Time
import Game.LambdaHack.Common.Types

-- | Handle the move of an actor under AI control (regardless if the whole
-- faction is under human or computer control).
queryAI :: MonadClient m => ActorId -> m RequestAI
queryAI :: ActorId -> m RequestAI
queryAI aid :: ActorId
aid = do
  -- @sleader@ may be different from @gleader@ due to @stopPlayBack@,
  -- but only leaders may change faction leader, so we fix that beforehand:
  Actor
body <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
  [(ActorId, Actor)]
foeAssocs <- (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)])
-> (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
forall a b. (a -> b) -> a -> b
$ FactionId -> LevelId -> State -> [(ActorId, Actor)]
foeRegularAssocs (Actor -> FactionId
bfid Actor
body) (Actor -> LevelId
blid Actor
body)
  [(ActorId, Actor)]
friendAssocs <- (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)])
-> (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
forall a b. (a -> b) -> a -> b
$ FactionId -> LevelId -> State -> [(ActorId, Actor)]
friendRegularAssocs (Actor -> FactionId
bfid Actor
body) (Actor -> LevelId
blid Actor
body)
  Maybe ActorId
mleader <- (State -> Maybe ActorId) -> m (Maybe ActorId)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Maybe ActorId) -> m (Maybe ActorId))
-> (State -> Maybe ActorId) -> m (Maybe ActorId)
forall a b. (a -> b) -> a -> b
$ Faction -> Maybe ActorId
gleader (Faction -> Maybe ActorId)
-> (State -> Faction) -> State -> Maybe ActorId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
body) (EnumMap FactionId Faction -> Faction)
-> (State -> EnumMap FactionId Faction) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap FactionId Faction
sfactionD
  Maybe ActorId
mleaderCli <- (StateClient -> Maybe ActorId) -> m (Maybe ActorId)
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Maybe ActorId
sleader
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ActorId -> Maybe ActorId
forall a. a -> Maybe a
Just ActorId
aid Maybe ActorId -> Maybe ActorId -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe ActorId
mleader Bool -> Bool -> Bool
|| Maybe ActorId
mleader Maybe ActorId -> Maybe ActorId -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe ActorId
mleaderCli) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
    -- @aid@ is not the leader, so he can't change leader later on,
    -- so we match the leaders here
    (StateClient -> StateClient) -> m ()
forall (m :: * -> *).
MonadClient m =>
(StateClient -> StateClient) -> m ()
modifyClient ((StateClient -> StateClient) -> m ())
-> (StateClient -> StateClient) -> m ()
forall a b. (a -> b) -> a -> b
$ \cli :: StateClient
cli -> StateClient
cli {_sleader :: Maybe ActorId
_sleader = Maybe ActorId
mleader}
  (aidToMove :: ActorId
aidToMove, treq :: RequestTimed
treq, oldFlee :: Maybe (Point, Time)
oldFlee) <- [(ActorId, Actor)]
-> [(ActorId, Actor)]
-> Maybe ActorId
-> ActorId
-> m (ActorId, RequestTimed, Maybe (Point, Time))
forall (m :: * -> *).
MonadClient m =>
[(ActorId, Actor)]
-> [(ActorId, Actor)]
-> Maybe ActorId
-> ActorId
-> m (ActorId, RequestTimed, Maybe (Point, Time))
pickActorAndAction [(ActorId, Actor)]
foeAssocs [(ActorId, Actor)]
friendAssocs
                                                   Maybe ActorId
forall a. Maybe a
Nothing ActorId
aid
  let tryAgain :: m (ActorId, RequestTimed)
tryAgain = do
        -- Leader waits; a waste; try once to pick a yet different leader
        -- or at least a non-waiting action. Undo state changes in @pickAction@:
        (StateClient -> StateClient) -> m ()
forall (m :: * -> *).
MonadClient m =>
(StateClient -> StateClient) -> m ()
modifyClient ((StateClient -> StateClient) -> m ())
-> (StateClient -> StateClient) -> m ()
forall a b. (a -> b) -> a -> b
$ \cli :: StateClient
cli -> StateClient
cli
          { _sleader :: Maybe ActorId
_sleader = Maybe ActorId
mleader
          , sfleeD :: EnumMap ActorId (Point, Time)
sfleeD = (Maybe (Point, Time) -> Maybe (Point, Time))
-> ActorId
-> EnumMap ActorId (Point, Time)
-> EnumMap ActorId (Point, Time)
forall k a.
Enum k =>
(Maybe a -> Maybe a) -> k -> EnumMap k a -> EnumMap k a
EM.alter (Maybe (Point, Time) -> Maybe (Point, Time) -> Maybe (Point, Time)
forall a b. a -> b -> a
const Maybe (Point, Time)
oldFlee) ActorId
aidToMove (EnumMap ActorId (Point, Time) -> EnumMap ActorId (Point, Time))
-> EnumMap ActorId (Point, Time) -> EnumMap ActorId (Point, Time)
forall a b. (a -> b) -> a -> b
$ StateClient -> EnumMap ActorId (Point, Time)
sfleeD StateClient
cli }
        (a :: ActorId
a, t :: RequestTimed
t, _) <- [(ActorId, Actor)]
-> [(ActorId, Actor)]
-> Maybe ActorId
-> ActorId
-> m (ActorId, RequestTimed, Maybe (Point, Time))
forall (m :: * -> *).
MonadClient m =>
[(ActorId, Actor)]
-> [(ActorId, Actor)]
-> Maybe ActorId
-> ActorId
-> m (ActorId, RequestTimed, Maybe (Point, Time))
pickActorAndAction [(ActorId, Actor)]
foeAssocs [(ActorId, Actor)]
friendAssocs
                                        (ActorId -> Maybe ActorId
forall a. a -> Maybe a
Just ActorId
aidToMove) ActorId
aid
        (ActorId, RequestTimed) -> m (ActorId, RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return (ActorId
a, RequestTimed
t)
  (aidToMove2 :: ActorId
aidToMove2, treq2 :: RequestTimed
treq2) <-
    if Maybe ActorId
mleader Maybe ActorId -> Maybe ActorId -> Bool
forall a. Eq a => a -> a -> Bool
/= ActorId -> Maybe ActorId
forall a. a -> Maybe a
Just ActorId
aid
    then (ActorId, RequestTimed) -> m (ActorId, RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return (ActorId
aidToMove, RequestTimed
treq)
    else case RequestTimed
treq of
      ReqWait -> m (ActorId, RequestTimed)
tryAgain
      ReqYell -> m (ActorId, RequestTimed)
tryAgain
      _ -> (ActorId, RequestTimed) -> m (ActorId, RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return (ActorId
aidToMove, RequestTimed
treq)
  RequestAI -> m RequestAI
forall (m :: * -> *) a. Monad m => a -> m a
return ( RequestTimed -> ReqAI
ReqAITimed RequestTimed
treq2
         , if ActorId
aidToMove2 ActorId -> ActorId -> Bool
forall a. Eq a => a -> a -> Bool
/= ActorId
aid then ActorId -> Maybe ActorId
forall a. a -> Maybe a
Just ActorId
aidToMove2 else Maybe ActorId
forall a. Maybe a
Nothing )

-- | Pick an actor to move and an action for him to perform, given an optional
-- previous candidate actor and action and the server-proposed actor.
pickActorAndAction :: MonadClient m
                   => [(ActorId, Actor)] -> [(ActorId, Actor)]
                   -> Maybe ActorId -> ActorId
                   -> m (ActorId, RequestTimed, Maybe (Point, Time))
pickActorAndAction :: [(ActorId, Actor)]
-> [(ActorId, Actor)]
-> Maybe ActorId
-> ActorId
-> m (ActorId, RequestTimed, Maybe (Point, Time))
pickActorAndAction foeAssocs :: [(ActorId, Actor)]
foeAssocs friendAssocs :: [(ActorId, Actor)]
friendAssocs maid :: Maybe ActorId
maid aid :: ActorId
aid = do
  Maybe ActorId
mleader <- (StateClient -> Maybe ActorId) -> m (Maybe ActorId)
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Maybe ActorId
sleader
  ActorId
aidToMove <-
    if Maybe ActorId
mleader Maybe ActorId -> Maybe ActorId -> Bool
forall a. Eq a => a -> a -> Bool
== ActorId -> Maybe ActorId
forall a. a -> Maybe a
Just ActorId
aid
    then [(ActorId, Actor)]
-> [(ActorId, Actor)] -> Maybe ActorId -> m ActorId
forall (m :: * -> *).
MonadClient m =>
[(ActorId, Actor)]
-> [(ActorId, Actor)] -> Maybe ActorId -> m ActorId
pickActorToMove [(ActorId, Actor)]
foeAssocs [(ActorId, Actor)]
friendAssocs Maybe ActorId
maid
    else do
      [(ActorId, Actor)] -> [(ActorId, Actor)] -> ActorId -> m ()
forall (m :: * -> *).
MonadClient m =>
[(ActorId, Actor)] -> [(ActorId, Actor)] -> ActorId -> m ()
setTargetFromDoctrines [(ActorId, Actor)]
foeAssocs [(ActorId, Actor)]
friendAssocs ActorId
aid
      ActorId -> m ActorId
forall (m :: * -> *) a. Monad m => a -> m a
return ActorId
aid
  Maybe (Point, Time)
oldFlee <- (StateClient -> Maybe (Point, Time)) -> m (Maybe (Point, Time))
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient ((StateClient -> Maybe (Point, Time)) -> m (Maybe (Point, Time)))
-> (StateClient -> Maybe (Point, Time)) -> m (Maybe (Point, Time))
forall a b. (a -> b) -> a -> b
$ ActorId -> EnumMap ActorId (Point, Time) -> Maybe (Point, Time)
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup ActorId
aidToMove (EnumMap ActorId (Point, Time) -> Maybe (Point, Time))
-> (StateClient -> EnumMap ActorId (Point, Time))
-> StateClient
-> Maybe (Point, Time)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateClient -> EnumMap ActorId (Point, Time)
sfleeD
  -- Trying harder (@retry@) whenever no better leader found and so at least
  -- a non-waiting action should be found.
  -- If a new leader found, there is hope (but we don't check)
  -- that he gets a non-waiting action without any desperate measures.
  let retry :: Bool
retry = Bool -> (ActorId -> Bool) -> Maybe ActorId -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (ActorId
aidToMove ActorId -> ActorId -> Bool
forall a. Eq a => a -> a -> Bool
==) Maybe ActorId
maid
  RequestTimed
treq <- [(ActorId, Actor)]
-> [(ActorId, Actor)] -> ActorId -> Bool -> m RequestTimed
forall (m :: * -> *).
MonadClient m =>
[(ActorId, Actor)]
-> [(ActorId, Actor)] -> ActorId -> Bool -> m RequestTimed
pickAction [(ActorId, Actor)]
foeAssocs [(ActorId, Actor)]
friendAssocs ActorId
aidToMove Bool
retry
  (ActorId, RequestTimed, Maybe (Point, Time))
-> m (ActorId, RequestTimed, Maybe (Point, Time))
forall (m :: * -> *) a. Monad m => a -> m a
return (ActorId
aidToMove, RequestTimed
treq, Maybe (Point, Time)
oldFlee)