{-# LANGUAGE EmptyDataDecls        #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE GADTs                 #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE TypeSynonymInstances  #-}

module Graphics.GPipe.Internal.Format where

import           Data.Text.Lazy        (Text)
import           Foreign.Marshal.Array (withArray)
import           Graphics.GL.Core45
import           Graphics.GL.Types     (GLenum)
import           Linear.V2             (V2 (..))
import           Linear.V3             (V3 (..))
import           Linear.V4             (V4 (..))

data RFloat
data RInt
data RWord
data RGFloat
data RGInt
data RGWord
data RGBFloat
data RGBInt
data RGBWord
data RGBAFloat
data RGBAInt
data RGBAWord
data Depth
data Stencil
data DepthStencil

data Format a where
    R8 :: Format RFloat
    R8S :: Format RFloat
    R16 :: Format RFloat
    R16S :: Format RFloat
    R16F :: Format RFloat
    R32F :: Format RFloat
    R8I :: Format RInt
    R16I :: Format RInt
    R32I :: Format RInt
    R8UI :: Format RWord
    R16UI :: Format RWord
    R32UI :: Format RWord
    RG8 :: Format RGFloat
    RG8S :: Format RGFloat
    RG16 :: Format RGFloat
    RG16S :: Format RGFloat
    RG16F :: Format RGFloat
    RG32F :: Format RGFloat
    RG8I :: Format RGInt
    RG16I :: Format RGInt
    RG32I :: Format RGInt
    RG8UI :: Format RGWord
    RG16UI :: Format RGWord
    RG32UI :: Format RGWord
    R3G3B2 :: Format RGBFloat
    RGB4 :: Format RGBFloat
    RGB5 :: Format RGBFloat
    RGB8 :: Format RGBFloat
    RGB8S :: Format RGBFloat
    RGB10 :: Format RGBFloat
    RGB12 :: Format RGBFloat
    RGB16 :: Format RGBFloat
    RGB16S :: Format RGBFloat
    RGB16F :: Format RGBFloat
    RGB32F :: Format RGBFloat
    R11FG11FB10F :: Format RGBFloat
    RGB9E5 :: Format RGBFloat
    SRGB8 :: Format RGBFloat
    RGB8I :: Format RGBInt
    RGB16I :: Format RGBInt
    RGB32I :: Format RGBInt
    RGBWord :: Format RGBWord
    RGB8UI :: Format RGBWord
    RGB16UI :: Format RGBWord
    RGB32UI :: Format RGBWord
    RGBA2 :: Format RGBAFloat
    RGBA4 :: Format RGBAFloat
    RGB5A1 :: Format RGBAFloat
    RGBA8 :: Format RGBAFloat
    RGBA8S :: Format RGBAFloat
    RGB10A2 :: Format RGBAFloat
    RGBA12 :: Format RGBAFloat
    RGBA16 :: Format RGBAFloat
    RGBA16S :: Format RGBAFloat
    RGBA16F :: Format RGBAFloat
    RGBA32F :: Format RGBAFloat
    SRGB8A8 :: Format RGBAFloat
    RGBA8I :: Format RGBAInt
    RGBA16I :: Format RGBAInt
    RGBA32I :: Format RGBAInt
    RGBA8UI :: Format RGBAWord
    RGBA16UI :: Format RGBAWord
    RGBA32UI :: Format RGBAWord

    Depth16 :: Format Depth
    Depth24 :: Format Depth
    Depth32 :: Format Depth
    Depth32F :: Format Depth
    Stencil1 :: Format Stencil
    Stencil4 :: Format Stencil
    Stencil8 :: Format Stencil
    Stencil16 :: Format Stencil
    Depth24Stencil8  :: Format DepthStencil
    Depth32FStencil8 :: Format DepthStencil

getGlInternalFormat :: Format f -> GLenum
getGlInternalFormat :: Format f -> GLenum
getGlInternalFormat Format f
R8               = GLenum
forall a. (Eq a, Num a) => a
GL_R8
getGlInternalFormat Format f
R8S              = GLenum
forall a. (Eq a, Num a) => a
GL_R8_SNORM
getGlInternalFormat Format f
R16              = GLenum
forall a. (Eq a, Num a) => a
GL_R16
getGlInternalFormat Format f
R16S             = GLenum
forall a. (Eq a, Num a) => a
GL_R16_SNORM
getGlInternalFormat Format f
R16F             = GLenum
forall a. (Eq a, Num a) => a
GL_R16F
getGlInternalFormat Format f
R32F             = GLenum
forall a. (Eq a, Num a) => a
GL_R32F
getGlInternalFormat Format f
R8I              = GLenum
forall a. (Eq a, Num a) => a
GL_R8I
getGlInternalFormat Format f
R16I             = GLenum
forall a. (Eq a, Num a) => a
GL_R16I
getGlInternalFormat Format f
R32I             = GLenum
forall a. (Eq a, Num a) => a
GL_R32I
getGlInternalFormat Format f
R8UI             = GLenum
forall a. (Eq a, Num a) => a
GL_R8UI
getGlInternalFormat Format f
R16UI            = GLenum
forall a. (Eq a, Num a) => a
GL_R16UI
getGlInternalFormat Format f
R32UI            = GLenum
forall a. (Eq a, Num a) => a
GL_R32UI
getGlInternalFormat Format f
RG8              = GLenum
forall a. (Eq a, Num a) => a
GL_RG8
getGlInternalFormat Format f
RG8S             = GLenum
forall a. (Eq a, Num a) => a
GL_RG8_SNORM
getGlInternalFormat Format f
RG16             = GLenum
forall a. (Eq a, Num a) => a
GL_RG16
getGlInternalFormat Format f
RG16S            = GLenum
forall a. (Eq a, Num a) => a
GL_RG16_SNORM
getGlInternalFormat Format f
RG16F            = GLenum
forall a. (Eq a, Num a) => a
GL_RG16F
getGlInternalFormat Format f
RG32F            = GLenum
forall a. (Eq a, Num a) => a
GL_RG32F
getGlInternalFormat Format f
RG8I             = GLenum
forall a. (Eq a, Num a) => a
GL_RG8I
getGlInternalFormat Format f
RG16I            = GLenum
forall a. (Eq a, Num a) => a
GL_RG16I
getGlInternalFormat Format f
RG32I            = GLenum
forall a. (Eq a, Num a) => a
GL_RG32I
getGlInternalFormat Format f
RG8UI            = GLenum
forall a. (Eq a, Num a) => a
GL_RG8UI
getGlInternalFormat Format f
RG16UI           = GLenum
forall a. (Eq a, Num a) => a
GL_RG16UI
getGlInternalFormat Format f
RG32UI           = GLenum
forall a. (Eq a, Num a) => a
GL_RG32UI
getGlInternalFormat Format f
R3G3B2           = GLenum
forall a. (Eq a, Num a) => a
GL_R3_G3_B2
getGlInternalFormat Format f
RGB4             = GLenum
forall a. (Eq a, Num a) => a
GL_RGB4
getGlInternalFormat Format f
RGB5             = GLenum
forall a. (Eq a, Num a) => a
GL_RGB5
getGlInternalFormat Format f
RGB8             = GLenum
forall a. (Eq a, Num a) => a
GL_RGB8
getGlInternalFormat Format f
RGB8S            = GLenum
forall a. (Eq a, Num a) => a
GL_RGB8_SNORM
getGlInternalFormat Format f
RGB10            = GLenum
forall a. (Eq a, Num a) => a
GL_RGB10
getGlInternalFormat Format f
RGB12            = GLenum
forall a. (Eq a, Num a) => a
GL_RGB12
getGlInternalFormat Format f
RGB16            = GLenum
forall a. (Eq a, Num a) => a
GL_RGB16
getGlInternalFormat Format f
RGB16S           = GLenum
forall a. (Eq a, Num a) => a
GL_RGB16_SNORM
getGlInternalFormat Format f
RGB16F           = GLenum
forall a. (Eq a, Num a) => a
GL_RGB16F
getGlInternalFormat Format f
RGB32F           = GLenum
forall a. (Eq a, Num a) => a
GL_RGB32F
getGlInternalFormat Format f
R11FG11FB10F     = GLenum
forall a. (Eq a, Num a) => a
GL_R11F_G11F_B10F
getGlInternalFormat Format f
RGB9E5           = GLenum
forall a. (Eq a, Num a) => a
GL_RGB9_E5
getGlInternalFormat Format f
SRGB8            = GLenum
forall a. (Eq a, Num a) => a
GL_SRGB8
getGlInternalFormat Format f
RGB8I            = GLenum
forall a. (Eq a, Num a) => a
GL_RGB8I
getGlInternalFormat Format f
RGB16I           = GLenum
forall a. (Eq a, Num a) => a
GL_RGB16I
getGlInternalFormat Format f
RGB32I           = GLenum
forall a. (Eq a, Num a) => a
GL_RGB32I
getGlInternalFormat Format f
RGB8UI           = GLenum
forall a. (Eq a, Num a) => a
GL_RGB8UI
getGlInternalFormat Format f
RGB16UI          = GLenum
forall a. (Eq a, Num a) => a
GL_RGB16UI
getGlInternalFormat Format f
RGB32UI          = GLenum
forall a. (Eq a, Num a) => a
GL_RGB32UI
getGlInternalFormat Format f
RGBA2            = GLenum
forall a. (Eq a, Num a) => a
GL_RGBA2
getGlInternalFormat Format f
RGBA4            = GLenum
forall a. (Eq a, Num a) => a
GL_RGBA4
getGlInternalFormat Format f
RGB5A1           = GLenum
forall a. (Eq a, Num a) => a
GL_RGB5_A1
getGlInternalFormat Format f
RGBA8            = GLenum
forall a. (Eq a, Num a) => a
GL_RGBA8
getGlInternalFormat Format f
RGBA8S           = GLenum
forall a. (Eq a, Num a) => a
GL_RGBA8_SNORM
getGlInternalFormat Format f
RGB10A2          = GLenum
forall a. (Eq a, Num a) => a
GL_RGB10_A2
getGlInternalFormat Format f
RGBA12           = GLenum
forall a. (Eq a, Num a) => a
GL_RGBA12
getGlInternalFormat Format f
RGBA16           = GLenum
forall a. (Eq a, Num a) => a
GL_RGBA16
getGlInternalFormat Format f
RGBA16S          = GLenum
forall a. (Eq a, Num a) => a
GL_RGBA16_SNORM
getGlInternalFormat Format f
RGBA16F          = GLenum
forall a. (Eq a, Num a) => a
GL_RGBA16F
getGlInternalFormat Format f
RGBA32F          = GLenum
forall a. (Eq a, Num a) => a
GL_RGBA32F
getGlInternalFormat Format f
SRGB8A8          = GLenum
forall a. (Eq a, Num a) => a
GL_SRGB8_ALPHA8
getGlInternalFormat Format f
RGBA8I           = GLenum
forall a. (Eq a, Num a) => a
GL_RGBA8I
getGlInternalFormat Format f
RGBA16I          = GLenum
forall a. (Eq a, Num a) => a
GL_RGBA16I
getGlInternalFormat Format f
RGBA32I          = GLenum
forall a. (Eq a, Num a) => a
GL_RGBA32I
getGlInternalFormat Format f
RGBA8UI          = GLenum
forall a. (Eq a, Num a) => a
GL_RGBA8UI
getGlInternalFormat Format f
RGBA16UI         = GLenum
forall a. (Eq a, Num a) => a
GL_RGBA16UI
getGlInternalFormat Format f
RGBA32UI         = GLenum
forall a. (Eq a, Num a) => a
GL_RGBA32UI
getGlInternalFormat Format f
Depth16          = GLenum
forall a. (Eq a, Num a) => a
GL_DEPTH_COMPONENT16
getGlInternalFormat Format f
Depth24          = GLenum
forall a. (Eq a, Num a) => a
GL_DEPTH_COMPONENT24
getGlInternalFormat Format f
Depth32          = GLenum
forall a. (Eq a, Num a) => a
GL_DEPTH_COMPONENT32
getGlInternalFormat Format f
Depth32F         = GLenum
forall a. (Eq a, Num a) => a
GL_DEPTH_COMPONENT32F
getGlInternalFormat Format f
Stencil1         = GLenum
forall a. (Eq a, Num a) => a
GL_STENCIL_INDEX1
getGlInternalFormat Format f
Stencil4         = GLenum
forall a. (Eq a, Num a) => a
GL_STENCIL_INDEX4
getGlInternalFormat Format f
Stencil8         = GLenum
forall a. (Eq a, Num a) => a
GL_STENCIL_INDEX8
getGlInternalFormat Format f
Stencil16        = GLenum
forall a. (Eq a, Num a) => a
GL_STENCIL_INDEX16
getGlInternalFormat Format f
Depth24Stencil8  = GLenum
forall a. (Eq a, Num a) => a
GL_DEPTH24_STENCIL8
getGlInternalFormat Format f
Depth32FStencil8 = GLenum
forall a. (Eq a, Num a) => a
GL_DEPTH32F_STENCIL8

class TextureFormat f where
    getGlFormat  :: f -> GLenum
    getGlFormat = [Char] -> f -> GLenum
forall a. HasCallStack => [Char] -> a
error [Char]
"You cannot create your own instances of TextureFormat"

instance TextureFormat RFloat where
    getGlFormat :: RFloat -> GLenum
getGlFormat RFloat
_ = GLenum
forall a. (Eq a, Num a) => a
GL_RED
instance TextureFormat RInt where
    getGlFormat :: RInt -> GLenum
getGlFormat RInt
_ = GLenum
forall a. (Eq a, Num a) => a
GL_RED_INTEGER
instance TextureFormat RWord where
    getGlFormat :: RWord -> GLenum
getGlFormat RWord
_ = GLenum
forall a. (Eq a, Num a) => a
GL_RED_INTEGER

instance TextureFormat RGFloat where
    getGlFormat :: RGFloat -> GLenum
getGlFormat RGFloat
_ = GLenum
forall a. (Eq a, Num a) => a
GL_RG
instance TextureFormat RGInt where
    getGlFormat :: RGInt -> GLenum
getGlFormat RGInt
_ = GLenum
forall a. (Eq a, Num a) => a
GL_RG_INTEGER
instance TextureFormat RGWord where
    getGlFormat :: RGWord -> GLenum
getGlFormat RGWord
_ = GLenum
forall a. (Eq a, Num a) => a
GL_RG_INTEGER

instance TextureFormat RGBFloat where
    getGlFormat :: RGBFloat -> GLenum
getGlFormat RGBFloat
_ = GLenum
forall a. (Eq a, Num a) => a
GL_RGB
instance TextureFormat RGBInt where
    getGlFormat :: RGBInt -> GLenum
getGlFormat RGBInt
_ = GLenum
forall a. (Eq a, Num a) => a
GL_RGB_INTEGER
instance TextureFormat RGBWord where
    getGlFormat :: RGBWord -> GLenum
getGlFormat RGBWord
_ = GLenum
forall a. (Eq a, Num a) => a
GL_RGB_INTEGER

instance TextureFormat RGBAFloat where
    getGlFormat :: RGBAFloat -> GLenum
getGlFormat RGBAFloat
_ = GLenum
forall a. (Eq a, Num a) => a
GL_RGBA
instance TextureFormat RGBAInt where
    getGlFormat :: RGBAInt -> GLenum
getGlFormat RGBAInt
_ = GLenum
forall a. (Eq a, Num a) => a
GL_RGBA_INTEGER
instance TextureFormat RGBAWord where
    getGlFormat :: RGBAWord -> GLenum
getGlFormat RGBAWord
_ = GLenum
forall a. (Eq a, Num a) => a
GL_RGBA_INTEGER

instance TextureFormat Depth where
    getGlFormat :: Depth -> GLenum
getGlFormat Depth
_ = GLenum
forall a. (Eq a, Num a) => a
GL_DEPTH_COMPONENT
instance TextureFormat DepthStencil where
    getGlFormat :: DepthStencil -> GLenum
getGlFormat DepthStencil
_ = GLenum
forall a. (Eq a, Num a) => a
GL_DEPTH_STENCIL

class TextureFormat f => ColorSampleable f where
    type Color f a
    type ColorElement f :: *
    typeStr :: f -> Text
    typeStr4 :: f -> Text
    toColor :: f -> V4 x -> Color f x
    fromColor :: f -> Color f x -> [x]
    setBorderColor :: f -> GLenum -> Color f (ColorElement f) -> IO ()
    samplerPrefix :: f -> Text
    typeStr = [Char] -> f -> Text
forall a. HasCallStack => [Char] -> a
error [Char]
"You cannot create your own instances of ColorSampleable"
    typeStr4 = [Char] -> f -> Text
forall a. HasCallStack => [Char] -> a
error [Char]
"You cannot create your own instances of ColorSampleable"
    toColor = [Char] -> f -> V4 x -> Color f x
forall a. HasCallStack => [Char] -> a
error [Char]
"You cannot create your own instances of ColorSampleable"
    fromColor = [Char] -> f -> Color f x -> [x]
forall a. HasCallStack => [Char] -> a
error [Char]
"You cannot create your own instances of ColorSampleable"
    setBorderColor = [Char] -> f -> GLenum -> Color f (ColorElement f) -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"You cannot create your own instances of ColorSampleable"
    samplerPrefix f
_ = Text
""

instance ColorSampleable RFloat where
    type Color RFloat a = a
    type ColorElement RFloat = Float
    typeStr :: RFloat -> Text
typeStr RFloat
_ = Text
"float"
    typeStr4 :: RFloat -> Text
typeStr4 RFloat
_ = Text
"vec4"
    toColor :: RFloat -> V4 x -> Color RFloat x
toColor RFloat
_ (V4 x
r x
_ x
_ x
_) = x
Color RFloat x
r
    fromColor :: RFloat -> Color RFloat x -> [x]
fromColor RFloat
_ Color RFloat x
r = [x
Color RFloat x
r]
    setBorderColor :: RFloat -> GLenum -> Color RFloat (ColorElement RFloat) -> IO ()
setBorderColor RFloat
_ GLenum
t Color RFloat (ColorElement RFloat)
r = [GLfloat] -> (Ptr GLfloat -> IO ()) -> IO ()
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [GLfloat -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac GLfloat
Color RFloat (ColorElement RFloat)
r, GLfloat
0,GLfloat
0,GLfloat
0] (GLenum -> GLenum -> Ptr GLfloat -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> Ptr GLfloat -> m ()
glTexParameterfv GLenum
t GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_BORDER_COLOR)
instance ColorSampleable RInt where
    type Color RInt a = a
    type ColorElement RInt = Int
    typeStr :: RInt -> Text
typeStr RInt
_ = Text
"int"
    typeStr4 :: RInt -> Text
typeStr4 RInt
_ = Text
"ivec4"
    toColor :: RInt -> V4 x -> Color RInt x
toColor RInt
_ (V4 x
r x
_ x
_ x
_) = x
Color RInt x
r
    fromColor :: RInt -> Color RInt x -> [x]
fromColor RInt
_ Color RInt x
r = [x
Color RInt x
r]
    setBorderColor :: RInt -> GLenum -> Color RInt (ColorElement RInt) -> IO ()
setBorderColor RInt
_ GLenum
t Color RInt (ColorElement RInt)
r = [GLint] -> (Ptr GLint -> IO ()) -> IO ()
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
Color RInt (ColorElement RInt)
r, GLint
0,GLint
0,GLint
0] (GLenum -> GLenum -> Ptr GLint -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> Ptr GLint -> m ()
glTexParameterIiv GLenum
t GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_BORDER_COLOR)
    samplerPrefix :: RInt -> Text
