diff --git a/src/Shader.hs b/src/Shader.hs index c156ea3c1..6681324e8 100644 --- a/src/Shader.hs +++ b/src/Shader.hs @@ -20,7 +20,7 @@ import qualified Data.Vector.Mutable as MV import Control.Monad.Primitive import Foreign import Graphics.Rendering.OpenGL hiding (Point,translate,scale,imageHeight) -import Graphics.GL.Core43 +import Graphics.GL.Core45 drawShaderLay :: Int -> UMV.MVector (PrimState IO) Int -> Int -> FullShader' -> IO () {-# INLINE drawShaderLay #-} @@ -30,8 +30,10 @@ drawShaderLay l countsVector shadIn fs = do glUseProgram (_shadProg' fs) bindVertexArrayObject $= Just (_vao $ _shadVAO' fs) case _shadTex' fs of - Just ShaderTexture{_textureObject = txo} - -> textureBinding Texture2D $= Just txo + Just ShaderTexture{_textureObject = txo} --, _textureTarget = tt} + -- -> textureBinding Texture2D $= Just txo + -- -> glBindTexture tt txo + -> glBindTextureUnit 0 txo _ -> return () glDrawArrays (marshalEPrimitiveMode $ _shadPrim' fs) @@ -45,9 +47,10 @@ drawShader fs i = do glUseProgram (_shadProg' fs) bindVertexArrayObject $= Just (_vao $ _shadVAO' fs) case _shadTex' fs of - Just ShaderTexture{_textureObject = TextureObject txo - , _textureTarget = tt } - -> glBindTexture tt txo + Just ShaderTexture{_textureObject = txo + } --, _textureTarget = tt } + -- -> glBindTexture tt txo + -> glBindTextureUnit 0 txo _ -> return () glDrawArrays (marshalEPrimitiveMode $ _shadPrim' fs) diff --git a/src/Shader/AuxAddition.hs b/src/Shader/AuxAddition.hs index 63b77b2db..c529b7a91 100644 --- a/src/Shader/AuxAddition.hs +++ b/src/Shader/AuxAddition.hs @@ -5,6 +5,9 @@ module Shader.AuxAddition , addUniforms' , tilesToLine -- ^ kept in case it is needed in the future ) where +import Unsafe.Coerce +import Foreign.Marshal +import Foreign.Storable import Shader.Data import Control.Monad import qualified Data.ByteString as BS @@ -15,54 +18,59 @@ import Codec.Picture import qualified Data.Vector.Storable as VS import Control.Lens import Graphics.Rendering.OpenGL hiding (Point,translate,scale,imageHeight) -import Graphics.GL.Core43 +import Graphics.GL.Core45 -- I am not sure if this assumes that the shader is constructed directly before -- the texture is added... addTexture' :: String -> FullShader' -> IO FullShader' -addTexture' = addTexture2D 3 ((Linear',Just Linear') , Linear') +addTexture' = addTexture2D 3 GL_LINEAR_MIPMAP_LINEAR GL_LINEAR vaddTextureNoFilter' :: String -> FullShader' -> IO FullShader' -vaddTextureNoFilter' = addTexture2D 1 ((Nearest,Nothing), Nearest) +vaddTextureNoFilter' = addTexture2D 1 GL_NEAREST GL_NEAREST --vaddTextureNoFilter' = addTexture2D 3 ((Linear',Just Linear') , Linear') -addTexture2D :: GLint -> ((TextureFilter,Maybe TextureFilter),TextureFilter) +addTexture2D :: GLint -- number mipmap levels +-- -> ((TextureFilter,Maybe TextureFilter),TextureFilter) + -> GLenum -- minfilter + -> GLenum -- magfilter -> String -> FullShader' -> IO FullShader' -addTexture2D nlev filt texpath shad = do +addTexture2D nlev minfilt magfilt texpath shad = do Right cmap <- readImage texpath - let tex = convertRGBA8 cmap - textureOb <- genObjectName - textureBinding Texture2D $= Just textureOb - let wtex = fromIntegral $ imageWidth tex - htex = fromIntegral $ imageHeight tex - glTexStorage2D GL_TEXTURE_2D nlev GL_RGBA8 wtex htex - VS.unsafeWith (imageData tex) $ \ptr -> do - glTexSubImage2D GL_TEXTURE_2D 0 0 0 wtex htex GL_RGBA GL_UNSIGNED_BYTE ptr - textureFilter Texture2D $= filt - generateMipmap' Texture2D - return $ shad & shadTex' ?~ ShaderTexture - {_textureObject = textureOb - ,_textureTarget = GL_TEXTURE_2D - } + let texdata = convertRGBA8 cmap + let wtex = fromIntegral $ imageWidth texdata + htex = fromIntegral $ imageHeight texdata + alloca $ \nameptr -> do + glCreateTextures GL_TEXTURE_2D 1 nameptr + texname <- peek nameptr + glTextureStorage2D texname nlev GL_RGBA8 wtex htex + VS.unsafeWith (imageData texdata) $ \ptr -> do + glTextureSubImage2D texname 0 0 0 wtex htex GL_RGBA GL_UNSIGNED_BYTE ptr + glGenerateTextureMipmap texname + glTextureParameteri texname GL_TEXTURE_MIN_FILTER (unsafeCoerce minfilt) + glTextureParameteri texname GL_TEXTURE_MAG_FILTER (unsafeCoerce magfilt) + return $ shad & shadTex' ?~ ShaderTexture + {_textureObject = texname } -- | for transforming a 256x256 image containing 64 tiles of 16x16 pixels into -- an image that was directly readable by glTexSubImage3D, used the -- transformation tilesToLine 8 128 on the underlying pixels. addTextureArray' :: String -> FullShader' -> IO FullShader' addTextureArray' texturePath shad = do - textureOb <- genObjectName - textureBinding Texture2DArray $= Just textureOb + err <- glGetError + print err Right cmap <- readImage texturePath - let tex = convertRGBA8 cmap - glTexStorage3D GL_TEXTURE_2D_ARRAY 3 GL_RGBA8 32 32 64 - VS.unsafeWith (imageData tex) $ \ptr -> do - glTexSubImage3D GL_TEXTURE_2D_ARRAY 0 0 0 0 32 32 64 GL_RGBA GL_UNSIGNED_BYTE ptr - textureFilter Texture2DArray $= ((Linear',Just Linear') , Linear') - generateMipmap' Texture2DArray - return $ shad & shadTex' ?~ ShaderTexture - { _textureObject = textureOb - , _textureTarget = GL_TEXTURE_2D_ARRAY - } + let texdata = convertRGBA8 cmap + alloca $ \nameptr -> do + glCreateTextures GL_TEXTURE_2D_ARRAY 1 nameptr + texname <- peek nameptr + glTextureStorage3D texname 3 GL_RGBA8 32 32 64 + VS.unsafeWith (imageData texdata) $ \ptr -> do + glTextureSubImage3D texname 0 0 0 0 32 32 64 GL_RGBA GL_UNSIGNED_BYTE ptr + glGenerateTextureMipmap texname + glTextureParameteri texname GL_TEXTURE_MIN_FILTER (unsafeCoerce GL_LINEAR_MIPMAP_LINEAR) + glTextureParameteri texname GL_TEXTURE_MAG_FILTER (unsafeCoerce GL_LINEAR) + return $ shad & shadTex' ?~ ShaderTexture + { _textureObject = texname} -- I am completely unclear on why this works with its current parameters tilesToLine diff --git a/src/Shader/Data.hs b/src/Shader/Data.hs index 9cb334cd5..912e699de 100644 --- a/src/Shader/Data.hs +++ b/src/Shader/Data.hs @@ -79,8 +79,8 @@ data EBO = EBO } {- | Datatype containing the reference to a texture object. -} data ShaderTexture = ShaderTexture - { _textureObject :: TextureObject - , _textureTarget :: GLenum + { _textureObject :: GLuint -- DSA style texture, 450 +-- , _textureTarget :: GLenum } data EPrimitiveMode = EPoints