--------------------------------------------------------------------------------
-- |
-- Module      :  Graphics.UI.GLUT.DeviceControl
-- Copyright   :  (c) Sven Panne 2002-2018
-- License     :  BSD3
--
-- Maintainer  :  Sven Panne <svenpanne@gmail.com>
-- Stability   :  stable
-- Portability :  portable
--
-- GLUT offers some routines for controlling the key repeat and polling the
-- joystick.
--
--------------------------------------------------------------------------------

module Graphics.UI.GLUT.DeviceControl (
   GlobalKeyRepeat(..), globalKeyRepeat,
   PerWindowKeyRepeat(..), perWindowKeyRepeat,
   forceJoystickCallback
) where

import Control.Monad.IO.Class ( MonadIO(..) )
import Data.StateVar ( StateVar, makeStateVar )
import Foreign.C.Types ( CInt )

import Graphics.UI.GLUT.QueryUtils
import Graphics.UI.GLUT.Raw

--------------------------------------------------------------------------------

-- | The state of the global key repeat

data GlobalKeyRepeat
   = GlobalKeyRepeatOff
   | GlobalKeyRepeatOn
   | GlobalKeyRepeatDefault
   deriving ( GlobalKeyRepeat -> GlobalKeyRepeat -> Bool
(GlobalKeyRepeat -> GlobalKeyRepeat -> Bool)
-> (GlobalKeyRepeat -> GlobalKeyRepeat -> Bool)
-> Eq GlobalKeyRepeat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GlobalKeyRepeat -> GlobalKeyRepeat -> Bool
$c/= :: GlobalKeyRepeat -> GlobalKeyRepeat -> Bool
== :: GlobalKeyRepeat -> GlobalKeyRepeat -> Bool
$c== :: GlobalKeyRepeat -> GlobalKeyRepeat -> Bool
Eq, Eq GlobalKeyRepeat
Eq GlobalKeyRepeat
-> (GlobalKeyRepeat -> GlobalKeyRepeat -> Ordering)
-> (GlobalKeyRepeat -> GlobalKeyRepeat -> Bool)
-> (GlobalKeyRepeat -> GlobalKeyRepeat -> Bool)
-> (GlobalKeyRepeat -> GlobalKeyRepeat -> Bool)
-> (GlobalKeyRepeat -> GlobalKeyRepeat -> Bool)
-> (GlobalKeyRepeat -> GlobalKeyRepeat -> GlobalKeyRepeat)
-> (GlobalKeyRepeat -> GlobalKeyRepeat -> GlobalKeyRepeat)
-> Ord GlobalKeyRepeat
GlobalKeyRepeat -> GlobalKeyRepeat -> Bool
GlobalKeyRepeat -> GlobalKeyRepeat -> Ordering
GlobalKeyRepeat -> GlobalKeyRepeat -> GlobalKeyRepeat
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: GlobalKeyRepeat -> GlobalKeyRepeat -> GlobalKeyRepeat
$cmin :: GlobalKeyRepeat -> GlobalKeyRepeat -> GlobalKeyRepeat
max :: GlobalKeyRepeat -> GlobalKeyRepeat -> GlobalKeyRepeat
$cmax :: GlobalKeyRepeat -> GlobalKeyRepeat -> GlobalKeyRepeat
>= :: GlobalKeyRepeat -> GlobalKeyRepeat -> Bool
$c>= :: GlobalKeyRepeat -> GlobalKeyRepeat -> Bool
> :: GlobalKeyRepeat -> GlobalKeyRepeat -> Bool
$c> :: GlobalKeyRepeat -> GlobalKeyRepeat -> Bool
<= :: GlobalKeyRepeat -> GlobalKeyRepeat -> Bool
$c<= :: GlobalKeyRepeat -> GlobalKeyRepeat -> Bool
< :: GlobalKeyRepeat -> GlobalKeyRepeat -> Bool
$c< :: GlobalKeyRepeat -> GlobalKeyRepeat -> Bool
compare :: GlobalKeyRepeat -> GlobalKeyRepeat -> Ordering
$ccompare :: GlobalKeyRepeat -> GlobalKeyRepeat -> Ordering
$cp1Ord :: Eq GlobalKeyRepeat
Ord, Int -> GlobalKeyRepeat -> ShowS
[GlobalKeyRepeat] -> ShowS
GlobalKeyRepeat -> String
(Int -> GlobalKeyRepeat -> ShowS)
-> (GlobalKeyRepeat -> String)
-> ([GlobalKeyRepeat] -> ShowS)
-> Show GlobalKeyRepeat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GlobalKeyRepeat] -> ShowS
$cshowList :: [GlobalKeyRepeat] -> ShowS
show :: GlobalKeyRepeat -> String
$cshow :: GlobalKeyRepeat -> String
showsPrec :: Int -> GlobalKeyRepeat -> ShowS
$cshowsPrec :: Int -> GlobalKeyRepeat -> ShowS
Show )

