-----------------------------------------------------------------------------
-- |
-- Module      :  Graphics.Rendering.OpenGL.GL.Shaders.ShaderBinaries
-- Copyright   :  (c) Sven Panne 2006-2019
-- License     :  BSD3
--
-- Maintainer  :  Sven Panne <svenpanne@gmail.com>
-- Stability   :  stable
-- Portability :  portable
--
-- This module corresponds to section 7.2 (Shader Binaries) of the OpenGL 4.4
-- spec.
--
-----------------------------------------------------------------------------

module Graphics.Rendering.OpenGL.GL.Shaders.ShaderBinaries (
   ShaderBinaryFormat(..), shaderBinaryFormats,
   ShaderBinary(..), shaderBinary,
) where

import Data.StateVar
import Foreign.Marshal.Array
import Graphics.Rendering.OpenGL.GL.ByteString
import Graphics.Rendering.OpenGL.GL.QueryUtils
import Graphics.Rendering.OpenGL.GL.Shaders.Shader
import Graphics.GL

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

newtype ShaderBinaryFormat = ShaderBinaryFormat GLenum
   deriving ( ShaderBinaryFormat -> ShaderBinaryFormat -> Bool
(ShaderBinaryFormat -> ShaderBinaryFormat -> Bool)
-> (ShaderBinaryFormat -> ShaderBinaryFormat -> Bool)
-> Eq ShaderBinaryFormat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ShaderBinaryFormat -> ShaderBinaryFormat -> Bool
== :: ShaderBinaryFormat -> ShaderBinaryFormat -> Bool
$c/= :: ShaderBinaryFormat -> ShaderBinaryFormat -> Bool
/= :: ShaderBinaryFormat -> ShaderBinaryFormat -> Bool
Eq, Eq ShaderBinaryFormat
Eq ShaderBinaryFormat =>
(ShaderBinaryFormat -> ShaderBinaryFormat -> Ordering)
-> (ShaderBinaryFormat -> ShaderBinaryFormat -> Bool)
-> (ShaderBinaryFormat -> ShaderBinaryFormat -> Bool)
-> (ShaderBinaryFormat -> ShaderBinaryFormat -> Bool)
-> (ShaderBinaryFormat -> ShaderBinaryFormat -> Bool)
-> (ShaderBinaryFormat -> ShaderBinaryFormat -> ShaderBinaryFormat)
-> (ShaderBinaryFormat -> ShaderBinaryFormat -> ShaderBinaryFormat)
-> Ord ShaderBinaryFormat
ShaderBinaryFormat -> ShaderBinaryFormat -> Bool
ShaderBinaryFormat -> ShaderBinaryFormat -> Ordering
ShaderBinaryFormat -> ShaderBinaryFormat -> ShaderBinaryFormat
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 :: ShaderBinaryFormat -> ShaderBinaryFormat -> Ordering
compare :: ShaderBinaryFormat -> ShaderBinaryFormat -> Ordering
$c< :: ShaderBinaryFormat -> ShaderBinaryFormat -> Bool
< :: ShaderBinaryFormat -> ShaderBinaryFormat -> Bool
$c<= :: ShaderBinaryFormat -> ShaderBinaryFormat -> Bool
<= :: ShaderBinaryFormat -> ShaderBinaryFormat -> Bool
$c> :: ShaderBinaryFormat -> ShaderBinaryFormat -> Bool
> :: ShaderBinaryFormat -> ShaderBinaryFormat -> Bool
$c>= :: ShaderBinaryFormat -> ShaderBinaryFormat -> Bool
>= :: ShaderBinaryFormat -> ShaderBinaryFormat -> Bool
$cmax :: ShaderBinaryFormat -> ShaderBinaryFormat -> ShaderBinaryFormat
max :: ShaderBinaryFormat -> ShaderBinaryFormat -> ShaderBinaryFormat
$cmin :: ShaderBinaryFormat -> ShaderBinaryFormat -> ShaderBinaryFormat
min :: ShaderBinaryFormat -> ShaderBinaryFormat -> ShaderBinaryFormat
Ord, Int -> ShaderBinaryFormat -> ShowS
[ShaderBinaryFormat] -> ShowS
ShaderBinaryFormat -> String
(Int -> ShaderBinaryFormat -> ShowS)
-> (ShaderBinaryFormat -> String)
-> ([ShaderBinaryFormat] -> ShowS)
-> Show ShaderBinaryFormat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ShaderBinaryFormat -> ShowS
showsPrec :: Int -> ShaderBinaryFormat -> ShowS
$cshow :: ShaderBinaryFormat -> String
show :: ShaderBinaryFormat -> String
$cshowList :: [ShaderBinaryFormat] -> ShowS
showList :: [ShaderBinaryFormat] -> ShowS
Show )

shaderBinaryFormats :: GettableStateVar [ShaderBinaryFormat]
shaderBinaryFormats :: GettableStateVar [ShaderBinaryFormat]
shaderBinaryFormats =
   GettableStateVar [ShaderBinaryFormat]
-> GettableStateVar [ShaderBinaryFormat]
forall a. IO a -> IO a
makeGettableStateVar (GettableStateVar [ShaderBinaryFormat]
 -> GettableStateVar [ShaderBinaryFormat])
-> GettableStateVar [ShaderBinaryFormat]
-> GettableStateVar [ShaderBinaryFormat]
forall a b. (a -> b) -> a -> b
$ do
      Int
