-- | 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, rndToAction, rndToActionForget
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import           Control.Monad.ST.Strict (stToIO)
import qualified Control.Monad.Trans.State.Strict as St
import           Data.Bits (finiteBitSize, xor, (.&.))
import qualified Data.Primitive.PrimArray as PA
import qualified Data.Text.IO as T
import           System.IO (hFlush, stdout)
import qualified System.Random as R

import Game.LambdaHack.Client.ClientOptions
import Game.LambdaHack.Client.State
import Game.LambdaHack.Common.Kind
import Game.LambdaHack.Common.MonadStateRead
import Game.LambdaHack.Common.Point
import Game.LambdaHack.Common.State
import Game.LambdaHack.Common.Time
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.hPutStrLn Handle
stdout Text
t
    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

-- | 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
  StdGen
gen1 <- (StateClient -> StdGen) -> m StdGen
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> StdGen
srandom
  let (a :: a
a, gen2 :: StdGen
gen2) = Rnd a -> StdGen -> (a, StdGen)
forall s a. State s a -> s -> (a, s)
St.runState Rnd a
r StdGen
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 :: StdGen
srandom = StdGen
gen2}
  a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a

-- | Invoke pseudo-random computation, don't change generator kept in state.
-- Modify the used generator by @xoring@ with current global game time.
rndToActionForget :: MonadClientRead m => Rnd a -> m a
rndToActionForget :: Rnd a -> m a
rndToActionForget r :: Rnd a
r = do
  StdGen
gen <- (StateClient -> StdGen) -> m StdGen
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> StdGen
srandom
  let i :: PointI
i = (PointI, StdGen) -> PointI
forall a b. (a, b) -> a
fst ((PointI, StdGen) -> PointI) -> (PointI, StdGen) -> PointI
forall a b. (a -> b) -> a -> b
$ StdGen -> (PointI, StdGen)
forall g. RandomGen g => g -> (PointI, g)
R.next StdGen
gen
  Time
time <- (State -> Time) -> m Time
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> Time
stime
  -- Prevent overflow from @Int64@ to @Int@.
  let positiveIntSize :: PointI
positiveIntSize = PointI -> PointI
forall b. FiniteBits b => b -> PointI
finiteBitSize (1 :: Int) PointI -> PointI -> PointI
forall a. Num a => a -> a -> a
- 1
      oneBitsPositiveInt :: Int64
oneBitsPositiveInt = 2 Int64 -> PointI -> Int64
forall a b. (Num a, Integral b) => a -> b -> a
^ PointI
positiveIntSize Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- 1
      timeSmallBits :: PointI
timeSmallBits = Int64 -> PointI
forall a. Enum a => a -> PointI
fromEnum (Int64 -> PointI) -> Int64 -> PointI
forall a b. (a -> b) -> a -> b
$ Time -> Int64
timeTicks Time
time Int64 -> Int64 -> Int64
forall a. Bits a => a -> a -> a
.&. Int64
oneBitsPositiveInt
      genNew :: StdGen
genNew = PointI -> StdGen
R.mkStdGen (PointI -> StdGen) -> PointI -> StdGen
forall a b. (a -> b) -> a -> b
$ PointI
i PointI -> PointI -> PointI
forall a. Bits a => a -> a -> a
`xor` PointI
timeSmallBits
  a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> m a) -> a -> m a
forall a b. (a -> b) -> a -> b
$! Rnd a -> StdGen -> a
forall s a. State s a -> s -> a
St.evalState Rnd a
r StdGen
genNew