Added support for ARB_texture_float extension.

Author: svenpanne

CHANGELOG.md

@@ -1,6 +1,6 @@
 3.0.2.0
 -------
-* Added `PixelInternalFormat` constructors for S3_s3tc and EXT_texture_compression_s3tc extensions.
+* Added `PixelInternalFormat` constructors for S3_s3tc, EXT_texture_compression_s3tc, and ARB_texture_float extensions.
 
 3.0.1.0
 -------

src/Graphics/Rendering/OpenGL/GL/DataType.hs

@@ -15,7 +15,7 @@
 
 module Graphics.Rendering.OpenGL.GL.DataType (
    DataType(..), marshalDataType, unmarshalDataType,
-   DataTypeType(..), marshalDataTypeType, unmarshalDataTypeType
+   DataRepresentation(..), unmarshalDataRepresentation
 ) where
 
 import Graphics.GL
@@ -126,29 +126,20 @@ unmarshalDataType x
    | x == GL_4_BYTES = FourBytes
    | otherwise = error ("unmarshalDataType: illegal value " ++ show x)
 
-data DataTypeType
-   = TNone
-   | TSignedNormalized
-   | TUnsignedNormalized
-   | TFloat
-   | TInt
-   | TUnsignedInt
-
-marshalDataTypeType :: DataTypeType -> GLenum
-marshalDataTypeType x = case x of
-   TNone -> GL_NONE
-   TSignedNormalized -> GL_SIGNED_NORMALIZED
-   TUnsignedNormalized -> GL_UNSIGNED_NORMALIZED
-   TFloat -> GL_FLOAT
-   TInt -> GL_INT
-   TUnsignedInt -> GL_UNSIGNED_INT
+data DataRepresentation
+   = SignedNormalizedRepresentation
+   | UnsignedNormalizedRepresentation
+   | FloatRepresentation
+   | IntRepresentation
+   | UnsignedIntRepresentation
+   deriving ( Eq, Ord, Show )
 
-unmarshalDataTypeType :: GLenum -> DataTypeType
-unmarshalDataTypeType x
-   | x == GL_NONE = TNone
-   | x == GL_SIGNED_NORMALIZED = TSignedNormalized
-   | x == GL_UNSIGNED_NORMALIZED = TUnsignedNormalized
-   | x == GL_FLOAT = TFloat
-   | x == GL_INT = TInt
-   | x == GL_UNSIGNED_INT = TUnsignedInt
-   | otherwise = error $ "unmarshalDataTypeType: illegal value " ++ show x
+unmarshalDataRepresentation :: GLenum -> Maybe DataRepresentation
+unmarshalDataRepresentation x
+   | x == GL_SIGNED_NORMALIZED = Just SignedNormalizedRepresentation
+   | x == GL_UNSIGNED_NORMALIZED = Just UnsignedNormalizedRepresentation
+   | x == GL_FLOAT = Just FloatRepresentation
+   | x == GL_INT = Just IntRepresentation
+   | x == GL_UNSIGNED_INT = Just UnsignedIntRepresentation
+   | x == GL_NONE = Nothing
+   | otherwise = error $ "unmarshalDataRepresentation: illegal value " ++ show x

src/Graphics/Rendering/OpenGL/GL/Texturing/PixelInternalFormat.hs

@@ -143,6 +143,14 @@ data PixelInternalFormat =
    | CompressedRGBAS3TCDXT3
    | CompressedRGBAS3TCDXT5
    | CompressedRGBS3TCDXT1
+   | Alpha32F
+   | Intensity32F
+   | Luminance32F
+   | LuminanceAlpha32F
+   | Alpha16F
+   | Intensity16F
+   | Luminance16F
+   | LuminanceAlpha16F
    deriving ( Eq, Ord, Show )
 
 marshalPixelInternalFormat :: PixelInternalFormat -> GLint
@@ -267,6 +275,14 @@ marshalPixelInternalFormat x = fromIntegral $ case x of
    CompressedRGBAS3TCDXT3 -> GL_COMPRESSED_RGBA_S3TC_DXT3_EXT
    CompressedRGBAS3TCDXT5 -> GL_COMPRESSED_RGBA_S3TC_DXT5_EXT
    CompressedRGBS3TCDXT1 -> GL_COMPRESSED_RGB_S3TC_DXT1_EXT
+   Alpha32F -> GL_ALPHA32F_ARB
+   Intensity32F -> GL_INTENSITY32F_ARB
+   Luminance32F -> GL_LUMINANCE32F_ARB
+   LuminanceAlpha32F -> GL_LUMINANCE_ALPHA32F_ARB
+   Alpha16F -> GL_ALPHA16F_ARB
+   Intensity16F -> GL_INTENSITY16F_ARB
+   Luminance16F -> GL_LUMINANCE16F_ARB
+   LuminanceAlpha16F -> GL_LUMINANCE_ALPHA16F_ARB
 
 -- *sigh* The OpenGL API is sometimes a bit creative in its usage of types...
 marshalPixelInternalFormat' :: PixelInternalFormat -> GLenum
@@ -389,6 +405,14 @@ unmarshalPixelInternalFormat x
    | y == GL_COMPRESSED_RGBA_S3TC_DXT3_EXT = CompressedRGBAS3TCDXT3
    | y == GL_COMPRESSED_RGBA_S3TC_DXT5_EXT = CompressedRGBAS3TCDXT5
    | y == GL_COMPRESSED_RGB_S3TC_DXT1_EXT = CompressedRGBS3TCDXT1
