--------------------------------------------------------------------------------
-- |
-- Module      :  Graphics.UI.GLUT.Callbacks.Window
-- Copyright   :  (c) Sven Panne 2002-2018
-- License     :  BSD3
--
-- Maintainer  :  Sven Panne <svenpanne@gmail.com>
-- Stability   :  stable
-- Portability :  portable
--
--------------------------------------------------------------------------------

module Graphics.UI.GLUT.Callbacks.Window (
   -- * Redisplay callbacks
   DisplayCallback, displayCallback, overlayDisplayCallback,

   -- * Reshape callback
   ReshapeCallback, reshapeCallback,

   -- * Position callback
   PositionCallback, positionCallback,

   -- * Callbacks for visibility changes
   Visibility(..), VisibilityCallback, visibilityCallback,
   WindowState(..), WindowStateCallback, windowStateCallback,

   -- * Window close callback
   CloseCallback, closeCallback,

   -- * Life cycle callbacks for mobile platforms
   InitContextCallback, initContextCallback,
   AppStatus(..), AppStatusCallback, appStatusCallback,

   -- * Keyboard callback
   KeyboardCallback, keyboardCallback, keyboardUpCallback,

   -- * Special callback
   SpecialCallback, specialCallback, specialUpCallback,

   -- * Mouse callback
   MouseCallback, mouseCallback,

   -- * Keyboard and mouse input callback
   Key(..), SpecialKey(..), MouseButton(..), KeyState(..), Modifiers(..),
   KeyboardMouseCallback, keyboardMouseCallback,

   -- * Mouse wheel callback
   WheelNumber, WheelDirection, MouseWheelCallback, mouseWheelCallback,

   -- * Mouse movement callbacks
   MotionCallback, motionCallback, passiveMotionCallback,
   Crossing(..), CrossingCallback, crossingCallback,

   -- * Spaceball callback
   SpaceballMotion, SpaceballRotation, ButtonIndex, SpaceballInput(..),
   SpaceballCallback, spaceballCallback,

   -- * Dial & button box callback
   DialAndButtonBoxInput(..), DialIndex,
   DialAndButtonBoxCallback, dialAndButtonBoxCallback,

   -- * Tablet callback
   TabletPosition(..), TabletInput(..), TabletCallback, tabletCallback,

   -- * Joystick callback
   JoystickButtons(..), JoystickPosition(..),
   JoystickCallback, joystickCallback,

   -- * Multi-touch support
   TouchID,
   MultiMouseCallback, multiMouseCallback,
   MultiCrossingCallback, multiCrossingCallback,
   MultiMotionCallback, multiMotionCallback, multiPassiveMotionCallback

) where

import Data.Bits ( (.&.) )
import Data.Char ( chr )
import Data.Maybe ( fromJust )
import Data.StateVar ( SettableStateVar, makeSettableStateVar )
import Foreign.C.Types ( CInt, CUInt )
import Graphics.Rendering.OpenGL ( Position(..), Size(..) )

import Graphics.UI.GLUT.Callbacks.Registration
import Graphics.UI.GLUT.Raw
import Graphics.UI.GLUT.State
import Graphics.UI.GLUT.Types

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

-- | A display callback

type DisplayCallback = IO ()

-- | Controls the display callback for the /current window./ When GLUT determines
-- that the normal plane for the window needs to be redisplayed, the display
-- callback for the window is called. Before the callback, the /current window/
-- is set to the window needing to be redisplayed and (if no overlay display
-- callback is registered) the /layer in use/ is set to the normal plane. The
-- entire normal plane region should be redisplayed in response to the callback
-- (this includes ancillary buffers if your program depends on their state).
--
-- GLUT determines when the display callback should be triggered based on the
-- window\'s redisplay state. The redisplay state for a window can be either set
-- explicitly by calling 'Graphics.UI.GLUT.Window.postRedisplay' or implicitly
-- as the result of window damage reported by the window system. Multiple posted
-- redisplays for a window are coalesced by GLUT to minimize the number of
-- display callbacks called.
--
-- When an overlay is established for a window, but there is no overlay display
-- callback registered, the display callback is used for redisplaying both the
-- overlay and normal plane (that is, it will be called if either the redisplay
-- state or overlay redisplay state is set). In this case, the /layer in use/ is
-- not implicitly changed on entry to the display callback.
--
-- See 'overlayDisplayCallback' to understand how distinct callbacks for the
-- overlay and normal plane of a window may be established.
--
-- When a window is created, no display callback exists for the window. It is
-- the responsibility of the programmer to install a display callback for the
-- window before the window is shown. A display callback must be registered for
-- any window that is shown. If a window becomes displayed without a display
-- callback being registered, a fatal error occurs. There is no way to
-- \"deregister\" a display callback (though another callback routine can always
-- be registered).
--
-- Upon return from the display callback, the normal damaged state of the window
-- (see 'Graphics.UI.GLUT.State.damaged') is cleared. If there is no overlay
-- display callback registered the overlay damaged state of the window (see
-- 'Graphics.UI.GLUT.State.damaged') is also cleared.

displayCallback :: SettableStateVar DisplayCallback
displayCallback :: SettableStateVar DisplayCallback
displayCallback = (DisplayCallback -> DisplayCallback)
-> SettableStateVar DisplayCallback
forall a. (a -> DisplayCallback) -> SettableStateVar a
makeSettableStateVar ((DisplayCallback -> DisplayCallback)
 -> SettableStateVar DisplayCallback)
-> (DisplayCallback -> DisplayCallback)
-> SettableStateVar DisplayCallback
forall a b. (a -> b) -> a -> b
$
   CallbackType
-> (FunPtr DisplayCallback -> DisplayCallback)
-> (DisplayCallback -> IO (FunPtr DisplayCallback))
-> Maybe DisplayCallback
-> DisplayCallback
forall a b.
CallbackType
-> (FunPtr a -> DisplayCallback)
-> (b -> IO (FunPtr a))
-> Maybe b
-> DisplayCallback
setCallback CallbackType
DisplayCB FunPtr DisplayCallback -> DisplayCallback
forall (m :: * -> *). MonadIO m => FunPtr DisplayCallback -> m ()
glutDisplayFunc DisplayCallback -> IO (FunPtr DisplayCallback)
makeDisplayFunc (Maybe DisplayCallback -> DisplayCallback)
-> (DisplayCallback -> Maybe DisplayCallback)
-> DisplayCallback
-> DisplayCallback
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DisplayCallback -> Maybe DisplayCallback
forall a. a -> Maybe a
Just

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

-- | Controls the overlay display callback for the /current window./ The overlay
-- display callback is functionally the same as the window\'s display callback
-- except that the overlay display callback is used to redisplay the window\'s
-- overlay.
--
-- When GLUT determines that the overlay plane for the window needs to be
-- redisplayed, the overlay display callback for the window is called. Before
-- the callback, the /current window/ is set to the window needing to be
-- redisplayed and the /layer in use/ is set to the overlay. The entire overlay
-- region should be redisplayed in response to the callback (this includes
-- ancillary buffers if your program depends on their state).
--
-- GLUT determines when the overlay display callback should be triggered based
-- on the window\'s overlay redisplay state. The overlay redisplay state for a
-- window can be either set explicitly by calling
-- 'Graphics.UI.GLUT.Overlay.postOverlayRedisplay' or implicitly as the result
-- of window damage reported by the window system. Multiple posted overlay
-- redisplays for a window are coalesced by GLUT to minimize the number of
-- overlay display callbacks called.
--
-- Upon return from the overlay display callback, the overlay damaged state of
-- the window (see 'Graphics.UI.GLUT.State.damaged') is cleared.
--
-- Initially there is no overlay display callback registered when an overlay is
-- established. See 'displayCallback' to understand how the display callback
-- alone is used if an overlay display callback is not registered.

overlayDisplayCallback :: SettableStateVar (Maybe DisplayCallback)
overlayDisplayCallback :: SettableStateVar (Maybe DisplayCallback)
overlayDisplayCallback = (Maybe DisplayCallback -> DisplayCallback)
-> SettableStateVar (Maybe DisplayCallback)
forall a. (a -> DisplayCallback) -> SettableStateVar a
makeSettableStateVar ((Maybe DisplayCallback -> DisplayCallback)
 -> SettableStateVar (Maybe DisplayCallback))
-> (Maybe DisplayCallback -> DisplayCallback)
-> SettableStateVar (Maybe DisplayCallback)
forall a b. (a -> b) -> a -> b
$
   CallbackType
-> (FunPtr DisplayCallback -> DisplayCallback)
-> (DisplayCallback -> IO (FunPtr DisplayCallback))
-> Maybe DisplayCallback
-> DisplayCallback
forall a b.
CallbackType
-> (FunPtr a -> DisplayCallback)
-> (b -> IO (FunPtr a))
-> Maybe b
-> DisplayCallback
setCallback CallbackType
OverlayDisplayCB FunPtr DisplayCallback -> DisplayCallback
forall (m :: * -> *). MonadIO m => FunPtr DisplayCallback -> m ()
glutOverlayDisplayFunc DisplayCallback -> IO (FunPtr DisplayCallback)
makeOverlayDisplayFunc

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

-- | A reshape callback

type ReshapeCallback = Size -> IO ()

-- | Controls the reshape callback for the /current window./ The reshape callback
-- is triggered when a window is reshaped. A reshape callback is also triggered
-- immediately before a window\'s first display callback after a window is
-- created or whenever an overlay for the window is established. The parameter
-- of the callback specifies the new window size in pixels. Before the callback,
-- the /current window/ is set to the window that has been reshaped.
--
-- If a reshape callback is not registered for a window or 'reshapeCallback' is
-- set to 'Nothing' (to deregister a previously registered callback), the
-- default reshape callback is used. This default callback will simply call
--
-- @
-- 'Graphics.Rendering.OpenGL.GL.CoordTrans.viewport' ('Graphics.Rendering.OpenGL.GL.CoordTrans.Position' 0 0) ('Graphics.Rendering.OpenGL.GL.CoordTrans.Size' /width/ /height/)
-- @
--
-- on the normal plane (and on the overlay if one exists).
--
-- If an overlay is established for the window, a single reshape callback is
-- generated. It is the callback\'s responsibility to update both the normal
-- plane and overlay for the window (changing the layer in use as necessary).
--
-- When a top-level window is reshaped, subwindows are not reshaped. It is up to
-- the GLUT program to manage the size and positions of subwindows within a
-- top-level window. Still, reshape callbacks will be triggered for subwindows
-- when their size is changed using 'Graphics.UI.GLUT.Window.windowSize'.

reshapeCallback :: SettableStateVar (Maybe ReshapeCallback)
reshapeCallback :: SettableStateVar (Maybe ReshapeCallback)
reshapeCallback = (Maybe ReshapeCallback -> DisplayCallback)
-> SettableStateVar (Maybe ReshapeCallback)
forall a. (a -> DisplayCallback) -> SettableStateVar a
makeSettableStateVar ((Maybe ReshapeCallback -> DisplayCallback)
 -> SettableStateVar (Maybe ReshapeCallback))
-> (Maybe ReshapeCallback -> DisplayCallback)
-> SettableStateVar (Maybe ReshapeCallback)
forall a b. (a -> b) -> a -> b
$
   CallbackType
-> (FunPtr ReshapeFunc -> DisplayCallback)
-> (ReshapeCallback -> IO (FunPtr ReshapeFunc))
-> Maybe ReshapeCallback
-> DisplayCallback
forall a b.
CallbackType
-> (FunPtr a -> DisplayCallback)
-> (b -> IO (FunPtr a))
-> Maybe b
-> DisplayCallback
setCallback CallbackType
ReshapeCB FunPtr ReshapeFunc -> DisplayCallback
forall (m :: * -> *). MonadIO m => FunPtr ReshapeFunc -> m ()
glutReshapeFunc (ReshapeFunc -> IO (FunPtr ReshapeFunc)
makeReshapeFunc (ReshapeFunc -> IO (FunPtr ReshapeFunc))
-> (ReshapeCallback -> ReshapeFunc)
-> ReshapeCallback
-> IO (FunPtr ReshapeFunc)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReshapeCallback -> ReshapeFunc
forall a a t.
(Integral a, Integral a) =>
(Size -> t) -> a -> a -> t
unmarshal)
   where unmarshal :: (Size -> t) -> a -> a -> t
unmarshal Size -> t
cb a
w a
h = Size -> t
cb (GLsizei -> GLsizei -> Size
Size (a -> GLsizei
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
w) (a -> GLsizei
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
h))

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

-- | A position callback

type PositionCallback = Position -> IO ()

-- | (/freeglut only/) Controls the position callback for the /current window./
-- The position callback for a window is called when the position of a window
-- changes.

positionCallback :: SettableStateVar (Maybe PositionCallback)
positionCallback :: SettableStateVar (Maybe PositionCallback)
positionCallback = (Maybe PositionCallback -> DisplayCallback)
-> SettableStateVar (Maybe PositionCallback)
forall a. (a -> DisplayCallback) -> SettableStateVar a
makeSettableStateVar ((Maybe PositionCallback -> DisplayCallback)
 -> SettableStateVar (Maybe PositionCallback))
-> (Maybe PositionCallback -> DisplayCallback)
-> SettableStateVar (Maybe PositionCallback)
forall a b. (a -> b) -> a -> b
$
   CallbackType
-> (FunPtr ReshapeFunc -> DisplayCallback)
-> (PositionCallback -> IO (FunPtr ReshapeFunc))
-> Maybe PositionCallback
-> DisplayCallback
forall a b.
CallbackType
-> (FunPtr a -> DisplayCallback)
-> (b -> IO (FunPtr a))
-> Maybe b
-> DisplayCallback
setCallback CallbackType
PositionCB FunPtr ReshapeFunc -> DisplayCallback
forall (m :: * -> *). MonadIO m => FunPtr ReshapeFunc -> m ()
glutPositionFunc (ReshapeFunc -> IO (FunPtr ReshapeFunc)
makePositionFunc (ReshapeFunc -> IO (FunPtr ReshapeFunc))
-> (PositionCallback -> ReshapeFunc)
-> PositionCallback
-> IO (FunPtr ReshapeFunc)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PositionCallback -> ReshapeFunc
forall a a t.
(Integral a, Integral a) =>
(Position -> t) -> a -> a -> t
unmarshal)
   where unmarshal :: (Position -> t) -> a -> a -> t
unmarshal Position -> t
cb a
x a
y = Position -> t
cb (GLsizei -> GLsizei -> Position
Position (a -> GLsizei
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x) (a -> GLsizei
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
y))

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

-- | The visibility state of the /current window/

