2 files changed, 31 insertions(+), 16 deletions(-)

M lib/Graphics/Rendering/Rect/Image.hs
M lib/Graphics/Rendering/Rect/Types.hs

@@ 4,9 4,9 @@ module Graphics.Rendering.Rect.Image(
 
 import qualified Data.HashMap.Lazy as HM
 import Data.Text (Text)
-import Codec.Picture (DynamicImage(..), Image(..), PixelRGBA8(..), PixelYCbCr8(..),
+import Codec.Picture (DynamicImage(..), Image(..), PixelRGBA8(..), PixelF,
                         pixelMap, generateImage)
-import Codec.Picture.Types (promoteImage, dynamicMap)
+import Codec.Picture.Types (promoteImage, dynamicMap, convertImage)
 
 import Control.Monad.IO.Class (MonadIO(..))
 import Control.Monad (forM)


@@ 37,13 37,13 @@ buildAtlas cb srcs = do
 
     forM (zip textures imgs) $ \(texture, dyn) -> do
         -- NOTE: `unsafe` crashes with a divide-by-zero given a `Vector ()`
-        let img = dynamicMap (unsafeCast . imageData) $ adjustGL dyn :: Vector Word
-        let (format, word) = glFormat dyn
+        let dyn' = convertDyn dyn
+        let img = dynamicMap (unsafeCast . imageData) dyn' :: Vector Word
+        let (format, word) = glFormat dyn'
         liftIO $ glBindTexture GL_TEXTURE_2D texture
-        liftIO $ unsafeWith img $ -- FIXME: Crashes
-            glTexImage2D GL_TEXTURE_2D 0 GL_RGBA
-                    (toEnum $ dynamicMap imageWidth dyn)
-                    (toEnum $ dynamicMap imageHeight dyn)
+        liftIO $ unsafeWith img $ glTexImage2D GL_TEXTURE_2D 0 GL_RGBA
+                    (toEnum $ dynamicMap imageWidth dyn')
+                    (toEnum $ dynamicMap imageHeight dyn')
                     0 format word . castPtr
         liftIO $ glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER GL_LINEAR
         liftIO $ glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER GL_LINEAR


@@ 52,14 52,29 @@ buildAtlas cb srcs = do
 
     return $ Atlas $ HM.fromList $ zip srcs textures
 
-data Texture = Texture GLuint
+data Texture = Texture { unTexture :: GLuint }
 atlasLookup :: Text -> Atlas -> Texture
 atlasLookup key = Texture . fromMaybe 0 . HM.lookup key . unAtlas
 
 -- OpenGL deals in CrCb not CbCr...
-adjustGL (ImageYCbCr8 img) = ImageYCbCr8 $ pixelMap swapCrCb img
-  where swapCrCb (PixelYCbCr8 y cb cr) = PixelYCbCr8 y cr cb
-adjustGL img = img
+-- Convert pixels to some flavour of RGBA
+convertDyn :: DynamicImage -> DynamicImage
+convertDyn (ImageY8 img) = ImageRGBA8 $ promoteImage img
+convertDyn (ImageY16 img) = ImageRGBA16 $ promoteImage img
+convertDyn (ImageY32 img) =
+    ImageRGBF $ promoteImage (pixelMap fromIntegral img :: Image PixelF)
+convertDyn (ImageYF img) = ImageRGBF $ promoteImage img
+convertDyn (ImageYA8 img) = ImageRGBA8 $ promoteImage img
+convertDyn (ImageYA16 img) = ImageRGBA16 $ promoteImage img
+convertDyn (ImageRGB8 img) = ImageRGB8 img
+convertDyn (ImageRGB16 img) = ImageRGB16 img
+convertDyn (ImageRGBF img) = ImageRGBF img
+convertDyn (ImageRGBA8 img) = ImageRGBA8 img
+convertDyn (ImageRGBA16 img) = ImageRGBA16 img
+convertDyn (ImageYCbCr8 img) = ImageRGB8 $ convertImage img
+convertDyn (ImageCMYK8 img) = ImageRGB8 $ convertImage img
+convertDyn (ImageCMYK16 img) = ImageRGB16 $ convertImage img
+
 glFormat (ImageY8 _) = (GL_LUMINANCE, GL_UNSIGNED_BYTE)
 glFormat (ImageY16 _) = (GL_LUMINANCE, GL_UNSIGNED_SHORT)
 glFormat (ImageY32 _) = (GL_LUMINANCE, GL_UNSIGNED_INT)

@@ 102,11 102,11 @@ renderRectWith fragmentShader uniformNames = do
         liftIO $ updateUniform prog matID $ mflip mat
         liftIO $ updateUniform prog originID $ V2 (left rect) (top rect)
         forM (zip uniformIDs uniforms) $ \(slot, cb) -> cb prog slot
-        forM textures $ \(Texture texture) -> glBindTexture GL_TEXTURE_2D texture
 
-        glBindVertexArray vao
-        drawVAO prog vao GL_TRIANGLES 6 -- 2 triangles
-        glBindVertexArray 0
+        withBoundTextures (map unTexture textures) $ do
+            glBindVertexArray vao
+            drawVAO prog vao GL_TRIANGLES 6 -- 2 triangles
+            glBindVertexArray 0
 
         liftIO $ withArray [pbuf] $ glDeleteBuffers 1
         liftIO $ withArray [vao] $ glDeleteVertexArrays 1