-----------------------------------------------------------------------------
-- |
-- Module      :  Graphics.Rendering.OpenGL.GL.QueryObjects
-- Copyright   :  (c) Sven Panne 2004-2019, Lars Corbijn 2004-2016
-- License     :  BSD3
--
-- Maintainer  :  Sven Panne <svenpanne@gmail.com>
-- Stability   :  stable
-- Portability :  portable
--
-- This module corresponds to section 4.2 (Query Objects and Asynchronous
-- Queries) of the OpenGL 4.4 specs.
--
-----------------------------------------------------------------------------

{-# LANGUAGE TypeSynonymInstances #-}

module Graphics.Rendering.OpenGL.GL.QueryObjects (
   -- * Creating and Delimiting Queries
   QueryObject, QueryIndex, maxVertexStreams, QueryTarget(..),
   beginQuery, endQuery, withQuery,

   -- * Query Target Queries
   currentQuery, queryCounterBits,

   -- * Query Object Queries
   queryResultAvailable, QueryResult, queryResult,

   -- * Time Queries
   timestampQuery, timestamp
) where

import Data.StateVar
import Foreign.Marshal.Alloc
import Foreign.Marshal.Utils
import Foreign.Ptr
import Foreign.Storable
import Graphics.Rendering.OpenGL.GL.Exception
import Graphics.Rendering.OpenGL.GL.GLboolean
import Graphics.Rendering.OpenGL.GL.PeekPoke
import Graphics.Rendering.OpenGL.GL.QueryObject
import Graphics.Rendering.OpenGL.GL.QueryUtils
import Graphics.GL

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

type QueryIndex = GLuint

maxVertexStreams :: GettableStateVar QueryIndex
maxVertexStreams :: GettableStateVar GLuint
maxVertexStreams =
   forall a. IO a -> IO a
makeGettableStateVar (forall p a. GetPName1I p => (GLint -> a) -> p -> IO a
getInteger1 forall a b. (Integral a, Num b) => a -> b
fromIntegral PName1I
GetMaxVertexStreams)

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

data QueryTarget =
     SamplesPassed
   | AnySamplesPassed
   | AnySamplesPassedConservative
   | TimeElapsed
   | PrimitivesGenerated QueryIndex
   | TransformFeedbackPrimitivesWritten QueryIndex
   deriving ( QueryTarget -> QueryTarget -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QueryTarget -> QueryTarget -> Bool
$c/= :: QueryTarget -> QueryTarget -> Bool
== :: QueryTarget -> QueryTarget -> Bool
$c== :: QueryTarget -> QueryTarget -> Bool
Eq, Eq QueryTarget
QueryTarget -> QueryTarget -> Bool
QueryTarget -> QueryTarget -> Ordering
QueryTarget -> QueryTarget -> QueryTarget
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
min :: QueryTarget -> QueryTarget -> QueryTarget
$cmin :: QueryTarget -> QueryTarget -> QueryTarget
max :: QueryTarget -> QueryTarget -> QueryTarget
$cmax :: QueryTarget -> QueryTarget -> QueryTarget
>= :: QueryTarget -> QueryTarget -> Bool
$c>= :: QueryTarget -> QueryTarget -> Bool
> :: QueryTarget -> QueryTarget -> Bool
$c> :: QueryTarget -> QueryTarget -> Bool
<= :: QueryTarget -> QueryTarget -> Bool
$c<= :: QueryTarget -> QueryTarget -> Bool
< :: QueryTarget -> QueryTarget -> Bool
$c< :: QueryTarget -> QueryTarget -> Bool
compare :: QueryTarget -> QueryTarget -> Ordering
$ccompare :: QueryTarget -> QueryTarget -> Ordering
Ord, Int -> QueryTarget -> ShowS
[QueryTarget] -> ShowS
QueryTarget -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [QueryTarget] -> ShowS
$cshowList :: [QueryTarget] -> ShowS
show :: QueryTarget -> String
$cshow :: QueryTarget -> String
showsPrec :: Int -> QueryTarget -> ShowS
$cshowsPrec :: Int -> QueryTarget -> ShowS
Show )

marshalQueryTarget :: QueryTarget -> (GLenum, QueryIndex)
marshalQueryTarget :: QueryTarget -> (GLuint, GLuint)
marshalQueryTarget QueryTarget
x = case QueryTarget
x of
   QueryTarget
SamplesPassed -> (GLuint
GL_SAMPLES_PASSED, GLuint
0)
   QueryTarget
AnySamplesPassed -> (GLuint
GL_ANY_SAMPLES_PASSED, GLuint
0)
   QueryTarget
AnySamplesPassedConservative -> (GLuint
GL_ANY_SAMPLES_PASSED_CONSERVATIVE, GLuint
0)
   QueryTarget
TimeElapsed -> (GLuint
GL_TIME_ELAPSED, GLuint
0)
   PrimitivesGenerated GLuint
n -> (GLuint
GL_PRIMITIVES_GENERATED, GLuint
n)
   TransformFeedbackPrimitivesWritten GLuint
n ->
      (GLuint
GL_TRANSFORM_FEEDBACK_PRIMITIVES_WRITTEN, GLuint
n)

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

beginQuery :: QueryTarget -> QueryObject -> IO ()
beginQuery :: QueryTarget -> QueryObject -> IO ()
beginQuery QueryTarget
target = case QueryTarget -> (GLuint, GLuint)
marshalQueryTarget QueryTarget
target of
   (GLuint
t, GLuint
0) -> forall (m :: * -> *). MonadIO m => GLuint -> GLuint -> m ()
glBeginQuery GLuint
t forall b c a. (b -> c) -> (a -> b) -> a -> c
. QueryObject -> GLuint
queryID
   (GLuint
t, GLuint
n) -> forall (m :: * -> *).
MonadIO m =>
GLuint -> GLuint -> GLuint -> m ()
glBeginQueryIndexed GLuint
t GLuint
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. QueryObject -> GLuint
queryID

endQuery :: QueryTarget -> IO ()
endQuery :: QueryTarget -> IO ()
endQuery QueryTarget
target = case QueryTarget -> (GLuint, GLuint)
marshalQueryTarget QueryTarget
target of
   (GLuint
t, GLuint
0) -> forall (m :: * -> *). MonadIO m => GLuint -> m ()
glEndQuery GLuint
t
   (GLuint
t, GLuint
n) -> forall (m :: * -> *). MonadIO m => GLuint -> GLuint -> m ()
glEndQueryIndexed GLuint
t GLuint
n

-- | Convenience function for an exception-safe combination of 'beginQuery' and
-- 'endQuery'.
withQuery :: QueryTarget -> QueryObject -> IO a -> IO a
withQuery :: forall a. QueryTarget -> QueryObject -> IO a -> IO a
withQuery QueryTarget
t QueryObject
q = forall a b c. IO a -> IO b -> IO c -> IO c
bracket_ (QueryTarget -> QueryObject -> IO ()
beginQuery QueryTarget
t QueryObject
q) (QueryTarget -> IO ()
endQuery QueryTarget
t)

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

data GetQueryPName =
     QueryCounterBits
   | CurrentQuery

marshalGetQueryPName :: GetQueryPName -> GLenum
marshalGetQueryPName :: GetQueryPName -> GLuint
marshalGetQueryPName GetQueryPName
x = case GetQueryPName
x of
   GetQueryPName
QueryCounterBits -> GLuint
GL_QUERY_COUNTER_BITS
   GetQueryPName
CurrentQuery -> GLuint
GL_CURRENT_QUERY

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

currentQuery :: QueryTarget -> GettableStateVar (Maybe QueryObject)
currentQuery :: QueryTarget -> GettableStateVar (Maybe QueryObject)
currentQuery = forall a.
(GLint -> a) -> GetQueryPName -> QueryTarget -> GettableStateVar a
getQueryi (QueryObject -> Maybe QueryObject
toMaybeQueryObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. GLint -> QueryObject
toQueryObject) GetQueryPName
CurrentQuery
   where toQueryObject :: GLint -> QueryObject
toQueryObject = GLuint -> QueryObject
QueryObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
         toMaybeQueryObject :: QueryObject -> Maybe QueryObject
toMaybeQueryObject QueryObject
q = if QueryObject
q forall a. Eq a => a -> a -> Bool
== QueryObject
noQueryObject then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just QueryObject
q

queryCounterBits :: QueryTarget -> GettableStateVar GLsizei
queryCounterBits :: QueryTarget -> GettableStateVar GLint
queryCounterBits = forall a.
(GLint -> a) -> GetQueryPName -> QueryTarget -> GettableStateVar a
getQueryi forall a b. (Integral a, Num b) => a -> b
fromIntegral GetQueryPName
QueryCounterBits

getQueryi :: (GLint -> a) -> GetQueryPName -> QueryTarget -> GettableStateVar a
getQueryi :: forall a.
(GLint -> a) -> GetQueryPName -> QueryTarget -> GettableStateVar a
getQueryi GLint -> a
f GetQueryPName
p QueryTarget
t =
   forall a. IO a -> IO a
makeGettableStateVar forall a b. (a -> b) -> a -> b
$
      forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with GLint
0 forall a b. (a -> b) -> a -> b
$ \Ptr GLint
buf -> do
         QueryTarget -> GetQueryPName -> Ptr GLint -> IO ()
getQueryiv' QueryTarget
t GetQueryPName
p Ptr GLint
buf
         forall a b. Storable a => (a -> b) -> Ptr a -> IO b
peek1 GLint -> a
f Ptr GLint
buf

getQueryiv' :: QueryTarget -> GetQueryPName -> Ptr GLint -> IO ()
getQueryiv' :: QueryTarget -> GetQueryPName -> Ptr GLint -> IO ()
getQueryiv' QueryTarget
target = case QueryTarget -> (GLuint, GLuint)
marshalQueryTarget QueryTarget
target of
   (GLuint
t, GLuint
0) -> forall (m :: * -> *).
MonadIO m =>
GLuint -> GLuint -> Ptr GLint -> m ()
glGetQueryiv GLuint
t forall b c a. (b -> c) -> (a -> b) -> a -> c
. GetQueryPName -> GLuint
marshalGetQueryPName
   (GLuint
t, GLuint
n) -> forall (m :: * -> *).
MonadIO m =>
GLuint -> GLuint -> GLuint -> Ptr GLint -> m ()
glGetQueryIndexediv GLuint
t GLuint
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. GetQueryPName -> GLuint
marshalGetQueryPName

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

data GetQueryObjectPName =
     QueryResultAvailable
   | QueryResult

marshalGetQueryObjectPName :: GetQueryObjectPName -> GLenum
marshalGetQueryObjectPName :: GetQueryObjectPName -> GLuint
marshalGetQueryObjectPName GetQueryObjectPName
x = case GetQueryObjectPName
x of
   GetQueryObjectPName
QueryResultAvailable -> GLuint
GL_QUERY_RESULT_AVAILABLE
   GetQueryObjectPName
QueryResult -> GLuint
GL_QUERY_RESULT

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

queryResultAvailable :: QueryObject -> GettableStateVar Bool
queryResultAvailable :: QueryObject -> GettableStateVar Bool
queryResultAvailable =
   forall a b.
QueryResult a =>
(a -> b)
-> GetQueryObjectPName -> QueryObject -> GettableStateVar b
getQueryObject (forall a. (Eq a, Num a) => a -> Bool
unmarshalGLboolean :: GLuint -> Bool) GetQueryObjectPName
QueryResultAvailable

queryResult :: QueryResult a => QueryObject -> GettableStateVar a
queryResult :: forall a. QueryResult a => QueryObject -> GettableStateVar a
queryResult = forall a b.
QueryResult a =>
(a -> b)
-> GetQueryObjectPName -> QueryObject -> GettableStateVar b
getQueryObject forall a. a -> a
id GetQueryObjectPName
QueryResult

class Storable a => QueryResult a where
   getQueryObjectv :: GLuint -> GLenum -> Ptr a -> IO ()

instance QueryResult GLint where getQueryObjectv :: GLuint -> GLuint -> Ptr GLint -> IO ()
getQueryObjectv = forall (m :: * -> *).
MonadIO m =>
GLuint -> GLuint -> Ptr GLint -> m ()
glGetQueryObjectiv
instance QueryResult GLuint where getQueryObjectv :: GLuint -> GLuint -> Ptr GLuint -> IO ()
getQueryObjectv = forall (m :: * -> *).
MonadIO m =>
GLuint -> GLuint -> Ptr GLuint -> m ()
glGetQueryObjectuiv
instance QueryResult GLint64 where getQueryObjectv :: GLuint -> GLuint -> Ptr GLint64 -> IO ()
getQueryObjectv = forall (m :: * -> *).
MonadIO m =>
GLuint -> GLuint -> Ptr GLint64 -> m ()
glGetQueryObjecti64v
instance QueryResult GLuint64 where getQueryObjectv :: GLuint -> GLuint -> Ptr GLuint64 -> IO ()
getQueryObjectv = forall (m :: * -> *).
MonadIO m =>
GLuint -> GLuint -> Ptr GLuint64 -> m ()
glGetQueryObjectui64v

getQueryObject :: (QueryResult a)
               => (a -> b)
               -> GetQueryObjectPName
               -> QueryObject
               -> GettableStateVar b
getQueryObject :: forall a b.
QueryResult a =>
(a -> b)
-> GetQueryObjectPName -> QueryObject -> GettableStateVar b
getQueryObject a -> b
f GetQueryObjectPName
p QueryObject
q =
   forall a. IO a -> IO a
makeGettableStateVar forall a b. (a -> b) -> a -> b
$
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr a
buf -> do
         forall a. QueryResult a => GLuint -> GLuint -> Ptr a -> IO ()
getQueryObjectv (QueryObject -> GLuint
queryID QueryObject
q) (GetQueryObjectPName -> GLuint
marshalGetQueryObjectPName GetQueryObjectPName
p) Ptr a
buf
         forall a b. Storable a => (a -> b) -> Ptr a -> IO b
peek1 a -> b
f Ptr a
buf

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

-- | Record the time after all previous commands on the GL client and server
-- state and the framebuffer have been fully realized

timestampQuery :: QueryObject -> IO ()
timestampQuery :: QueryObject -> IO ()
timestampQuery QueryObject
q = forall (m :: * -> *). MonadIO m => GLuint -> GLuint -> m ()
glQueryCounter (QueryObject -> GLuint
queryID QueryObject
q) GLuint
GL_TIMESTAMP

-- | Contains the GL time after all previous commands have reached the GL server
-- but have not yet necessarily executed.

timestamp :: GettableStateVar GLuint64
timestamp :: GettableStateVar GLuint64
timestamp = forall a. IO a -> IO a
makeGettableStateVar (forall p a. GetPName1I p => (GLint64 -> a) -> p -> IO a
getInteger64 forall a b. (Integral a, Num b) => a -> b
fromIntegral PName1I
GetTimestamp)