--------------------------------------------------------------------------------
-- |
-- Module      :  Graphics.UI.GLUT.State
-- Copyright   :  (c) Sven Panne 2002-2018
-- License     :  BSD3
--
-- Maintainer  :  Sven Panne <svenpanne@gmail.com>
-- Stability   :  stable
-- Portability :  portable
--
-- GLUT maintains a considerable amount of programmer visible state. Some (but
-- not all) of this state may be directly retrieved.
--
--------------------------------------------------------------------------------

module Graphics.UI.GLUT.State (
   -- * State of all windows
   windowBorderWidth, windowHeaderHeight, skipStaleMotionEvents,

   -- * State of the /current window/

   -- ** Framebuffer state
   rgba,
   BufferDepth, rgbaBufferDepths, colorBufferDepth,
   doubleBuffered, stereo,
   accumBufferDepths, depthBufferDepth, stencilBufferDepth,
   SampleCount, sampleCount, formatID,

   -- ** Full screen state
   fullScreenMode,

   -- ** Object rendering state
   geometryVisualizeNormals,

   -- ** Vertex attribute state
   vertexAttribCoord3, vertexAttribNormal, vertexAttribTexCoord2,

   -- ** Layer state
   damaged,

   -- * Timing
   elapsedTime,

   -- * Device information

   -- $DeviceInformation
   screenSize, screenSizeMM,
   hasKeyboard,
   ButtonCount, numMouseButtons,
   numSpaceballButtons,
   DialCount, numDialsAndButtons,
   numTabletButtons,
   AxisCount, PollRate, joystickInfo,
   supportedNumAuxBuffers, supportedSamplesPerPixel,

   -- * GLUT information
   glutVersion, initState
) where

import Control.Monad ( unless )
import Data.StateVar ( GettableStateVar, makeGettableStateVar
                     , SettableStateVar, makeSettableStateVar
                     , StateVar, makeStateVar )
import Foreign.C.Types ( CInt )
import Foreign.Marshal.Alloc ( alloca )
import Foreign.Marshal.Array ( peekArray )
import Foreign.Storable ( peek )
import Graphics.Rendering.OpenGL ( AttribLocation(..), Size(..), GLenum, GLint )

import Graphics.UI.GLUT.Overlay
import Graphics.UI.GLUT.QueryUtils
import Graphics.UI.GLUT.Raw
import Graphics.UI.GLUT.Window

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

-- | Contains 'True' when the current layer of the /current window/ is in RGBA
-- mode, 'False' means color index mode.

rgba :: GettableStateVar Bool
rgba :: GettableStateVar Bool
rgba = GettableStateVar Bool -> GettableStateVar Bool
forall a. IO a -> IO a
makeGettableStateVar(GettableStateVar Bool -> GettableStateVar Bool)
-> GettableStateVar Bool -> GettableStateVar Bool
forall a b. (a -> b) -> a -> b
$ Getter Bool
forall a. Getter a
simpleGet CInt -> Bool
i2b GLenum
glut_WINDOW_RGBA

-- | Bit depth of a buffer

type BufferDepth = Int

-- | Contains the number of red, green, blue, and alpha bits in the color buffer
-- of the /current window\'s/ current layer (0 in color index mode).

rgbaBufferDepths ::
   GettableStateVar (BufferDepth, BufferDepth, BufferDepth, BufferDepth)
rgbaBufferDepths :: GettableStateVar
  (BufferDepth, BufferDepth, BufferDepth, BufferDepth)
rgbaBufferDepths = GettableStateVar
  (BufferDepth, BufferDepth, BufferDepth, BufferDepth)
-> GettableStateVar
     (BufferDepth, BufferDepth, BufferDepth, BufferDepth)
forall a. IO a -> IO a
makeGettableStateVar (GettableStateVar
   (BufferDepth, BufferDepth, BufferDepth, BufferDepth)
 -> GettableStateVar
      (BufferDepth, BufferDepth, BufferDepth, BufferDepth))
-> GettableStateVar
     (BufferDepth, BufferDepth, BufferDepth, BufferDepth)
-> GettableStateVar
     (BufferDepth, BufferDepth, BufferDepth, BufferDepth)
forall a b. (a -> b) -> a -> b
$ do
   BufferDepth
r <- Getter BufferDepth
forall a. Getter a
simpleGet CInt -> BufferDepth
forall a b. (Integral a, Num b) => a -> b
fromIntegral GLenum
glut_WINDOW_RED_SIZE
   BufferDepth
g <- Getter BufferDepth
forall a. Getter a
simpleGet CInt -> BufferDepth
forall a b. (Integral a, Num b) => a -> b
fromIntegral GLenum
glut_WINDOW_GREEN_SIZE
   BufferDepth
b <- Getter BufferDepth
forall a. Getter a
simpleGet CInt -> BufferDepth
forall a b. (Integral a, Num b) => a -> b
fromIntegral GLenum
glut_WINDOW_BLUE_SIZE
   BufferDepth