data Visibility
   = NotVisible -- ^ No part of the /current window/ is visible, i.e., until the
                --   window\'s visibility changes, all further rendering to the
                --   window is discarded.
   | Visible    -- ^ The /current window/ is totally or partially visible. GLUT
                --   considers a window visible if any pixel of the window is
                --   visible or any pixel of any descendant window is visible on
                --   the screen.
   deriving ( Visibility -> Visibility -> Bool
(Visibility -> Visibility -> Bool)
-> (Visibility -> Visibility -> Bool) -> Eq Visibility
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Visibility -> Visibility -> Bool
$c/= :: Visibility -> Visibility -> Bool
== :: Visibility -> Visibility -> Bool
$c== :: Visibility -> Visibility -> Bool
Eq, Eq Visibility
Eq Visibility
-> (Visibility -> Visibility -> Ordering)
-> (Visibility -> Visibility -> Bool)
-> (Visibility -> Visibility -> Bool)
-> (Visibility -> Visibility -> Bool)
-> (Visibility -> Visibility -> Bool)
-> (Visibility -> Visibility -> Visibility)
-> (Visibility -> Visibility -> Visibility)
-> Ord Visibility
Visibility -> Visibility -> Bool
Visibility -> Visibility -> Ordering
Visibility -> Visibility -> Visibility
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 :: Visibility -> Visibility -> Visibility
$cmin :: Visibility -> Visibility -> Visibility
max :: Visibility -> Visibility -> Visibility
$cmax :: Visibility -> Visibility -> Visibility
>= :: Visibility -> Visibility -> Bool
$c>= :: Visibility -> Visibility -> Bool
> :: Visibility -> Visibility -> Bool
$c> :: Visibility -> Visibility -> Bool
<= :: Visibility -> Visibility -> Bool
$c<= :: Visibility -> Visibility -> Bool
< :: Visibility -> Visibility -> Bool
$c< :: Visibility -> Visibility -> Bool
compare :: Visibility -> Visibility -> Ordering
$ccompare :: Visibility -> Visibility -> Ordering
$cp1Ord :: Eq Visibility
Ord, Int -> Visibility -> ShowS
[Visibility] -> ShowS
Visibility -> String
(Int -> Visibility -> ShowS)
-> (Visibility -> String)
-> ([Visibility] -> ShowS)
-> Show Visibility
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Visibility] -> ShowS
$cshowList :: [Visibility] -> ShowS
show :: Visibility -> String
$cshow :: Visibility -> String
showsPrec :: Int -> Visibility -> ShowS
$cshowsPrec :: Int -> Visibility -> ShowS
Show )

unmarshalVisibility :: CInt -> Visibility
unmarshalVisibility :: CInt -> Visibility
unmarshalVisibility CInt
x
   | CInt
x CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
glut_NOT_VISIBLE = Visibility
NotVisible
   | CInt
x CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
glut_VISIBLE = Visibility
Visible
   | Bool
otherwise = String -> Visibility
forall a. HasCallStack => String -> a
error (String
"unmarshalVisibility: illegal value " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CInt -> String
forall a. Show a => a -> String
show CInt
x)

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

-- | A visibility callback

type VisibilityCallback = Visibility -> IO ()

-- | Controls the visibility callback for the /current window./ The visibility
-- callback for a window is called when the visibility of a window changes.
--
-- If the visibility callback for a window is disabled and later re-enabled, the
-- visibility status of the window is undefined; any change in window visibility
-- will be reported, that is if you disable a visibility callback and re-enable
-- the callback, you are guaranteed the next visibility change will be reported.
--
-- Note that you can either use 'visibilityCallback' or 'windowStateCallback',
-- but not both, because the former is implemented via the latter.

visibilityCallback :: SettableStateVar (Maybe VisibilityCallback)
visibilityCallback :: SettableStateVar (Maybe VisibilityCallback)
visibilityCallback = (Maybe VisibilityCallback -> DisplayCallback)
-> SettableStateVar (Maybe VisibilityCallback)
forall a. (a -> DisplayCallback) -> SettableStateVar a
makeSettableStateVar ((Maybe VisibilityCallback -> DisplayCallback)
 -> SettableStateVar (Maybe VisibilityCallback))
-> (Maybe VisibilityCallback -> DisplayCallback)
-> SettableStateVar (Maybe VisibilityCallback)
forall a b. (a -> b) -> a -> b
$
   CallbackType
-> (FunPtr VisibilityFunc -> DisplayCallback)
-> (VisibilityCallback -> IO (FunPtr VisibilityFunc))
-> Maybe VisibilityCallback
-> DisplayCallback
forall a b.
CallbackType
-> (FunPtr a -> DisplayCallback)
-> (b -> IO (FunPtr a))
-> Maybe b
-> DisplayCallback
setCallback CallbackType
VisibilityCB FunPtr VisibilityFunc -> DisplayCallback
forall (m :: * -> *). MonadIO m => FunPtr VisibilityFunc -> m ()
glutVisibilityFunc
               (VisibilityFunc -> IO (FunPtr VisibilityFunc)
makeVisibilityFunc (VisibilityFunc -> IO (FunPtr VisibilityFunc))
-> (VisibilityCallback -> VisibilityFunc)
-> VisibilityCallback
-> IO (FunPtr VisibilityFunc)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VisibilityCallback -> VisibilityFunc
forall c. (Visibility -> c) -> CInt -> c
unmarshal)
   where unmarshal :: (Visibility -> c) -> CInt -> c
unmarshal Visibility -> c
cb  = Visibility -> c
cb (Visibility -> c) -> (CInt -> Visibility) -> CInt -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Visibility
unmarshalVisibility

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

-- | The window state of the /current window/

data WindowState
   = Unmapped          -- ^ The /current window/ is unmapped.
   | FullyRetained     -- ^ The /current window/ is unobscured.
   | PartiallyRetained -- ^ The /current window/ is partially obscured.
   | FullyCovered      -- ^ The /current window/ is fully obscured.
   deriving ( WindowState -> WindowState -> Bool
(WindowState -> WindowState -> Bool)
-> (WindowState -> WindowState -> Bool) -> Eq WindowState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WindowState -> WindowState -> Bool
$c/= :: WindowState -> WindowState -> Bool
== :: WindowState -> WindowState -> Bool
$c== :: WindowState -> WindowState -> Bool
Eq, Eq WindowState
Eq WindowState
-> (WindowState -> WindowState -> Ordering)
-> (WindowState -> WindowState -> Bool)
-> (WindowState -> WindowState -> Bool)
-> (WindowState -> WindowState -> Bool)
-> (WindowState -> WindowState -> Bool)
-> (WindowState -> WindowState -> WindowState)
-> (WindowState -> WindowState -> WindowState)
-> Ord WindowState
WindowState -> WindowState -> Bool
WindowState -> WindowState -> Ordering
WindowState -> WindowState -> WindowState
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 :: WindowState -> WindowState -> WindowState
$cmin :: WindowState -> WindowState -> WindowState
max :: WindowState -> WindowState -> WindowState
$cmax :: WindowState -> WindowState -> WindowState
>= :: WindowState -> WindowState -> Bool
$c>= :: WindowState -> WindowState -> Bool
> :: WindowState -> WindowState -> Bool
$c> :: WindowState -> WindowState -> Bool
<= :: WindowState -> WindowState -> Bool
$c<= :: WindowState -> WindowState -> Bool
< :: WindowState -> WindowState -> Bool
$c< :: WindowState -> WindowState -> Bool
compare :: WindowState -> WindowState -> Ordering
$ccompare :: WindowState -> WindowState -> Ordering
$cp1Ord :: Eq WindowState
Ord, Int -> WindowState -> ShowS
[WindowState] -> ShowS
WindowState -> String
(Int -> WindowState -> ShowS)
-> (WindowState -> String)
-> ([WindowState] -> ShowS)
-> Show WindowState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WindowState] -> ShowS
$cshowList :: [WindowState] -> ShowS
show :: WindowState -> String
$cshow :: WindowState -> String
showsPrec :: Int -> WindowState -> ShowS
$cshowsPrec :: Int -> WindowState -> ShowS
Show )

unmarshalWindowState :: CInt -> WindowState
unmarshalWindowState :: CInt -> WindowState
unmarshalWindowState CInt
x
   | CInt
x CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
glut_HIDDEN = WindowState
Unmapped
   | CInt
x CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
glut_FULLY_RETAINED = WindowState
FullyRetained
   | CInt
x CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
glut_PARTIALLY_RETAINED = WindowState
PartiallyRetained
   | CInt
x CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
glut_FULLY_COVERED = WindowState
FullyCovered
   | Bool
otherwise = String -> WindowState
forall a. HasCallStack => String -> a
error (String
"unmarshalWindowState: illegal value " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CInt -> String
forall a. Show a => a -> String
show CInt
x)

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

-- | A window state callback

type WindowStateCallback = WindowState -> IO ()

-- | Controls the window state callback for the
-- /current window./ The window state callback for a window is called when the
-- window state of a window changes.
--
-- If the window state callback for a window is disabled and later re-enabled,
-- the window state state of the window is undefined; any change in the window
-- state will be reported, that is if you disable a window state callback and
-- re-enable the callback, you are guaranteed the next window state change will
-- be reported.
--
-- Note that you can either use 'visibilityCallback' or 'windowStateCallback',
-- but not both, because the former is implemented via the latter.

windowStateCallback :: SettableStateVar (Maybe WindowStateCallback)
windowStateCallback :: SettableStateVar (Maybe WindowStateCallback)
windowStateCallback = (Maybe WindowStateCallback -> DisplayCallback)
-> SettableStateVar (Maybe WindowStateCallback)
forall a. (a -> DisplayCallback) -> SettableStateVar a
makeSettableStateVar ((Maybe WindowStateCallback -> DisplayCallback)
 -> SettableStateVar (Maybe WindowStateCallback))
-> (Maybe WindowStateCallback -> DisplayCallback)
-> SettableStateVar (Maybe WindowStateCallback)
forall a b. (a -> b) -> a -> b
$
   CallbackType
-> (FunPtr VisibilityFunc -> DisplayCallback)
-> (WindowStateCallback -> IO (FunPtr VisibilityFunc))
-> Maybe WindowStateCallback
-> DisplayCallback
forall a b.
CallbackType
-> (FunPtr a -> DisplayCallback)
-> (b -> IO (FunPtr a))
-> Maybe b
-> DisplayCallback
setCallback CallbackType
WindowStatusCB FunPtr VisibilityFunc -> DisplayCallback
forall (m :: * -> *). MonadIO m => FunPtr VisibilityFunc -> m ()
glutWindowStatusFunc
               (VisibilityFunc -> IO (FunPtr VisibilityFunc)
makeWindowStatusFunc (VisibilityFunc -> IO (FunPtr VisibilityFunc))
-> (WindowStateCallback -> VisibilityFunc)
-> WindowStateCallback
-> IO (FunPtr VisibilityFunc)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowStateCallback -> VisibilityFunc
forall c. (WindowState -> c) -> CInt -> c
unmarshal)
   where unmarshal :: (WindowState -> c) -> CInt -> c
unmarshal WindowState -> c
cb  = WindowState -> c
cb (WindowState -> c) -> (CInt -> WindowState) -> CInt -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> WindowState
unmarshalWindowState

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

-- | A window close callback

type CloseCallback = IO ()

-- | Controls the window close callback for the /current window/.

closeCallback :: SettableStateVar (Maybe CloseCallback)
closeCallback :: SettableStateVar (Maybe DisplayCallback)
closeCallback = (Maybe DisplayCallback -> DisplayCallback)
-> SettableStateVar (Maybe DisplayCallback)
forall a. (a -> DisplayCallback) -> SettableStateVar a
makeSettableStateVar ((Maybe DisplayCallback -> DisplayCallback)
 -> SettableStateVar (Maybe DisplayCallback))
-> (Maybe DisplayCallback -> DisplayCallback)
-> SettableStateVar (Maybe DisplayCallback)
forall a b. (a -> b) -> a -> b
$
   CallbackType
-> (FunPtr DisplayCallback -> DisplayCallback)
-> (DisplayCallback -> IO (FunPtr DisplayCallback))
-> Maybe DisplayCallback
-> DisplayCallback
forall a b.
CallbackType
-> (FunPtr a -> DisplayCallback)
-> (b -> IO (FunPtr a))
-> Maybe b
-> DisplayCallback
setCallback CallbackType
CloseCB FunPtr DisplayCallback -> DisplayCallback
forall (m :: * -> *). MonadIO m => FunPtr DisplayCallback -> m ()
glutCloseFunc DisplayCallback -> IO (FunPtr DisplayCallback)
makeCloseFunc

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

-- | An initialize context callback

type InitContextCallback = IO ()

-- | (/freeglut only/) Controls the initialize context callback for the /current
-- window/.

initContextCallback :: SettableStateVar (Maybe InitContextCallback)
initContextCallback :: SettableStateVar (Maybe DisplayCallback)
initContextCallback = (Maybe DisplayCallback -> DisplayCallback)
-> SettableStateVar (Maybe DisplayCallback)
forall a. (a -> DisplayCallback) -> SettableStateVar a
makeSettableStateVar ((Maybe DisplayCallback -> DisplayCallback)
 -> SettableStateVar (Maybe DisplayCallback))
-> (Maybe DisplayCallback -> DisplayCallback)
-> SettableStateVar (Maybe DisplayCallback)
forall a b. (a -> b) -> a -> b
$
   CallbackType
-> (FunPtr DisplayCallback -> DisplayCallback)
-> (DisplayCallback -> IO (FunPtr DisplayCallback))
-> Maybe DisplayCallback
-> DisplayCallback
forall a b.
CallbackType
-> (FunPtr a -> DisplayCallback)
-> (b -> IO (FunPtr a))
-> Maybe b
-> DisplayCallback
setCallback CallbackType
InitContextCB FunPtr DisplayCallback -> DisplayCallback
forall (m :: * -> *). MonadIO m => FunPtr DisplayCallback -> m ()
glutInitContextFunc DisplayCallback -> IO (FunPtr DisplayCallback)
makeInitContextFunc

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

-- | The application status of the /current window/

data AppStatus
   = AppStatusPause
   | AppStatusResume
   deriving ( AppStatus -> AppStatus -> Bool
(AppStatus -> AppStatus -> Bool)
-> (AppStatus -> AppStatus -> Bool) -> Eq AppStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AppStatus -> AppStatus -> Bool
$c/= :: AppStatus -> AppStatus -> Bool
== :: AppStatus -> AppStatus -> Bool
$c== :: AppStatus -> AppStatus -> Bool
Eq, Eq AppStatus
Eq AppStatus
-> (AppStatus -> AppStatus -> Ordering)
-> (AppStatus -> AppStatus -> Bool)
-> (AppStatus -> AppStatus -> Bool)
-> (AppStatus -> AppStatus -> Bool)
-> (AppStatus -> AppStatus -> Bool)
-> (AppStatus -> AppStatus -> AppStatus)
-> (AppStatus -> AppStatus -> AppStatus)
-> Ord AppStatus
AppStatus -> AppStatus -> Bool
AppStatus -> AppStatus -> Ordering
AppStatus -> AppStatus -> AppStatus
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 :: AppStatus -> AppStatus -> AppStatus
$cmin :: AppStatus -> AppStatus -> AppStatus
max :: AppStatus -> AppStatus -> AppStatus
$cmax :: AppStatus -> AppStatus -> AppStatus
>= :: AppStatus -> AppStatus -> Bool
$c>= :: AppStatus -> AppStatus -> Bool
> :: AppStatus -> AppStatus -> Bool
$c> :: AppStatus -> AppStatus -> Bool
<= :: AppStatus -> AppStatus -> Bool
$c<= :: AppStatus -> AppStatus -> Bool
< :: AppStatus -> AppStatus -> Bool
$c< :: AppStatus -> AppStatus -> Bool
compare :: AppStatus -> AppStatus -> Ordering
$ccompare :: AppStatus -> AppStatus -> Ordering
$cp1Ord :: Eq AppStatus
Ord, Int -> AppStatus -> ShowS
[AppStatus] -> ShowS
AppStatus -> String
(Int -> AppStatus -> ShowS)
-> (AppStatus -> String)
-> ([AppStatus] -> ShowS)
-> Show AppStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AppStatus] -> ShowS
$cshowList :: [AppStatus] -> ShowS
show :: AppStatus -> String
$cshow :: AppStatus -> String
showsPrec :: Int -> AppStatus -> ShowS
$cshowsPrec :: Int -> AppStatus -> ShowS
Show )

