-- | User input functions covering much of the GLFW __Input guide__:
-- <http://www.glfw.org/docs/latest/input_guide.html>.
--
-- Actions are in the GPipe 'GPipe.ContextT' monad when a window handle is required,
-- otherwise they are bare reexported IO actions which can be lifted into the 'GPipe.ContextT' monad.
-- The 'Window' taken by many of these functions is the window resource from GPipe.

module Graphics.GPipe.Context.GLFW.Input (

 -- * Event processing
 -- | Learn more: http://www.glfw.org/docs/latest/input_guide.html#events
 --
 --     * `glfwPollEvents`
 --     * `glfwWaitEvents`
 --
 -- GLFW Events are processed after each buffer swap by default. To change
 -- event processing construct a 'HandleConfig' for 'runContextT'. For greater
 -- control use the 'mainloop' and 'mainstep' functions provided by
 -- "Graphics.GPipe.Context.GLFW".
 GLFW.postEmptyEvent,
 -- | Force wake from 'waitEvents' with a dummy event.

 -- * Keyboard input
 -- | Learn more: http://www.glfw.org/docs/latest/input_guide.html#input_keyboard

 -- ** Key input
 setKeyCallback,
 getKey,
 setStickyKeysInputMode,
 getStickyKeysInputMode,

 -- ** Text input
 setCharCallback,

 -- * Mouse input
 -- | Learn more: http://www.glfw.org/docs/latest/input_guide.html#input_mouse

 -- ** Cursor position
 setCursorPosCallback,
 getCursorPos,

 -- ** Cursor modes
 setCursorInputMode,
 getCursorInputMode,

 -- ** Cursor objects

 -- *** Custom cursor creation
 GLFW.createCursor,

 -- *** Standard cursor creation
 GLFW.createStandardCursor,

 -- *** Cursor destruction
 GLFW.destroyCursor,

 -- *** Cursor setting
 setCursor,

 -- ** Cursor enter/leave events
 setCursorEnterCallback,

 -- ** Mouse button input
 setMouseButtonCallback,
 getMouseButton,
 setStickyMouseButtonsInputMode,
 getStickyMouseButtonsInputMode,

 -- ** Scroll input
 setScrollCallback,

 -- * Joystick input
 -- | Learn more: http://www.glfw.org/docs/latest/input_guide.html#joystick
 GLFW.joystickPresent,
 -- | Is the specified 'Joystick' currently connected?

 -- ** Joystick axis states
 GLFW.getJoystickAxes,
 -- | Poll for the positions of each axis on the 'Joystick'. Positions are on the range `-1.0..1.0`.

 -- ** Joystick button states
 GLFW.getJoystickButtons,
 -- | Poll for the 'JoystickButtonState' of each button on the 'Joystick'.

 -- ** Joystick name
 GLFW.getJoystickName,
 -- | Retrieve a non-unique string identifier for the 'Joystick'.
 -- This might be the make & model name of the device.

 -- * Time input
 -- | Learn more: http://www.glfw.org/docs/latest/input_guide.html#time
 GLFW.getTime,
 -- | Poll for the number of seconds since GLFW was initialized by GPipe.
 GLFW.setTime,
 -- | Manually set the timer to a specified value.

 -- * Clipboard input and output
 -- | Learn more: http://www.glfw.org/docs/latest/input_guide.html#clipboard
 getClipboardString,
 setClipboardString,

 -- * Path drop input
 -- | Learn more: http://www.glfw.org/docs/latest/input_guide.html#path_drop
 setDropCallback,

 -- * Reexported datatypes

 -- ** Keyboard
 Key(..),
 KeyState(..),
 ModifierKeys(..),
 StickyKeysInputMode(..),

 -- ** Mouse
 CursorInputMode(..),
 StandardCursorShape(..),
 CursorState(..),
 StickyMouseButtonsInputMode(..),
 MouseButton(..),
 MouseButtonState(..),

 -- ** Joystick
 Joystick(..),
 JoystickButtonState(..),

 -- * Not supported
 -- | Some GLFW functionality isn't currently exposed by "Graphics.UI.GLFW".
 --
 --     * `glfwWaitEventsTimeout`
 --     * `glfwSetCharModsCallback`
 --     * `glfwGetKeyName`
 --     * `glfwSetJoystickCallback`
 --     * `glfwGetTimerValue`
 --     * `glfwGetTimerFrequency`
 ) where