samplerPrefix RInt
_ = Text
"i"
instance ColorSampleable RWord where
    type Color RWord a = a
    type ColorElement RWord = Word
    typeStr :: RWord -> Text
typeStr RWord
_ = Text
"uint"
    typeStr4 :: RWord -> Text
typeStr4 RWord
_ = Text
"uvec4"
    toColor :: RWord -> V4 x -> Color RWord x
toColor RWord
_ (V4 x
r x
_ x
_ x
_) = x
Color RWord x
r
    fromColor :: RWord -> Color RWord x -> [x]
fromColor RWord
_ Color RWord x
r = [x
Color RWord x
r]
    setBorderColor :: RWord -> GLenum -> Color RWord (ColorElement RWord) -> IO ()
setBorderColor RWord
_ GLenum
t Color RWord (ColorElement RWord)
r = [GLenum] -> (Ptr GLenum -> IO ()) -> IO ()
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [Word -> GLenum
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
Color RWord (ColorElement RWord)
r, GLenum
0,GLenum
0,GLenum
0] (GLenum -> GLenum -> Ptr GLenum -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> Ptr GLenum -> m ()
glTexParameterIuiv GLenum
t GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_BORDER_COLOR)
    samplerPrefix :: RWord -> Text
samplerPrefix RWord
_ = Text
"u"