unmarshalAppStatus :: CInt -> AppStatus
unmarshalAppStatus :: CInt -> AppStatus
unmarshalAppStatus CInt
x
   | CInt
x CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
glut_APPSTATUS_PAUSE = AppStatus
AppStatusPause
   | CInt
x CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
glut_APPSTATUS_RESUME = AppStatus
AppStatusResume
   | Bool
otherwise = String -> AppStatus
forall a. HasCallStack => String -> a
error (String
"unmarshalAppStatus: illegal value " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CInt -> String
forall a. Show a => a -> String
show CInt
x)

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

-- | An application status callback

type AppStatusCallback = AppStatus -> IO ()

-- | Controls the application status callback for the /current window./

appStatusCallback :: SettableStateVar (Maybe AppStatusCallback)
appStatusCallback :: SettableStateVar (Maybe AppStatusCallback)
appStatusCallback = (Maybe AppStatusCallback -> DisplayCallback)
-> SettableStateVar (Maybe AppStatusCallback)
forall a. (a -> DisplayCallback) -> SettableStateVar a
makeSettableStateVar ((Maybe AppStatusCallback -> DisplayCallback)
 -> SettableStateVar (Maybe AppStatusCallback))
-> (Maybe AppStatusCallback -> DisplayCallback)
-> SettableStateVar (Maybe AppStatusCallback)
forall a b. (a -> b) -> a -> b
$
   CallbackType
-> (FunPtr VisibilityFunc -> DisplayCallback)
-> (AppStatusCallback -> IO (FunPtr VisibilityFunc))
-> Maybe AppStatusCallback
-> DisplayCallback
forall a b.
CallbackType
-> (FunPtr a -> DisplayCallback)
-> (b -> IO (FunPtr a))
-> Maybe b
-> DisplayCallback
setCallback CallbackType
AppStatusCB FunPtr VisibilityFunc -> DisplayCallback
forall (m :: * -> *). MonadIO m => FunPtr VisibilityFunc -> m ()
glutAppStatusFunc
               (VisibilityFunc -> IO (FunPtr VisibilityFunc)
makeAppStatusFunc (VisibilityFunc -> IO (FunPtr VisibilityFunc))
-> (AppStatusCallback -> VisibilityFunc)
-> AppStatusCallback
-> IO (FunPtr VisibilityFunc)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppStatusCallback -> VisibilityFunc
forall c. (AppStatus -> c) -> CInt -> c
unmarshal)
   where unmarshal :: (AppStatus -> c) -> CInt -> c
unmarshal AppStatus -> c
cb  = AppStatus -> c
cb (AppStatus -> c) -> (CInt -> AppStatus) -> CInt -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> AppStatus
unmarshalAppStatus

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

-- | A keyboard callback

type KeyboardCallback = Char -> Position -> IO ()

setKeyboardCallback :: Maybe KeyboardCallback -> IO ()
setKeyboardCallback :: Maybe KeyboardCallback -> DisplayCallback
setKeyboardCallback =
   CallbackType
-> (FunPtr KeyboardFunc -> DisplayCallback)
-> (KeyboardCallback -> IO (FunPtr KeyboardFunc))
-> Maybe KeyboardCallback
-> DisplayCallback
forall a b.
CallbackType
-> (FunPtr a -> DisplayCallback)
-> (b -> IO (FunPtr a))
-> Maybe b
-> DisplayCallback
setCallback CallbackType
KeyboardCB FunPtr KeyboardFunc -> DisplayCallback
forall (m :: * -> *). MonadIO m => FunPtr KeyboardFunc -> m ()
glutKeyboardFunc (KeyboardFunc -> IO (FunPtr KeyboardFunc)
makeKeyboardFunc (KeyboardFunc -> IO (FunPtr KeyboardFunc))
-> (KeyboardCallback -> KeyboardFunc)
-> KeyboardCallback
-> IO (FunPtr KeyboardFunc)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyboardCallback -> KeyboardFunc
forall a a a t.
(Integral a, Integral a, Integral a) =>
(Char -> Position -> t) -> a -> a -> a -> t
unmarshal)
   where unmarshal :: (Char -> Position -> t) -> a -> a -> a -> t
unmarshal Char -> Position -> t
cb a
c a
x a
y = Char -> Position -> t
cb (Int -> Char
chr (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
c))
                                 (GLsizei -> GLsizei -> Position
Position (a -> GLsizei
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x) (a -> GLsizei
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
y))

-- | Controls the keyboard callback for the /current window/. This is
-- activated only when a key is pressed.

keyboardCallback :: SettableStateVar (Maybe KeyboardCallback)
keyboardCallback :: SettableStateVar (Maybe KeyboardCallback)
keyboardCallback = (Maybe KeyboardCallback -> DisplayCallback)
-> SettableStateVar (Maybe KeyboardCallback)
forall a. (a -> DisplayCallback) -> SettableStateVar a
makeSettableStateVar Maybe KeyboardCallback -> DisplayCallback
setKeyboardCallback

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

setKeyboardUpCallback :: Maybe KeyboardCallback -> IO ()
setKeyboardUpCallback :: Maybe KeyboardCallback -> DisplayCallback
setKeyboardUpCallback =
   CallbackType
-> (FunPtr KeyboardFunc -> DisplayCallback)
-> (KeyboardCallback -> IO (FunPtr KeyboardFunc))
-> Maybe KeyboardCallback
-> DisplayCallback
forall a b.
CallbackType
-> (FunPtr a -> DisplayCallback)
-> (b -> IO (FunPtr a))
-> Maybe b
-> DisplayCallback
setCallback CallbackType
KeyboardUpCB FunPtr KeyboardFunc -> DisplayCallback
forall (m :: * -> *). MonadIO m => FunPtr KeyboardFunc -> m ()
glutKeyboardUpFunc
               (KeyboardFunc -> IO (FunPtr KeyboardFunc)
makeKeyboardUpFunc (KeyboardFunc -> IO (FunPtr KeyboardFunc))
-> (KeyboardCallback -> KeyboardFunc)
-> KeyboardCallback
-> IO (FunPtr KeyboardFunc)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyboardCallback -> KeyboardFunc
forall a a a t.
(Integral a, Integral a, Integral a) =>
(Char -> Position -> t) -> a -> a -> a -> t
unmarshal)
   where unmarshal :: (Char -> Position -> t) -> a -> a -> a -> t
unmarshal Char -> Position -> t
cb a
c a
x a
y = Char -> Position -> t
cb (Int -> Char
chr (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
c))
                                 (GLsizei -> GLsizei -> Position
Position (a -> GLsizei
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x) (a -> GLsizei
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
y))

-- | Controls the keyboard callback for the /current window/. This is
-- activated only when a key is released.

keyboardUpCallback :: SettableStateVar (Maybe KeyboardCallback)
keyboardUpCallback :: SettableStateVar (Maybe KeyboardCallback)
keyboardUpCallback = (Maybe KeyboardCallback -> DisplayCallback)
-> SettableStateVar (Maybe KeyboardCallback)
forall a. (a -> DisplayCallback) -> SettableStateVar a
makeSettableStateVar Maybe KeyboardCallback -> DisplayCallback
setKeyboardUpCallback

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

-- | Special keys

data SpecialKey
   = KeyF1
   | KeyF2
   | KeyF3
   | KeyF4
   | KeyF5
   | KeyF6
   | KeyF7
   | KeyF8
   | KeyF9
   | KeyF10
   | KeyF11
   | KeyF12
   | KeyLeft
   | KeyUp
   | KeyRight
   | KeyDown
   | KeyPageUp
   | KeyPageDown
   | KeyHome
   | KeyEnd
   | KeyInsert
   | KeyNumLock
   | KeyBegin
   | KeyDelete
   | KeyShiftL
   | KeyShiftR
   | KeyCtrlL
   | KeyCtrlR
   | KeyAltL
   | KeyAltR
   | KeyUnknown Int -- ^ You should actually never encounter this value, it is
                    -- just here as a safeguard against future changes in the
                    -- native GLUT library.
   deriving ( SpecialKey -> SpecialKey -> Bool
(SpecialKey -> SpecialKey -> Bool)
-> (SpecialKey -> SpecialKey -> Bool) -> Eq SpecialKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SpecialKey -> SpecialKey -> Bool
$c/= :: SpecialKey -> SpecialKey -> Bool
== :: SpecialKey -> SpecialKey -> Bool
$c== :: SpecialKey -> SpecialKey -> Bool
Eq, Eq SpecialKey
Eq SpecialKey
-> (SpecialKey -> SpecialKey -> Ordering)
-> (SpecialKey -> SpecialKey -> Bool)
-> (SpecialKey -> SpecialKey -> Bool)
-> (SpecialKey -> SpecialKey -> Bool)
-> (SpecialKey -> SpecialKey -> Bool)
-> (SpecialKey -> SpecialKey -> SpecialKey)
-> (SpecialKey -> SpecialKey -> SpecialKey)
-> Ord SpecialKey
SpecialKey -> SpecialKey -> Bool
SpecialKey -> SpecialKey -> Ordering
SpecialKey -> SpecialKey -> SpecialKey
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 :: SpecialKey -> SpecialKey -> SpecialKey
$cmin :: SpecialKey -> SpecialKey -> SpecialKey
max :: SpecialKey -> SpecialKey -> SpecialKey
$cmax :: SpecialKey -> SpecialKey -> SpecialKey
>= :: SpecialKey -> SpecialKey -> Bool
$c>= :: SpecialKey -> SpecialKey -> Bool
> :: SpecialKey -> SpecialKey -> Bool
$c> :: SpecialKey -> SpecialKey -> Bool
<= :: SpecialKey -> SpecialKey -> Bool
$c<= :: SpecialKey -> SpecialKey -> Bool
< :: SpecialKey -> SpecialKey -> Bool
$c< :: SpecialKey -> SpecialKey -> Bool
compare :: SpecialKey -> SpecialKey -> Ordering
$ccompare :: SpecialKey -> SpecialKey -> Ordering
$cp1Ord :: Eq SpecialKey
Ord, Int -> SpecialKey -> ShowS
[SpecialKey] -> ShowS
SpecialKey -> String
(Int -> SpecialKey -> ShowS)
-> (SpecialKey -> String)
-> ([SpecialKey] -> ShowS)
-> Show SpecialKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SpecialKey] -> ShowS
$cshowList :: [SpecialKey] -> ShowS
show :: SpecialKey -> String
$cshow :: SpecialKey -> String
showsPrec :: Int -> SpecialKey -> ShowS
$cshowsPrec :: Int -> SpecialKey -> ShowS
Show )

unmarshalSpecialKey :: CInt -> SpecialKey
unmarshalSpecialKey :: CInt -> SpecialKey
unmarshalSpecialKey CInt
x
   | CInt
x CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
glut_KEY_F1 = SpecialKey
KeyF1
   | CInt
x CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
glut_KEY_F2 = SpecialKey
KeyF2
   | CInt
x CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
glut_KEY_F3 = SpecialKey
KeyF3
   | CInt
x CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
glut_KEY_F4 = SpecialKey
KeyF4
   | CInt
x CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
glut_KEY_F5 = SpecialKey
KeyF5
   | CInt
x CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
glut_KEY_F6 = SpecialKey
KeyF6
   | CInt
x CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
glut_KEY_F7 = SpecialKey
KeyF7
   | CInt
x CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
glut_KEY_F8 = SpecialKey
KeyF8
   | CInt
x CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
glut_KEY_F9 = SpecialKey
KeyF9
   | CInt
x CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
glut_KEY_F10 = SpecialKey
KeyF10
   | CInt
x CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
glut_KEY_F11 = SpecialKey
KeyF11
   | CInt
x CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
glut_KEY_F12 = SpecialKey
KeyF12
   | CInt
x CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
glut_KEY_LEFT = SpecialKey
KeyLeft
   | CInt
x CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
glut_KEY_UP = SpecialKey
KeyUp
   | CInt
x CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
glut_KEY_RIGHT = SpecialKey
KeyRight
   | CInt
x CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
glut_KEY_DOWN = SpecialKey
KeyDown
   | CInt
x CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
glut_KEY_PAGE_UP = SpecialKey
KeyPageUp
   | CInt
x CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
glut_KEY_PAGE_DOWN = SpecialKey
KeyPageDown
   | CInt
x CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
glut_KEY_HOME = SpecialKey
KeyHome
   | CInt
x CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
glut_KEY_END = SpecialKey
KeyEnd
   | CInt
x CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
glut_KEY_INSERT = SpecialKey
KeyInsert
   | CInt
x CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
glut_KEY_NUM_LOCK = SpecialKey
KeyNumLock
   | CInt
x CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
glut_KEY_BEGIN = SpecialKey
KeyBegin
   | CInt
x CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
glut_KEY_DELETE = SpecialKey
KeyDelete
   | CInt
x CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
glut_KEY_SHIFT_L = SpecialKey
KeyShiftL
   | CInt
x CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
glut_KEY_SHIFT_R = SpecialKey
KeyShiftR
   | CInt
x CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
glut_KEY_CTRL_L = SpecialKey
KeyCtrlL
   | CInt
x CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
glut_KEY_CTRL_R = SpecialKey
KeyCtrlR
   | CInt
x CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
glut_KEY_ALT_L = SpecialKey
KeyAltL
   | CInt
x CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
glut_KEY_ALT_R = SpecialKey
KeyAltR
   | Bool
otherwise = Int -> SpecialKey
KeyUnknown (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
x)

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

-- | A special key callback

type SpecialCallback = SpecialKey -> Position -> IO ()

setSpecialCallback :: Maybe SpecialCallback -> IO ()
setSpecialCallback :: Maybe SpecialCallback -> DisplayCallback
setSpecialCallback =
   CallbackType
-> (FunPtr SpecialFunc -> DisplayCallback)
-> (SpecialCallback -> IO (FunPtr SpecialFunc))
-> Maybe SpecialCallback
-> DisplayCallback
forall a b.
CallbackType
-> (FunPtr a -> DisplayCallback)
-> (b -> IO (FunPtr a))
-> Maybe b
-> DisplayCallback
setCallback CallbackType
SpecialCB FunPtr SpecialFunc -> DisplayCallback
forall (m :: * -> *). MonadIO m => FunPtr SpecialFunc -> m ()
glutSpecialFunc (SpecialFunc -> IO (FunPtr SpecialFunc)
makeSpecialFunc (SpecialFunc -> IO (FunPtr SpecialFunc))
-> (SpecialCallback -> SpecialFunc)
-> SpecialCallback
-> IO (FunPtr SpecialFunc)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SpecialCallback -> SpecialFunc
forall a a t.
(Integral a, Integral a) =>
(SpecialKey -> Position -> t) -> CInt -> a -> a -> t
unmarshal)
   where unmarshal :: (SpecialKey -> Position -> t) -> CInt -> a -> a -> t
unmarshal SpecialKey -> Position -> t
cb CInt
k a
x a
y = SpecialKey -> Position -> t
cb (CInt -> SpecialKey
unmarshalSpecialKey CInt
k)
                                 (GLsizei -> GLsizei -> Position
Position (a -> GLsizei
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x) (a -> GLsizei
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
y))

-- | Controls the special key callback for the /current window/. This is
-- activated only when a special key is pressed.

