-----------------------------------------------------------------------------
-- |
-- Module      :  Graphics.Rendering.OpenGL.GL.Shaders.ShaderObjects
-- Copyright   :  (c) Sven Panne 2006-2019
-- License     :  BSD3
--
-- Maintainer  :  Sven Panne <svenpanne@gmail.com>
-- Stability   :  stable
-- Portability :  portable
--
-- This module corresponds to section 7.1 (Shader Objects) and 7.13 (Shader,
-- Program, and Program Pipeline Queries) of the OpenGL 4.4 spec.
--
-----------------------------------------------------------------------------

module Graphics.Rendering.OpenGL.GL.Shaders.ShaderObjects (
   -- * Shader Objects
   shaderCompiler,
   ShaderType(..), Shader, createShader,
   shaderSourceBS, shaderSource, compileShader, releaseShaderCompiler,

   -- * Shader Queries
   shaderType, shaderDeleteStatus, compileStatus, shaderInfoLog,
   PrecisionType, shaderPrecisionFormat,

   -- * Bytestring utilities
   packUtf8, unpackUtf8
) where

import Control.Monad
import Data.StateVar
import Foreign.Marshal.Alloc
import Foreign.Marshal.Array
import Foreign.Marshal.Utils
import Foreign.Storable
import Graphics.Rendering.OpenGL.GL.ByteString
import Graphics.Rendering.OpenGL.GL.GLboolean
import Graphics.Rendering.OpenGL.GL.PeekPoke
import Graphics.Rendering.OpenGL.GL.QueryUtils
import Graphics.Rendering.OpenGL.GL.Shaders.Shader
import Graphics.GL

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

shaderCompiler :: GettableStateVar Bool
shaderCompiler :: GettableStateVar Bool
shaderCompiler =
   GettableStateVar Bool -> GettableStateVar Bool
forall a. IO a -> IO a
makeGettableStateVar ((GLboolean -> Bool) -> PName1I -> GettableStateVar Bool
forall p a. GetPName1I p => (GLboolean -> a) -> p -> IO a
getBoolean1 GLboolean -> Bool
forall a. (Eq a, Num a) => a -> Bool
unmarshalGLboolean PName1I
GetShaderCompiler)

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

data ShaderType =
     VertexShader
   | TessControlShader
   | TessEvaluationShader
   | GeometryShader
   | FragmentShader
   | ComputeShader
   deriving ( ShaderType -> ShaderType -> Bool
(ShaderType -> ShaderType -> Bool)
-> (ShaderType -> ShaderType -> Bool) -> Eq ShaderType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ShaderType -> ShaderType -> Bool
$c/= :: ShaderType -> ShaderType -> Bool
== :: ShaderType -> ShaderType -> Bool
$c== :: ShaderType -> ShaderType -> Bool
Eq, Eq ShaderType
Eq ShaderType =>
(ShaderType -> ShaderType -> Ordering)
-> (ShaderType -> ShaderType -> Bool)
-> (ShaderType -> ShaderType -> Bool)
-> (ShaderType -> ShaderType -> Bool)
-> (ShaderType -> ShaderType -> Bool)
-> (ShaderType -> ShaderType -> ShaderType)
-> (ShaderType -> ShaderType -> ShaderType)
-> Ord ShaderType
ShaderType -> ShaderType -> Bool
ShaderType -> ShaderType -> Ordering
ShaderType -> ShaderType -> ShaderType
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 :: ShaderType -> ShaderType -> ShaderType
$cmin :: ShaderType -> ShaderType -> ShaderType
max :: ShaderType -> ShaderType -> ShaderType
$cmax :: ShaderType -> ShaderType -> ShaderType
>= :: ShaderType -> ShaderType -> Bool
$c>= :: ShaderType -> ShaderType -> Bool
> :: ShaderType -> ShaderType -> Bool
$c> :: ShaderType -> ShaderType -> Bool
<= :: ShaderType -> ShaderType -> Bool
$c<= :: ShaderType -> ShaderType -> Bool
< :: ShaderType -> ShaderType -> Bool
$c< :: ShaderType -> ShaderType -> Bool
compare :: ShaderType -> ShaderType -> Ordering
$ccompare :: ShaderType -> ShaderType -> Ordering
$cp1Ord :: Eq ShaderType
Ord, Int -> ShaderType -> ShowS
[ShaderType] -> ShowS
ShaderType -> String
(Int -> ShaderType -> ShowS)
-> (ShaderType -> String)
-> ([ShaderType] -> ShowS)
-> Show ShaderType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ShaderType] -> ShowS
$cshowList :: [ShaderType] -> ShowS
show :: ShaderType -> String
$cshow :: ShaderType -> String
showsPrec :: Int -> ShaderType -> ShowS
$cshowsPrec :: Int -> ShaderType -> ShowS
Show )