+   | y == GL_ALPHA32F_ARB = Alpha32F
+   | y == GL_INTENSITY32F_ARB = Intensity32F
+   | y == GL_LUMINANCE32F_ARB = Luminance32F
+   | y == GL_LUMINANCE_ALPHA32F_ARB = LuminanceAlpha32F
+   | y == GL_ALPHA16F_ARB = Alpha16F
+   | y == GL_INTENSITY16F_ARB = Intensity16F
+   | y == GL_LUMINANCE16F_ARB = Luminance16F
+   | y == GL_LUMINANCE_ALPHA16F_ARB = LuminanceAlpha16F
    -- legacy values
    | y == 1 = Luminance'
    | y == 2 = LuminanceAlpha'

src/Graphics/Rendering/OpenGL/GL/Texturing/Queries.hs

@@ -16,12 +16,14 @@ module Graphics.Rendering.OpenGL.GL.Texturing.Queries (
    TextureQuery, textureInternalFormat, textureSize1D, textureSize2D,
    textureSize3D, textureBorder, textureRGBASizes, textureSharedSize,
    textureIntensitySize, textureLuminanceSize, textureIndexSize,
-   textureDepthBits, textureCompressedImageSize, textureProxyOK
+   textureDepthBits, textureCompressedImageSize, textureProxyOK,
+   textureRGBATypes, textureIntensityType, textureLuminanceType, textureDepthType
 ) where
 
 import Control.Monad
 import Data.StateVar
 import Foreign.Marshal.Utils
+import Graphics.Rendering.OpenGL.GL.DataType
 import Graphics.Rendering.OpenGL.GL.GLboolean
 import Graphics.Rendering.OpenGL.GL.PeekPoke
 import Graphics.Rendering.OpenGL.GL.PixelRectangles
@@ -50,6 +52,13 @@ data TexLevelParameter =
    | TextureCompressedImageSize
    | TextureCompressed
    | TextureSharedSize
+   | TextureRedType
+   | TextureGreenType
+   | TextureBlueType
+   | TextureAlphaType
+   | TextureLuminanceType
+   | TextureIntensityType
+   | TextureDepthType
 
 marshalTexLevelParameter :: TexLevelParameter -> GLenum
 marshalTexLevelParameter x = case x of
@@ -69,6 +78,13 @@ marshalTexLevelParameter x = case x of
    TextureCompressedImageSize -> GL_TEXTURE_COMPRESSED_IMAGE_SIZE
    TextureCompressed -> GL_TEXTURE_COMPRESSED
    TextureSharedSize -> GL_TEXTURE_SHARED_SIZE
+   TextureRedType -> GL_TEXTURE_RED_TYPE_ARB
+   TextureGreenType -> GL_TEXTURE_GREEN_TYPE_ARB
+   TextureBlueType -> GL_TEXTURE_BLUE_TYPE_ARB
+   TextureAlphaType -> GL_TEXTURE_ALPHA_TYPE_ARB
+   TextureLuminanceType -> GL_TEXTURE_LUMINANCE_TYPE_ARB
+   TextureIntensityType -> GL_TEXTURE_INTENSITY_TYPE_ARB
+   TextureDepthType -> GL_TEXTURE_DEPTH_TYPE_ARB
 
 --------------------------------------------------------------------------------
 
@@ -152,6 +168,27 @@ textureProxyOK t level =
    makeGettableStateVar $
       getTexLevelParameteri unmarshalGLboolean (marshalParameterizedTextureTargetProxy t) level TextureWidth
 
+textureRGBATypes :: QueryableTextureTarget t =>  TextureQuery t (Color4 (Maybe DataRepresentation))
+textureRGBATypes t level =
+   makeGettableStateVar $
+      liftM4 Color4
+             (getDataRepr t level TextureRedType  )
+             (getDataRepr t level TextureGreenType)
+             (getDataRepr t level TextureBlueType )
+             (getDataRepr t level TextureAlphaType)
+
+getDataRepr :: QueryableTextureTarget t => t -> Level -> TexLevelParameter -> IO (Maybe DataRepresentation)
+getDataRepr = getTexLevelParameteriNoProxy (unmarshalDataRepresentation . fromIntegral)
+
+textureIntensityType :: QueryableTextureTarget t => TextureQuery t (Maybe DataRepresentation)
+textureIntensityType t level = makeGettableStateVar $ getDataRepr t level TextureIntensityType
+
+textureLuminanceType :: QueryableTextureTarget t =>  TextureQuery t (Maybe DataRepresentation)
+textureLuminanceType t level = makeGettableStateVar $ getDataRepr t level TextureLuminanceType
+
+textureDepthType :: QueryableTextureTarget t =>  TextureQuery t (Maybe DataRepresentation)
+textureDepthType t level = makeGettableStateVar $ getDataRepr t level TextureDepthType
+
 getTexLevelParameteriNoProxy :: QueryableTextureTarget t => (GLint -> a) -> t -> Level -> TexLevelParameter -> IO a
 getTexLevelParameteriNoProxy f = getTexLevelParameteri f . marshalQueryableTextureTarget