    --------------------------------------------------------------------------------
    -- |
    -- Module      :  Graphics.Rendering.OpenGL.GL.Selection
    -- Copyright   :  (c) Sven Panne 2002-2019
    -- License     :  BSD3
    --
    -- Maintainer  :  Sven Panne <svenpanne@gmail.com>
    -- 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.GL

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

    data HitRecord = HitRecord GLfloat GLfloat [Name]
       deriving ( HitRecord -> HitRecord -> Bool
    (HitRecord -> HitRecord -> Bool)
    -> (HitRecord -> HitRecord -> Bool) -> Eq HitRecord
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: HitRecord -> HitRecord -> Bool
    == :: HitRecord -> HitRecord -> Bool
    $c/= :: HitRecord -> HitRecord -> Bool
    /= :: HitRecord -> HitRecord -> Bool
    Eq, Eq HitRecord
    Eq HitRecord =>
    (HitRecord -> HitRecord -> Ordering)
    -> (HitRecord -> HitRecord -> Bool)
    -> (HitRecord -> HitRecord -> Bool)
    -> (HitRecord -> HitRecord -> Bool)
    -> (HitRecord -> HitRecord -> Bool)
    -> (HitRecord -> HitRecord -> HitRecord)
    -> (HitRecord -> HitRecord -> HitRecord)
    -> Ord HitRecord
    HitRecord -> HitRecord -> Bool
    HitRecord -> HitRecord -> Ordering
    HitRecord -> HitRecord -> HitRecord
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: HitRecord -> HitRecord -> Ordering
    compare :: HitRecord -> HitRecord -> Ordering
    $c< :: HitRecord -> HitRecord -> Bool
    < :: HitRecord -> HitRecord -> Bool
    $c<= :: HitRecord -> HitRecord -> Bool
    <= :: HitRecord -> HitRecord -> Bool
    $c> :: HitRecord -> HitRecord -> Bool
    > :: HitRecord -> HitRecord -> Bool
    $c>= :: HitRecord -> HitRecord -> Bool
    >= :: HitRecord -> HitRecord -> Bool
    $cmax :: HitRecord -> HitRecord -> HitRecord
    max :: HitRecord -> HitRecord -> HitRecord
    $cmin :: HitRecord -> HitRecord -> HitRecord
    min :: HitRecord -> HitRecord -> HitRecord
    Ord, Int -> HitRecord -> ShowS
    [HitRecord] -> ShowS
    HitRecord -> String
    (Int -> HitRecord -> ShowS)
    -> (HitRecord -> String)
    -> ([HitRecord] -> ShowS)
    -> Show HitRecord
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> HitRecord -> ShowS
    showsPrec :: Int -> HitRecord -> ShowS
    $cshow :: HitRecord -> String
    show :: HitRecord -> String
    $cshowList :: [HitRecord] -> ShowS
    showList :: [HitRecord] -> ShowS
    Show )

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

    getHitRecords :: GLsizei -> IO a -> IO (a, Maybe [HitRecord])
    getHitRecords :: forall a. GLint -> IO a -> IO (a, Maybe [HitRecord])
    getHitRecords GLint
    bufSize IO a
    action =
       Int
    -> (Ptr GLuint -> IO (a, Maybe [HitRecord]))
    -> IO (a, Maybe [HitRecord])
    forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
    allocaArray (GLint -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral GLint
    bufSize) ((Ptr GLuint -> IO (a, Maybe [HitRecord]))
     -> IO (a, Maybe [HitRecord]))
    -> (Ptr GLuint -> IO (a, Maybe [HitRecord]))
    -> IO (a, Maybe [HitRecord])
    forall a b. (a -> b) -> a -> b
    $ \Ptr GLuint
    buf -> do
          GLint -> Ptr GLuint -> IO ()
    forall (m :: * -> *). MonadIO m => GLint -> Ptr GLuint -> m ()
    glSelectBuffer GLint
    bufSize Ptr GLuint
    buf
          (value, numHits) <- RenderMode -> IO a -> IO (a, GLint)
    forall a. RenderMode -> IO a -> IO (a, GLint)
    withRenderMode RenderMode
    Select (IO a -> IO (a, GLint)) -> IO a -> IO (a, GLint)
    forall a b. (a -> b) -> a -> b
    $ do
             IO ()
    forall (m :: * -> *). MonadIO m => m ()
    glInitNames
             IO a
    action
          hits <- parseSelectionBuffer numHits buf
          return (value, hits)

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

    parseSelectionBuffer :: GLint -> Ptr GLuint -> IO (Maybe [HitRecord])
    parseSelectionBuffer :: GLint -> Ptr GLuint -> IO (Maybe [HitRecord])
    parseSelectionBuffer GLint
    numHits Ptr GLuint
    buf
       | GLint
    numHits GLint -> GLint -> Bool
    forall a. Ord a => a -> a -> Bool
    < GLint
    0 = Maybe [HitRecord] -> IO (Maybe [HitRecord])
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe [HitRecord]
    forall a. Maybe a
    Nothing
       | Bool
    otherwise = ([HitRecord] -> Maybe [HitRecord])
    -> IO [HitRecord] -> IO (Maybe [HitRecord])
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap [HitRecord] -> Maybe [HitRecord]
    forall a. a -> Maybe a
    Just (IO [HitRecord] -> IO (Maybe [HitRecord]))
    -> IO [HitRecord] -> IO (Maybe [HitRecord])
    forall a b. (a -> b) -> a -> b
    $ IOState GLuint [HitRecord] -> Ptr GLuint -> IO [HitRecord]
    forall s a. IOState s a -> Ptr s -> IO a
    evalIOState (GLint -> IOState GLuint HitRecord -> IOState GLuint [HitRecord]
    forall a b c. Integral a => a -> IOState b c -> IOState b [c]
    nTimes GLint
    numHits IOState GLuint HitRecord
    parseSelectionHit) Ptr GLuint
    buf

    type Parser a = IOState GLuint a

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

    parseGLuint :: Parser GLuint
    parseGLuint :: Parser GLuint
    parseGLuint = Parser GLuint
    forall a. Storable a => IOState a a
    peekIOState

    parseGLfloat :: Parser GLfloat
    parseGLfloat :: Parser GLfloat
    parseGLfloat = (GLuint -> GLfloat) -> Parser GLuint -> Parser GLfloat
    forall a b. (a -> b) -> IOState GLuint a -> IOState GLuint b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (\GLuint
    x -> GLuint -> GLfloat
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral GLuint
    x GLfloat -> GLfloat -> GLfloat
    forall a. Fractional a => a -> a -> a
    / GLfloat
    0xffffffff) Parser GLuint
    parseGLuint

    parseName :: Parser Name
    parseName :: IOState GLuint Name
    parseName = (GLuint -> Name) -> Parser GLuint -> IOState GLuint Name
    forall a b. (a -> b) -> IOState GLuint a -> IOState GLuint b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap GLuint -> Name
    Name Parser GLuint
    parseGLuint

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

    newtype Name = Name GLuint
       deriving ( Name -> Name -> Bool
    (Name -> Name -> Bool) -> (Name -> Name -> Bool) -> Eq Name
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Name -> Name -> Bool
    == :: Name -> Name -> Bool
    $c/= :: Name -> Name -> Bool
    /= :: Name -> Name -> Bool
    Eq, Eq Name
    Eq Name =>
    (Name -> Name -> Ordering)
    -> (Name -> Name -> Bool)
    -> (Name -> Name -> Bool)
    -> (Name -> Name -> Bool)
    -> (Name -> Name -> Bool)
    -> (Name -> Name -> Name)
    -> (Name -> Name -> Name)
    -> Ord Name
    Name -> Name -> Bool
    Name -> Name -> Ordering
    Name -> Name -> Name
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: Name -> Name -> Ordering
    compare :: Name -> Name -> Ordering
    $c< :: Name -> Name -> Bool
    < :: Name -> Name -> Bool
    $c<= :: Name -> Name -> Bool
    <= :: Name -> Name -> Bool
    $c> :: Name -> Name -> Bool
    > :: Name -> Name -> Bool
    $c>= :: Name -> Name -> Bool
    >= :: Name -> Name -> Bool
    $cmax :: Name -> Name -> Name
    max :: Name -> Name -> Name
    $cmin :: Name -> Name -> Name
    min :: Name -> Name -> Name
    Ord, Int -> Name -> ShowS
    [Name] -> ShowS
    Name -> String
    (Int -> Name -> ShowS)
    -> (Name -> String) -> ([Name] -> ShowS) -> Show Name
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Name -> ShowS
    showsPrec :: Int -> Name -> ShowS
    $cshow :: Name -> String
    show :: Name -> String
    $cshowList :: [Name] -> ShowS
    showList :: [Name] -> ShowS
    Show )

    withName :: Name -> IO a -> IO a
    withName :: forall a. Name -> IO a -> IO a
    withName (Name GLuint
    name) = IO () -> IO () -> IO a -> IO a
    forall a b c. IO a -> IO b -> IO c -> IO c
    bracket_ (GLuint -> IO ()
    forall (m :: * -> *). MonadIO m => GLuint -> m ()
    glPushName GLuint
    name) IO ()
    forall (m :: * -> *). MonadIO m => m ()
    glPopName

    loadName :: Name -> IO ()
    loadName :: Name -> IO ()
    loadName (Name GLuint
    n) = GLuint -> IO ()
    forall (m :: * -> *). MonadIO m => GLuint -> m ()
    glLoadName GLuint
    n

    maxNameStackDepth :: GettableStateVar GLsizei
    maxNameStackDepth :: GettableStateVar GLint
    maxNameStackDepth = GettableStateVar GLint -> GettableStateVar GLint
    forall a. IO a -> IO a
    makeGettableStateVar ((GLint -> GLint) -> PName1I -> GettableStateVar GLint
    forall p a. GetPName1I p => (GLint -> a) -> p -> IO a
    forall a. (GLint -> a) -> PName1I -> IO a
    getSizei1 GLint -> GLint
    forall a. a -> a
    id PName1I
    GetMaxNameStackDepth)

    nameStackDepth :: GettableStateVar GLsizei
    nameStackDepth :: GettableStateVar GLint
    nameStackDepth = GettableStateVar GLint -> GettableStateVar GLint
    forall a. IO a -> IO a
    makeGettableStateVar ((GLint -> GLint) -> PName1I -> GettableStateVar GLint
    forall p a. GetPName1I p => (GLint -> a) -> p -> IO a
    forall a. (GLint -> a) -> PName1I -> IO a
    getSizei1 GLint -> GLint
    forall a. a -> a
    id PName1I
    GetNameStackDepth)