a <- Getter BufferDepth
forall a. Getter a
simpleGet CInt -> BufferDepth
forall a b. (Integral a, Num b) => a -> b
fromIntegral GLenum
glut_WINDOW_ALPHA_SIZE
   (BufferDepth, BufferDepth, BufferDepth, BufferDepth)
-> GettableStateVar
     (BufferDepth, BufferDepth, BufferDepth, BufferDepth)
forall (m :: * -> *) a. Monad m => a -> m a
return (BufferDepth
r, BufferDepth
g, BufferDepth
b, BufferDepth
a)

-- | Contains the total number of bits in the color buffer of the /current
-- window\'s/ current layer. For an RGBA layer, this is the sum of the red,
-- green, blue, and alpha bits. For an color index layer, this is the number
-- of bits of the color indexes.

colorBufferDepth :: GettableStateVar BufferDepth
colorBufferDepth :: GettableStateVar BufferDepth
colorBufferDepth =
   GettableStateVar BufferDepth -> GettableStateVar BufferDepth
forall a. IO a -> IO a
makeGettableStateVar (GettableStateVar BufferDepth -> GettableStateVar BufferDepth)
-> GettableStateVar BufferDepth -> GettableStateVar BufferDepth
forall a b. (a -> b) -> a -> b
$ Getter BufferDepth
forall a. Getter a
simpleGet CInt -> BufferDepth
forall a b. (Integral a, Num b) => a -> b
fromIntegral GLenum
glut_WINDOW_BUFFER_SIZE

-- | Contains 'True' when the current layer of the /current window/ is double
-- buffered, 'False' otherwise.

doubleBuffered :: GettableStateVar Bool
doubleBuffered :: GettableStateVar Bool
doubleBuffered = GettableStateVar Bool -> GettableStateVar Bool
forall a. IO a -> IO a
makeGettableStateVar (GettableStateVar Bool -> GettableStateVar Bool)
-> GettableStateVar Bool -> GettableStateVar Bool
forall a b. (a -> b) -> a -> b
$ Getter Bool
forall a. Getter a
simpleGet CInt -> Bool
i2b GLenum
glut_WINDOW_DOUBLEBUFFER

-- | Contains 'True' when the current layer of the /current window/ is stereo,
-- 'False' otherwise.

stereo :: GettableStateVar Bool
stereo :: GettableStateVar Bool
stereo = GettableStateVar Bool -> GettableStateVar Bool
forall a. IO a -> IO a
makeGettableStateVar (GettableStateVar Bool -> GettableStateVar Bool)
-> GettableStateVar Bool -> GettableStateVar Bool
forall a b. (a -> b) -> a -> b
$ Getter Bool
forall a. Getter a
simpleGet CInt -> Bool
i2b GLenum
glut_WINDOW_STEREO

-- | Contains the number of red, green, blue, and alpha bits in the accumulation
-- buffer of the /current window\'s/ current layer (0 in color index mode).

accumBufferDepths ::
   GettableStateVar (BufferDepth, BufferDepth, BufferDepth, BufferDepth)
accumBufferDepths :: GettableStateVar
  (BufferDepth, BufferDepth, BufferDepth, BufferDepth)
accumBufferDepths = GettableStateVar
  (BufferDepth, BufferDepth, BufferDepth, BufferDepth)
-> GettableStateVar
     (BufferDepth, BufferDepth, BufferDepth, BufferDepth)
forall a. IO a -> IO a
makeGettableStateVar (GettableStateVar
   (BufferDepth, BufferDepth, BufferDepth, BufferDepth)
 -> GettableStateVar
      (BufferDepth, BufferDepth, BufferDepth, BufferDepth))
-> GettableStateVar
     (BufferDepth, BufferDepth, BufferDepth, BufferDepth)
-> GettableStateVar
     (BufferDepth, BufferDepth, BufferDepth, BufferDepth)
forall a b. (a -> b) -> a -> b
$ do
   BufferDepth
r <- Getter BufferDepth
forall a. Getter a
simpleGet CInt -> BufferDepth
forall a b. (Integral a, Num b) => a -> b
fromIntegral GLenum
glut_WINDOW_ACCUM_RED_SIZE
   BufferDepth
g <- Getter BufferDepth
forall a. Getter a
simpleGet CInt -> BufferDepth
forall a b. (Integral a, Num b) => a -> b
fromIntegral GLenum
glut_WINDOW_ACCUM_GREEN_SIZE
   BufferDepth
b <- Getter BufferDepth
forall a. Getter a
simpleGet CInt -> BufferDepth
forall a b. (Integral a, Num b) => a -> b
fromIntegral GLenum
glut_WINDOW_ACCUM_BLUE_SIZE
   BufferDepth
a <- Getter BufferDepth
forall a. Getter a
simpleGet CInt -> BufferDepth
forall a b. (Integral a, Num b) => a -> b
fromIntegral GLenum
glut_WINDOW_ACCUM_ALPHA_SIZE
   (BufferDepth, BufferDepth, BufferDepth, BufferDepth)
-> GettableStateVar
     (BufferDepth, BufferDepth, BufferDepth, BufferDepth)
