Improve texture loading performance

This commit is contained in:
jgk
2021-08-17 11:40:27 +02:00
parent 5da577ff12
commit d9306c4adb
8 changed files with 16 additions and 18 deletions
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.

After

Width:  |  Height:  |  Size: 144 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 118 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 240 KiB

+2 -1
View File
@@ -90,7 +90,8 @@ preloadRender = do
>>= addTexture "data/texture/grayscaleDirt.png" >>= addTexture "data/texture/grayscaleDirt.png"
---- texture array shader ---- texture array shader
textArrayShad <- makeShader "texture/array" [vert,frag] [3,3] ETriangles textArrayShad <- makeShader "texture/array" [vert,frag] [3,3] ETriangles
>>= addTextureArray "data/texture/ayene_wooden_floor.png" >>= addTextureArray "data/texture/ayene_wooden_floor_transformed.png"
-- >>= addTextureArray "data/texture/ayene_wooden_floor.png"
-- bind fixed vertex data -- bind fixed vertex data
bindShaderBuffers [fsShad,fullscreenAlphaHalveShad] [4,4] bindShaderBuffers [fsShad,fullscreenAlphaHalveShad] [4,4]
framebuf2 <- setupTextureFramebuffer 800 600 framebuf2 <- setupTextureFramebuffer 800 600
+14 -17
View File
@@ -4,11 +4,12 @@ module Shader.AuxAddition
, vaddTextureNoFilter , vaddTextureNoFilter
, addTextureArray , addTextureArray
, addUniforms , addUniforms
, tilesToLine -- ^ kept in case it is needed in the future
) where ) where
import Shader.Data import Shader.Data
import Data.List.Extra import Data.List.Extra
import Foreign --import Foreign
import Codec.Picture import Codec.Picture
import qualified Data.Vector.Storable as V import qualified Data.Vector.Storable as V
import Control.Lens import Control.Lens
@@ -41,8 +42,7 @@ vaddTextureNoFilter texturePath shad = do
textureOb <- genObjectName textureOb <- genObjectName
textureBinding Texture2D $= Just textureOb textureBinding Texture2D $= Just textureOb
textureFilter Texture2D $= ((Nearest,Nothing) , Nearest) textureFilter Texture2D $= ((Nearest,Nothing) , Nearest)
let texData = V.toList $ imageData tex let wtex = fromIntegral $ imageWidth tex
wtex = fromIntegral $ imageWidth tex
htex = fromIntegral $ imageHeight tex htex = fromIntegral $ imageHeight tex
glTexStorage2D GL_TEXTURE_2D 1 GL_RGBA8 wtex htex glTexStorage2D GL_TEXTURE_2D 1 GL_RGBA8 wtex htex
--withArray texData $ \ptr -> do --withArray texData $ \ptr -> do
@@ -57,25 +57,29 @@ addTextureNoFilter texturePath shad = do
textureOb <- genObjectName textureOb <- genObjectName
textureBinding Texture2D $= Just textureOb textureBinding Texture2D $= Just textureOb
textureFilter Texture2D $= ((Nearest,Nothing) , Nearest) textureFilter Texture2D $= ((Nearest,Nothing) , Nearest)
let texData = V.toList $ imageData tex let wtex = fromIntegral $ imageWidth tex
wtex = fromIntegral $ imageWidth tex
htex = fromIntegral $ imageHeight tex htex = fromIntegral $ imageHeight tex
glTexStorage2D GL_TEXTURE_2D 1 GL_RGBA8 wtex htex glTexStorage2D GL_TEXTURE_2D 1 GL_RGBA8 wtex htex
--withArray texData $ \ptr -> do
V.unsafeWith (imageData tex) $ \ptr -> do V.unsafeWith (imageData tex) $ \ptr -> do
glTexSubImage2D GL_TEXTURE_2D 0 0 0 wtex htex GL_RGBA GL_UNSIGNED_BYTE ptr glTexSubImage2D GL_TEXTURE_2D 0 0 0 wtex htex GL_RGBA GL_UNSIGNED_BYTE ptr
return $ shad & shaderTexture ?~ ShaderTexture {_textureObject = textureOb} return $ shad & shaderTexture ?~ ShaderTexture {_textureObject = textureOb}
-- | 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 :: String -> FullShader -> IO FullShader
addTextureArray texturePath shad = do addTextureArray texturePath shad = do
textureOb <- genObjectName textureOb <- genObjectName
textureBinding Texture2DArray $= Just textureOb textureBinding Texture2DArray $= Just textureOb
Right cmap <- readImage texturePath Right cmap <- readImage texturePath
let tex = convertRGBA8 cmap let tex = convertRGBA8 cmap
let texData = tilesToLine 128 8 . --let texData = tilesToLine 8 128 .
V.toList $ imageData tex --let texData = tilesToLine 8 128 .
-- V.toList $ imageData tex
glTexStorage3D GL_TEXTURE_2D_ARRAY 3 GL_RGBA8 32 32 64 glTexStorage3D GL_TEXTURE_2D_ARRAY 3 GL_RGBA8 32 32 64
withArray texData $ \ptr -> do --writePng "atest.png" ((Image 256 256 (V.fromList texData)) :: Image PixelRGBA8)
--withArray texData $ \ptr -> do
V.unsafeWith (imageData tex) $ \ptr -> do
--glTexSubImage3D GL_TEXTURE_2D_ARRAY 0 0 0 0 32 32 64 GL_RGBA GL_UNSIGNED_BYTE ptr --glTexSubImage3D GL_TEXTURE_2D_ARRAY 0 0 0 0 32 32 64 GL_RGBA GL_UNSIGNED_BYTE ptr
glTexSubImage3D GL_TEXTURE_2D_ARRAY 0 0 0 0 32 32 64 GL_RGBA GL_UNSIGNED_BYTE ptr glTexSubImage3D GL_TEXTURE_2D_ARRAY 0 0 0 0 32 32 64 GL_RGBA GL_UNSIGNED_BYTE ptr
textureFilter Texture2DArray $= ((Linear',Just Linear') , Linear') textureFilter Texture2DArray $= ((Linear',Just Linear') , Linear')
@@ -88,14 +92,7 @@ tilesToLine
-> Int -- ^ Parameter b -> Int -- ^ Parameter b
-> [a] -> [a]
-> [a] -> [a]
tilesToLine w n = concat . concat . transpose . chunksOf n . chunksOf w tilesToLine n w = concat . concat . transpose . chunksOf n . chunksOf w
tilesToLineV
:: Int -- ^ Parameter a
-> Int -- ^ Parameter b
-> V.Vector a
-> V.Vector a
tilesToLineV w n = undefined
addUniforms :: [String] -> FullShader -> IO FullShader addUniforms :: [String] -> FullShader -> IO FullShader
addUniforms uniStrings shad = do addUniforms uniStrings shad = do