{-# OPTIONS_HADDOCK hide #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  Graphics.Rendering.OpenGL.GL.QueryUtils
-- Copyright   :  (c) Sven Panne 2002-2019
-- License     :  BSD3
--
-- Maintainer  :  Sven Panne <svenpanne@gmail.com>
-- Stability   :  stable
-- Portability :  portable
--
-- This is a purely internal module with utilities to query OpenGL state.
--
--------------------------------------------------------------------------------

module Graphics.Rendering.OpenGL.GL.QueryUtils (
   module Graphics.Rendering.OpenGL.GL.QueryUtils.PName,
   module Graphics.Rendering.OpenGL.GL.QueryUtils.VertexAttrib,

   lightIndexToEnum,
   modelviewIndexToEnum, modelviewEnumToIndex,

   maybeNullPtr,

   objectNameLabel, objectPtrLabel, maxLabelLength
) where

import Data.StateVar
import Foreign.C.String ( peekCStringLen, withCStringLen )
import Foreign.Ptr ( Ptr, nullPtr )
import Foreign.Marshal.Alloc ( alloca )
import Foreign.Marshal.Array ( allocaArray )
import Graphics.Rendering.OpenGL.GL.PeekPoke
import Graphics.Rendering.OpenGL.GL.QueryUtils.PName
import Graphics.Rendering.OpenGL.GL.QueryUtils.VertexAttrib
import Graphics.GL

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

-- 0x4000 through 0x4FFF are reserved for light numbers

lightIndexToEnum :: GLsizei -> Maybe GLenum
lightIndexToEnum :: GLsizei -> Maybe GLenum
lightIndexToEnum GLsizei
i
   | GLsizei
0 GLsizei -> GLsizei -> Bool
forall a. Ord a => a -> a -> Bool
<= GLsizei
i Bool -> Bool -> Bool
&& GLsizei
i GLsizei -> GLsizei -> Bool
forall a. Ord a => a -> a -> Bool
<= GLsizei
maxLightIndex = GLenum -> Maybe GLenum
forall a. a -> Maybe a
Just (GLenum
GL_LIGHT0 GLenum -> GLenum -> GLenum
forall a. Num a => a -> a -> a
+ GLsizei -> GLenum
forall a b. (Integral a, Num b) => a -> b
fromIntegral GLsizei
i)
   | Bool
otherwise = Maybe GLenum
forall a. Maybe a
Nothing

maxLightIndex :: GLsizei
maxLightIndex :: GLsizei
maxLightIndex = GLsizei
0xFFF

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

-- 0x1700, 0x850a, and 0x8722 through 0x873f are reserved for modelview matrices

modelviewIndexToEnum :: GLsizei -> Maybe GLenum
modelviewIndexToEnum :: GLsizei -> Maybe GLenum
modelviewIndexToEnum GLsizei
0 = GLenum -> Maybe GLenum
forall a. a -> Maybe a
Just GLenum
GL_MODELVIEW
modelviewIndexToEnum GLsizei
1 = GLenum -> Maybe GLenum
forall a. a -> Maybe a
Just GLenum
GL_MODELVIEW1_ARB
modelviewIndexToEnum GLsizei
i
   | GLsizei
2 GLsizei -> GLsizei -> Bool
forall a. Ord a => a -> a -> Bool
<= GLsizei
i Bool -> Bool -> Bool
&& GLsizei
i GLsizei -> GLsizei -> Bool
forall a. Ord a => a -> a -> Bool
<= GLsizei
31 = GLenum -> Maybe GLenum
forall a. a -> Maybe a
Just (GLenum
GL_MODELVIEW2_ARB GLenum -> GLenum -> GLenum
forall a. Num a => a -> a -> a
- GLenum
2 GLenum -> GLenum -> GLenum
forall a. Num a => a -> a -> a
+ GLsizei -> GLenum
forall a b. (Integral a, Num b) => a -> b
fromIntegral GLsizei
i)
   | Bool
otherwise = Maybe GLenum
forall a. Maybe a
Nothing

modelviewEnumToIndex :: GLenum -> Maybe GLsizei
modelviewEnumToIndex :: GLenum -> Maybe GLsizei
modelviewEnumToIndex GLenum
x
   | GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_MODELVIEW = GLsizei -> Maybe GLsizei
forall a. a -> Maybe a
Just GLsizei
0
   | GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_MODELVIEW1_ARB = GLsizei -> Maybe GLsizei
forall a. a -> Maybe a
Just GLsizei
1
   | GLenum
GL_MODELVIEW2_ARB GLenum -> GLenum -> Bool
forall a. Ord a => a -> a -> Bool
<= GLenum
x Bool -> Bool -> Bool
&& GLenum
x GLenum -> GLenum -> Bool
forall a. Ord a => a -> a -> Bool
<= GLenum
GL_MODELVIEW31_ARB = GLsizei -> Maybe GLsizei
forall a. a -> Maybe a
Just (GLenum -> GLsizei
forall a b. (Integral a, Num b) => a -> b
fromIntegral (GLenum
x GLenum -> GLenum -> GLenum
forall a. Num a => a -> a -> a
- (GLenum
GL_MODELVIEW2_ARB GLenum -> GLenum -> GLenum
forall a. Num a => a -> a -> a
- GLenum
2)))
   | Bool
otherwise = Maybe GLsizei
forall a. Maybe a
Nothing

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

maybeNullPtr :: b -> (Ptr a -> b) -> Ptr a -> b
maybeNullPtr :: b -> (Ptr a -> b) -> Ptr a -> b
maybeNullPtr b
n Ptr a -> b
f Ptr a
ptr | Ptr a
ptr Ptr a -> Ptr a -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr a
forall a. Ptr a
nullPtr = b
n
                     | Bool
otherwise      = Ptr a -> b
f Ptr a
ptr

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

objectNameLabel :: GLuint -> GLenum -> StateVar (Maybe String)
objectNameLabel :: GLenum -> GLenum -> StateVar (Maybe String)
objectNameLabel GLenum
name GLenum
ident =
 IO (Maybe String)
-> (Maybe String -> IO ()) -> StateVar (Maybe String)
forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar
   ((GLsizei -> Ptr GLsizei -> Ptr GLchar -> IO ())
-> IO (Maybe String)
getObjectLabelWith (GLenum -> GLenum -> GLsizei -> Ptr GLsizei -> Ptr GLchar -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> GLsizei -> Ptr GLsizei -> Ptr GLchar -> m ()
glGetObjectLabel GLenum
ident GLenum
name))
   ((GLsizei -> Ptr GLchar -> IO ()) -> Maybe String -> IO ()
setObjectLabelWith (GLenum -> GLenum -> GLsizei -> Ptr GLchar -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> GLsizei -> Ptr GLchar -> m ()
glObjectLabel GLenum
ident GLenum
name))

objectPtrLabel :: Ptr () -> StateVar (Maybe String)
objectPtrLabel :: Ptr () -> StateVar (Maybe String)
objectPtrLabel Ptr ()
ptr =
  IO (Maybe String)
-> (Maybe String -> IO ()) -> StateVar (Maybe String)
forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar
    ((GLsizei -> Ptr GLsizei -> Ptr GLchar -> IO ())
-> IO (Maybe String)
getObjectLabelWith (Ptr () -> GLsizei -> Ptr GLsizei -> Ptr GLchar -> IO ()
forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> GLsizei -> Ptr GLsizei -> Ptr GLchar -> m ()
glGetObjectPtrLabel Ptr ()
ptr))
    ((GLsizei -> Ptr GLchar -> IO ()) -> Maybe String -> IO ()
setObjectLabelWith (Ptr () -> GLsizei -> Ptr GLchar -> IO ()
forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> GLsizei -> Ptr GLchar -> m ()
glObjectPtrLabel Ptr ()
ptr))

getObjectLabelWith :: (GLsizei -> Ptr GLsizei -> Ptr GLchar -> IO ())
                   -> IO (Maybe String)
getObjectLabelWith :: (GLsizei -> Ptr GLsizei -> Ptr GLchar -> IO ())
-> IO (Maybe String)
getObjectLabelWith GLsizei -> Ptr GLsizei -> Ptr GLchar -> IO ()
getLabel = do
  GLsizei
maxLen <- GettableStateVar GLsizei -> GettableStateVar GLsizei
forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
get GettableStateVar GLsizei
maxLabelLength
  (Ptr GLsizei -> IO (Maybe String)) -> IO (Maybe String)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr GLsizei -> IO (Maybe String)) -> IO (Maybe String))
