-----------------------------------------------------------------------------
-- |
-- 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 =
   GettableStateVar GLuint -> GettableStateVar GLuint
forall a. IO a -> IO a
makeGettableStateVar ((GLint -> GLuint) -> PName1I -> GettableStateVar GLuint
forall p a. GetPName1I p => (GLint -> a) -> p -> IO a
forall a. (GLint -> a) -> PName1I -> IO a
getInteger1 GLint -> GLuint
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
(QueryTarget -> QueryTarget -> Bool)
-> (QueryTarget -> QueryTarget -> Bool) -> Eq QueryTarget
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: QueryTarget -> QueryTarget -> Bool
== :: QueryTarget -> QueryTarget -> Bool
$c/= :: QueryTarget -> QueryTarget -> Bool
/= :: QueryTarget -> QueryTarget -> Bool
Eq, Eq QueryTarget
Eq QueryTarget =>
(QueryTarget -> QueryTarget -> Ordering)
-> (QueryTarget -> QueryTarget -> Bool)
-> (QueryTarget -> QueryTarget -> Bool)
-> (QueryTarget -> QueryTarget -> Bool)
-> (QueryTarget -> QueryTarget -> Bool)
-> (QueryTarget -> QueryTarget -> QueryTarget)
-> (QueryTarget -> QueryTarget -> QueryTarget)
-> Ord 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
$ccompare :: QueryTarget -> QueryTarget -> Ordering
compare :: QueryTarget -> QueryTarget -> Ordering
$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
>= :: QueryTarget -> QueryTarget -> Bool
$cmax :: QueryTarget -> QueryTarget -> QueryTarget
max :: QueryTarget -> QueryTarget -> QueryTarget
$cmin :: QueryTarget -> QueryTarget -> QueryTarget
min :: QueryTarget -> QueryTarget -> QueryTarget
Ord, Int -> QueryTarget -> ShowS
[QueryTarget] -> ShowS
QueryTarget -> String
(Int -> QueryTarget -> ShowS)
-> (QueryTarget -> String)
-> ([QueryTarget] -> ShowS)
-> Show QueryTarget
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> QueryTarget -> ShowS
showsPrec :: Int -> QueryTarget -> ShowS
$cshow :: QueryTarget -> String
show :: QueryTarget -> String
$cshowList :: [QueryTarget] -> ShowS
showList :: [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) -> GLuint -> GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLuint -> GLuint -> m ()
glBeginQuery GLuint
t (GLuint -> IO ())
-> (QueryObject -> GLuint) -> QueryObject -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QueryObject -> GLuint
queryID
   (GLuint
t, GLuint
n) -> GLuint -> GLuint -> GLuint -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLuint -> GLuint -> GLuint -> m ()
glBeginQueryIndexed GLuint
t GLuint
n (GLuint -> IO ())
-> (QueryObject -> GLuint) -> QueryObject -> IO ()
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) -> GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLuint -> m ()
glEndQuery GLuint
t
   (GLuint
t, GLuint
n) -> GLuint -> GLuint -> IO ()
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 = IO () -> IO () -> IO a -> IO a
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 = (GLint -> Maybe QueryObject)
-> GetQueryPName
-> QueryTarget
-> GettableStateVar (Maybe QueryObject)
forall a.
(GLint -> a) -> GetQueryPName -> QueryTarget -> GettableStateVar a
getQueryi (QueryObject -> Maybe QueryObject
toMaybeQueryObject (QueryObject -> Maybe QueryObject)
-> (GLint -> QueryObject) -> GLint -> Maybe QueryObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GLint -> QueryObject
toQueryObject) GetQueryPName
CurrentQuery
   where toQueryObject :: GLint -> QueryObject
toQueryObject = GLuint -> QueryObject
QueryObject (GLuint -> QueryObject)
-> (GLint -> GLuint) -> GLint -> QueryObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GLint -> GLuint
forall a b. (Integral a, Num b) => a -> b
fromIntegral
         toMaybeQueryObject :: QueryObject -> Maybe QueryObject
toMaybeQueryObject QueryObject
q = if QueryObject
q QueryObject -> QueryObject -> Bool
forall a. Eq a => a -> a -> Bool
== QueryObject
noQueryObject then Maybe QueryObject
forall a. Maybe a
Nothing else QueryObject -> Maybe QueryObject
forall a. a -> Maybe a
Just QueryObject
q

