From b8fbc6055d1954ad657a8c75225ca98edc2a674e Mon Sep 17 00:00:00 2001 From: justin Date: Thu, 9 Mar 2023 09:52:55 +0000 Subject: [PATCH] Continue move to raw open gl --- src/Shader/AuxAddition.hs | 55 ++++++++++++++++++++++----------------- src/Shader/Compile.hs | 15 +++++++---- 2 files changed, 41 insertions(+), 29 deletions(-) diff --git a/src/Shader/AuxAddition.hs b/src/Shader/AuxAddition.hs index e611cb6af..a711dc6f6 100644 --- a/src/Shader/AuxAddition.hs +++ b/src/Shader/AuxAddition.hs @@ -6,8 +6,6 @@ module Shader.AuxAddition , 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 @@ -19,6 +17,7 @@ import qualified Data.Vector.Storable as VS import Control.Lens --import Graphics.Rendering.OpenGL hiding (Point,translate,scale,imageHeight) import Graphics.GL.Core45 +import GLHelp -- I am not sure if this assumes that the shader is constructed directly before -- the texture is added... @@ -39,17 +38,27 @@ addTexture2D nlev minfilt magfilt texpath shad = do 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 } + texname <- mglCreateSingle $ glCreateTextures GL_TEXTURE_2D 1 + 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 } +-- 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 @@ -60,17 +69,15 @@ addTextureArray texturePath shad = do print err Right cmap <- readImage texturePath 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} + texname <- mglCreateSingle $ glCreateTextures GL_TEXTURE_2D_ARRAY 1 + 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/Compile.hs b/src/Shader/Compile.hs index 6b3fdbd26..776b65535 100644 --- a/src/Shader/Compile.hs +++ b/src/Shader/Compile.hs @@ -2,7 +2,7 @@ module Shader.Compile ( makeShader, makeByteStringShaderUsingVAO, makeShaderSized, --- makeShaderUsingShaderVAO, + -- makeShaderUsingShaderVAO, makeShaderUsingVAO, setupVAO, setupVertexAttribPointer, @@ -226,12 +226,12 @@ makeShaderProgram str srcs = do shaders <- mapM (compileAndCheckShader str) srcs mapM_ (glAttachShader theprog) shaders glLinkProgram theprog - glCheckError (str ++ " linking ") glGetProgramiv glGetProgramInfoLog theprog GL_LINK_STATUS + checkErrorGL (str ++ " linking ") glGetProgramiv glGetProgramInfoLog theprog GL_LINK_STATUS mapM_ (glDetachShader theprog) shaders mapM_ glDeleteShader shaders return theprog -glCheckError :: +checkErrorGL :: (Storable t1) => [Char] -> (t2 -> GLenum -> Ptr t1 -> IO ()) -> @@ -239,7 +239,7 @@ glCheckError :: t2 -> GLenum -> IO () -glCheckError str f g x statustype = +checkErrorGL str f g x statustype = alloca $ \statusPtr -> do f x statustype statusPtr status <- peek $ castPtr statusPtr @@ -257,7 +257,12 @@ compileAndCheckShader str (theShaderType, sourceCode) = do theShader <- glCreateShader theShaderType setShaderSource theShader sourceCode glCompileShader theShader - glCheckError (str ++ shaderTypeExt' theShaderType) glGetShaderiv glGetShaderInfoLog theShader GL_COMPILE_STATUS + checkErrorGL + (str ++ shaderTypeExt' theShaderType) + glGetShaderiv + glGetShaderInfoLog + theShader + GL_COMPILE_STATUS return theShader setShaderSource :: GLuint -> BS.ByteString -> IO ()