-- stdlib
import           Control.Monad.IO.Class               (MonadIO)
import qualified Graphics.GPipe.Context               as GPipe (ContextT,
                                                                Window)
-- third party
import           Graphics.UI.GLFW                     (Cursor (..),
                                                       CursorInputMode (..),
                                                       CursorState (..),
                                                       Joystick (..),
                                                       JoystickButtonState (..),
                                                       Key (..), KeyState (..),
                                                       ModifierKeys (..),
                                                       MouseButton (..),
                                                       MouseButtonState (..),
                                                       StandardCursorShape (..),
                                                       StickyKeysInputMode (..),
                                                       StickyMouseButtonsInputMode (..))
import qualified Graphics.UI.GLFW                     as GLFW
-- local
import qualified Graphics.GPipe.Context.GLFW.Calls    as Call
import           Graphics.GPipe.Context.GLFW.Handler  (Handle (..))
import           Graphics.GPipe.Context.GLFW.Wrappers (withWindowRPC,
                                                       wrapCallbackSetter,
                                                       wrapWindowFun)



{- Keyboard -}

-- | Register or unregister a callback to receive 'KeyState' changes to any 'Key'.
setKeyCallback :: MonadIO m => GPipe.Window os c ds -> Maybe (Key -> Int -> KeyState -> ModifierKeys -> IO ()) -> GPipe.ContextT Handle os m (Maybe ())
setKeyCallback :: Window os c ds
-> Maybe (Key -> Int -> KeyState -> ModifierKeys -> IO ())
-> ContextT Handle os m (Maybe ())
setKeyCallback = (OnMain ()
 -> Window
 -> Maybe
      (Window -> Key -> Int -> KeyState -> ModifierKeys -> IO ())
 -> IO ())
-> Window os c ds
-> Maybe (Key -> Int -> KeyState -> ModifierKeys -> IO ())
-> ContextT Handle os m (Maybe ())
forall (m :: * -> *) (g :: * -> *) a b os c ds.
(MonadIO m, Functor g) =>
(OnMain a -> Window -> g (Window -> b) -> IO a)
-> Window os c ds -> g b -> ContextT Handle os m (Maybe a)
wrapCallbackSetter OnMain ()
-> Window
-> Maybe
     (Window -> Key -> Int -> KeyState -> ModifierKeys -> IO ())
-> IO ()
Call.setKeyCallback

-- | Poll for the 'KeyState' of a 'Key'.
getKey :: MonadIO m => GPipe.Window os c ds -> Key -> GPipe.ContextT Handle os m (Maybe KeyState)
getKey :: Window os c ds -> Key -> ContextT Handle os m (Maybe KeyState)
getKey = (OnMain KeyState -> Window -> Key -> IO KeyState)
-> Window os c ds -> Key -> ContextT Handle os m (Maybe KeyState)
forall (m :: * -> *) b a os c ds.
MonadIO m =>
(OnMain b -> Window -> a -> IO b)
-> Window os c ds -> a -> ContextT Handle os m (Maybe b)
wrapWindowFun OnMain KeyState -> Window -> Key -> IO KeyState
Call.getKey