instance ColorSampleable RGFloat where
    type Color RGFloat a = V2 a
    type ColorElement RGFloat = Float
    typeStr :: RGFloat -> Text
typeStr RGFloat
_ = Text
"vec2"
    typeStr4 :: RGFloat -> Text
typeStr4 RGFloat
_ = Text
"vec4"
    toColor :: RGFloat -> V4 x -> Color RGFloat x
toColor RGFloat
_ (V4 x
r x
g x
_ x
_) = x -> x -> V2 x
forall a. a -> a -> V2 a
V2 x
r x
g
    fromColor :: RGFloat -> Color RGFloat x -> [x]
fromColor RGFloat
_ (V2 r g) = [x
r,x
g]
    setBorderColor :: RGFloat -> GLenum -> Color RGFloat (ColorElement RGFloat) -> IO ()
setBorderColor RGFloat
_ GLenum
t (V2 r g) = [GLfloat] -> (Ptr GLfloat -> IO ()) -> IO ()
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [GLfloat -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac GLfloat
r, GLfloat -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac GLfloat
g,GLfloat
0,GLfloat
0] (GLenum -> GLenum -> Ptr GLfloat -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> Ptr GLfloat -> m ()
glTexParameterfv GLenum
t GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_BORDER_COLOR)
instance ColorSampleable RGInt where
    type Color RGInt a = V2 a
    type ColorElement RGInt = Int
    typeStr :: RGInt -> Text
