    --------------------------------------------------------------------------------
    -- |
    -- Module      :  Graphics.Rendering.OpenGL.GL.Selection
    -- Copyright   :  (c) Sven Panne 2002-2009
    -- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)
    --
    -- Maintainer  :  sven.panne@aedion.de
    -- Stability   :  stable
    -- Portability :  portable
    --
    -- This module corresponds to section 5.2 (Selection) of the OpenGL 2.1 specs.
    --
    --------------------------------------------------------------------------------

    module Graphics.Rendering.OpenGL.GL.Selection (
       HitRecord(..), getHitRecords,
       Name(..), withName, loadName, maxNameStackDepth, nameStackDepth,
       RenderMode(..), renderMode
    ) where

    import Data.StateVar
    import Foreign.Marshal.Array
    import Foreign.Ptr
    import Graphics.Rendering.OpenGL.GL.Exception
    import Graphics.Rendering.OpenGL.GL.IOState
    import Graphics.Rendering.OpenGL.GL.QueryUtils
    import Graphics.Rendering.OpenGL.GL.RenderMode
    import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility (
       glSelectBuffer, glInitNames, glPushName, glPopName, glLoadName )
    import Graphics.Rendering.OpenGL.Raw.Core31

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

    data HitRecord = HitRecord GLfloat GLfloat [Name]
       deriving ( Eq, Ord, Show )

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

    getHitRecords :: GLsizei -> IO a -> IO (a, Maybe [HitRecord])
    getHitRecords bufSize action =
       allocaArray (fromIntegral bufSize) $ \buf -> do
          glSelectBuffer bufSize buf
          (value, numHits) <- withRenderMode Select $ do
             glInitNames
             action
          hits <- parseSelectionBuffer numHits buf
          return (value, hits)

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

    parseSelectionBuffer :: GLint -> Ptr GLuint -> IO (Maybe [HitRecord])
    parseSelectionBuffer numHits buf
       | numHits < 0 = return Nothing
       | otherwise = fmap Just $ evalIOState (nTimes numHits parseSelectionHit) buf

    type Parser a = IOState GLuint a

    parseSelectionHit :: Parser HitRecord
    parseSelectionHit = do
       numNames <- parseGLuint
       minZ <- parseGLfloat
       maxZ <- parseGLfloat
       nameStack <- nTimes numNames parseName
       return $ HitRecord minZ maxZ nameStack

    parseGLuint :: Parser GLuint
    parseGLuint = peekIOState

    parseGLfloat :: Parser GLfloat
    parseGLfloat = fmap (\x -> fromIntegral x / 0xffffffff) parseGLuint

    parseName :: Parser Name
    parseName = fmap Name parseGLuint

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

    newtype Name = Name GLuint
       deriving ( Eq, Ord, Show )

    withName :: Name -> IO a -> IO a
    withName (Name name) = bracket_ (glPushName name) glPopName

    loadName :: Name -> IO ()
    loadName (Name n) = glLoadName n

    maxNameStackDepth :: GettableStateVar GLsizei
    maxNameStackDepth = makeGettableStateVar (getSizei1 id GetMaxNameStackDepth)

    nameStackDepth :: GettableStateVar GLsizei
    nameStackDepth = makeGettableStateVar (getSizei1 id GetNameStackDepth)