get textures halfway working

renderer-tutorial.cabal

@@ -24,8 +24,11 @@ executable renderer-tutorial
                      , OpenGLRaw
                      , sdl2 >= 2.5.0.0
                      , bytestring
+                     , vector
+                     , linear
                      , monad-loops
                      , random
+                     , JuicyPixels
   other-modules:       BindableClass
                      , BufferClass
                      , VertexBuffer
@@ -33,5 +36,6 @@ executable renderer-tutorial
                      , IndexBuffer
                      , Shader
                      , Renderer
+                     , Texture
   hs-source-dirs:      src
   default-language:    Haskell2010

res/shaders/frag.shader

@@ -1,10 +1,14 @@
 #version 330 core
 
-out vec4 color;
+layout(location = 0) out vec4 color;
+
+in vec2 v_texCoord;
 
 uniform vec4 u_color;
+uniform sampler2D u_texture;
 
 void main()
 {
-  color = u_color;
+  vec4 texColor = texture(u_texture, v_texCoord);
+  color = texColor;
 }

res/shaders/vert.shader

@@ -1,8 +1,12 @@
 #version 330 core
 
-layout(location = 0) in vec4 position;
+layout(location = 0) in vec3 position;
+layout(location = 1) in vec2 texCoord;
+
+out vec2 v_texCoord;
 
 void main()
 {
   gl_Position = position;
+  v_texCoord = texCoord;
 }

shell.nix

@@ -4,17 +4,18 @@ let
 
   inherit (nixpkgs) pkgs;
 
-  f = { mkDerivation, base, bytestring, monad-loops, OpenGL
+  f = { mkDerivation, base, bytestring, JuicyPixels, linear
-      , OpenGLRaw, random, sdl2, stdenv
+      , monad-loops, OpenGL, OpenGLRaw, random, sdl2, stdenv, vector
       }:
       mkDerivation {
-        pname = "renderer";
+        pname = "renderer-tutorial";
         version = "0.0.0.0";
         src = ./.;
         isLibrary = false;
         isExecutable = true;
         executableHaskellDepends = [
-          base bytestring monad-loops OpenGL OpenGLRaw random sdl2
+          base bytestring JuicyPixels linear monad-loops OpenGL OpenGLRaw
+          random sdl2 vector
         ];
         license = stdenv.lib.licenses.gpl3;
       };

src/Main.hs

@@ -38,6 +38,7 @@ import VertexBuffer
 import IndexBuffer
 import Shader
 import Renderer
+import Texture
 
 main :: IO ()
 main = do
@@ -80,12 +81,14 @@ main = do
   vao <- GL.genObjectName
   GL.bindVertexArrayObject $= Just vao
 
-      -- define vertices (positions of the triangle corners) as List of Floats
+      -- define vertices (positions of the rectangle corners) as List of Floats
+      -- with added in texture coordinates
   let vertexPositions =
-        [ (-0.5), (-0.5) -- 0
+        -- 3D positions    | texture coordinates
-        , 0.5   , (-0.5) -- 1
+        [ (-0.5), (-0.5), 0, 0, 0 -- 0
-        , 0.5   , 0.5    -- 2
+        , 0.5   , (-0.5), 0, 1, 0 -- 1
-        , (-0.5), 0.5    -- 3
+        , 0.5   , 0.5   , 0, 1, 1 -- 2
+        , (-0.5), 0.5   , 0, 0, 1 -- 3
         ] :: [GL.GLfloat]
 
       -- create draw order indices
@@ -100,23 +103,18 @@ main = do
   
   -- enable and specify data layout of the in-memory vertices
   layout <- newVertexBufferLayout
+  -- push vertex positions
+  pushElements layout GL.Float 3
+  -- pusht texture coordinates
   pushElements layout GL.Float 2
 
   addBuffer vao vbo layout
 
-  -- GL.vertexAttribPointer (GL.AttribLocation 0) $=
+  -- -- TEXTURE
-  --   ( GL.ToFloat
+  
-  --   , GL.VertexArrayDescriptor
+  -- generate and bind texture
-  --     -- There are 2 components (Floats) to our attribute
+  tex <- newTexture "res/textures/lynx.jpg" 0
-  --     2
+  bind tex
-  --     -- They are Floats
-  --     GL.Float
-  --     -- ???
-  --     0
-  --     -- our attribute is directly at the beginning of each vertex
-  --     (plusPtr nullPtr 0)
-  --   )
-  -- GL.vertexAttribArray (GL.AttribLocation 0) $= GL.Enabled
 
   -- construct new IndexBuffer and fill it with data
   ibo <- newIndexBuffer indices
@@ -128,8 +126,13 @@ main = do
     , ShaderSource GL.FragmentShader "./res/shaders/frag.shader"
     ]
     [ "u_color"
+    , "u_texture"
     ]
 
+  -- -- tell the shader where to find the texture
+  bind sp
+  setUniform sp "u_texture" (texSlot tex)
+
   -- -- UNIFORMS
 
   -- create MVars for pulsating red channel
@@ -143,7 +146,7 @@ main = do
 
   -- -- UNBINDING ALL BUFFERS AND VERTEX ARRAYS
 
-  GL.bindVertexArrayObject $= Nothing
+  unbind vao
   unbind vbo
   unbind ibo
   unbind sp

src/Texture.hs

@@ -0,0 +1,88 @@
+module Texture where
+
+import SDL (($=), get)
+
+import qualified Graphics.Rendering.OpenGL as GL
+
+import Codec.Picture
+
+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 <- 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))

src/VertexArray.hs

@@ -60,11 +60,12 @@ addBuffer va vb layout = do
     (\(index, elem) -> do
       let offset = fromIntegral $
             foldl
-              (\acc (index, _) -> acc + index )
+              (\acc (index, elem) -> acc + vbleCount elem)
               0
-              (filter ((<= index) . fst) indexed) :: Int
+              (filter ((< index) . fst) indexed) :: Int
-      GL.vertexAttribArray (GL.AttribLocation index) $= GL.Enabled
+      GL.vertexAttribArray (GL.AttribLocation $ fromIntegral index) $=
-      GL.vertexAttribPointer (GL.AttribLocation index) $=
+        GL.Enabled
+      GL.vertexAttribPointer (GL.AttribLocation $ fromIntegral index) $=
         ( vbleHandling elem
         , GL.VertexArrayDescriptor
           -- number of components to our attribute
@@ -72,7 +73,7 @@ addBuffer va vb layout = do
           -- datatype of elements
           (vbleType elem)
           -- ???
-          0
+          (sum (map vbleCount list) * fromIntegral (dataElementSize (vbleType elem)))
           -- offset from beginnning of vertex
           (plusPtr nullPtr (offset * dataElementSize (vbleType elem)))
         )