forall (m :: * -> *) a. Monad m => a -> m a
return (BufferDepth
r, BufferDepth
g, BufferDepth
b, BufferDepth
a)

-- | Contains the number of bits in the depth buffer of the /current window\'s/
-- current layer.

depthBufferDepth :: GettableStateVar BufferDepth
depthBufferDepth :: GettableStateVar BufferDepth
depthBufferDepth =
   GettableStateVar BufferDepth -> GettableStateVar BufferDepth
forall a. IO a -> IO a
makeGettableStateVar (GettableStateVar BufferDepth -> GettableStateVar BufferDepth)
-> GettableStateVar BufferDepth -> GettableStateVar BufferDepth
forall a b. (a -> b) -> a -> b
$ Getter BufferDepth
forall a. Getter a
simpleGet CInt -> BufferDepth
forall a b. (Integral a, Num b) => a -> b
fromIntegral GLenum
glut_WINDOW_DEPTH_SIZE

-- | Contains the number of bits in the stencil buffer of the /current
-- window\'s/ current layer.

stencilBufferDepth :: GettableStateVar BufferDepth
stencilBufferDepth :: GettableStateVar BufferDepth
stencilBufferDepth =
   GettableStateVar BufferDepth -> GettableStateVar BufferDepth
forall a. IO a -> IO a
makeGettableStateVar (GettableStateVar BufferDepth -> GettableStateVar BufferDepth)
-> GettableStateVar BufferDepth -> GettableStateVar BufferDepth
forall a b. (a -> b) -> a -> b
$ Getter BufferDepth
forall a. Getter a
simpleGet CInt -> BufferDepth
forall a b. (Integral a, Num b) => a -> b
fromIntegral GLenum
glut_WINDOW_STENCIL_SIZE

-- | Number of samples for multisampling

type SampleCount = Int

-- | Contains the number of samples for multisampling for the /current window./

sampleCount :: GettableStateVar SampleCount
sampleCount :: GettableStateVar BufferDepth
sampleCount =
   GettableStateVar BufferDepth -> GettableStateVar BufferDepth
forall a. IO a -> IO a
makeGettableStateVar (GettableStateVar BufferDepth -> GettableStateVar BufferDepth)
-> GettableStateVar BufferDepth -> GettableStateVar BufferDepth
forall a b. (a -> b) -> a -> b
$ Getter BufferDepth
forall a. Getter a
simpleGet CInt -> BufferDepth
forall a b. (Integral a, Num b) => a -> b
fromIntegral GLenum
glut_WINDOW_NUM_SAMPLES

-- | Contains the window system dependent format ID for the current layer of the
-- /current window/. On X11 GLUT implementations, this is the X visual ID. On
-- Win32 GLUT implementations, this is the Win32 Pixel Format Descriptor number.
-- This value is returned for debugging, benchmarking, and testing ease.

formatID :: GettableStateVar Int
formatID :: GettableStateVar BufferDepth
formatID = GettableStateVar BufferDepth -> GettableStateVar BufferDepth
forall a. IO a -> IO a
makeGettableStateVar (GettableStateVar BufferDepth -> GettableStateVar BufferDepth)
-> GettableStateVar BufferDepth -> GettableStateVar BufferDepth
forall a b. (a -> b) -> a -> b
$ Getter BufferDepth
forall a. Getter a
simpleGet CInt -> BufferDepth
forall a b. (Integral a, Num b) => a -> b
fromIntegral GLenum
glut_WINDOW_FORMAT_ID

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

-- | (/freeglut only/) Contains 'True' if the /current window/ is in full screen
-- mode, 'False' otherwise.

fullScreenMode :: StateVar Bool
fullScreenMode :: StateVar Bool
fullScreenMode = GettableStateVar Bool -> (Bool -> IO ()) -> StateVar Bool
forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar GettableStateVar Bool
getFullScreenMode Bool -> IO ()
setFullScreenMode

getFullScreenMode :: IO Bool
getFullScreenMode :: GettableStateVar Bool
getFullScreenMode = Getter Bool
forall a. Getter a
simpleGet CInt -> Bool
i2b GLenum
glut_FULL_SCREEN

setFullScreenMode :: Bool -> IO ()
setFullScreenMode :: Bool -> IO ()
setFullScreenMode Bool
newMode = do
   Bool
oldMode <- GettableStateVar Bool
getFullScreenMode
   Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool
newMode Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
oldMode) IO ()
forall (m :: * -> *). MonadIO m => m ()
fullScreenToggle

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

-- | (/freeglut only/) Controls if vectors representing the normals should be
-- drawn, too, when objects are drawn.

geometryVisualizeNormals :: StateVar Bool
geometryVisualizeNormals :: StateVar Bool
geometryVisualizeNormals =
   GettableStateVar Bool -> (Bool -> IO ()) -> StateVar Bool
forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar
      (Getter Bool
forall a. Getter a
simpleGet CInt -> Bool
i2b GLenum
glut_GEOMETRY_VISUALIZE_NORMALS)
      (GLenum -> CInt -> IO ()
forall (m :: * -> *). MonadIO m => GLenum -> CInt -> m ()
glutSetOption GLenum
glut_GEOMETRY_VISUALIZE_NORMALS (CInt -> IO ()) -> (Bool -> CInt) -> Bool -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> CInt
b2i)


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

-- | (/freeglut only/) If 'vertexAttribCoord3' and 'vertexAttribNormal' both
-- contain 'Nothing', the fixed function pipeline is used to draw
-- objects. Otherwise VBOs are used and the coordinates are passed via 'Just'
-- this attribute location (for a vec3).

vertexAttribCoord3 :: SettableStateVar (Maybe AttribLocation)
vertexAttribCoord3 :: SettableStateVar (Maybe AttribLocation)
vertexAttribCoord3 = (GLint -> IO ()) -> SettableStateVar (Maybe AttribLocation)
setVertexAttribWith GLint -> IO ()
forall (m :: * -> *). MonadIO m => GLint -> m ()
glutSetVertexAttribCoord3

setVertexAttribWith :: (GLint -> IO ()) -> SettableStateVar (Maybe AttribLocation)
setVertexAttribWith :: (GLint -> IO ()) -> SettableStateVar (Maybe AttribLocation)
setVertexAttribWith GLint -> IO ()
f = (Maybe AttribLocation -> IO ())
-> SettableStateVar (Maybe AttribLocation)
forall a. (a -> IO ()) -> SettableStateVar a
makeSettableStateVar ((Maybe AttribLocation -> IO ())
 -> SettableStateVar (Maybe AttribLocation))
-> (Maybe AttribLocation -> IO ())
-> SettableStateVar (Maybe AttribLocation)
forall a b. (a -> b) -> a -> b
$ GLint -> IO ()
f (GLint -> IO ())
-> (Maybe AttribLocation -> GLint) -> Maybe AttribLocation -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe AttribLocation -> GLint
getLocation
   where getLocation :: Maybe AttribLocation -> GLint
getLocation = GLint -> (AttribLocation -> GLint) -> Maybe AttribLocation -> GLint
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (-GLint
1) (\(AttribLocation GLenum
l) -> GLenum -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral GLenum
l)

-- | (/freeglut only/) If 'vertexAttribCoord3' and 'vertexAttribNormal' both
-- contain 'Nothing', the fixed function pipeline is used to draw
-- objects. Otherwise VBOs are used and the normals are passed via 'Just' this
-- attribute location (for a vec3).

vertexAttribNormal :: SettableStateVar (Maybe AttribLocation)
vertexAttribNormal :: SettableStateVar (Maybe AttribLocation)
vertexAttribNormal = (GLint -> IO ()) -> SettableStateVar (Maybe AttribLocation)
setVertexAttribWith GLint -> IO ()
forall (m :: * -> *). MonadIO m => GLint -> m ()
glutSetVertexAttribNormal

-- | (/freeglut only/) If VBOs are used to draw objects (controlled via
-- 'vertexAttribCoord3' and 'vertexAttribNormal'), the texture coordinates are
-- passed via 'Just' this attribute location (for a vec2).

vertexAttribTexCoord2 :: SettableStateVar (Maybe AttribLocation)
vertexAttribTexCoord2 :: SettableStateVar (Maybe AttribLocation)
vertexAttribTexCoord2 = (GLint -> IO ()) -> SettableStateVar (Maybe AttribLocation)
setVertexAttribWith GLint -> IO ()
forall (m :: * -> *). MonadIO m => GLint -> m ()
glutSetVertexAttribTexCoord2

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

-- | Contains the number of milliseconds since
-- 'Graphics.UI.GLUT.Initialization.initialize' was called.

elapsedTime :: GettableStateVar Int
elapsedTime :: GettableStateVar BufferDepth
elapsedTime = GettableStateVar BufferDepth -> GettableStateVar BufferDepth
forall a. IO a -> IO a
makeGettableStateVar (GettableStateVar BufferDepth -> GettableStateVar BufferDepth)
-> GettableStateVar BufferDepth -> GettableStateVar BufferDepth
forall a b. (a -> b) -> a -> b
$ Getter BufferDepth
forall a. Getter a
simpleGet CInt -> BufferDepth
forall a b. (Integral a, Num b) => a -> b
fromIntegral GLenum
glut_ELAPSED_TIME

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

-- | Contains 'True' if the given plane of the /current window/ has been
-- damaged (by window system activity) since the last display callback was
-- triggered. Calling 'Graphics.UI.GLUT.Window.postRedisplay' or
-- 'Graphics.UI.GLUT.Overlay.postOverlayRedisplay' will not set this 'True'.

damaged :: Layer -> GettableStateVar Bool
damaged :: Layer -> GettableStateVar Bool
damaged Layer
l = GettableStateVar Bool -> GettableStateVar Bool
forall a. IO a -> IO a
makeGettableStateVar (GettableStateVar Bool -> GettableStateVar Bool)
-> GettableStateVar Bool -> GettableStateVar Bool
forall a b. (a -> b) -> a -> b
$ Getter Bool
forall a. Getter a
layerGet CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
isDamaged (Layer -> GLenum
marshalDamagedLayer Layer
l)
   where isDamaged :: a -> Bool
