Haskell OpenGL textures with JuicyPixels and Cairo

Quick note post, I saw some stackoverflow questions of how to load OpenGL textures from JuicyPixels and I found one way to do it. Seems like an easy way to shuttle binary data between libraries is to use bytestrings, though you might end up with more copies in the process. Looking at some other libraries, you can probably use vector directly but that's a bit too advanced for me.

I just noticed in pasting this code that useAsCString will add a null terminator, which shouldn't be a problem, but it's a little odd for this application.

module TestGame.TextureLoading
where

import Codec.Picture
import qualified Data.ByteString
import qualified Data.ByteString.Lazy
import qualified Data.ByteString.Lazy.Builder as ByteString.Builder
import qualified Data.Vector.Storable
import Data.Monoid
import qualified Graphics.Rendering.OpenGL as OpenGL
import Data.Int

data Loaded2dTexture = Loaded2dTexture { width :: Int, 
                                         height::Int, 
                                         textureData :: Data.ByteString.ByteString}

loadTexture :: FilePath -> IO (Maybe Loaded2dTexture)
loadTexture filePath = do
    imageEither  <- readImage filePath
    case imageEither of
        Left error -> do
            putStrLn error
            return Nothing
        Right image -> return $ rawImage image

rawImage :: DynamicImage -> (Maybe Loaded2dTexture)
rawImage (ImageRGBA8 image) = Just $ rawImageRGBA8 $ flipImageVertically image
rawImage _ = Nothing

--OpenGL has y going up so this makes it convenient for 2d game images
flipImageVertically :: Image PixelRGBA8 -> Image PixelRGBA8
flipImageVertically image = generateImage (flippedPixel) 
                                          (imageWidth image) 
                                          (imageHeight image)
    where flippedPixel x y = pixelAt image x ((imageHeight image) - 1 - y)

rawImageRGBA8 :: Image PixelRGBA8 -> Loaded2dTexture
rawImageRGBA8 image =
    Loaded2dTexture{
        width = imageWidth image,
        height = imageHeight image,
        --JuicyPixels image data is packed from first component to last component, 
        --should not need endian conversion
        textureData = copyPixelDataToByteString (imageData image)}
                      
copyPixelDataToByteString imageData =  Data.ByteString.Lazy.toStrict $ 
                      ByteString.Builder.toLazyByteString $ 
                      Data.Vector.Storable.foldl' appendPixel 
                                                  (mempty :: ByteString.Builder.Builder) 
                                                  imageData

appendPixel :: ByteString.Builder.Builder -> (PixelBaseComponent PixelRGBA8) -> ByteString.Builder.Builder
appendPixel pixelBytes pixelComponent = pixelBytes `mappend` (ByteString.Builder.word8 pixelComponent)

uploadTexture :: Loaded2dTexture -> IO ()
uploadTexture texture = do
    uploadTextureT texture OpenGL.Texture2D


uploadTextureRectangle :: Loaded2dTexture -> IO ()
uploadTextureRectangle texture = do
    uploadTextureT texture OpenGL.TextureRectangle


uploadTextureT :: (OpenGL.TwoDimensionalTextureTarget t, OpenGL.ParameterizedTextureTarget t ) =>  
                  Loaded2dTexture -> t -> IO ()