marshalGlobalKeyRepeat :: GlobalKeyRepeat -> CInt
marshalGlobalKeyRepeat :: GlobalKeyRepeat -> CInt
marshalGlobalKeyRepeat GlobalKeyRepeat
x = case GlobalKeyRepeat
x of
   GlobalKeyRepeat
GlobalKeyRepeatOff -> CInt
glut_KEY_REPEAT_OFF
   GlobalKeyRepeat
GlobalKeyRepeatOn -> CInt
glut_KEY_REPEAT_ON
   GlobalKeyRepeat
GlobalKeyRepeatDefault -> CInt
glut_KEY_REPEAT_DEFAULT

unmarshalGlobalKeyRepeat :: CInt -> GlobalKeyRepeat
unmarshalGlobalKeyRepeat :: CInt -> GlobalKeyRepeat
unmarshalGlobalKeyRepeat CInt
x
   | CInt
x CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
glut_KEY_REPEAT_OFF = GlobalKeyRepeat
GlobalKeyRepeatOff
   | CInt
x CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
glut_KEY_REPEAT_ON = GlobalKeyRepeat
GlobalKeyRepeatOn
   | CInt
x CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
glut_KEY_REPEAT_DEFAULT = GlobalKeyRepeat
GlobalKeyRepeatDefault
   | Bool
otherwise = String -> GlobalKeyRepeat
forall a. HasCallStack => String -> a
error (String
"unmarshalGlobalKeyRepeat: illegal value " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CInt -> String
forall a. Show a => a -> String
show CInt
x)

--------------------------------------------------------------------------------

-- | Controls the key repeat mode for the window system on a global basis if
-- possible. If supported by the window system, the key repeat can either be
-- disabled, enabled, or set to the window system\'s default key repeat state.
--
-- /X Implementation Notes:/ X11 sends @KeyPress@ events repeatedly when the
-- window system\'s global auto repeat is enabled. 'perWindowKeyRepeat' can
-- prevent these auto repeated keystrokes from being reported as keyboard or
-- special callbacks, but there is still some minimal overhead by the X server
-- to continually stream @KeyPress@ events to the GLUT application. The
-- 'globalKeyRepeat' state variable can be used to actually disable the global
-- sending of auto repeated @KeyPress@ events. Note that 'globalKeyRepeat'
-- affects the global window system auto repeat state so other applications
-- will not auto repeat if you disable auto repeat globally through
-- 'globalKeyRepeat'. GLUT applications using the X11 GLUT implementation
-- should disable key repeat with 'globalKeyRepeat' to disable key repeats most
-- efficiently, but are responsible for explicitly restoring the default key
-- repeat state on exit.
--
-- /Win32 Implementation Notes:/ The Win32 implementation of 'globalKeyRepeat'
-- does nothing. The 'perWindowKeyRepeat' can be used in the Win32 GLUT
-- implementation to ignore repeated keys on a per-window basis without changing
-- the global window system key repeat.

