{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Terminal.Game.Layer.Object.Record where

-- Record Monad, for when I need to play the game and record Events
-- (keypresses, ticks, screen size, FPS) to a file.

import Terminal.Game.Layer.Object.Interface
import Terminal.Game.Layer.Object.Primitive
import Terminal.Game.Layer.Object.IO ()

import qualified Control.Concurrent   as CC
import qualified Control.Monad.Catch  as MC
import qualified Control.Monad.Reader as R
import qualified Control.Monad.Trans  as T -- MonadIO
import qualified Data.ByteString      as BS
import qualified Data.Serialize       as S

-- record the key pressed in a game session

newtype Record a = Record (R.ReaderT (CC.MVar GRec) IO a)
                deriving (forall a b. a -> Record b -> Record a
forall a b. (a -> b) -> Record a -> Record b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Record b -> Record a
$c<$ :: forall a b. a -> Record b -> Record a
fmap :: forall a b. (a -> b) -> Record a -> Record b
$cfmap :: forall a b. (a -> b) -> Record a -> Record b
Functor, Functor Record
forall a. a -> Record a
forall a b. Record a -> Record b -> Record a
forall a b. Record a -> Record b -> Record b
forall a b. Record (a -> b) -> Record a -> Record b
forall a b c. (a -> b -> c) -> Record a -> Record b -> Record c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. Record a -> Record b -> Record a
$c<* :: forall a b. Record a -> Record b -> Record a
*> :: forall a b. Record a -> Record b -> Record b
$c*> :: forall a b. Record a -> Record b -> Record b
liftA2 :: forall a b c. (a -> b -> c) -> Record a -> Record b -> Record c
$cliftA2 :: forall a b c. (a -> b -> c) -> Record a -> Record b -> Record c
<*> :: forall a b. Record (a -> b) -> Record a -> Record b
$c<*> :: forall a b. Record (a -> b) -> Record a -> Record b
pure :: forall a. a -> Record a
$cpure :: forall a. a -> Record a
Applicative, Applicative Record
forall a. a -> Record a
forall a b. Record a -> Record b -> Record b
forall a b. Record a -> (a -> Record b) -> Record b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> Record a
$creturn :: forall a. a -> Record a
>> :: forall a b. Record a -> Record b -> Record b
$c>> :: forall a b. Record a -> Record b -> Record b
>>= :: forall a b. Record a -> (a -> Record b) -> Record b
$c>>= :: forall a b. Record a -> (a -> Record b) -> Record b
Monad,
                          Monad Record
forall a. IO a -> Record a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: forall a. IO a -> Record a
$cliftIO :: forall a. IO a -> Record a
T.MonadIO, R.MonadReader (CC.MVar GRec),
                          Monad Record
forall e a. Exception e => e -> Record a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
throwM :: forall e a. Exception e => e -> Record a
$cthrowM :: forall e a. Exception e => e -> Record a
MC.MonadThrow, MonadThrow Record
forall e a. Exception e => Record a -> (e -> Record a) -> Record a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
catch :: forall e a. Exception e => Record a -> (e -> Record a) -> Record a
$ccatch :: forall e a. Exception e => Record a -> (e -> Record a) -> Record a
MC.MonadCatch, MonadCatch Record
forall b.
((forall a. Record a -> Record a) -> Record b) -> Record b
forall a b c.
Record a
-> (a -> ExitCase b -> Record c)
-> (a -> Record b)
-> Record (b, c)
forall (m :: * -> *).
MonadCatch m
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
    m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
generalBracket :: forall a b c.
Record a
-> (a -> ExitCase b -> Record c)
-> (a -> Record b)
-> Record (b, c)
$cgeneralBracket :: forall a b c.
Record a
-> (a -> ExitCase b -> Record c)
-> (a -> Record b)
-> Record (b, c)
uninterruptibleMask :: forall b.
((forall a. Record a -> Record a) -> Record b) -> Record b
$cuninterruptibleMask :: forall b.
((forall a. Record a -> Record a) -> Record b) -> Record b
mask :: forall b.
((forall a. Record a -> Record a) -> Record b) -> Record b
$cmask :: forall b.
((forall a. Record a -> Record a) -> Record b) -> Record b
MC.MonadMask)

-- Lifts IO interface, records where necessary
instance MonadInput Record where
    startEvents :: TPS -> Record InputHandle
startEvents TPS
tps = forall (m :: * -> *) a. MonadIO m => IO a -> m a
T.liftIO (forall (m :: * -> *). MonadInput m => TPS -> m InputHandle
startEvents TPS
tps)
    pollEvents :: MVar [Event] -> Record [Event]
pollEvents MVar [Event]
ve = forall (m :: * -> *) a. MonadIO m => IO a -> m a
T.liftIO (forall (m :: * -> *). MonadInput m => MVar [Event] -> m [Event]
pollEvents MVar [Event]
ve) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[Event]
es ->
                    forall a. (a -> GRec -> GRec) -> a -> Record a
modMRec [Event] -> GRec -> GRec
addPolled [Event]
es
    stopEvents :: [ThreadId] -> Record ()
stopEvents [ThreadId]
ts = forall (m :: * -> *) a. MonadIO m => IO a -> m a
T.liftIO (forall (m :: * -> *). MonadInput m => [ThreadId] -> m ()
stopEvents [ThreadId]
ts)

instance MonadDisplay Record where
    setupDisplay :: Record ()
setupDisplay = forall (m :: * -> *) a. MonadIO m => IO a -> m a
T.liftIO forall (m :: * -> *). MonadDisplay m => m ()
setupDisplay
    clearDisplay :: Record ()
clearDisplay = forall (m :: * -> *) a. MonadIO m => IO a -> m a
T.liftIO forall (m :: * -> *). MonadDisplay m => m ()
clearDisplay
    displaySize :: Record (Maybe Dimensions)
displaySize = forall (m :: * -> *) a. MonadIO m => IO a -> m a
T.liftIO forall (m :: * -> *). MonadDisplay m => m (Maybe Dimensions)
displaySize forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Maybe Dimensions
ds ->
                  forall a. (a -> GRec -> GRec) -> a -> Record a
modMRec Maybe Dimensions -> GRec -> GRec
addDims Maybe Dimensions
ds
    blitPlane :: Maybe Plane -> Plane -> Record ()
blitPlane Maybe Plane
mp Plane
p = forall (m :: * -> *) a. MonadIO m => IO a -> m a
T.liftIO (forall (m :: * -> *).
MonadDisplay m =>
Maybe Plane -> Plane -> m ()
blitPlane Maybe Plane
mp Plane
p)
    shutdownDisplay :: Record ()
shutdownDisplay = forall (m :: * -> *) a. MonadIO m => IO a -> m a
T.liftIO forall (m :: * -> *). MonadDisplay m => m ()
shutdownDisplay

-- logs and passes the value on
modMRec :: (a -> GRec -> GRec) -> a -> Record a
modMRec :: forall a. (a -> GRec -> GRec) -> a -> Record a
modMRec a -> GRec -> GRec
f a
a = forall r (m :: * -> *). MonadReader r m => m r
R.ask forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \MVar GRec
mv ->
              let fmv :: IO ()
fmv = forall a. MVar a -> (a -> IO a) -> IO ()
CC.modifyMVar_ MVar GRec
mv (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> GRec -> GRec
f a
a) in
              forall (m :: * -> *) a. MonadIO m => IO a -> m a
T.liftIO IO ()
fmv forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
              forall (m :: * -> *) a. Monad m => a -> m a
return a
a

runRecord :: Record a -> CC.MVar GRec -> IO a
runRecord :: forall a. Record a -> MVar GRec -> IO a
runRecord (Record ReaderT (MVar GRec) IO a
r) MVar GRec
me = forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
R.runReaderT ReaderT (MVar GRec) IO a
r MVar GRec
me

writeRec :: FilePath -> CC.MVar GRec -> IO ()
writeRec :: FilePath -> MVar GRec -> IO ()
writeRec FilePath
fp MVar GRec
vr = forall a. MVar a -> IO a
CC.readMVar MVar GRec
vr                forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \GRec
k ->
                 FilePath -> ByteString -> IO ()
BS.writeFile FilePath
fp (forall a. Serialize a => a -> ByteString
S.encode GRec
k)