-- | Game state reading monad and basic operations.
module Game.LambdaHack.Common.MonadStateRead
  ( MonadStateRead(..)
  , getState, getLevel
  , getGameMode, isNoConfirmsGame, getEntryArena, pickWeaponM, displayTaunt
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import           Data.Either
import qualified Data.EnumMap.Strict as EM

import           Game.LambdaHack.Common.Actor
import           Game.LambdaHack.Common.ActorState
import           Game.LambdaHack.Common.Faction
import           Game.LambdaHack.Common.Item
import           Game.LambdaHack.Common.Kind
import           Game.LambdaHack.Common.Level
import           Game.LambdaHack.Common.ReqFailure
import           Game.LambdaHack.Common.State
import           Game.LambdaHack.Common.Types
import           Game.LambdaHack.Content.ModeKind
import           Game.LambdaHack.Core.Frequency
import           Game.LambdaHack.Core.Random
import qualified Game.LambdaHack.Definition.Ability as Ability

-- | Monad for reading game state. A state monad with state modification
-- disallowed (another constraint is needed to permit that).
-- The basic server and client monads are like that, because server
-- and clients freely modify their internal session data, but don't modify
-- the main game state, except in very restricted and synchronized way.
class (Monad m, Functor m, Applicative m) => MonadStateRead m where
  getsState :: (State -> a) -> m a

getState :: MonadStateRead m => m State
getState :: forall (m :: * -> *). MonadStateRead m => m State
getState = (State -> State) -> m State
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> State
forall a. a -> a
id

getLevel :: MonadStateRead m => LevelId -> m Level
getLevel :: forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel LevelId
lid = (State -> Level) -> m Level
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Level) -> m Level) -> (State -> Level) -> m Level
forall a b. (a -> b) -> a -> b
$ (EnumMap LevelId Level -> LevelId -> Level
forall k a. Enum k => EnumMap k a -> k -> a
EM.! LevelId
lid) (EnumMap LevelId Level -> Level)
-> (State -> EnumMap LevelId Level) -> State -> Level
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap LevelId Level
sdungeon

getGameMode :: MonadStateRead m => m ModeKind
getGameMode :: forall (m :: * -> *). MonadStateRead m => m ModeKind
getGameMode = do
  COps{comode} <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  gameModeId <- getsState sgameModeId
  return $! okind comode gameModeId

isNoConfirmsGame :: MonadStateRead m => m Bool
isNoConfirmsGame :: forall (m :: * -> *). MonadStateRead m => m Bool
isNoConfirmsGame = do
  gameMode <- m ModeKind
forall (m :: * -> *). MonadStateRead m => m ModeKind
getGameMode
  return $! mattract gameMode

getEntryArena :: MonadStateRead m => Faction -> m LevelId
getEntryArena :: forall (m :: * -> *). MonadStateRead m => Faction -> m LevelId
getEntryArena Faction
fact = do
  dungeon <- (State -> EnumMap LevelId Level) -> m (EnumMap LevelId Level)
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> EnumMap LevelId Level
sdungeon
  let (minD, maxD) = dungeonBounds dungeon
      f [] = a
0
      f ((a
ln, b
_, c
_) : [(a, b, c)]
_) = a
ln
  return $! max minD $ min maxD $ toEnum $ f $ ginitial fact

pickWeaponM :: MonadStateRead m
            => Bool -> Maybe DiscoveryBenefit
            -> [(ItemId, ItemFullKit)] -> Ability.Skills -> ActorId
            -> m [(Double, Bool, Int, Int, ItemId, ItemFullKit)]
pickWeaponM :: forall (m :: * -> *).
MonadStateRead m =>
Bool
-> Maybe DiscoveryBenefit
-> [(ItemId, ItemFullKit)]
-> Skills
-> ActorId
-> m [(Double, Bool, Int, Int, ItemId, ItemFullKit)]
pickWeaponM Bool
ignoreCharges Maybe DiscoveryBenefit
mdiscoBenefit [(ItemId, ItemFullKit)]
kitAss Skills
actorSk ActorId
source = do
  sb <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
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
source
  localTime <- getsState $ getLocalTime (blid sb)
  actorMaxSk <- getsState $ getActorMaxSkills source
  let calmE = Actor -> Skills -> Bool
calmEnough Actor
sb Skills
actorMaxSk
      forced = Actor -> Bool
bproj Actor
sb
      permitted = Bool -> Bool -> ItemFull -> Either ReqFailure Bool
permittedPrecious Bool
forced Bool
calmE
      preferredPrecious = Bool -> Either ReqFailure Bool -> Bool
forall b a. b -> Either a b -> b
fromRight Bool
False (Either ReqFailure Bool -> Bool)
-> (ItemFull -> Either ReqFailure Bool) -> ItemFull -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ItemFull -> Either ReqFailure Bool
permitted
      permAssocs = ((ItemId, ItemFullKit) -> Bool)
