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

module Graphics.Rendering.OpenGL.GL.Shaders.ProgramBinaries (
   ProgramBinaryFormat(..), programBinaryFormats,
   ProgramBinary(..), programBinary
) where

import Data.StateVar
import Foreign.Marshal.Alloc
import Graphics.Rendering.OpenGL.GL.ByteString
import Graphics.Rendering.OpenGL.GL.PeekPoke
import Graphics.Rendering.OpenGL.GL.QueryUtils
import Graphics.Rendering.OpenGL.GL.Shaders.Program
import Graphics.GL

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

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

programBinaryFormats :: GettableStateVar [ProgramBinaryFormat]
programBinaryFormats :: GettableStateVar [ProgramBinaryFormat]
programBinaryFormats =
   forall a. IO a -> IO a
makeGettableStateVar forall a b. (a -> b) -> a -> b
$ do
      Int
n <- forall p a. GetPName1I p => (GLint -> a) -> p -> IO a
getInteger1 forall a b. (Integral a, Num b) => a -> b
fromIntegral PName1I
GetNumProgramBinaryFormats
      forall p a. GetPNameNI p => (GLenum -> a) -> p -> Int -> IO [a]
getEnumN GLenum -> ProgramBinaryFormat
ProgramBinaryFormat PNameNI
GetProgramBinaryFormats Int
n

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

programBinary :: Program -> StateVar ProgramBinary
programBinary :: Program -> StateVar ProgramBinary
programBinary Program
program =
   forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar (Program -> IO ProgramBinary
getProgramBinary Program
program) (Program -> ProgramBinary -> IO ()
setProgramBinary Program
program)

getProgramBinary :: Program -> IO ProgramBinary
getProgramBinary :: Program -> IO ProgramBinary
getProgramBinary Program
program =
   forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr GLenum
formatBuf -> do
      let getBin :: Program -> GLint -> Ptr GLint -> Ptr a -> IO ()
getBin = forall d a b c e. d -> (a -> b -> c -> d -> e) -> a -> b -> c -> e
bind4th Ptr GLenum
formatBuf (forall (m :: * -> *) a.
MonadIO m =>
GLenum -> GLint -> Ptr GLint -> Ptr GLenum -> Ptr a -> m ()
glGetProgramBinary forall b c a. (b -> c) -> (a -> b) -> a -> c
. Program -> GLenum
programID)
      ByteString
bs <- forall a.
(a -> GettableStateVar GLint)
-> (a -> GLint -> Ptr GLint -> Ptr GLchar -> IO ())
-> a
-> IO ByteString
stringQuery Program -> GettableStateVar GLint
programBinaryLength forall {a}. Program -> GLint -> Ptr GLint -> Ptr a -> IO ()
getBin Program
program
      ProgramBinaryFormat
format <- forall a b. Storable a => (a -> b) -> Ptr a -> IO b
peek1 GLenum -> ProgramBinaryFormat
ProgramBinaryFormat Ptr GLenum
formatBuf
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ProgramBinaryFormat -> ByteString -> ProgramBinary
ProgramBinary ProgramBinaryFormat
format ByteString
bs

bind4th :: d -> (a -> b -> c -> d -> e) -> (a -> b -> c -> e)
bind4th :: forall d a b c e. d -> (a -> b -> c -> d -> e) -> a -> b -> c -> e
bind4th d
x = (forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b c a. (b -> c) -> (a -> b) -> a -> c
(.)) (forall a b. (a -> b) -> a -> b
$ d
x)

setProgramBinary :: Program -> ProgramBinary -> IO ()
setProgramBinary :: Program -> ProgramBinary -> IO ()
setProgramBinary Program
program (ProgramBinary (ProgramBinaryFormat GLenum
format) ByteString
bs) = do
   forall b. ByteString -> (Ptr GLchar -> GLint -> IO b) -> IO b
withByteString ByteString
bs forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadIO m =>
GLenum -> GLenum -> Ptr a -> GLint -> m ()
glProgramBinary (Program -> GLenum
programID Program
program) GLenum
format

programBinaryLength :: Program -> GettableStateVar GLsizei
programBinaryLength :: Program -> GettableStateVar GLint
programBinaryLength = forall a.
(GLint -> a) -> GetProgramPName -> Program -> GettableStateVar a
programVar1 forall a b. (Integral a, Num b) => a -> b
fromIntegral GetProgramPName
ProgramBinaryLength