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) <*> (pure $ fmap fromIntegral $ V2 (imageWidth img) (imageHeight img)) <*> (pure $ componentCount (VS.head $ imageData img)) <*> (pure $ 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 -- unbind texture unbind tex -- -- throw away the data on the CPU side -- free (texData tex) -- pass texture object out return tex loadTexture :: Texture -> IO () loadTexture tex = let (V2 w h) = texDimensions tex in GL.texImage2D GL.Texture2D GL.NoProxy 0 GL.RGBA' (GL.TextureSize2D w h) 0 (GL.PixelData GL.RGBA GL.UnsignedByte (texData tex))