specialCallback :: SettableStateVar (Maybe SpecialCallback)
specialCallback :: SettableStateVar (Maybe SpecialCallback)
specialCallback = (Maybe SpecialCallback -> DisplayCallback)
-> SettableStateVar (Maybe SpecialCallback)
forall a. (a -> DisplayCallback) -> SettableStateVar a
makeSettableStateVar Maybe SpecialCallback -> DisplayCallback
setSpecialCallback

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

setSpecialUpCallback :: Maybe SpecialCallback -> IO ()
setSpecialUpCallback :: Maybe SpecialCallback -> DisplayCallback
setSpecialUpCallback =
   CallbackType
-> (FunPtr SpecialFunc -> DisplayCallback)
-> (SpecialCallback -> IO (FunPtr SpecialFunc))
-> Maybe SpecialCallback
-> DisplayCallback
forall a b.
CallbackType
-> (FunPtr a -> DisplayCallback)
-> (b -> IO (FunPtr a))
-> Maybe b
-> DisplayCallback
setCallback CallbackType
SpecialUpCB FunPtr SpecialFunc -> DisplayCallback
forall (m :: * -> *). MonadIO m => FunPtr SpecialFunc -> m ()
glutSpecialUpFunc (SpecialFunc -> IO (FunPtr SpecialFunc)
makeSpecialUpFunc (SpecialFunc -> IO (FunPtr SpecialFunc))
-> (SpecialCallback -> SpecialFunc)
-> SpecialCallback
-> IO (FunPtr SpecialFunc)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SpecialCallback -> SpecialFunc
forall a a t.
(Integral a, Integral a) =>
(SpecialKey -> Position -> t) -> CInt -> a -> a -> t
unmarshal)
   where unmarshal :: (SpecialKey -> Position -> t) -> CInt -> a -> a -> t
unmarshal SpecialKey -> Position -> t
cb CInt
k a
x a
y = SpecialKey -> Position -> t
cb (CInt -> SpecialKey
unmarshalSpecialKey CInt
k)
                                 (GLsizei -> GLsizei -> Position
Position (a -> GLsizei
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x) (a -> GLsizei
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
y))

-- | Controls the special key callback for the /current window/. This is
-- activated only when a special key is released.

specialUpCallback :: SettableStateVar (Maybe SpecialCallback)
specialUpCallback :: SettableStateVar (Maybe SpecialCallback)
specialUpCallback = (Maybe SpecialCallback -> DisplayCallback)
-> SettableStateVar (Maybe SpecialCallback)
forall a. (a -> DisplayCallback) -> SettableStateVar a
makeSettableStateVar Maybe SpecialCallback -> DisplayCallback
setSpecialUpCallback

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

-- | The current state of a key or button

data KeyState
   = Down
   | Up
   deriving ( KeyState -> KeyState -> Bool
(KeyState -> KeyState -> Bool)
-> (KeyState -> KeyState -> Bool) -> Eq KeyState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KeyState -> KeyState -> Bool
$c/= :: KeyState -> KeyState -> Bool
== :: KeyState -> KeyState -> Bool
$c== :: KeyState -> KeyState -> Bool
Eq, Eq KeyState
Eq KeyState
-> (KeyState -> KeyState -> Ordering)
-> (KeyState -> KeyState -> Bool)
-> (KeyState -> KeyState -> Bool)
-> (KeyState -> KeyState -> Bool)
-> (KeyState -> KeyState -> Bool)
-> (KeyState -> KeyState -> KeyState)
-> (KeyState -> KeyState -> KeyState)
-> Ord KeyState
KeyState -> KeyState -> Bool
KeyState -> KeyState -> Ordering
KeyState -> KeyState -> KeyState
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 :: KeyState -> KeyState -> KeyState
$cmin :: KeyState -> KeyState -> KeyState
max :: KeyState -> KeyState -> KeyState
$cmax :: KeyState -> KeyState -> KeyState
>= :: KeyState -> KeyState -> Bool
$c>= :: KeyState -> KeyState -> Bool
> :: KeyState -> KeyState -> Bool
$c> :: KeyState -> KeyState -> Bool
<= :: KeyState -> KeyState -> Bool
$c<= :: KeyState -> KeyState -> Bool
< :: KeyState -> KeyState -> Bool
$c< :: KeyState -> KeyState -> Bool
compare :: KeyState -> KeyState -> Ordering
$ccompare :: KeyState -> KeyState -> Ordering
$cp1Ord :: Eq KeyState
Ord, Int -> KeyState -> ShowS
[KeyState] -> ShowS
KeyState -> String
(Int -> KeyState -> ShowS)
-> (KeyState -> String) -> ([KeyState] -> ShowS) -> Show KeyState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KeyState] -> ShowS
$cshowList :: [KeyState] -> ShowS
show :: KeyState -> String
$cshow :: KeyState -> String
showsPrec :: Int -> KeyState -> ShowS
$cshowsPrec :: Int -> KeyState -> ShowS
Show )

unmarshalKeyState :: CInt -> KeyState
unmarshalKeyState :: CInt -> KeyState
unmarshalKeyState CInt
x
   | CInt
x CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
glut_DOWN = KeyState
Down
   | CInt
x CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
glut_UP = KeyState
Up
   | Bool
otherwise = String -> KeyState
forall a. HasCallStack => String -> a
error (String
"unmarshalKeyState: illegal value " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CInt -> String
forall a. Show a => a -> String
show CInt
x)

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

-- | A mouse callback

type MouseCallback = MouseButton -> KeyState -> Position -> IO ()

setMouseCallback :: Maybe MouseCallback -> IO ()
setMouseCallback :: Maybe MouseCallback -> DisplayCallback
setMouseCallback =
   CallbackType
-> (FunPtr MouseFunc -> DisplayCallback)
-> (MouseCallback -> IO (FunPtr MouseFunc))
-> Maybe MouseCallback
-> DisplayCallback
forall a b.
CallbackType
-> (FunPtr a -> DisplayCallback)
-> (b -> IO (FunPtr a))
-> Maybe b
-> DisplayCallback
setCallback CallbackType
MouseCB FunPtr MouseFunc -> DisplayCallback
forall (m :: * -> *). MonadIO m => FunPtr MouseFunc -> m ()
glutMouseFunc (MouseFunc -> IO (FunPtr MouseFunc)
makeMouseFunc (MouseFunc -> IO (FunPtr MouseFunc))
-> (MouseCallback -> MouseFunc)
-> MouseCallback
-> IO (FunPtr MouseFunc)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MouseCallback -> MouseFunc
forall a a t.
(Integral a, Integral a) =>
(MouseButton -> KeyState -> Position -> t)
-> CInt -> CInt -> a -> a -> t
unmarshal)
   where unmarshal :: (MouseButton -> KeyState -> Position -> t)
-> CInt -> CInt -> a -> a -> t
unmarshal MouseButton -> KeyState -> Position -> t
cb CInt
b CInt
s a
x a
y = MouseButton -> KeyState -> Position -> t
cb (CInt -> MouseButton
unmarshalMouseButton CInt
b)
                                   (CInt -> KeyState
unmarshalKeyState CInt
s)
                                   (GLsizei -> GLsizei -> Position
Position (a -> GLsizei
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x) (a -> GLsizei
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
y))

-- | Controls the mouse callback for the /current window/.

mouseCallback :: SettableStateVar (Maybe MouseCallback)
mouseCallback :: SettableStateVar (Maybe MouseCallback)
mouseCallback = (Maybe MouseCallback -> DisplayCallback)
-> SettableStateVar (Maybe MouseCallback)
forall a. (a -> DisplayCallback) -> SettableStateVar a
makeSettableStateVar Maybe MouseCallback -> DisplayCallback
setMouseCallback

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

-- | The state of the keyboard modifiers

data Modifiers = Modifiers { Modifiers -> KeyState
shift, Modifiers -> KeyState
ctrl, Modifiers -> KeyState
alt :: KeyState }
   deriving ( Modifiers -> Modifiers -> Bool
(Modifiers -> Modifiers -> Bool)
-> (Modifiers -> Modifiers -> Bool) -> Eq Modifiers
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Modifiers -> Modifiers -> Bool
$c/= :: Modifiers -> Modifiers -> Bool
== :: Modifiers -> Modifiers -> Bool
$c== :: Modifiers -> Modifiers -> Bool
Eq, Eq Modifiers
Eq Modifiers
-> (Modifiers -> Modifiers -> Ordering)
-> (Modifiers -> Modifiers -> Bool)
-> (Modifiers -> Modifiers -> Bool)
-> (Modifiers -> Modifiers -> Bool)
-> (Modifiers -> Modifiers -> Bool)
-> (Modifiers -> Modifiers -> Modifiers)
-> (Modifiers -> Modifiers -> Modifiers)
-> Ord Modifiers
Modifiers -> Modifiers -> Bool
Modifiers -> Modifiers -> Ordering
Modifiers -> Modifiers -> Modifiers
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 :: Modifiers -> Modifiers -> Modifiers
$cmin :: Modifiers -> Modifiers -> Modifiers
max :: Modifiers -> Modifiers -> Modifiers
$cmax :: Modifiers -> Modifiers -> Modifiers
>= :: Modifiers -> Modifiers -> Bool
$c>= :: Modifiers -> Modifiers -> Bool
> :: Modifiers -> Modifiers -> Bool
$c> :: Modifiers -> Modifiers -> Bool
<= :: Modifiers -> Modifiers -> Bool
$c<= :: Modifiers -> Modifiers -> Bool
< :: Modifiers -> Modifiers -> Bool
$c< :: Modifiers -> Modifiers -> Bool
compare :: Modifiers -> Modifiers -> Ordering
$ccompare :: Modifiers -> Modifiers -> Ordering
$cp1Ord :: Eq Modifiers
Ord, Int -> Modifiers -> ShowS
[Modifiers] -> ShowS
Modifiers -> String
(Int -> Modifiers -> ShowS)
-> (Modifiers -> String)
-> ([Modifiers] -> ShowS)
-> Show Modifiers
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Modifiers] -> ShowS
$cshowList :: [Modifiers] -> ShowS
show :: Modifiers -> String
$cshow :: Modifiers -> String
showsPrec :: Int -> Modifiers -> ShowS
$cshowsPrec :: Int -> Modifiers -> ShowS
Show )

-- Could use fromBitfield + Enum/Bounded instances + marshalModifier instead...
unmarshalModifiers :: CInt -> Modifiers
unmarshalModifiers :: CInt -> Modifiers
unmarshalModifiers CInt
m = Modifiers :: KeyState -> KeyState -> KeyState -> Modifiers
Modifiers {
   shift :: KeyState
shift = if (CInt
m CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
.&. CInt
glut_ACTIVE_SHIFT) CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0 then KeyState
Down else KeyState
Up,
   ctrl :: KeyState
ctrl  = if (CInt
m CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
.&. CInt
glut_ACTIVE_CTRL ) CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0 then KeyState
Down else KeyState
Up,
   alt :: KeyState
alt   = if (CInt
m CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
.&. CInt
glut_ACTIVE_ALT  ) CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0 then KeyState
Down else KeyState
Up }

getModifiers :: IO Modifiers
getModifiers :: IO Modifiers
getModifiers = (CInt -> Modifiers) -> IO CInt -> IO Modifiers
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CInt -> Modifiers
unmarshalModifiers IO CInt
forall (m :: * -> *). MonadIO m => m CInt
glutGetModifiers

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

-- | A generalized view of keys

data Key
   = Char Char
   | SpecialKey SpecialKey
   | MouseButton MouseButton
   deriving ( Key -> Key -> Bool
(Key -> Key -> Bool) -> (Key -> Key -> Bool) -> Eq Key
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Key -> Key -> Bool
$c/= :: Key -> Key -> Bool
== :: Key -> Key -> Bool
$c== :: Key -> Key -> Bool
Eq, Eq Key
Eq Key
-> (Key -> Key -> Ordering)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Key)
-> (Key -> Key -> Key)
-> Ord Key
Key -> Key -> Bool
Key -> Key -> Ordering
Key -> Key -> Key
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 :: Key -> Key -> Key
$cmin :: Key -> Key -> Key
max :: Key -> Key -> Key
$cmax :: Key -> Key -> Key
>= :: Key -> Key -> Bool
$c>= :: Key -> Key -> Bool
> :: Key -> Key -> Bool
$c> :: Key -> Key -> Bool
<= :: Key -> Key -> Bool
$c<= :: Key -> Key -> Bool
< :: Key -> Key -> Bool
$c< :: Key -> Key -> Bool
compare :: Key -> Key -> Ordering
$ccompare :: Key -> Key -> Ordering
$cp1Ord :: Eq Key
Ord, Int -> Key -> ShowS
[Key] -> ShowS
Key -> String
(Int -> Key -> ShowS)
-> (Key -> String) -> ([Key] -> ShowS) -> Show Key
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Key] -> ShowS
$cshowList :: [Key] -> ShowS
show :: Key -> String
$cshow :: Key -> String
showsPrec :: Int -> Key -> ShowS
$cshowsPrec :: Int -> Key -> ShowS
Show )

-- | A keyboard\/mouse callback

type KeyboardMouseCallback =
   Key -> KeyState -> Modifiers -> Position -> IO ()

-- | Controls the keyboard\/mouse callback for the /current window./ The
-- keyboard\/mouse callback for a window is called when the state of a key or
-- mouse button changes. The callback parameters indicate the new state of the
-- key\/button, the state of the keyboard modifiers, and the mouse location in
-- window relative coordinates.
--
-- Note that this is a convenience function that should not ordinarily be used
-- in conjunction with `keyboardCallback`, `keyboardUpCallback`,
-- `specialCallback`, `specialUpCallback`, or `mouseCallback`.

keyboardMouseCallback :: SettableStateVar (Maybe KeyboardMouseCallback)
keyboardMouseCallback :: SettableStateVar (Maybe KeyboardMouseCallback)
keyboardMouseCallback = (Maybe KeyboardMouseCallback -> DisplayCallback)
-> SettableStateVar (Maybe KeyboardMouseCallback)
forall a. (a -> DisplayCallback) -> SettableStateVar a
makeSettableStateVar Maybe KeyboardMouseCallback -> DisplayCallback
setKeyboardMouseCallback

setKeyboardMouseCallback :: Maybe KeyboardMouseCallback -> IO ()
setKeyboardMouseCallback :: Maybe KeyboardMouseCallback -> DisplayCallback
setKeyboardMouseCallback Maybe KeyboardMouseCallback
Nothing = do
   Maybe KeyboardCallback -> DisplayCallback
setKeyboardCallback   Maybe KeyboardCallback
forall a. Maybe a
Nothing
   Maybe KeyboardCallback -> DisplayCallback
setKeyboardUpCallback Maybe KeyboardCallback
forall a. Maybe a
Nothing
   Maybe SpecialCallback -> DisplayCallback
setSpecialCallback    Maybe SpecialCallback
forall a. Maybe a
Nothing
   Maybe SpecialCallback -> DisplayCallback
setSpecialUpCallback  Maybe SpecialCallback
forall a. Maybe a
Nothing
   Maybe MouseCallback -> DisplayCallback
setMouseCallback      Maybe MouseCallback
forall a. Maybe a
Nothing
setKeyboardMouseCallback (Just KeyboardMouseCallback
cb) = do
   Maybe KeyboardCallback -> DisplayCallback
setKeyboardCallback   (KeyboardCallback -> Maybe KeyboardCallback
forall a. a -> Maybe a
Just (\Char
c   Position
p -> do Modifiers
m <- IO Modifiers
getModifiers
                                             KeyboardMouseCallback
cb (Char -> Key
Char        Char
c) KeyState
Down Modifiers
m Position
p))
   Maybe KeyboardCallback -> DisplayCallback