marshalShaderType :: ShaderType -> GLenum
marshalShaderType :: ShaderType -> GLenum
marshalShaderType x :: ShaderType
x = case ShaderType
x of
   VertexShader -> GLenum
GL_VERTEX_SHADER
   TessControlShader -> GLenum
GL_TESS_CONTROL_SHADER
   TessEvaluationShader -> GLenum
GL_TESS_EVALUATION_SHADER
   GeometryShader -> GLenum
GL_GEOMETRY_SHADER
   FragmentShader -> GLenum
GL_FRAGMENT_SHADER
   ComputeShader -> GLenum
GL_COMPUTE_SHADER

unmarshalShaderType :: GLenum -> ShaderType
unmarshalShaderType :: GLenum -> ShaderType
unmarshalShaderType x :: GLenum
x
   | GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_VERTEX_SHADER = ShaderType
VertexShader
   | GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_TESS_CONTROL_SHADER = ShaderType
TessControlShader
   | GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_TESS_EVALUATION_SHADER = ShaderType
TessEvaluationShader
   | GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_GEOMETRY_SHADER = ShaderType
GeometryShader
   | GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_FRAGMENT_SHADER = ShaderType
FragmentShader
   | GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_COMPUTE_SHADER = ShaderType
ComputeShader
   | Bool
otherwise = String -> ShaderType
forall a. HasCallStack => String -> a
error ("unmarshalShaderType: illegal value " String -> ShowS
forall a. [a] -> [a] -> [a]
++ GLenum -> String
forall a. Show a => a -> String
show GLenum
x)

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

createShader :: ShaderType -> IO Shader
createShader :: ShaderType -> IO Shader
createShader = (GLenum -> Shader) -> IO GLenum -> IO Shader
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GLenum -> Shader
Shader (IO GLenum -> IO Shader)
-> (ShaderType -> IO GLenum) -> ShaderType -> IO Shader
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GLenum -> IO GLenum
forall (m :: * -> *). MonadIO m => GLenum -> m GLenum
glCreateShader (GLenum -> IO GLenum)
-> (ShaderType -> GLenum) -> ShaderType -> IO GLenum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShaderType -> GLenum
marshalShaderType

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

-- | UTF8 encoded.
shaderSourceBS :: Shader -> StateVar ByteString
shaderSourceBS :: Shader -> StateVar ByteString
shaderSourceBS shader :: Shader
shader =
   IO ByteString -> (ByteString -> IO ()) -> StateVar ByteString
forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar (Shader -> IO ByteString
getShaderSource Shader
shader) (Shader -> ByteString -> IO ()
setShaderSource Shader
shader)

getShaderSource :: Shader -> IO ByteString
getShaderSource :: Shader -> IO ByteString
getShaderSource = (Shader -> GettableStateVar GLsizei)
-> (Shader -> GLsizei -> Ptr GLsizei -> Ptr GLchar -> IO ())
-> Shader
-> IO ByteString
forall a.
(a -> GettableStateVar GLsizei)
-> (a -> GLsizei -> Ptr GLsizei -> Ptr GLchar -> IO ())
-> a
-> IO ByteString
stringQuery Shader -> GettableStateVar GLsizei
shaderSourceLength (GLenum -> GLsizei -> Ptr GLsizei -> Ptr GLchar -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLsizei -> Ptr GLsizei -> Ptr GLchar -> m ()
glGetShaderSource (GLenum -> GLsizei -> Ptr GLsizei -> Ptr GLchar -> IO ())
-> (Shader -> GLenum)
-> Shader
-> GLsizei
-> Ptr GLsizei
-> Ptr GLchar
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Shader -> GLenum
shaderID)

