{-# LANGUAGE OverloadedStrings #-} module Graphics.Texture where import SDL (($=), get) import qualified Graphics.Rendering.OpenGL as GL import Codec.Picture import Codec.Picture.Extra import Data.Either import Data.Vector.Storable as VS import Data.String (fromString) import Foreign.Ptr import Foreign.Marshal.Alloc (free) import Linear -- internal imports import Classes.Graphics.Bindable data Texture = Texture { texId :: GL.TextureObject , texSlot :: GL.TextureUnit } instance Bindable Texture where bind t = do GL.activeTexture $= texSlot t GL.textureBinding GL.Texture2D $= Just (texId t) unbind _ = GL.textureBinding GL.Texture2D $= Nothing newTexture :: FilePath -> GL.GLuint -> IO (Either String Texture) newTexture fp slot = do eimg <- readImage fp case eimg of Left err -> do let mesg = ("reading file " <> fp <> " failed: " <> show err) logIO Error (fromString mesg) return $ Left mesg Right rawImg -> do -- convert image format let img = flipVertically $ convertRGBA8 rawImg -- extract the raw pointer from vector unsafeWith (imageData img) $ \ptr -> do -- create texture object tex <- Texture <$> GL.genObjectName <*> (pure $ GL.TextureUnit slot) -- <*> (pure fp) let dimensions = fromIntegral <$> V2 (imageWidth img) (imageHeight img) -- <*> (pure $ componentCount (VS.head $ imageData img)) data_ = castPtr ptr -- bind texture bind tex -- set texture parameters GL.textureFilter GL.Texture2D $= ((GL.Linear', Nothing), GL.Linear') GL.textureWrapMode GL.Texture2D GL.S $= (GL.Repeated, GL.Clamp) GL.textureWrapMode GL.Texture2D GL.T $= (GL.Repeated, GL.Clamp) -- put data into GPU memory loadTexture tex dimensions data_ -- unbind texture unbind tex -- pass texture object out return $ Right tex loadTexture :: Texture -> V2 GL.GLsizei -> Ptr () -> IO () loadTexture tex dimensions data_ = let (V2 w h) = dimensions in GL.texImage2D GL.Texture2D GL.NoProxy 0 GL.RGBA' (GL.TextureSize2D w h) 0 (GL.PixelData GL.RGBA GL.UnsignedByte data_)