setKeyboardUpCallback (KeyboardCallback -> Maybe KeyboardCallback
forall a. a -> Maybe a
Just (\Char
c   Position
p -> do Modifiers
m <- IO Modifiers
getModifiers
                                             KeyboardMouseCallback
cb (Char -> Key
Char        Char
c) KeyState
Up   Modifiers
m Position
p))
   Maybe SpecialCallback -> DisplayCallback
setSpecialCallback    (SpecialCallback -> Maybe SpecialCallback
forall a. a -> Maybe a
Just (\SpecialKey
s   Position
p -> do Modifiers
m <- IO Modifiers
getModifiers
                                             KeyboardMouseCallback
cb (SpecialKey -> Key
SpecialKey  SpecialKey
s) KeyState
Down Modifiers
m Position
p))
   Maybe SpecialCallback -> DisplayCallback
setSpecialUpCallback  (SpecialCallback -> Maybe SpecialCallback
forall a. a -> Maybe a
Just (\SpecialKey
s   Position
p -> do Modifiers
m <- IO Modifiers
getModifiers
                                             KeyboardMouseCallback
cb (SpecialKey -> Key
SpecialKey  SpecialKey
s) KeyState
Up   Modifiers
m Position
p))
   Maybe MouseCallback -> DisplayCallback
setMouseCallback      (MouseCallback -> Maybe MouseCallback
forall a. a -> Maybe a
Just (\MouseButton
b KeyState
s Position
p -> do Modifiers
m <- IO Modifiers
getModifiers
                                             KeyboardMouseCallback
cb (MouseButton -> Key
MouseButton MouseButton
b) KeyState
s    Modifiers
m Position
p))

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

type WheelNumber = Int

type WheelDirection = Int

type MouseWheelCallback = WheelNumber -> WheelDirection -> Position -> IO ()

-- | (/freeglut only/) Controls the mouse wheel callback for the
-- /current window./ The mouse wheel callback for a window is called when a
-- mouse wheel is used and the wheel number is greater than or equal to
-- 'Graphics.UI.GLUT.State.numMouseButtons'.

mouseWheelCallback :: SettableStateVar (Maybe MouseWheelCallback)
mouseWheelCallback :: SettableStateVar (Maybe MouseWheelCallback)
mouseWheelCallback = (Maybe MouseWheelCallback -> DisplayCallback)
-> SettableStateVar (Maybe MouseWheelCallback)
forall a. (a -> DisplayCallback) -> SettableStateVar a
makeSettableStateVar ((Maybe MouseWheelCallback -> DisplayCallback)
 -> SettableStateVar (Maybe MouseWheelCallback))
-> (Maybe MouseWheelCallback -> DisplayCallback)
-> SettableStateVar (Maybe MouseWheelCallback)
forall a b. (a -> b) -> a -> b
$
   CallbackType
-> (FunPtr MouseFunc -> DisplayCallback)
-> (MouseWheelCallback -> IO (FunPtr MouseFunc))
-> Maybe MouseWheelCallback
-> DisplayCallback
forall a b.
CallbackType
-> (FunPtr a -> DisplayCallback)
-> (b -> IO (FunPtr a))
-> Maybe b
-> DisplayCallback
setCallback CallbackType
MouseWheelCB FunPtr MouseFunc -> DisplayCallback
forall (m :: * -> *). MonadIO m => FunPtr MouseFunc -> m ()
glutMouseWheelFunc (MouseFunc -> IO (FunPtr MouseFunc)
makeMouseWheelFunc (MouseFunc -> IO (FunPtr MouseFunc))
-> (MouseWheelCallback -> MouseFunc)
-> MouseWheelCallback
-> IO (FunPtr MouseFunc)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MouseWheelCallback -> MouseFunc
forall a a a a t t t.
(Integral a, Integral a, Integral a, Integral a, Num t, Num t) =>
(t -> t -> Position -> t) -> a -> a -> a -> a -> t
unmarshal)
   where unmarshal :: (t -> t -> Position -> t) -> a -> a -> a -> a -> t
unmarshal t -> t -> Position -> t
cb a
n a
d a
x a
y = t -> t -> Position -> t
cb (a -> t
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n) (a -> t
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
d)
                                   (GLsizei -> GLsizei -> Position
Position (a -> GLsizei
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x) (a -> GLsizei
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
y))

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

-- | A motion callback

type MotionCallback = Position -> IO ()

-- | Controls the motion callback for the /current window./ The motion callback
-- for a window is called when the mouse moves within the window while one or
-- more mouse buttons are pressed. The callback parameter indicates the mouse
-- location in window relative coordinates.

motionCallback :: SettableStateVar (Maybe MotionCallback)
motionCallback :: SettableStateVar (Maybe PositionCallback)
motionCallback = (Maybe PositionCallback -> DisplayCallback)
-> SettableStateVar (Maybe PositionCallback)
forall a. (a -> DisplayCallback) -> SettableStateVar a
makeSettableStateVar ((Maybe PositionCallback -> DisplayCallback)
 -> SettableStateVar (Maybe PositionCallback))
-> (Maybe PositionCallback -> DisplayCallback)
-> SettableStateVar (Maybe PositionCallback)
forall a b. (a -> b) -> a -> b
$
   CallbackType
-> (FunPtr ReshapeFunc -> DisplayCallback)
-> (PositionCallback -> IO (FunPtr ReshapeFunc))
-> Maybe PositionCallback
-> DisplayCallback
forall a b.
CallbackType
-> (FunPtr a -> DisplayCallback)
-> (b -> IO (FunPtr a))
-> Maybe b
-> DisplayCallback
setCallback CallbackType
MotionCB FunPtr ReshapeFunc -> DisplayCallback
forall (m :: * -> *). MonadIO m => FunPtr ReshapeFunc -> m ()
glutMotionFunc (ReshapeFunc -> IO (FunPtr ReshapeFunc)
makeMotionFunc (ReshapeFunc -> IO (FunPtr ReshapeFunc))
-> (PositionCallback -> ReshapeFunc)
-> PositionCallback
-> IO (FunPtr ReshapeFunc)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PositionCallback -> ReshapeFunc
forall a a t.
(Integral a, Integral a) =>
(Position -> t) -> a -> a -> t
unmarshal)
   where unmarshal :: (Position -> t) -> a -> a -> t
unmarshal Position -> t
cb a
x a
y = Position -> t
cb (GLsizei -> GLsizei -> Position
Position (a -> GLsizei
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x) (a -> GLsizei
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
y))

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

-- | Controls the passive motion callback for the /current window./ The passive
-- motion callback for a window is called when the mouse moves within the window
-- while /no/ mouse buttons are pressed. The callback parameter indicates the
-- mouse location in window relative coordinates.

passiveMotionCallback :: SettableStateVar (Maybe MotionCallback)
passiveMotionCallback :: SettableStateVar (Maybe PositionCallback)
passiveMotionCallback = (Maybe PositionCallback -> DisplayCallback)
-> SettableStateVar (Maybe PositionCallback)
forall a. (a -> DisplayCallback) -> SettableStateVar a
makeSettableStateVar ((Maybe PositionCallback -> DisplayCallback)
 -> SettableStateVar (Maybe PositionCallback))
-> (Maybe PositionCallback -> DisplayCallback)
-> SettableStateVar (Maybe PositionCallback)
forall a b. (a -> b) -> a -> b
$
   CallbackType
-> (FunPtr ReshapeFunc -> DisplayCallback)
-> (PositionCallback -> IO (FunPtr ReshapeFunc))
-> Maybe PositionCallback
-> DisplayCallback
forall a b.
CallbackType
-> (FunPtr a -> DisplayCallback)
-> (b -> IO (FunPtr a))
-> Maybe b
-> DisplayCallback
setCallback CallbackType
PassiveMotionCB FunPtr ReshapeFunc -> DisplayCallback
forall (m :: * -> *). MonadIO m => FunPtr ReshapeFunc -> m ()
glutPassiveMotionFunc
               (ReshapeFunc -> IO (FunPtr ReshapeFunc)
makePassiveMotionFunc (ReshapeFunc -> IO (FunPtr ReshapeFunc))
-> (PositionCallback -> ReshapeFunc)
-> PositionCallback
-> IO (FunPtr ReshapeFunc)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PositionCallback -> ReshapeFunc
forall a a t.
(Integral a, Integral a) =>
(Position -> t) -> a -> a -> t
unmarshal)
   where unmarshal :: (Position -> t) -> a -> a -> t
unmarshal Position -> t
cb a
x a
y = Position -> t
cb (GLsizei -> GLsizei -> Position
Position (a -> GLsizei
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x) (a -> GLsizei
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
y))

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

-- | The relation between the mouse pointer and the /current window/ has
-- changed.

data Crossing
   = WindowLeft    -- ^ The mouse pointer has left the /current window./
   | WindowEntered -- ^ The mouse pointer has entered the /current window./
   deriving ( Crossing -> Crossing -> Bool
(Crossing -> Crossing -> Bool)
-> (Crossing -> Crossing -> Bool) -> Eq Crossing
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Crossing -> Crossing -> Bool
$c/= :: Crossing -> Crossing -> Bool
== :: Crossing -> Crossing -> Bool
$c== :: Crossing -> Crossing -> Bool
Eq, Eq Crossing
Eq Crossing
-> (Crossing -> Crossing -> Ordering)
-> (Crossing -> Crossing -> Bool)
-> (Crossing -> Crossing -> Bool)
-> (Crossing -> Crossing -> Bool)
-> (Crossing -> Crossing -> Bool)
-> (Crossing -> Crossing -> Crossing)
-> (Crossing -> Crossing -> Crossing)
-> Ord Crossing
Crossing -> Crossing -> Bool
Crossing -> Crossing -> Ordering
Crossing -> Crossing -> Crossing
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 :: Crossing -> Crossing -> Crossing
$cmin :: Crossing -> Crossing -> Crossing
max :: Crossing -> Crossing -> Crossing
$cmax :: Crossing -> Crossing -> Crossing
>= :: Crossing -> Crossing -> Bool
$c>= :: Crossing -> Crossing -> Bool
> :: Crossing -> Crossing -> Bool
$c> :: Crossing -> Crossing -> Bool
<= :: Crossing -> Crossing -> Bool
$c<= :: Crossing -> Crossing -> Bool
< :: Crossing -> Crossing -> Bool
$c< :: Crossing -> Crossing -> Bool
compare :: Crossing -> Crossing -> Ordering
$ccompare :: Crossing -> Crossing -> Ordering
$cp1Ord :: Eq Crossing
Ord, Int -> Crossing -> ShowS
[Crossing] -> ShowS
Crossing -> String
(Int -> Crossing -> ShowS)
-> (Crossing -> String) -> ([Crossing] -> ShowS) -> Show Crossing
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Crossing] -> ShowS
$cshowList :: [Crossing] -> ShowS
show :: Crossing -> String
$cshow :: Crossing -> String
showsPrec :: Int -> Crossing -> ShowS
$cshowsPrec :: Int -> Crossing -> ShowS
Show )

unmarshalCrossing :: CInt -> Crossing
unmarshalCrossing :: CInt -> Crossing
unmarshalCrossing CInt
x
   | CInt
x CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
glut_LEFT = Crossing
WindowLeft
   | CInt
x CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
glut_ENTERED = Crossing
WindowEntered
   | Bool
otherwise = String -> Crossing
forall a. HasCallStack => String -> a
error (String
"unmarshalCrossing: illegal value " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CInt -> String
forall a. Show a => a -> String
show CInt
x)

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

-- | An enter\/leave callback

type CrossingCallback = Crossing -> IO ()

-- | Controls the mouse enter\/leave callback for the /current window./ Note
-- that some window systems may not generate accurate enter\/leave callbacks.
--
-- /X Implementation Notes:/ An X implementation of GLUT should generate
-- accurate enter\/leave callbacks.

crossingCallback :: SettableStateVar (Maybe CrossingCallback)
crossingCallback :: SettableStateVar (Maybe CrossingCallback)
crossingCallback = (Maybe CrossingCallback -> DisplayCallback)
-> SettableStateVar (Maybe CrossingCallback)
forall a. (a -> DisplayCallback) -> SettableStateVar a
makeSettableStateVar ((Maybe CrossingCallback -> DisplayCallback)
 -> SettableStateVar (Maybe CrossingCallback))
-> (Maybe CrossingCallback -> DisplayCallback)
-> SettableStateVar (Maybe CrossingCallback)
forall a b. (a -> b) -> a -> b
$
   CallbackType
-> (FunPtr VisibilityFunc -> DisplayCallback)
-> (CrossingCallback -> IO (FunPtr VisibilityFunc))
-> Maybe CrossingCallback
-> DisplayCallback
forall a b.
CallbackType
-> (FunPtr a -> DisplayCallback)
-> (b -> IO (FunPtr a))
-> Maybe b
-> DisplayCallback
setCallback CallbackType
CrossingCB FunPtr VisibilityFunc -> DisplayCallback
forall (m :: * -> *). MonadIO m => FunPtr VisibilityFunc -> m ()
glutEntryFunc (VisibilityFunc -> IO (FunPtr VisibilityFunc)
makeEntryFunc (VisibilityFunc -> IO (FunPtr VisibilityFunc))
-> (CrossingCallback -> VisibilityFunc)
-> CrossingCallback
-> IO (FunPtr VisibilityFunc)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CrossingCallback -> VisibilityFunc
forall c. (Crossing -> c) -> CInt -> c
unmarshal)
   where unmarshal :: (Crossing -> c) -> CInt -> c
unmarshal Crossing -> c
cb = Crossing -> c
cb (Crossing -> c) -> (CInt -> Crossing) -> CInt -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Crossing
unmarshalCrossing

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

-- | Translation of the Spaceball along one axis, normalized to be in the range
-- of -1000 to +1000 inclusive

type SpaceballMotion = Int

-- | Rotation of the Spaceball along one axis, normalized to be in the range
-- of -1800 .. +1800 inclusive

type SpaceballRotation = Int

-- | The index of a specific buttons of an input device.

type ButtonIndex = Int

-- | The state of the Spaceball has changed.

