Refactor
This commit is contained in:
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
+14
-116
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user