globalKeyRepeat :: StateVar GlobalKeyRepeat
globalKeyRepeat :: StateVar GlobalKeyRepeat
globalKeyRepeat =
   IO GlobalKeyRepeat
-> (GlobalKeyRepeat -> IO ()) -> StateVar GlobalKeyRepeat
forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar (Getter GlobalKeyRepeat
forall a. Getter a
deviceGet CInt -> GlobalKeyRepeat
unmarshalGlobalKeyRepeat GLenum
glut_DEVICE_KEY_REPEAT)
                (CInt -> IO ()
forall (m :: * -> *). MonadIO m => CInt -> m ()
glutSetKeyRepeat (CInt -> IO ())
-> (GlobalKeyRepeat -> CInt) -> GlobalKeyRepeat -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlobalKeyRepeat -> CInt
marshalGlobalKeyRepeat)

--------------------------------------------------------------------------------

-- | The state of the per-window key repeat

data PerWindowKeyRepeat
   = PerWindowKeyRepeatOff
   | PerWindowKeyRepeatOn
   deriving ( PerWindowKeyRepeat -> PerWindowKeyRepeat -> Bool
(PerWindowKeyRepeat -> PerWindowKeyRepeat -> Bool)
-> (PerWindowKeyRepeat -> PerWindowKeyRepeat -> Bool)
-> Eq PerWindowKeyRepeat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PerWindowKeyRepeat -> PerWindowKeyRepeat -> Bool
$c/= :: PerWindowKeyRepeat -> PerWindowKeyRepeat -> Bool
== :: PerWindowKeyRepeat -> PerWindowKeyRepeat -> Bool
$c== :: PerWindowKeyRepeat -> PerWindowKeyRepeat -> Bool
Eq, Eq PerWindowKeyRepeat
Eq PerWindowKeyRepeat
-> (PerWindowKeyRepeat -> PerWindowKeyRepeat -> Ordering)
-> (PerWindowKeyRepeat -> PerWindowKeyRepeat -> Bool)
-> (PerWindowKeyRepeat -> PerWindowKeyRepeat -> Bool)
-> (PerWindowKeyRepeat -> PerWindowKeyRepeat -> Bool)
-> (PerWindowKeyRepeat -> PerWindowKeyRepeat -> Bool)
-> (PerWindowKeyRepeat -> PerWindowKeyRepeat -> PerWindowKeyRepeat)
-> (PerWindowKeyRepeat -> PerWindowKeyRepeat -> PerWindowKeyRepeat)
-> Ord PerWindowKeyRepeat
PerWindowKeyRepeat -> PerWindowKeyRepeat -> Bool
PerWindowKeyRepeat -> PerWindowKeyRepeat -> Ordering
PerWindowKeyRepeat -> PerWindowKeyRepeat -> PerWindowKeyRepeat
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PerWindowKeyRepeat -> PerWindowKeyRepeat -> PerWindowKeyRepeat
$cmin :: PerWindowKeyRepeat -> PerWindowKeyRepeat -> PerWindowKeyRepeat
max :: PerWindowKeyRepeat -> PerWindowKeyRepeat -> PerWindowKeyRepeat
$cmax :: PerWindowKeyRepeat -> PerWindowKeyRepeat -> PerWindowKeyRepeat
>= :: PerWindowKeyRepeat -> PerWindowKeyRepeat -> Bool
$c>= :: PerWindowKeyRepeat -> PerWindowKeyRepeat -> Bool
> :: PerWindowKeyRepeat -> PerWindowKeyRepeat -> Bool
$c> :: PerWindowKeyRepeat -> PerWindowKeyRepeat -> Bool
<= :: PerWindowKeyRepeat -> PerWindowKeyRepeat -> Bool
$c<= :: PerWindowKeyRepeat -> PerWindowKeyRepeat -> Bool
< :: PerWindowKeyRepeat -> PerWindowKeyRepeat -> Bool
$c< :: PerWindowKeyRepeat -> PerWindowKeyRepeat -> Bool
compare :: PerWindowKeyRepeat -> PerWindowKeyRepeat -> Ordering
$ccompare :: PerWindowKeyRepeat -> PerWindowKeyRepeat -> Ordering
$cp1Ord :: Eq PerWindowKeyRepeat
Ord, Int -> PerWindowKeyRepeat -> ShowS
[PerWindowKeyRepeat] -> ShowS
PerWindowKeyRepeat -> String
(Int -> PerWindowKeyRepeat -> ShowS)
-> (PerWindowKeyRepeat -> String)
-> ([PerWindowKeyRepeat] -> ShowS)
-> Show PerWindowKeyRepeat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PerWindowKeyRepeat] -> ShowS
$cshowList :: [PerWindowKeyRepeat] -> ShowS
show :: PerWindowKeyRepeat -> String
$cshow :: PerWindowKeyRepeat -> String
showsPrec :: Int -> PerWindowKeyRepeat -> ShowS
$cshowsPrec :: Int -> PerWindowKeyRepeat -> ShowS
Show )