data SpaceballInput
   = SpaceballMotion   SpaceballMotion SpaceballMotion SpaceballMotion
   | SpaceballRotation SpaceballRotation SpaceballRotation SpaceballRotation
   | SpaceballButton   ButtonIndex KeyState
   deriving ( SpaceballInput -> SpaceballInput -> Bool
(SpaceballInput -> SpaceballInput -> Bool)
-> (SpaceballInput -> SpaceballInput -> Bool) -> Eq SpaceballInput
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SpaceballInput -> SpaceballInput -> Bool
$c/= :: SpaceballInput -> SpaceballInput -> Bool
== :: SpaceballInput -> SpaceballInput -> Bool
$c== :: SpaceballInput -> SpaceballInput -> Bool
Eq, Eq SpaceballInput
Eq SpaceballInput
-> (SpaceballInput -> SpaceballInput -> Ordering)
-> (SpaceballInput -> SpaceballInput -> Bool)
-> (SpaceballInput -> SpaceballInput -> Bool)
-> (SpaceballInput -> SpaceballInput -> Bool)
-> (SpaceballInput -> SpaceballInput -> Bool)
-> (SpaceballInput -> SpaceballInput -> SpaceballInput)
-> (SpaceballInput -> SpaceballInput -> SpaceballInput)
-> Ord SpaceballInput
SpaceballInput -> SpaceballInput -> Bool
SpaceballInput -> SpaceballInput -> Ordering
SpaceballInput -> SpaceballInput -> SpaceballInput
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 :: SpaceballInput -> SpaceballInput -> SpaceballInput
$cmin :: SpaceballInput -> SpaceballInput -> SpaceballInput
max :: SpaceballInput -> SpaceballInput -> SpaceballInput
$cmax :: SpaceballInput -> SpaceballInput -> SpaceballInput
>= :: SpaceballInput -> SpaceballInput -> Bool
$c>= :: SpaceballInput -> SpaceballInput -> Bool
> :: SpaceballInput -> SpaceballInput -> Bool
$c> :: SpaceballInput -> SpaceballInput -> Bool
<= :: SpaceballInput -> SpaceballInput -> Bool
$c<= :: SpaceballInput -> SpaceballInput -> Bool
< :: SpaceballInput -> SpaceballInput -> Bool
$c< :: SpaceballInput -> SpaceballInput -> Bool
compare :: SpaceballInput -> SpaceballInput -> Ordering
$ccompare :: SpaceballInput -> SpaceballInput -> Ordering
$cp1Ord :: Eq SpaceballInput
Ord, Int -> SpaceballInput -> ShowS
[SpaceballInput] -> ShowS
SpaceballInput -> String
(Int -> SpaceballInput -> ShowS)
-> (SpaceballInput -> String)
-> ([SpaceballInput] -> ShowS)
-> Show SpaceballInput
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SpaceballInput] -> ShowS
$cshowList :: [SpaceballInput] -> ShowS
show :: SpaceballInput -> String
$cshow :: SpaceballInput -> String
showsPrec :: Int -> SpaceballInput -> ShowS
$cshowsPrec :: Int -> SpaceballInput -> ShowS
Show )

-- | A SpaceballButton callback

type SpaceballCallback = SpaceballInput -> IO ()

-- | Controls the Spaceball callback for the /current window./ The Spaceball
-- callback for a window is called when the window has Spaceball input focus
-- (normally, when the mouse is in the window) and the user generates Spaceball
-- translations, rotations, or button presses. The number of available Spaceball
-- buttons can be determined with 'Graphics.UI.GLUT.State.numSpaceballButtons'.
--
-- Registering a Spaceball callback when a Spaceball device is not available has
-- no effect and is not an error. In this case, no Spaceball callbacks will be
-- generated.

spaceballCallback :: SettableStateVar (Maybe SpaceballCallback)
spaceballCallback :: SettableStateVar (Maybe SpaceballCallback)
spaceballCallback = (Maybe SpaceballCallback -> DisplayCallback)
-> SettableStateVar (Maybe SpaceballCallback)
forall a. (a -> DisplayCallback) -> SettableStateVar a
makeSettableStateVar Maybe SpaceballCallback -> DisplayCallback
setSpaceballCallback

setSpaceballCallback :: Maybe SpaceballCallback -> IO ()
setSpaceballCallback :: Maybe SpaceballCallback -> DisplayCallback
setSpaceballCallback Maybe SpaceballCallback
Nothing = do
   Maybe SpaceballMotionCallback -> DisplayCallback
setSpaceballMotionCallback   Maybe SpaceballMotionCallback
forall a. Maybe a
Nothing
   Maybe SpaceballMotionCallback -> DisplayCallback
setSpaceballRotationCallback Maybe SpaceballMotionCallback
forall a. Maybe a
Nothing
   Maybe SpaceballButtonCallback -> DisplayCallback
setSpaceballButtonCallback   Maybe SpaceballButtonCallback
forall a. Maybe a
Nothing
setSpaceballCallback (Just SpaceballCallback
cb) = do
   Maybe SpaceballMotionCallback -> DisplayCallback
setSpaceballMotionCallback   (SpaceballMotionCallback -> Maybe SpaceballMotionCallback
forall a. a -> Maybe a
Just (\Int
x Int
y Int
z -> SpaceballCallback
cb (Int -> Int -> Int -> SpaceballInput
SpaceballMotion   Int
x Int
y Int
z)))
   Maybe SpaceballMotionCallback -> DisplayCallback
setSpaceballRotationCallback (SpaceballMotionCallback -> Maybe SpaceballMotionCallback
forall a. a -> Maybe a
Just (\Int
x Int
y Int
z -> SpaceballCallback
cb (Int -> Int -> Int -> SpaceballInput
SpaceballRotation Int
x Int
y Int
z)))
   Maybe SpaceballButtonCallback -> DisplayCallback
setSpaceballButtonCallback   (SpaceballButtonCallback -> Maybe SpaceballButtonCallback
forall a. a -> Maybe a
Just (\Int
b KeyState
s   -> SpaceballCallback
cb (Int -> KeyState -> SpaceballInput
SpaceballButton   Int
b KeyState
s)))

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

type SpaceballMotionCallback =
   SpaceballMotion -> SpaceballMotion -> SpaceballMotion -> IO ()

setSpaceballMotionCallback :: Maybe SpaceballMotionCallback -> IO ()
setSpaceballMotionCallback :: Maybe SpaceballMotionCallback -> DisplayCallback
setSpaceballMotionCallback =
   CallbackType
-> (FunPtr SpecialFunc -> DisplayCallback)
-> (SpaceballMotionCallback -> IO (FunPtr SpecialFunc))
-> Maybe SpaceballMotionCallback
-> DisplayCallback
forall a b.
CallbackType
-> (FunPtr a -> DisplayCallback)
-> (b -> IO (FunPtr a))
-> Maybe b
-> DisplayCallback
setCallback CallbackType
SpaceballMotionCB FunPtr SpecialFunc -> DisplayCallback
forall (m :: * -> *). MonadIO m => FunPtr SpecialFunc -> m ()
glutSpaceballMotionFunc
               (SpecialFunc -> IO (FunPtr SpecialFunc)
makeSpaceballMotionFunc (SpecialFunc -> IO (FunPtr SpecialFunc))
-> (SpaceballMotionCallback -> SpecialFunc)
-> SpaceballMotionCallback
-> IO (FunPtr SpecialFunc)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SpaceballMotionCallback -> SpecialFunc
forall a a a t t t t.
(Integral a, Integral a, Integral a, Num t, Num t, Num t) =>
(t -> t -> t -> t) -> a -> a -> a -> t
unmarshal)
   where unmarshal :: (t -> t -> t -> t) -> a -> a -> a -> t
unmarshal t -> t -> t -> t
cb a
x a
y a
z =
            t -> t -> t -> t
cb (a -> t
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x) (a -> t
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
y) (a -> t
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
z)

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

type SpaceballRotationCallback =
   SpaceballRotation -> SpaceballRotation -> SpaceballRotation -> IO ()

setSpaceballRotationCallback :: Maybe SpaceballRotationCallback -> IO ()
setSpaceballRotationCallback :: Maybe SpaceballMotionCallback -> DisplayCallback
setSpaceballRotationCallback =
   CallbackType
-> (FunPtr SpecialFunc -> DisplayCallback)
-> (SpaceballMotionCallback -> IO (FunPtr SpecialFunc))
-> Maybe SpaceballMotionCallback
-> DisplayCallback
forall a b.
CallbackType
-> (FunPtr a -> DisplayCallback)
-> (b -> IO (FunPtr a))
-> Maybe b
-> DisplayCallback
setCallback CallbackType
SpaceballRotateCB FunPtr SpecialFunc -> DisplayCallback
forall (m :: * -> *). MonadIO m => FunPtr SpecialFunc -> m ()
glutSpaceballRotateFunc
               (SpecialFunc -> IO (FunPtr SpecialFunc)
makeSpaceballRotateFunc (SpecialFunc -> IO (FunPtr SpecialFunc))
-> (SpaceballMotionCallback -> SpecialFunc)
-> SpaceballMotionCallback
-> IO (FunPtr SpecialFunc)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SpaceballMotionCallback -> SpecialFunc
forall a a a t t t t.
(Integral a, Integral a, Integral a, Num t, Num t, Num t) =>
(t -> t -> t -> t) -> a -> a -> a -> t
unmarshal)
   where unmarshal :: (t -> t -> t -> t) -> a -> a -> a -> t
unmarshal t -> t -> t -> t
cb a
x a
y a
z =
            t -> t -> t -> t
cb (a -> t
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x) (a -> t
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
y) (a -> t
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
z)

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

type SpaceballButtonCallback = ButtonIndex -> KeyState -> IO ()

setSpaceballButtonCallback :: Maybe SpaceballButtonCallback -> IO ()
setSpaceballButtonCallback :: Maybe SpaceballButtonCallback -> DisplayCallback
setSpaceballButtonCallback =
   CallbackType
-> (FunPtr ReshapeFunc -> DisplayCallback)
-> (SpaceballButtonCallback -> IO (FunPtr ReshapeFunc))
-> Maybe SpaceballButtonCallback
-> DisplayCallback
forall a b.
CallbackType
-> (FunPtr a -> DisplayCallback)
-> (b -> IO (FunPtr a))
-> Maybe b
-> DisplayCallback
setCallback CallbackType
SpaceballButtonCB FunPtr ReshapeFunc -> DisplayCallback
forall (m :: * -> *). MonadIO m => FunPtr ReshapeFunc -> m ()
glutSpaceballButtonFunc
               (ReshapeFunc -> IO (FunPtr ReshapeFunc)
makeSpaceballButtonFunc (ReshapeFunc -> IO (FunPtr ReshapeFunc))
-> (SpaceballButtonCallback -> ReshapeFunc)
-> SpaceballButtonCallback
-> IO (FunPtr ReshapeFunc)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SpaceballButtonCallback -> ReshapeFunc
forall a t t.
(Integral a, Num t) =>
(t -> KeyState -> t) -> a -> CInt -> t
unmarshal)
   where unmarshal :: (t -> KeyState -> t) -> a -> CInt -> t
unmarshal t -> KeyState -> t
cb a
b CInt
s = t -> KeyState -> t
cb (a -> t
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
b) (CInt -> KeyState
unmarshalKeyState CInt
s)

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

-- | The index of a specific dial of a dial and button box.

type DialIndex = Int

-- | The dial & button box state has changed.

data DialAndButtonBoxInput
   = DialAndButtonBoxButton ButtonIndex KeyState
   | DialAndButtonBoxDial   DialIndex Int
   deriving ( DialAndButtonBoxInput -> DialAndButtonBoxInput -> Bool
(DialAndButtonBoxInput -> DialAndButtonBoxInput -> Bool)
-> (DialAndButtonBoxInput -> DialAndButtonBoxInput -> Bool)
-> Eq DialAndButtonBoxInput
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DialAndButtonBoxInput -> DialAndButtonBoxInput -> Bool
$c/= :: DialAndButtonBoxInput -> DialAndButtonBoxInput -> Bool
== :: DialAndButtonBoxInput -> DialAndButtonBoxInput -> Bool
$c== :: DialAndButtonBoxInput -> DialAndButtonBoxInput -> Bool
Eq, Eq DialAndButtonBoxInput
Eq DialAndButtonBoxInput
-> (DialAndButtonBoxInput -> DialAndButtonBoxInput -> Ordering)
-> (DialAndButtonBoxInput -> DialAndButtonBoxInput -> Bool)
-> (DialAndButtonBoxInput -> DialAndButtonBoxInput -> Bool)
-> (DialAndButtonBoxInput -> DialAndButtonBoxInput -> Bool)
-> (DialAndButtonBoxInput -> DialAndButtonBoxInput -> Bool)
-> (DialAndButtonBoxInput
    -> DialAndButtonBoxInput -> DialAndButtonBoxInput)
-> (DialAndButtonBoxInput
    -> DialAndButtonBoxInput -> DialAndButtonBoxInput)
-> Ord DialAndButtonBoxInput
DialAndButtonBoxInput -> DialAndButtonBoxInput -> Bool
DialAndButtonBoxInput -> DialAndButtonBoxInput -> Ordering
DialAndButtonBoxInput
-> DialAndButtonBoxInput -> DialAndButtonBoxInput
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 :: DialAndButtonBoxInput
-> DialAndButtonBoxInput -> DialAndButtonBoxInput
$cmin :: DialAndButtonBoxInput
-> DialAndButtonBoxInput -> DialAndButtonBoxInput
max :: DialAndButtonBoxInput
-> DialAndButtonBoxInput -> DialAndButtonBoxInput
$cmax :: DialAndButtonBoxInput
-> DialAndButtonBoxInput -> DialAndButtonBoxInput
>= :: DialAndButtonBoxInput -> DialAndButtonBoxInput -> Bool
$c>= :: DialAndButtonBoxInput -> DialAndButtonBoxInput -> Bool
> :: DialAndButtonBoxInput -> DialAndButtonBoxInput -> Bool
$c> :: DialAndButtonBoxInput -> DialAndButtonBoxInput -> Bool
<= :: DialAndButtonBoxInput -> DialAndButtonBoxInput -> Bool
$c<= :: DialAndButtonBoxInput -> DialAndButtonBoxInput -> Bool
< :: DialAndButtonBoxInput -> DialAndButtonBoxInput -> Bool
$c< :: DialAndButtonBoxInput -> DialAndButtonBoxInput -> Bool
compare :: DialAndButtonBoxInput -> DialAndButtonBoxInput -> Ordering
$ccompare :: DialAndButtonBoxInput -> DialAndButtonBoxInput -> Ordering
$cp1Ord :: Eq DialAndButtonBoxInput
Ord, Int -> DialAndButtonBoxInput -> ShowS
[DialAndButtonBoxInput] -> ShowS
DialAndButtonBoxInput -> String
(Int -> DialAndButtonBoxInput -> ShowS)
-> (DialAndButtonBoxInput -> String)
-> ([DialAndButtonBoxInput] -> ShowS)
-> Show DialAndButtonBoxInput
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DialAndButtonBoxInput] -> ShowS
$cshowList :: [DialAndButtonBoxInput] -> ShowS
show :: DialAndButtonBoxInput -> String
$cshow :: DialAndButtonBoxInput -> String
showsPrec :: Int -> DialAndButtonBoxInput -> ShowS
$cshowsPrec :: Int -> DialAndButtonBoxInput -> ShowS
Show )

-- | A dial & button box callback

type DialAndButtonBoxCallback = DialAndButtonBoxInput -> IO ()

-- | Controls the dial & button box callback for the /current window./ The dial
-- & button box button callback for a window is called when the window has dial
-- & button box input focus (normally, when the mouse is in the window) and the
-- user generates dial & button box button presses or dial changes. The number
-- of available dial & button box buttons and dials can be determined with
-- 'Graphics.UI.GLUT.State.numDialsAndButtons'.
--
-- Registering a dial & button box callback when a dial & button box device is
-- not available is ineffectual and not an error. In this case, no dial & button
-- box button will be generated.

dialAndButtonBoxCallback :: SettableStateVar (Maybe DialAndButtonBoxCallback)
dialAndButtonBoxCallback :: SettableStateVar (Maybe DialAndButtonBoxCallback)
dialAndButtonBoxCallback = (Maybe DialAndButtonBoxCallback -> DisplayCallback)
-> SettableStateVar (Maybe DialAndButtonBoxCallback)
forall a. (a -> DisplayCallback) -> SettableStateVar a
makeSettableStateVar Maybe DialAndButtonBoxCallback -> DisplayCallback
setDialAndButtonBoxCallback

setDialAndButtonBoxCallback :: Maybe DialAndButtonBoxCallback -> IO ()
setDialAndButtonBoxCallback :: Maybe DialAndButtonBoxCallback -> DisplayCallback
setDialAndButtonBoxCallback Maybe DialAndButtonBoxCallback
Nothing = do
   Maybe SpaceballButtonCallback -> DisplayCallback
