module 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 Foreign.Ptr import Foreign.Marshal.Alloc (free) import Linear -- internal imports import BindableClass data Texture = Texture { texId :: GL.TextureObject , texSlot :: GL.TextureUnit -- , texPath :: FilePath -- , texDimensions :: V2 GL.GLsizei -- , texBPP :: Int -- , texData :: Ptr () } 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 Texture newTexture fp slot = do -- read in image from filesystem img <- flipVertically <$> convertRGBA8 <$> either (error $ "reading image file " <> fp <> " failed!") id <$> readImage fp -- 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 -- -- throw away the data on the CPU side -- free (texData tex) -- pass texture object out return 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_)