{-# LANGUAGE ScopedTypeVariables #-}
module Graphics.GPipe.Engine where

import           Control.Concurrent.MVar      (MVar, putMVar, takeMVar)
import           Control.Monad                (unless)
import           Control.Monad.IO.Class       (liftIO)
import           Graphics.GPipe               (ContextT, Depth, RGBAFloat,
                                               Window, swapWindowBuffers)
import qualified Graphics.GPipe.Context.GLFW  as GLFW
import           Graphics.GPipe.Engine.TimeIt (timeItInPlace)


mainloop
    :: Window os RGBAFloat Depth
    -> Bool
    -> (pipelineState -> ContextT GLFW.Handle os IO pipelineState)
    -> (Window os RGBAFloat Depth -> pipelineData -> pipelineState -> ContextT GLFW.Handle os IO ())
    -> pipelineData
    -> MVar pipelineState
    -> ContextT GLFW.Handle os IO ()
mainloop :: Window os RGBAFloat Depth
-> Bool
-> (pipelineState -> ContextT Handle os IO pipelineState)
-> (Window os RGBAFloat Depth
    -> pipelineData -> pipelineState -> ContextT Handle os IO ())
-> pipelineData
-> MVar pipelineState
-> ContextT Handle os IO ()
mainloop Window os RGBAFloat Depth
win Bool
timing pipelineState -> ContextT Handle os IO pipelineState
prepare Window os RGBAFloat Depth
-> pipelineData -> pipelineState -> ContextT Handle os IO ()
render pipelineData
pipelineData MVar pipelineState
pipelineState = ContextT Handle os IO ()
loop
  where
    timeIt :: ContextT Handle os IO (Maybe Bool)
-> ContextT Handle os IO (Maybe Bool)
timeIt = if Bool
timing then String
-> ContextT Handle os IO (Maybe Bool)
-> ContextT Handle os IO (Maybe Bool)
forall a (m :: * -> *). (Info a, MonadIO m) => String -> m a -> m a
timeItInPlace String
"Rendering..." else ContextT Handle os IO (Maybe Bool)
-> ContextT Handle os IO (Maybe Bool)
forall a. a -> a
id

    loop :: ContextT Handle os IO ()
loop = do
        Maybe Bool
closeRequested <- ContextT Handle os IO (Maybe Bool)
-> ContextT Handle os IO (Maybe Bool)
timeIt (ContextT Handle os IO (Maybe Bool)
 -> ContextT Handle os IO (Maybe Bool))
-> ContextT Handle os IO (Maybe Bool)
-> ContextT Handle os IO (Maybe Bool)
forall a b. (a -> b) -> a -> b
$ do
            -- Take the current state, make any necessary changes to it within
            -- the ContextT, then put it back so GLFW callbacks can proceed.
            pipelineState
state <- IO pipelineState -> ContextT Handle os IO pipelineState
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (MVar pipelineState -> IO pipelineState
forall a. MVar a -> IO a
takeMVar MVar pipelineState
pipelineState) ContextT Handle os IO pipelineState
-> (pipelineState -> ContextT Handle os IO pipelineState)
-> ContextT Handle os IO pipelineState
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= pipelineState -> ContextT Handle os IO pipelineState
prepare
            IO () -> ContextT Handle os IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ContextT Handle os IO ())
-> IO () -> ContextT Handle os IO ()
forall a b. (a -> b) -> a -> b
$ MVar pipelineState -> pipelineState -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar pipelineState
pipelineState pipelineState
state
            -- Render with the current state (events will be processed on the
            -- next iteration).
            Window os RGBAFloat Depth
-> pipelineData -> pipelineState -> ContextT Handle os IO ()
render Window os RGBAFloat Depth
win pipelineData
pipelineData pipelineState
state

            Window os RGBAFloat Depth -> ContextT Handle os IO ()
forall ctx (m :: * -> *) os c ds.
(ContextHandler ctx, MonadIO m) =>
Window os c ds -> ContextT ctx os m ()
swapWindowBuffers Window os RGBAFloat Depth
win

            Window os RGBAFloat Depth -> ContextT Handle os IO (Maybe Bool)
forall (m :: * -> *) os c ds.
MonadIO m =>
Window os c ds -> ContextT Handle os m (Maybe Bool)
GLFW.windowShouldClose Window os RGBAFloat Depth
win

        Bool -> ContextT Handle os IO () -> ContextT Handle os IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Maybe Bool
closeRequested Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True) ContextT Handle os IO ()
loop