setButtonBoxCallback Maybe SpaceballButtonCallback
forall a. Maybe a
Nothing
   Maybe DialsCallback -> DisplayCallback
setDialsCallback     Maybe DialsCallback
forall a. Maybe a
Nothing
setDialAndButtonBoxCallback (Just DialAndButtonBoxCallback
cb) = do
   Maybe SpaceballButtonCallback -> DisplayCallback
setButtonBoxCallback (SpaceballButtonCallback -> Maybe SpaceballButtonCallback
forall a. a -> Maybe a
Just (\Int
b KeyState
s -> DialAndButtonBoxCallback
cb (Int -> KeyState -> DialAndButtonBoxInput
DialAndButtonBoxButton Int
b KeyState
s)))
   Maybe DialsCallback -> DisplayCallback
setDialsCallback     (DialsCallback -> Maybe DialsCallback
forall a. a -> Maybe a
Just (\Int
d Int
x -> DialAndButtonBoxCallback
cb (Int -> Int -> DialAndButtonBoxInput
DialAndButtonBoxDial   Int
d Int
x)))

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

type ButtonBoxCallback = ButtonIndex -> KeyState -> IO ()

setButtonBoxCallback :: Maybe ButtonBoxCallback -> IO ()
setButtonBoxCallback :: Maybe SpaceballButtonCallback -> DisplayCallback
setButtonBoxCallback =
   CallbackType
-> (FunPtr ReshapeFunc -> DisplayCallback)
-> (SpaceballButtonCallback -> IO (FunPtr ReshapeFunc))
-> Maybe SpaceballButtonCallback
-> DisplayCallback
forall a b.
CallbackType
-> (FunPtr a -> DisplayCallback)
-> (b -> IO (FunPtr a))
-> Maybe b
-> DisplayCallback
setCallback CallbackType
ButtonBoxCB FunPtr ReshapeFunc -> DisplayCallback
forall (m :: * -> *). MonadIO m => FunPtr ReshapeFunc -> m ()
glutButtonBoxFunc (ReshapeFunc -> IO (FunPtr ReshapeFunc)
makeButtonBoxFunc (ReshapeFunc -> IO (FunPtr ReshapeFunc))
-> (SpaceballButtonCallback -> ReshapeFunc)
-> SpaceballButtonCallback
-> IO (FunPtr ReshapeFunc)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SpaceballButtonCallback -> ReshapeFunc
forall a t t.
(Integral a, Num t) =>
(t -> KeyState -> t) -> a -> CInt -> t
unmarshal)
   where unmarshal :: (t -> KeyState -> t) -> a -> CInt -> t
unmarshal t -> KeyState -> t
cb a
b CInt
s = t -> KeyState -> t
cb (a -> t
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
b) (CInt -> KeyState
unmarshalKeyState CInt
s)

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

type DialsCallback = DialIndex -> Int -> IO ()

setDialsCallback :: Maybe DialsCallback -> IO ()
setDialsCallback :: Maybe DialsCallback -> DisplayCallback
setDialsCallback =
    CallbackType
-> (FunPtr ReshapeFunc -> DisplayCallback)
-> (DialsCallback -> IO (FunPtr ReshapeFunc))
-> Maybe DialsCallback
-> DisplayCallback
forall a b.
CallbackType
-> (FunPtr a -> DisplayCallback)
-> (b -> IO (FunPtr a))
-> Maybe b
-> DisplayCallback
setCallback CallbackType
DialsCB FunPtr ReshapeFunc -> DisplayCallback
forall (m :: * -> *). MonadIO m => FunPtr ReshapeFunc -> m ()
glutDialsFunc (ReshapeFunc -> IO (FunPtr ReshapeFunc)
makeDialsFunc (ReshapeFunc -> IO (FunPtr ReshapeFunc))
-> (DialsCallback -> ReshapeFunc)
-> DialsCallback
-> IO (FunPtr ReshapeFunc)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DialsCallback -> ReshapeFunc
forall a a t t t.
(Integral a, Integral a, Num t, Num t) =>
(t -> t -> t) -> a -> a -> t
unmarshal)
    where unmarshal :: (t -> t -> t) -> a -> a -> t
unmarshal t -> t -> t
cb a
d a
x = t -> t -> t
cb (a -> t
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
d) (a -> t
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x)

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

-- | Absolute tablet position, with coordinates normalized to be in the range of
-- 0 to 2000 inclusive

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

-- | The table state has changed.

data TabletInput
   = TabletMotion
   | TabletButton ButtonIndex KeyState
   deriving ( TabletInput -> TabletInput -> Bool
(TabletInput -> TabletInput -> Bool)
-> (TabletInput -> TabletInput -> Bool) -> Eq TabletInput
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TabletInput -> TabletInput -> Bool
$c/= :: TabletInput -> TabletInput -> Bool
== :: TabletInput -> TabletInput -> Bool
$c== :: TabletInput -> TabletInput -> Bool
Eq, Eq TabletInput
Eq TabletInput
-> (TabletInput -> TabletInput -> Ordering)
-> (TabletInput -> TabletInput -> Bool)
-> (TabletInput -> TabletInput -> Bool)
-> (TabletInput -> TabletInput -> Bool)
-> (TabletInput -> TabletInput -> Bool)
-> (TabletInput -> TabletInput -> TabletInput)
-> (TabletInput -> TabletInput -> TabletInput)
-> Ord TabletInput
TabletInput -> TabletInput -> Bool
TabletInput -> TabletInput -> Ordering
TabletInput -> TabletInput -> TabletInput
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 :: TabletInput -> TabletInput -> TabletInput
$cmin :: TabletInput -> TabletInput -> TabletInput
max :: TabletInput -> TabletInput -> TabletInput
$cmax :: TabletInput -> TabletInput -> TabletInput
>= :: TabletInput -> TabletInput -> Bool
$c>= :: TabletInput -> TabletInput -> Bool
> :: TabletInput -> TabletInput -> Bool
$c> :: TabletInput -> TabletInput -> Bool
<= :: TabletInput -> TabletInput -> Bool
$c<= :: TabletInput -> TabletInput -> Bool
< :: TabletInput -> TabletInput -> Bool
$c< :: TabletInput -> TabletInput -> Bool
compare :: TabletInput -> TabletInput -> Ordering
$ccompare :: TabletInput -> TabletInput -> Ordering
$cp1Ord :: Eq TabletInput
Ord, Int -> TabletInput -> ShowS
[TabletInput] -> ShowS
TabletInput -> String
(Int -> TabletInput -> ShowS)
-> (TabletInput -> String)
-> ([TabletInput] -> ShowS)
-> Show TabletInput
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TabletInput] -> ShowS
$cshowList :: [TabletInput] -> ShowS
show :: TabletInput -> String
$cshow :: TabletInput -> String
showsPrec :: Int -> TabletInput -> ShowS
$cshowsPrec :: Int -> TabletInput -> ShowS
Show )

-- | A tablet callback

type TabletCallback = TabletInput -> TabletPosition -> IO ()

-- | Controls the tablet callback for the /current window./ The tablet callback
-- for a window is called when the window has tablet input focus (normally, when
-- the mouse is in the window) and the user generates tablet motion or button
-- presses. The number of available tablet buttons can be determined with
-- 'Graphics.UI.GLUT.State.numTabletButtons'.
--
-- Registering a tablet callback when a tablet device is not available is
-- ineffectual and not an error. In this case, no tablet callbacks will be
-- generated.

tabletCallback :: SettableStateVar (Maybe TabletCallback)
tabletCallback :: SettableStateVar (Maybe TabletCallback)
tabletCallback = (Maybe TabletCallback -> DisplayCallback)
-> SettableStateVar (Maybe TabletCallback)
forall a. (a -> DisplayCallback) -> SettableStateVar a
makeSettableStateVar Maybe TabletCallback -> DisplayCallback
setTabletCallback

setTabletCallback :: Maybe TabletCallback -> IO ()
setTabletCallback :: Maybe TabletCallback -> DisplayCallback
setTabletCallback Maybe TabletCallback
Nothing = do
   Maybe TabletMotionCallback -> DisplayCallback
setTabletMotionCallback Maybe TabletMotionCallback
forall a. Maybe a
Nothing
   Maybe TabletButtonCallback -> DisplayCallback
setTabletButtonCallback Maybe TabletButtonCallback
forall a. Maybe a
Nothing
setTabletCallback (Just TabletCallback
cb) = do
   Maybe TabletMotionCallback -> DisplayCallback
setTabletMotionCallback (TabletMotionCallback -> Maybe TabletMotionCallback
forall a. a -> Maybe a
Just (\TabletPosition
p     -> TabletCallback
cb TabletInput
TabletMotion       TabletPosition
p))
   Maybe TabletButtonCallback -> DisplayCallback
setTabletButtonCallback (TabletButtonCallback -> Maybe TabletButtonCallback
forall a. a -> Maybe a
Just (\Int
b KeyState
s TabletPosition
p -> TabletCallback
cb (Int -> KeyState -> TabletInput
TabletButton Int
b KeyState
s) TabletPosition
p))

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

type TabletMotionCallback = TabletPosition -> IO ()

setTabletMotionCallback :: Maybe TabletMotionCallback -> IO ()
setTabletMotionCallback :: Maybe TabletMotionCallback -> DisplayCallback
setTabletMotionCallback =
    CallbackType
-> (FunPtr ReshapeFunc -> DisplayCallback)
-> (TabletMotionCallback -> IO (FunPtr ReshapeFunc))
-> Maybe TabletMotionCallback
-> DisplayCallback
forall a b.
CallbackType
-> (FunPtr a -> DisplayCallback)
-> (b -> IO (FunPtr a))
-> Maybe b
-> DisplayCallback
setCallback CallbackType
TabletMotionCB FunPtr ReshapeFunc -> DisplayCallback
forall (m :: * -> *). MonadIO m => FunPtr ReshapeFunc -> m ()
glutTabletMotionFunc
                (ReshapeFunc -> IO (FunPtr ReshapeFunc)
makeTabletMotionFunc (ReshapeFunc -> IO (FunPtr ReshapeFunc))
-> (TabletMotionCallback -> ReshapeFunc)
-> TabletMotionCallback
-> IO (FunPtr ReshapeFunc)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TabletMotionCallback -> ReshapeFunc
forall a a t.
(Integral a, Integral a) =>
(TabletPosition -> t) -> a -> a -> t
unmarshal)
    where unmarshal :: (TabletPosition -> t) -> a -> a -> t
unmarshal TabletPosition -> t
cb a
x a
y =
             TabletPosition -> t
cb (Int -> Int -> TabletPosition
TabletPosition (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x) (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
y))

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

type TabletButtonCallback = ButtonIndex -> KeyState -> TabletPosition -> IO ()

setTabletButtonCallback :: Maybe TabletButtonCallback -> IO ()
setTabletButtonCallback :: Maybe TabletButtonCallback -> DisplayCallback
setTabletButtonCallback =
    CallbackType
-> (FunPtr MouseFunc -> DisplayCallback)
-> (TabletButtonCallback -> IO (FunPtr MouseFunc))
-> Maybe TabletButtonCallback
-> DisplayCallback
forall a b.
CallbackType
-> (FunPtr a -> DisplayCallback)
-> (b -> IO (FunPtr a))
-> Maybe b
-> DisplayCallback
setCallback CallbackType
TabletButtonCB FunPtr MouseFunc -> DisplayCallback
forall (m :: * -> *). MonadIO m => FunPtr MouseFunc -> m ()
glutTabletButtonFunc
                (MouseFunc -> IO (FunPtr MouseFunc)
makeTabletButtonFunc (MouseFunc -> IO (FunPtr MouseFunc))
-> (TabletButtonCallback -> MouseFunc)
-> TabletButtonCallback
-> IO (FunPtr MouseFunc)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TabletButtonCallback -> MouseFunc
forall a a a t t.
(Integral a, Integral a, Integral a, Num t) =>
(t -> KeyState -> TabletPosition -> t) -> a -> CInt -> a -> a -> t
unmarshal)
    where unmarshal :: (t -> KeyState -> TabletPosition -> t) -> a -> CInt -> a -> a -> t
unmarshal t -> KeyState -> TabletPosition -> t
cb a
b CInt
s a
x a
y =
             t -> KeyState -> TabletPosition -> t
cb (a -> t
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
b) (CInt -> KeyState
unmarshalKeyState CInt
s)
                (Int -> Int -> TabletPosition
TabletPosition (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x) (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
y))

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

-- | The state of the joystick buttons

data JoystickButtons = JoystickButtons {
   JoystickButtons -> KeyState
joystickButtonA, JoystickButtons -> KeyState
joystickButtonB,
   JoystickButtons -> KeyState
joystickButtonC, JoystickButtons -> KeyState
joystickButtonD :: KeyState }
   deriving ( JoystickButtons -> JoystickButtons -> Bool
(JoystickButtons -> JoystickButtons -> Bool)
-> (JoystickButtons -> JoystickButtons -> Bool)
-> Eq JoystickButtons
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JoystickButtons -> JoystickButtons -> Bool
$c/= :: JoystickButtons -> JoystickButtons -> Bool
== :: JoystickButtons -> JoystickButtons -> Bool
$c== :: JoystickButtons -> JoystickButtons -> Bool
Eq, Eq JoystickButtons
Eq JoystickButtons
-> (JoystickButtons -> JoystickButtons -> Ordering)
-> (JoystickButtons -> JoystickButtons -> Bool)
-> (JoystickButtons -> JoystickButtons -> Bool)
-> (JoystickButtons -> JoystickButtons -> Bool)
-> (JoystickButtons -> JoystickButtons -> Bool)
-> (JoystickButtons -> JoystickButtons -> JoystickButtons)
-> (JoystickButtons -> JoystickButtons -> JoystickButtons)
-> Ord JoystickButtons
JoystickButtons -> JoystickButtons -> Bool
JoystickButtons -> JoystickButtons -> Ordering
JoystickButtons -> JoystickButtons -> JoystickButtons
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 :: JoystickButtons -> JoystickButtons -> JoystickButtons
$cmin :: JoystickButtons -> JoystickButtons -> JoystickButtons
max :: JoystickButtons -> JoystickButtons -> JoystickButtons
$cmax :: JoystickButtons -> JoystickButtons -> JoystickButtons
>= :: JoystickButtons -> JoystickButtons -> Bool
$c>= :: JoystickButtons -> JoystickButtons -> Bool
> :: JoystickButtons -> JoystickButtons -> Bool
$c> :: JoystickButtons -> JoystickButtons -> Bool
<= :: JoystickButtons -> JoystickButtons -> Bool
$c<= :: JoystickButtons -> JoystickButtons -> Bool
< :: JoystickButtons -> JoystickButtons -> Bool
$c< :: JoystickButtons -> JoystickButtons -> Bool
compare :: JoystickButtons -> JoystickButtons -> Ordering
$ccompare :: JoystickButtons -> JoystickButtons -> Ordering
$cp1Ord :: Eq JoystickButtons
Ord, Int -> JoystickButtons -> ShowS
[JoystickButtons] -> ShowS
JoystickButtons -> String
(Int -> JoystickButtons -> ShowS)
-> (JoystickButtons -> String)
-> ([JoystickButtons] -> ShowS)
-> Show JoystickButtons
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JoystickButtons] -> ShowS
$cshowList :: [JoystickButtons] -> ShowS
show :: JoystickButtons -> String
$cshow :: JoystickButtons -> String
showsPrec :: Int -> JoystickButtons -> ShowS
$cshowsPrec :: Int -> JoystickButtons -> ShowS
Show )

