-- | 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 :: m State
getState = (State -> State) -> m State
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> State
forall a. a -> a
id

getLevel :: MonadStateRead m => LevelId -> m Level
getLevel :: LevelId -> m Level
getLevel LevelId
lid = (State -> Level) -> m Level
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 :: m ModeKind
getGameMode = do
  COps{ContentData ModeKind
comode :: COps -> ContentData ModeKind
comode :: ContentData ModeKind
comode} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  ContentId ModeKind
gameModeId <- (State -> ContentId ModeKind) -> m (ContentId ModeKind)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> ContentId ModeKind
sgameModeId
  ModeKind -> m ModeKind
forall (m :: * -> *) a. Monad m => a -> m a
return (ModeKind -> m ModeKind) -> ModeKind -> m ModeKind
forall a b. (a -> b) -> a -> b
$! ContentData ModeKind -> ContentId ModeKind -> ModeKind
forall a. ContentData a -> ContentId a -> a
okind ContentData ModeKind
comode ContentId ModeKind
gameModeId

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

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

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

displayTaunt :: MonadStateRead m
             => Bool -> (Rnd (Text, Text) -> m (Text, Text))
             -> ActorId -> m (Text, Text)
displayTaunt :: Bool
-> (Rnd (Text, Text) -> m (Text, Text))
-> ActorId
-> m (Text, Text)
displayTaunt Bool
_voluntary Rnd (Text, Text) -> m (Text, Text)
rndToAction ActorId
aid = do
  Actor
b <- (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
  Skills
actorMaxSk <- (State -> Skills) -> m Skills
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Skills) -> m Skills) -> (State -> Skills) -> m Skills
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Skills
getActorMaxSkills ActorId
aid
  let canApply :: Bool
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 :: Bool
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 :: Bool
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, (Text, Text))]
braceUneasy = [ (Int
2, (Text
"something", Text
"flail around"))
                    , (Int
1, (Text
"something", Text
"toss blindly"))
                    , (Int
1, (Text
"something", Text
"squirm dizzily")) ]
      braceEasy :: [(Int, (Text, Text))]
braceEasy = [ (Int
2, (Text
"something", Text
"stretch"))
                  , (Int
1, (Text
"something", Text
"fidget"))
                  , (Int
1, (Text
"something", Text
"fret")) ]
      uneasy :: Bool
uneasy = ResDelta -> Bool
deltasSerious (Actor -> ResDelta
bcalmDelta Actor
b) Bool -> Bool -> Bool
|| Bool -> Bool
not (Actor -> Skills -> Bool
calmEnough Actor
b Skills
actorMaxSk)
  if Actor -> Watchfulness
bwatch Actor
b Watchfulness -> [Watchfulness] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Watchfulness
WSleep, Watchfulness
WWake]
  then Rnd (Text, Text) -> m (Text, Text)
rndToAction (Rnd (Text, Text) -> m (Text, Text))
-> Rnd (Text, Text) -> m (Text, Text)
forall a b. (a -> b) -> a -> b
$ Frequency (Text, Text) -> Rnd (Text, Text)
forall a. Show a => Frequency a -> Rnd a
frequency (Frequency (Text, Text) -> Rnd (Text, Text))
-> Frequency (Text, Text) -> Rnd (Text, Text)
forall a b. (a -> b) -> a -> b
$ Text -> [(Int, (Text, Text))] -> Frequency (Text, Text)
forall a. Text -> [(Int, a)] -> Frequency a
toFreq Text
"SfxTaunt" ([(Int, (Text, Text))] -> Frequency (Text, Text))
-> [(Int, (Text, Text))] -> Frequency (Text, Text)
forall a b. (a -> b) -> a -> b
$
    if Bool
uneasy
    then if | Bool
canApply -> (Int
5, (Text
"somebody", Text
"yell"))
                          (Int, (Text, Text))
-> [(Int, (Text, Text))] -> [(Int, (Text, Text))]
forall a. a -> [a] -> [a]
: (Int
3, (Text
"somebody", Text
"bellow"))
                          (Int, (Text, Text))
-> [(Int, (Text, Text))] -> [(Int, (Text, Text))]
forall a. a -> [a] -> [a]
: [(Int, (Text, Text))]
braceUneasy
            | Bool
canHear -> (Int
5, (Text
"somebody", Text
"bellow"))
                         (Int, (Text, Text))
-> [(Int, (Text, Text))] -> [(Int, (Text, Text))]
forall a. a -> [a] -> [a]
: (Int
3, (Text
"something", Text
"hiss"))
                         (Int, (Text, Text))
-> [(Int, (Text, Text))] -> [(Int, (Text, Text))]
forall a. a -> [a] -> [a]
: [(Int, (Text, Text))]
braceUneasy
            | Bool
canBrace -> [(Int, (Text, Text))]
braceUneasy
            | Bool
otherwise -> [(Int
1, (Text
"something", Text
"drone enquiringly"))]
    else if | Bool
canApply -> (Int
5, (Text
"somebody", Text
"yawn"))
                          (Int, (Text, Text))
-> [(Int, (Text, Text))] -> [(Int, (Text, Text))]
forall a. a -> [a] -> [a]
: (Int
3, (Text
"somebody", Text
"grunt"))
                          (Int, (Text, Text))
-> [(Int, (Text, Text))] -> [(Int, (Text, Text))]
forall a. a -> [a] -> [a]
: [(Int, (Text, Text))]
braceEasy
            | Bool
canHear -> (Int
5, (Text
"somebody", Text
"grunt"))
                         (Int, (Text, Text))
-> [(Int, (Text, Text))] -> [(Int, (Text, Text))]
forall a. a -> [a] -> [a]
: (Int
3, (Text
"something", Text
"wheeze"))
                         (Int, (Text, Text))
-> [(Int, (Text, Text))] -> [(Int, (Text, Text))]
forall a. a -> [a] -> [a]
: [(Int, (Text, Text))]
braceEasy
            | Bool
canBrace -> [(Int, (Text, Text))]
braceEasy
            | Bool
otherwise -> [(Int
1, (Text
"something", Text
"hum silently"))]
  else (Text, Text) -> m (Text, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Text, Text) -> m (Text, Text)) -> (Text, Text) -> m (Text, Text)
forall a b. (a -> b) -> a -> b
$!
    if | Actor -> Bool
bproj Actor
b -> (Text
"something", Text
"ping")
       | Bool
canApply -> (Text
"somebody", Text
"holler a taunt")
       | Bool
canHear -> (Text
"somebody", Text
"growl menacingly")
       | Bool
canBrace -> (Text
"something", Text
"stomp repeatedly")
       | Bool
otherwise -> (Text
"something", Text
"buzz angrily")