module Engine.Window.CursorPos
  ( Callback
  , callback

  , GLFW.MouseButton(..)
  , GLFW.MouseButtonState(..)
  , GLFW.ModifierKeys(..)

  , mkCallback
  ) where

import RIO

import Graphics.UI.GLFW qualified as GLFW
import RIO.App (appEnv)
import UnliftIO.Resource (ReleaseKey)
import UnliftIO.Resource qualified as Resource

import Engine.Types (ghWindow)
import Engine.Events.Sink (MonadSink)

type Callback m = Double -> Double -> m ()

callback
  :: MonadSink rs m
  => Callback m
  -> m ReleaseKey
callback :: forall rs (m :: * -> *).
MonadSink rs m =>
Callback m -> m ReleaseKey
callback Callback m
handler = do
  Window
window <- (App GlobalHandles rs -> Window) -> m Window
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((App GlobalHandles rs -> Window) -> m Window)
-> (App GlobalHandles rs -> Window) -> m Window
forall a b. (a -> b) -> a -> b
$ GlobalHandles -> Window
ghWindow (GlobalHandles -> Window)
-> (App GlobalHandles rs -> GlobalHandles)
-> App GlobalHandles rs
-> Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. App GlobalHandles rs -> GlobalHandles
forall env st. App env st -> env
appEnv
  (UnliftIO m -> IO ()) -> m ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
(UnliftIO m -> IO a) -> m a
withUnliftIO \UnliftIO m
ul ->
    Window -> Maybe CursorPosCallback -> IO ()
GLFW.setCursorPosCallback Window
window (Maybe CursorPosCallback -> IO ())
-> (CursorPosCallback -> Maybe CursorPosCallback)
-> CursorPosCallback
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CursorPosCallback -> Maybe CursorPosCallback
forall a. a -> Maybe a
Just (CursorPosCallback -> IO ()) -> CursorPosCallback -> IO ()
forall a b. (a -> b) -> a -> b
$ UnliftIO m -> Callback m -> CursorPosCallback
forall (m :: * -> *). UnliftIO m -> Callback m -> CursorPosCallback
mkCallback UnliftIO m
ul Callback m
handler
  IO () -> m ReleaseKey
forall (m :: * -> *). MonadResource m => IO () -> m ReleaseKey
Resource.register (IO () -> m ReleaseKey) -> IO () -> m ReleaseKey
forall a b. (a -> b) -> a -> b
$
    Window -> Maybe CursorPosCallback -> IO ()
GLFW.setCursorPosCallback Window
window Maybe CursorPosCallback
forall a. Maybe a
Nothing

mkCallback :: UnliftIO m -> Callback m -> GLFW.CursorPosCallback
mkCallback :: forall (m :: * -> *). UnliftIO m -> Callback m -> CursorPosCallback
mkCallback (UnliftIO forall a. m a -> IO a
ul) Callback m
action =
  \Window
_window Double
px Double
py ->
    m () -> IO ()
forall a. m a -> IO a
ul (m () -> IO ()) -> m () -> IO ()
forall a b. (a -> b) -> a -> b
$ Callback m
action Double
px Double
py