marshalPerWindowKeyRepeat :: PerWindowKeyRepeat -> CInt
marshalPerWindowKeyRepeat :: PerWindowKeyRepeat -> CInt
marshalPerWindowKeyRepeat PerWindowKeyRepeat
x = case PerWindowKeyRepeat
x of
   PerWindowKeyRepeat
PerWindowKeyRepeatOn -> CInt
0
   PerWindowKeyRepeat
PerWindowKeyRepeatOff -> CInt
1

unmarshalPerWindowKeyRepeat :: CInt -> PerWindowKeyRepeat
unmarshalPerWindowKeyRepeat :: CInt -> PerWindowKeyRepeat
unmarshalPerWindowKeyRepeat CInt
x
   | CInt
x CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0 = PerWindowKeyRepeat
PerWindowKeyRepeatOn
   | Bool
otherwise = PerWindowKeyRepeat
PerWindowKeyRepeatOff

--------------------------------------------------------------------------------

-- | Controls if auto repeat keystrokes are reported to the /current window./
-- Ignoring auto repeated keystrokes is generally done in conjunction with using
-- the 'Graphics.UI.GLUT.Callbacks.Window.keyboardMouseCallback'. If you do
-- not ignore auto repeated keystrokes, your GLUT application will experience
-- repeated release\/press callbacks. Games using the keyboard will typically
-- want to ignore key repeat.

perWindowKeyRepeat :: StateVar PerWindowKeyRepeat
perWindowKeyRepeat :: StateVar PerWindowKeyRepeat
perWindowKeyRepeat =
   IO PerWindowKeyRepeat
-> (PerWindowKeyRepeat -> IO ()) -> StateVar PerWindowKeyRepeat
forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar
      (Getter PerWindowKeyRepeat
forall a. Getter a
deviceGet CInt -> PerWindowKeyRepeat
unmarshalPerWindowKeyRepeat GLenum
glut_DEVICE_IGNORE_KEY_REPEAT)
      (CInt -> IO ()
forall (m :: * -> *). MonadIO m => CInt -> m ()
glutIgnoreKeyRepeat (CInt -> IO ())
-> (PerWindowKeyRepeat -> CInt) -> PerWindowKeyRepeat -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PerWindowKeyRepeat -> CInt
marshalPerWindowKeyRepeat)

--------------------------------------------------------------------------------

-- | Execute the joystick callback set by
-- 'Graphics.UI.GLUT.Callbacks.Window.joystickCallback' once (if one exists).
-- This is done in a synchronous fashion within the current context, i.e. when
-- 'forceJoystickCallback' returns, the callback will have already happened.

forceJoystickCallback :: MonadIO m => m ()
forceJoystickCallback :: m ()
forceJoystickCallback = m ()
forall (m :: * -> *). MonadIO m => m ()
glutForceJoystickFunc