shaderSourceLength :: Shader -> GettableStateVar GLsizei
shaderSourceLength :: Shader -> GettableStateVar GLsizei
shaderSourceLength = (GLsizei -> GLsizei)
-> GetShaderPName -> Shader -> GettableStateVar GLsizei
forall a.
(GLsizei -> a) -> GetShaderPName -> Shader -> GettableStateVar a
shaderVar GLsizei -> GLsizei
forall a b. (Integral a, Num b) => a -> b
fromIntegral GetShaderPName
ShaderSourceLength

setShaderSource :: Shader -> ByteString -> IO ()
setShaderSource :: Shader -> ByteString -> IO ()
setShaderSource shader :: Shader
shader src :: ByteString
src =
   ByteString -> (Ptr GLchar -> GLsizei -> IO ()) -> IO ()
forall b. ByteString -> (Ptr GLchar -> GLsizei -> IO b) -> IO b
withByteString ByteString
src ((Ptr GLchar -> GLsizei -> IO ()) -> IO ())
-> (Ptr GLchar -> GLsizei -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \srcPtr :: Ptr GLchar
srcPtr srcLength :: GLsizei
srcLength ->
      Ptr GLchar -> (Ptr (Ptr GLchar) -> IO ()) -> IO ()
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Ptr GLchar
srcPtr ((Ptr (Ptr GLchar) -> IO ()) -> IO ())
-> (Ptr (Ptr GLchar) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \srcPtrBuf :: Ptr (Ptr GLchar)
srcPtrBuf ->
         GLsizei -> (Ptr GLsizei -> IO ()) -> IO ()
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with GLsizei
srcLength ((Ptr GLsizei -> IO ()) -> IO ())
-> (Ptr GLsizei -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \srcLengthBuf :: Ptr GLsizei
srcLengthBuf ->
            GLenum -> GLsizei -> Ptr (Ptr GLchar) -> Ptr GLsizei -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLsizei -> Ptr (Ptr GLchar) -> Ptr GLsizei -> m ()
glShaderSource (Shader -> GLenum
shaderID Shader
shader) 1 Ptr (Ptr GLchar)
srcPtrBuf Ptr GLsizei
srcLengthBuf

{-# DEPRECATED shaderSource "Use a combination of 'shaderSourceBS' and 'packUtf8' or 'unpackUtf8' instead." #-}
shaderSource :: Shader -> StateVar [String]
shaderSource :: Shader -> StateVar [String]
shaderSource shader :: Shader
shader =
   IO [String] -> ([String] -> IO ()) -> StateVar [String]
forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar
     ((ByteString -> [String]) -> IO ByteString -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[]) (String -> [String])
-> (ByteString -> String) -> ByteString -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
unpackUtf8) (IO ByteString -> IO [String]) -> IO ByteString -> IO [String]
forall a b. (a -> b) -> a -> b
$ StateVar ByteString -> IO ByteString
forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
get (Shader -> StateVar ByteString
shaderSourceBS Shader
shader))
     ((Shader -> StateVar ByteString
shaderSourceBS Shader
shader StateVar ByteString -> ByteString -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$=) (ByteString -> IO ())
-> ([String] -> ByteString) -> [String] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
packUtf8 (String -> ByteString)
-> ([String] -> String) -> [String] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat)

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

compileShader :: Shader -> IO ()
compileShader :: Shader -> IO ()
compileShader = GLenum -> IO ()
forall (m :: * -> *). MonadIO m => GLenum -> m ()
glCompileShader (GLenum -> IO ()) -> (Shader -> GLenum) -> Shader -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Shader -> GLenum
shaderID

releaseShaderCompiler :: IO ()
releaseShaderCompiler :: IO ()
releaseShaderCompiler = IO ()
forall (m :: * -> *). MonadIO m => m ()
glReleaseShaderCompiler

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

shaderType :: Shader -> GettableStateVar ShaderType
shaderType :: Shader -> GettableStateVar ShaderType
shaderType = (GLsizei -> ShaderType)
-> GetShaderPName -> Shader -> GettableStateVar ShaderType
forall a.
(GLsizei -> a) -> GetShaderPName -> Shader -> GettableStateVar a
shaderVar (GLenum -> ShaderType
unmarshalShaderType (GLenum -> ShaderType)
-> (GLsizei -> GLenum) -> GLsizei -> ShaderType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GLsizei -> GLenum
forall a b. (Integral a, Num b) => a -> b
fromIntegral) GetShaderPName
ShaderType

shaderDeleteStatus :: Shader -> GettableStateVar Bool
shaderDeleteStatus :: Shader -> GettableStateVar Bool
shaderDeleteStatus = (GLsizei -> Bool)
-> GetShaderPName -> Shader -> GettableStateVar Bool
forall a.
(GLsizei -> a) -> GetShaderPName -> Shader -> GettableStateVar a
shaderVar GLsizei -> Bool
forall a. (Eq a, Num a) => a -> Bool
unmarshalGLboolean GetShaderPName
ShaderDeleteStatus

compileStatus :: Shader -> GettableStateVar Bool
compileStatus :: Shader -> GettableStateVar Bool
compileStatus = (GLsizei -> Bool)
-> GetShaderPName -> Shader -> GettableStateVar Bool
forall a.
(GLsizei -> a) -> GetShaderPName -> Shader -> GettableStateVar a
shaderVar GLsizei -> Bool
forall a. (Eq a, Num a) => a -> Bool
unmarshalGLboolean GetShaderPName
CompileStatus

shaderInfoLog :: Shader -> GettableStateVar String
shaderInfoLog :: Shader -> GettableStateVar String
shaderInfoLog =
   GettableStateVar String -> GettableStateVar String
forall a. IO a -> IO a
makeGettableStateVar (GettableStateVar String -> GettableStateVar String)
-> (Shader -> GettableStateVar String)
-> Shader
-> GettableStateVar String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      (ByteString -> String) -> IO ByteString -> GettableStateVar String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> String
unpackUtf8 (IO ByteString -> GettableStateVar String)
-> (Shader -> IO ByteString) -> Shader -> GettableStateVar String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
         (Shader -> GettableStateVar GLsizei)
-> (Shader -> GLsizei -> Ptr GLsizei -> Ptr GLchar -> IO ())
-> Shader
-> IO ByteString
forall a.
(a -> GettableStateVar GLsizei)
-> (a -> GLsizei -> Ptr GLsizei -> Ptr GLchar -> IO ())
-> a
-> IO ByteString
stringQuery Shader -> GettableStateVar GLsizei
shaderInfoLogLength (GLenum -> GLsizei -> Ptr GLsizei -> Ptr GLchar -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLsizei -> Ptr GLsizei -> Ptr GLchar -> m ()
glGetShaderInfoLog (GLenum -> GLsizei -> Ptr GLsizei -> Ptr GLchar -> IO ())
-> (Shader -> GLenum)
-> Shader
-> GLsizei
-> Ptr GLsizei
-> Ptr GLchar
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Shader -> GLenum
shaderID)

shaderInfoLogLength :: Shader -> GettableStateVar GLsizei
shaderInfoLogLength :: Shader -> GettableStateVar GLsizei
shaderInfoLogLength = (GLsizei -> GLsizei)
-> GetShaderPName -> Shader -> GettableStateVar GLsizei
forall a.
(GLsizei -> a) -> GetShaderPName -> Shader -> GettableStateVar a
shaderVar GLsizei -> GLsizei
forall a b. (Integral a, Num b) => a -> b
fromIntegral GetShaderPName
ShaderInfoLogLength

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

data GetShaderPName =
     ShaderDeleteStatus
   | CompileStatus
   | ShaderInfoLogLength
   | ShaderSourceLength
   | ShaderType

marshalGetShaderPName :: GetShaderPName -> GLenum
marshalGetShaderPName :: GetShaderPName -> GLenum
marshalGetShaderPName x :: GetShaderPName
x = case GetShaderPName
x of
   ShaderDeleteStatus -> GLenum
GL_DELETE_STATUS
   CompileStatus -> GLenum
GL_COMPILE_STATUS
   ShaderInfoLogLength -> GLenum
GL_INFO_LOG_LENGTH
   ShaderSourceLength -> GLenum
GL_SHADER_SOURCE_LENGTH
   ShaderType -> GLenum
GL_SHADER_TYPE

shaderVar :: (GLint -> a) -> GetShaderPName -> Shader -> GettableStateVar a
shaderVar :: (GLsizei -> a) -> GetShaderPName -> Shader -> GettableStateVar a
shaderVar f :: GLsizei -> a
f p :: GetShaderPName
p shader :: Shader
shader =
   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
$
      GLsizei
-> (Ptr GLsizei -> GettableStateVar a) -> GettableStateVar a
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with 0 ((Ptr GLsizei -> GettableStateVar a) -> GettableStateVar a)
-> (Ptr GLsizei -> GettableStateVar a) -> GettableStateVar a
forall a b. (a -> b) -> a -> b
$ \buf :: Ptr GLsizei
buf -> do
         GLenum -> GLenum -> Ptr GLsizei -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> Ptr GLsizei -> m ()
glGetShaderiv (Shader -> GLenum
shaderID Shader
shader) (GetShaderPName -> GLenum
marshalGetShaderPName GetShaderPName
p) Ptr GLsizei
buf
         (GLsizei -> a) -> Ptr GLsizei -> GettableStateVar a
forall a b. Storable a => (a -> b) -> Ptr a -> IO b
peek1 GLsizei -> a
f Ptr GLsizei
buf

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

data PrecisionType =
     LowFloat
   | MediumFloat
   | HighFloat
   | LowInt
   | MediumInt
   | HighInt
   deriving ( PrecisionType -> PrecisionType -> Bool
(PrecisionType -> PrecisionType -> Bool)
-> (PrecisionType -> PrecisionType -> Bool) -> Eq PrecisionType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PrecisionType -> PrecisionType -> Bool
$c/= :: PrecisionType -> PrecisionType -> Bool
== :: PrecisionType -> PrecisionType -> Bool
$c== :: PrecisionType -> PrecisionType -> Bool
Eq, Eq PrecisionType
Eq PrecisionType =>
(PrecisionType -> PrecisionType -> Ordering)
-> (PrecisionType -> PrecisionType -> Bool)
-> (PrecisionType -> PrecisionType -> Bool)
-> (PrecisionType -> PrecisionType -> Bool)
-> (PrecisionType -> PrecisionType -> Bool)
-> (PrecisionType -> PrecisionType -> PrecisionType)
-> (PrecisionType -> PrecisionType -> PrecisionType)
-> Ord PrecisionType
PrecisionType -> PrecisionType -> Bool
PrecisionType -> PrecisionType -> Ordering
PrecisionType -> PrecisionType -> PrecisionType
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 :: PrecisionType -> PrecisionType -> PrecisionType
$cmin :: PrecisionType -> PrecisionType -> PrecisionType
max :: PrecisionType -> PrecisionType -> PrecisionType
$cmax :: PrecisionType -> PrecisionType -> PrecisionType
>= :: PrecisionType -> PrecisionType -> Bool
$c>= :: PrecisionType -> PrecisionType -> Bool
> :: PrecisionType -> PrecisionType -> Bool
$c> :: PrecisionType -> PrecisionType -> Bool
<= :: PrecisionType -> PrecisionType -> Bool
$c<= :: PrecisionType -> PrecisionType -> Bool
< :: PrecisionType -> PrecisionType -> Bool
$c< :: PrecisionType -> PrecisionType -> Bool
compare :: PrecisionType -> PrecisionType -> Ordering
$ccompare :: PrecisionType -> PrecisionType -> Ordering
$cp1Ord :: Eq PrecisionType
Ord, Int -> PrecisionType -> ShowS
[PrecisionType] -> ShowS
PrecisionType -> String
(Int -> PrecisionType -> ShowS)
-> (PrecisionType -> String)
-> ([PrecisionType] -> ShowS)
-> Show PrecisionType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PrecisionType] -> ShowS
$cshowList :: [PrecisionType] -> ShowS
show :: PrecisionType -> String
$cshow :: PrecisionType -> String
showsPrec :: Int -> PrecisionType -> ShowS
$cshowsPrec :: Int -> PrecisionType -> ShowS
Show )

marshalPrecisionType :: PrecisionType -> GLenum
marshalPrecisionType :: PrecisionType -> GLenum
marshalPrecisionType x :: PrecisionType
x = case PrecisionType
x of
   LowFloat -> GLenum
GL_LOW_FLOAT
   MediumFloat -> GLenum
GL_MEDIUM_FLOAT
   HighFloat -> GLenum
GL_HIGH_FLOAT
   LowInt -> GLenum
GL_LOW_INT
   MediumInt -> GLenum
GL_MEDIUM_INT
   HighInt -> GLenum
GL_HIGH_INT

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

shaderPrecisionFormat :: ShaderType
                      -> PrecisionType
                      -> GettableStateVar ((GLint,GLint),GLint)
shaderPrecisionFormat :: ShaderType
-> PrecisionType -> GettableStateVar ((GLsizei, GLsizei), GLsizei)
shaderPrecisionFormat st :: ShaderType
st pt :: PrecisionType
pt =
   GettableStateVar ((GLsizei, GLsizei), GLsizei)
-> GettableStateVar ((GLsizei, GLsizei), GLsizei)
forall a. IO a -> IO a
makeGettableStateVar (GettableStateVar ((GLsizei, GLsizei), GLsizei)
 -> GettableStateVar ((GLsizei, GLsizei), GLsizei))
-> GettableStateVar ((GLsizei, GLsizei), GLsizei)
-> GettableStateVar ((GLsizei, GLsizei), GLsizei)
forall a b. (a -> b) -> a -> b
$
      Int
-> (Ptr GLsizei -> GettableStateVar ((GLsizei, GLsizei), GLsizei))
-> GettableStateVar ((GLsizei, GLsizei), GLsizei)
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray 2 ((Ptr GLsizei -> GettableStateVar ((GLsizei, GLsizei), GLsizei))
 -> GettableStateVar ((GLsizei, GLsizei), GLsizei))
-> (Ptr GLsizei -> GettableStateVar ((GLsizei, GLsizei), GLsizei))
-> GettableStateVar ((GLsizei, GLsizei), GLsizei)
forall a b. (a -> b) -> a -> b
$ \rangeBuf :: Ptr GLsizei
rangeBuf ->
         (Ptr GLsizei -> GettableStateVar ((GLsizei, GLsizei), GLsizei))
-> GettableStateVar ((GLsizei, GLsizei), GLsizei)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr GLsizei -> GettableStateVar ((GLsizei, GLsizei), GLsizei))
 -> GettableStateVar ((GLsizei, GLsizei), GLsizei))
