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

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

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

programBinary :: Program -> StateVar ProgramBinary
programBinary :: Program -> StateVar ProgramBinary
programBinary Program
program =
   IO ProgramBinary
-> (ProgramBinary -> IO ()) -> StateVar ProgramBinary
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 =
   (Ptr GLenum -> IO ProgramBinary) -> IO ProgramBinary
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr GLenum -> IO ProgramBinary) -> IO ProgramBinary)
-> (Ptr GLenum -> IO ProgramBinary) -> IO ProgramBinary
forall a b. (a -> b) -> a -> b
$ \Ptr GLenum
formatBuf -> do
      let getBin :: Program -> GLint -> Ptr GLint -> Ptr a -> IO ()
getBin = Ptr GLenum
-> (Program -> GLint -> Ptr GLint -> Ptr GLenum -> Ptr a -> IO ())
-> Program
-> GLint
-> Ptr GLint
-> Ptr a
-> IO ()
forall d a b c e. d -> (a -> b -> c -> d -> e) -> a -> b -> c -> e
bind4th Ptr GLenum
formatBuf (GLenum -> GLint -> Ptr GLint -> Ptr GLenum -> Ptr a -> IO ()
forall (m :: * -> *) a.
MonadIO m =>
GLenum -> GLint -> Ptr GLint -> Ptr GLenum -> Ptr a -> m ()
glGetProgramBinary (GLenum -> GLint -> Ptr GLint -> Ptr GLenum -> Ptr a -> IO ())
-> (Program -> GLenum)
-> Program
-> GLint
-> Ptr GLint
-> Ptr GLenum
-> Ptr a
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Program -> GLenum
programID)
      ByteString
bs <- (Program -> GettableStateVar GLint)
-> (Program -> GLint -> Ptr GLint -> Ptr GLchar -> IO ())
-> Program
-> IO ByteString
forall a.
(a -> GettableStateVar GLint)
-> (a -> GLint -> Ptr GLint -> Ptr GLchar -> IO ())
-> a
-> IO ByteString
stringQuery Program -> GettableStateVar GLint
programBinaryLength Program -> GLint -> Ptr GLint -> Ptr GLchar -> IO ()
forall {a}. Program -> GLint -> Ptr GLint -> Ptr a -> IO ()
getBin Program
program
      ProgramBinaryFormat
format <- (GLenum -> ProgramBinaryFormat)
-> Ptr GLenum -> IO ProgramBinaryFormat
forall a b. Storable a => (a -> b) -> Ptr a -> IO b
peek1 GLenum -> ProgramBinaryFormat
ProgramBinaryFormat Ptr GLenum
formatBuf
      ProgramBinary -> IO ProgramBinary
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ProgramBinary -> IO ProgramBinary)
-> ProgramBinary -> IO ProgramBinary
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 = (((b -> c -> d -> e) -> b -> c -> e)
-> (a -> b -> c -> d -> e) -> a -> b -> c -> e
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) (((b -> c -> d -> e) -> b -> c -> e)
 -> (a -> b -> c -> d -> e) -> a -> b -> c -> e)
-> (((d -> e) -> e) -> (b -> c -> d -> e) -> b -> c -> e)
-> ((d -> e) -> e)
-> (a -> b -> c -> d -> e)
-> a
-> b
-> c
-> e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((c -> d -> e) -> c -> e) -> (b -> c -> d -> e) -> b -> c -> e
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) (((c -> d -> e) -> c -> e) -> (b -> c -> d -> e) -> b -> c -> e)
-> (((d -> e) -> e) -> (c -> d -> e) -> c -> e)
-> ((d -> e) -> e)
-> (b -> c -> d -> e)
-> b
-> c
-> e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((d -> e) -> e) -> (c -> d -> e) -> c -> e
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.)) ((d -> e) -> d -> e
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
   ByteString -> (Ptr GLchar -> GLint -> IO ()) -> IO ()
forall b. ByteString -> (Ptr GLchar -> GLint -> IO b) -> IO b
withByteString ByteString
bs ((Ptr GLchar -> GLint -> IO ()) -> IO ())
-> (Ptr GLchar -> GLint -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ GLenum -> GLenum -> Ptr GLchar -> GLint -> IO ()
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 = (GLint -> GLint)
-> GetProgramPName -> Program -> GettableStateVar GLint
forall a.
(GLint -> a) -> GetProgramPName -> Program -> GettableStateVar a
programVar1 GLint -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral GetProgramPName
ProgramBinaryLength