isDamaged a
d = a
d a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
0 Bool -> Bool -> Bool
&& a
d a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= -a
1
         marshalDamagedLayer :: Layer -> GLenum
marshalDamagedLayer Layer
x = case Layer
x of
            Layer
Normal -> GLenum
glut_NORMAL_DAMAGED
            Layer
Overlay -> GLenum
glut_OVERLAY_DAMAGED

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

-- $DeviceInformation
-- If a device is not available, the following state variables contain
-- 'Nothing', otherwise they return 'Just' the specific device information.
-- Only a screen is always assumed.

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

-- | The size of the screen in pixels.

screenSize :: GettableStateVar Size
screenSize :: GettableStateVar Size
screenSize =
   GettableStateVar Size -> GettableStateVar Size
forall a. IO a -> IO a
makeGettableStateVar (GettableStateVar Size -> GettableStateVar Size)
-> GettableStateVar Size -> GettableStateVar Size
forall a b. (a -> b) -> a -> b
$ do
      GLint
wpx <- Getter GLint
forall a. Getter a
simpleGet CInt -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral GLenum
glut_SCREEN_WIDTH
      GLint
hpx <- Getter GLint
forall a. Getter a
simpleGet CInt -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral GLenum
glut_SCREEN_HEIGHT
      Size -> GettableStateVar Size
forall (m :: * -> *) a. Monad m => a -> m a
return (Size -> GettableStateVar Size) -> Size -> GettableStateVar Size
forall a b. (a -> b) -> a -> b
$ GLint -> GLint -> Size
Size GLint
wpx GLint
hpx

-- | The size of the screen in millimeters.

screenSizeMM :: GettableStateVar Size
screenSizeMM :: GettableStateVar Size
screenSizeMM =
   GettableStateVar Size -> GettableStateVar Size
forall a. IO a -> IO a
makeGettableStateVar (GettableStateVar Size -> GettableStateVar Size)
-> GettableStateVar Size -> GettableStateVar Size
forall a b. (a -> b) -> a -> b
$ do
      GLint
wmm <- Getter GLint
forall a. Getter a
simpleGet CInt -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral GLenum
glut_SCREEN_WIDTH_MM
      GLint
hmm <- Getter GLint
forall a. Getter a
simpleGet CInt -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral GLenum
glut_SCREEN_HEIGHT_MM
      Size -> GettableStateVar Size
forall (m :: * -> *) a. Monad m => a -> m a
return (Size -> GettableStateVar Size) -> Size -> GettableStateVar Size
forall a b. (a -> b) -> a -> b
$ GLint -> GLint -> Size
Size GLint
wmm GLint
hmm

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

-- | Contains 'True' if a keyboard is present, 'False' otherwise.

hasKeyboard :: GettableStateVar Bool
hasKeyboard :: GettableStateVar Bool
hasKeyboard = GettableStateVar Bool -> GettableStateVar Bool
forall a. IO a -> IO a
makeGettableStateVar (GettableStateVar Bool -> GettableStateVar Bool)
-> GettableStateVar Bool -> GettableStateVar Bool
forall a b. (a -> b) -> a -> b
$ Getter Bool
forall a. Getter a
deviceGet CInt -> Bool
i2b GLenum
glut_HAS_KEYBOARD

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

-- | Number of buttons of an input device

type ButtonCount = Int

-- | Contains 'Just' the number of buttons of an attached mouse or 'Nothing' if
-- there is none.

numMouseButtons :: GettableStateVar (Maybe ButtonCount)
numMouseButtons :: GettableStateVar (Maybe BufferDepth)
numMouseButtons =
   GLenum
-> GettableStateVar BufferDepth
-> GettableStateVar (Maybe BufferDepth)
forall a. GLenum -> IO a -> GettableStateVar (Maybe a)
getDeviceInfo GLenum
glut_HAS_MOUSE (GettableStateVar BufferDepth
 -> GettableStateVar (Maybe BufferDepth))
-> GettableStateVar BufferDepth
-> GettableStateVar (Maybe BufferDepth)
forall a b. (a -> b) -> a -> b
$
      Getter BufferDepth
forall a. Getter a
deviceGet CInt -> BufferDepth
forall a b. (Integral a, Num b) => a -> b
fromIntegral GLenum
glut_NUM_MOUSE_BUTTONS

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

-- | Contains 'Just' the number of buttons of the attached Spaceball or 'Nothing'
-- if there is none.

numSpaceballButtons :: GettableStateVar (Maybe ButtonCount)
numSpaceballButtons :: GettableStateVar (Maybe BufferDepth)
numSpaceballButtons =
   GLenum