-- | Polling a 'Key' for 'KeyState' may sometimes miss state transitions.
-- If you use cannot use a callback to receive 'KeyState' changes,
-- use 'getKey' in combination with GLFW's sticky-keys feature:
-- <http://www.glfw.org/docs/latest/input_guide.html#input_key>.
setStickyKeysInputMode :: MonadIO m => GPipe.Window os c ds -> StickyKeysInputMode -> GPipe.ContextT Handle os m (Maybe ())
setStickyKeysInputMode :: Window os c ds
-> StickyKeysInputMode -> ContextT Handle os m (Maybe ())
setStickyKeysInputMode = (OnMain () -> Window -> StickyKeysInputMode -> IO ())
-> Window os c ds
-> StickyKeysInputMode
-> ContextT Handle os m (Maybe ())
forall (m :: * -> *) b a os c ds.
MonadIO m =>
(OnMain b -> Window -> a -> IO b)
-> Window os c ds -> a -> ContextT Handle os m (Maybe b)
wrapWindowFun OnMain () -> Window -> StickyKeysInputMode -> IO ()
Call.setStickyKeysInputMode

getStickyKeysInputMode :: MonadIO m => GPipe.Window os c ds -> GPipe.ContextT Handle os m (Maybe StickyKeysInputMode)
getStickyKeysInputMode :: Window os c ds -> ContextT Handle os m (Maybe StickyKeysInputMode)
getStickyKeysInputMode = (OnMain StickyKeysInputMode -> Window -> IO StickyKeysInputMode)
-> Window os c ds
-> ContextT Handle os m (Maybe StickyKeysInputMode)
forall (m :: * -> *) a os c ds.
MonadIO m =>
(OnMain a -> Window -> IO a)
-> Window os c ds -> ContextT Handle os m (Maybe a)
withWindowRPC OnMain StickyKeysInputMode -> Window -> IO StickyKeysInputMode
Call.getStickyKeysInputMode

-- | Register or unregister a callback to receive character input obeying keyboard layouts and modifier effects.
setCharCallback :: MonadIO m => GPipe.Window os c ds -> Maybe (Char -> IO ()) -> GPipe.ContextT Handle os m (Maybe ())
setCharCallback :: Window os c ds
-> Maybe (Char -> IO ()) -> ContextT Handle os m (Maybe ())
setCharCallback = (OnMain () -> Window -> Maybe (Window -> Char -> IO ()) -> IO ())
-> Window os c ds
-> Maybe (Char -> IO ())
-> ContextT Handle os m (Maybe ())
forall (m :: * -> *) (g :: * -> *) a b os c ds.
(MonadIO m, Functor g) =>
(OnMain a -> Window -> g (Window -> b) -> IO a)
-> Window os c ds -> g b -> ContextT Handle os m (Maybe a)
wrapCallbackSetter OnMain () -> Window -> Maybe (Window -> Char -> IO ()) -> IO ()
Call.setCharCallback

{- Mouse -}

-- | Register or unregister a callback to receive mouse location changes.
-- Callback receives `x` and `y` position measured in screen-coordinates relative to the top left of the GLFW window.
setCursorPosCallback :: MonadIO m => GPipe.Window os c ds -> Maybe (Double -> Double -> IO ()) -> GPipe.ContextT Handle os m (Maybe ())
setCursorPosCallback :: Window os c ds
-> Maybe (Double -> Double -> IO ())
-> ContextT Handle os m (Maybe ())
setCursorPosCallback = (OnMain ()
 -> Window -> Maybe (Window -> Double -> Double -> IO ()) -> IO ())
-> Window os c ds
-> Maybe (Double -> Double -> IO ())
-> ContextT Handle os m (Maybe ())
forall (m :: * -> *) (g :: * -> *) a b os c ds.
(MonadIO m, Functor g) =>
(OnMain a -> Window -> g (Window -> b) -> IO a)
-> Window os c ds -> g b -> ContextT Handle os m (Maybe a)
wrapCallbackSetter OnMain ()
-> Window -> Maybe (Window -> Double -> Double -> IO ()) -> IO ()
Call.setCursorPosCallback

