justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Use DSA for renderbuffers

Browse Source
This commit is contained in:
justin
2023-03-09 14:58:38 +00:00
parent 0b698e5f5d
commit 76a8b05433
11 changed files with 81 additions and 74 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Data/Preload/Render.hs
+19 -19
View File
@@ -12,25 +12,25 @@ import qualified Data.Vector.Mutable as MV
import Control.Monad.Primitive import Control.Monad.Primitive
data RenderData = RenderData data RenderData = RenderData
{ _lightingWallShadShader :: FullShader' { _lightingWallShadShader :: FullShader
, _lightingLineShadowShader :: FullShader' , _lightingLineShadowShader :: FullShader
, _positionalBlankShader :: FullShader' , _positionalBlankShader :: FullShader
, _lightingCapShader :: FullShader' , _lightingCapShader :: FullShader
, _wallBlankShader :: FullShader' , _wallBlankShader :: FullShader
, _windowShader :: FullShader' , _windowShader :: FullShader
, _wallTextureShader :: FullShader' , _wallTextureShader :: FullShader
, _textureArrayShader :: FullShader' , _textureArrayShader :: FullShader
, _fullscreenShader :: FullShader' , _fullscreenShader :: FullShader
, _lightingTextureShader :: FullShader' , _lightingTextureShader :: FullShader
--, _fullscreenAlphaHalveShader :: FullShader' --, _fullscreenAlphaHalveShader :: FullShader
, _bloomBlurShader :: FullShader' , _bloomBlurShader :: FullShader
, _colorBlurShader :: FullShader' , _colorBlurShader :: FullShader
, _barrelShader :: FullShader' , _barrelShader :: FullShader
, _grayscaleShader :: FullShader' , _grayscaleShader :: FullShader
, _shapeShader :: FullShader' , _shapeShader :: FullShader
, _shapeEBO :: EBO , _shapeEBO :: EBO
, _silhouetteEBO :: EBO , _silhouetteEBO :: EBO
, _pictureShaders :: MV.MVector (PrimState IO) FullShader' , _pictureShaders :: MV.MVector (PrimState IO) FullShader
, _fbo2 :: (FramebufferObject, TextureObject) , _fbo2 :: (FramebufferObject, TextureObject)
, _fbo3 :: (FramebufferObject, TextureObject) , _fbo3 :: (FramebufferObject, TextureObject)
, _fboHalf1 :: (FramebufferObject, TextureObject) , _fboHalf1 :: (FramebufferObject, TextureObject)
@@ -41,11 +41,11 @@ data RenderData = RenderData
, _fboBloom :: (FramebufferObject, TextureObject) , _fboBloom :: (FramebufferObject, TextureObject)
, _fboColor :: (FramebufferObject, TextureObject) , _fboColor :: (FramebufferObject, TextureObject)
, _fboPos :: (FramebufferObject, TextureObject) , _fboPos :: (FramebufferObject, TextureObject)
, _rboBaseBloom :: RenderbufferObject , _rboBaseBloom :: GLuint -- RenderbufferObject id
, _fboLighting :: (FramebufferObject, TextureObject) , _fboLighting :: (FramebufferObject, TextureObject)
, _fboLightingHigh :: (FramebufferObject, TextureObject) , _fboLightingHigh :: (FramebufferObject, TextureObject)
, _fboShadow :: (FramebufferObject, (TextureObject,TextureObject)) , _fboShadow :: (FramebufferObject, (TextureObject,TextureObject))
, _matUBO :: GLuint , _matUBO :: GLuint -- BufferObject id
} }
makeLenses ''RenderData makeLenses ''RenderData
src/Framebuffer/Setup.hs
+6 -4
View File
@@ -40,28 +40,30 @@ setupShadowFramebuffer = do
return (fboName,(toName,toName2)) return (fboName,(toName,toName2))
setupFramebufferGivenStencil setupFramebufferGivenStencil
:: RenderbufferObject :: GLuint -- RenderbufferObject
-> IO (FramebufferObject, TextureObject) -> IO (FramebufferObject, TextureObject)
{-# INLINE setupFramebufferGivenStencil #-} {-# INLINE setupFramebufferGivenStencil #-}
setupFramebufferGivenStencil rboName = do setupFramebufferGivenStencil rboName = do
fboName <- genObjectName fboName <- genObjectName
bindFramebuffer Framebuffer $= fboName bindFramebuffer Framebuffer $= fboName
toName <- genObjectName toName <- genObjectName
framebufferRenderbuffer Framebuffer DepthStencilAttachment Renderbuffer rboName --framebufferRenderbuffer Framebuffer DepthStencilAttachment Renderbuffer rboName
glFramebufferRenderbuffer GL_FRAMEBUFFER GL_DEPTH_STENCIL_ATTACHMENT GL_RENDERBUFFER rboName
fboStatus <- framebufferStatus Framebuffer fboStatus <- framebufferStatus Framebuffer
case fboStatus of case fboStatus of
Complete -> return () Complete -> return ()
_ -> putStrLn $ "Framebuffer with given stencil status: " ++ show fboStatus _ -> putStrLn $ "Framebuffer with given stencil status: " ++ show fboStatus
return (fboName,toName) return (fboName,toName)
setupFramebuffer2GivenStencil setupFramebuffer2GivenStencil
:: RenderbufferObject :: GLuint -- RenderbufferObject
-> IO (FramebufferObject, (TextureObject,TextureObject)) -> IO (FramebufferObject, (TextureObject,TextureObject))
setupFramebuffer2GivenStencil rboName = do setupFramebuffer2GivenStencil rboName = do
fboName <- genObjectName fboName <- genObjectName
bindFramebuffer Framebuffer $= fboName bindFramebuffer Framebuffer $= fboName
toName <- genObjectName toName <- genObjectName
toName2 <- genObjectName toName2 <- genObjectName
framebufferRenderbuffer Framebuffer DepthStencilAttachment Renderbuffer rboName --framebufferRenderbuffer Framebuffer DepthStencilAttachment Renderbuffer rboName
glFramebufferRenderbuffer GL_FRAMEBUFFER GL_DEPTH_STENCIL_ATTACHMENT GL_RENDERBUFFER rboName
fboStatus <- framebufferStatus Framebuffer fboStatus <- framebufferStatus Framebuffer
case fboStatus of case fboStatus of
Complete -> return () Complete -> return ()
src/Framebuffer/Update.hs
+9 -4
View File
@@ -9,7 +9,7 @@ where
import Data.Preload.Render import Data.Preload.Render
import Graphics.Rendering.OpenGL import Graphics.Rendering.OpenGL
import Graphics.GL.Core43 import Graphics.GL.Core45
--import Foreign --import Foreign
import Control.Lens import Control.Lens
import Control.Monad import Control.Monad
@@ -37,15 +37,20 @@ sizeFBOs xsize ysize xfull yfull rdata = do
-- return rdata4 -- return rdata4
resizeRBO resizeRBO
:: RenderbufferObject :: GLuint -- RenderbufferObject
-> Int -> Int
-> Int -> Int
-> IO () -> IO ()
resizeRBO rboName xsize ysize = do resizeRBO rboName xsize ysize = do
let xsize' = fromIntegral xsize let xsize' = fromIntegral xsize
ysize' = fromIntegral ysize ysize' = fromIntegral ysize
bindRenderbuffer Renderbuffer $= rboName --bindRenderbuffer Renderbuffer $= rboName
renderbufferStorage Renderbuffer Depth24Stencil8 (RenderbufferSize xsize' ysize') --renderbufferStorage Renderbuffer Depth24Stencil8 (RenderbufferSize xsize' ysize')
glNamedRenderbufferStorage
rboName
GL_DEPTH24_STENCIL8
xsize'
ysize'
updateFBOTO updateFBOTO
:: Int :: Int
-> Int -> Int
src/Preload/Render.hs
+12 -12
View File
@@ -28,11 +28,7 @@ preloadRender :: IO RenderData
preloadRender = do preloadRender = do
-- set up uniform buffer object -- set up uniform buffer object
theUBO <- mglCreateSingle glCreateBuffers theUBO <- mglCreateSingle glCreateBuffers
--glBindBuffer GL_UNIFORM_BUFFER theUBO
--bindBuffer UniformBuffer $= Just theUBO
glNamedBufferData theUBO 64 nullPtr GL_STREAM_DRAW glNamedBufferData theUBO 64 nullPtr GL_STREAM_DRAW
--bufferData UniformBuffer $= (64, nullPtr, StreamDraw)
--bindBufferBase IndexedUniformBuffer 0 $= Just theUBO
glBindBufferBase GL_UNIFORM_BUFFER 0 theUBO glBindBufferBase GL_UNIFORM_BUFFER 0 theUBO
-- setup wall points VBO, VAOs and shaders -- setup wall points VBO, VAOs and shaders
wpVBOname <- mglCreateSingle glCreateBuffers wpVBOname <- mglCreateSingle glCreateBuffers
@@ -58,11 +54,10 @@ preloadRender = do
-- setup window points VBO, VAOs and shaders -- setup window points VBO, VAOs and shaders
winVBOname <- mglCreateSingle glCreateBuffers winVBOname <- mglCreateSingle glCreateBuffers
winVBOptr <- mallocArray (8 * numDrawableWalls) winVBOptr <- mallocArray (8 * numDrawableWalls)
bufferData ArrayBuffer glNamedBufferData wpVBOname
$= ( fromIntegral $ floatSize * numDrawableWalls * 8 ( fromIntegral $ floatSize * numDrawableWalls * 8)
, nullPtr nullPtr
, StreamDraw GL_STREAM_DRAW
)
let winVBO = VBO{_vboName = winVBOname, _vboPtr = winVBOptr, _vboAttribSizes = [4, 4], _vboStride = 8} let winVBO = VBO{_vboName = winVBOname, _vboPtr = winVBOptr, _vboAttribSizes = [4, 4], _vboStride = 8}
--winColVAOname <- genObjectName --winColVAOname <- genObjectName
--bindVertexArrayObject $= Just winColVAOname --bindVertexArrayObject $= Just winColVAOname
@@ -180,9 +175,14 @@ preloadRender = do
framebuf2 <- setupTextureFramebuffer 800 600 framebuf2 <- setupTextureFramebuffer 800 600
framebuf3 <- setupTextureFramebuffer 800 600 framebuf3 <- setupTextureFramebuffer 800 600
rboBaseBloomName <- genObjectName rboBaseBloomName <- mglCreateSingle glCreateRenderbuffers
bindRenderbuffer Renderbuffer $= rboBaseBloomName --bindRenderbuffer Renderbuffer $= rboBaseBloomName
renderbufferStorage Renderbuffer Depth24Stencil8 (RenderbufferSize 800 600) --renderbufferStorage Renderbuffer Depth24Stencil8 (RenderbufferSize 800 600)
glNamedRenderbufferStorage
rboBaseBloomName
GL_DEPTH24_STENCIL8
800
600
fboBaseName <- setupFramebuffer2GivenStencil rboBaseBloomName fboBaseName <- setupFramebuffer2GivenStencil rboBaseBloomName
fboCloudName <- setupFramebuffer2GivenStencil rboBaseBloomName fboCloudName <- setupFramebuffer2GivenStencil rboBaseBloomName
src/Render.hs
+3 -3
View File
@@ -145,7 +145,7 @@ createLightMap pdata lightPoints nWalls nSils nCaps drawObjShads toPos drawCPUSh
pingPongBetween :: pingPongBetween ::
(FramebufferObject, TextureObject) -> (FramebufferObject, TextureObject) ->
(FramebufferObject, TextureObject) -> (FramebufferObject, TextureObject) ->
FullShader' -> FullShader ->
IO () IO ()
pingPongBetween (fb1, to1) (fb2, to2) fs = do pingPongBetween (fb1, to1) (fb2, to2) fs = do
bindFramebuffer Framebuffer $= fb2 bindFramebuffer Framebuffer $= fb2
@@ -156,7 +156,7 @@ pingPongBetween (fb1, to1) (fb2, to2) fs = do
drawShader fs 4 drawShader fs 4
renderFoldable :: renderFoldable ::
MV.MVector (PrimState IO) FullShader' -> MV.MVector (PrimState IO) FullShader ->
Picture -> Picture ->
IO () IO ()
renderFoldable shadV struct = do renderFoldable shadV struct = do
@@ -167,7 +167,7 @@ renderFoldable shadV struct = do
------------------------------end renderFoldable ------------------------------end renderFoldable
renderLayer :: renderLayer ::
Layer -> Layer ->
MV.MVector (PrimState IO) FullShader' -> MV.MVector (PrimState IO) FullShader ->
UMV.MVector (PrimState IO) Int -> UMV.MVector (PrimState IO) Int ->
IO () IO ()
renderLayer layer shads counts = do renderLayer layer shads counts = do
src/Shader.hs
+7 -7
View File
@@ -21,7 +21,7 @@ import Control.Monad.Primitive
import Foreign import Foreign
import Graphics.GL.Core45 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 #-}
drawShaderLay l countsVector shadIn fs = do drawShaderLay l countsVector shadIn fs = do
i <- UMV.read countsVector shadIn i <- UMV.read countsVector shadIn
@@ -40,7 +40,7 @@ drawShaderLay l countsVector shadIn fs = do
(fromIntegral $ l*numSubElements) (fromIntegral $ l*numSubElements)
(fromIntegral i) (fromIntegral i)
drawShader :: FullShader' -> Int -> IO () drawShader :: FullShader -> Int -> IO ()
{-# INLINE drawShader #-} {-# INLINE drawShader #-}
drawShader fs i = do drawShader fs i = do
--currentProgram $= Just (_shadProg fs) --currentProgram $= Just (_shadProg fs)
@@ -58,11 +58,11 @@ drawShader fs i = do
0 0
(fromIntegral i) (fromIntegral i)
freeShaderPointers' :: FullShader' -> IO () freeShaderPointers' :: FullShader -> IO ()
freeShaderPointers' = free . _vboPtr . _vaoVBO . _shadVAO' freeShaderPointers' = free . _vboPtr . _vaoVBO . _shadVAO'
pokeBindFoldable pokeBindFoldable
:: MV.MVector (PrimState IO) FullShader' :: MV.MVector (PrimState IO) FullShader
-> UMV.MVector (PrimState IO) Int -> UMV.MVector (PrimState IO) Int
-> Picture -> Picture
-> IO () -> IO ()
@@ -71,7 +71,7 @@ pokeBindFoldable shadV counts m = do
bindShader shadV counts bindShader shadV counts
pokeBindFoldableLayer pokeBindFoldableLayer
:: MV.MVector (PrimState IO) FullShader' :: MV.MVector (PrimState IO) FullShader
-> UMV.MVector (PrimState IO) Int -> UMV.MVector (PrimState IO) Int
-> Picture -> Picture
-> IO () -> IO ()
@@ -79,10 +79,10 @@ pokeBindFoldableLayer shadV counts m = do
pokeLayVerxs shadV counts m pokeLayVerxs shadV counts m
bindShaderLayers shadV counts bindShaderLayers shadV counts
shadVBOptr :: FullShader' -> Ptr Float shadVBOptr :: FullShader -> Ptr Float
{-# INLINE shadVBOptr #-} {-# INLINE shadVBOptr #-}
shadVBOptr = _vboPtr . _vaoVBO . _shadVAO' shadVBOptr = _vboPtr . _vaoVBO . _shadVAO'
shadVBOptr' :: FullShader' -> Ptr Float shadVBOptr' :: FullShader -> Ptr Float
{-# INLINE shadVBOptr' #-} {-# INLINE shadVBOptr' #-}
shadVBOptr' = _vboPtr . _vaoVBO . _shadVAO' shadVBOptr' = _vboPtr . _vaoVBO . _shadVAO'
src/Shader/AuxAddition.hs
+6 -6
View File
@@ -21,10 +21,10 @@ import GLHelp
-- 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 GL_LINEAR_MIPMAP_LINEAR GL_LINEAR addTexture = addTexture2D 3 GL_LINEAR_MIPMAP_LINEAR GL_LINEAR
vaddTextureNoFilter :: String -> FullShader' -> IO FullShader' vaddTextureNoFilter :: String -> FullShader -> IO FullShader
vaddTextureNoFilter = addTexture2D 1 GL_NEAREST GL_NEAREST vaddTextureNoFilter = addTexture2D 1 GL_NEAREST GL_NEAREST
addTexture2D addTexture2D
@@ -32,7 +32,7 @@ addTexture2D
-> GLenum -- minfilter -> GLenum -- minfilter
-> GLenum -- magfilter -> GLenum -- magfilter
-> String -- path to image -> String -- path to image
-> FullShader' -> IO FullShader' -> FullShader -> IO FullShader
addTexture2D nlev minfilt magfilt texpath shad = do addTexture2D nlev minfilt magfilt texpath shad = do
Right cmap <- readImage texpath Right cmap <- readImage texpath
let texdata = convertRGBA8 cmap let texdata = convertRGBA8 cmap
@@ -63,7 +63,7 @@ addTexture2D nlev minfilt magfilt texpath shad = do
-- | 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
err <- glGetError err <- glGetError
print err print err
@@ -87,10 +87,10 @@ tilesToLine
-> [a] -> [a]
tilesToLine n w = concat . concat . transpose . chunksOf n . chunksOf w tilesToLine n w = concat . concat . transpose . chunksOf n . chunksOf w
addUniforms :: [String] -> FullShader' -> IO FullShader' addUniforms :: [String] -> FullShader -> IO FullShader
addUniforms uniStrings shad = do foldM addUniform shad uniStrings addUniforms uniStrings shad = do foldM addUniform shad uniStrings
addUniform :: FullShader' -> String -> IO FullShader' addUniform :: FullShader -> String -> IO FullShader
addUniform shad unistr = BS.useAsCString (pack unistr) $ \cstr -> do addUniform shad unistr = BS.useAsCString (pack unistr) $ \cstr -> do
loc <- glGetUniformLocation (_shadProg' shad) cstr loc <- glGetUniformLocation (_shadProg' shad) cstr
return $ shad & shadUnis' %~ (V.++ V.fromList [loc]) return $ shad & shadUnis' %~ (V.++ V.fromList [loc])
src/Shader/Bind.hs
+4 -4
View File
@@ -27,7 +27,7 @@ bindArrayBuffers numVs theVBO = do
(fromIntegral $ floatSize * numVs * sum (_vboAttribSizes theVBO)) (fromIntegral $ floatSize * numVs * sum (_vboAttribSizes theVBO))
(_vboPtr theVBO) (_vboPtr theVBO)
bindShaderLayers :: MV.MVector (PrimState IO) FullShader' -> UMV.MVector (PrimState IO) Int -> IO () bindShaderLayers :: MV.MVector (PrimState IO) FullShader -> UMV.MVector (PrimState IO) Int -> IO ()
bindShaderLayers shads counts = MV.imapM_ f shads bindShaderLayers shads counts = MV.imapM_ f shads
where where
f i shad = do f i shad = do
@@ -47,17 +47,17 @@ bindShaderLayers shads counts = MV.imapM_ f shads
(fromIntegral $ floatSize * numVs * stride) (fromIntegral $ floatSize * numVs * stride)
(_vboPtr theVBO `plusPtr` (floatSize * stride * numSubElements * lay)) (_vboPtr theVBO `plusPtr` (floatSize * stride * numSubElements * lay))
bindShader :: MV.MVector (PrimState IO) FullShader' -> UMV.MVector (PrimState IO) Int -> IO () bindShader :: MV.MVector (PrimState IO) FullShader -> UMV.MVector (PrimState IO) Int -> IO ()
bindShader shads counts = MV.imapM_ f shads bindShader shads counts = MV.imapM_ f shads
where where
f i shad = UMV.read counts i >>= flip bindArrayBuffers (_vaoVBO . _shadVAO' $ shad) f i shad = UMV.read counts i >>= flip bindArrayBuffers (_vaoVBO . _shadVAO' $ shad)
bindShaderBuffers :: [FullShader'] -> [Int] -> IO () bindShaderBuffers :: [FullShader] -> [Int] -> IO ()
bindShaderBuffers = zipWithM_ f bindShaderBuffers = zipWithM_ f
where where
f fs i = bindArrayBuffers i $ _vaoVBO $ _shadVAO' fs f fs i = bindArrayBuffers i $ _vaoVBO $ _shadVAO' fs
bindShaderBuffers' :: [FullShader'] -> [Int] -> IO () bindShaderBuffers' :: [FullShader] -> [Int] -> IO ()
bindShaderBuffers' = zipWithM_ f bindShaderBuffers' = zipWithM_ f
where where
f fs i = bindArrayBuffers i $ _vaoVBO $ _shadVAO' fs f fs i = bindArrayBuffers i $ _vaoVBO $ _shadVAO' fs
src/Shader/Compile.hs
+8 -8
View File
@@ -29,12 +29,12 @@ makeShader ::
-- | The input vertex sizes -- | The input vertex sizes
[Int] -> [Int] ->
EPrimitiveMode -> EPrimitiveMode ->
IO FullShader' IO FullShader
makeShader s shaderlist sizes pm = do makeShader s shaderlist sizes pm = do
prog <- makeSourcedShader s shaderlist prog <- makeSourcedShader s shaderlist
vaob <- setupVAO sizes vaob <- setupVAO sizes
return $ return $
FullShader' FullShader
{ _shadProg' = prog { _shadProg' = prog
, _shadVAO' = vaob , _shadVAO' = vaob
, _shadPrim' = pm , _shadPrim' = pm
@@ -49,11 +49,11 @@ makeByteStringShaderUsingVAO ::
[(GLenum, BS.ByteString)] -> [(GLenum, BS.ByteString)] ->
EPrimitiveMode -> EPrimitiveMode ->
VAO -> VAO ->
IO FullShader' IO FullShader
makeByteStringShaderUsingVAO s shaderlist pm vao = do makeByteStringShaderUsingVAO s shaderlist pm vao = do
prog <- makeShaderProgram s shaderlist prog <- makeShaderProgram s shaderlist
return $ return $
FullShader' FullShader
{ _shadProg' = prog { _shadProg' = prog
, _shadVAO' = vao , _shadVAO' = vao
, _shadPrim' = pm , _shadPrim' = pm
@@ -69,11 +69,11 @@ makeShaderUsingVAO ::
[GLenum] -> [GLenum] ->
EPrimitiveMode -> EPrimitiveMode ->
VAO -> VAO ->
IO FullShader' IO FullShader
makeShaderUsingVAO s shaderlist pm theVAO = do makeShaderUsingVAO s shaderlist pm theVAO = do
prog <- makeSourcedShader s shaderlist prog <- makeSourcedShader s shaderlist
return $ return $
FullShader' FullShader
{ _shadProg' = prog { _shadProg' = prog
, _shadVAO' = theVAO , _shadVAO' = theVAO
, _shadPrim' = pm , _shadPrim' = pm
@@ -95,12 +95,12 @@ makeShaderSized ::
-- | Number of vertexes that can be poked -- | Number of vertexes that can be poked
Int -> Int ->
EPrimitiveMode -> EPrimitiveMode ->
IO FullShader' IO FullShader
makeShaderSized s shaderlist sizes ndraw pm = do makeShaderSized s shaderlist sizes ndraw pm = do
prog <- makeSourcedShader s shaderlist prog <- makeSourcedShader s shaderlist
vaob <- setupVAOSized ndraw sizes vaob <- setupVAOSized ndraw sizes
return $ return $
FullShader' FullShader
{ _shadProg' = prog { _shadProg' = prog
, _shadVAO' = vaob , _shadVAO' = vaob
, _shadPrim' = pm , _shadPrim' = pm
src/Shader/Data.hs
+3 -3
View File
@@ -6,7 +6,7 @@ module Shader.Data
, VBO (..) , VBO (..)
, EBO (..) , EBO (..)
-- , FullShader (..) -- , FullShader (..)
, FullShader' (..) , FullShader (..)
, ShaderTexture (..) , ShaderTexture (..)
, EPrimitiveMode (..) , EPrimitiveMode (..)
-- | Lens functions -- | Lens functions
@@ -35,7 +35,7 @@ import Graphics.GL.Core43
import Foreign import Foreign
import Control.Lens import Control.Lens
{- | Datatype containing the necessary information for a single shader. -} {- | Datatype containing the necessary information for a single shader. -}
data FullShader' = FullShader' data FullShader = FullShader
{ _shadProg' :: GLuint -- should be shaderID { _shadProg' :: GLuint -- should be shaderID
, _shadVAO' :: VAO , _shadVAO' :: VAO
, _shadPrim' :: EPrimitiveMode , _shadPrim' :: EPrimitiveMode
@@ -87,5 +87,5 @@ geom' = GL_GEOMETRY_SHADER
frag' = GL_FRAGMENT_SHADER frag' = GL_FRAGMENT_SHADER
makeLenses ''VAO makeLenses ''VAO
makeLenses ''VBO makeLenses ''VBO
makeLenses ''FullShader' makeLenses ''FullShader
makeLenses ''EBO makeLenses ''EBO
src/Shader/Poke.hs
+4 -4
View File
@@ -25,14 +25,14 @@ import Control.Monad.Primitive
--import qualified Control.Monad.Parallel as MP --import qualified Control.Monad.Parallel as MP
pokeVerxs pokeVerxs
:: MV.MVector (PrimState IO) FullShader' :: MV.MVector (PrimState IO) FullShader
-> UMV.MVector (PrimState IO) Int -> UMV.MVector (PrimState IO) Int
-> Picture -> Picture
-> IO () -> IO ()
--pokeVerxs vbos count = S.mapM_ (pokeVerx vbos count) . S.each --pokeVerxs vbos count = S.mapM_ (pokeVerx vbos count) . S.each
pokeVerxs vbos count = VFSM.mapM_ (pokeVerx vbos count) . VFSM.fromList pokeVerxs vbos count = VFSM.mapM_ (pokeVerx vbos count) . VFSM.fromList
pokeVerx :: MV.MVector (PrimState IO) FullShader' -> UMV.MVector (PrimState IO) Int -> Verx -> IO () pokeVerx :: MV.MVector (PrimState IO) FullShader -> UMV.MVector (PrimState IO) Int -> Verx -> IO ()
pokeVerx vbos offsets Verx{_vxPos=thePos,_vxCol=theCol,_vxExt=ext,_vxShadNum=theShadNum} = do pokeVerx vbos offsets Verx{_vxPos=thePos,_vxCol=theCol,_vxExt=ext,_vxShadNum=theShadNum} = do
typeOff <- UMV.unsafeRead offsets sn typeOff <- UMV.unsafeRead offsets sn
basePtr <- _vboPtr . _vaoVBO . _shadVAO' <$> MV.unsafeRead vbos sn basePtr <- _vboPtr . _vaoVBO . _shadVAO' <$> MV.unsafeRead vbos sn
@@ -183,14 +183,14 @@ pokeJustV ptr nv sh = do
V4 d e f g = _svCol sh V4 d e f g = _svCol sh
pokeLayVerxs pokeLayVerxs
:: MV.MVector (PrimState IO) FullShader' :: MV.MVector (PrimState IO) FullShader
-> UMV.MVector (PrimState IO) Int -> UMV.MVector (PrimState IO) Int
-> Picture -> Picture
-> IO () -> IO ()
--pokeLayVerxs vbos counts = S.mapM_ (pokeLayVerx vbos counts) . S.each --pokeLayVerxs vbos counts = S.mapM_ (pokeLayVerx vbos counts) . S.each
pokeLayVerxs vbos counts = VFSM.mapM_ (pokeLayVerx vbos counts) . VFSM.fromList pokeLayVerxs vbos counts = VFSM.mapM_ (pokeLayVerx vbos counts) . VFSM.fromList
pokeLayVerx :: MV.MVector (PrimState IO) FullShader' -> UMV.MVector (PrimState IO) Int -> Verx -> IO () pokeLayVerx :: MV.MVector (PrimState IO) FullShader -> UMV.MVector (PrimState IO) Int -> Verx -> IO ()
--{-# INLINE pokeLayVerx #-} --{-# INLINE pokeLayVerx #-}
pokeLayVerx vbos counts vx = do pokeLayVerx vbos counts vx = do
theOff <- UMV.unsafeRead counts vecPos theOff <- UMV.unsafeRead counts vecPos