DSA gl texture naming and storage

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