-> (Ptr GLsizei -> IO (Maybe String)) -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ \Ptr GLsizei
lenBuf ->
    Int -> (Ptr GLchar -> IO (Maybe String)) -> IO (Maybe String)
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray (GLsizei -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral GLsizei
maxLen) ((Ptr GLchar -> IO (Maybe String)) -> IO (Maybe String))
-> (Ptr GLchar -> IO (Maybe String)) -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ \Ptr GLchar
labelBuf -> do
      GLsizei -> Ptr GLsizei -> Ptr GLchar -> IO ()
getLabel GLsizei
maxLen Ptr GLsizei
lenBuf Ptr GLchar
labelBuf
      Int
actualLen <- (GLsizei -> Int) -> Ptr GLsizei -> IO Int
forall a b. Storable a => (a -> b) -> Ptr a -> IO b
peek1 GLsizei -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Ptr GLsizei
lenBuf
      String
label <- CStringLen -> IO String
peekCStringLen (Ptr GLchar
labelBuf, Int
actualLen)
      Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> IO (Maybe String))
-> Maybe String -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ if String
label String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"" then Maybe String
forall a. Maybe a
Nothing else String -> Maybe String
forall a. a -> Maybe a
Just String
label

setObjectLabelWith :: (GLsizei -> Ptr GLchar -> IO ()) -> Maybe String -> IO ()
setObjectLabelWith :: (GLsizei -> Ptr GLchar -> IO ()) -> Maybe String -> IO ()
setObjectLabelWith GLsizei -> Ptr GLchar -> IO ()
setLabel =
  IO () -> (String -> IO ()) -> Maybe String -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (CStringLen -> IO ()
forall a. Integral a => (Ptr GLchar, a) -> IO ()
set (Ptr GLchar
forall a. Ptr a
nullPtr, (Int
0 :: Int))) ((String -> (CStringLen -> IO ()) -> IO ())
-> (CStringLen -> IO ()) -> String -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> (CStringLen -> IO ()) -> IO ()
forall a. String -> (CStringLen -> IO a) -> IO a
withCStringLen CStringLen -> IO ()
forall a. Integral a => (Ptr GLchar, a) -> IO ()
set)
  where set :: (Ptr GLchar, a) -> IO ()
set (Ptr GLchar
labelBuf, a
len) = GLsizei -> Ptr GLchar -> IO ()
setLabel (a -> GLsizei
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
len) Ptr GLchar
labelBuf

maxLabelLength :: GettableStateVar GLsizei
maxLabelLength :: GettableStateVar GLsizei
maxLabelLength =
  GettableStateVar GLsizei -> GettableStateVar GLsizei
forall a. IO a -> IO a
makeGettableStateVar ((GLsizei -> GLsizei) -> PName1I -> GettableStateVar GLsizei
forall p a. GetPName1I p => (GLsizei -> a) -> p -> IO a
getSizei1 GLsizei -> GLsizei
forall a. a -> a
id PName1I
GetMaxLabelLength)