n <- (GLsizei -> Int) -> PName1I -> IO Int
forall p a. GetPName1I p => (GLsizei -> a) -> p -> IO a
forall a. (GLsizei -> a) -> PName1I -> IO a
getInteger1 GLsizei -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral PName1I
GetNumShaderBinaryFormats
      (GLuint -> ShaderBinaryFormat)
-> PNameNI -> Int -> GettableStateVar [ShaderBinaryFormat]
forall p a. GetPNameNI p => (GLuint -> a) -> p -> Int -> IO [a]
forall a. (GLuint -> a) -> PNameNI -> Int -> IO [a]
getEnumN GLuint -> ShaderBinaryFormat
ShaderBinaryFormat PNameNI
GetShaderBinaryFormats Int
n

data ShaderBinary = ShaderBinary ShaderBinaryFormat ByteString
   deriving ( ShaderBinary -> ShaderBinary -> Bool
(ShaderBinary -> ShaderBinary -> Bool)
-> (ShaderBinary -> ShaderBinary -> Bool) -> Eq ShaderBinary
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ShaderBinary -> ShaderBinary -> Bool
== :: ShaderBinary -> ShaderBinary -> Bool
$c/= :: ShaderBinary -> ShaderBinary -> Bool
/= :: ShaderBinary -> ShaderBinary -> Bool
Eq, Eq ShaderBinary
Eq ShaderBinary =>
(ShaderBinary -> ShaderBinary -> Ordering)
-> (ShaderBinary -> ShaderBinary -> Bool)
-> (ShaderBinary -> ShaderBinary -> Bool)
-> (ShaderBinary -> ShaderBinary -> Bool)
-> (ShaderBinary -> ShaderBinary -> Bool)
-> (ShaderBinary -> ShaderBinary -> ShaderBinary)
-> (ShaderBinary -> ShaderBinary -> ShaderBinary)
-> Ord ShaderBinary
ShaderBinary -> ShaderBinary -> Bool
ShaderBinary -> ShaderBinary -> Ordering
ShaderBinary -> ShaderBinary -> ShaderBinary
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 :: ShaderBinary -> ShaderBinary -> Ordering
compare :: ShaderBinary -> ShaderBinary -> Ordering
$c< :: ShaderBinary -> ShaderBinary -> Bool
< :: ShaderBinary -> ShaderBinary -> Bool
$c<= :: ShaderBinary -> ShaderBinary -> Bool
<= :: ShaderBinary -> ShaderBinary -> Bool
$c> :: ShaderBinary -> ShaderBinary -> Bool
> :: ShaderBinary -> ShaderBinary -> Bool
$c>= :: ShaderBinary -> ShaderBinary -> Bool
>= :: ShaderBinary -> ShaderBinary -> Bool
$cmax :: ShaderBinary -> ShaderBinary -> ShaderBinary
max :: ShaderBinary -> ShaderBinary -> ShaderBinary
$cmin :: ShaderBinary -> ShaderBinary -> ShaderBinary
min :: ShaderBinary -> ShaderBinary -> ShaderBinary
Ord, Int -> ShaderBinary -> ShowS
[ShaderBinary] -> ShowS
ShaderBinary -> String
(Int -> ShaderBinary -> ShowS)
-> (ShaderBinary -> String)
-> ([ShaderBinary] -> ShowS)
-> Show ShaderBinary
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ShaderBinary -> ShowS
showsPrec :: Int -> ShaderBinary -> ShowS
$cshow :: ShaderBinary -> String
show :: ShaderBinary -> String
$cshowList :: [ShaderBinary] -> ShowS
showList :: [ShaderBinary] -> ShowS
Show )

shaderBinary :: [Shader] -> SettableStateVar ShaderBinary
shaderBinary :: [Shader] -> SettableStateVar ShaderBinary
shaderBinary [Shader]
shaders =
   (ShaderBinary -> IO ()) -> SettableStateVar ShaderBinary
forall a. (a -> IO ()) -> SettableStateVar a
makeSettableStateVar ((ShaderBinary -> IO ()) -> SettableStateVar ShaderBinary)
-> (ShaderBinary -> IO ()) -> SettableStateVar ShaderBinary
forall a b. (a -> b) -> a -> b
$ \(ShaderBinary (ShaderBinaryFormat GLuint
format) ByteString
bs) ->
      [GLuint] -> (Int -> Ptr GLuint -> IO ()) -> IO ()
forall a b. Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen ((Shader -> GLuint) -> [Shader] -> [GLuint]
forall a b. (a -> b) -> [a] -> [b]
map Shader -> GLuint
shaderID [Shader]
shaders) ((Int -> Ptr GLuint -> IO ()) -> IO ())
-> (Int -> Ptr GLuint -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Int
numShaders Ptr GLuint
shadersBuf ->
         ByteString -> (Ptr GLchar -> GLsizei -> IO ()) -> IO ()
forall b. ByteString -> (Ptr GLchar -> GLsizei -> IO b) -> IO b
withByteString ByteString
bs ((Ptr GLchar -> GLsizei -> IO ()) -> IO ())
-> (Ptr GLchar -> GLsizei -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
            GLsizei -> Ptr GLuint -> GLuint -> Ptr GLchar -> GLsizei -> IO ()
forall (m :: * -> *) a.
MonadIO m =>
GLsizei -> Ptr GLuint -> GLuint -> Ptr a -> GLsizei -> m ()
glShaderBinary (Int -> GLsizei
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
numShaders) Ptr GLuint
shadersBuf GLuint
format