Key.hs

module Engine.Window.Key
  ( Callback
  , callback

  , GLFW.Key(..)
  , GLFW.KeyState(..)
  , 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.Events.Sink (MonadSink)
import Engine.Types (ghWindow)

type Callback m = Int -> (GLFW.ModifierKeys, GLFW.KeyState, GLFW.Key) -> m ()

callback :: MonadSink rs m => Callback m -> m ReleaseKey
callback handler = do
  window <- asks $ ghWindow . appEnv
  withUnliftIO \ul ->
    GLFW.setKeyCallback window . Just $ mkCallback ul handler
  Resource.register $
    GLFW.setKeyCallback window Nothing

mkCallback :: UnliftIO m -> Callback m -> GLFW.KeyCallback
mkCallback (UnliftIO ul) action =
  \_window key keyCode keyState mods ->
    ul $ action keyCode (mods, keyState, key)