    --------------------------------------------------------------------------------
    -- |
    -- Module      :  Graphics.UI.GLUT.State
    -- Copyright   :  (c) Sven Panne 2002-2005
    -- License     :  BSD-style (see the file libraries/GLUT/LICENSE)
    --
    -- Maintainer  :  sven.panne@aedion.de
    -- 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,

      -- * State of the /current window/
      rgba,
      BufferDepth, rgbaBufferDepths, colorBufferDepth,
      doubleBuffered, stereo,
      accumBufferDepths, depthBufferDepth, stencilBufferDepth,
      SampleCount, sampleCount, formatID,

      -- * GLUT state pertaining to the layers of the /current window/
      damaged,

      -- * Timing
      elapsedTime,

      -- * Device information

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

      -- * GLUT information
     glutVersion
    ) where

    import Foreign.C.Types ( CInt )
    import Foreign.Ptr ( nullFunPtr )
    import Graphics.Rendering.OpenGL.GL.BasicTypes ( GLenum )
    import Graphics.Rendering.OpenGL.GL.CoordTrans ( Size(..) )
    import Graphics.Rendering.OpenGL.GL.StateVar (
       GettableStateVar, makeGettableStateVar )
    import Graphics.UI.GLUT.Constants (
       glut_WINDOW_RGBA,
       glut_WINDOW_RED_SIZE, glut_WINDOW_GREEN_SIZE, glut_WINDOW_BLUE_SIZE,
       glut_WINDOW_ALPHA_SIZE, glut_WINDOW_BUFFER_SIZE,
       glut_WINDOW_DOUBLEBUFFER, glut_WINDOW_STEREO,
       glut_WINDOW_ACCUM_RED_SIZE, glut_WINDOW_ACCUM_GREEN_SIZE,
       glut_WINDOW_ACCUM_BLUE_SIZE, glut_WINDOW_ACCUM_ALPHA_SIZE,
       glut_WINDOW_DEPTH_SIZE, glut_WINDOW_STENCIL_SIZE, glut_WINDOW_NUM_SAMPLES,
       glut_WINDOW_FORMAT_ID, glut_ELAPSED_TIME,
       glut_NORMAL_DAMAGED, glut_OVERLAY_DAMAGED,
       glut_SCREEN_WIDTH, glut_SCREEN_HEIGHT,
       glut_SCREEN_WIDTH_MM, glut_SCREEN_HEIGHT_MM,
       glut_HAS_KEYBOARD,
       glut_HAS_MOUSE, glut_NUM_MOUSE_BUTTONS,
       glut_HAS_SPACEBALL, glut_NUM_SPACEBALL_BUTTONS,
       glut_HAS_DIAL_AND_BUTTON_BOX, glut_NUM_DIALS, glut_NUM_BUTTON_BOX_BUTTONS,
       glut_HAS_TABLET, glut_NUM_TABLET_BUTTONS,
       glut_HAS_JOYSTICK, glut_JOYSTICK_BUTTONS, glut_JOYSTICK_POLL_RATE,
       glut_JOYSTICK_AXES,
       glut_VERSION, glut_WINDOW_BORDER_WIDTH, glut_WINDOW_HEADER_HEIGHT )

    import Graphics.UI.GLUT.Overlay ( Layer(..) )
    import Graphics.UI.GLUT.QueryUtils ( simpleGet, layerGet, deviceGet )
    import Graphics.UI.GLUT.Extensions ( getProcAddressInternal )

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

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

    rgba :: GettableStateVar Bool
    rgba = makeGettableStateVar$ simpleGet i2b 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 = makeGettableStateVar $ do
       r <- simpleGet fromIntegral glut_WINDOW_RED_SIZE
       g <- simpleGet fromIntegral glut_WINDOW_GREEN_SIZE
       b <- simpleGet fromIntegral glut_WINDOW_BLUE_SIZE
       a <- simpleGet fromIntegral glut_WINDOW_ALPHA_SIZE
       return (r, g, b, 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 =
       makeGettableStateVar $ simpleGet fromIntegral glut_WINDOW_BUFFER_SIZE

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

    doubleBuffered :: GettableStateVar Bool
    doubleBuffered = makeGettableStateVar $ simpleGet i2b glut_WINDOW_DOUBLEBUFFER

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

    stereo :: GettableStateVar Bool
    stereo = makeGettableStateVar $ simpleGet i2b 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 = makeGettableStateVar $ do
       r <- simpleGet fromIntegral glut_WINDOW_ACCUM_RED_SIZE
       g <- simpleGet fromIntegral glut_WINDOW_ACCUM_GREEN_SIZE
       b <- simpleGet fromIntegral glut_WINDOW_ACCUM_BLUE_SIZE
       a <- simpleGet fromIntegral glut_WINDOW_ACCUM_ALPHA_SIZE
       return (r, g, b, a)

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

    depthBufferDepth :: GettableStateVar BufferDepth
    depthBufferDepth =
       makeGettableStateVar $ simpleGet fromIntegral glut_WINDOW_DEPTH_SIZE

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

    stencilBufferDepth :: GettableStateVar BufferDepth
    stencilBufferDepth =
       makeGettableStateVar $ simpleGet fromIntegral 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 =
       makeGettableStateVar $ simpleGet fromIntegral 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 = makeGettableStateVar $ simpleGet fromIntegral glut_WINDOW_FORMAT_ID

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

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

    elapsedTime :: GettableStateVar Int
    elapsedTime = makeGettableStateVar $ simpleGet fromIntegral 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 l = makeGettableStateVar $ layerGet isDamaged (marshalDamagedLayer l)
       where isDamaged d = d /= 0 && d /= -1
             marshalDamagedLayer x = case x of
                Normal -> glut_NORMAL_DAMAGED
                Overlay -> 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 =
       makeGettableStateVar $ do
          wpx <- simpleGet fromIntegral glut_SCREEN_WIDTH
          hpx <- simpleGet fromIntegral glut_SCREEN_HEIGHT
          return $ Size wpx hpx

    -- | The size of the screen in millimeters.

    screenSizeMM :: GettableStateVar Size
    screenSizeMM =
       makeGettableStateVar $ do
          wmm <- simpleGet fromIntegral glut_SCREEN_WIDTH_MM
          hmm <- simpleGet fromIntegral glut_SCREEN_HEIGHT_MM
          return $ Size wmm hmm

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

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

    hasKeyboard :: GettableStateVar Bool
    hasKeyboard = makeGettableStateVar $ deviceGet i2b 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 =
       getDeviceInfo glut_HAS_MOUSE $
          deviceGet fromIntegral 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 =
       getDeviceInfo glut_HAS_SPACEBALL $
          deviceGet fromIntegral 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 =
       getDeviceInfo glut_HAS_DIAL_AND_BUTTON_BOX $ do
          d <- deviceGet fromIntegral glut_NUM_DIALS
          b <- deviceGet fromIntegral glut_NUM_BUTTON_BOX_BUTTONS
          return (d, b)

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

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

    numTabletButtons :: GettableStateVar (Maybe ButtonCount)
    numTabletButtons =
       getDeviceInfo glut_HAS_TABLET $
          deviceGet fromIntegral 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 =
       getDeviceInfo glut_HAS_JOYSTICK $ do
          b <- deviceGet fromIntegral glut_JOYSTICK_BUTTONS
          a <- deviceGet fromIntegral glut_JOYSTICK_AXES
          r <- deviceGet fromIntegral glut_JOYSTICK_POLL_RATE
          return (b, a, r)

    --------------------------------------------------------------------------------
    -- Convenience unmarshalers

    i2b :: CInt -> Bool
    i2b = (/= 0)

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

    getDeviceInfo :: GLenum -> IO a -> GettableStateVar (Maybe a)
    getDeviceInfo dev act =
       makeGettableStateVar $ do
          hasDevice <- deviceGet i2b dev
          if hasDevice then fmap Just act else return 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 = makeGettableStateVar $ do
       let isGLUT = isUnknown "glutSetOption"
           isFreeglut = isUnknown "glutSetWindowStayOnTop"
           isUnknown = fmap (== nullFunPtr) . getProcAddressInternal
           showVersionPart x = shows (x `mod` 100)
           showVersion v = showVersionPart (v `div` 10000) . showChar '.' .
                           showVersionPart (v `div`   100) . showChar '.' .
                           showVersionPart  v
       g <- isGLUT
       if g
          then return "GLUT 3.7"   -- ToDo: just guessing
          else do f <- isFreeglut
                  v <- simpleGet id glut_VERSION
                  let prefix = if f then "freeglut" else "OpenGLUT"
                  return $ showString prefix . showChar ' ' . showVersion v $ ""

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

    -- | (/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 =
       makeGettableStateVar (simpleGet fromIntegral glut_WINDOW_BORDER_WIDTH)

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

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

    windowHeaderHeight :: GettableStateVar Int
    windowHeaderHeight =
       makeGettableStateVar (simpleGet fromIntegral glut_WINDOW_HEADER_HEIGHT)