{-# LANGUAGE UndecidableInstances #-} ----------------------------------------------------------------------------- -- -- Module : Formats -- Copyright : Tobias Bexelius -- License : BSD3 -- -- Maintainer : Tobias Bexelius -- Stability : Experimental -- Portability : Portable -- -- | -- ----------------------------------------------------------------------------- module Formats ( AlphaFormat(..), DepthFormat(..), StencilFormat(..), LuminanceFormat(..), LuminanceAlphaFormat(..), RGBFormat(..), RGBAFormat(..), CPUFormat4Comp(..), CPUFormat3Comp(..), CPUFormat2Comp(..), CPUFormat1Comp(..), StorableCPUFormat(toGLDataType), formatRowByteSize, GPUFormat(..), ColorFormat(fromColor,toColor), -- (..) will give a warning that Color is exported twice, even though we need to export it explicitly to get its constructors Color(..), Depth, Stencil ) where import qualified Graphics.Rendering.OpenGL as GL import Data.Vec ((:.)(..), Vec3, Vec4, zipWith) import Prelude hiding (zipWith) import Data.Boolean import Data.Vec.Boolean -- | A GPU format with only an alpha value. -- These are the associated types in 'GPUFormat' and 'ColorFormat': -- -- [@CPUFormat AlphaFormat@] 'CPUFormat1Comp' -- -- [@Color AlphaFormat a@] @Alpha a@ data AlphaFormat = Alpha4 | Alpha8 | Alpha12 | Alpha16 deriving (Eq,Ord,Bounded,Enum,Show) -- | A GPU format with a single color component. -- These are the associated types in 'GPUFormat' and 'ColorFormat': -- -- [@CPUFormat LuminanceFormat@] 'CPUFormat1Comp' -- -- [@Color LuminanceFormat a@] @Luminance a@ data LuminanceFormat = Luminance4 | Luminance8 | Luminance12 | Luminance16 | SLuminance8 deriving (Eq,Ord,Bounded,Enum,Show) -- | A GPU format with a single color component and an alpha value. -- These are the associated types in 'GPUFormat' and 'ColorFormat': -- -- [@CPUFormat LuminanceAlphaFormat@] 'CPUFormat2Comp' -- -- [@Color LuminanceAlphaFormat a@] @LuminanceAlpha a a@ data LuminanceAlphaFormat = Luminance4Alpha4 | Luminance6Alpha2 | Luminance8Alpha8 | Luminance12Alpha4 | Luminance12Alpha12 | Luminance16Alpha16 | SLuminance8Alpha8 deriving (Eq,Ord,Bounded,Enum,Show) -- | A GPU format with color components for red, green and blue. -- These are the associated types in 'GPUFormat' and 'ColorFormat': -- -- [@CPUFormat RGBFormat@] 'CPUFormat3Comp' -- -- [@Color RGBFormat a@] @RGB (@'Vec3'@ a)@ data RGBFormat = R3G3B2 | RGB4 | RGB5 | RGB8 | RGB10 | RGB12 | RGB16 | SRGB8 deriving (Eq,Ord,Bounded,Enum,Show) -- | A GPU format with color components for red, green and blue, and an alpha value. -- These are the associated types in 'GPUFormat' and 'ColorFormat': -- -- [@CPUFormat RGBAFormat@] 'CPUFormat4Comp' -- -- [@Color RGBAFormat a@] @RGBA (@'Vec3'@ a) a@ data RGBAFormat = RGBA2 | RGBA4 | RGB5A1 | RGBA8 | RGB10A2 | RGBA12 | RGBA16 | SRGBA8 deriving (Eq,Ord,Bounded,Enum,Show) -- | A GPU format for a depth buffer value. -- This is the associated type in 'GPUFormat': -- -- [@CPUFormat DepthFormat@] 'CPUFormat1Comp' data DepthFormat = Depth16 | Depth24 | Depth32 deriving (Eq,Ord,Bounded,Enum,Show) -- | A GPU format for a stencil buffer value. -- This is the associated type in 'GPUFormat': -- -- [@CPUFormat StencilFormat@] 'CPUFormat1Comp' data StencilFormat = StencilFormat deriving (Eq,Ord,Bounded,Enum,Show) -- | A CPU format for 4 components (i.e. a RGBA color). data CPUFormat4Comp = PerComp4 CPUFormat1Comp | UnsignedShort4_4_4_4 | UnsignedShort4_4_4_4_Rev | UnsignedShort5_5_5_1 | UnsignedShort1_5_5_5_Rev | UnsignedInt8_8_8_8 | UnsignedInt8_8_8_8_Rev | UnsignedInt10_10_10_2 | UnsignedInt2_10_10_10_Rev deriving (Eq,Ord,Show) -- | A CPU format for 3 components (i.e. a RGB color). data CPUFormat3Comp = PerComp3 CPUFormat1Comp | UnsignedByte3_3_2 | UnsignedByte2_3_3_Rev | UnsignedShort5_6_5 | UnsignedShort5_6_5_Rev deriving (Eq,Ord,Show) -- | A CPU format for 2 components (i.e. a LuminanceAlpha color). data CPUFormat2Comp = PerComp2 CPUFormat1Comp deriving (Eq,Ord,Show) -- | A CPU format for 1 component data CPUFormat1Comp = UnsignedByteFormat | BitmapFormat | ByteFormat | UnsignedShortFormat | ShortFormat | UnsignedIntFormat | IntFormat | FloatFormat deriving (Eq,Ord,Show) class StorableCPUFormat a where sizeOfFormat :: a -> Int toGLDataType :: a -> GL.DataType formatRowByteSize :: StorableCPUFormat a => a -> Int -> Int formatRowByteSize f x = (x*sizeOfFormat f-1) `div` 8 + 1 instance StorableCPUFormat CPUFormat4Comp where sizeOfFormat (PerComp4 a) = 4 * sizeOfFormat a sizeOfFormat UnsignedShort4_4_4_4 = 16 sizeOfFormat UnsignedShort4_4_4_4_Rev = 16 sizeOfFormat UnsignedShort5_5_5_1 = 16 sizeOfFormat UnsignedShort1_5_5_5_Rev = 16 sizeOfFormat UnsignedInt8_8_8_8 = 32 sizeOfFormat UnsignedInt8_8_8_8_Rev = 32 sizeOfFormat UnsignedInt10_10_10_2 = 32 sizeOfFormat UnsignedInt2_10_10_10_Rev = 32 toGLDataType (PerComp4 a) = toGLDataType a toGLDataType UnsignedShort4_4_4_4 = GL.UnsignedShort4444 toGLDataType UnsignedShort4_4_4_4_Rev = GL.UnsignedShort4444Rev toGLDataType UnsignedShort5_5_5_1 = GL.UnsignedShort5551 toGLDataType UnsignedShort1_5_5_5_Rev = GL.UnsignedShort1555Rev toGLDataType UnsignedInt8_8_8_8 = GL.UnsignedInt8888 toGLDataType UnsignedInt8_8_8_8_Rev = GL.UnsignedInt8888Rev toGLDataType UnsignedInt10_10_10_2 = GL.UnsignedInt1010102 toGLDataType UnsignedInt2_10_10_10_Rev = GL.UnsignedInt2101010Rev instance StorableCPUFormat CPUFormat3Comp where sizeOfFormat (PerComp3 a) = 3 * sizeOfFormat a sizeOfFormat UnsignedByte3_3_2 = 8 sizeOfFormat UnsignedByte2_3_3_Rev = 8 sizeOfFormat UnsignedShort5_6_5 = 16 sizeOfFormat UnsignedShort5_6_5_Rev = 16 toGLDataType (PerComp3 a) = toGLDataType a toGLDataType UnsignedByte3_3_2 = GL.UnsignedByte332 toGLDataType UnsignedByte2_3_3_Rev = GL.UnsignedByte233Rev toGLDataType UnsignedShort5_6_5 = GL.UnsignedShort565 toGLDataType UnsignedShort5_6_5_Rev = GL.UnsignedShort565Rev instance StorableCPUFormat CPUFormat2Comp where sizeOfFormat (PerComp2 a) = 2 * sizeOfFormat a toGLDataType (PerComp2 a) = toGLDataType a instance StorableCPUFormat CPUFormat1Comp where sizeOfFormat UnsignedByteFormat = 8 sizeOfFormat BitmapFormat = 1 sizeOfFormat ByteFormat = 8 sizeOfFormat UnsignedShortFormat = 16 sizeOfFormat ShortFormat = 16 sizeOfFormat UnsignedIntFormat = 32 sizeOfFormat IntFormat = 32 sizeOfFormat FloatFormat = 32 toGLDataType UnsignedByteFormat = GL.UnsignedByte toGLDataType BitmapFormat = GL.Bitmap toGLDataType ByteFormat = GL.Byte toGLDataType UnsignedShortFormat = GL.UnsignedShort toGLDataType ShortFormat = GL.Short toGLDataType UnsignedIntFormat = GL.UnsignedInt toGLDataType IntFormat = GL.Int toGLDataType FloatFormat = GL.Float class (StorableCPUFormat (CPUFormat f), Eq (CPUFormat f))=> GPUFormat f where type CPUFormat f toGLInternalFormat :: f -> GL.PixelInternalFormat toGLPixelFormat :: f -> GL.PixelFormat -- | This context is used to select which types can be used in a frame buffers color buffer, and also -- to restrict the type of a texture. class GPUFormat f => ColorFormat f where data Color f :: * -> * fromColor :: a -> a -> Color f a -> Vec4 a toColor :: Vec4 a -> Color f a type Depth = Float type Stencil = Int instance GPUFormat AlphaFormat where type CPUFormat AlphaFormat = CPUFormat1Comp toGLInternalFormat Alpha4 = GL.Alpha4 toGLInternalFormat Alpha8 = GL.Alpha8 toGLInternalFormat Alpha12 = GL.Alpha12 toGLInternalFormat Alpha16 = GL.Alpha16 toGLPixelFormat _ = GL.Alpha instance GPUFormat DepthFormat where type CPUFormat DepthFormat = CPUFormat1Comp toGLInternalFormat Depth16 = GL.DepthComponent16 toGLInternalFormat Depth24 = GL.DepthComponent24 toGLInternalFormat Depth32 = GL.DepthComponent32 toGLPixelFormat _ = GL.DepthComponent instance GPUFormat StencilFormat where type CPUFormat StencilFormat = CPUFormat1Comp toGLInternalFormat = error "Stencil has no GLFormat" toGLPixelFormat _ = GL.StencilIndex instance GPUFormat LuminanceFormat where type CPUFormat LuminanceFormat = CPUFormat1Comp toGLInternalFormat Luminance4 = GL.Luminance4 toGLInternalFormat Luminance8 = GL.Luminance8 toGLInternalFormat Luminance12 = GL.Luminance12 toGLInternalFormat Luminance16 = GL.Luminance16 toGLInternalFormat SLuminance8 = GL.SLuminance8 toGLPixelFormat _ = GL.Luminance instance GPUFormat LuminanceAlphaFormat where type CPUFormat LuminanceAlphaFormat = CPUFormat2Comp toGLInternalFormat Luminance4Alpha4 = GL.Luminance4Alpha4 toGLInternalFormat Luminance6Alpha2 = GL.Luminance6Alpha2 toGLInternalFormat Luminance8Alpha8 = GL.Luminance8Alpha8 toGLInternalFormat Luminance12Alpha4 = GL.Luminance12Alpha4 toGLInternalFormat Luminance12Alpha12 = GL.Luminance12Alpha12 toGLInternalFormat Luminance16Alpha16 = GL.Luminance16Alpha16 toGLInternalFormat SLuminance8Alpha8 = GL.SLuminance8Alpha8 toGLPixelFormat _ = GL.LuminanceAlpha instance GPUFormat RGBFormat where type CPUFormat RGBFormat = CPUFormat3Comp toGLInternalFormat R3G3B2 = GL.R3G3B2 toGLInternalFormat RGB4 = GL.RGB4 toGLInternalFormat RGB5 = GL.RGB5 toGLInternalFormat RGB8 = GL.RGB8 toGLInternalFormat RGB10 = GL.RGB10 toGLInternalFormat RGB12 = GL.RGB12 toGLInternalFormat RGB16 = GL.RGB16 toGLInternalFormat SRGB8 = GL.SRGB8 toGLPixelFormat _ = GL.RGB instance GPUFormat RGBAFormat where type CPUFormat RGBAFormat = CPUFormat4Comp toGLInternalFormat RGBA2 = GL.RGBA2 toGLInternalFormat RGBA4 = GL.RGBA4 toGLInternalFormat RGB5A1 = GL.RGB5A1 toGLInternalFormat RGBA8 = GL.RGBA8 toGLInternalFormat RGB10A2 = GL.RGB10A2 toGLInternalFormat RGBA12 = GL.RGBA12 toGLInternalFormat RGBA16 = GL.RGBA16 toGLInternalFormat SRGBA8 = GL.SRGB8Alpha8 toGLPixelFormat _ = GL.RGBA instance ColorFormat AlphaFormat where data Color AlphaFormat a = Alpha a deriving (Eq,Ord,Show) fromColor x _ (Alpha a) = x:.x:.x:.a:.() toColor (_:._:._:.d:.()) = Alpha d instance ColorFormat LuminanceFormat where data Color LuminanceFormat a = Luminance a deriving (Eq,Ord,Show) fromColor x w (Luminance a) = a:.x:.x:.w:.() toColor (a:._:._:._:.()) = Luminance a instance ColorFormat LuminanceAlphaFormat where data Color LuminanceAlphaFormat a = LuminanceAlpha a a deriving (Eq,Ord,Show) fromColor x _ (LuminanceAlpha a b) = a:.x:.x:.b:.() toColor (a:._:._:.d:.()) = LuminanceAlpha a d instance ColorFormat RGBFormat where data Color RGBFormat a = RGB (Vec3 a) deriving (Eq,Ord,Show) fromColor _ w (RGB (a:.b:.c:.())) = a:.b:.c:.w:.() toColor (a:.b:.c:._:.()) = RGB $ a:.b:.c:.() instance ColorFormat RGBAFormat where data Color RGBAFormat a = RGBA (Vec3 a) a deriving (Eq,Ord,Show) fromColor _ _ (RGBA (a:.b:.c:.()) d) = a:.b:.c:.d:.() toColor (a:.b:.c:.d:.()) = RGBA (a:.b:.c:.()) d instance IfB bool a => IfB bool (Color AlphaFormat a) where ifB c (Alpha t) (Alpha e) = Alpha (ifB c t e) instance IfB bool a => IfB bool (Color LuminanceFormat a) where ifB c (Luminance t) (Luminance e) = Luminance (ifB c t e) instance IfB bool a => IfB bool (Color LuminanceAlphaFormat a) where ifB c (LuminanceAlpha t1 t2) (LuminanceAlpha e1 e2) = LuminanceAlpha (ifB c t1 e1) (ifB c t2 e2) instance IfB bool a => IfB bool (Color RGBFormat a) where ifB c (RGB t) (RGB e) = RGB (ifB c t e) instance IfB bool a => IfB bool (Color RGBAFormat a) where ifB c (RGBA t1 t2) (RGBA e1 e2) = RGBA (ifB c t1 e1) (ifB c t2 e2)