-- | Window manipulation functions covering much of the GLFW __Window guide__:
-- <http://www.glfw.org/docs/latest/window_guide.html>.
-- Notably absent are the window creation functions. These are handled automatically by GPipe-GLFW.
--
-- Actions are in the GPipe 'GPipe.ContextT' monad when a window handle is required,
-- otherwise they are bare reexported IO actions which can be lifted into the 'GPipe.ContextT' monad.
-- The 'Window' taken by many of these functions is the window resource from GPipe.

module Graphics.GPipe.Context.GLFW.Window (
-- * Window objects
-- | Learn more: http://www.glfw.org/docs/latest/window_guide.html#window_object

-- * Window event processing
-- | GLFW event processing is performed by 'GPipe-GLFW' after each call to the 'GPipe' @swapBuffers@.
-- No further action is required, but additional controls are available for complex applications in
-- "Graphics.GPipe.Context.GLFW".

-- * Window properties and events
-- | Learn more: http://www.glfw.org/docs/latest/window_guide.html#window_properties

-- ** Window closing and close flag
windowShouldClose,
setWindowShouldClose,
setWindowCloseCallback,

-- ** Window size
getWindowSize,
setWindowSizeCallback,

-- ** Framebuffer size
-- | Reexported from "Graphics.GPipe.Context".
GPipe.getFrameBufferSize,

-- * Buffer swapping
-- | Buffer swapping is initiated via the 'GPipe' @swapBuffers@ function.

-- * Not supported
-- | Some GLFW functionality isn't currently exposed by "Graphics.UI.GLFW".
--
--      * `glfwSetWindowUserPointer`, `glfwGetWindowUserPointer`
) where

-- stdlib
import           Control.Monad.IO.Class               (MonadIO)
--thirdparty
import qualified Graphics.GPipe.Context               as GPipe (ContextT,
                                                                Window,
                                                                getFrameBufferSize)
--local
import qualified Graphics.GPipe.Context.GLFW.Calls    as Call
import           Graphics.GPipe.Context.GLFW.Handler  (Handle (..))
import qualified Graphics.GPipe.Context.GLFW.Wrappers as Wrappers

-- TODO: function docstrings

getWindowSize :: MonadIO m => GPipe.Window os c ds -> GPipe.ContextT Handle os m (Maybe (Int, Int))
getWindowSize :: Window os c ds -> ContextT Handle os m (Maybe (Int, Int))
getWindowSize = (OnMain (Int, Int) -> Window -> IO (Int, Int))
-> Window os c ds -> ContextT Handle os m (Maybe (Int, Int))
forall (m :: * -> *) a os c ds.
MonadIO m =>
(OnMain a -> Window -> IO a)
-> Window os c ds -> ContextT Handle os m (Maybe a)
Wrappers.withWindowRPC OnMain (Int, Int) -> Window -> IO (Int, Int)
Call.getWindowSize

setWindowSizeCallback :: MonadIO m => GPipe.Window os c ds -> Maybe (Int -> Int -> IO ()) -> GPipe.ContextT Handle os m (Maybe ())
setWindowSizeCallback :: Window os c ds
-> Maybe (Int -> Int -> IO ()) -> ContextT Handle os m (Maybe ())
setWindowSizeCallback = (OnMain ()
 -> Window -> Maybe (Window -> Int -> Int -> IO ()) -> IO ())
-> Window os c ds
-> Maybe (Int -> Int -> IO ())
-> ContextT Handle os m (Maybe ())
forall (m :: * -> *) (g :: * -> *) a b os c ds.
(MonadIO m, Functor g) =>
(OnMain a -> Window -> g (Window -> b) -> IO a)
-> Window os c ds -> g b -> ContextT Handle os m (Maybe a)
Wrappers.wrapCallbackSetter OnMain ()
-> Window -> Maybe (Window -> Int -> Int -> IO ()) -> IO ()
Call.setWindowSizeCallback

windowShouldClose :: MonadIO m => GPipe.Window os c ds -> GPipe.ContextT Handle os m (Maybe Bool)
windowShouldClose :: Window os c ds -> ContextT Handle os m (Maybe Bool)
windowShouldClose = (Window -> IO Bool)
-> Window os c ds -> ContextT Handle os m (Maybe Bool)
forall (m :: * -> *) a os c ds.
MonadIO m =>
(Window -> IO a)
-> Window os c ds -> ContextT Handle os m (Maybe a)
Wrappers.withWindow Window -> IO Bool
Call.windowShouldClose

setWindowShouldClose :: MonadIO m => GPipe.Window os c ds -> Bool -> GPipe.ContextT Handle os m (Maybe ())
setWindowShouldClose :: Window os c ds -> Bool -> ContextT Handle os m (Maybe ())
setWindowShouldClose Window os c ds
w Bool
b = (Window -> IO ())
-> Window os c ds -> ContextT Handle os m (Maybe ())
forall (m :: * -> *) a os c ds.
MonadIO m =>
(Window -> IO a)
-> Window os c ds -> ContextT Handle os m (Maybe a)
Wrappers.withWindow (Window -> Bool -> IO ()
`Call.setWindowShouldClose` Bool
b) Window os c ds
w

setWindowCloseCallback :: MonadIO m => GPipe.Window os c ds -> Maybe (IO ()) -> GPipe.ContextT Handle os m (Maybe ())
setWindowCloseCallback :: Window os c ds -> Maybe (IO ()) -> ContextT Handle os m (Maybe ())
setWindowCloseCallback = (OnMain () -> Window -> Maybe (Window -> IO ()) -> IO ())
-> Window os c ds
-> Maybe (IO ())
-> ContextT Handle os m (Maybe ())
forall (m :: * -> *) (g :: * -> *) a b os c ds.
(MonadIO m, Functor g) =>
(OnMain a -> Window -> g (Window -> b) -> IO a)
-> Window os c ds -> g b -> ContextT Handle os m (Maybe a)
Wrappers.wrapCallbackSetter OnMain () -> Window -> Maybe (Window -> IO ()) -> IO ()
Call.setWindowCloseCallback