summaryrefslogtreecommitdiff
path: root/Backend/GL/Data.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Backend/GL/Data.hs')
-rw-r--r--Backend/GL/Data.hs26
1 files changed, 22 insertions, 4 deletions
diff --git a/Backend/GL/Data.hs b/Backend/GL/Data.hs
index 4eb3fa0..2c6e596 100644
--- a/Backend/GL/Data.hs
+++ b/Backend/GL/Data.hs
@@ -19,7 +19,7 @@ import qualified Data.Vector.Storable as SV
19import Graphics.Rendering.OpenGL.Raw.Core33 19import Graphics.Rendering.OpenGL.Raw.Core33
20import Data.Word 20import Data.Word
21import Codec.Picture 21import Codec.Picture
22import Codec.Picture.RGBA8 22import Codec.Picture.Types
23 23
24import Backend.GL.Type 24import Backend.GL.Type
25import Backend.GL.Util 25import Backend.GL.Util
@@ -60,8 +60,26 @@ arrayType buf arrIdx = arrType $! bufArrays buf V.! arrIdx
60 60
61-- FIXME: Temporary implemenation 61-- FIXME: Temporary implemenation
62compileTexture2DRGBAF :: Bool -> Bool -> DynamicImage -> IO TextureData 62compileTexture2DRGBAF :: Bool -> Bool -> DynamicImage -> IO TextureData
63compileTexture2DRGBAF isMip isClamped bitmap' = do 63compileTexture2DRGBAF = compileTexture2DRGBAF' False
64 let bitmap = ImageRGBA8 $ fromDynamicImage bitmap' 64
65compileTexture2DRGBAF' :: Bool -> Bool -> Bool -> DynamicImage -> IO TextureData
66compileTexture2DRGBAF' isSRGB isMip isClamped bitmap' = do
67 let bitmap = case bitmap' of
68 ImageRGB8 i@(Image w h _) -> bitmap' -- pixelFoldMap (\(PixelRGB8 r g b) -> [PixelRGBA8 r g b maxBound]) i
69 ImageRGBA8 i@(Image w h _) -> bitmap' -- pixelFoldMap (\(PixelRGBA8 r g b a) -> [PixelRGBA8 r g b a]) i
70 ImageYCbCr8 i@(Image w h _) -> ImageRGB8 $ convertImage i -- $ Image w h $ SV.fromList $ pixelFoldMap (\p -> let PixelRGB8 r g b = convertPixel p in [PixelRGBA8 r g b maxBound]) i
71 ImageCMYK16 _ -> error "compileTexture2DRGBAF: ImageCMYK16"
72 ImageCMYK8 _ -> error "compileTexture2DRGBAF: ImageCMYK8"
73 ImageRGBA16 _ -> error "compileTexture2DRGBAF: ImageRGBA16"
74 ImageRGBF _ -> error "compileTexture2DRGBAF: ImageRGBF"
75 ImageRGB16 _ -> error "compileTexture2DRGBAF: ImageRGB16"
76 ImageYA16 _ -> error "compileTexture2DRGBAF: ImageYA16"
77 ImageYA8 _ -> error "compileTexture2DRGBAF: ImageYA8"
78 ImageYF _ -> error "compileTexture2DRGBAF: ImageYF"
79 ImageY16 _ -> error "compileTexture2DRGBAF: ImageY16"
80 ImageY8 _ -> error "compileTexture2DRGBAF: ImageY8"
81 _ -> error "compileTexture2DRGBAF: unknown image"
82
65 glPixelStorei gl_UNPACK_ALIGNMENT 1 83 glPixelStorei gl_UNPACK_ALIGNMENT 1
66 to <- alloca $! \pto -> glGenTextures 1 pto >> peek pto 84 to <- alloca $! \pto -> glGenTextures 1 pto >> peek pto
67 glBindTexture gl_TEXTURE_2D to 85 glBindTexture gl_TEXTURE_2D to
@@ -85,7 +103,7 @@ compileTexture2DRGBAF isMip isClamped bitmap' = do
85 glTexParameteri gl_TEXTURE_2D gl_TEXTURE_BASE_LEVEL 0 103 glTexParameteri gl_TEXTURE_2D gl_TEXTURE_BASE_LEVEL 0
86 glTexParameteri gl_TEXTURE_2D gl_TEXTURE_MAX_LEVEL $ fromIntegral maxLevel 104 glTexParameteri gl_TEXTURE_2D gl_TEXTURE_MAX_LEVEL $ fromIntegral maxLevel
87 withBitmap bitmap $ \(w,h) nchn 0 ptr -> do 105 withBitmap bitmap $ \(w,h) nchn 0 ptr -> do
88 let internalFormat = fromIntegral gl_RGBA8 106 let internalFormat = fromIntegral $ if isSRGB then (if nchn == 3 then gl_SRGB8 else gl_SRGB8_ALPHA8) else (if nchn == 3 then gl_RGB8 else gl_RGBA8)
89 dataFormat = fromIntegral $ case nchn of 107 dataFormat = fromIntegral $ case nchn of
90 3 -> gl_RGB 108 3 -> gl_RGB
91 4 -> gl_RGBA 109 4 -> gl_RGBA