-> GettableStateVar BufferDepth
-> GettableStateVar (Maybe BufferDepth)
forall a. GLenum -> IO a -> GettableStateVar (Maybe a)
getDeviceInfo GLenum
glut_HAS_SPACEBALL (GettableStateVar BufferDepth
 -> GettableStateVar (Maybe BufferDepth))
-> GettableStateVar BufferDepth
-> GettableStateVar (Maybe BufferDepth)
forall a b. (a -> b) -> a -> b
$
      Getter BufferDepth
forall a. Getter a
deviceGet CInt -> BufferDepth
forall a b. (Integral a, Num b) => a -> b
fromIntegral GLenum
glut_NUM_SPACEBALL_BUTTONS

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

-- | Number of dials of a dial and button box

type DialCount = Int

-- | Contains 'Just' the number of dials and buttons of an attached dial &
-- button box or 'Nothing' if there is none.

numDialsAndButtons :: GettableStateVar (Maybe (DialCount, ButtonCount))
numDialsAndButtons :: GettableStateVar (Maybe (BufferDepth, BufferDepth))
numDialsAndButtons =
   GLenum
-> IO (BufferDepth, BufferDepth)
-> GettableStateVar (Maybe (BufferDepth, BufferDepth))
forall a. GLenum -> IO a -> GettableStateVar (Maybe a)
getDeviceInfo GLenum
glut_HAS_DIAL_AND_BUTTON_BOX (IO (BufferDepth, BufferDepth)
 -> GettableStateVar (Maybe (BufferDepth, BufferDepth)))
-> IO (BufferDepth, BufferDepth)
-> GettableStateVar (Maybe (BufferDepth, BufferDepth))
forall a b. (a -> b) -> a -> b
$ do
      BufferDepth
d <- Getter BufferDepth
forall a. Getter a
deviceGet CInt -> BufferDepth
forall a b. (Integral a, Num b) => a -> b
fromIntegral GLenum
glut_NUM_DIALS
      BufferDepth
b <- Getter BufferDepth
forall a. Getter a
deviceGet CInt -> BufferDepth
forall a b. (Integral a, Num b) => a -> b
fromIntegral GLenum
glut_NUM_BUTTON_BOX_BUTTONS
      (BufferDepth, BufferDepth) -> IO (BufferDepth, BufferDepth)
forall (m :: * -> *) a. Monad m => a -> m a
return (BufferDepth
d, BufferDepth
b)

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

-- | Contains 'Just' the number of buttons of an attached tablet or 'Nothing' if
-- there is none.

numTabletButtons :: GettableStateVar (Maybe ButtonCount)
numTabletButtons :: GettableStateVar (Maybe BufferDepth)
numTabletButtons =
   GLenum
-> GettableStateVar BufferDepth
-> GettableStateVar (Maybe BufferDepth)
forall a. GLenum -> IO a -> GettableStateVar (Maybe a)
getDeviceInfo GLenum
glut_HAS_TABLET (GettableStateVar BufferDepth
 -> GettableStateVar (Maybe BufferDepth))
-> GettableStateVar BufferDepth
-> GettableStateVar (Maybe BufferDepth)
forall a b. (a -> b) -> a -> b
$
      Getter BufferDepth
forall a. Getter a
deviceGet CInt -> BufferDepth
forall a b. (Integral a, Num b) => a -> b
fromIntegral GLenum
glut_NUM_TABLET_BUTTONS

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

-- | Number of axes of a joystick

type AxisCount = Int

-- | The a rate at which a joystick is polled (in milliseconds)

type PollRate = Int

-- | Contains 'Just' the number of buttons of an attached joystick, the number
-- of joystick axes, and the rate at which the joystick is polled. Contains
-- 'Nothing' if there is no joystick attached.

joystickInfo :: GettableStateVar (Maybe (ButtonCount, PollRate, AxisCount))
joystickInfo :: GettableStateVar (Maybe (BufferDepth, BufferDepth, BufferDepth))
joystickInfo =
   GLenum
-> IO (BufferDepth, BufferDepth, BufferDepth)
-> GettableStateVar (Maybe (BufferDepth, BufferDepth, BufferDepth))
forall a. GLenum -> IO a -> GettableStateVar (Maybe a)
getDeviceInfo GLenum
glut_HAS_JOYSTICK (IO (BufferDepth, BufferDepth, BufferDepth)
 -> GettableStateVar
      (Maybe (BufferDepth, BufferDepth, BufferDepth)))
-> IO (BufferDepth, BufferDepth, BufferDepth)
-> GettableStateVar (Maybe (BufferDepth, BufferDepth, BufferDepth))
forall a b. (a -> b) -> a -> b
$ do
      BufferDepth
b <- Getter BufferDepth
forall a. Getter a
deviceGet CInt -> BufferDepth
forall a b. (Integral a, Num b) => a -> b
fromIntegral GLenum
glut_JOYSTICK_BUTTONS
      BufferDepth
a <- Getter BufferDepth
forall a. Getter a
deviceGet CInt -> BufferDepth
forall a b. (Integral a, Num b) => a -> b
fromIntegral GLenum
glut_JOYSTICK_AXES
      BufferDepth