typeStr RGInt
_ = Text
"ivec2"
    typeStr4 :: RGInt -> Text
typeStr4 RGInt
_ = Text
"ivec4"
    toColor :: RGInt -> V4 x -> Color RGInt x
toColor RGInt
_ (V4 x
r x
g x
_ x
_) = x -> x -> V2 x
forall a. a -> a -> V2 a
V2 x
r x
g
    fromColor :: RGInt -> Color RGInt x -> [x]
fromColor RGInt
_ (V2 r g) = [x
r,x
g]
    setBorderColor :: RGInt -> GLenum -> Color RGInt (ColorElement RGInt) -> IO ()
setBorderColor RGInt
_ GLenum
t (V2 r g) = [GLint] -> (Ptr GLint -> IO ()) -> IO ()
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
r, Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
g,GLint
0,GLint
0] (GLenum -> GLenum -> Ptr GLint -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> Ptr GLint -> m ()
glTexParameterIiv GLenum
t GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_BORDER_COLOR)
    samplerPrefix :: RGInt -> Text
samplerPrefix RGInt
_ = Text
"i"
instance ColorSampleable RGWord where
    type Color RGWord a = V2 a
    type ColorElement RGWord = Word
    typeStr :: RGWord -> Text
typeStr RGWord
_ = Text
"uvec2"
    typeStr4 :: RGWord -> Text
typeStr4 RGWord
_ = Text
"uvec4"
    toColor :: RGWord -> V4 x -> Color RGWord x
toColor RGWord
_ (V4 x
r x
g x
_ x
_) = x -> x -> V2 x
forall a. a -> a -> V2 a
V2 x
r x
g
    fromColor :: RGWord -> Color RGWord x -> [x]
fromColor RGWord
_ (V2 r g) = [x
r,x
g]
    setBorderColor :: RGWord -> GLenum -> Color RGWord (ColorElement RGWord) -> IO ()
setBorderColor RGWord
_ GLenum
t (V2 r g) = [GLenum] -> (Ptr GLenum -> IO ()) -> IO ()
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [Word -> GLenum
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
r, Word -> GLenum
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
g,GLenum
0,GLenum
0] (GLenum -> GLenum -> Ptr GLenum -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> Ptr GLenum -> m ()
glTexParameterIuiv GLenum
t GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_BORDER_COLOR)
    samplerPrefix :: RGWord -> Text
samplerPrefix RGWord
_ = Text
"u"

instance ColorSampleable RGBFloat where
    type Color RGBFloat a = V3 a
    type ColorElement RGBFloat = Float
    typeStr :: RGBFloat -> Text
typeStr RGBFloat
_ = Text
"vec3"
    typeStr4 :: RGBFloat -> Text
typeStr4 RGBFloat
_ = Text
"vec4"
    toColor :: RGBFloat -> V4 x -> Color RGBFloat x
toColor RGBFloat
_ (V4 x
r x
g x
b x
_) = x -> x -> x -> V3 x
forall a. a -> a -> a -> V3 a
V3 x
r x
g x
b
    fromColor :: RGBFloat -> Color RGBFloat x -> [x]
fromColor RGBFloat
_ (V3 r g b) = [x
r,x
g,x
b]
    setBorderColor :: RGBFloat
-> GLenum -> Color RGBFloat (ColorElement RGBFloat) -> IO ()
setBorderColor RGBFloat
_ GLenum
t (V3 r g b) = [GLfloat] -> (Ptr GLfloat -> IO ()) -> IO ()
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [GLfloat -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac GLfloat
r, GLfloat -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac GLfloat
g, GLfloat -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac GLfloat
b,GLfloat
0] (GLenum -> GLenum -> Ptr GLfloat -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> Ptr GLfloat -> m ()
glTexParameterfv GLenum
t GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_BORDER_COLOR)
instance ColorSampleable RGBInt where
    type Color RGBInt a = V3 a
    type ColorElement RGBInt = Int
    typeStr :: RGBInt -> Text
typeStr RGBInt
_ = Text
"ivec3"
    typeStr4 :: RGBInt -> Text
typeStr4 RGBInt
_ = Text
"ivec4"
    toColor :: RGBInt -> V4 x -> Color RGBInt x
toColor RGBInt
_ (V4 x
r x
g x
b x
_) = x -> x -> x -> V3 x
forall a. a -> a -> a -> V3 a
V3 x
r x
g x
b
    fromColor :: RGBInt -> Color RGBInt x -> [x]
fromColor RGBInt
_ (V3 r g b) = [x
r,x
g,x
b]
    setBorderColor :: RGBInt -> GLenum -> Color RGBInt (ColorElement RGBInt) -> IO ()
