module Engine.Window.MouseButton
  ( 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 (GlobalHandles(..), StageRIO)

type Callback st = (GLFW.ModifierKeys, GLFW.MouseButtonState, GLFW.MouseButton) -> StageRIO st ()

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

mkCallback :: UnliftIO (StageRIO st) -> Callback st -> GLFW.MouseButtonCallback
mkCallback :: UnliftIO (StageRIO st) -> Callback st -> MouseButtonCallback
mkCallback (UnliftIO forall a. StageRIO st a -> IO a
ul) Callback st
action =
  \Window
_window MouseButton
button MouseButtonState
buttonState ModifierKeys
mods ->
    StageRIO st () -> IO ()
forall a. StageRIO st a -> IO a
ul (StageRIO st () -> IO ()) -> StageRIO st () -> IO ()
forall a b. (a -> b) -> a -> b
$ Callback st
action (ModifierKeys
mods, MouseButtonState
buttonState, MouseButton
button)