-- | Basic client monad and related operations.
module Game.LambdaHack.Client.MonadClient
  ( -- * Basic client monads
    MonadClientRead ( getsClient
                    , liftIO  -- exposed only to be implemented, not used
                    )
  , MonadClient(modifyClient)
    -- * Assorted primitives
  , getClient, putClient
  , debugPossiblyPrint, createTabBFS, dumpTextFile, rndToAction, condInMeleeM
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import           Control.Monad.ST.Strict (stToIO)
import qualified Control.Monad.Trans.State.Strict as St
import qualified Data.EnumMap.Strict as EM
import qualified Data.Primitive.PrimArray as PA
import qualified Data.Text.IO as T
import           System.FilePath
import           System.IO (hFlush, stdout)

import Game.LambdaHack.Client.State
import Game.LambdaHack.Common.ActorState
import Game.LambdaHack.Common.ClientOptions
import Game.LambdaHack.Common.File
import Game.LambdaHack.Common.Kind
import Game.LambdaHack.Common.Misc
import Game.LambdaHack.Common.MonadStateRead
import Game.LambdaHack.Common.Point
import Game.LambdaHack.Common.State
import Game.LambdaHack.Common.Types
import Game.LambdaHack.Content.RuleKind
import Game.LambdaHack.Core.Random

-- | Monad for reading client state.
class MonadStateRead m => MonadClientRead m where
  getsClient :: (StateClient -> a) -> m a
  -- We do not provide a MonadIO instance, so that outside
  -- nobody can subvert the action monads by invoking arbitrary IO.
  liftIO :: IO a -> m a

-- | Monad for writing to client state.
class MonadClientRead m => MonadClient m where
  modifyClient :: (StateClient -> StateClient) -> m ()

getClient :: MonadClientRead m => m StateClient
getClient :: m StateClient
getClient = (StateClient -> StateClient) -> m StateClient
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> StateClient
forall a. a -> a
id

putClient :: MonadClient m => StateClient -> m ()
putClient :: StateClient -> m ()
putClient s :: StateClient
s = (StateClient -> StateClient) -> m ()
forall (m :: * -> *).
MonadClient m =>
(StateClient -> StateClient) -> m ()
modifyClient (StateClient -> StateClient -> StateClient
forall a b. a -> b -> a
const StateClient
s)

debugPossiblyPrint :: MonadClient m => Text -> m ()
debugPossiblyPrint :: Text -> m ()
debugPossiblyPrint t :: Text
t = do
  Bool
sdbgMsgCli <- (StateClient -> Bool) -> m Bool
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient ((StateClient -> Bool) -> m Bool)
-> (StateClient -> Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ ClientOptions -> Bool
sdbgMsgCli (ClientOptions -> Bool)
-> (StateClient -> ClientOptions) -> StateClient -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateClient -> ClientOptions
soptions
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
sdbgMsgCli (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ IO () -> m ()
forall (m :: * -> *) a. MonadClientRead m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Handle -> Text -> IO ()
T.hPutStr Handle
stdout (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$! Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\n"  -- hPutStrLn not atomic enough
    Handle -> IO ()
hFlush Handle
stdout

createTabBFS :: MonadClient m => m (PA.PrimArray PointI)
createTabBFS :: m (PrimArray PointI)
createTabBFS = do
  COps{corule :: COps -> RuleContent
corule=RuleContent{PointI
rXmax :: RuleContent -> PointI
rXmax :: PointI
rXmax, PointI
rYmax :: RuleContent -> PointI
rYmax :: PointI
rYmax}} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  IO (PrimArray PointI) -> m (PrimArray PointI)
forall (m :: * -> *) a. MonadClientRead m => IO a -> m a
liftIO (IO (PrimArray PointI) -> m (PrimArray PointI))
-> IO (PrimArray PointI) -> m (PrimArray PointI)
forall a b. (a -> b) -> a -> b
$ ST RealWorld (PrimArray PointI) -> IO (PrimArray PointI)
forall a. ST RealWorld a -> IO a
stToIO (ST RealWorld (PrimArray PointI) -> IO (PrimArray PointI))
-> ST RealWorld (PrimArray PointI) -> IO (PrimArray PointI)
forall a b. (a -> b) -> a -> b
$ do
    MutablePrimArray RealWorld PointI
tabAMutable <- PointI
-> ST
     RealWorld (MutablePrimArray (PrimState (ST RealWorld)) PointI)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
PointI -> m (MutablePrimArray (PrimState m) a)
PA.newPrimArray (PointI
rXmax PointI -> PointI -> PointI
forall a. Num a => a -> a -> a
* PointI
rYmax)  -- always enough
    MutablePrimArray (PrimState (ST RealWorld)) PointI
-> ST RealWorld (PrimArray PointI)
forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
PA.unsafeFreezePrimArray MutablePrimArray RealWorld PointI
MutablePrimArray (PrimState (ST RealWorld)) PointI
tabAMutable

dumpTextFile :: MonadClientRead m => Text -> FilePath -> m FilePath
dumpTextFile :: Text -> FilePath -> m FilePath
dumpTextFile t :: Text
t filename :: FilePath
filename = IO FilePath -> m FilePath
forall (m :: * -> *) a. MonadClientRead m => IO a -> m a
liftIO (IO FilePath -> m FilePath) -> IO FilePath -> m FilePath
forall a b. (a -> b) -> a -> b
$ do
  FilePath
dataDir <- IO FilePath
appDataDir
  FilePath -> IO ()
tryCreateDir FilePath
dataDir
  let path :: FilePath
path = FilePath
dataDir FilePath -> FilePath -> FilePath
</> FilePath
filename
  FilePath -> Text -> IO ()
T.writeFile FilePath
path Text
t
  FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
path

-- | Invoke pseudo-random computation with the generator kept in the state.
rndToAction :: MonadClient m => Rnd a -> m a
rndToAction :: Rnd a -> m a
rndToAction r :: Rnd a
r = do
  SMGen
gen1 <- (StateClient -> SMGen) -> m SMGen
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> SMGen
srandom
  let (a :: a
a, gen2 :: SMGen
gen2) = Rnd a -> SMGen -> (a, SMGen)
forall s a. State s a -> s -> (a, s)
St.runState Rnd a
r SMGen
gen1
  (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 {srandom :: SMGen
srandom = SMGen
gen2}
  a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a

condInMeleeM :: MonadClient m => LevelId -> m Bool
condInMeleeM :: LevelId -> m Bool
condInMeleeM lid :: LevelId
lid = do
  EnumMap LevelId Bool
condInMelee <- (StateClient -> EnumMap LevelId Bool) -> m (EnumMap LevelId Bool)
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> EnumMap LevelId Bool
scondInMelee
  case LevelId -> EnumMap LevelId Bool -> Maybe Bool
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup LevelId
lid EnumMap LevelId Bool
condInMelee of
    Just inM :: Bool
inM -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
inM
    Nothing -> do
      FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
      ActorMaxSkills
actorMaxSkills <- (State -> ActorMaxSkills) -> m ActorMaxSkills
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> ActorMaxSkills
sactorMaxSkills
      Bool
inM <- (State -> Bool) -> m Bool
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Bool) -> m Bool) -> (State -> Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ ActorMaxSkills -> FactionId -> LevelId -> State -> Bool
inMelee ActorMaxSkills
actorMaxSkills FactionId
side LevelId
lid
      (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 {scondInMelee :: EnumMap LevelId Bool
scondInMelee = LevelId -> Bool -> EnumMap LevelId Bool -> EnumMap LevelId Bool
forall k a. Enum k => k -> a -> EnumMap k a -> EnumMap k a
EM.insert LevelId
lid Bool
inM EnumMap LevelId Bool
condInMelee}
      Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
inM