setBorderColor RGBInt
_ GLenum
t (V3 r g b) = [GLint] -> (Ptr GLint -> IO ()) -> IO ()
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
r, Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
g, Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
b,GLint
0] (GLenum -> GLenum -> Ptr GLint -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> Ptr GLint -> m ()
glTexParameterIiv GLenum
t GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_BORDER_COLOR)
    samplerPrefix :: RGBInt -> Text
samplerPrefix RGBInt
_ = Text
"i"
instance ColorSampleable RGBWord where
    type Color RGBWord a = V3 a
    type ColorElement RGBWord = Word
    typeStr :: RGBWord -> Text
typeStr RGBWord
_ = Text
"uvec3"
    typeStr4 :: RGBWord -> Text
typeStr4 RGBWord
_ = Text
"uvec4"
    toColor :: RGBWord -> V4 x -> Color RGBWord x
toColor RGBWord
_ (V4 x
r x
g x
b x
_) = x -> x -> x -> V3 x
forall a. a -> a -> a -> V3 a
V3 x
r x
g x
b
    fromColor :: RGBWord -> Color RGBWord x -> [x]
fromColor RGBWord
_ (V3 r g b) = [x
r,x
g,x
b]
    setBorderColor :: RGBWord -> GLenum -> Color RGBWord (ColorElement RGBWord) -> IO ()
setBorderColor RGBWord
_ GLenum
t (V3 r g b) = [GLenum] -> (Ptr GLenum -> IO ()) -> IO ()
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [Word -> GLenum
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
r, Word -> GLenum
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
g, Word -> GLenum
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
b,GLenum
0] (GLenum -> GLenum -> Ptr GLenum -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> Ptr GLenum -> m ()
glTexParameterIuiv GLenum
t GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_BORDER_COLOR)
    samplerPrefix :: RGBWord -> Text
samplerPrefix RGBWord
_ = Text
"u"

instance ColorSampleable RGBAFloat where
    type Color RGBAFloat a = V4 a
    type ColorElement RGBAFloat = Float
    typeStr :: RGBAFloat -> Text
typeStr RGBAFloat
_ = Text
"vec4"
    typeStr4 :: RGBAFloat -> Text
typeStr4 RGBAFloat
_ = Text
"vec4"
    toColor :: RGBAFloat -> V4 x -> Color RGBAFloat x
toColor RGBAFloat
_ = V4 x -> Color RGBAFloat x
forall a. a -> a
id
    fromColor :: RGBAFloat -> Color RGBAFloat x -> [x]
fromColor RGBAFloat
_ (V4 r g b a) = [x
r,x
g,x
b,x
a]
    setBorderColor :: RGBAFloat
-> GLenum -> Color RGBAFloat (ColorElement RGBAFloat) -> IO ()
setBorderColor RGBAFloat
_ GLenum
t (V4 r g b a) = [GLfloat] -> (Ptr GLfloat -> IO ()) -> IO ()
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [GLfloat -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac GLfloat
r, GLfloat -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac GLfloat
g, GLfloat -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac GLfloat
b, GLfloat -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac GLfloat
a] (GLenum -> GLenum -> Ptr GLfloat -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> Ptr GLfloat -> m ()
glTexParameterfv GLenum
t GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_BORDER_COLOR)
instance ColorSampleable RGBAInt where
    type Color RGBAInt a = V4 a
    type ColorElement RGBAInt = Int
    typeStr :: RGBAInt -> Text
typeStr RGBAInt
_ = Text
"ivec4"
    typeStr4 :: RGBAInt -> Text
typeStr4 RGBAInt
_ = Text
"ivec4"
    toColor :: RGBAInt -> V4 x -> Color RGBAInt x
toColor RGBAInt
_ = V4 x -> Color RGBAInt x
forall a. a -> a
id
    fromColor :: RGBAInt -> Color RGBAInt x -> [x]
fromColor RGBAInt
_ (V4 r g b a) = [x
r,x
g,x
b,x
a]
    setBorderColor :: RGBAInt -> GLenum -> Color RGBAInt (ColorElement RGBAInt) -> IO ()
setBorderColor RGBAInt
_ GLenum
t (V4 r g b a) = [GLint] -> (Ptr GLint -> IO ()) -> IO ()
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
r, Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
g, Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
b, Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
a] (GLenum -> GLenum -> Ptr GLint -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> Ptr GLint -> m ()
glTexParameterIiv GLenum
t GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_BORDER_COLOR)
    samplerPrefix :: RGBAInt -> Text
samplerPrefix RGBAInt
_ = Text
"i"
instance ColorSampleable RGBAWord where
    type Color RGBAWord a = V4 a
    type ColorElement RGBAWord = Word
    typeStr :: RGBAWord -> Text
typeStr RGBAWord
_ = Text
"uvec4"
    typeStr4 :: RGBAWord -> Text
typeStr4 RGBAWord
_ = Text
"uvec4"
    toColor :: RGBAWord -> V4 x -> Color RGBAWord x
toColor RGBAWord
_ = V4 x -> Color RGBAWord x
forall a. a -> a
id
    fromColor :: RGBAWord -> Color RGBAWord x -> [x]
fromColor RGBAWord
_ (V4 r g b a) = [x
r,x
g,x
b,x
a]
    setBorderColor :: RGBAWord
-> GLenum -> Color RGBAWord (ColorElement RGBAWord) -> IO ()
setBorderColor RGBAWord
_ GLenum
t (V4 r g b a) = [GLenum] -> (Ptr GLenum -> IO ()) -> IO ()
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [Word -> GLenum
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
r, Word -> GLenum
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
g, Word -> GLenum
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
b, Word -> GLenum
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
a] (GLenum -> GLenum -> Ptr GLenum -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> Ptr GLenum -> m ()
glTexParameterIuiv GLenum
t GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_BORDER_COLOR)
    samplerPrefix :: RGBAWord -> Text
samplerPrefix RGBAWord
_ = Text
"u"

instance ColorSampleable Depth where
    type Color Depth a = a
    type ColorElement Depth = Float
    typeStr :: Depth -> Text
typeStr Depth
_ = Text
"float"
    typeStr4 :: Depth -> Text
typeStr4 Depth
_ = Text
"vec4"
    toColor :: Depth -> V4 x -> Color Depth x
toColor Depth
_ (V4 x
r x
_ x
_ x
_) = x
Color Depth x
r
    fromColor :: Depth -> Color Depth x -> [x]
fromColor Depth
_ Color Depth x
r = [x
Color Depth x
r]
    setBorderColor :: Depth -> GLenum -> Color Depth (ColorElement Depth) -> IO ()
setBorderColor Depth
_ GLenum
t Color Depth (ColorElement Depth)
r = [GLfloat] -> (Ptr GLfloat -> IO ()) -> IO ()
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [GLfloat -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac GLfloat
Color Depth (ColorElement Depth)
r, GLfloat
0,GLfloat
0,GLfloat
0] (GLenum -> GLenum -> Ptr GLfloat -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> Ptr GLfloat -> m ()
glTexParameterfv GLenum
t GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_BORDER_COLOR)
instance ColorSampleable DepthStencil where
    type Color DepthStencil a = a
    type ColorElement DepthStencil = Float
    typeStr :: DepthStencil -> Text
