module Game.LambdaHack.Client.MonadClient
(
MonadClientRead ( getsClient
, liftIO
)
, MonadClient(modifyClient)
, 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
class MonadStateRead m => MonadClientRead m where
getsClient :: (StateClient -> a) -> m a
liftIO :: IO a -> m a
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"
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)
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
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 ->
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}