-- | Internal module supporting "Graphics.GPipe.Context.GLFW.Input" and "Graphics.GPipe.Context.GLFW.Wrapped"
module Graphics.GPipe.Context.GLFW.Wrappers where

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

-- | Convenience funcion to run the action with the context if GPipe can locate it and it is still open.
withWindow :: MonadIO m => (GLFW.Window -> IO a) -> GPipe.Window os c ds -> GPipe.ContextT Handler.Handle os m (Maybe a)
withWindow :: (Window -> IO a)
-> Window os c ds -> ContextT Handle os m (Maybe a)
withWindow Window -> IO a
fun Window os c ds
wid = String
-> Window os c ds
-> (Context -> IO a)
-> ContextT Handle os m (Maybe a)
forall (m :: * -> *) os c ds a.
MonadIO m =>
String
-> Window os c ds
-> (Context -> IO a)
-> ContextT Handle os m (Maybe a)
Handler.withContextFromGPipe String
"withWindowNoRPC" Window os c ds
wid Context -> IO a
go
    where
        go :: Context -> IO a
go = Window -> IO a
fun (Window -> IO a) -> (Context -> Window) -> Context -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context -> Window
Handler.contextRaw

-- | Convenience function to look up and unwrap the GLFW window and route the GLFW function through RPC.
withWindowRPC :: MonadIO m => (Call.OnMain a -> GLFW.Window -> IO a) -> GPipe.Window os c ds -> GPipe.ContextT Handler.Handle os m (Maybe a)
withWindowRPC :: (OnMain a -> Window -> IO a)
-> Window os c ds -> ContextT Handle os m (Maybe a)
withWindowRPC OnMain a -> Window -> IO a
fun Window os c ds
wid = String
-> Window os c ds
-> (Handle -> Context -> IO a)
-> ContextT Handle os m (Maybe a)
forall (m :: * -> *) os c ds a.
MonadIO m =>
String
-> Window os c ds
-> (Handle -> Context -> IO a)
-> ContextT Handle os m (Maybe a)
Handler.withBothFromGPipe String
"withWindowRPC" Window os c ds
wid Handle -> Context -> IO a
go
    where
        go :: Handle -> Context -> IO a
go Handle
handle = OnMain a -> Window -> IO a
fun (Handle -> OnMain a
forall a. Handle -> IO a -> IO a
RPC.fetchResult (Handle -> OnMain a) -> (Handle -> Handle) -> Handle -> OnMain a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> Handle
Handler.handleComm (Handle -> OnMain a) -> Handle -> OnMain a
forall a b. (a -> b) -> a -> b
$ Handle
handle) (Window -> IO a) -> (Context -> Window) -> Context -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context -> Window
Handler.contextRaw

-- | Convenience function to wrap two-argument functions taking window and something else.
wrapWindowFun :: MonadIO m => (Call.OnMain b -> GLFW.Window -> a -> IO b) -> GPipe.Window os c ds -> a -> GPipe.ContextT Handler.Handle os m (Maybe b)
wrapWindowFun :: (OnMain b -> Window -> a -> IO b)
-> Window os c ds -> a -> ContextT Handle os m (Maybe b)
wrapWindowFun OnMain b -> Window -> a -> IO b
fun Window os c ds
wid a
x = ((OnMain b -> Window -> IO b)
 -> Window os c ds -> ContextT Handle os m (Maybe b))
-> Window os c ds
-> (OnMain b -> Window -> IO b)
-> ContextT Handle os m (Maybe b)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (OnMain b -> Window -> IO b)
-> Window os c ds -> ContextT Handle os m (Maybe b)
forall (m :: * -> *) a os c ds.
MonadIO m =>
(OnMain a -> Window -> IO a)
-> Window os c ds -> ContextT Handle os m (Maybe a)
withWindowRPC Window os c ds
wid ((OnMain b -> Window -> IO b) -> ContextT Handle os m (Maybe b))
-> (OnMain b -> Window -> IO b) -> ContextT Handle os m (Maybe b)
forall a b. (a -> b) -> a -> b
$ \OnMain b
onMain Window
window -> OnMain b -> Window -> a -> IO b
fun OnMain b
onMain Window
window a
x

-- | Convenience function to wrap callback setters which take window and pass it to the callback.
-- Callbacks will be passed the GPipe window id.
wrapCallbackSetter :: (MonadIO m, Functor g) => (Call.OnMain a -> GLFW.Window -> g (GLFW.Window -> b) -> IO a) -> GPipe.Window os c ds -> g b -> GPipe.ContextT Handler.Handle os m (Maybe a)
wrapCallbackSetter :: (OnMain a -> Window -> g (Window -> b) -> IO a)
-> Window os c ds -> g b -> ContextT Handle os m (Maybe a)
wrapCallbackSetter OnMain a -> Window -> g (Window -> b) -> IO a
setter Window os c ds
wid g b
cb = ((OnMain a -> Window -> IO a)
 -> Window os c ds -> ContextT Handle os m (Maybe a))
-> Window os c ds
-> (OnMain a -> Window -> IO a)
-> ContextT Handle os m (Maybe a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (OnMain a -> Window -> IO a)
-> Window os c ds -> ContextT Handle os m (Maybe a)
forall (m :: * -> *) a os c ds.
MonadIO m =>
(OnMain a -> Window -> IO a)
-> Window os c ds -> ContextT Handle os m (Maybe a)
withWindowRPC Window os c ds
wid ((OnMain a -> Window -> IO a) -> ContextT Handle os m (Maybe a))
-> (OnMain a -> Window -> IO a) -> ContextT Handle os m (Maybe a)
forall a b. (a -> b) -> a -> b
$ \OnMain a
onMain Window
window -> OnMain a -> Window -> g (Window -> b) -> IO a
setter OnMain a
onMain Window
window (b -> Window -> b
forall a b. a -> b -> a
const (b -> Window -> b) -> g b -> g (Window -> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> g b
cb)