-- | Poll for the location of the mouse.
getCursorPos :: MonadIO m => GPipe.Window os c ds -> GPipe.ContextT Handle os m (Maybe (Double, Double))
getCursorPos :: Window os c ds -> ContextT Handle os m (Maybe (Double, Double))
getCursorPos = (OnMain (Double, Double) -> Window -> IO (Double, Double))
-> Window os c ds -> ContextT Handle os m (Maybe (Double, Double))
forall (m :: * -> *) a os c ds.
MonadIO m =>
(OnMain a -> Window -> IO a)
-> Window os c ds -> ContextT Handle os m (Maybe a)
withWindowRPC OnMain (Double, Double) -> Window -> IO (Double, Double)
Call.getCursorPos

-- | GLFW supports setting cursor mode to support mouselook and other advanced uses of the mouse:
-- <http://www.glfw.org/docs/latest/input_guide.html#cursor_mode>.
setCursorInputMode :: MonadIO m => GPipe.Window os c ds -> CursorInputMode -> GPipe.ContextT Handle os m (Maybe ())
setCursorInputMode :: Window os c ds
-> CursorInputMode -> ContextT Handle os m (Maybe ())
setCursorInputMode = (OnMain () -> Window -> CursorInputMode -> IO ())
-> Window os c ds
-> CursorInputMode
-> ContextT Handle os m (Maybe ())
forall (m :: * -> *) b a os c ds.
MonadIO m =>
(OnMain b -> Window -> a -> IO b)
-> Window os c ds -> a -> ContextT Handle os m (Maybe b)
wrapWindowFun OnMain () -> Window -> CursorInputMode -> IO ()
Call.setCursorInputMode

getCursorInputMode :: MonadIO m => GPipe.Window os c ds -> GPipe.ContextT Handle os m (Maybe CursorInputMode)
getCursorInputMode :: Window os c ds -> ContextT Handle os m (Maybe CursorInputMode)
getCursorInputMode = (OnMain CursorInputMode -> Window -> IO CursorInputMode)
-> Window os c ds -> ContextT Handle os m (Maybe CursorInputMode)
forall (m :: * -> *) a os c ds.
MonadIO m =>
(OnMain a -> Window -> IO a)
-> Window os c ds -> ContextT Handle os m (Maybe a)
withWindowRPC OnMain CursorInputMode -> Window -> IO CursorInputMode
Call.getCursorInputMode

-- | Set the cursor to be displayed over the window while 'CursorInputMode' is `Normal`.
setCursor :: MonadIO m => GPipe.Window os c ds -> Cursor -> GPipe.ContextT Handle os m (Maybe ())
setCursor :: Window os c ds -> Cursor -> ContextT Handle os m (Maybe ())
setCursor = (OnMain () -> Window -> Cursor -> IO ())
-> Window os c ds -> Cursor -> ContextT Handle os m (Maybe ())
forall (m :: * -> *) b a os c ds.
MonadIO m =>
(OnMain b -> Window -> a -> IO b)
-> Window os c ds -> a -> ContextT Handle os m (Maybe b)
wrapWindowFun OnMain () -> Window -> Cursor -> IO ()
Call.setCursor

-- | Register or unregister a callback to receive 'CursorState' changes when the cursor enters or exits the window.
setCursorEnterCallback :: MonadIO m => GPipe.Window os c ds -> Maybe (CursorState -> IO ()) -> GPipe.ContextT Handle os m (Maybe ())
setCursorEnterCallback :: Window os c ds
-> Maybe (CursorState -> IO ()) -> ContextT Handle os m (Maybe ())
setCursorEnterCallback = (OnMain ()
 -> Window -> Maybe (Window -> CursorState -> IO ()) -> IO ())
-> Window os c ds
-> Maybe (CursorState -> IO ())
-> ContextT Handle os m (Maybe ())
forall (m :: * -> *) (g :: * -> *) a b os c ds.
(MonadIO m, Functor g) =>
(OnMain a -> Window -> g (Window -> b) -> IO a)
-> Window os c ds -> g b -> ContextT Handle os m (Maybe a)
wrapCallbackSetter OnMain ()
-> Window -> Maybe (Window -> CursorState -> IO ()) -> IO ()
Call.setCursorEnterCallback

