-----------------------------------------------------------------------------
-- |
-- 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 QueryIndex
maxVertexStreams =
   GettableStateVar QueryIndex -> GettableStateVar QueryIndex
forall a. IO a -> IO a
makeGettableStateVar ((GLint -> QueryIndex) -> PName1I -> GettableStateVar QueryIndex
forall p a. GetPName1I p => (GLint -> a) -> p -> IO a
getInteger1 GLint -> QueryIndex
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
/= :: QueryTarget -> QueryTarget -> Bool
$c/= :: QueryTarget -> QueryTarget -> Bool
== :: QueryTarget -> QueryTarget -> Bool
$c== :: 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
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
$cp1Ord :: Eq 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
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 -> (QueryIndex, QueryIndex)
marshalQueryTarget QueryTarget
x = case QueryTarget
x of
   QueryTarget
SamplesPassed -> (QueryIndex
GL_SAMPLES_PASSED, QueryIndex
0)
   QueryTarget
AnySamplesPassed -> (QueryIndex
GL_ANY_SAMPLES_PASSED, QueryIndex
0)
   QueryTarget
AnySamplesPassedConservative -> (QueryIndex
GL_ANY_SAMPLES_PASSED_CONSERVATIVE, QueryIndex
0)
   QueryTarget
TimeElapsed -> (QueryIndex
GL_TIME_ELAPSED, QueryIndex
0)
   PrimitivesGenerated QueryIndex
n -> (QueryIndex
GL_PRIMITIVES_GENERATED, QueryIndex
n)
   TransformFeedbackPrimitivesWritten QueryIndex
n ->
      (QueryIndex
GL_TRANSFORM_FEEDBACK_PRIMITIVES_WRITTEN, QueryIndex
n)

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

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

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

-- | Convenience function for an exception-safe combination of 'beginQuery' and
-- 'endQuery'.
withQuery :: QueryTarget -> QueryObject -> IO a -> IO a
withQuery :: 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 -> QueryIndex
marshalGetQueryPName GetQueryPName
x = case GetQueryPName
x of
   GetQueryPName
QueryCounterBits -> QueryIndex
GL_QUERY_COUNTER_BITS
   GetQueryPName
CurrentQuery -> QueryIndex
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 = QueryIndex -> QueryObject
QueryObject (QueryIndex -> QueryObject)
-> (GLint -> QueryIndex) -> GLint -> QueryObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GLint -> QueryIndex
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 :: (GLint -> a) -> GetQueryPName -> QueryTarget -> GettableStateVar a
getQueryi GLint -> a
f GetQueryPName
p QueryTarget
t =
   GettableStateVar a -> GettableStateVar a
forall a. IO a -> IO a
makeGettableStateVar (GettableStateVar a -> GettableStateVar a)
-> GettableStateVar a -> GettableStateVar a
forall a b. (a -> b) -> a -> b
$
      GLint -> (Ptr GLint -> GettableStateVar a) -> GettableStateVar a
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with GLint
0 ((Ptr GLint -> GettableStateVar a) -> GettableStateVar a)
-> (Ptr GLint -> GettableStateVar a) -> GettableStateVar 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 -> GettableStateVar 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 -> (QueryIndex, QueryIndex)
marshalQueryTarget QueryTarget
target of
   (QueryIndex
t, QueryIndex
0) -> QueryIndex -> QueryIndex -> Ptr GLint -> IO ()
forall (m :: * -> *).
MonadIO m =>
QueryIndex -> QueryIndex -> Ptr GLint -> m ()
glGetQueryiv QueryIndex
t (QueryIndex -> Ptr GLint -> IO ())
-> (GetQueryPName -> QueryIndex)
-> GetQueryPName
-> Ptr GLint
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GetQueryPName -> QueryIndex
marshalGetQueryPName
   (QueryIndex
t, QueryIndex
n) -> QueryIndex -> QueryIndex -> QueryIndex -> Ptr GLint -> IO ()
forall (m :: * -> *).
MonadIO m =>
QueryIndex -> QueryIndex -> QueryIndex -> Ptr GLint -> m ()
glGetQueryIndexediv QueryIndex
t QueryIndex
n (QueryIndex -> Ptr GLint -> IO ())
-> (GetQueryPName -> QueryIndex)
-> GetQueryPName
-> Ptr GLint
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GetQueryPName -> QueryIndex
marshalGetQueryPName

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

data GetQueryObjectPName =
     QueryResultAvailable
   | QueryResult

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

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

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

queryResult :: QueryResult a => QueryObject -> GettableStateVar a
queryResult :: 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 :: QueryIndex -> QueryIndex -> Ptr GLint -> IO ()
getQueryObjectv = QueryIndex -> QueryIndex -> Ptr GLint -> IO ()
forall (m :: * -> *).
MonadIO m =>
QueryIndex -> QueryIndex -> Ptr GLint -> m ()
glGetQueryObjectiv
instance QueryResult GLuint where getQueryObjectv :: QueryIndex -> QueryIndex -> Ptr QueryIndex -> IO ()
getQueryObjectv = QueryIndex -> QueryIndex -> Ptr QueryIndex -> IO ()
forall (m :: * -> *).
MonadIO m =>
QueryIndex -> QueryIndex -> Ptr QueryIndex -> m ()
glGetQueryObjectuiv
instance QueryResult GLint64 where getQueryObjectv :: QueryIndex -> QueryIndex -> Ptr GLint64 -> IO ()
getQueryObjectv = QueryIndex -> QueryIndex -> Ptr GLint64 -> IO ()
forall (m :: * -> *).
MonadIO m =>
QueryIndex -> QueryIndex -> Ptr GLint64 -> m ()
glGetQueryObjecti64v
instance QueryResult GLuint64 where getQueryObjectv :: QueryIndex -> QueryIndex -> Ptr GLuint64 -> IO ()
getQueryObjectv = QueryIndex -> QueryIndex -> Ptr GLuint64 -> IO ()
forall (m :: * -> *).
MonadIO m =>
QueryIndex -> QueryIndex -> Ptr GLuint64 -> m ()
glGetQueryObjectui64v

getQueryObject :: (QueryResult a)
               => (a -> b)
               -> GetQueryObjectPName
               -> QueryObject
               -> GettableStateVar b
getQueryObject :: (a -> b)
-> GetQueryObjectPName -> QueryObject -> GettableStateVar b
getQueryObject a -> b
f GetQueryObjectPName
p QueryObject
q =
   GettableStateVar b -> GettableStateVar b
forall a. IO a -> IO a
makeGettableStateVar (GettableStateVar b -> GettableStateVar b)
-> GettableStateVar b -> GettableStateVar b
forall a b. (a -> b) -> a -> b
$
      (Ptr a -> GettableStateVar b) -> GettableStateVar b
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr a -> GettableStateVar b) -> GettableStateVar b)
-> (Ptr a -> GettableStateVar b) -> GettableStateVar b
forall a b. (a -> b) -> a -> b
$ \Ptr a
buf -> do
         QueryIndex -> QueryIndex -> Ptr a -> IO ()
forall a.
QueryResult a =>
QueryIndex -> QueryIndex -> Ptr a -> IO ()
getQueryObjectv (QueryObject -> QueryIndex
queryID QueryObject
q) (GetQueryObjectPName -> QueryIndex
marshalGetQueryObjectPName GetQueryObjectPName
p) Ptr a
buf
         (a -> b) -> Ptr a -> GettableStateVar 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 = QueryIndex -> QueryIndex -> IO ()
forall (m :: * -> *). MonadIO m => QueryIndex -> QueryIndex -> m ()
glQueryCounter (QueryObject -> QueryIndex
queryID QueryObject
q) QueryIndex
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
getInteger64 GLint64 -> GLuint64
forall a b. (Integral a, Num b) => a -> b
fromIntegral PName1I
GetTimestamp)