typeStr DepthStencil
_ = Text
"float"
    typeStr4 :: DepthStencil -> Text
typeStr4 DepthStencil
_ = Text
"vec4"
    toColor :: DepthStencil -> V4 x -> Color DepthStencil x
toColor DepthStencil
_ (V4 x
r x
_ x
_ x
_) = x
Color DepthStencil x
r
    fromColor :: DepthStencil -> Color DepthStencil x -> [x]
fromColor DepthStencil
_ Color DepthStencil x
r = [x
Color DepthStencil x
r]
    setBorderColor :: DepthStencil
-> GLenum
-> Color DepthStencil (ColorElement DepthStencil)
-> IO ()
setBorderColor DepthStencil
_ GLenum
t Color DepthStencil (ColorElement DepthStencil)
r = [GLfloat] -> (Ptr GLfloat -> IO ()) -> IO ()
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [GLfloat -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac GLfloat
Color DepthStencil (ColorElement DepthStencil)
r, GLfloat
0,GLfloat
0,GLfloat
0] (GLenum -> GLenum -> Ptr GLfloat -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> Ptr GLfloat -> m ()
glTexParameterfv GLenum
t GLenum
forall a. (Eq a, Num a) => a
GL_TEXTURE_BORDER_COLOR)

class ColorSampleable c => ColorRenderable c where
    isSrgb :: Format c -> Bool
    isSrgb Format c
_ = Bool
False
    clearColor :: c -> Color c (ColorElement c) -> IO ()
    clearColor = [Char] -> c -> Color c (ColorElement c) -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"You cannot create your own instances of ColorRenderable"
class ColorSampleable f => DepthRenderable f
class StencilRenderable f

instance ColorRenderable RFloat where
    clearColor :: RFloat -> Color RFloat (ColorElement RFloat) -> IO ()
clearColor RFloat
_ Color RFloat (ColorElement RFloat)
r = [GLfloat] -> (Ptr GLfloat -> IO ()) -> IO ()
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [GLfloat -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac GLfloat
Color RFloat (ColorElement RFloat)
r, GLfloat
0,GLfloat
0,GLfloat
0] (GLenum -> GLint -> Ptr GLfloat -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLint -> Ptr GLfloat -> m ()
glClearBufferfv GLenum
forall a. (Eq a, Num a) => a
GL_COLOR GLint
0)
instance ColorRenderable RInt where
    clearColor :: RInt -> Color RInt (ColorElement RInt) -> IO ()
clearColor RInt
_ Color RInt (ColorElement RInt)
r = [GLint] -> (Ptr GLint -> IO ()) -> IO ()
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
Color RInt (ColorElement RInt)
r, GLint
0,GLint
0,GLint
0] (GLenum -> GLint -> Ptr GLint -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLint -> Ptr GLint -> m ()
glClearBufferiv GLenum
forall a. (Eq a, Num a) => a
GL_COLOR GLint
0)
instance ColorRenderable RWord where
    clearColor :: RWord -> Color RWord (ColorElement RWord) -> IO ()
clearColor RWord
_ Color RWord (ColorElement RWord)
r = [GLenum] -> (Ptr GLenum -> IO ()) -> IO ()
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [Word -> GLenum
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
Color RWord (ColorElement RWord)
r, GLenum
0,GLenum
0,GLenum
0] (GLenum -> GLint -> Ptr GLenum -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLint -> Ptr GLenum -> m ()
glClearBufferuiv GLenum
forall a. (Eq a, Num a) => a
GL_COLOR GLint
0)
instance ColorRenderable RGFloat where
    clearColor :: RGFloat -> Color RGFloat (ColorElement RGFloat) -> IO ()
clearColor RGFloat
_ (V2 r g) = [GLfloat] -> (Ptr GLfloat -> IO ()) -> IO ()
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [GLfloat -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac GLfloat
r, GLfloat -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac GLfloat
g,GLfloat
0,GLfloat
0] (GLenum -> GLint -> Ptr GLfloat -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLint -> Ptr GLfloat -> m ()
glClearBufferfv GLenum
forall a. (Eq a, Num a) => a
GL_COLOR GLint
0)
instance ColorRenderable RGInt where
    clearColor :: RGInt -> Color RGInt (ColorElement RGInt) -> IO ()
clearColor RGInt
_ (V2 r g) = [GLint] -> (Ptr GLint -> IO ()) -> IO ()
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
r, Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
g,GLint
0,GLint
0] (GLenum -> GLint -> Ptr GLint -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLint -> Ptr GLint -> m ()
glClearBufferiv GLenum
forall a. (Eq a, Num a) => a
GL_COLOR GLint
0)
instance ColorRenderable RGWord where
    clearColor :: RGWord -> Color RGWord (ColorElement RGWord) -> IO ()
clearColor RGWord
_ (V2 r g) = [GLenum] -> (Ptr GLenum -> IO ()) -> IO ()
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [Word -> GLenum
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
r, Word -> GLenum
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
g,GLenum
0,GLenum
0] (GLenum -> GLint -> Ptr GLenum -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLint -> Ptr GLenum -> m ()
glClearBufferuiv GLenum
forall a. (Eq a, Num a) => a
GL_COLOR GLint
0)
instance ColorRenderable RGBFloat where
    isSrgb :: Format RGBFloat -> Bool
isSrgb Format RGBFloat
SRGB8 = Bool
True
    isSrgb Format RGBFloat
_     = Bool
False
    clearColor :: RGBFloat -> Color RGBFloat (ColorElement RGBFloat) -> IO ()
clearColor RGBFloat
_ (V3 r g b) = [GLfloat] -> (Ptr GLfloat -> IO ()) -> IO ()
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [GLfloat -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac GLfloat
r, GLfloat -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac GLfloat
g, GLfloat -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac GLfloat
b,GLfloat
0] (GLenum -> GLint -> Ptr GLfloat -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLint -> Ptr GLfloat -> m ()
glClearBufferfv GLenum
forall a. (Eq a, Num a) => a
GL_COLOR GLint
0)
instance ColorRenderable RGBInt where
    clearColor :: RGBInt -> Color RGBInt (ColorElement RGBInt) -> IO ()
clearColor RGBInt
_ (V3 r g b) = [GLint] -> (Ptr GLint -> IO ()) -> IO ()
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
r, Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
g, Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
b,GLint
0] (GLenum -> GLint -> Ptr GLint -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLint -> Ptr GLint -> m ()
glClearBufferiv GLenum
forall a. (Eq a, Num a) => a
GL_COLOR GLint
0)
instance ColorRenderable RGBWord where
    clearColor :: RGBWord -> Color RGBWord (ColorElement RGBWord) -> IO ()
