    --------------------------------------------------------------------------------
    -- |
    -- 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 Foreign.Marshal.Array ( allocaArray )
    import Foreign.Ptr ( Ptr )
    import Graphics.Rendering.OpenGL.GL.BasicTypes (
       GLint, GLsizei, GLuint, GLfloat )
    import Graphics.Rendering.OpenGL.GL.Exception ( bracket_ )
    import Graphics.Rendering.OpenGL.GL.IOState (
       IOState, peekIOState, evalIOState, nTimes )
    import Graphics.Rendering.OpenGL.GL.QueryUtils (
       GetPName(GetMaxNameStackDepth,GetNameStackDepth), getSizei1 )
    import Graphics.Rendering.OpenGL.GL.RenderMode (
       RenderMode(..), withRenderMode, renderMode )
    import Graphics.Rendering.OpenGL.GL.StateVar (
       GettableStateVar, makeGettableStateVar )

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

    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)

    foreign import CALLCONV unsafe "glInitNames" glInitNames :: IO ()

    foreign import CALLCONV unsafe "glSelectBuffer" glSelectBuffer ::
       GLsizei -> Ptr GLuint -> IO ()

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

    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 = bracket_ (glPushName name) glPopName

    foreign import CALLCONV unsafe "glPopName" glPopName :: IO ()

    foreign import CALLCONV unsafe "glPushName" glPushName :: Name -> IO ()

    foreign import CALLCONV unsafe "glLoadName" loadName :: Name -> IO ()

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

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