-- | Register or unregister a callback to receive 'MouseButtonState' changes to a 'MouseButton'.
setMouseButtonCallback :: MonadIO m => GPipe.Window os c ds -> Maybe (MouseButton -> MouseButtonState -> ModifierKeys -> IO ()) -> GPipe.ContextT Handle os m (Maybe ())
setMouseButtonCallback :: Window os c ds
-> Maybe (MouseButton -> MouseButtonState -> ModifierKeys -> IO ())
-> ContextT Handle os m (Maybe ())
setMouseButtonCallback = (OnMain ()
 -> Window
 -> Maybe
      (Window
       -> MouseButton -> MouseButtonState -> ModifierKeys -> IO ())
 -> IO ())
-> Window os c ds
-> Maybe (MouseButton -> MouseButtonState -> ModifierKeys -> IO ())
-> ContextT Handle os m (Maybe ())
forall (m :: * -> *) (g :: * -> *) a b os c ds.
(MonadIO m, Functor g) =>
(OnMain a -> Window -> g (Window -> b) -> IO a)
-> Window os c ds -> g b -> ContextT Handle os m (Maybe a)
wrapCallbackSetter OnMain ()
-> Window
-> Maybe
     (Window
      -> MouseButton -> MouseButtonState -> ModifierKeys -> IO ())
-> IO ()
Call.setMouseButtonCallback

-- | Poll for the 'MouseButtonState' of a 'MouseButton'.
getMouseButton :: MonadIO m => GPipe.Window os c ds -> MouseButton -> GPipe.ContextT Handle os m (Maybe MouseButtonState)
getMouseButton :: Window os c ds
-> MouseButton -> ContextT Handle os m (Maybe MouseButtonState)
getMouseButton = (OnMain MouseButtonState
 -> Window -> MouseButton -> IO MouseButtonState)
-> Window os c ds
-> MouseButton
-> ContextT Handle os m (Maybe MouseButtonState)
forall (m :: * -> *) b a os c ds.
MonadIO m =>
(OnMain b -> Window -> a -> IO b)
-> Window os c ds -> a -> ContextT Handle os m (Maybe b)
wrapWindowFun OnMain MouseButtonState
-> Window -> MouseButton -> IO MouseButtonState
Call.getMouseButton

-- | Polling a 'MouseButton' for 'MouseButtonState' may sometimes miss state transitions.
-- If you use cannot use a callback to receive 'MouseButtonState' changes,
-- use 'getMouseButton' in combination with GLFW's sticky-mouse-buttons feature:
-- <http://www.glfw.org/docs/latest/input_guide.html#input_mouse_button>.
setStickyMouseButtonsInputMode :: MonadIO m => GPipe.Window os c ds -> StickyMouseButtonsInputMode -> GPipe.ContextT Handle os m (Maybe ())
setStickyMouseButtonsInputMode :: Window os c ds
-> StickyMouseButtonsInputMode -> ContextT Handle os m (Maybe ())
setStickyMouseButtonsInputMode = (OnMain () -> Window -> StickyMouseButtonsInputMode -> IO ())
-> Window os c ds
-> StickyMouseButtonsInputMode
-> ContextT Handle os m (Maybe ())
forall (m :: * -> *) b a os c ds.
MonadIO m =>
(OnMain b -> Window -> a -> IO b)
-> Window os c ds -> a -> ContextT Handle os m (Maybe b)
wrapWindowFun OnMain () -> Window -> StickyMouseButtonsInputMode -> IO ()
Call.setStickyMouseButtonsInputMode

getStickyMouseButtonsInputMode :: MonadIO m => GPipe.Window os c ds -> GPipe.ContextT Handle os m (Maybe StickyMouseButtonsInputMode)
getStickyMouseButtonsInputMode :: Window os c ds
-> ContextT Handle os m (Maybe StickyMouseButtonsInputMode)
getStickyMouseButtonsInputMode = (OnMain StickyMouseButtonsInputMode
 -> Window -> IO StickyMouseButtonsInputMode)
