From ec087113f896ec91548efc72eaa7e25def645609 Mon Sep 17 00:00:00 2001 From: nek0 Date: Mon, 7 Dec 2020 00:26:17 +0100 Subject: [PATCH] preapare for textures --- src/Types/Graphics/Texture.hs | 93 +++++++++++++++++++++++++++++++++++ 1 file changed, 93 insertions(+) create mode 100644 src/Types/Graphics/Texture.hs diff --git a/src/Types/Graphics/Texture.hs b/src/Types/Graphics/Texture.hs new file mode 100644 index 0000000..7d2a312 --- /dev/null +++ b/src/Types/Graphics/Texture.hs @@ -0,0 +1,93 @@ +{-# 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 -> + 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_)