r <- Getter BufferDepth
forall a. Getter a
deviceGet CInt -> BufferDepth
forall a b. (Integral a, Num b) => a -> b
fromIntegral GLenum
glut_JOYSTICK_POLL_RATE
      (BufferDepth, BufferDepth, BufferDepth)
-> IO (BufferDepth, BufferDepth, BufferDepth)
forall (m :: * -> *) a. Monad m => a -> m a
return (BufferDepth
b, BufferDepth
a, BufferDepth
r)

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

-- | (/freeglut only/) Contains a list of the number of auxiliary buffers
-- supported, in increasing order.

supportedNumAuxBuffers :: GettableStateVar [Int]
supportedNumAuxBuffers :: GettableStateVar [BufferDepth]
supportedNumAuxBuffers = GLenum -> GettableStateVar [BufferDepth]
forall a. Integral a => GLenum -> GettableStateVar [a]
getModeValues GLenum
glut_AUX

-- | (/freeglut only/) Contains a list of the number of samples per pixel
-- supported for multisampling, in increasing order.

supportedSamplesPerPixel :: GettableStateVar [SampleCount]
supportedSamplesPerPixel :: GettableStateVar [BufferDepth]
supportedSamplesPerPixel = GLenum -> GettableStateVar [BufferDepth]
forall a. Integral a => GLenum -> GettableStateVar [a]
getModeValues (CUInt -> GLenum
forall a b. (Integral a, Num b) => a -> b
fromIntegral CUInt
glut_MULTISAMPLE)

getModeValues :: Integral a => GLenum -> GettableStateVar [a]
getModeValues :: GLenum -> GettableStateVar [a]
getModeValues GLenum
what = GettableStateVar [a] -> GettableStateVar [a]
forall a. IO a -> IO a
makeGettableStateVar (GettableStateVar [a] -> GettableStateVar [a])
-> GettableStateVar [a] -> GettableStateVar [a]
forall a b. (a -> b) -> a -> b
$
   (Ptr CInt -> GettableStateVar [a]) -> GettableStateVar [a]
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> GettableStateVar [a]) -> GettableStateVar [a])
-> (Ptr CInt -> GettableStateVar [a]) -> GettableStateVar [a]
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
sizeBuffer -> do
      Ptr CInt
valuesBuffer <- GLenum -> Ptr CInt -> IO (Ptr CInt)
forall (m :: * -> *).
MonadIO m =>
GLenum -> Ptr CInt -> m (Ptr CInt)
glutGetModeValues GLenum
what Ptr CInt
sizeBuffer
      CInt
