module Types.Texture where import SDL (($=), get) import qualified Graphics.Rendering.OpenGL as GL import SDL (($=), get) import Codec.Picture import Codec.Picture.Extra import Data.Vector.Storable (unsafeWith) import Linear import Foreign import Foreign.Ptr -- internal imports import Classes.Graphics.Bindable data Texture = Texture { textureId :: GL.TextureObject , textureSlot :: GL.TextureUnit } deriving (Eq, Show) instance Bindable Texture where bind t = do GL.activeTexture $= textureSlot t GL.textureBinding GL.Texture2D $= Just (textureId t) unbind t = GL.textureBinding GL.Texture2D $= Nothing newTexture :: FilePath -> GL.GLuint -> IO (V2 Word, Texture) newTexture fp slot = do -- read in image from filesystem img <- flipVertically <$> convertRGBA8 <$> either (\err -> error $ "reading image file " <> fp <> " failed: " <> err) 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.Repeat) GL.textureWrapMode GL.Texture2D GL.T $= (GL.Repeated, GL.Repeat) -- put data into GPU memory loadTexture tex dimensions data_ -- unbind texture unbind tex -- pass texture object out return (fmap fromIntegral dimensions, 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_)