preapare for textures

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_)