size <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
sizeBuffer
      ([CInt] -> [a]) -> IO [CInt] -> GettableStateVar [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((CInt -> a) -> [CInt] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map CInt -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (IO [CInt] -> GettableStateVar [a])
-> IO [CInt] -> GettableStateVar [a]
forall a b. (a -> b) -> a -> b
$ BufferDepth -> Ptr CInt -> IO [CInt]
forall a. Storable a => BufferDepth -> Ptr a -> IO [a]
peekArray (CInt -> BufferDepth
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
size) Ptr CInt
valuesBuffer

--------------------------------------------------------------------------------
-- Convenience (un-)marshalers

i2b :: CInt -> Bool
i2b :: CInt -> Bool
i2b = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0)

b2i :: Bool ->  CInt
b2i :: Bool -> CInt
b2i Bool
False = CInt
0
b2i Bool
True = CInt
1

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

getDeviceInfo :: GLenum -> IO a -> GettableStateVar (Maybe a)
getDeviceInfo :: GLenum -> IO a -> GettableStateVar (Maybe a)
getDeviceInfo GLenum
dev IO a
act =
   GettableStateVar (Maybe a) -> GettableStateVar (Maybe a)
forall a. IO a -> IO a
makeGettableStateVar (GettableStateVar (Maybe a) -> GettableStateVar (Maybe a))
-> GettableStateVar (Maybe a) -> GettableStateVar (Maybe a)
forall a b. (a -> b) -> a -> b
$ do
      Bool
hasDevice <- Getter Bool
forall a. Getter a
deviceGet CInt -> Bool
i2b GLenum
dev
      if Bool
hasDevice then (a -> Maybe a) -> IO a -> GettableStateVar (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just IO a
act else Maybe a -> GettableStateVar (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing

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

-- | Contains version of GLUT in the form of
-- @/flavour/ /major/./minor/./patchlevel/@, where @/flavour/@ is one of
-- @GLUT@, @freeglut@ or @OpenGLUT@.

glutVersion :: GettableStateVar String
glutVersion :: GettableStateVar String
glutVersion = GettableStateVar String -> GettableStateVar String
forall a. IO a -> IO a
makeGettableStateVar (GettableStateVar String -> GettableStateVar String)
-> GettableStateVar String -> GettableStateVar String
forall a b. (a -> b) -> a -> b
$ do
   let isGLUT :: GettableStateVar Bool
isGLUT = Bool -> Bool
not (Bool -> Bool) -> GettableStateVar Bool -> GettableStateVar Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` String -> GettableStateVar Bool
forall (m :: * -> *). MonadIO m => String -> m Bool
isKnown String
"glutSetOption"
       isFreeglut :: GettableStateVar Bool
isFreeglut = Bool -> Bool
not (Bool -> Bool) -> GettableStateVar Bool -> GettableStateVar Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` String -> GettableStateVar Bool
forall (m :: * -> *). MonadIO m => String -> m Bool
isKnown String
"glutSetWindowStayOnTop"
       showVersionPart :: a -> ShowS
showVersionPart a
x = a -> ShowS
forall a. Show a => a -> ShowS
shows (a
x a -> a -> a
forall a. Integral a => a -> a -> a
`mod` a
100)
       showVersion :: a -> ShowS
showVersion a
v = a -> ShowS
forall a. (Show a, Integral a) => a -> ShowS
showVersionPart (a
v a -> a -> a
forall a. Integral a => a -> a -> a
`div` a
10000) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'.' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                       a -> ShowS
forall a. (Show a, Integral a) => a -> ShowS
showVersionPart (a
v a -> a -> a
forall a. Integral a => a -> a -> a
`div`   a
100) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'.' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                       a -> ShowS
forall a. (Show a, Integral a) => a -> ShowS
showVersionPart  a
v
   Bool
g <- GettableStateVar Bool
isGLUT
   if Bool
g
      then String -> GettableStateVar String
forall (m :: * -> *) a. Monad m => a -> m a
return String
"GLUT 3.7"   -- ToDo: just guessing
      else do Bool
f <- GettableStateVar Bool
isFreeglut
              CInt
v <- Getter CInt
forall a. Getter a
simpleGet CInt -> CInt
forall a. a -> a
id GLenum
glut_VERSION
              let prefix :: String
prefix = if Bool
f then String
"freeglut" else String
"OpenGLUT"
              String -> GettableStateVar String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> GettableStateVar String)
-> String -> GettableStateVar String
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
prefix ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' ' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> ShowS
forall a. (Show a, Integral a) => a -> ShowS
showVersion CInt
v ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
""

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

-- | (/freeglut only/) Contains the thickness of the sizing border around the
-- perimeter of a window that can be resized, in pixels.

windowBorderWidth :: GettableStateVar Int
windowBorderWidth :: GettableStateVar BufferDepth
windowBorderWidth =
   GettableStateVar BufferDepth -> GettableStateVar BufferDepth
forall a. IO a -> IO a
makeGettableStateVar (Getter BufferDepth
forall a. Getter a
simpleGet CInt -> BufferDepth
forall a b. (Integral a, Num b) => a -> b
fromIntegral GLenum
glut_WINDOW_BORDER_WIDTH)

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

-- | (/freeglut only/) Contains the height of the header\/caption area of a
-- window in pixels.

windowHeaderHeight :: GettableStateVar Int
windowHeaderHeight :: GettableStateVar BufferDepth
windowHeaderHeight =
   GettableStateVar BufferDepth -> GettableStateVar BufferDepth
forall a. IO a -> IO a
makeGettableStateVar (Getter BufferDepth
forall a. Getter a
simpleGet CInt -> BufferDepth
forall a b. (Integral a, Num b) => a -> b
fromIntegral GLenum
glut_WINDOW_HEADER_HEIGHT)

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

-- | (/freeglut on X11 only/) Controls if all but the last motion event should
-- be discarded.

skipStaleMotionEvents :: StateVar Bool
skipStaleMotionEvents :: StateVar Bool
skipStaleMotionEvents =
   GettableStateVar Bool -> (Bool -> IO ()) -> StateVar Bool
forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar
      (Getter Bool
forall a. Getter a
simpleGet CInt -> Bool
i2b GLenum
glut_SKIP_STALE_MOTION_EVENTS)
      (GLenum -> CInt -> IO ()
forall (m :: * -> *). MonadIO m => GLenum -> CInt -> m ()
glutSetOption GLenum
glut_SKIP_STALE_MOTION_EVENTS (CInt -> IO ()) -> (Bool -> CInt) -> Bool -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> CInt
b2i)

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

-- | (/freeglut only/) Contains 'True' if GLUT has been initialized 
-- with 'Graphics.UI.GLUT.Initialization.initialize' or
-- 'Graphics.UI.GLUT.Initialization.getArgsAndInitialize' has and not yet
-- been de-initialized with 'Graphics.UI.GLUT.Initialization.exit'. Contains
-- 'False' otherwise.

initState :: GettableStateVar Bool
initState :: GettableStateVar Bool
initState = GettableStateVar Bool -> GettableStateVar Bool
forall a. IO a -> IO a
makeGettableStateVar(GettableStateVar Bool -> GettableStateVar Bool)
-> GettableStateVar Bool -> GettableStateVar Bool
forall a b. (a -> b) -> a -> b
$ Getter Bool
forall a. Getter a
simpleGet CInt -> Bool
i2b GLenum
glut_INIT_STATE