uploadTextureT texture textureTarget = do
    Data.ByteString.useAsCString (textureData texture) $ \ texturePtr ->  do
            let (texWidth, texHeight) = ((fromIntegral $ width texture), (fromIntegral $ height texture))
            OpenGL.texImage2D textureTarget 
                              OpenGL.NoProxy 0 OpenGL.RGBA' 
                              (OpenGL.TextureSize2D texWidth texHeight) 0 
                              (OpenGL.PixelData OpenGL.RGBA OpenGL.UnsignedByte (texturePtr))
    OpenGL.textureFilter textureTarget OpenGL.$= ((OpenGL.Linear', Nothing), OpenGL.Linear')

Bytestrings also work for shuttling data from cairo (hoping to get diagram generated textures!) but cairo uses the host endian format. Little endian ARGB = BGRA. This one is ripped from some existing code so it's not a full example.

import qualified Graphics.UI.GLFW as GLFW
import qualified Graphics.Rendering.OpenGL as OpenGL
import qualified Graphics.Rendering.OpenGL.GLU as OpenGL.GLU
import qualified Graphics.Rendering.FTGL as FTGL
import Control.Monad
import qualified Control.Concurrent
import Foreign.C.Types
import qualified Graphics.Rendering.Cairo as Cairo
import qualified Data.ByteString
import qualified Foreign.Ptr
import qualified Data.Word
import qualified Data.ByteString.Lazy.Builder
import qualified Data.ByteString.Lazy
import qualified Data.Binary.Get
import Data.Monoid

loadTexture = do
        cairoTexture <- renderCairo
        OpenGL.textureBinding OpenGL.Texture2D OpenGL.$= Just textureName
        Data.ByteString.writeFile "texture.raw" cairoTexture
        Data.ByteString.useAsCString (hostEndianToLittleEndian cairoTexture) $ \ texturePtr ->  do
            OpenGL.texImage2D OpenGL.Texture2D OpenGL.NoProxy 0 
                              OpenGL.RGBA' (OpenGL.TextureSize2D 512 512) 0 
                              (OpenGL.PixelData OpenGL.BGRA OpenGL.UnsignedByte (texturePtr))
        OpenGL.textureFilter OpenGL.Texture2D OpenGL.$= ((OpenGL.Linear', Nothing), OpenGL.Linear')

hostEndianToLittleEndian :: Data.ByteString.ByteString -> Data.ByteString.ByteString
hostEndianToLittleEndian sourceByteString =
    let initialBuilder = mempty :: Data.ByteString.Lazy.Builder.Builder
        convert builder = do
            empty <- Data.Binary.Get.isEmpty
            if empty
                then return builder
                else do
                    word32 <- Data.Binary.Get.getWord32host
                    convert (builder `mappend` (Data.ByteString.Lazy.Builder.word32LE word32)  )
    in Data.ByteString.Lazy.toStrict $ 
       Data.ByteString.Lazy.Builder.toLazyByteString $ 
       Data.Binary.Get.runGet (convert initialBuilder) (Data.ByteString.Lazy.fromStrict sourceByteString)

renderCairo :: IO Data.ByteString.ByteString
renderCairo = do
    Cairo.withImageSurface Cairo.FormatARGB32 512 512 $ \surface -> do
        drawSurface surface
        Cairo.imageSurfaceGetData surface

drawSurface :: Cairo.Surface -> IO ()
drawSurface surface = do
    Cairo.renderWith surface $ do
        --Doing the y axis flip for OpenGL directly in cairo
        Cairo.scale 1.0 (-1.0)
        Cairo.translate 0 (-512)
        Cairo.rectangle 0 0 512 512
        Cairo.setSourceRGBA 0.0 0.0 0.0 0.0
        Cairo.fill
        Cairo.setSourceRGB 0.5 0.5 0.5
        Cairo.rectangle 0 0 10 10
        Cairo.fill
        Cairo.setLineWidth 10.0
        Cairo.setSourceRGB 1.0 0.0 0.0
        Cairo.rectangle  50 50 200 200
        Cairo.stroke

        roundRectPath 100 100 200 50 10
        Cairo.setSourceRGB 0.25 0.25 0.25
        Cairo.fill
        Cairo.setSourceRGB 0.0 1.0 1.0
        Cairo.moveTo 120 120
        Cairo.setFontSize 20
        Cairo.showText $ "Hello Cairo!"




        Cairo.surfaceFlush surface
    return ()

roundRectPath x y width height radius = do
    Cairo.newPath
    Cairo.arc (x+width-radius) (y+radius) radius  (3*pi/2) (2*pi)
    Cairo.arc (x+width-radius) (y+height-radius) radius 0  (pi/2.0)
    Cairo.arc (x+radius) (y+height-radius) radius (pi/2.0) (pi)
    Cairo.arc (x+radius) (y+radius) radius pi (3*pi/2)
    Cairo.closePath