-> (Ptr GLsizei -> GettableStateVar ((GLsizei, GLsizei), GLsizei))
-> GettableStateVar ((GLsizei, GLsizei), GLsizei)
forall a b. (a -> b) -> a -> b
$ \precisionBuf :: Ptr GLsizei
precisionBuf -> do
            GLenum -> GLenum -> Ptr GLsizei -> Ptr GLsizei -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> Ptr GLsizei -> Ptr GLsizei -> m ()
glGetShaderPrecisionFormat (ShaderType -> GLenum
marshalShaderType ShaderType
st)
                                       (PrecisionType -> GLenum
marshalPrecisionType PrecisionType
pt)
                                       Ptr GLsizei
rangeBuf
                                       Ptr GLsizei
precisionBuf
            ((GLsizei, GLsizei) -> GLsizei -> ((GLsizei, GLsizei), GLsizei))
-> IO (GLsizei, GLsizei)
-> GettableStateVar GLsizei
-> GettableStateVar ((GLsizei, GLsizei), GLsizei)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) ((GLsizei -> GLsizei -> (GLsizei, GLsizei))
-> Ptr GLsizei -> IO (GLsizei, GLsizei)
forall a b. Storable a => (a -> a -> b) -> Ptr a -> IO b
peek2 (,) Ptr GLsizei
rangeBuf) (Ptr GLsizei -> GettableStateVar GLsizei
forall a. Storable a => Ptr a -> IO a
peek Ptr GLsizei
precisionBuf)