module Engine.Window.Scroll
  ( Callback
  , callback

  , 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 = Double -> Double -> StageRIO st ()

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

mkCallback :: UnliftIO (StageRIO st) -> Callback st -> GLFW.ScrollCallback
mkCallback :: forall st. UnliftIO (StageRIO st) -> Callback st -> ScrollCallback
mkCallback (UnliftIO forall a. StageRIO st a -> IO a
ul) Callback st
action =
  \Window
_window Double
dx Double
dy ->
    forall a. StageRIO st a -> IO a
ul forall a b. (a -> b) -> a -> b
$ Callback st
action Double
dx Double
dy