clearColor RGBWord
_ (V3 r g b) = [GLenum] -> (Ptr GLenum -> IO ()) -> IO ()
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [Word -> GLenum
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
r, Word -> GLenum
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
g, Word -> GLenum
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
b,GLenum
0] (GLenum -> GLint -> Ptr GLenum -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLint -> Ptr GLenum -> m ()
glClearBufferuiv GLenum
forall a. (Eq a, Num a) => a
GL_COLOR GLint
0)
instance ColorRenderable RGBAFloat where
    isSrgb :: Format RGBAFloat -> Bool
isSrgb Format RGBAFloat
SRGB8A8 = Bool
True
    isSrgb Format RGBAFloat
_       = Bool
False
    clearColor :: RGBAFloat -> Color RGBAFloat (ColorElement RGBAFloat) -> IO ()
clearColor RGBAFloat
_ (V4 r g b a) = [GLfloat] -> (Ptr GLfloat -> IO ()) -> IO ()
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [GLfloat -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac GLfloat
r, GLfloat -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac GLfloat
g, GLfloat -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac GLfloat
b, GLfloat -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac GLfloat
a] (GLenum -> GLint -> Ptr GLfloat -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLint -> Ptr GLfloat -> m ()
glClearBufferfv GLenum
forall a. (Eq a, Num a) => a
GL_COLOR GLint
0)
instance ColorRenderable RGBAInt where
    clearColor :: RGBAInt -> Color RGBAInt (ColorElement RGBAInt) -> IO ()
clearColor RGBAInt
_ (V4 r g b a) = [GLint] -> (Ptr GLint -> IO ()) -> IO ()
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
r, Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
g, Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
b, Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
a] (GLenum -> GLint -> Ptr GLint -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLint -> Ptr GLint -> m ()
glClearBufferiv GLenum
forall a. (Eq a, Num a) => a
GL_COLOR GLint
0)
instance ColorRenderable RGBAWord where
    clearColor :: RGBAWord -> Color RGBAWord (ColorElement RGBAWord) -> IO ()
clearColor RGBAWord
_ (V4 r g b a) = [GLenum] -> (Ptr GLenum -> IO ()) -> IO ()
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [Word -> GLenum
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
r, Word -> GLenum
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
g, Word -> GLenum
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
b, Word -> GLenum
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
a] (GLenum -> GLint -> Ptr GLenum -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLint -> Ptr GLenum -> m ()
glClearBufferuiv GLenum
forall a. (Eq a, Num a) => a
GL_COLOR GLint
0)

instance DepthRenderable Depth
instance DepthRenderable DepthStencil

instance StencilRenderable Stencil
instance StencilRenderable DepthStencil


class ColorRenderable c => ContextColorFormat c where
    redBits :: Format c -> Int
    greenBits :: Format c -> Int
    blueBits :: Format c -> Int
    alphaBits :: Format c -> Int
    redBits = [Char] -> Format c -> Int
forall a. HasCallStack => [Char] -> a
error [Char]
"You cannot create your own instances of ContextColorFormat"
    greenBits = [Char] -> Format c -> Int
forall a. HasCallStack => [Char] -> a
error [Char]
"You cannot create your own instances of ContextColorFormat"
    blueBits = [Char] -> Format c -> Int
forall a. HasCallStack => [Char] -> a
error [Char]
"You cannot create your own instances of ContextColorFormat"
    alphaBits = [Char] -> Format c -> Int
forall a. HasCallStack => [Char] -> a
error [Char]
"You cannot create your own instances of ContextColorFormat"

instance ContextColorFormat RFloat where
    redBits :: Format RFloat -> Int
redBits Format RFloat
R8   = Int
8
    redBits Format RFloat
R8S  = Int
8
    redBits Format RFloat
R16  = Int
16
    redBits Format RFloat
R16S = Int
16
    redBits Format RFloat
R16F = Int
16
    redBits Format RFloat
R32F = Int
32
    greenBits :: Format RFloat -> Int
greenBits Format RFloat
_ = Int
0
    blueBits :: Format RFloat -> Int
blueBits Format RFloat
_ = Int
0
    alphaBits :: Format RFloat -> Int
alphaBits Format RFloat
_ = Int
0

instance ContextColorFormat RGFloat where
    redBits :: Format RGFloat -> Int
redBits Format RGFloat
RG8   = Int
8
    redBits Format RGFloat
RG8S  = Int
8
    redBits Format RGFloat
RG16  = Int
16
    redBits Format RGFloat
RG16S = Int
16
    redBits Format RGFloat
RG16F = Int
16
    redBits Format RGFloat
RG32F = Int
32
    greenBits :: Format RGFloat -> Int
greenBits = Format RGFloat -> Int
forall c. ContextColorFormat c => Format c -> Int
redBits
    blueBits :: Format RGFloat -> Int
blueBits Format RGFloat
_ = Int
0
    alphaBits :: Format RGFloat -> Int
alphaBits Format RGFloat
_ = Int
0

instance ContextColorFormat RGBFloat where
    redBits :: Format RGBFloat -> Int
redBits Format RGBFloat
R3G3B2       = Int
3
    redBits Format RGBFloat
RGB4         = Int
4
    redBits Format RGBFloat
RGB5         = Int
5
    redBits Format RGBFloat
RGB8         = Int
8
    redBits Format RGBFloat
RGB8S        = Int
8
    redBits Format RGBFloat
RGB10        = Int
10
    redBits Format RGBFloat
RGB12        = Int
12
    redBits Format RGBFloat
RGB16        = Int
16
    redBits Format RGBFloat
RGB16S       = Int
16
    redBits Format RGBFloat
RGB16F       = Int
16
    redBits Format RGBFloat
RGB32F       = Int
32
    redBits Format RGBFloat
R11FG11FB10F = Int
11
    redBits Format RGBFloat
RGB9E5       = Int
14 -- hmm...

    redBits Format RGBFloat
SRGB8        = Int
8
    greenBits :: Format RGBFloat -> Int
greenBits = Format RGBFloat -> Int
forall c. ContextColorFormat c => Format c -> Int
redBits
    blueBits :: Format RGBFloat -> Int
blueBits Format RGBFloat
R3G3B2       = Int
2
    blueBits Format RGBFloat
R11FG11FB10F = Int
10
    blueBits Format RGBFloat
x            = Format RGBFloat -> Int
forall c. ContextColorFormat c => Format c -> Int
redBits Format RGBFloat
x
    alphaBits :: Format RGBFloat -> Int
alphaBits Format RGBFloat
_ = Int
0

instance ContextColorFormat RGBAFloat where
    redBits :: Format RGBAFloat -> Int
redBits Format RGBAFloat
RGBA2   = Int
2
    redBits Format RGBAFloat
RGBA4   = Int
4
    redBits Format RGBAFloat
RGB5A1  = Int
5
    redBits Format RGBAFloat
RGBA8   = Int
8
    redBits Format RGBAFloat
