get textures halfway working

This commit is contained in:
nek0 2020-05-22 16:16:06 +02:00
parent 1714facb11
commit e3be56ab6c
8 changed files with 136 additions and 31 deletions

View file

@ -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

View file

@ -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;
}

View file

@ -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;
}

BIN
res/textures/lynx.jpg Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 227 KiB

View file

@ -4,17 +4,18 @@ let
inherit (nixpkgs) pkgs;
f = { mkDerivation, base, bytestring, monad-loops, OpenGL
, OpenGLRaw, random, sdl2, stdenv
f = { mkDerivation, base, bytestring, JuicyPixels, linear
, 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;
};

View file

@ -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
, 0.5 , (-0.5) -- 1
, 0.5 , 0.5 -- 2
, (-0.5), 0.5 -- 3
-- 3D positions | texture coordinates
[ (-0.5), (-0.5), 0, 0, 0 -- 0
, 0.5 , (-0.5), 0, 1, 0 -- 1
, 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) $=
-- ( GL.ToFloat
-- , GL.VertexArrayDescriptor
-- -- There are 2 components (Floats) to our attribute
-- 2
-- -- 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
-- -- TEXTURE
-- generate and bind texture
tex <- newTexture "res/textures/lynx.jpg" 0
bind tex
-- 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

88
src/Texture.hs Normal file
View file

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

View file

@ -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
GL.vertexAttribArray (GL.AttribLocation index) $= GL.Enabled
GL.vertexAttribPointer (GL.AttribLocation index) $=
(filter ((< index) . fst) indexed) :: Int
GL.vertexAttribArray (GL.AttribLocation $ fromIntegral 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)))
)