queryCounterBits :: QueryTarget -> GettableStateVar GLsizei
queryCounterBits :: QueryTarget -> GettableStateVar GLint
queryCounterBits = (GLint -> GLint)
-> GetQueryPName -> QueryTarget -> GettableStateVar GLint
forall a.
(GLint -> a) -> GetQueryPName -> QueryTarget -> GettableStateVar a
getQueryi GLint -> GLint
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 =
   IO a -> IO a
forall a. IO a -> IO a
makeGettableStateVar (IO a -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$
      GLint -> (Ptr GLint -> IO a) -> IO a
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with GLint
0 ((Ptr GLint -> IO a) -> IO a) -> (Ptr GLint -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr GLint
buf -> do
         QueryTarget -> GetQueryPName -> Ptr GLint -> IO ()
getQueryiv' QueryTarget
t GetQueryPName
p Ptr GLint
buf
         (GLint -> a) -> Ptr GLint -> IO a
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) -> GLuint -> GLuint -> Ptr GLint -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLuint -> GLuint -> Ptr GLint -> m ()
glGetQueryiv GLuint
t (GLuint -> Ptr GLint -> IO ())
-> (GetQueryPName -> GLuint) -> GetQueryPName -> Ptr GLint -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GetQueryPName -> GLuint
marshalGetQueryPName
   (GLuint
t, GLuint
n) -> GLuint -> GLuint -> GLuint -> Ptr GLint -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLuint -> GLuint -> GLuint -> Ptr GLint -> m ()
glGetQueryIndexediv GLuint
t GLuint
n (GLuint -> Ptr GLint -> IO ())
-> (GetQueryPName -> GLuint) -> GetQueryPName -> Ptr GLint -> IO ()
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 =
   (GLuint -> Bool)
-> GetQueryObjectPName -> QueryObject -> GettableStateVar Bool
forall a b.
QueryResult a =>
(a -> b)
-> GetQueryObjectPName -> QueryObject -> GettableStateVar b
getQueryObject (GLuint -> Bool
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 = (a -> a)
-> GetQueryObjectPName -> QueryObject -> GettableStateVar a
forall a b.
QueryResult a =>
(a -> b)
-> GetQueryObjectPName -> QueryObject -> GettableStateVar b
getQueryObject a -> a
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 = GLuint -> GLuint -> Ptr GLint -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLuint -> GLuint -> Ptr GLint -> m ()
glGetQueryObjectiv
instance QueryResult GLuint where getQueryObjectv :: GLuint -> GLuint -> Ptr GLuint -> IO ()
getQueryObjectv = GLuint -> GLuint -> Ptr GLuint -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLuint -> GLuint -> Ptr GLuint -> m ()
glGetQueryObjectuiv
instance QueryResult GLint64 where getQueryObjectv :: GLuint -> GLuint -> Ptr GLint64 -> IO ()
getQueryObjectv = GLuint -> GLuint -> Ptr GLint64 -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLuint -> GLuint -> Ptr GLint64 -> m ()
glGetQueryObjecti64v
instance QueryResult GLuint64 where getQueryObjectv :: GLuint -> GLuint -> Ptr GLuint64 -> IO ()
getQueryObjectv = GLuint -> GLuint -> Ptr GLuint64 -> IO ()
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 =
   IO b -> IO b
forall a. IO a -> IO a
makeGettableStateVar (IO b -> IO b) -> IO b -> IO b
forall a b. (a -> b) -> a -> b
$
      (Ptr a -> IO b) -> IO b
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr a -> IO b) -> IO b) -> (Ptr a -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr a
buf -> do
         GLuint -> GLuint -> Ptr a -> IO ()
forall a. QueryResult a => GLuint -> GLuint -> Ptr a -> IO ()
getQueryObjectv (QueryObject -> GLuint
queryID QueryObject
q) (GetQueryObjectPName -> GLuint
marshalGetQueryObjectPName GetQueryObjectPName
p) Ptr a
buf
         (a -> b) -> Ptr a -> IO b
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 = GLuint -> GLuint -> IO ()
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 = GettableStateVar GLuint64 -> GettableStateVar GLuint64
forall a. IO a -> IO a
makeGettableStateVar ((GLint64 -> GLuint64) -> PName1I -> GettableStateVar GLuint64
forall p a. GetPName1I p => (GLint64 -> a) -> p -> IO a
forall a. (GLint64 -> a) -> PName1I -> IO a
getInteger64 GLint64 -> GLuint64
forall a b. (Integral a, Num b) => a -> b
fromIntegral PName1I
GetTimestamp)