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.Events.Sink (MonadSink) import Engine.Types (GlobalHandles(..)) 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 ScrollCallback -> IO () GLFW.setScrollCallback Window window (Maybe ScrollCallback -> IO ()) -> (ScrollCallback -> Maybe ScrollCallback) -> ScrollCallback -> IO () forall b c a. (b -> c) -> (a -> b) -> a -> c . ScrollCallback -> Maybe ScrollCallback forall a. a -> Maybe a Just (ScrollCallback -> IO ()) -> ScrollCallback -> IO () forall a b. (a -> b) -> a -> b $ UnliftIO m -> Callback m -> ScrollCallback forall (m :: * -> *). UnliftIO m -> Callback m -> ScrollCallback 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 ScrollCallback -> IO () GLFW.setScrollCallback Window window Maybe ScrollCallback forall a. Maybe a Nothing mkCallback :: UnliftIO m -> Callback m -> GLFW.ScrollCallback mkCallback :: forall (m :: * -> *). UnliftIO m -> Callback m -> ScrollCallback mkCallback (UnliftIO forall a. m a -> IO a ul) Callback m action = \Window _window Double dx Double dy -> m () -> IO () forall a. m a -> IO a ul (m () -> IO ()) -> m () -> IO () forall a b. (a -> b) -> a -> b $ Callback m action Double dx Double dy