-- | 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, insertInMeleeM
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import qualified Control.Exception as Ex
import           Control.Monad.ST.Strict (stToIO)
import qualified Control.Monad.Trans.State.Strict as St
import qualified Data.EnumSet as ES
import qualified Data.Primitive.PrimArray as PA
import qualified Data.Text.IO as T
import           System.Directory
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 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 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
<> Text
"\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
rWidthMax :: RuleContent -> PointI
rWidthMax :: PointI
rWidthMax, PointI
rHeightMax :: RuleContent -> PointI
rHeightMax :: PointI
rHeightMax}} <- (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
rWidthMax PointI -> PointI -> PointI
forall a. Num a => a -> a -> a
* PointI
rHeightMax)  -- 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 Text
t 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
  (IOException -> IO ()) -> IO () -> IO ()
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
Ex.handle (\(IOException
_ :: Ex.IOException) -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    FilePath -> IO ()
removeFile FilePath
path
  FilePath -> Text -> IO ()
tryWriteFile 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 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, 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
$ \StateClient
cli -> StateClient
cli {srandom :: SMGen
srandom = SMGen
gen2}
  a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a

condInMeleeM :: MonadClientRead m => LevelId -> m Bool
condInMeleeM :: LevelId -> m Bool
condInMeleeM LevelId
lid = do
  EnumSet LevelId
condInMelee <- (StateClient -> EnumSet LevelId) -> m (EnumSet LevelId)
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> EnumSet LevelId
scondInMelee
  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
$! LevelId
lid LevelId -> EnumSet LevelId -> Bool
forall k. Enum k => k -> EnumSet k -> Bool
`ES.member` EnumSet LevelId
condInMelee

insertInMeleeM :: MonadClient m => LevelId -> m ()
insertInMeleeM :: LevelId -> m ()
insertInMeleeM LevelId
lid = 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
$ \StateClient
cli ->
--    cli {scondInMelee = ES.alterF (const inM) lid $ scondInMelee cli}
    StateClient
cli {scondInMelee :: EnumSet LevelId
scondInMelee = if Bool
inM
                        then LevelId -> EnumSet LevelId -> EnumSet LevelId
forall k. Enum k => k -> EnumSet k -> EnumSet k
ES.insert LevelId
lid (EnumSet LevelId -> EnumSet LevelId)
-> EnumSet LevelId -> EnumSet LevelId
forall a b. (a -> b) -> a -> b
$ StateClient -> EnumSet LevelId
scondInMelee StateClient
cli
                        else LevelId -> EnumSet LevelId -> EnumSet LevelId
forall k. Enum k => k -> EnumSet k -> EnumSet k
ES.delete LevelId
lid (EnumSet LevelId -> EnumSet LevelId)
-> EnumSet LevelId -> EnumSet LevelId
forall a b. (a -> b) -> a -> b
$ StateClient -> EnumSet LevelId
scondInMelee StateClient
cli}