RGBA8S  = Int
8
    redBits Format RGBAFloat
RGB10A2 = Int
10
    redBits Format RGBAFloat
RGBA12  = Int
12
    redBits Format RGBAFloat
RGBA16  = Int
16
    redBits Format RGBAFloat
RGBA16S = Int
16
    redBits Format RGBAFloat
RGBA16F = Int
16
    redBits Format RGBAFloat
RGBA32F = Int
32
    redBits Format RGBAFloat
SRGB8A8 = Int
8
    greenBits :: Format RGBAFloat -> Int
greenBits = Format RGBAFloat -> Int
forall c. ContextColorFormat c => Format c -> Int
redBits
    blueBits :: Format RGBAFloat -> Int
blueBits = Format RGBAFloat -> Int
forall c. ContextColorFormat c => Format c -> Int
redBits
    alphaBits :: Format RGBAFloat -> Int
alphaBits Format RGBAFloat
RGB5A1  = Int
1
    alphaBits Format RGBAFloat
RGB10A2 = Int
2
    alphaBits Format RGBAFloat
x       = Format RGBAFloat -> Int
forall c. ContextColorFormat c => Format c -> Int
redBits Format RGBAFloat
x

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


colorBits :: ContextColorFormat c => Format c -> (Int, Int, Int, Int, Bool)
colorBits :: Format c -> (Int, Int, Int, Int, Bool)
colorBits Format c
f = (Format c -> Int
forall c. ContextColorFormat c => Format c -> Int
redBits Format c
f, Format c -> Int
forall c. ContextColorFormat c => Format c -> Int
greenBits Format c
f, Format c -> Int
forall c. ContextColorFormat c => Format c -> Int
blueBits Format c
f, Format c -> Int
forall c. ContextColorFormat c => Format c -> Int
alphaBits Format c
f, Format c -> Bool
forall c. ColorRenderable c => Format c -> Bool
isSrgb Format c
f)

depthBits :: Format Depth  -> Int
depthBits :: Format Depth -> Int
depthBits Format Depth
Depth16  = Int
16
depthBits Format Depth
Depth24  = Int
24
depthBits Format Depth
Depth32  = Int
32
depthBits Format Depth
Depth32F = Int
32

stencilBits :: Format Stencil -> Int
stencilBits :: Format Stencil -> Int
stencilBits Format Stencil
Stencil1  = Int
1
stencilBits Format Stencil
Stencil4  = Int
4
stencilBits Format Stencil
Stencil8  = Int
8
stencilBits Format Stencil
Stencil16 = Int
16

depthStencilBits :: Format DepthStencil -> (Int, Int)
depthStencilBits :: Format DepthStencil -> (Int, Int)
depthStencilBits Format DepthStencil
Depth32FStencil8 = (Int
32, Int
8)
depthStencilBits Format DepthStencil
Depth24Stencil8  = (Int
24, Int
8)

data WindowFormat c ds where
    WindowFormatColor :: ContextColorFormat c => Format c -> WindowFormat c ()
    WindowFormatColorDepth :: ContextColorFormat c => Format c -> Format Depth -> WindowFormat c Depth
    WindowFormatColorStencil :: ContextColorFormat c => Format c -> Format Stencil -> WindowFormat c Stencil
    WindowFormatColorDepthStencilSeparate :: ContextColorFormat c => Format c -> Format Depth -> Format Stencil -> WindowFormat c DepthStencil
    WindowFormatColorDepthStencilCombined :: ContextColorFormat c => Format c -> Format DepthStencil -> WindowFormat c DepthStencil
    WindowFormatDepth :: Format Depth -> WindowFormat () Depth
    WindowFormatStencil :: Format Stencil -> WindowFormat () Stencil
    WindowFormatDepthStencilSeparate :: Format Depth -> Format Stencil -> WindowFormat () DepthStencil
    WindowFormatDepthStencilCombined :: Format DepthStencil -> WindowFormat () DepthStencil

type WindowBits = ((Int,Int,Int,Int,Bool),Int,Int)

windowBits :: WindowFormat c ds -> WindowBits
windowBits :: WindowFormat c ds -> WindowBits
windowBits (WindowFormatColor Format c
c) = (Format c -> (Int, Int, Int, Int, Bool)
forall c.
ContextColorFormat c =>
Format c -> (Int, Int, Int, Int, Bool)
colorBits Format c
c, Int
0, Int
0)
windowBits (WindowFormatColorDepth Format c
c Format Depth
d) = (Format c -> (Int, Int, Int, Int, Bool)
forall c.
ContextColorFormat c =>
Format c -> (Int, Int, Int, Int, Bool)
colorBits Format c
c, Format Depth -> Int
depthBits Format Depth
d, Int
0)
windowBits (WindowFormatColorStencil Format c
c Format Stencil
s) = (Format c -> (Int, Int, Int, Int, Bool)
forall c.
ContextColorFormat c =>
Format c -> (Int, Int, Int, Int, Bool)
colorBits Format c
c, Int
0, Format Stencil -> Int
stencilBits Format Stencil
s)
windowBits (WindowFormatColorDepthStencilSeparate Format c
c Format Depth
d Format Stencil
s) = (Format c -> (Int, Int, Int, Int, Bool)
forall c.
ContextColorFormat c =>
Format c -> (Int, Int, Int, Int, Bool)
colorBits Format c
c, Format Depth -> Int
depthBits Format Depth
d, Format Stencil -> Int
stencilBits Format Stencil
s)
windowBits (WindowFormatColorDepthStencilCombined Format c
c Format DepthStencil
ds) = let (Int
d,Int
s) = Format DepthStencil -> (Int, Int)
depthStencilBits Format DepthStencil
ds in (Format c -> (Int, Int, Int, Int, Bool)
forall c.
ContextColorFormat c =>
Format c -> (Int, Int, Int, Int, Bool)
colorBits Format c
c, Int
d, Int
s)
windowBits (WindowFormatDepth Format Depth
d) = ((Int
0,Int
0,Int
0,Int
0, Bool
False), Format Depth -> Int
depthBits Format Depth
d, Int
0)
windowBits (WindowFormatStencil Format Stencil
s) = ((Int
0,Int
0,Int
0,Int
0, Bool
False), Int
0, Format Stencil -> Int
stencilBits Format Stencil
s)
windowBits (WindowFormatDepthStencilSeparate Format Depth
d Format Stencil
s) = ((Int
0,Int
0,Int
0,Int
0, Bool
False), Format Depth -> Int
depthBits Format Depth
d, Format Stencil -> Int
stencilBits Format Stencil
s)
windowBits (WindowFormatDepthStencilCombined Format DepthStencil
ds) = let (Int
d,Int
s) = Format DepthStencil -> (Int, Int)
depthStencilBits Format DepthStencil
ds in ((Int
0,Int
0,Int
0,Int
0, Bool
False), Int
d, Int
s)