-- Could use fromBitfield + Enum/Bounded instances + unmarshalJoystickButton
-- instead...
unmarshalJoystickButtons :: CUInt -> JoystickButtons
unmarshalJoystickButtons :: CUInt -> JoystickButtons
unmarshalJoystickButtons CUInt
m = JoystickButtons :: KeyState -> KeyState -> KeyState -> KeyState -> JoystickButtons
JoystickButtons {
   joystickButtonA :: KeyState
joystickButtonA = if (CUInt
m CUInt -> CUInt -> CUInt
forall a. Bits a => a -> a -> a
.&. CUInt
glut_JOYSTICK_BUTTON_A) CUInt -> CUInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CUInt
0 then KeyState
Down else KeyState
Up,
   joystickButtonB :: KeyState
joystickButtonB = if (CUInt
m CUInt -> CUInt -> CUInt
forall a. Bits a => a -> a -> a
.&. CUInt
glut_JOYSTICK_BUTTON_B) CUInt -> CUInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CUInt
0 then KeyState
Down else KeyState
Up,
   joystickButtonC :: KeyState
joystickButtonC = if (CUInt
m CUInt -> CUInt -> CUInt
forall a. Bits a => a -> a -> a
.&. CUInt
glut_JOYSTICK_BUTTON_C) CUInt -> CUInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CUInt
0 then KeyState
Down else KeyState
Up,
   joystickButtonD :: KeyState
joystickButtonD = if (CUInt
m CUInt -> CUInt -> CUInt
forall a. Bits a => a -> a -> a
.&. CUInt
glut_JOYSTICK_BUTTON_D) CUInt -> CUInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CUInt
0 then KeyState
Down else KeyState
Up }

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

-- | Absolute joystick position, with coordinates normalized to be in the range
-- of -1000 to 1000 inclusive. The signs of the three axes mean the following:
--
-- * negative = left, positive = right
--
-- * negative = towards player, positive = away
--
-- * if available (e.g. rudder): negative = down, positive = up

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

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

-- | A joystick callback

type JoystickCallback = JoystickButtons -> JoystickPosition -> IO ()

-- | Controls the joystick callback for the /current window./ The joystick
-- callback is called either due to polling of the joystick at the uniform timer
-- interval specified (if > 0) or in response to an explicit call of
-- 'Graphics.UI.GLUT.DeviceControl.forceJoystickCallback'.
--
-- /X Implementation Notes:/ Currently GLUT has no joystick support for X11.

-- joystickCallback :: SettableStateVar (Maybe JoystickCallback, PollRate)
joystickCallback :: SettableStateVar (Maybe (JoystickCallback, PollRate))
joystickCallback :: SettableStateVar (Maybe (JoystickCallback, Int))
joystickCallback =
   (Maybe (JoystickCallback, Int) -> DisplayCallback)
-> SettableStateVar (Maybe (JoystickCallback, Int))
forall a. (a -> DisplayCallback) -> SettableStateVar a
makeSettableStateVar ((Maybe (JoystickCallback, Int) -> DisplayCallback)
 -> SettableStateVar (Maybe (JoystickCallback, Int)))
-> (Maybe (JoystickCallback, Int) -> DisplayCallback)
-> SettableStateVar (Maybe (JoystickCallback, Int))
forall a b. (a -> b) -> a -> b
$ \Maybe (JoystickCallback, Int)
maybeCBAndRate ->
      CallbackType
-> (FunPtr JoystickFunc -> DisplayCallback)
-> (JoystickCallback -> IO (FunPtr JoystickFunc))
-> Maybe JoystickCallback
-> DisplayCallback
forall a b.
CallbackType
-> (FunPtr a -> DisplayCallback)
-> (b -> IO (FunPtr a))
-> Maybe b
-> DisplayCallback
setCallback CallbackType
JoystickCB
                  (\FunPtr JoystickFunc
f -> FunPtr JoystickFunc -> VisibilityFunc
forall (m :: * -> *).
MonadIO m =>
FunPtr JoystickFunc -> CInt -> m ()
glutJoystickFunc FunPtr JoystickFunc
f (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((JoystickCallback, Int) -> Int
forall a b. (a, b) -> b
snd (Maybe (JoystickCallback, Int) -> (JoystickCallback, Int)
forall a. HasCallStack => Maybe a -> a
fromJust Maybe (JoystickCallback, Int)
maybeCBAndRate))))
                  (JoystickFunc -> IO (FunPtr JoystickFunc)
makeJoystickFunc (JoystickFunc -> IO (FunPtr JoystickFunc))
-> (JoystickCallback -> JoystickFunc)
-> JoystickCallback
-> IO (FunPtr JoystickFunc)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JoystickCallback -> JoystickFunc
forall a a a t.
(Integral a, Integral a, Integral a) =>
(JoystickButtons -> JoystickPosition -> t)
-> CUInt -> a -> a -> a -> t
unmarshal)
                  (((JoystickCallback, Int) -> JoystickCallback)
-> Maybe (JoystickCallback, Int) -> Maybe JoystickCallback
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (JoystickCallback, Int) -> JoystickCallback
forall a b. (a, b) -> a
fst Maybe (JoystickCallback, Int)
maybeCBAndRate)
    where unmarshal :: (JoystickButtons -> JoystickPosition -> t)
-> CUInt -> a -> a -> a -> t
unmarshal JoystickButtons -> JoystickPosition -> t
cb CUInt
b a
x a
y a
z = JoystickButtons -> JoystickPosition -> t
cb (CUInt -> JoystickButtons
unmarshalJoystickButtons CUInt
b)
                                    (Int -> Int -> Int -> JoystickPosition
JoystickPosition (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x)
                                                      (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
y)
                                                      (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
z))

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

-- | A description where the multi-touch event is coming from, the freeglut
-- specs are very vague about the actual semantics. It contains the device ID
-- and\/or the cursor\/finger ID.

type TouchID = Int

-- | A multi-touch variant of 'MouseCallback'.

type MultiMouseCallback = TouchID -> MouseCallback

-- | (/freeglut only/) A multi-touch variant of 'mouseCallback'.

multiMouseCallback :: SettableStateVar (Maybe MultiMouseCallback)
multiMouseCallback :: SettableStateVar (Maybe MultiMouseCallback)
multiMouseCallback = (Maybe MultiMouseCallback -> DisplayCallback)
-> SettableStateVar (Maybe MultiMouseCallback)
forall a. (a -> DisplayCallback) -> SettableStateVar a
makeSettableStateVar ((Maybe MultiMouseCallback -> DisplayCallback)
 -> SettableStateVar (Maybe MultiMouseCallback))
-> (Maybe MultiMouseCallback -> DisplayCallback)
-> SettableStateVar (Maybe MultiMouseCallback)
forall a b. (a -> b) -> a -> b
$
   CallbackType
-> (FunPtr MultiButtonFunc -> DisplayCallback)
-> (MultiMouseCallback -> IO (FunPtr MultiButtonFunc))
-> Maybe MultiMouseCallback
-> DisplayCallback
forall a b.
CallbackType
-> (FunPtr a -> DisplayCallback)
-> (b -> IO (FunPtr a))
-> Maybe b
-> DisplayCallback
setCallback CallbackType
MultiButtonCB FunPtr MultiButtonFunc -> DisplayCallback
forall (m :: * -> *). MonadIO m => FunPtr MultiButtonFunc -> m ()
glutMultiButtonFunc (MultiButtonFunc -> IO (FunPtr MultiButtonFunc)
makeMultiButtonFunc (MultiButtonFunc -> IO (FunPtr MultiButtonFunc))
-> (MultiMouseCallback -> MultiButtonFunc)
-> MultiMouseCallback
-> IO (FunPtr MultiButtonFunc)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MultiMouseCallback -> MultiButtonFunc
forall a a a t t.
(Integral a, Integral a, Integral a, Num t) =>
(t -> MouseButton -> KeyState -> Position -> t)
-> a -> a -> a -> CInt -> CInt -> t
unmarshal)
   where unmarshal :: (t -> MouseButton -> KeyState -> Position -> t)
-> a -> a -> a -> CInt -> CInt -> t
unmarshal t -> MouseButton -> KeyState -> Position -> t
cb a
d a
x a
y CInt
b CInt
s = t -> MouseButton -> KeyState -> Position -> t
cb (a -> t
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
d)
                                     (CInt -> MouseButton
unmarshalMouseButton CInt
b)
                                     (CInt -> KeyState
unmarshalKeyState CInt
s)
                                     (GLsizei -> GLsizei -> Position
Position (a -> GLsizei
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x) (a -> GLsizei
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
y))

-- | A multi-touch variant of 'CrossingCallback'.

type MultiCrossingCallback = TouchID -> CrossingCallback

-- | (/freeglut only/) A multi-touch variant of 'crossingCallback'.

multiCrossingCallback :: SettableStateVar (Maybe MultiCrossingCallback)
multiCrossingCallback :: SettableStateVar (Maybe MultiCrossingCallback)
multiCrossingCallback = (Maybe MultiCrossingCallback -> DisplayCallback)
-> SettableStateVar (Maybe MultiCrossingCallback)
forall a. (a -> DisplayCallback) -> SettableStateVar a
makeSettableStateVar ((Maybe MultiCrossingCallback -> DisplayCallback)
 -> SettableStateVar (Maybe MultiCrossingCallback))
-> (Maybe MultiCrossingCallback -> DisplayCallback)
-> SettableStateVar (Maybe MultiCrossingCallback)
forall a b. (a -> b) -> a -> b
$
   CallbackType
-> (FunPtr ReshapeFunc -> DisplayCallback)
-> (MultiCrossingCallback -> IO (FunPtr ReshapeFunc))
-> Maybe MultiCrossingCallback
-> DisplayCallback
forall a b.
CallbackType
-> (FunPtr a -> DisplayCallback)
-> (b -> IO (FunPtr a))
-> Maybe b
-> DisplayCallback
setCallback CallbackType
MultiEntryCB FunPtr ReshapeFunc -> DisplayCallback
forall (m :: * -> *). MonadIO m => FunPtr ReshapeFunc -> m ()
glutMultiEntryFunc (ReshapeFunc -> IO (FunPtr ReshapeFunc)
makeMultiEntryFunc (ReshapeFunc -> IO (FunPtr ReshapeFunc))
-> (MultiCrossingCallback -> ReshapeFunc)
-> MultiCrossingCallback
-> IO (FunPtr ReshapeFunc)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MultiCrossingCallback -> ReshapeFunc
forall a t t.
(Integral a, Num t) =>
(t -> Crossing -> t) -> a -> CInt -> t
unmarshal)
   where unmarshal :: (t -> Crossing -> t) -> a -> CInt -> t
unmarshal t -> Crossing -> t
cb a
d CInt
c = t -> Crossing -> t
cb (a -> t
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
d) (CInt -> Crossing
unmarshalCrossing CInt
c)

-- | A multi-touch variant of 'MotionCallback'.

type MultiMotionCallback = TouchID -> MotionCallback

-- | (/freeglut only/) A multi-touch variant of 'motionCallback'.

multiMotionCallback :: SettableStateVar (Maybe MultiMotionCallback)
multiMotionCallback :: SettableStateVar (Maybe MultiMotionCallback)
multiMotionCallback = (Maybe MultiMotionCallback -> DisplayCallback)
-> SettableStateVar (Maybe MultiMotionCallback)
forall a. (a -> DisplayCallback) -> SettableStateVar a
makeSettableStateVar ((Maybe MultiMotionCallback -> DisplayCallback)
 -> SettableStateVar (Maybe MultiMotionCallback))
-> (Maybe MultiMotionCallback -> DisplayCallback)
-> SettableStateVar (Maybe MultiMotionCallback)
forall a b. (a -> b) -> a -> b
$
   CallbackType
-> (FunPtr SpecialFunc -> DisplayCallback)
-> (MultiMotionCallback -> IO (FunPtr SpecialFunc))
-> Maybe MultiMotionCallback
-> DisplayCallback
forall a b.
CallbackType
-> (FunPtr a -> DisplayCallback)
-> (b -> IO (FunPtr a))
-> Maybe b
-> DisplayCallback
setCallback CallbackType
MultiMotionCB FunPtr SpecialFunc -> DisplayCallback
forall (m :: * -> *). MonadIO m => FunPtr SpecialFunc -> m ()
glutMultiMotionFunc (SpecialFunc -> IO (FunPtr SpecialFunc)
makeMultiMotionFunc (SpecialFunc -> IO (FunPtr SpecialFunc))
-> (MultiMotionCallback -> SpecialFunc)
-> MultiMotionCallback
-> IO (FunPtr SpecialFunc)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MultiMotionCallback -> SpecialFunc
forall a a a t t.
(Integral a, Integral a, Integral a, Num t) =>
(t -> Position -> t) -> a -> a -> a -> t
unmarshal)
   where unmarshal :: (t -> Position -> t) -> a -> a -> a -> t
unmarshal t -> Position -> t
cb a
d a
x a
y =
            t -> Position -> t
cb (a -> t
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
d) (GLsizei -> GLsizei -> Position
Position (a -> GLsizei
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x) (a -> GLsizei
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
y))

-- | (/freeglut only/) A multi-touch variant of 'passiveMotionCallback'.

multiPassiveMotionCallback :: SettableStateVar (Maybe MultiMotionCallback)
multiPassiveMotionCallback :: SettableStateVar (Maybe MultiMotionCallback)
multiPassiveMotionCallback = (Maybe MultiMotionCallback -> DisplayCallback)
-> SettableStateVar (Maybe MultiMotionCallback)
forall a. (a -> DisplayCallback) -> SettableStateVar a
makeSettableStateVar ((Maybe MultiMotionCallback -> DisplayCallback)
 -> SettableStateVar (Maybe MultiMotionCallback))
-> (Maybe MultiMotionCallback -> DisplayCallback)
-> SettableStateVar (Maybe MultiMotionCallback)
forall a b. (a -> b) -> a -> b
$
   CallbackType
-> (FunPtr SpecialFunc -> DisplayCallback)
-> (MultiMotionCallback -> IO (FunPtr SpecialFunc))
-> Maybe MultiMotionCallback
-> DisplayCallback
forall a b.
CallbackType
-> (FunPtr a -> DisplayCallback)
-> (b -> IO (FunPtr a))
-> Maybe b
-> DisplayCallback
setCallback CallbackType
MultiPassiveCB FunPtr SpecialFunc -> DisplayCallback
forall (m :: * -> *). MonadIO m => FunPtr SpecialFunc -> m ()
glutMultiPassiveFunc (SpecialFunc -> IO (FunPtr SpecialFunc)
makeMultiPassiveFunc (SpecialFunc -> IO (FunPtr SpecialFunc))
-> (MultiMotionCallback -> SpecialFunc)
-> MultiMotionCallback
-> IO (FunPtr SpecialFunc)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MultiMotionCallback -> SpecialFunc
forall a a a t t.
(Integral a, Integral a, Integral a, Num t) =>
(t -> Position -> t) -> a -> a -> a -> t
unmarshal)
   where unmarshal :: (t -> Position -> t) -> a -> a -> a -> t
unmarshal t -> Position -> t
cb a
d a
x a
y =
            t -> Position -> t
cb (a -> t
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
d) (GLsizei -> GLsizei -> Position
Position (a -> GLsizei
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x) (a -> GLsizei
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
y))