From a32ea93e067f26fb5330f5c00f4003a2a995a2d2 Mon Sep 17 00:00:00 2001 From: justin Date: Tue, 7 Mar 2023 22:42:41 +0000 Subject: [PATCH] Refactor --- src/Dodge/Render.hs | 1 - src/Dodge/Render/Shadow.hs | 2 +- src/Shader/AuxAddition.hs | 130 ++++--------------------------------- 3 files changed, 15 insertions(+), 118 deletions(-) diff --git a/src/Dodge/Render.hs b/src/Dodge/Render.hs index b2d6c0f0b..0f67771d5 100644 --- a/src/Dodge/Render.hs +++ b/src/Dodge/Render.hs @@ -44,7 +44,6 @@ doDrawing win pdata u = do (wallPointsCol, windowPoints, wallSPics) = wallsToDraw w lightPoints = lightsToRender cfig (w ^. cWorld . camPos) (w ^. cWorld . lWorld) viewFroms@(V2 vfx vfy) = w ^. cWorld . camPos . camViewFrom - viewFrom3d = Vector3 vfx vfy 20 shadV = _pictureShaders pdata lwShad = _lightingWallShadShader pdata -- bind as much data into vbos as feasible at this point diff --git a/src/Dodge/Render/Shadow.hs b/src/Dodge/Render/Shadow.hs index 36b3011a4..7939d68f4 100644 --- a/src/Dodge/Render/Shadow.hs +++ b/src/Dodge/Render/Shadow.hs @@ -2,7 +2,7 @@ module Dodge.Render.Shadow where import Shader.Parameters import Shader.ExtraPrimitive -import Graphics.Rendering.OpenGL (currentProgram, ($=), bindVertexArrayObject, bindBuffer +import Graphics.Rendering.OpenGL ( ($=), bindVertexArrayObject, bindBuffer , BufferTarget (..), bufferSubData, TransferDirection (..) ) import Graphics.GL.Core43 diff --git a/src/Shader/AuxAddition.hs b/src/Shader/AuxAddition.hs index 961e58493..63b77b2db 100644 --- a/src/Shader/AuxAddition.hs +++ b/src/Shader/AuxAddition.hs @@ -1,17 +1,11 @@ module Shader.AuxAddition - ( addTexture - , addTexture' - , addTextureNoFilter - , vaddTextureNoFilter + ( addTexture' , vaddTextureNoFilter' - , addTextureArray , addTextureArray' - , addUniforms , addUniforms' , tilesToLine -- ^ kept in case it is needed in the future ) where import Shader.Data -import Foreign.Marshal import Control.Monad import qualified Data.ByteString as BS import Data.ByteString.Char8 (pack) @@ -25,133 +19,43 @@ import Graphics.GL.Core43 -- I am not sure if this assumes that the shader is constructed directly before -- the texture is added... -addTexture :: String -> FullShader -> IO FullShader -addTexture texturePath shad = do - Right cmap <- readImage texturePath - let tex = convertRGBA8 cmap - textureOb <- genObjectName - textureBinding Texture2D $= Just textureOb - let wtex = fromIntegral $ imageWidth tex - htex = fromIntegral $ imageHeight tex - glTexStorage2D GL_TEXTURE_2D 3 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 Texture2DArray $= ((Linear',Just Linear') , Linear') - textureFilter Texture2D $= ((Linear',Just Linear') , Linear') - generateMipmap' Texture2D - return $ shad & shadTex ?~ ShaderTexture - {_textureObject = textureOb - ,_textureTarget = GL_TEXTURE_2D - } - addTexture' :: String -> FullShader' -> IO FullShader' -addTexture' texturePath shad = do - Right cmap <- readImage texturePath - let tex = convertRGBA8 cmap - textureOb <- genObjectName - textureBinding Texture2D $= Just textureOb - let wtex = fromIntegral $ imageWidth tex - htex = fromIntegral $ imageHeight tex - glTexStorage2D GL_TEXTURE_2D 3 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 Texture2DArray $= ((Linear',Just Linear') , Linear') - textureFilter Texture2D $= ((Linear',Just Linear') , Linear') - generateMipmap' Texture2D - return $ shad & shadTex' ?~ ShaderTexture - {_textureObject = textureOb - ,_textureTarget = GL_TEXTURE_2D - } - -vaddTextureNoFilter :: String -> FullShader -> IO FullShader -vaddTextureNoFilter texturePath shad = do - Right cmap <- readImage texturePath - let tex = convertRGBA8 cmap - textureOb <- genObjectName - textureBinding Texture2D $= Just textureOb - textureFilter Texture2D $= ((Nearest,Nothing) , Nearest) - let wtex = fromIntegral $ imageWidth tex - htex = fromIntegral $ imageHeight tex - glTexStorage2D GL_TEXTURE_2D 1 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 - return $ shad & shadTex ?~ ShaderTexture - { _textureObject = textureOb - , _textureTarget = GL_TEXTURE_2D - } +addTexture' = addTexture2D 3 ((Linear',Just Linear') , Linear') vaddTextureNoFilter' :: String -> FullShader' -> IO FullShader' -vaddTextureNoFilter' texturePath shad = do - Right cmap <- readImage texturePath - let tex = convertRGBA8 cmap - textureOb <- genObjectName - textureBinding Texture2D $= Just textureOb - textureFilter Texture2D $= ((Nearest,Nothing) , Nearest) - let wtex = fromIntegral $ imageWidth tex - htex = fromIntegral $ imageHeight tex - glTexStorage2D GL_TEXTURE_2D 1 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 - return $ shad & shadTex' ?~ ShaderTexture - { _textureObject = textureOb - , _textureTarget = GL_TEXTURE_2D - } +vaddTextureNoFilter' = addTexture2D 1 ((Nearest,Nothing), Nearest) +--vaddTextureNoFilter' = addTexture2D 3 ((Linear',Just Linear') , Linear') -addTextureNoFilter :: String -> FullShader -> IO FullShader -addTextureNoFilter texturePath shad = do - Right cmap <- readImage texturePath +addTexture2D :: GLint -> ((TextureFilter,Maybe TextureFilter),TextureFilter) + -> String -> FullShader' -> IO FullShader' +addTexture2D nlev filt texpath shad = do + Right cmap <- readImage texpath let tex = convertRGBA8 cmap textureOb <- genObjectName textureBinding Texture2D $= Just textureOb - textureFilter Texture2D $= ((Nearest,Nothing) , Nearest) let wtex = fromIntegral $ imageWidth tex htex = fromIntegral $ imageHeight tex - glTexStorage2D GL_TEXTURE_2D 1 GL_RGBA8 wtex htex + 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 - return $ shad & shadTex ?~ ShaderTexture - { _textureObject = textureOb - , _textureTarget = GL_TEXTURE_2D + textureFilter Texture2D $= filt + generateMipmap' Texture2D + return $ shad & shadTex' ?~ ShaderTexture + {_textureObject = textureOb + ,_textureTarget = GL_TEXTURE_2D } -- | 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 - Right cmap <- readImage texturePath - let tex = convertRGBA8 cmap - --let texData = tilesToLine 8 128 . - --let texData = tilesToLine 8 128 . - -- V.toList $ imageData tex - glTexStorage3D GL_TEXTURE_2D_ARRAY 3 GL_RGBA8 32 32 64 - --writePng "atest.png" ((Image 256 256 (V.fromList texData)) :: Image PixelRGBA8) - --withArray texData $ \ptr -> do - VS.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 - textureFilter Texture2DArray $= ((Linear',Just Linear') , Linear') - generateMipmap' Texture2DArray - return $ shad & shadTex ?~ ShaderTexture - { _textureObject = textureOb - , _textureTarget = GL_TEXTURE_2D_ARRAY - } addTextureArray' :: String -> FullShader' -> IO FullShader' addTextureArray' texturePath shad = do textureOb <- genObjectName textureBinding Texture2DArray $= Just textureOb Right cmap <- readImage texturePath let tex = convertRGBA8 cmap - --let texData = tilesToLine 8 128 . - --let texData = tilesToLine 8 128 . - -- V.toList $ imageData tex glTexStorage3D GL_TEXTURE_2D_ARRAY 3 GL_RGBA8 32 32 64 - --writePng "atest.png" ((Image 256 256 (V.fromList texData)) :: Image PixelRGBA8) - --withArray texData $ \ptr -> do VS.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 textureFilter Texture2DArray $= ((Linear',Just Linear') , Linear') generateMipmap' Texture2DArray @@ -168,14 +72,8 @@ tilesToLine -> [a] tilesToLine n w = concat . concat . transpose . chunksOf n . chunksOf w -addUniforms :: [String] -> FullShader -> IO FullShader -addUniforms uniStrings shad = do - uniLocs <- mapM (uniformLocation $ _shadProg shad) uniStrings - return $ shad & shadUnis %~ (V.++ V.fromList uniLocs) addUniforms' :: [String] -> FullShader' -> IO FullShader' addUniforms' uniStrings shad = do foldM addUniform' shad uniStrings --- uniLocs <- mapM (uniformLocation $ _shadProg shad) uniStrings --- return $ shad & shadUnis' %~ (V.++ V.fromList uniLocs) addUniform' :: FullShader' -> String -> IO FullShader' addUniform' shad unistr = BS.useAsCString (pack unistr) $ \cstr -> do