    --------------------------------------------------------------------------------
    -- |
    -- 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 = 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

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

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

    fullScreenMode :: StateVar Bool
    fullScreenMode = makeStateVar getFullScreenMode setFullScreenMode

    getFullScreenMode :: IO Bool
    getFullScreenMode = simpleGet i2b glut_FULL_SCREEN

    setFullScreenMode :: Bool -> IO ()
    setFullScreenMode newMode = do
       oldMode <- getFullScreenMode
       unless (newMode == oldMode) fullScreenToggle

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

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

    geometryVisualizeNormals :: StateVar Bool
    geometryVisualizeNormals =
       makeStateVar
          (simpleGet i2b glut_GEOMETRY_VISUALIZE_NORMALS)
          (glutSetOption glut_GEOMETRY_VISUALIZE_NORMALS . 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 = setVertexAttribWith glutSetVertexAttribCoord3

    setVertexAttribWith :: (GLint -> IO ()) -> SettableStateVar (Maybe AttribLocation)
    setVertexAttribWith f = makeSettableStateVar $ f . getLocation
       where getLocation = maybe (-1) (\(AttribLocation l) -> fromIntegral 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 = setVertexAttribWith 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 = setVertexAttribWith glutSetVertexAttribTexCoord2

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

    -- | 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)

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

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

    supportedNumAuxBuffers :: GettableStateVar [Int]
    supportedNumAuxBuffers = getModeValues glut_AUX

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

    supportedSamplesPerPixel :: GettableStateVar [SampleCount]
    supportedSamplesPerPixel = getModeValues (fromIntegral glut_MULTISAMPLE)

    getModeValues :: Integral a => GLenum -> GettableStateVar [a]
    getModeValues what = makeGettableStateVar $
       alloca $ \sizeBuffer -> do
          valuesBuffer <- glutGetModeValues what sizeBuffer
          size <- peek sizeBuffer
          fmap (map fromIntegral) $ peekArray (fromIntegral size) valuesBuffer

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

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

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

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

    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 = not `fmap` isKnown "glutSetOption"
           isFreeglut = not `fmap` isKnown "glutSetWindowStayOnTop"
           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)

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

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

    skipStaleMotionEvents :: StateVar Bool
    skipStaleMotionEvents =
       makeStateVar
          (simpleGet i2b glut_SKIP_STALE_MOTION_EVENTS)
          (glutSetOption glut_SKIP_STALE_MOTION_EVENTS . 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 = makeGettableStateVar$ simpleGet i2b glut_INIT_STATE