-> Window os c ds
-> ContextT Handle os m (Maybe StickyMouseButtonsInputMode)
forall (m :: * -> *) a os c ds.
MonadIO m =>
(OnMain a -> Window -> IO a)
-> Window os c ds -> ContextT Handle os m (Maybe a)
withWindowRPC OnMain StickyMouseButtonsInputMode
-> Window -> IO StickyMouseButtonsInputMode
Call.getStickyMouseButtonsInputMode

-- | Register or unregister a callback to receive scroll offset changes.
setScrollCallback :: MonadIO m => GPipe.Window os c ds -> Maybe (Double -> Double -> IO ()) -> GPipe.ContextT Handle os m (Maybe ())
setScrollCallback :: Window os c ds
-> Maybe (Double -> Double -> IO ())
-> ContextT Handle os m (Maybe ())
setScrollCallback = (OnMain ()
 -> Window -> Maybe (Window -> Double -> Double -> IO ()) -> IO ())
-> Window os c ds
-> Maybe (Double -> Double -> IO ())
-> ContextT Handle os m (Maybe ())
forall (m :: * -> *) (g :: * -> *) a b os c ds.
(MonadIO m, Functor g) =>
(OnMain a -> Window -> g (Window -> b) -> IO a)
-> Window os c ds -> g b -> ContextT Handle os m (Maybe a)
wrapCallbackSetter OnMain ()
-> Window -> Maybe (Window -> Double -> Double -> IO ()) -> IO ()
Call.setScrollCallback

{- Joystick -}

{- Time -}

{- Clipboard -}

-- | Poll the system clipboard for a UTF-8 encoded string, if one can be extracted.
getClipboardString :: MonadIO m => GPipe.Window os c ds -> GPipe.ContextT Handle os m (Maybe (Maybe String))
getClipboardString :: Window os c ds -> ContextT Handle os m (Maybe (Maybe String))
getClipboardString = (OnMain (Maybe String) -> Window -> IO (Maybe String))
-> Window os c ds -> ContextT Handle os m (Maybe (Maybe String))
forall (m :: * -> *) a os c ds.
MonadIO m =>
(OnMain a -> Window -> IO a)
-> Window os c ds -> ContextT Handle os m (Maybe a)
withWindowRPC OnMain (Maybe String) -> Window -> IO (Maybe String)
Call.getClipboardString

-- | Store a UTF-8 encoded string in the system clipboard.
setClipboardString :: MonadIO m => GPipe.Window os c ds -> String -> GPipe.ContextT Handle os m (Maybe ())
setClipboardString :: Window os c ds -> String -> ContextT Handle os m (Maybe ())
setClipboardString = (OnMain () -> Window -> String -> IO ())
-> Window os c ds -> String -> ContextT Handle os m (Maybe ())
forall (m :: * -> *) b a os c ds.
MonadIO m =>
(OnMain b -> Window -> a -> IO b)
-> Window os c ds -> a -> ContextT Handle os m (Maybe b)
wrapWindowFun OnMain () -> Window -> String -> IO ()
Call.setClipboardString

{- Pathdrop -}

-- | Register or unregister a callback to receive file paths when files are dropped onto the window.
setDropCallback :: MonadIO m => GPipe.Window os c ds -> Maybe ([String] -> IO ()) -> GPipe.ContextT Handle os m (Maybe ())
setDropCallback :: Window os c ds
-> Maybe ([String] -> IO ()) -> ContextT Handle os m (Maybe ())
setDropCallback = (OnMain ()
 -> Window -> Maybe (Window -> [String] -> IO ()) -> IO ())
-> Window os c ds
-> Maybe ([String] -> IO ())
-> ContextT Handle os m (Maybe ())
forall (m :: * -> *) (g :: * -> *) a b os c ds.
(MonadIO m, Functor g) =>
(OnMain a -> Window -> g (Window -> b) -> IO a)
-> Window os c ds -> g b -> ContextT Handle os m (Maybe a)
wrapCallbackSetter OnMain () -> Window -> Maybe (Window -> [String] -> IO ()) -> IO ()
Call.setDropCallback