-> [(ItemId, ItemFullKit)] -> [(ItemId, ItemFullKit)]
forall a. (a -> Bool) -> [a] -> [a]
filter (ItemFull -> Bool
preferredPrecious (ItemFull -> Bool)
-> ((ItemId, ItemFullKit) -> ItemFull)
-> (ItemId, ItemFullKit)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ItemFullKit -> ItemFull
forall a b. (a, b) -> a
fst (ItemFullKit -> ItemFull)
-> ((ItemId, ItemFullKit) -> ItemFullKit)
-> (ItemId, ItemFullKit)
-> ItemFull
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ItemId, ItemFullKit) -> ItemFullKit
forall a b. (a, b) -> b
snd) [(ItemId, ItemFullKit)]
kitAss
      strongest = Bool
-> Maybe DiscoveryBenefit
-> Time
-> [(ItemId, ItemFullKit)]
-> [(Double, Bool, Int, Int, ItemId, ItemFullKit)]
strongestMelee Bool
ignoreCharges Maybe DiscoveryBenefit
mdiscoBenefit
                                 Time
localTime [(ItemId, ItemFullKit)]
permAssocs
  return $! if | forced -> map (\(ItemId
iid, ItemFullKit
itemFullKit) ->
                                  (-Double
1, Bool
False, Int
0, Int
1, ItemId
iid, ItemFullKit
itemFullKit)) kitAss
               | Ability.getSk Ability.SkMelee actorSk <= 0 -> []
               | otherwise -> strongest

displayTaunt :: MonadStateRead m
             => Bool -> (Rnd (Text, Text) -> m (Text, Text))
             -> ActorId -> m (Text, Text)
displayTaunt :: forall (m :: * -> *).
MonadStateRead m =>
Bool
-> (Rnd (Text, Text) -> m (Text, Text))
-> ActorId
-> m (Text, Text)
displayTaunt Bool
_voluntary Rnd (Text, Text) -> m (Text, Text)
rndToAction ActorId
aid = do
  b <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
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
  actorMaxSk <- getsState $ getActorMaxSkills aid
  let canApply = Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkApply Skills
actorMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
2
                 Bool -> Bool -> Bool
&& Bool
canHear
        -- if applies complex items, probably intelligent and can speak
      canHear = Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkHearing Skills
actorMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
                Bool -> Bool -> Bool
&& Bool
canBrace
        -- if hears, probably also emits sound vocally;
        -- disabled even by ushanka and rightly so
      canBrace = Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkWait Skills
actorMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2
        -- not an insect, plant, geyser, faucet, fence, etc.
        -- so can emit sound by hitting something with body parts
                 Bool -> Bool -> Bool
|| Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkApply Skills
actorMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
2
                      -- and neither an impatient intelligent actor
      braceUneasy = [ (Int
2, (Text
"something", Text
"flail around"))
                    , (Int
1, (Text
"something", Text
"toss blindly"))
                    , (Int
1, (Text
"something", Text
"squirm dizzily")) ]
      braceEasy = [ (Int
2, (Text
"something", Text
"stretch"))
                  , (Int
1, (Text
"something", Text
"fidget"))
                  , (Int
1, (Text
"something", Text
"fret")) ]
      uneasy = ResDelta -> Bool
deltasSerious (Actor -> ResDelta
bcalmDelta Actor
b) Bool -> Bool -> Bool
|| Bool -> Bool
not (Actor -> Skills -> Bool
calmEnough Actor
b Skills
actorMaxSk)
  if bwatch b `elem` [WSleep, WWake]
  then rndToAction $ frequency $ toFreq "SfxTaunt" $
    if uneasy
    then if | canApply -> (5, ("somebody", "yell"))
                          : (3, ("somebody", "bellow"))
                          : braceUneasy
            | canHear -> (5, ("somebody", "bellow"))
                         : (3, ("something", "hiss"))
                         : braceUneasy
            | canBrace -> braceUneasy
            | otherwise -> [(1, ("something", "drone enquiringly"))]
    else if | canApply -> (5, ("somebody", "yawn"))
                          : (3, ("somebody", "grunt"))
                          : braceEasy
            | canHear -> (5, ("somebody", "grunt"))
                         : (3, ("something", "wheeze"))
                         : braceEasy
            | canBrace -> braceEasy
            | otherwise -> [(1, ("something", "hum silently"))]
  else return $!
    if | bproj b -> ("something", "ping")
       | canApply -> ("somebody", "holler a taunt")
       | canHear -> ("somebody", "growl menacingly")
       | canBrace -> ("something", "stomp repeatedly")
       | otherwise -> ("something", "buzz angrily")